File Coverage

blib/lib/Class/Accessor/Chained.pm
Criterion Covered Total %
statement 13 22 59.1
branch 2 4 50.0
condition n/a
subroutine 4 6 66.7
pod n/a
total 19 32 59.4


line stmt bran cond sub pod time code
1 2     2   31 use strict;
  2         26  
  2         32  
2             package Class::Accessor::Chained;
3 2     2   42 use base 'Class::Accessor';
  2         17  
  2         37  
4             our $VERSION = '0.01';
5              
6             sub make_accessor {
7 3     3   300     my($class, $field) = @_;
8              
9             # Build a closure around $field.
10                 return sub {
11 5     5   68         my($self) = shift;
12              
13 5 100       50         if (@_) {
14 4         60             $self->set($field, @_);
15 4         102             return $self;
16                     }
17                     else {
18 1         29             return $self->get($field);
19                     }
20 3         51     };
21             }
22              
23             sub make_wo_accessor {
24 0     0         my($class, $field) = @_;
25              
26                 return sub {
27 0     0             my($self) = shift;
28              
29 0 0                 unless (@_) {
30 0                       my $caller = caller;
31 0                       require Carp;
32 0                       Carp::croak("'$caller' cannot access the value of '$field' on ".
33                                     "objects of class '$class'");
34                     }
35                     else {
36 0                       $self->set($field, @_);
37 0                       return $self;
38                     }
39 0               };
40             }
41              
42             1;
43             __END__
44            
45             =head1 NAME
46            
47             Class::Accessor::Chained - make chained accessors
48            
49             =head1 SYNOPSIS
50            
51             package Foo;
52             use base qw( Class::Accessor::Chained );
53             __PACKAGE__->mk_accessors(qw( foo bar baz ));
54            
55             my $foo = Foo->new->foo(1)->bar(2)->baz(4);
56             print $foo->bar; # prints 2
57            
58             =head1 DESCRIPTION
59            
60             A chained accessor is one that always returns the object when called
61             with parameters (to set), and the value of the field when called with
62             no arguments.
63            
64             This module subclasses Class::Accessor in order to provide the same
65             mk_accessors interface.
66            
67             =head1 AUTHOR
68            
69             Richard Clamp <richardc@unixbeard.net>
70            
71             =head1 COPYRIGHT
72            
73             Copyright (C) 2003 Richard Clamp. All Rights Reserved.
74            
75             This module is free software; you can redistribute it and/or modify it
76             under the same terms as Perl itself.
77            
78             =head1 SEE ALSO
79            
80             L<Class::Accessor>, L<Class::Accessor::Chained::Fast>
81            
82             =cut
83