File Coverage

blib/lib/Test/Run/Sprintf/Named/FromAccessors.pm
Criterion Covered Total %
statement 16 16 100.0
branch 1 2 50.0
condition n/a
subroutine 5 5 100.0
pod 2 2 100.0
total 24 25 96.0


line stmt bran cond sub pod time code
1             package Test::Run::Sprintf::Named::FromAccessors;
2              
3 23     23   167 use strict;
  23         49  
  23         625  
4 23     23   117 use warnings;
  23         53  
  23         645  
5              
6             =head1 NAME
7              
8             Test::Run::Sprintf::Named::FromAccessors - named sprintf according to the
9             values of accessors.
10              
11             =head1 SYNOPSIS
12              
13             my $formatter =
14             Test::Run::Sprintf::Named::FromAccessors->new(
15             {
16             fmt => "Hello %(name)s! Today you are %(age)d years old.",
17             )
18             );
19              
20             my $person1 = Person->new(name => "Larry", age => 24);
21              
22             my $msg1 = $formatter->format({args => { obj => $person1 }});
23              
24             my $person2 = Person->new(name => "Rachel", age => 30);
25              
26             my $msg2 = $formatter->format({args => { obj => $person2 }});
27              
28             =head1 DESCRIPTION
29              
30             This module is a sub-class of L<Text::Sprintf::Named> where the variables
31             inside the sprintf fields (e.g: C<%(varname)s>) are read from the accessors
32             (or any other function) of the current object.
33              
34             =head1 METHODS
35              
36             =cut
37              
38 23     23   105 use Moose;
  23         48  
  23         143  
39              
40             extends('Text::Sprintf::Named');
41              
42              
43             =head2 $formatter->calc_param()
44              
45             Over-riding the behavior of the equivalent one in Text::Sprintf::Named.
46              
47             =cut
48              
49             sub calc_param
50             {
51 219     219 1 8099 my ($self, $args) = @_;
52              
53 219         439 my $method = $args->{name};
54              
55 219         4541 return $args->{named_params}->{obj}->$method();
56             }
57              
58             =head2 $formatter->obj_format($object, \%args)
59              
60             Formats based on the accessors of the object $object. I don't think %args
61             is used in any way.
62              
63             =cut
64              
65             sub obj_format
66             {
67 14     14 1 362 my ($self, $obj, $other_args) = @_;
68              
69 14 50       42 if (!$other_args)
70             {
71 14         33 $other_args = {};
72             }
73              
74 14         133 return $self->format({args => {obj => $obj, %$other_args}});
75             }
76              
77             1;
78              
79             __END__
80              
81             =head1 AUTHOR
82              
83             Written by Shlomi Fish, L<http://www.shlomifish.org/>.
84              
85             =head1 LICENSE
86              
87             This file is licensed under the MIT X11 License:
88              
89             http://www.opensource.org/licenses/mit-license.php
90              
91             =head1 SEE ALSO
92              
93             L<Text::Sprintf::Named> , L<Test::Run>
94