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