File Coverage

blib/lib/REST/Cot/Generators.pm
Criterion Covered Total %
statement 38 54 70.3
branch 7 18 38.8
condition n/a
subroutine 13 14 92.8
pod 0 3 0.0
total 58 89 65.1


line stmt bran cond sub pod time code
1             package REST::Cot::Generators;
2             $REST::Cot::Generators::VERSION = '0.005';
3 2     2   20 use 5.16.0;
  2         6  
4 2     2   9 use strict;
  2         3  
  2         37  
5 2     2   10 use warnings;
  2         4  
  2         52  
6 2     2   1453 use Email::MIME::ContentType;
  2         1734  
  2         99  
7 2     2   11 use JSON;
  2         3  
  2         14  
8 2     2   238 use Carp qw[confess];
  2         3  
  2         84  
9 2     2   1555 use namespace::clean;
  2         34220  
  2         10  
10              
11             sub progenitor {
12 17     17 0 22 my $self = shift;
13             return sub {
14 197 100   197   499 return $self unless $self->{parent};
15 58         131 return $self->{parent}->{progenitor}->();
16 17         79 };
17             }
18              
19             sub path {
20 17     17 0 22 my $self = shift;
21             return sub {
22 138     138   136 state $path;
23 138 50       251 return undef unless ref($self->{progenitor}->());
24 138 100       534 return $path if $path;
25              
26 16         64 $path = @{ $self->{args} }?
27 5         19 join ( '/', $self->{parent}->{path}->(), $self->{name}, @{ $self->{args} } ) :
28 16 100       19 join ( '/', $self->{parent}->{path}->(), $self->{name} );
29              
30 16         65 return $path;
31 17         118 };
32             }
33              
34             sub method {
35 17     17 0 23 my $self = shift;
36             return sub {
37 0     0     my $method = shift;
38 0           my $self = shift;
39 0           my $response = $self->{client}->$method( "$self", @_ );
40              
41 0 0         if (my $content_type = $response->responseHeader('Content-Type')) {
42 0           $content_type = parse_content_type($content_type);
43 0           my $body = $response->responseContent;
44 0           my $code = $response->responseCode;
45 0           my $type = $content_type->{type};
46 0           my $subtype = $content_type->{subtype};
47              
48 0 0         if ($type eq 'application') {
49 0           my $decoded = $body;
50              
51 0 0         $decoded = from_json($body)
52             if ($subtype eq 'json');
53              
54 0 0         $decoded = $response->responseXpath
55             if ($subtype eq 'xml');
56              
57 0 0         return !wantarray? $decoded : ($decoded, $code, $response);
58             } else {
59 0           return $response;
60             }
61             } else {
62 0           return $response;
63             }
64             }
65 17         88 }
66              
67 2     2   1252 no namespace::clean;
  2         3  
  2         7  
68             1;
69              
70             __END__