File Coverage

blib/lib/Class/Member/GLOB.pm
Criterion Covered Total %
statement 37 37 100.0
branch 7 8 87.5
condition n/a
subroutine 7 7 100.0
pod n/a
total 51 52 98.1


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