/usr/share/perl5/Class/Virtually/Abstract.pm is in libclass-virtual-perl 0.06-3.
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 130 | package 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<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;
|