File Coverage

blib/lib/Class/Tiny/Chained.pm
Criterion Covered Total %
statement 14 16 87.5
branch 2 4 50.0
condition 1 3 33.3
subroutine 4 4 100.0
pod n/a
total 21 27 77.7


line stmt bran cond sub pod time code
1             package Class::Tiny::Chained;
2              
3 1     1   5140 use strict;
  1         2  
  1         30  
4 1     1   5 use warnings;
  1         2  
  1         28  
5 1     1   6 use Class::Tiny ();
  1         2  
  1         186  
6             our @ISA = 'Class::Tiny';
7              
8             our $VERSION = '0.002';
9              
10             sub __gen_sub_body {
11 3     3   597 my ($self, $name, $has_default, $default_type) = @_;
12            
13 3         6 my $sub = "sub $name { if (\@_ == 1) {";
14            
15 3 50 33     14 if ($has_default && $default_type eq 'CODE') {
    50          
16 0         0 $sub .= "if ( !exists \$_[0]{$name} ) { \$_[0]{$name} = \$default->(\$_[0]) }";
17             }
18             elsif ($has_default) {
19 0         0 $sub .= "if ( !exists \$_[0]{$name} ) { \$_[0]{$name} = \$default }";
20             }
21            
22 3         11 $sub .= "return \$_[0]{$name} } else { \$_[0]{$name}=\$_[1]; return \$_[0] } }";
23            
24 3         8 return $sub;
25             }
26              
27             1;
28              
29             =head1 NAME
30              
31             Class::Tiny::Chained - Minimalist class construction, with chained attributes
32              
33             =head1 SYNOPSIS
34              
35             In I:
36              
37             package Person;
38            
39             use Class::Tiny::Chained qw( name );
40            
41             1;
42              
43             In I:
44              
45             package Employee;
46             use parent 'Person';
47            
48             use Class::Tiny::Chained qw( ssn ), {
49             timestamp => sub { time } # attribute with default
50             };
51            
52             1;
53              
54             In I:
55              
56             use Employee;
57            
58             my $obj = Employee->new( name => "Larry", ssn => "111-22-3333" );
59            
60             # attribute setters are chainable
61             my $obj = Employee->new->name("Fred")->ssn("444-55-6666");
62             my $ts = $obj->name("Bob")->timestamp;
63              
64             =head1 DESCRIPTION
65              
66             L is a wrapper around L which makes the
67             generated attribute accessors chainable; that is, when setting an attribute
68             value, the object is returned so that further methods can be called.
69              
70             =head1 BUGS
71              
72             Report any issues on the public bugtracker.
73              
74             =head1 AUTHOR
75              
76             Dan Book
77              
78             =head1 COPYRIGHT AND LICENSE
79              
80             This software is Copyright (c) 2015 by Dan Book.
81              
82             This is free software, licensed under:
83              
84             The Artistic License 2.0 (GPL Compatible)
85              
86             =head1 SEE ALSO
87              
88             L, L