File Coverage

inc/Test/Deep/MM.pm
Criterion Covered Total %
statement 37 40 92.5
branch 2 2 100.0
condition 0 3 0.0
subroutine 9 9 100.0
pod 0 2 0.0
total 48 56 85.7


line stmt bran cond sub pod time code
1 1     1   6 #line 1
  1         2  
  1         31  
2 1     1   6 use strict;
  1         2  
  1         96  
3             use warnings;
4              
5             package Test::Deep::MM;
6              
7             sub import
8 1     1   2 {
9             my $self = shift;
10 1         3  
11 1         4 my ($pkg) = caller();
12 1         4 my $mpkg = $pkg."::Methods";
13             foreach my $attr (@_)
14 4 100       16 {
15             if ($attr =~ /^[a-z]/)
16 1     1   12 {
  1         3  
  1         145  
17 2         4 no strict 'refs';
  2         16  
  2         4  
18             *{$mpkg."::$attr"} = \&{$attr};
19             }
20             else
21 2         5 {
22 2         4 my $get_name = $mpkg."::get$attr";
23             my $set_name = $mpkg."::set$attr";
24 118     118   463 my $get_sub = sub {
25 2         9 return $_[0]->{$attr};
26             };
27 6     6   21 my $set_sub = sub {
28 2         7 return $_[0]->{$attr} = $_[1];
29             };
30              
31 1     1   5 {
  1         3  
  1         234  
  2         3  
32 2         12 no strict 'refs';
33 2         10 *$get_name = $get_sub;
34 2         4 *$set_name = $set_sub;
  2         389  
35             push(@{$pkg."::ISA"}, $mpkg);
36             }
37             }
38             }
39             }
40              
41             sub new
42 6     6 0 16 {
43             my $pkg = shift;
44 6         22  
45             my $self = bless {}, $pkg;
46 6         66  
47             $self->init(@_);
48 6         18  
49             return $self;
50             }
51              
52             sub init
53 6     6 0 134 {
54             my $self = shift;
55 6         60  
56             while (@_)
57 0   0       {
58             my $name = shift || confess("No name");
59 0            
60 0           my $method = "set$name";
61             $self->$method(shift);
62             }
63             }
64              
65             1;