File Coverage

blib/lib/IO/Iron/Connector.pm
Criterion Covered Total %
statement 68 219 31.0
branch 0 54 0.0
condition 0 24 0.0
subroutine 19 24 79.1
pod 3 3 100.0
total 90 324 27.7


line stmt bran cond sub pod time code
1             package IO::Iron::Connector;
2              
3             ## no critic (Documentation::RequirePodAtEnd)
4             ## no critic (Documentation::RequirePodSections)
5             ## no critic (RegularExpressions::RequireExtendedFormatting)
6             ## no critic (RegularExpressions::RequireLineBoundaryMatching)
7             ## no critic (RegularExpressions::ProhibitEscapedMetacharacters)
8              
9 3     3   55 use 5.010_000;
  3         13  
10 3     3   18 use strict;
  3         5  
  3         69  
11 3     3   15 use warnings;
  3         14  
  3         129  
12              
13             # Global creator
14 3         247 BEGIN {
15 3     3   18 use parent qw( IO::Iron::ConnectorBase ); # Inheritance
  3         5  
  3         47  
16             }
17              
18             # Global destructor
19       3     END {
20             }
21              
22              
23             # ABSTRACT: REST API Connector, HTTP interface class.
24              
25             our $VERSION = '0.12_01'; # TRIAL VERSION: generated by DZP::OurPkgVersion
26              
27              
28              
29 3     3   8 use Log::Any qw{$log};
  3         15  
  3         1092  
30             require JSON::MaybeXS;
31 3     3   641 use Data::UUID ();
  3         81  
  3         17  
32 3     3   47 use Hash::Util 0.06 qw{lock_keys lock_keys_plus unlock_keys legal_keys};
  3         16  
  3         222  
33 3     3   7 use Carp::Assert;
  3         16  
  3         341  
34 3     3   6 use Carp::Assert::More;
  3         481  
  3         22  
35 3     3   6 use Carp;
  3         142  
  3         16  
36 3     3   15 use English '-no_match_vars';
  3         20  
  3         2683  
37 3     3   141621 use REST::Client ();
  3         106  
  3         24  
38 3     3   8 use URI::Escape qw{uri_escape_utf8};
  3         168  
  3         20  
39 3     3   6 use Try::Tiny;
  3         170  
  3         19  
40 3     3   7 use Scalar::Util qw{blessed looks_like_number};
  3         186  
  3         507  
41             use Exception::Class (
42 3         1300 'IronHTTPCallException' => {
43             fields => ['status_code', 'response_message'],
44             }
45 3     3   8588 );
  3         31  
46              
47             # CONSTANTS
48              
49 3     3   9 use Const::Fast;
  3         29  
  3         16  
50             const my $HTTP_CODE_OK_MIN => 200;
51             const my $HTTP_CODE_OK_MAX => 299;
52             const my $HTTP_CODE_SERVICE_UNAVAILABLE => 503;
53              
54              
55             sub new {
56 3     3 1 40 my ($class) = @_;
57 3         286 $log->tracef('Entering new(%s)', $class);
58 3         7 my $self = IO::Iron::ConnectorBase->new();
59             # Add more keys to the self hash.
60             my @self_keys = (
61             'client', # REST client timeout (for REST calls accessing Iron services).
62             'mime_boundary', # The boundary string separating parts in multipart REST messages.
63 3         17 legal_keys(%{$self}),
  3         24  
64             );
65 3         28 unlock_keys(%{$self});
  3         32  
66 3         4 bless $self, $class;
67 3         24 lock_keys(%{$self}, @self_keys);
  3         153  
68              
69             # Set up REST client
70 3         15769 my $client = REST::Client->new();
71 3         857 $self->{'client'} = $client;
72              
73             # Create MIME multipart message boundary string
74 3         640 my $ug = Data::UUID->new();
75 3         50 my $uuid1 = $ug->create();
76 3         53 $self->{'mime_boundary'} = 'MIME_BOUNDARY_' . (substr $ug->to_string($uuid1), 1, 20); ## no critic (ValuesAndExpressions::ProhibitMagicNumbers)
77              
78 3         204 $log->infof('Iron Connector created with REST::Client as HTTP user agent.');
79 3         1927 $log->tracef('Exiting new: %s', $self);
80 0           return $self;
81             }
82              
83              
84             # TODO check why previous message (coded content) is in the next message!
85             sub perform_iron_action { ## no critic (Subroutines::ProhibitExcessComplexity)
86 0     0 1   my ($self, $iron_action, $params) = @_;
87 0 0         if(!defined $params) {
88 0           $params = {};
89             }
90 0           $log->tracef('Entering Connector:perform_iron_action(%s, %s)', $iron_action, $params);
91              
92 0           my $href = $iron_action->{'href'};
93 0           my $action_verb = $iron_action->{'action'};
94 0           my $return_type = $iron_action->{'return'};
95 0           my $retry = $iron_action->{'retry'};
96 0           my $require_body = $iron_action->{'require_body'};
97 0 0         my $paged = $iron_action->{'paged'} ? $iron_action->{'paged'} : 0;
98 0 0         my $per_page = $iron_action->{'per_page'} ? $iron_action->{'per_page'} : 0;
99 0           my $url_params = q{};
100 0 0 0       if(exists $iron_action->{'url_params'} && ref $iron_action->{'url_params'} eq 'HASH') {
101 0           foreach (keys %{$iron_action->{'url_params'}}) {
  0            
102 0           $log->tracef('perform_iron_action(): url_param:%s', $_);
103 0 0         if ($params->{'{'.$_.'}'}) {
104 0           $url_params .= "$_={$_}&";
105             }
106             }
107 0           $url_params = substr $url_params, 0, (length $url_params) - 1;
108             }
109 0 0         if ($url_params) {
110 0           $href .= (q{?} . $url_params);
111             }
112 0           my $content_type = $iron_action->{'content_type'};
113 0           $params->{'content_type'} = $content_type;
114 0           $params->{'return_type'} = $return_type;
115 0           $log->tracef('href before value substitution:\'%s\'.', $href);
116 0           foreach my $value_key (sort keys %{$params}) {
  0            
117 0           my $value = $params->{$value_key};
118 0           $log->tracef('Param key:%s; value=%s;', $value_key, $value);
119 0           $href =~ s/$value_key/$value/gs;
120             };
121 0           $log->tracef('href after value substitution:\'%s\'.', $href);
122              
123 0           my ($http_status_code, $returned_msg);
124 0           my $keep_on_trying = 1;
125 0           while($keep_on_trying) {
126 0           $keep_on_trying = 0;
127             try {
128             assert(
129             ($require_body == 1 && defined $params->{'body'} && ref $params->{'body'} eq 'HASH')
130 0   0 0     || ($require_body == 0 && !defined $params->{'body'})
131             );
132 0           assert_in($action_verb, ['GET','PATCH','PUT','POST','DELETE','OPTIONS','HEAD'], 'action_verb is a valid HTTP verb.');
133 0           assert_nonblank( $params->{'{Protocol}'}, 'params->{Protocol} is defined and not blank.' );
134 0           assert_nonblank( $params->{'{Port}'}, 'params->{Port} is defined and not blank.' );
135 0           assert_nonblank( $params->{'{Host}'}, 'params->{Host} is defined and not blank.' );
136 0           assert_nonblank( $params->{'{Project ID}'}, 'params->{Project ID} is defined and not blank.' );
137 0           assert_nonblank( $params->{'{API Version}'}, 'params->{API Version} is defined and not blank.' );
138 0           assert_nonblank( $params->{'authorization_token'}, 'params->{authorization_token} is defined and not blank.' );
139 0           assert_nonblank( $params->{'http_client_timeout'}, 'params->{http_client_timeout} is defined and not blank.' );
140 0 0         my $url_escape_these_fields = defined $iron_action->{'url_escape'} ? $iron_action->{'url_escape'} : {};
141 0           foreach my $field_name (keys %{$url_escape_these_fields}) {
  0            
142 0 0         if (defined $params->{$field_name}) {
143 0           $params->{$field_name} = uri_escape_utf8($params->{$field_name});
144             }
145             }
146             #
147 0 0         if($paged) {
148 0           $log->debugf('A paged query.');
149 0           my @returned_msgs;
150 0           my ($http_status_code_temp, $returned_msg_temp);
151 0           my $page_number = 0;
152 0           while(1) {
153 0           my $page_href = $href;
154 0           $log->debugf('A paged query. Href:\'%s\'', $page_href);
155 0 0         $page_href .= ($href =~ /\?/gsx ? q{&} : q{?}) . 'per_page='.$per_page.'&page='.$page_number;
156 0           ($http_status_code_temp, $returned_msg_temp) =
157             $self->perform_http_action($action_verb, $page_href, $params);
158 0           my $return_list = $returned_msg_temp;
159 0           my ($return_type_def, $list_hash_key) = (split m/:/s, $return_type);
160 0 0 0       $return_list = $returned_msg_temp->{$list_hash_key}
161             if $return_type_def eq 'LIST' && defined $list_hash_key; ## no critic (ControlStructures::ProhibitPostfixControls)
162 0           push @returned_msgs, @{$return_list};
  0            
163 0 0 0       if( scalar @{$return_list} == 0 || @{$return_list} < $per_page ) {
  0            
  0            
164 0           last;
165             }
166 0           $page_number++;
167             }
168 0           $http_status_code = $http_status_code_temp;
169 0           $returned_msg = \@returned_msgs;
170             }
171             else {
172 0           ($http_status_code, $returned_msg) = $self->perform_http_action($action_verb, $href, $params);
173             }
174             }
175             catch {
176 0     0     $log->debugf('perform_iron_action(): Caught exception:\'%s\'.', $_);
177 0 0 0       croak $_ unless blessed $_ && $_->can('rethrow'); ## no critic (ControlStructures::ProhibitPostfixControls)
178 0 0         if ( $_->isa('IronHTTPCallException') ) {
179 0 0         if( $_->status_code == $HTTP_CODE_SERVICE_UNAVAILABLE ) {
180             # 503 Service Unavailable. Clients should implement exponential backoff to retry the request.
181 0 0         $keep_on_trying = 1 if ($retry == 1); ## no critic (ControlStructures::ProhibitPostfixControls)
182             # TODO Fix this temporary solution for backoff to retry the request.
183             }
184             else {
185 0           $log->debugf('perform_iron_action(): rethrow the exception.', $_);
186 0           $_->rethrow;
187             }
188             }
189             else {
190 0           $_->rethrow;
191             }
192 0           };
193             # Module::Pluggable here?
194             }
195 0           $log->tracef('Exiting Connector:perform_iron_action(): %s', $returned_msg );
196 0           return $http_status_code, $returned_msg;
197             }
198              
199              
200              
201             sub perform_http_action {
202 0     0 1   my ($self, $action_verb, $href, $params) = @_;
203 0           my $client = $self->{'client'};
204 0           my $json = JSON::MaybeXS->new(utf8 => 1, pretty => 1);
205             # TODO assert href is URL
206 0           assert_in($action_verb, ['GET','PATCH','PUT','POST','DELETE','OPTIONS','HEAD'], 'action_verb is a valid HTTP verb.');
207 0           assert_exists($params, ['http_client_timeout', 'authorization_token'], 'params contains items http_client_timeout and authorization_token.');
208 0           assert_integer($params->{'http_client_timeout'}, 'params->{\'http_client_timeout\'} is integer.');
209 0           assert_nonblank($params->{'authorization_token'}, 'params->{\'authorization_token\'} is a non-blank string.');
210 0           $log->tracef('Entering Connector:perform_http_action(%s, %s, %s)', $action_verb, $href, $params);
211             #
212             # HTTP request attributes
213 0           my $timeout = $params->{'http_client_timeout'};
214 0           my $request_body;
215             # Headers
216 0 0         my $content_type = $params->{'content_type'} ? $params->{'content_type'} : 'application/json; charset=utf8';
217 0           my $authorization = 'OAuth ' . $params->{'authorization_token'};
218             #
219 0 0         if($content_type =~ /multipart/is) {
220 0 0         my $body_content = $params->{'body'} ? $params->{'body'} : { }; # Else use an empty hash for body.
221 0           my $file_as_zip = $params->{'body'}->{'file'};
222 0           delete $params->{'body'}->{'file'};
223 0           my $encoded_body_content = $json->encode($body_content);
224 0           my $boundary = $self->{'mime_boundary'};
225 0           $content_type = "multipart/form-data; boundary=$boundary";
226 0           my $file_name = $params->{'body'}->{'file_name'} . '.zip';
227             #$request_body = 'MIME-Version: 1.0' . "\n";
228             #$request_body .= 'Content-Length: ' . $req_content_length . "\n";
229             #$request_body .= 'Content-Type: ' . $req_content_type . "\n";
230 0           $request_body = q{--} . $boundary . "\n";
231 0           $request_body .= 'Content-Disposition: ' . 'form-data; name="data"' . "\n";
232 0           $request_body .= 'Content-Type: ' . 'text/plain; charset=utf-8' . "\n";
233 0           $request_body .= "\n";
234 0           $request_body .= $encoded_body_content . "\n";
235 0           $request_body .= "\n";
236 0           $request_body .= q{--} . $boundary . "\n";
237 0           $request_body .= 'Content-Disposition: ' . 'form-data; name="file"; filename="' . $file_name . q{"} . "\n";
238 0           $request_body .= 'Content-Type: ' . 'application/zip' . "\n";
239 0           $request_body .= 'Content-Transfer-Encoding: base64' . "\n";
240 0           $request_body .= "\n";
241 0           $request_body .= $file_as_zip . "\n";
242 0           $request_body .= q{--} . $boundary . q{--} . "\n";
243             }
244             else {
245 0 0         my $body_content = $params->{'body'} ? $params->{'body'} : { }; # Else use an empty hash for body.
246 0           $log->debugf('About to jsonize the body:\'%s\'', $body_content);
247 0           foreach (keys %{$body_content}) {
  0            
248             # Gimmick to ensure the proper jsonization of numbers
249             # Otherwise numbers might end up as strings.
250 0 0         $body_content->{$_} += 0 if looks_like_number $body_content->{$_}; ## no critic (ControlStructures::ProhibitPostfixControls)
251             }
252 0           my $encoded_body_content = $json->encode($body_content);
253 0           $log->debugf('Jsonized body:\'%s\'', $encoded_body_content);
254 0           $request_body = $encoded_body_content;
255             }
256 0           $client->setTimeout($timeout);
257 0           $log->tracef('client: %s; action=%s; href=%s;', $client, $action_verb, $href);
258 0           $log->debugf('REST Request: [verb=%s; href=%s; body=%s; Headers: Content-Type=%s; Authorization=%s]', $action_verb, $href, $request_body, $content_type, $authorization);
259 0           $client->request($action_verb, $href, $request_body,
260             {
261             'Content-Type' => $content_type,
262             'Authorization' => $authorization,
263             });
264             # RETURN:
265 0           $log->debugf('Returned HTTP response code:%s', $client->responseCode());
266 0           $log->tracef('Returned HTTP response:%s', $client->responseContent());
267 0 0 0       if( $client->responseCode() >= $HTTP_CODE_OK_MIN && $client->responseCode() <= $HTTP_CODE_OK_MAX ) {
268             # 200 OK: Successful GET; 201 Created: Successful POST
269 0           $log->tracef('HTTP Response code: %d, %s', $client->responseCode(), 'Successful!');
270 0           my $decoded_body_content;
271 0 0 0       if(defined $params->{'return_type'} && $params->{'return_type'} eq 'BINARY') {
    0 0        
272 0           $log->tracef('Returned HTTP response header Content-Disposition:%s', $client->responseHeader('Content-Disposition'));
273 0           my $filename;
274 0 0         if($client->responseHeader ('Content-Disposition') =~ /filename=(.+)$/s) {
275 0 0         $filename = $1 ? $1 : '[Unknown filename]';
276             }
277 0           $decoded_body_content = { 'file' => $client->responseContent(), 'file_name' => $filename };
278             }
279             elsif(defined $params->{'return_type'} && $params->{'return_type'} eq 'PLAIN_TEXT') {
280 0           $decoded_body_content = $client->responseContent();
281             }
282             else {
283 0           $decoded_body_content = $json->decode( $client->responseContent() );
284             }
285 0           $log->tracef('Exiting Connector:perform_http_action(): %s, %s', $client->responseCode(), $decoded_body_content );
286 0           return $client->responseCode(), $decoded_body_content;
287             }
288             else {
289 0           $log->tracef('HTTP Response code: %d, %s', $client->responseCode(), 'Failure!');
290 0           my $decoded_body_content;
291             try {
292 0     0     $decoded_body_content = $json->decode( $client->responseContent() );
293 0           };
294 0 0         my $response_message = $decoded_body_content ? $decoded_body_content->{'msg'} : $client->responseContent();
295 0           $log->tracef('Throwing exception in perform_http_action(): status_code=%s, response_message=%s', $client->responseCode(), $response_message );
296 0           IronHTTPCallException->throw(
297             status_code => $client->responseCode(),
298             response_message => $response_message,
299             error => 'IronHTTPCallException: status_code=' . $client->responseCode()
300             . ' response_message=' . $response_message,
301             );
302             }
303             return; # Control does not reach this point.
304             }
305              
306             1;
307              
308             __END__