File Coverage

blib/lib/PONAPI/Builder/Role/HasPagination.pm
Criterion Covered Total %
statement 34 38 89.4
branch 10 18 55.5
condition 2 6 33.3
subroutine 6 6 100.0
pod 0 1 0.0
total 52 69 75.3


line stmt bran cond sub pod time code
1             # ABSTRACT: document builder - role - pagination
2             package PONAPI::Builder::Role::HasPagination;
3              
4 23     23   21772 use Moose::Role;
  23         50  
  23         276  
5              
6 23     23   136898 use URI;
  23         84835  
  23         663  
7 23     23   262239 use URI::QueryParam;
  23         16786  
  23         9755  
8              
9             # requires 'links_builder';
10             # requires 'req_path';
11              
12             # self isn't really part of pagination, but it can be overriden here
13             my %allowed_page_keys = map +($_=>1), qw/
14             first
15             last
16             next
17             prev
18             self
19             /;
20              
21             sub add_pagination_links {
22 10     10 0 2628 my ($self, %page_links) = @_;
23              
24             $page_links{self} ||= delete $page_links{current}
25 10 100 33     49 if exists $page_links{current};
26              
27 10         33 foreach my $link_name ( keys %page_links ) {
28             die "Tried to add pagination link `$link_name`, not allowed by the spec"
29 31 100       100 unless exists $allowed_page_keys{ $link_name };
30             }
31              
32 9         405 my $link = $self->req_path;
33              
34             $self->links_builder->add_links(
35             map {
36 26         154 my $query = $self->_hash_to_uri_query( { page => $page_links{$_} } );
37 26         403 ( $_ => $link . '?' . $query )
38             }
39 9 50       401 grep scalar keys %{ $page_links{$_} || {} },
  30         116  
40             keys %page_links
41             );
42             }
43              
44             sub _hash_to_uri_query {
45 26     26   45 my ($self, $data) = @_;
46 26         123 my $u = URI->new("", "http");
47              
48 26         28677 for my $d_k ( sort keys %$data ) {
49 26         48 my $d_v = $data->{$d_k};
50 26 50       72 defined($d_v) or next;
51              
52 26 50       85 if ( ref $d_v ne 'HASH' ) {
53             $u->query_param( $d_k =>
54 0 0       0 join ',' => ( ref $d_v eq 'ARRAY' ? @{$d_v} : $d_v ) );
  0         0  
55 0         0 next;
56             }
57              
58             # HASH
59 26         37 for my $k ( sort keys %{$d_v} ) {
  26         100  
60 52         3806 my $v = $d_v->{$k};
61 52 50       128 defined($v) or next;
62              
63 52 50 33     144 die "_hash_to_uri_query: nested value can be scalar/arrayref only"
64             unless !ref $v or ref $v eq 'ARRAY';
65              
66             $u->query_param( $d_k . '[' . $k . ']' =>
67 52 50       333 join ',' => ( ref $v eq 'ARRAY' ? @{$v} : $v ) );
  0         0  
68             }
69             }
70              
71 26         5018 return $u->query;
72             }
73              
74              
75              
76 23     23   156 no Moose::Role; 1;
  23         80  
  23         219  
77              
78             __END__
79              
80             =pod
81              
82             =encoding UTF-8
83              
84             =head1 NAME
85              
86             PONAPI::Builder::Role::HasPagination - document builder - role - pagination
87              
88             =head1 VERSION
89              
90             version 0.002005
91              
92             =head1 AUTHORS
93              
94             =over 4
95              
96             =item *
97              
98             Mickey Nasriachi <mickey@cpan.org>
99              
100             =item *
101              
102             Stevan Little <stevan@cpan.org>
103              
104             =item *
105              
106             Brian Fraser <hugmeir@cpan.org>
107              
108             =back
109              
110             =head1 COPYRIGHT AND LICENSE
111              
112             This software is copyright (c) 2016 by Mickey Nasriachi, Stevan Little, Brian Fraser.
113              
114             This is free software; you can redistribute it and/or modify it under
115             the same terms as the Perl 5 programming language system itself.
116              
117             =cut