Class-Virtual-0.06/0000755000076500007650000000000010476650747014066 5ustar schwernschwernClass-Virtual-0.06/Changes0000644000076500007650000000156310476650722015357 0ustar schwernschwern0.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.06/lib/0000755000076500007650000000000010476650746014633 5ustar schwernschwernClass-Virtual-0.06/lib/Class/0000755000076500007650000000000010476650746015700 5ustar schwernschwernClass-Virtual-0.06/lib/Class/Virtual.pm0000644000076500007650000001253410476650663017667 0ustar schwernschwernpackage Class::Virtual; use strict; use vars qw($VERSION @ISA); $VERSION = '0.06'; 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 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, 2001, 2003, 2004 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.06/lib/Class/Virtually/0000755000076500007650000000000010476650746017673 5ustar schwernschwernClass-Virtual-0.06/lib/Class/Virtually/Abstract.pm0000644000076500007650000000621610476647655022006 0ustar schwernschwernpackage Class::Virtually::Abstract; require Class::Virtual; @ISA = qw(Class::Virtual); use strict; use vars qw(%Registered $VERSION); $VERSION = '0.03'; { no strict 'refs'; sub virtual_methods { my($base_class) = shift; if( @_ and !$Registered{$base_class} ) { $Registered{$base_class} = 1; my($has_orig_import) = 0; # Shut up "subroutine import redefined" local $^W = 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; 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.06/Makefile.PL0000644000076500007650000000242510476647655016047 0ustar schwernschwern# A template for Makefile.PL used by Arena Networks. # - Set the $PACKAGE variable to the name of your module. # - Set $LAST_API_CHANGE to reflect the last version you changed the API # of your module. # - Fill in your dependencies in PREREQ_PM # Alternatively, you can say the hell with this and use h2xs. use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. $PACKAGE = 'Class::Virtual'; ($PACKAGE_FILE = $PACKAGE) =~ s|::|/|g; $LAST_API_CHANGE = 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 } WriteMakefile( NAME => $PACKAGE, VERSION_FROM => "lib/$PACKAGE_FILE.pm", # finds $VERSION PREREQ_PM => { Class::Data::Inheritable => 0.02, Class::ISA => 0.31, Carp::Assert => 0.10, Test::More => 0.50, }, ); Class-Virtual-0.06/MANIFEST0000644000076500007650000000030510476650747015215 0ustar schwernschwernChanges lib/Class/Virtual.pm lib/Class/Virtually/Abstract.pm Makefile.PL MANIFEST t/Abstract.t t/assert.t t/Virtual.t META.yml Module meta-data (added by MakeMaker) Class-Virtual-0.06/META.yml0000664000076500007650000000076410476650747015350 0ustar schwernschwern--- #YAML:1.0 name: Class-Virtual version: 0.06 abstract: ~ license: unknown generated_by: ExtUtils::MakeMaker version 6.30_03 author: ~ distribution_type: module requires: Carp::Assert: 0.1 Class::Data::Inheritable: 0.02 Class::ISA: 0.31 Test::More: 0.5 meta-spec: url: http://module-build.sourceforge.net/META-spec-new.html version: 1.1 Class-Virtual-0.06/t/0000755000076500007650000000000010476650746014330 5ustar schwernschwernClass-Virtual-0.06/t/Abstract.t0000644000076500007650000000526710476650533016264 0ustar schwernschwern#!/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.06/t/assert.t0000644000076500007650000000034710476647654016026 0ustar schwernschwern#!/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.06/t/Virtual.t0000644000076500007650000000473310476650515016144 0ustar schwernschwern#!/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' ); }