File Coverage

blib/lib/Net/Async/Webservice/UPS/Response/Utils.pm
Criterion Covered Total %
statement 21 59 35.5
branch 0 18 0.0
condition 0 6 0.0
subroutine 7 17 41.1
pod 9 9 100.0
total 37 109 33.9


line stmt bran cond sub pod time code
1             package Net::Async::Webservice::UPS::Response::Utils;
2             $Net::Async::Webservice::UPS::Response::Utils::VERSION = '1.1.3';
3             {
4             $Net::Async::Webservice::UPS::Response::Utils::DIST = 'Net-Async-Webservice-UPS';
5             }
6 3     3   18 use strict;
  3         4  
  3         101  
7 3     3   10 use warnings;
  3         3  
  3         159  
8 3     3   71 use 5.010;
  3         10  
  3         151  
9 3         33 use Sub::Exporter -setup => {
10             exports => [qw(img_if pair_if base64_if
11             in_if out_if in_object_if in_object_array_if in_datetime_if
12             set_implied_argument)],
13 3     3   1535 };
  3         24631  
14 3     3   3111 use DateTime::Format::Strptime;
  3         329130  
  3         210  
15 3     3   35 use Module::Runtime 'use_module';
  3         3  
  3         26  
16 3     3   2177 use Scope::Upper qw(reap :words);
  3         2965  
  3         1792  
17              
18             # ABSTRACT: utility functions to parse hashrefs into response objects
19              
20              
21             my $implied_arg;
22              
23             sub set_implied_argument {
24 0     0 1   my ($value) = @_;
25              
26 0           $implied_arg = $value;
27 0     0     reap { undef $implied_arg } UP;
  0            
28             }
29              
30              
31             sub out_if {
32 0     0 1   my ($key,$attr) = @_;
33 0 0         if ($implied_arg->$attr) {
34 0           return ($key => $implied_arg->$attr);
35             }
36 0           return;
37             }
38              
39              
40             sub in_if {
41 0     0 1   my ($attr,$key) = @_;
42 0 0         if ($implied_arg->{$key}) {
43 0           return ($attr => $implied_arg->{$key});
44             }
45 0           return;
46             }
47              
48              
49             sub in_object_if {
50 0     0 1   my ($attr,$key,$class) = @_;
51 0 0         if ($implied_arg->{$key}) {
52 0           return ($attr => use_module($class)->new($implied_arg->{$key}));
53             }
54 0           return;
55             }
56              
57              
58             sub in_object_array_if {
59 0     0 1   my ($attr,$key,$class) = @_;
60 0 0         if ($implied_arg->{$key}) {
61 0           my $arr = $implied_arg->{$key};
62 0 0         if (ref($arr) ne 'ARRAY') { $arr = [ $arr ] };
  0            
63             return (
64 0           $attr => [
65 0           map { use_module($class)->new($_) } @$arr
66             ],
67             );
68             }
69 0           return;
70             }
71              
72              
73             {my $date_parser = DateTime::Format::Strptime->new(
74             pattern => '%Y%m%d%H%M%S',
75             );
76             sub in_datetime_if {
77 0     0 1   my ($attr,$key) = @_;
78 0 0 0       if ($implied_arg->{$key} && $implied_arg->{$key}{Date}) {
79 0           return ( $attr => $date_parser->parse_datetime($implied_arg->{$key}{Date}.$implied_arg->{$key}{Time}) );
80             }
81 0           return;
82             }}
83              
84              
85             sub pair_if {
86 0 0   0 1   return @_ if $_[1];
87 0           return;
88             }
89              
90              
91             sub img_if {
92 0     0 1   my ($key,$hash) = @_;
93 0 0 0       if ($hash && %{$hash}) {
  0            
94 0           require Net::Async::Webservice::UPS::Response::Image;
95 0           return ( $key => Net::Async::Webservice::UPS::Response::Image->new($hash) )
96             }
97 0           return;
98             }
99              
100              
101             sub base64_if {
102 0 0   0 1   return ($_[0],decode_base64($_[1])) if $_[1];
103 0           return;
104             }
105              
106             __END__
107              
108             =pod
109              
110             =encoding UTF-8
111              
112             =head1 NAME
113              
114             Net::Async::Webservice::UPS::Response::Utils - utility functions to parse hashrefs into response objects
115              
116             =head1 VERSION
117              
118             version 1.1.3
119              
120             =head1 DESCRIPTION
121              
122             The functions in this module are mostly for internal use, they may
123             change or be removed without prior notice.
124              
125             =head1 FUNCTIONS
126              
127             =head2 C<set_implied_argument>
128              
129             Sets the ref that most other functions read from. It localises the
130             assignment to the calling frame, so you don't have to remember to
131             unset it.
132              
133             =head2 C<out_if>
134              
135             out_if($key,$attr)
136              
137             If C<< $implied_arg->$attr >> is true, returns C<< $key =>
138             $implied_arg->$attr >>, otherwise returns an empty list.
139              
140             =head2 C<in_if>
141              
142             in_if($attr,$key)
143              
144             If C<< $implied_arg->{$key} >> is true, returns C<< $attr =>
145             $implied_arg->{$key} >>, otherwise returns an empty list.
146              
147             =head2 C<in_object_if>
148              
149             in_object_if($attr,$key,$class)
150              
151             If C<< $implied_arg->{$key} >> is true, returns C<< $attr =>
152             $class->new($implied_arg->{$key}) >>, otherwise returns an empty
153             list. It also loads C<$class> if necessary.
154              
155             =head2 C<in_object_array_if>
156              
157             in_object_array_if($attr,$key,$class)
158              
159             If C<< $implied_arg->{$key} >> is true, maps each of its elements via
160             C<< $class->new($_) >>, and returns C<< $attr => \@mapped_elements >>,
161             otherwise returns an empty list. It also loads C<$class> if necessary.
162              
163             If C<< $implied_arg->{$key} >> is not an array, this function will map
164             C<< [ $implied_arg->{$key} ] >>.
165              
166             =head2 C<in_datetime_if>
167              
168             in_datetime_if($attr,$key)
169              
170             If C<< $implied_arg->{$key} >> is a hashref that contains a C<Date>
171             key, parses the values corresponding to the C<Date> and C<Time> keys,
172             and returns C<< $attr => $parsed_date >>, otherwise returns an empty
173             list.
174              
175             The L<DateTime> object in the returned list will have a floating time
176             zone.
177              
178             =head2 C<pair_if>
179              
180             pair_if($key,$value);
181              
182             If C<$value> is true, returns the arguments, otherwise returns an
183             empty list.
184              
185             This function does not use the implied argument.
186              
187             =head2 C<img_if>
188              
189             img_if($key,$hash);
190              
191             If C<$hash> is a non-empty hashref, coverts it into a
192             L<Net::Async::Webservice::UPS::Response::Image> and returns C<< $key
193             => $image >>, otherwise returns an empty list.
194              
195             This function does not use the implied argument.
196              
197             =head2 C<base64_if>
198              
199             base64_if($key,$string);
200              
201             If C<$string> is true, decodes its contents from Base64 and returns
202             C<< $key => $decoded_string >>, otherwise returns an empty list.
203              
204             This function does not use the implied argument.
205              
206             =head1 AUTHORS
207              
208             =over 4
209              
210             =item *
211              
212             Gianni Ceccarelli <gianni.ceccarelli@net-a-porter.com>
213              
214             =item *
215              
216             Sherzod B. Ruzmetov <sherzodr@cpan.org>
217              
218             =back
219              
220             =head1 COPYRIGHT AND LICENSE
221              
222             This software is copyright (c) 2015 by Gianni Ceccarelli <gianni.ceccarelli@net-a-porter.com>.
223              
224             This is free software; you can redistribute it and/or modify it under
225             the same terms as the Perl 5 programming language system itself.
226              
227             =cut