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