File Coverage

blib/lib/Mojar/Google/Analytics/Response.pm
Criterion Covered Total %
statement 6 34 17.6
branch 0 14 0.0
condition 0 17 0.0
subroutine 2 4 50.0
pod 2 2 100.0
total 10 71 14.0


line stmt bran cond sub pod time code
1             package Mojar::Google::Analytics::Response;
2 3     3   13 use Mojo::Base -base;
  3         4  
  3         28  
3              
4             our $VERSION = 1.011;
5              
6 3     3   1499 use Mojar::Util 'snakecase';
  3         67594  
  3         1461  
7              
8             # Attributes
9              
10             has [qw(code content error message success)];
11              
12             has start_index => 1;
13             has contains_sampled_data => !!0;
14             has column_headers => sub {[]};
15             has total_results => 0;
16             has rows => sub {[]};
17             has [qw(items_per_page profile_info next_link totals_for_all_results)];
18              
19             # Public methods
20              
21             sub parse {
22 0     0 1   my ($self, $res) = @_;
23              
24 0 0         if ($res->is_success) {
25 0           delete @$self{qw(code content error message)};
26 0           my $j = $res->json;
27 0           $self->{snakecase($_)} = $j->{$_} for keys %$j;
28 0           return $self->success(1);
29             }
30             else {
31             # Got a transaction-level error
32 0   0       $self->success(undef)->code($res->code || 408)
      0        
33             ->message($res->message // 'Possible timeout')
34             ->error(sprintf 'Error (%u): %s', $_[0]->code, $_[0]->message);
35              
36 0 0 0       if ($res and my $j = $res->json) {
37             # Got JSON body in response
38 0           $self->content($j);
39 0 0 0       my $m = ref($j->{error}) ? $j->{error} : {message => $j->{error} // ''};
40              
41             # Got message record
42 0 0         $self->code($m->{code}) if $m->{code};
43             # Take note of headline error
44 0   0       my $msg = ($m->{message} // $j->{message}) ."\n";
45              
46 0   0       for my $e (@{$m->{errors} // []}) {
  0            
47             # Take note of next listed error
48             $msg .= sprintf "%s at %s\n%s\n",
49 0   0       $e->{reason}, ($e->{location} // $e->{domain}), $e->{message};
50             }
51 0           $self->message($msg);
52             }
53 0           return undef;
54             }
55             }
56              
57             sub columns {
58 0     0 1   my $self = shift;
59 0 0         return undef unless my $rows = $self->rows;
60 0 0         return undef unless my $height = @$rows;
61 0 0         return undef unless my $width = @{$$rows[0]};
  0            
62              
63 0           my @cols = map [], 1 .. $width;
64 0           for (my $j = 0; $j < $height; ++$j) {
65 0           for (my $i = 0; $i < $width; ++$i) {
66 0           push @{$cols[$i]}, $$rows[$j][$i]
  0            
67             }
68             }
69 0           return \@cols;
70             }
71             # See https://gist.github.com/niczero/cc792d919ff7c32cbccf04fa821a1cb0 for bm
72              
73             1;
74             __END__