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