File Coverage

blib/lib/Class/Virtually/Abstract.pm
Criterion Covered Total %
statement 34 57 59.6
branch 8 26 30.7
condition 3 3 100.0
subroutine 6 8 75.0
pod 1 1 100.0
total 52 95 54.7


line stmt bran cond sub pod time code
1             package Class::Virtually::Abstract;
2              
3             require Class::Virtual;
4             @ISA = qw(Class::Virtual);
5              
6 2     2   30121 use strict;
  2         4  
  2         75  
7              
8 2     2   7 use vars qw(%Registered $VERSION);
  2         4  
  2         130  
9             $VERSION = '0.07';
10              
11             {
12 2     2   8 no strict 'refs';
  2         5  
  2         302  
13              
14             sub virtual_methods {
15 16     16 1 2890 my($base_class) = shift;
16              
17 16 100 100     60 if( @_ and !$Registered{$base_class} ) {
18 5         11 $Registered{$base_class} = 1;
19              
20 5         6 my($has_orig_import) = 0;
21              
22             # Shut up "subroutine import redefined"
23 5         19 local $^W = 0;
24              
25 5 100       5 if( defined &{$base_class.'::import'} ) {
  5         39  
26             # Divert the existing import method.
27 1         2 $has_orig_import = 1;
28 1         2 *{$base_class.'::__orig_import'} = \&{$base_class.'::import'};
  1         10  
  1         4  
29             }
30              
31             # We can't use a closure here, SUPER wouldn't work right. :(
32 5 50   1   692 eval <<"IMPORT";
  1 50   0   42  
  1 0   0   3  
  1 0   1   9  
  1 0       3  
  0 0       0  
  0 0       0  
  1 0       1  
  1 50       3  
  0 50       0  
  0 0       0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  1         683  
  1         3  
  1         3  
  1         3  
  1         4  
  1         505  
  0            
  0            
  0            
33             package $base_class;
34              
35             sub import {
36             my \$class = shift;
37             return if \$class eq '$base_class';
38              
39             my \@missing_methods = \$class->missing_methods;
40             if (\@missing_methods) {
41             require Carp;
42             Carp::croak("Class \$class must define ".
43             join(', ', \@missing_methods).
44             " for class $base_class");
45             }
46              
47             # Since import() is typically caller() sensitive, these
48             # must be gotos.
49             if( $has_orig_import ) {
50             goto &${base_class}::__orig_import;
51             }
52             elsif( my \$super_import = \$class->can('SUPER::import') ) {
53             goto &\$super_import;
54             }
55             }
56             IMPORT
57              
58             }
59              
60 16         59 $base_class->SUPER::virtual_methods(@_);
61             }
62             }
63              
64             1;
65              
66              
67             =pod
68              
69             =head1 NAME
70              
71             Class::Virtually::Abstract - Compile-time enforcement of Class::Virtual
72              
73              
74             =head1 SYNOPSIS
75              
76             package My::Virtual::Idaho;
77             use base qw(Class::Virtually::Abstract);
78              
79             __PACKAGE__->virtual_methods(qw(new foo bar this that));
80              
81              
82             package My::Private::Idaho;
83             use base qw(My::Virtual::Idaho);
84              
85             sub new { ... }
86             sub foo { ... }
87             sub bar { ... }
88             sub this { ... }
89             # oops, forgot to implement that()!! Whatever will happen?!
90              
91              
92             # Meanwhile, in another piece of code!
93             # KA-BLAM! My::Private::Idaho fails to compile because it didn't
94             # fully implement My::Virtual::Idaho.
95             use My::Private::Idaho;
96              
97             =head1 DESCRIPTION
98              
99             This subclass of Class::Virtual provides B enforcement.
100             That means subclasses of your virtual class are B to
101             implement all virtual methods or else it will not compile.
102              
103              
104             =head1 BUGS and CAVEATS
105              
106             Because this relies on import() it is important that your classes are
107             Bd instead of Bd. This is a problem, and I'm trying to
108             figure a way around it.
109              
110             Also, if a subclass defines its own import() routine (I've done it)
111             Class::Virtually::Abstract's compile-time checking is defeated.
112              
113             Got to think of a better way to do this besides import().
114              
115              
116             =head1 AUTHOR
117              
118             Original idea and code from Ben Tilly's AbstractClass
119             http://www.perlmonks.org/index.pl?node_id=44300&lastnode_id=45341
120              
121             Embraced and Extended by Michael G Schwern Eschwern@pobox.comE
122              
123              
124             =head1 SEE ALSO
125              
126             L
127              
128             =cut
129              
130             1;