File Coverage

blib/lib/Net/Flotum/API/ExceptionHandler.pm
Criterion Covered Total %
statement 41 55 74.5
branch 8 12 66.6
condition 8 19 42.1
subroutine 7 7 100.0
pod 0 2 0.0
total 64 95 67.3


line stmt bran cond sub pod time code
1             package Net::Flotum::API::ExceptionHandler;
2 4     4   14 use strict;
  4         6  
  4         103  
3 4     4   11 use warnings;
  4         2  
  4         75  
4 4     4   13 use utf8;
  4         4  
  4         73  
5 4     4   78 use JSON::MaybeXS;
  4         5  
  4         2164  
6              
7             require Exporter;
8             our @ISA = qw(Exporter);
9             our @EXPORT = qw/request_with_retries/;
10              
11             sub request_with_retries {
12 17     17 0 472 my (%opts) = @_;
13 17         45 my $logger = $opts{logger};
14 17         29 my $requester = $opts{requester};
15 17   50     108 my $tries = $opts{tries} || 3;
16 17   50     89 my $sleep = $opts{sleep} || 1;
17 17         29 my $name = $opts{name};
18              
19 17         21 my ( $obj, $req, $res );
20 17         64 while ( $tries-- ) {
21              
22 17         29 my $func = $opts{method};
23 17         35 $obj = eval {
24             $requester->stash->$func(
25 17         279 @{ $opts{params} },
26             process_response => sub {
27 17     17   5504491 $res = $_[0]->{res};
28 17         54 $req = $_[0]->{req};
29             },
30 17         438 );
31             };
32 17 100       3457 last unless $@;
33              
34 2 50       13 die "Response not defined: $@" unless defined $res;
35 2 100 66     12 if ( $res->code == 404 && $res->content !~ /Endpoint not found/ ) {
36 1         90 die "Resource does not exists\n";
37             }
38 1 50 33     14 if ( $res->code == 400 && ref $obj eq 'HASH' && ref $obj->{error} eq 'form_error' ) {
    50 33        
      33        
39 0         0 my $msg = "Invalid data:\n";
40 0         0 $msg .= "$_ = " . $obj->{form_error}{$_} . "\n" for keys %{ $obj->{form_error} };
  0         0  
41 0         0 $logger->error( &log_error_txt( $@, $req, $res ) );
42 0         0 $logger->error($msg);
43 0         0 die "$msg\n";
44             }
45             elsif ( $res->code == 400 && ref $obj eq 'ARRAY' ) {
46 0         0 my $msg = "Invalid data:\n";
47 0         0 $msg .= encode_json($_) . "\n" for @{$obj};
  0         0  
48 0         0 $logger->error( &log_error_txt( $@, $req, $res ) );
49 0         0 $logger->error($msg);
50 0         0 die $obj;
51             }
52              
53 1         34 $logger->error( &log_error_txt( $@, $req, $res ) );
54              
55             # erros nao 500 desiste na hora.
56 1 50 33     143 if ( $tries == 0 || $res->code != 500 ) {
57 1         13 $logger->error( "Giving up $name. Reponse code " . $res->code );
58 1         11 die "Can't $name right now, response code ${\$res->code}.\n";
  1         6  
59             }
60 0         0 $logger->info("trying $tries more times...");
61 0         0 sleep $sleep;
62             }
63              
64 15         285 return ( obj => $obj, res => $res );
65             }
66              
67             sub log_error_txt {
68 1     1 0 3 my ( $err, $req, $res ) = @_;
69              
70 1         14 return "Error! $err\nREQUEST: \n" . eval { $req->as_string } . "\nRESPONSE\n" . eval { $res->as_string };
  1         9  
  1         239  
71             }
72              
73             1;