File Coverage

blib/lib/Data/Record/Serialize/Role/Default.pm
Criterion Covered Total %
statement 21 21 100.0
branch 1 2 50.0
condition n/a
subroutine 10 10 100.0
pod 1 3 33.3
total 33 36 91.6


line stmt bran cond sub pod time code
1              
2             # ABSTRACT: Default methods for Data::Record::Serialize
3              
4             use Moo::Role;
5 18     18   8650  
  18         38  
  18         107  
6             our $VERSION = '1.03'; # TRIAL
7              
8             use Hash::Util qw[ hv_store ];
9 18     18   14820 use Ref::Util qw[ is_coderef ];
  18         46088  
  18         114  
10 18     18   1442  
  18         43  
  18         880  
11             use Data::Record::Serialize::Error { errors => [ 'fields' ] }, -all;
12 18     18   96  
  18         42  
  18         231  
13             use namespace::clean;
14 18     18   2232  
  18         38  
  18         112  
15              
16              
17              
18              
19              
20              
21              
22              
23              
24              
25              
26              
27              
28              
29              
30              
31              
32              
33              
34             # provide default if not already defined
35             my $self = shift;
36              
37 38     38 1 187 $self->_needs_eol
38             ? $self->say( $self->encode( @_ ) )
39 38 50       118 : $self->print( $self->encode( @_ ) );
40             }
41              
42             # just in case they're not defined in preceding roles
43              
44             around 'setup' => sub {
45       50 0   my ( $orig, $self, $data ) = @_;
46       108      
47 3     3   12 # if fields has not been set yet, set it to the names in the data
48             $self->_set_fields( [ keys %$data ] )
49             unless $self->has_fields;
50              
51             # make sure there are no duplicate output fields
52             my %dups;
53             $dups{$_}++ && error( fields => "duplicate output field: $_" ) for@{$self->fields};
54              
55             if ( $self->has_default_type ) {
56             $self->_set_types_from_default;
57             }
58             else {
59             $self->_set_types_from_record( $data );
60             }
61              
62             # trigger building of output_types, which also remaps types. ick.
63             $self->output_types;
64              
65             $orig->( $self );
66              
67             $self->_set__run_setup( 0 );
68             };
69              
70              
71             before 'send' => sub {
72             my ( $self, $data ) = @_;
73              
74             # can't do format or numify until we have types, which might need to
75             # be done from the data, which will be done in setup.
76              
77             $self->setup( $data )
78             if $self->_run_setup;
79              
80             # remove fields that won't be output
81             delete @{$data}{ grep { !exists $self->_fieldh->{$_} } keys %{$data} };
82              
83             # nullify fields (set to undef) those that are zero length
84              
85             if ( defined( my $fields = $self->_nullified ) ) {
86             $data->{$_} = undef
87             for grep { defined $data->{$_} && !length $data->{$_} } @$fields;
88             }
89              
90             if ( defined( my $fields = $self->_numified ) ) {
91             $data->{$_} = ( $data->{$_} || 0 ) + 0
92             for grep { defined $data->{$_} } @{$fields};
93             }
94              
95             if ( defined( my $fields = $self->_stringified ) ) {
96             $data->{$_} = "@{[ $data->{$_}]}"
97             for grep { defined $data->{$_} } @{$fields};
98             }
99              
100             if ( my $format = $self->_format ) {
101             $data->{$_}
102             = is_coderef( $format->{$_} )
103             ? $format->{$_}( $data->{$_} )
104             : sprintf( $format->{$_}, $data->{$_} )
105             foreach grep { defined $data->{$_} && length $data->{$_} }
106             keys %{$format};
107             }
108              
109              
110             # handle boolean
111             if ( $self->_boolify ) {
112             my @fields = grep { exists $data->{$_} } @{ $self->boolean_fields };
113              
114             if ( $self->_can_bool ) {
115             $data->{$_} = $self->to_bool( $data->{$_} ) for @fields;
116             }
117              
118             # the encoder doesn't have native boolean, must convert a
119             # truthy value to 0/1;
120             else {
121             $data->{$_} = $data->{$_} ? 1 : 0 foreach @fields;
122             }
123             }
124              
125             if ( my $rename = $self->rename_fields ) {
126             for my $from ( @{ $self->fields } ) {
127             my $to = $rename->{$from}
128             or next;
129              
130             hv_store( %$data, $to, $data->{$from} );
131             delete $data->{$from};
132             }
133             }
134             };
135              
136             my ( $self, $in_global_destruction ) = @_;
137              
138             # we can't make the decision about whether to pay attention during
139             # Global Destruction. the objects have to do that
140             $self->close( $in_global_destruction );
141             return;
142 56     56 0 144559 }
143              
144             1;
145              
146 56         251 #
147 56         790 # This file is part of Data-Record-Serialize
148             #
149             # This software is Copyright (c) 2017 by Smithsonian Astrophysical Observatory.
150             #
151             # This is free software, licensed under:
152             #
153             # The GNU General Public License, Version 3, June 2007
154             #
155              
156              
157             =pod
158              
159             =for :stopwords Diab Jerius Smithsonian Astrophysical Observatory
160              
161             =head1 NAME
162              
163             Data::Record::Serialize::Role::Default - Default methods for Data::Record::Serialize
164              
165             =head1 VERSION
166              
167             version 1.03
168              
169             =head1 DESCRIPTION
170              
171             C<Data::Record::Serialize::Role::Default> provides default methods for
172             L<Data::Record::Serialize>. It is applied after all of the other roles to
173             ensure that other roles' methods have priority.
174              
175             =head1 METHODS
176              
177             =head2 B<send>
178              
179             $s->send( \%record );
180              
181             Encode and send the record to the associated sink.
182              
183             B<WARNING>: the passed hash is modified. If you need the original
184             contents, pass in a copy.
185              
186             =for Pod::Coverage cleanup
187             send
188             setup
189             DEMOLISH
190              
191             =head1 SUPPORT
192              
193             =head2 Bugs
194              
195             Please report any bugs or feature requests to bug-data-record-serialize@rt.cpan.org or through the web interface at: https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Record-Serialize
196              
197             =head2 Source
198              
199             Source is available at
200              
201             https://gitlab.com/djerius/data-record-serialize
202              
203             and may be cloned from
204              
205             https://gitlab.com/djerius/data-record-serialize.git
206              
207             =head1 SEE ALSO
208              
209             Please see those modules/websites for more information related to this module.
210              
211             =over 4
212              
213             =item *
214              
215             L<Data::Record::Serialize|Data::Record::Serialize>
216              
217             =back
218              
219             =head1 AUTHOR
220              
221             Diab Jerius <djerius@cpan.org>
222              
223             =head1 COPYRIGHT AND LICENSE
224              
225             This software is Copyright (c) 2017 by Smithsonian Astrophysical Observatory.
226              
227             This is free software, licensed under:
228              
229             The GNU General Public License, Version 3, June 2007
230              
231             =cut