File Coverage

blib/lib/DBI/Util/_accessor.pm
Criterion Covered Total %
statement 37 39 94.8
branch 7 14 50.0
condition 6 13 46.1
subroutine 10 10 100.0
pod 0 5 0.0
total 60 81 74.0


line stmt bran cond sub pod time code
1             package DBI::Util::_accessor;
2 56     56   372 use strict;
  56         106  
  56         1396  
3 56     56   250 use Carp;
  56         92  
  56         11718  
4             our $VERSION = "0.009479";
5              
6             # inspired by Class::Accessor::Fast
7              
8             sub new {
9 7225     7225 0 12530 my($proto, $fields) = @_;
10 7225   33     19872 my($class) = ref $proto || $proto;
11 7225   50     13165 $fields ||= {};
12              
13 7225   33     22531 my @dubious = grep { !m/^_/ && !$proto->can($_) } keys %$fields;
  40378         172522  
14 7225 50       16871 carp "$class doesn't have accessors for fields: @dubious" if @dubious;
15              
16             # make a (shallow) copy of $fields.
17 7225         39376 bless {%$fields}, $class;
18             }
19              
20             sub mk_accessors {
21 352     352 0 1382 my($self, @fields) = @_;
22 352         1783 $self->mk_accessors_using('make_accessor', @fields);
23             }
24              
25             sub mk_accessors_using {
26 520     520 0 1383 my($self, $maker, @fields) = @_;
27 520   33     2003 my $class = ref $self || $self;
28              
29             # So we don't have to do lots of lookups inside the loop.
30 520 50       3892 $maker = $self->can($maker) unless ref $maker;
31              
32 56     56   351 no strict 'refs';
  56         114  
  56         11813  
33 520         1295 foreach my $field (@fields) {
34 2880         4530 my $accessor = $self->$maker($field);
35 2880         9081 *{$class."\:\:$field"} = $accessor
36 2880 50       3819 unless defined &{$class."\:\:$field"};
  2880         10646  
37             }
38             #my $hash_ref = \%{$class."\:\:_accessors_hash};
39             #$hash_ref->{$_}++ for @fields;
40             # XXX also copy down _accessors_hash of base class(es)
41             # so one in this class is complete
42 520         1553 return;
43             }
44              
45             sub make_accessor {
46 2712     2712 0 4145 my($class, $field) = @_;
47             return sub {
48 262098     262098   332092 my $self = shift;
49 262098 100       790999 return $self->{$field} unless @_;
50 41325 50       67107 croak "Too many arguments to $field" if @_ > 1;
51 41325         145146 return $self->{$field} = shift;
52 2712         8315 };
53             }
54              
55             sub make_accessor_autoviv_hashref {
56 168     168 0 348 my($class, $field) = @_;
57             return sub {
58 200     200   2160 my $self = shift;
59 200 50 100     685 return $self->{$field} ||= {} unless @_;
60 0 0         croak "Too many arguments to $field" if @_ > 1;
61 0           return $self->{$field} = shift;
62 168         638 };
63             }
64              
65             1;