/usr/share/perl5/Class/Virtually/Abstract.pm is in libclass-virtual-perl 0.08-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 | package 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<compile-time> enforcement.
That means subclasses of your virtual class are B<required> 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
B<use>d instead of B<require>d. 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 E<lt>schwern@pobox.comE<gt>
=head1 SEE ALSO
L<Class::Virtual>
=cut
1;
|