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 2     2   71 #line 1
  2         3  
  2         56  
2 2     2   8 use strict;
  2         3  
  2         199  
3             use warnings;
4              
5             package Test::Deep::MM;
6              
7             sub import
8 2     2   5 {
9             my $self = shift;
10 2         6  
11 2         5 my ($pkg) = caller();
12 2         6 my $mpkg = $pkg."::Methods";
13             foreach my $attr (@_)
14 8 100       25 {
15             if ($attr =~ /^[a-z]/)
16 2     2   11 {
  2         2  
  2         272  
17 4         5 no strict 'refs';
  4         28  
  4         10  
18             *{$mpkg."::$attr"} = \&{$attr};
19             }
20             else
21 4         8 {
22 4         9 my $get_name = $mpkg."::get$attr";
23             my $set_name = $mpkg."::set$attr";
24 220     220   692 my $get_sub = sub {
25 4         14 return $_[0]->{$attr};
26             };
27 6     6   21 my $set_sub = sub {
28 4         11 return $_[0]->{$attr} = $_[1];
29             };
30              
31 2     2   9 {
  2         4  
  2         434  
  4         5  
32 4         19 no strict 'refs';
33 4         17 *$get_name = $get_sub;
34 4         6 *$set_name = $set_sub;
  4         688  
35             push(@{$pkg."::ISA"}, $mpkg);
36             }
37             }
38             }
39             }
40              
41             sub new
42 6     6 0 12 {
43             my $pkg = shift;
44 6         19  
45             my $self = bless {}, $pkg;
46 6         29  
47             $self->init(@_);
48 6         19  
49             return $self;
50             }
51              
52             sub init
53 6     6 0 10 {
54             my $self = shift;
55 6         28  
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;