File Coverage

blib/lib/WebService/ILS/JSON.pm
Criterion Covered Total %
statement 21 82 25.6
branch 0 36 0.0
condition 0 6 0.0
subroutine 7 14 50.0
pod 0 5 0.0
total 28 143 19.5


line stmt bran cond sub pod time code
1             package WebService::ILS::JSON;
2              
3 4     4   1209 use Modern::Perl;
  4         8  
  4         19  
4              
5             =encoding utf-8
6              
7             =head1 NAME
8              
9             WebService::ILS::JSON - WebService::ILS module for services with JSON API
10              
11             =head1 DESCRIPTION
12              
13             To be subclassed
14              
15             See L
16              
17             =cut
18              
19 4     4   409 use Carp;
  4         23  
  4         206  
20 4     4   19 use HTTP::Request::Common;
  4         11  
  4         178  
21 4     4   1106 use JSON qw(encode_json);
  4         16674  
  4         20  
22 4     4   450 use URI;
  4         10  
  4         100  
23              
24 4     4   18 use parent qw(WebService::ILS);
  4         8  
  4         25  
25              
26             sub with_get_request {
27 0     0 0   my $self = shift;
28 0 0         my $callback = shift or croak "No callback";
29 0 0         my $url = shift or croak "No url";
30 0           my $get_params = shift; # hash ref
31              
32 0           my $uri = URI->new($url);
33 0 0         $uri->query_form($get_params) if $get_params;
34 0           my $request = HTTP::Request::Common::GET( $uri );
35 0           my $response = $self->_request_with_auth($request);
36 0           return $self->process_json_response($response, $callback);
37             }
38              
39             sub with_delete_request {
40 0     0 0   my $self = shift;
41 0 0         my $callback = shift or croak "No callback";
42 0           my $error_callback = shift;
43 0 0         my $url = shift or croak "No url";
44              
45 0           my $request = HTTP::Request::Common::DELETE( $url );
46 0           my $response = $self->_request_with_auth($request);
47 0 0         return $response->content ? $self->process_json_response($response, $callback) : 1
    0          
48             if $response->is_success;
49              
50             return $self->_error_result(
51 0     0     sub { $self->process_json_error_response($response, $error_callback); },
52 0           $request,
53             $response
54             );
55             }
56              
57             sub with_post_request {
58 0     0 0   my $self = shift;
59 0 0         my $callback = shift or croak "No callback";
60 0 0         my $url = shift or croak "No url";
61 0   0       my $post_params = shift || {}; # hash ref
62              
63 0           my $request = HTTP::Request::Common::POST( $url, $post_params );
64 0           my $response = $self->_request_with_auth($request);
65 0           return $self->process_json_response($response, $callback);
66             }
67              
68             # This will probably not suit everyone
69             sub with_put_request {
70 0     0 0   my $self = shift;
71 0 0         my $callback = shift or croak "No callback";
72 0 0         my $url = shift or croak "No url";
73 0           my $put_params = shift;
74              
75 0           my $request = HTTP::Request::Common::PUT( $url );
76 0           my $content;
77 0 0         if ($put_params) {
78 0           my $url = URI->new('http:');
79 0 0         $url->query_form(ref($put_params) eq "HASH" ? %$put_params : @$put_params);
80 0           $content = $url->query;
81             }
82 0 0         if( $content ) {
83             # HTML/4.01 says that line breaks are represented as "CR LF" pairs (i.e., `%0D%0A')
84 0           $content =~ s/(?
85              
86 0           $request->content_type("application/x-www-form-urlencoded");
87 0           $request->content_length(length $content);
88 0           $request->content($content);
89             }
90             else {
91 0           $request->content_length(0);
92             }
93              
94 0           my $response = $self->_request_with_auth($request);
95 0           return $self->process_json_response($response, $callback);
96             }
97              
98             sub with_json_request {
99 0     0 0   my $self = shift;
100 0 0         my $callback = shift or croak "No callback";
101 0           my $error_callback = shift;
102 0 0         my $url = shift or croak "No url";
103 0   0       my $post_params = shift || {}; # hashref
104 0   0       my $method = shift || 'post';
105              
106 0           my $req_builder = "HTTP::Request::Common::".uc( $method );
107 4     4   1940 no strict 'refs';
  4         11  
  4         545  
108 0           my $request = $req_builder->( $url );
109 0           $self->_json_request_content($request, $post_params);
110 0           my $response = $self->_request_with_auth($request);
111 0           return $self->process_json_response($response, $callback, $error_callback);
112             }
113              
114             sub _json_request_content {
115 0     0     my $self = shift;
116 0 0         my $request = shift or croak "No request";
117 0 0         my $data = shift or croak "No data"; # hashref
118              
119 0           $request->header( 'Content-Type' => 'application/json; charset=utf-8' );
120 0           $request->content( encode_json($data) );
121 0           $request->header( 'Content-Length' => bytes::length($request->content));
122 0           return $request;
123             }
124              
125             1;
126              
127             __END__