libclass-virtual-perl 0.06-3 / usr / share / perl5 / Class / Virtually / Abstract.pm

This file is indexed.

/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;

APT Browse - Built by Thomas Orozco.