File Coverage

blib/lib/Net/Flotum/API/ExceptionHandler.pm
Criterion Covered Total %
statement 28 46 60.8
branch 4 10 40.0
condition 3 16 18.7
subroutine 5 6 83.3
pod 0 2 0.0
total 40 80 50.0


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