File Coverage

blib/lib/Class/Member/Dynamic.pm
Criterion Covered Total %
statement 44 44 100.0
branch 11 12 91.7
condition n/a
subroutine 7 7 100.0
pod n/a
total 62 63 98.4


line stmt bran cond sub pod time code
1             package Class::Member::Dynamic;
2              
3 1     1   15 use strict;
  1         14  
  1         14  
4             our $VERSION='1.3';
5              
6 1     1   14 use Carp 'confess';
  1         10  
  1         18  
7              
8             sub import {
9 1     1   10   my $pack=shift;
10 1         11   ($pack)=caller;
11 1         10   my $dummy;
12              
13               my $getset=sub : lvalue {
14 17     17   143     my $I=shift;
15 17         143     my $what=shift;
16 17         141     my $rc=\$dummy;
17              
18 17 100       234     if( UNIVERSAL::isa( $I, 'HASH' ) ) {
    100          
19 8         105       $what=$pack.'::'.$what;
20 8 100       93       if( $#_>=0 ) {
21 2         23 $I->{$what}=shift;
22                   }
23 8         79       $rc=\$I->{$what};
24                 } elsif( UNIVERSAL::isa( $I, 'GLOB' ) ) {
25 8         436       $what=$pack.'::'.$what;
26 8 100       86       if( $#_>=0 ) {
27 2         18 ${*$I}{$what}=shift;
  2         25  
28                   }
29 8         67       $rc=\${*$I}{$what};
  8         84  
30                 } else {
31 1         16       confess "$pack\::$what must be called as instance method\n";
32                 }
33 16         242     $$rc;
34 1         17   };
35              
36 1         50   foreach my $name (@_) {
37 3 100       35     if( $name=~/^-(.*)/ ) { # reserved name, aka option
38 1 50       16       if( $1 eq 'CLASS_MEMBERS' ) {
39 1         9 local $_;
40 1     1   18 no strict 'refs';
  1         9  
  1         13  
41 1         10 *{$pack.'::CLASS_MEMBERS'}=[grep {!/^-/} @_];
  1         18  
  3         32  
42                   }
43                 } else {
44 1     1   15       no strict 'refs';
  1         10  
  1         12  
45 2         31       *{$pack.'::'.$name}=sub:lvalue {
46 17     17   282 my $I=shift;
47 17         174 &{$getset}( $I, $name, @_ );
  17         173  
48 2         25       };
49                 }
50               }
51             }
52              
53             1;
54              
55             __END__
56            
57             =head1 NAME
58            
59             Class::Member::Dynamic - A module to make the module developement easier
60            
61             =head1 SYNOPSIS
62            
63             package MyModule;
64             use Class::Member::Dynamic qw/member_A member_B/;
65            
66             =head1 DESCRIPTION
67            
68             See L<Class::Member>.
69            
70             =head1 AUTHOR
71            
72             Torsten Förtsch E<lt>Torsten.Foertsch@gmx.netE<gt>
73            
74             =head1 COPYRIGHT
75            
76             Copyright 2003 Torsten Förtsch.
77            
78             This library is free software; you can redistribute it and/or
79             modify it under the same terms as Perl itself.
80            
81             =cut
82