File Coverage

blib/lib/PONAPI/Client/Request.pm
Criterion Covered Total %
statement 32 33 96.9
branch 17 18 94.4
condition 14 18 77.7
subroutine 7 7 100.0
pod 0 2 0.0
total 70 78 89.7


line stmt bran cond sub pod time code
1             # ABSTRACT: request class
2             package PONAPI::Client::Request;
3              
4 7     7   9265 use Moose::Role;
  7         35550  
  7         27  
5              
6 7     7   40611 use JSON::MaybeXS qw< encode_json >;
  7         23741  
  7         419  
7              
8 7     7   3283 use PONAPI::Utils::URI qw< to_uri >;
  7         19  
  7         3521  
9              
10             requires 'method';
11             requires 'path';
12              
13             has 'uri_base' => (
14             is => 'ro',
15             isa => 'Maybe[Str]',
16             default => sub { '' },
17             );
18              
19             sub BUILDARGS {
20 19     19 0 99 my ( $class, %args ) = @_;
21             $args{uri_base} =~ s|/$||
22 19 100 66     80 if exists $args{uri_base} and defined $args{uri_base};
23 19         652 return \%args;
24             }
25              
26             sub request_params {
27 12     12 0 120 my $self = shift;
28              
29 12         52 my $method = $self->method;
30              
31 12         445 my $template = $self->uri_template;
32 12         51 my $path_args = $self->path;
33 12         90 (my $path = $template) =~ s/
34             \{
35             ( [^}]+ )
36             \}
37             /
38 24         60 my $placeholder = $1;
39 24 50       76 if ( !exists $path_args->{$placeholder} ) {
40 0         0 die "uri_template($template) has placeholder $placeholder, but that is not one of the request params for this class";
41             }
42 24         117 $path_args->{$placeholder}
43             /xeg;
44              
45             return (
46 12 100       413 method => $method,
    100          
47             path => $self->uri_base . $path,
48             ( $method eq 'GET'
49             ? ( query_string => $self->_build_query_string )
50             : ( $self->can('data')
51             ? ( body => encode_json( { data => $self->data } ) )
52             : ()
53             )
54             )
55             );
56             }
57              
58             sub _build_query_string {
59 9     9   19 my $self = shift;
60              
61 9         17 my %u;
62              
63 9 100 66     34 $u{filter} = $self->filter
64             if $self->does('PONAPI::Client::Request::Role::HasFilter') and $self->has_filter;
65              
66 9 100 100     29 $u{fields} = $self->fields
67             if $self->does('PONAPI::Client::Request::Role::HasFields') and $self->has_fields;
68              
69 9 100 66     76 $u{page} = $self->page
70             if $self->does('PONAPI::Client::Request::Role::HasPage') and $self->has_page;
71              
72 9 100 100     43 $u{include} = $self->include
73             if $self->does('PONAPI::Client::Request::Role::HasInclude') and $self->has_include;
74              
75 9 100 66     84 $u{sort} = $self->sort
76             if $self->does('PONAPI::Client::Request::Role::HasSort') and $self->has_sort;
77              
78 9         431 return to_uri( \%u );
79             }
80              
81 7     7   60 no Moose::Role; 1;
  7         15  
  7         68  
82              
83             __END__
84              
85             =pod
86              
87             =encoding UTF-8
88              
89             =head1 NAME
90              
91             PONAPI::Client::Request - request class
92              
93             =head1 VERSION
94              
95             version 0.002012
96              
97             =head1 AUTHORS
98              
99             =over 4
100              
101             =item *
102              
103             Mickey Nasriachi <mickey@cpan.org>
104              
105             =item *
106              
107             Stevan Little <stevan@cpan.org>
108              
109             =item *
110              
111             Brian Fraser <hugmeir@cpan.org>
112              
113             =back
114              
115             =head1 COPYRIGHT AND LICENSE
116              
117             This software is copyright (c) 2019 by Mickey Nasriachi, Stevan Little, Brian Fraser.
118              
119             This is free software; you can redistribute it and/or modify it under
120             the same terms as the Perl 5 programming language system itself.
121              
122             =cut