Class-Virtual-0.08/0000755000076500000240000000000012751441654013477 5ustar schwernstaffClass-Virtual-0.08/.travis.yml0000644000076500000240000000015412751440662015606 0ustar schwernstafflanguage: perl perl: - "5.22" - "5.20" - "5.18" - "5.16" - "5.14" - "5.12" - "5.10" - "5.8" Class-Virtual-0.08/appveyor.yml0000644000076500000240000000057112751440664016072 0ustar schwernstaffbranches: except: - /travis/ skip_tags: true cache: - C:\strawberry install: - if not exist "C:\strawberry" cinst strawberryperl - set PATH=C:\strawberry\perl\bin;C:\strawberry\perl\site\bin;C:\strawberry\c\bin;%PATH% - cd C:\projects\%APPVEYOR_PROJECT_NAME% - cpanm --installdeps . build_script: - perl Makefile.PL - dmake test_script: - dmake test Class-Virtual-0.08/Changes0000644000076500000240000000246212751441616014774 0ustar schwernstaff0.08 Sat Aug 6 13:07:36 PDT 2016 Kwalitee * Turn on and normalize strict and warnings. (Denis Ibaev) [github #3] Distribution * Added metacpan as the homepage * Now using Travis and AppVeyor CI 0.07 Sun Mar 1 12:32:44 PST 2015 Misc * Update metadata to point at Github. [github #2] * Discourage use of this module, there are better solutions. [github #1] * Clarify the license link in the documentation. 0.06 Sun Sep 3 18:06:03 EDT 2006 - Minor test fix for slightly different perldiag. [rt.cpan.org 11647] 0.05 Fri Dec 31 01:38:29 EST 2004 - Added a license and copyright. [rt.cpan.org 8229] - Fixed it so assert and affirm don't leak out from internal use of Carp::Assert [rt.cpan.org 6298] - Now using Test::More for tests. 0.04 Sun Oct 19 22:18:59 PDT 2003 * Class::Virtually::Abstract was missing a $VERSION - Using @ISA instead of base.pm to avoid the odd base.pm bug. 0.03 Fri Mar 2 01:33:07 EST 2001 * Officially distributing Class::Virtually::Abstract * Virtual responsibility was leaking across all virtual classes - Started using Carp::Assert 0.02 Fri Feb 9 13:17:34 GMT 2001 - Fixed wierd bug with fully qualified Carp::carp calls. 0.01 Tue Nov 28 03:03:35 GMT 2000 - First working version released to CPAN. Class-Virtual-0.08/lib/0000755000076500000240000000000012751441654014245 5ustar schwernstaffClass-Virtual-0.08/lib/Class/0000755000076500000240000000000012751441654015312 5ustar schwernstaffClass-Virtual-0.08/lib/Class/Virtual.pm0000644000076500000240000001300712751441424017272 0ustar schwernstaffpackage Class::Virtual; use strict; use warnings; use vars qw($VERSION @ISA); $VERSION = '0.08'; use Carp::Assert qw(DEBUG); # import only the tiny bit we need so it doesn't # get inherited. use Class::ISA; use Class::Data::Inheritable; @ISA = qw(Class::Data::Inheritable); __PACKAGE__->mk_classdata('__Virtual_Methods'); =pod =head1 NAME Class::Virtual - Base class for virtual base classes. =head1 SYNOPSIS package My::Virtual::Idaho; use base qw(Class::Virtual); __PACKAGE__->virtual_methods(qw(new foo bar this that)); package My::Private::Idaho; use base qw(My::Virtual::Idaho); # Check to make sure My::Private::Idaho implemented everything my @missing = __PACKAGE__->missing_methods; die __PACKAGE__ . ' forgot to implement ' . join ', ', @missing if @missing; # If My::Private::Idaho forgot to implement new(), the program will # halt and yell about that. my $idaho = My::Private::Idaho->new; # See what methods we're obligated to implement. my @must_implement = __PACKAGE__->virtual_methods; =head1 DESCRIPTION B Avoid using it for new code. There's nothing wrong with it, but there are better ways to accomplish the same thing. Look into the L ecosystem. This is a base class for implementing virtual base classes (what some people call an abstract class). Kinda kooky. It allows you to explicitly declare what methods are virtual and that must be implemented by subclasses. This might seem silly, since your program will halt and catch fire when an unimplemented virtual method is hit anyway, but there's some benefits. The error message is more informative. Instead of the usual "Can't locate object method" error, you'll get one explaining that a virtual method was left unimplemented. Subclass authors can explicitly check to make sure they've implemented all the necessary virtual methods. When used as part of a regression test, it will shield against the virtual method requirements changing out from under the subclass. Finally, subclass authors can get an explicit list of everything they're expected to implement. Doesn't hurt and it doesn't slow you down. =head2 Methods =over 4 =item B Virtual::Class->virtual_methods(@virtual_methods); my @must_implement = Sub::Class->virtual_methods; This is an accessor to the list of virtual_methods. Virtual base classes will declare their list of virtual methods. Subclasses will look at them. Once the virtual methods are set they cannot be undone. =for notes I'm tempted to make it possible for the subclass to override the virtual methods, perhaps add to them. Too hairy to think about for 0.01. =cut #"# sub virtual_methods { my($class) = shift; if( @_ ) { if( defined $class->__Virtual_Methods ) { require Carp; Carp::croak("Attempt to reset virtual methods."); } $class->_mk_virtual_methods(@_); } else { return @{$class->__Virtual_Methods}; } } sub _mk_virtual_methods { no strict 'refs'; # symbol table mucking! Getcher goloshes on. my($this_class, @methods) = @_; $this_class->__Virtual_Methods(\@methods); # private method to return the virtual base class *{$this_class.'::__virtual_base_class'} = sub { return $this_class; }; foreach my $meth (@methods) { # Make sure the method doesn't already exist. if( $this_class->can($meth) ) { require Carp; Carp::croak("$this_class attempted to declare $meth() virtual ". "but it appears to already be implemented!"); } # Create a virtual method. *{$this_class.'::'.$meth} = sub { my($self) = shift; my($class) = ref $self || $self; require Carp; if( $class eq $this_class) { my $caller = caller; Carp::croak("$caller called the virtual base class ". "$this_class directly! Use a subclass instead"); } else { Carp::croak("$class forgot to implement $meth()"); } }; } } =pod =item B my @missing_methods = Sub::Class->missing_methods; Returns a list of methods Sub::Class has not yet implemented. =cut sub missing_methods { my($class) = shift; my @vmeths = $class->virtual_methods; my @super_classes = Class::ISA::self_and_super_path($class); my $vclass = $class->__virtual_base_class; # Remove everything in the hierarchy beyond, and including, # the virtual base class. They don't concern us. my $sclass; do { $sclass = pop @super_classes; Carp::Assert::assert( defined $sclass ) if DEBUG; } until $sclass eq $vclass; my @missing = (); { no strict 'refs'; METHOD: foreach my $meth (@vmeths) { CLASS: foreach my $class (@super_classes) { next METHOD if defined &{$class.'::'.$meth}; } push @missing, $meth; } } return @missing; } =pod =back =head1 CAVEATS and BUGS Autoloaded methods are currently not recognized. I have no idea how to solve this. =head1 AUTHOR Michael G Schwern Eschwern@pobox.comE =head1 LEGAL Copyright 2000-2015 Michael G Schwern This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L =head1 SEE ALSO L =cut return "Club sandwich"; Class-Virtual-0.08/lib/Class/Virtually/0000755000076500000240000000000012751441654017305 5ustar schwernstaffClass-Virtual-0.08/lib/Class/Virtually/Abstract.pm0000644000076500000240000000616512751441436021414 0ustar schwernstaffpackage Class::Virtually::Abstract; use strict; use warnings; use vars qw(%Registered $VERSION @ISA); require Class::Virtual; @ISA = qw(Class::Virtual); $VERSION = '0.08'; { no strict 'refs'; sub virtual_methods { my($base_class) = shift; if( @_ and !$Registered{$base_class} ) { $Registered{$base_class} = 1; my($has_orig_import) = 0; if( defined &{$base_class.'::import'} ) { # Divert the existing import method. $has_orig_import = 1; *{$base_class.'::__orig_import'} = \&{$base_class.'::import'}; } # We can't use a closure here, SUPER wouldn't work right. :( eval <<"IMPORT"; package $base_class; no warnings 'redefine'; sub import { my \$class = shift; return if \$class eq '$base_class'; my \@missing_methods = \$class->missing_methods; if (\@missing_methods) { require Carp; Carp::croak("Class \$class must define ". join(', ', \@missing_methods). " for class $base_class"); } # Since import() is typically caller() sensitive, these # must be gotos. if( $has_orig_import ) { goto &${base_class}::__orig_import; } elsif( my \$super_import = \$class->can('SUPER::import') ) { goto &\$super_import; } } IMPORT } $base_class->SUPER::virtual_methods(@_); } } 1; =pod =head1 NAME Class::Virtually::Abstract - Compile-time enforcement of Class::Virtual =head1 SYNOPSIS package My::Virtual::Idaho; use base qw(Class::Virtually::Abstract); __PACKAGE__->virtual_methods(qw(new foo bar this that)); package My::Private::Idaho; use base qw(My::Virtual::Idaho); sub new { ... } sub foo { ... } sub bar { ... } sub this { ... } # oops, forgot to implement that()!! Whatever will happen?! # Meanwhile, in another piece of code! # KA-BLAM! My::Private::Idaho fails to compile because it didn't # fully implement My::Virtual::Idaho. use My::Private::Idaho; =head1 DESCRIPTION This subclass of Class::Virtual provides B enforcement. That means subclasses of your virtual class are B to implement all virtual methods or else it will not compile. =head1 BUGS and CAVEATS Because this relies on import() it is important that your classes are Bd instead of Bd. This is a problem, and I'm trying to figure a way around it. Also, if a subclass defines its own import() routine (I've done it) Class::Virtually::Abstract's compile-time checking is defeated. Got to think of a better way to do this besides import(). =head1 AUTHOR Original idea and code from Ben Tilly's AbstractClass http://www.perlmonks.org/index.pl?node_id=44300&lastnode_id=45341 Embraced and Extended by Michael G Schwern Eschwern@pobox.comE =head1 SEE ALSO L =cut 1; Class-Virtual-0.08/Makefile.PL0000644000076500000240000000264612751441354015456 0ustar schwernstaff#!/usr/bin/perl -w use ExtUtils::MakeMaker; $PACKAGE = 'Class::Virtual'; ($PACKAGE_FILE = $PACKAGE) =~ s|::|/|g; $LAST_API_CHANGE = 0; $LAST_MAJOR_BUG = 0; eval "require $PACKAGE"; unless ($@) { # Make sure we did find the module. print <<"CHANGE_WARN" if ${$PACKAGE.'::VERSION'} < $LAST_API_CHANGE; NOTE: There have been API changes between this version and any older than version $LAST_API_CHANGE! Please read the Changes file if you are upgrading from a version older than $LAST_API_CHANGE. CHANGE_WARN print <<"BUG_WARN" if ${$PACKAGE.'::VERSION'} < $LAST_MAJOR_BUG; Version $LAST_MAJOR_BUG contained a MAJOR BUG which has now been fixed. See the Changes file for details. BUG_WARN } WriteMakefile( NAME => $PACKAGE, VERSION_FROM => "lib/$PACKAGE_FILE.pm", ABSTRACT_FROM => "lib/$PACKAGE_FILE.pm", AUTHOR => 'Michael G Schwern ', LICENSE => 'perl_5', PREREQ_PM => { Class::Data::Inheritable => 0.02, Class::ISA => 0.31, Carp::Assert => 0.10, Test::More => 0.50, }, META_MERGE => { resources => { homepage => 'https://metacpan.org/release/Class-Virtual', bugtracker => 'https://github.com/schwern/Class-Virtual/issues', repository => 'https://github.com/schwern/Class-Virtual', } }, ); Class-Virtual-0.08/MANIFEST0000644000076500000240000000046712751441654014637 0ustar schwernstaff.travis.yml appveyor.yml Changes lib/Class/Virtual.pm lib/Class/Virtually/Abstract.pm Makefile.PL MANIFEST t/Abstract.t t/assert.t t/Virtual.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Class-Virtual-0.08/META.json0000644000076500000240000000250612751441654015123 0ustar schwernstaff{ "abstract" : "Base class for virtual base classes.", "author" : [ "Michael G Schwern " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.1, CPAN::Meta::Converter version 2.150005", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Class-Virtual", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Carp::Assert" : "0.1", "Class::Data::Inheritable" : "0.02", "Class::ISA" : "0.31", "Test::More" : "0.5" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/schwern/Class-Virtual/issues" }, "homepage" : "https://metacpan.org/release/Class-Virtual", "repository" : { "url" : "https://github.com/schwern/Class-Virtual" } }, "version" : "0.08", "x_serialization_backend" : "JSON::PP version 2.27203" } Class-Virtual-0.08/META.yml0000644000076500000240000000150012751441654014744 0ustar schwernstaff--- abstract: 'Base class for virtual base classes.' author: - 'Michael G Schwern ' build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.1, CPAN::Meta::Converter version 2.150005' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Class-Virtual no_index: directory: - t - inc requires: Carp::Assert: '0.1' Class::Data::Inheritable: '0.02' Class::ISA: '0.31' Test::More: '0.5' resources: bugtracker: https://github.com/schwern/Class-Virtual/issues homepage: https://metacpan.org/release/Class-Virtual repository: https://github.com/schwern/Class-Virtual version: '0.08' x_serialization_backend: 'CPAN::Meta::YAML version 0.012' Class-Virtual-0.08/t/0000755000076500000240000000000012751441654013742 5ustar schwernstaffClass-Virtual-0.08/t/Abstract.t0000644000076500000240000000526712473436237015706 0ustar schwernstaff#!/usr/bin/perl -w use strict; use Test::More tests => 18; BEGIN { use_ok 'Class::Virtually::Abstract'; } my @vmeths = qw(new foo bar this that); my $ok; package Foo::Virtual; use base qw(Class::Virtually::Abstract); __PACKAGE__->virtual_methods(@vmeths); ::is_deeply([sort __PACKAGE__->virtual_methods], [sort @vmeths], 'Declaring virtual methods' ); eval { __PACKAGE__->virtual_methods(qw(this wont work)); }; $ok = $@ =~ /^Attempt to reset virtual methods/; ::ok( $ok, "Disallow reseting by virtual class" ); package Foo::This; use base qw(Foo::Virtual); ::is_deeply( [sort __PACKAGE__->virtual_methods], [sort @vmeths], 'Subclass listing virtual methods'); ::is_deeply( [sort __PACKAGE__->missing_methods], [sort @vmeths], 'Subclass listing missing methods'); *foo = sub { 42 }; *bar = sub { 23 }; ::ok( defined &foo && defined &bar ); ::is_deeply([sort __PACKAGE__->missing_methods], [sort qw(new this that)], 'Subclass handling some methods'); eval { __PACKAGE__->virtual_methods(qw(this wont work)); }; ::like $@, qr/^Attempt to reset virtual methods/, "Disallow reseting by subclass"; package Foo::Virtual::Again; use base qw(Class::Virtually::Abstract); __PACKAGE__->virtual_methods('bing'); package Foo::Again; use base qw(Foo::Virtual::Again); ::is_deeply([sort __PACKAGE__->virtual_methods], [sort qw(bing)], 'Virtual classes not interfering' ); ::is_deeply([sort __PACKAGE__->missing_methods], [sort qw(bing)], 'Missing methods not interfering' ); ::is_deeply([sort Foo::This->virtual_methods], [sort @vmeths], 'Not overwriting virtual methods'); ::is_deeply([sort Foo::This->missing_methods], [sort qw(new this that)], 'Not overwriting missing methods'); eval { Foo::This->new; }; ::like( $@, qr/^Foo::This forgot to implement new\(\) at/, 'virtual method unimplemented, ok'); eval { Foo::This->bing; }; ::like( $@, qr/^Can't locate object method "bing" via package "Foo::This"/, 'virtual methods not leaking'); #') eval { Foo::Again->import; }; ::like( $@, qr/^Class Foo::Again must define bing for class Foo::Virtual::Again/ ); package Foo::More; use Test::More import => [qw($TODO)]; use base qw(Foo::Again); sub import { 42 } { local $TODO = 'defeated by import() routine'; eval { Foo::More->import; }; ::like( $@, qr/^Class Foo::More must define bing for class Foo::Virtual::Again/ ); } package Foo::Yet::Again; use base qw(Class::Virtually::Abstract); __PACKAGE__->virtual_methods('foo'); sub import { $Foo::Yet::Again = 42; } package Foo::Yet; use base qw(Foo::Yet::Again); sub foo { 23 } eval { Foo::Yet->import; }; ::is( $@, '' ); ::is( $Foo::Yet::Again, 42 ); Class-Virtual-0.08/t/assert.t0000644000076500000240000000034712473436237015436 0ustar schwernstaff#!/usr/bin/perl -w # rt.cpan.org 6298 use Test::More tests => 1; package Foo; use base qw(Class::Virtually::Abstract); eval { __PACKAGE__->virtual_methods(qw(assert affirm)); }; ::is $@, '', 'assert and affirm do not leak'; Class-Virtual-0.08/t/Virtual.t0000644000076500000240000000473312473436237015566 0ustar schwernstaff#!/usr/bin/perl -w use strict; use Test::More tests => 15; BEGIN { use_ok 'Class::Virtual'; } my @vmeths = qw(new foo bar this that); my $ok; package Test::Virtual; use base qw(Class::Virtual); __PACKAGE__->virtual_methods(@vmeths); ::is_deeply([sort __PACKAGE__->virtual_methods], [sort @vmeths], 'Declaring virtual methods' ); eval { __PACKAGE__->virtual_methods(qw(this wont work)); }; ::like($@, qr/^Attempt to reset virtual methods/, "Disallow reseting by virtual class" ); package Test::This; use base qw(Test::Virtual); ::is_deeply([sort __PACKAGE__->virtual_methods], [sort @vmeths], 'Subclass listing virtual methods'); ::is_deeply([sort __PACKAGE__->missing_methods], [sort @vmeths], 'Subclass listing missing methods'); *foo = sub { 42 }; *bar = sub { 23 }; ::ok( defined &foo && defined &bar ); ::is_deeply([sort __PACKAGE__->missing_methods], [sort qw(new this that)], 'Subclass handling some methods'); eval { __PACKAGE__->virtual_methods(qw(this wont work)); }; ::like($@, qr/^Attempt to reset virtual methods/, "Disallow reseting by subclass" ); package Test::Virtual::Again; use base qw(Class::Virtual); __PACKAGE__->virtual_methods('bing'); package Test::Again; use base qw(Test::Virtual::Again); ::is_deeply([sort __PACKAGE__->virtual_methods], [sort qw(bing)], 'Virtual classes not interfering' ); ::is_deeply([sort __PACKAGE__->missing_methods], [sort qw(bing)], 'Missing methods not interfering' ); ::is_deeply([sort Test::This->virtual_methods], [sort @vmeths], 'Not overwriting virtual methods'); ::is_deeply([sort Test::This->missing_methods], [sort qw(new this that)], 'Not overwriting missing methods'); eval { Test::This->new; }; ::like( $@, qr/^Test::This forgot to implement new\(\) at/, 'virtual method unimplemented, ok'); eval { Test::This->bing; }; ::like( $@, qr/^Can't locate object method "bing" via package "Test::This"/, 'virtual methods not leaking'); ### This test doesn't work and probably never will. ### package Test::That; use Test::More import => [qw($TODO)]; use base qw(Test::Virtual); # Let's see how things work with an autoloader. use vars qw($AUTOLOAD); sub AUTOLOAD { if( $AUTOLOAD =~ /(foo|bar)/ ) { return "Yay!"; } else { die "ARrrrrrrrrrrgh!\n"; } } { local $TODO = 'autoloaded methods'; ::is_deeply([sort __PACKAGE__->missing_methods], [sort qw(new this that)], 'Autoloaded methods recognized' ); }