File Coverage

blib/lib/PONAPI/Utils/URI.pm
Criterion Covered Total %
statement 38 38 100.0
branch 8 12 66.6
condition 2 3 66.6
subroutine 7 7 100.0
pod 0 1 0.0
total 55 61 90.1


line stmt bran cond sub pod time code
1             # ABSTRACT: URI utils
2             package PONAPI::Utils::URI;
3              
4 7     7   52 use strict;
  7         16  
  7         219  
5 7     7   37 use warnings;
  7         15  
  7         189  
6              
7 7     7   3966 use URI;
  7         33384  
  7         233  
8 7     7   3259 use URI::QueryParam;
  7         5523  
  7         367  
9 7     7   51 use URI::Escape qw( uri_escape_utf8 );
  7         21  
  7         467  
10              
11 7     7   48 use parent qw< Exporter >;
  7         16  
  7         59  
12             our @EXPORT_OK = qw< to_uri >;
13              
14             sub to_uri {
15 9     9 0 23 my ( $data ) = @_;
16 9 50       48 die "[__PACKAGE__] to_uri: input must be a hash"
17             unless ref $data eq 'HASH';
18              
19 9         50 my $u = URI->new("", "http");
20              
21 9         30102 for my $d_k ( sort keys %{ $data } ) {
  9         61  
22 20         2224 my $d_v = $data->{$d_k};
23 20 50       59 defined($d_v) or next;
24              
25 20 100       58 if ( ref $d_v ne 'HASH' ) {
26             $u->query_param( $d_k =>
27 8 50       26 join ',' => map { uri_escape_utf8($_) } ( ref $d_v eq 'ARRAY' ? @{$d_v} : $d_v ) );
  15         194  
  8         19  
28 8         1965 next;
29             }
30              
31             # HASH
32 12         22 for my $k ( sort keys %{$d_v} ) {
  12         39  
33 12         25 my $v = $d_v->{$k};
34              
35 12 50 66     64 die "[__PACKAGE__] to_uri: nested value can be scalar/arrayref only"
36             unless !ref $v or ref $v eq 'ARRAY';
37              
38             $u->query_param( $d_k . '[' . $k . ']' =>
39 12 100       51 join ',' => map { uri_escape_utf8($_) } ( ref $v eq 'ARRAY' ? @{$v} : $v ) );
  20         232  
  10         23  
40             }
41             }
42              
43 9         536 return $u->query;
44             }
45              
46             1;
47              
48             __END__
49              
50             =pod
51              
52             =encoding UTF-8
53              
54             =head1 NAME
55              
56             PONAPI::Utils::URI - URI utils
57              
58             =head1 VERSION
59              
60             version 0.002012
61              
62             =head1 AUTHORS
63              
64             =over 4
65              
66             =item *
67              
68             Mickey Nasriachi <mickey@cpan.org>
69              
70             =item *
71              
72             Stevan Little <stevan@cpan.org>
73              
74             =item *
75              
76             Brian Fraser <hugmeir@cpan.org>
77              
78             =back
79              
80             =head1 COPYRIGHT AND LICENSE
81              
82             This software is copyright (c) 2019 by Mickey Nasriachi, Stevan Little, Brian Fraser.
83              
84             This is free software; you can redistribute it and/or modify it under
85             the same terms as the Perl 5 programming language system itself.
86              
87             =cut