File Coverage

blib/lib/Objects/Collection/Base.pm
Criterion Covered Total %
statement 48 51 94.1
branch 14 18 77.7
condition n/a
subroutine 15 16 93.7
pod 0 2 0.0
total 77 87 88.5


line stmt bran cond sub pod time code
1             package Objects::Collection::Base;
2              
3             #$Id: Base.pm,v 1.3 2006/04/27 14:56:19 zag Exp $
4              
5             =head1 NAME
6              
7             Objects::Collection::Base - abstract class.
8              
9             =head1 SYNOPSIS
10              
11             use Objects::Collection::Base;
12             @Objects::Collection::ISA = qw(Objects::Collection::Base);
13              
14             =head1 DESCRIPTION
15              
16             Abstract class.
17              
18             =head1 METHODS
19              
20             =cut
21              
22              
23 99     99   143 use strict;
  99         501  
  3         81  
24 3     3   13 use warnings;
  3         4  
  3         68  
25 3     3   13 use strict;
  3         4  
  3         70  
26 3     3   12 use Carp;
  3         11  
  3         189  
27 3     3   13 use Data::Dumper;
  3         5  
  3         319  
28             require Exporter;
29             @Objects::Collection::Base::ISA = qw(Exporter);
30             @Objects::Collection::Base::EXPORT = qw(attributes);
31             $Objects::Collection::Base::VERSION = '0.01';
32              
33             sub attributes {
34 8     8 0 1020 my ($pkg) = caller;
35 3     3   15 no strict;
  3         12  
  3         870  
36 8         56 croak "Error: attributes() invoked multiple times"
37 8 100       13 if scalar @{"${pkg}::__ATTRIBUTES__"};
38              
39 8         11 @{"${pkg}::__ATTRIBUTES__"} = @_;
  8         28  
40 8         9 my $code = "";
41 8         17 foreach my $attr (@_) {
42 16 50       157 if ( UNIVERSAL::can( $pkg, "$attr" ) ) {
43 0         0 next;
44             }
45 16         36 $code .= _define_accessor( $pkg, $attr );
46             }
47 8 100   33   929 eval $code;
  33 0   0   47  
  33 100   6   167  
  0 100   9   0  
  0 100   45   0  
  6 100   71   11  
  6         34  
  9         223  
  9         59  
  45         70  
  45         162  
  71         113  
  71         351  
48             }
49              
50             sub _define_accessor {
51 16     16   24 my ( $pkg, $attr ) = @_;
52 16         42 my $code = qq{
53             package $pkg;
54             sub $attr { # Accessor ...
55             my \$self=shift;
56             \@_ ? \$self->{ Var }->{ $attr } = shift : \$self->{ Var }->{ $attr };
57             }
58             };
59 16         51 $code;
60             }
61              
62             sub new {
63 6     6 0 40 my $class = shift;
64 6         10 my $self = {};
65 6         8 my $stat;
66 6         51 bless( $self, $class );
67 6 50       28 return ( $stat = $self->_init(@_) ) ? $self : $stat;
68             }
69              
70             sub _init {
71 2     2   3 my $self = shift;
72 2         6 return 1;
73             }
74              
75              
76             # Preloaded methods go here.
77              
78             1;
79             __END__