File Coverage

blib/lib/accessors/related.pm
Criterion Covered Total %
statement 21 21 100.0
branch 2 2 100.0
condition n/a
subroutine 6 6 100.0
pod 0 1 0.0
total 29 30 96.6


line stmt bran cond sub pod time code
1             package accessors::related;
2              
3 1     1   18726 use strict;
  1         2  
  1         34  
4 1     1   4 use base qw(accessors);
  1         2  
  1         748  
5              
6 1     1   959 use Scalar::Util qw();
  1         6  
  1         54  
7              
8             our $VERSION = '0.00_50';
9              
10             sub create_accessor {
11 1     1 0 2780 my($class, $accessor, $property) = @_;
12 1         2 $property = "-$property";
13 1     1   4 no strict 'refs';
  1         1  
  1         95  
14 1         85 *{$accessor} = sub {
15 3 100   3   804 if (@_ > 1) {
16 1         3 $_[0]->{$property} = $_[1];
17 1         6 Scalar::Util::weaken($_[0]->{$property});
18 1         2 $_[0];
19             } else {
20 2         10 $_[0]->{$property}
21             }
22 1         3 };
23              
24             }
25              
26             1;
27              
28             __END__