File Coverage

blib/lib/Data/Transpose/Group.pm
Criterion Covered Total %
statement 28 30 93.3
branch 5 6 83.3
condition 1 3 33.3
subroutine 7 8 87.5
pod 2 2 100.0
total 43 49 87.7


line stmt bran cond sub pod time code
1             package Data::Transpose::Group;
2              
3 8     8   12779 use strict;
  8         7  
  8         184  
4 8     8   22 use warnings;
  8         5  
  8         168  
5              
6             =head1 NAME
7              
8             Data::Transpose::Group - Group class for Data::Transpose
9              
10             =head1 SYNOPSIS
11              
12             $group = $tp->group('fullname', $tp->field('firstname'),
13             $tp->field('lastname'));
14            
15             =head1 METHODS
16              
17             =head2 new
18              
19             $group = Data::Transpose::Group->new(name => 'mygroup',
20             objects => [$field_one, $field_two]);
21              
22             =cut
23              
24 8     8   446 use Moo;
  8         9336  
  8         29  
25 8     8   3369 use MooX::Types::MooseLike::Base qw(:all);
  8         4152  
  8         2147  
26 8     8   442 use namespace::clean;
  8         8328  
  8         37  
27              
28             has name => (is => 'rw',
29             required => 1,
30             isa => Str);
31              
32             has objects => (is => 'ro',
33             isa => ArrayRef[Object],
34             required => 1);
35              
36             has join => (is => 'rw',
37             default => sub { ' ' },
38             isa => Str);
39              
40             has _output => (is => 'rwp',
41             isa => Str,
42             );
43              
44             has target => (is => 'rw');
45              
46             =head2 name
47              
48             Set name of the group:
49              
50             $group->name('fullname');
51              
52             Get name of the group:
53              
54             $group->name;
55              
56             =head2 objects
57              
58             Passed only to the constructor. Arrayref with the field objects.
59              
60             =cut
61              
62             sub _return_object_on_set {
63 23     23   1696 my ($orig, $self, $name) = @_;
64 23 100       59 if (defined $name) {
65 6         48 $orig->($self, $name);
66 6         125 return $self;
67             }
68 17         166 return $orig->($self);
69             }
70              
71             around name => \&_return_object_on_set;
72              
73              
74             =head2 fields
75              
76             Returns field objects for this group:
77              
78             $group->fields;
79              
80             =cut
81              
82             sub fields {
83 0     0 1 0 return shift->objects;
84             }
85              
86             =head2 join
87              
88             Set string for joining field values:
89              
90             $group->join(',');
91              
92             Get string for joining field values:
93              
94             $group->join;
95              
96             The default string is a single blank character.
97              
98             =cut
99              
100             around join => \&_return_object_on_set;
101             around target => \&_return_object_on_set;
102              
103             =head2 value
104              
105             Returns value for output:
106            
107             $output = $group->value;
108              
109             With undefined argument, does not set the output to undef (because a
110             group always output a string), but apply the joining.
111              
112             With a defined argument, does not perform the joining, but set the
113             output value.
114              
115             =cut
116              
117             sub value {
118 4     4 1 3 my $self = shift;
119 4         4 my $token;
120            
121 4 50 33     15 if (@_ and defined($_[0])) {
122 0         0 $self->_set__output(shift);
123             }
124             else {
125             # combine field values
126             $self->_set__output(CORE::join($self->join,
127 8         11 map {my $value = $_->value;
128 8 100       54 defined $value ? $value : '';
129 4         62 } @{$self->objects}));
  4         20  
130             }
131            
132 4         498 return $self->_output;
133             }
134              
135             =head2 target
136              
137             Set target name for target operation:
138              
139             $group->target('name');
140              
141             Get target name:
142              
143             $group->target;
144              
145             =cut
146              
147              
148             =head1 LICENSE AND COPYRIGHT
149              
150             Copyright 2012-2016 Stefan Hornburg (Racke) .
151              
152             This program is free software; you can redistribute it and/or modify it
153             under the terms of either: the GNU General Public License as published
154             by the Free Software Foundation; or the Artistic License.
155              
156             See http://dev.perl.org/licenses/ for more information.
157              
158             =cut
159              
160             1;