| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package WWW::GoDaddy::REST::Util; | 
| 2 |  |  |  |  |  |  |  | 
| 3 | 2 |  |  | 2 |  | 16711 | use strict; | 
|  | 2 |  |  |  |  | 4 |  | 
|  | 2 |  |  |  |  | 89 |  | 
| 4 | 2 |  |  | 2 |  | 9 | use warnings; | 
|  | 2 |  |  |  |  | 3 |  | 
|  | 2 |  |  |  |  | 60 |  | 
| 5 |  |  |  |  |  |  |  | 
| 6 | 2 |  |  | 2 |  | 1711 | use JSON qw(); | 
|  | 2 |  |  |  |  | 29214 |  | 
|  | 2 |  |  |  |  | 102 |  | 
| 7 | 2 |  |  |  |  | 21 | 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 | 2 |  |  | 2 |  | 5680 | }; | 
|  | 2 |  |  |  |  | 10265 |  | 
| 19 | 2 |  |  | 2 |  | 1509 | use URI; | 
|  | 2 |  |  |  |  | 3571 |  | 
|  | 2 |  |  |  |  | 50 |  | 
| 20 | 2 |  |  | 2 |  | 1349 | use URI::QueryParam; | 
|  | 2 |  |  |  |  | 1096 |  | 
|  | 2 |  |  |  |  | 1114 |  | 
| 21 |  |  |  |  |  |  |  | 
| 22 |  |  |  |  |  |  | sub is_json { | 
| 23 | 4 |  |  | 4 | 1 | 3846 | my $json    = shift; | 
| 24 | 4 |  |  |  |  | 12 | my $handler = json_instance(@_); | 
| 25 |  |  |  |  |  |  |  | 
| 26 | 4 |  |  |  |  | 8 | eval { my $perl = json_decode($json); }; | 
|  | 4 |  |  |  |  | 36 |  | 
| 27 | 4 | 100 |  |  |  | 12 | if ($@) { | 
| 28 | 1 |  |  |  |  | 5 | return 0; | 
| 29 |  |  |  |  |  |  | } | 
| 30 |  |  |  |  |  |  | else { | 
| 31 | 3 |  |  |  |  | 14 | return 1; | 
| 32 |  |  |  |  |  |  | } | 
| 33 |  |  |  |  |  |  | } | 
| 34 |  |  |  |  |  |  |  | 
| 35 |  |  |  |  |  |  | sub json_encode { | 
| 36 | 3 |  |  | 3 | 1 | 6 | my $perl    = shift; | 
| 37 | 3 |  |  |  |  | 7 | my $handler = json_instance(@_); | 
| 38 | 3 |  |  |  |  | 59 | return $handler->encode($perl); | 
| 39 |  |  |  |  |  |  | } | 
| 40 |  |  |  |  |  |  |  | 
| 41 |  |  |  |  |  |  | sub json_decode { | 
| 42 | 7 |  |  | 7 | 1 | 1404 | my $json    = shift; | 
| 43 | 7 |  |  |  |  | 12 | my $handler = json_instance(@_); | 
| 44 | 7 |  |  |  |  | 94 | return $handler->decode($json); | 
| 45 |  |  |  |  |  |  | } | 
| 46 |  |  |  |  |  |  |  | 
| 47 |  |  |  |  |  |  | sub json_instance { | 
| 48 |  |  |  |  |  |  |  | 
| 49 | 14 |  |  | 14 | 1 | 80 | my $inst = JSON->new; | 
| 50 |  |  |  |  |  |  |  | 
| 51 | 14 | 50 | 33 |  |  | 61 | if ( @_ == 1 && UNIVERSAL::isa( $_[0], "JSON" ) ) { | 
|  |  | 50 |  |  |  |  |  | 
| 52 | 0 |  |  |  |  | 0 | 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 | 14 |  |  |  |  | 47 | $inst->convert_blessed(1); | 
| 61 | 14 |  |  |  |  | 34 | $inst->allow_nonref(1); | 
| 62 |  |  |  |  |  |  | } | 
| 63 | 14 |  |  |  |  | 27 | return $inst; | 
| 64 |  |  |  |  |  |  | } | 
| 65 |  |  |  |  |  |  |  | 
| 66 |  |  |  |  |  |  | sub abs_url { | 
| 67 | 7 |  |  | 7 | 1 | 11053 | my $api_base = shift; | 
| 68 | 7 |  |  |  |  | 10 | my $url      = shift; | 
| 69 |  |  |  |  |  |  |  | 
| 70 | 7 |  |  |  |  | 21 | $url      =~ s|^/||; | 
| 71 | 7 |  |  |  |  | 44 | $api_base =~ s|/*$|/|; | 
| 72 |  |  |  |  |  |  |  | 
| 73 | 7 |  |  |  |  | 26 | return URI->new_abs( $url, $api_base ); | 
| 74 |  |  |  |  |  |  | } | 
| 75 |  |  |  |  |  |  |  | 
| 76 |  |  |  |  |  |  | sub add_filters_to_url { | 
| 77 | 15 |  |  | 15 | 1 | 14596 | my ( $url, $filters ) = @_; | 
| 78 |  |  |  |  |  |  |  | 
| 79 | 15 |  |  |  |  | 60 | my $uri = URI->new($url); | 
| 80 | 15 |  |  |  |  | 916 | foreach my $field ( sort keys %{$filters} ) { | 
|  | 15 |  |  |  |  | 63 |  | 
| 81 | 9 |  |  |  |  | 73 | my $field_filters = $filters->{$field}; | 
| 82 |  |  |  |  |  |  |  | 
| 83 | 9 | 100 |  |  |  | 24 | next unless $field_filters; | 
| 84 |  |  |  |  |  |  |  | 
| 85 | 8 | 100 |  |  |  | 22 | 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 | 4 |  |  |  |  | 4 | foreach my $filter ( @{$field_filters} ) { | 
|  | 4 |  |  |  |  | 10 |  | 
| 95 | 5 |  | 100 |  |  | 74 | my $modifier = $filter->{modifier} || 'eq'; | 
| 96 | 5 |  |  |  |  | 4 | my $value = $filter->{value}; | 
| 97 | 5 | 100 |  |  |  | 12 | if ( $modifier eq 'eq' ) { | 
| 98 | 2 |  |  |  |  | 8 | $uri->query_param_append( $field => $value ); | 
| 99 |  |  |  |  |  |  | } | 
| 100 |  |  |  |  |  |  | else { | 
| 101 | 3 |  |  |  |  | 14 | $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 | 4 |  |  |  |  | 27 | $uri->query_param_append( $field => $field_filters ); | 
| 112 |  |  |  |  |  |  | } | 
| 113 |  |  |  |  |  |  | } | 
| 114 | 15 |  |  |  |  | 656 | return $uri->as_string; | 
| 115 |  |  |  |  |  |  | } | 
| 116 |  |  |  |  |  |  |  | 
| 117 |  |  |  |  |  |  | sub build_complex_query_url { | 
| 118 | 7 |  |  | 7 | 1 | 14160 | my ( $url, $filter, $params ) = @_; | 
| 119 |  |  |  |  |  |  |  | 
| 120 | 7 |  | 100 |  |  | 31 | $filter ||= {}; | 
| 121 | 7 |  | 100 |  |  | 20 | $params ||= {}; | 
| 122 |  |  |  |  |  |  |  | 
| 123 | 7 |  |  |  |  | 17 | $url = add_filters_to_url( $url, $filter ); | 
| 124 |  |  |  |  |  |  |  | 
| 125 | 7 | 100 |  |  |  | 40 | if ( exists $params->{'sort'} ) { | 
| 126 | 4 |  | 100 |  |  | 15 | $params->{'order'} ||= 'asc'; | 
| 127 |  |  |  |  |  |  | } | 
| 128 |  |  |  |  |  |  |  | 
| 129 | 7 |  |  |  |  | 16 | my $uri = URI->new($url); | 
| 130 | 7 |  |  |  |  | 271 | while ( my ( $key, $value ) = each %{$params} ) { | 
|  | 15 |  |  |  |  | 1138 |  | 
| 131 | 8 |  |  |  |  | 31 | $uri->query_param( $key => $value ); | 
| 132 |  |  |  |  |  |  | } | 
| 133 |  |  |  |  |  |  |  | 
| 134 | 7 |  |  |  |  | 19 | 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 |  |  |  |  |  |  |  |