File Coverage

blib/lib/WWW/GoDaddy/REST/Util.pm
Criterion Covered Total %
statement 69 72 95.8
branch 13 14 92.8
condition 10 11 90.9
subroutine 13 13 100.0
pod 7 7 100.0
total 112 117 95.7


line stmt bran cond sub pod time code
1             package WWW::GoDaddy::REST::Util;
2              
3 5     5   17003 use strict;
  5         8  
  5         178  
4 5     5   21 use warnings;
  5         7  
  5         115  
5              
6 5     5   3152 use JSON qw();
  5         51315  
  5         197  
7 5         60 use Sub::Exporter -setup => {
8             exports => [
9             qw( abs_url
10             add_filters_to_url
11             build_complex_query_url
12             is_json
13             json_decode
14             json_encode
15             json_instance
16             )
17             ]
18 5     5   669 };
  5         8595  
19 5     5   2823 use URI;
  5         3674  
  5         96  
20 5     5   499 use URI::QueryParam;
  5         502  
  5         2775  
21              
22             sub is_json {
23 42     42 1 10669 my $json = shift;
24 42         106 my $handler = json_instance(@_);
25              
26 42         69 eval { my $perl = json_decode($json); };
  42         111  
27 42 100       109 if ($@) {
28 26         84 return 0;
29             }
30             else {
31 16         60 return 1;
32             }
33             }
34              
35             sub json_encode {
36 65     65 1 21003359 my $perl = shift;
37 65         135 my $handler = json_instance(@_);
38 65         861 return $handler->encode($perl);
39             }
40              
41             sub json_decode {
42 90     90 1 1346 my $json = shift;
43 90         162 my $handler = json_instance(@_);
44 90         2064 return $handler->decode($json);
45             }
46              
47             sub json_instance {
48              
49 225     225 1 1084 my $inst = JSON->new;
50              
51 225 100 66     860 if ( @_ == 1 && UNIVERSAL::isa( $_[0], "JSON" ) ) {
    50          
52 28         94 return $_[0];
53             }
54             elsif (@_) {
55 0         0 while ( my ( $key, $value ) = each %{@_} ) {
  0         0  
56 0         0 $inst->property( $key => $value );
57             }
58             }
59             else {
60 197         544 $inst->convert_blessed(1);
61 197         400 $inst->allow_nonref(1);
62             }
63 197         297 return $inst;
64             }
65              
66             sub abs_url {
67 168     168 1 11257 my $api_base = shift;
68 168         190 my $url = shift;
69              
70 168         236 $url =~ s|^/||;
71 168         1132 $api_base =~ s|/*$|/|;
72              
73 168         845 return URI->new_abs( $url, $api_base );
74             }
75              
76             sub add_filters_to_url {
77 38     38 1 11327 my ( $url, $filters ) = @_;
78              
79 38         174 my $uri = URI->new($url);
80 38         3420 foreach my $field ( sort keys %{$filters} ) {
  38         184  
81 20         173 my $field_filters = $filters->{$field};
82              
83 20 100       54 next unless $field_filters;
84              
85 19 100       78 if ( ref($field_filters) eq 'ARRAY' ) {
86              
87             # a query could look like so:
88             # {
89             # 'myField' => [
90             # { modifier => 'ne', value => 'apple' },
91             # { value => 'orange' } # implicit 'eq'
92             # ]
93             # }
94 5         6 foreach my $filter ( @{$field_filters} ) {
  5         10  
95 6   100     73 my $modifier = $filter->{modifier} || 'eq';
96 6         8 my $value = $filter->{value};
97 6 100       11 if ( $modifier eq 'eq' ) {
98 3         9 $uri->query_param_append( $field => $value );
99             }
100             else {
101 3         17 $uri->query_param_append( sprintf( '%s_%s', $field, $modifier ) => $value );
102             }
103             }
104             }
105             else {
106              
107             # a query could look like so:
108             # {
109             # 'myField' => 'apple'
110             # }
111 14         87 $uri->query_param_append( $field => $field_filters );
112             }
113             }
114 38         1741 return $uri->as_string;
115             }
116              
117             sub build_complex_query_url {
118 30     30 1 17106 my ( $url, $filter, $params ) = @_;
119              
120 30   100     93 $filter ||= {};
121 30   100     133 $params ||= {};
122              
123 30         70 $url = add_filters_to_url( $url, $filter );
124              
125 30 100       190 if ( exists $params->{'sort'} ) {
126 4   100     13 $params->{'order'} ||= 'asc';
127             }
128              
129 30         92 my $uri = URI->new($url);
130 30         1313 while ( my ( $key, $value ) = each %{$params} ) {
  38         1040  
131 8         24 $uri->query_param( $key => $value );
132             }
133              
134 30         93 return $uri->as_string;
135              
136             }
137              
138             1;
139              
140             =head1 NAME
141              
142             WWW::GoDaddy::REST::Util - Mostly URL tweaking utilities for this package
143              
144             =head1 SYNOPSIS
145              
146             use WWW::GoDaddy::REST::Util qw/ abs_url add_filters_to_url /;
147              
148             # http://example.com/v1/asdf
149             abs_url('http://example.com/v1','/asdf');
150              
151             # http://example.com?sort=asc&fname=Fred
152             add_filters_to_url('http://example.com?sort=asc',{ 'fname' => [ { 'value': 'Fred' } ] });
153              
154             =head1 DESCRIPTION
155              
156             Utilities used commonly in this package. Most have to do with URL manipulation.
157              
158             =head1 FUNCTIONS
159              
160             =over 4
161              
162             =item is_json
163              
164             Given a json string, return true if it is parsable, false otherwise.
165              
166             If you need to control the parameters to the L<JSON> module, simply
167             pass additional parameters. These will be passed unchanged to C<json_instance>.
168              
169             Example:
170              
171             my $yes = is_json('"asdf"');
172             my $yes = is_json('{"key":"value"}');
173             my $no = is_json('dafsafsadfsdaf');
174              
175             =item json_decode
176              
177             Given a json string, return the perl data structure. This will C<die()> if it
178             can not be parsed.
179              
180             If you need to control the parameters to the L<JSON> module, simply
181             pass additional parameters. These will be passed unchanged to C<json_instance>.
182              
183             Example:
184              
185             my $hashref = json_decode('{"key":"value"}');
186              
187             =item json_encode
188              
189             Given a perl data structure, return the json string. This will C<die()> if it
190             can not be serialized.
191              
192             If you need to control the parameters to the L<JSON> module, simply
193             pass additional parameters. These will be passed unchanged to C<json_instance>.
194              
195             Example:
196              
197             my $json = json_encode({ 'key' => 'value' });
198              
199             =item json_instance
200              
201             Returns C<JSON> instance. If no parameters are given the following
202             defaults are set: C<convert_blessed>, C<allow_nonref>.
203              
204             If called with one parameter, it is assumed to be a C<JSON> instance
205             and this is returned instead of building a new one.
206              
207             If called with more than one parameter, it is assumed to be key/value
208             pairs and will be passed to the JSON C<property> method two by two.
209              
210             Example:
211              
212             $j = json_instance(); #defaults
213             $j = json_instance( JSON->new ); #pass through
214             $j = json_instance( 'convert_blessed' => 1, 'allow_nonref' => 1 ); # set properies
215              
216             =item abs_url
217              
218             Given a base and path fragment, generate an absolute url with the two
219             joined.
220              
221             Example:
222              
223             # http://example.com/v1/asdf
224             abs_url('http://example.com/v1','/asdf');
225              
226             =item add_filters_to_url
227              
228             Given a url and a query filter, generate a url with the filter
229             query parameters added.
230              
231             Filter syntax can be seen in the docs for L<WWW::GoDaddy::REST>.
232              
233             Example:
234              
235             add_filters_to_url('http://example.com?sort=asc',{ 'fname' => [ { 'value': 'Fred' } ] });
236             # http://example.com?sort=asc&fname=Fred
237              
238             =item build_complex_query_url
239              
240             Return a modified URL string given a URL, an optional filter spec, and optional
241             query parameter hash.
242              
243             If you specify a sort, then an order parameter will be filled in if not present, and
244             and sort or order query parameters in the input string will be replaced.
245              
246             All other query parameters (filters etc) will be appended to the query parameters
247             of the input URL instead of replacing.
248              
249             Example:
250              
251             build_complex_query_url(
252             'http://example.com',
253             {
254             'foo' => 'bar'
255             },
256             {
257             'sort' => 'surname'
258             }
259             );
260             # http://example.com?foo=bar&sort=surname&order=asc
261              
262             =back
263              
264             =head1 EXPORTS
265              
266             None by default.
267              
268             =head1 AUTHOR
269              
270             David Bartle, C<< <davidb@mediatemple.net> >>
271              
272             =head1 COPYRIGHT & LICENSE
273              
274             Copyright (c) 2014 Go Daddy Operating Company, LLC
275              
276             Permission is hereby granted, free of charge, to any person obtaining a
277             copy of this software and associated documentation files (the "Software"),
278             to deal in the Software without restriction, including without limitation
279             the rights to use, copy, modify, merge, publish, distribute, sublicense,
280             and/or sell copies of the Software, and to permit persons to whom the
281             Software is furnished to do so, subject to the following conditions:
282              
283             The above copyright notice and this permission notice shall be included in
284             all copies or substantial portions of the Software.
285              
286             THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
287             IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
288             FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
289             THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
290             LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
291             FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
292             DEALINGS IN THE SOFTWARE.
293              
294             =cut
295