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