File Coverage

blib/lib/Google/API/Client.pm
Criterion Covered Total %
statement 67 72 93.0
branch 7 14 50.0
condition n/a
subroutine 12 14 85.7
pod 3 3 100.0
total 89 103 86.4


line stmt bran cond sub pod time code
1             package Google::API::Client;
2              
3 2     2   44475 use strict;
  2         7  
  2         74  
4 2     2   63 use 5.008_001;
  2         8  
  2         118  
5             our $VERSION = '0.13';
6              
7 2     2   1097 use Google::API::Method;
  2         6  
  2         72  
8 2     2   1195 use Google::API::Resource;
  2         5  
  2         48  
9              
10              
11 2     2   9 use constant AUTH_URI => 'https://accounts.google.com/o/oauth2/auth';
  2         2  
  2         113  
12 2     2   8 use constant TOKEN_URI => 'https://accounts.google.com/o/oauth2/token';
  2         4  
  2         3008  
13              
14             sub new {
15 1     1 1 9 my $class = shift;
16 1         2 my ($param) = @_;
17 1 50       4 unless (defined $param->{ua}) {
18 1         4 $param->{ua} = $class->_new_ua;
19             }
20 1 50       9 unless (defined $param->{json_parser}) {
21 1         8 $param->{json_parser} = $class->_new_json_parser;
22             }
23 1         12 bless { %$param }, $class;
24             }
25              
26             sub build {
27 1     1 1 2 my $self = shift;
28 1         4 my ($service, $version, $args) = @_;
29              
30 1         2 my $discovery_service_url = 'https://www.googleapis.com/discovery/v1/apis/{api}/{apiVersion}/rest';
31 1         7 $discovery_service_url =~ s/{api}/$service/;
32 1         5 $discovery_service_url =~ s/{apiVersion}/$version/;
33              
34 1         10 my $req = HTTP::Request->new(GET => $discovery_service_url);
35 1         10895 my $res = $self->{ua}->request($req);
36 1 50       402268 unless ($res->is_success) {
37             # throw an error
38 0         0 die 'could not get service document.' . $res->status_line;
39             }
40 1         30 my $document = $self->{json_parser}->decode($res->content);
41 1         2052 $self->build_from_document($document, $discovery_service_url, $args);
42             }
43              
44             sub build_from_document {
45 1     1 1 3 my $self = shift;
46 1         3 my ($document, $url, $args) = @_;
47 1         3 my $base = $document->{basePath};
48 1         13 my $base_url = URI->new($url);
49 1         240 $base_url = URI->new_abs($base, $base_url);
50 1         623 my $resource = $self->_create_resource($document, $base_url, $args);
51 1         59 return $resource;
52             }
53              
54             sub _create_resource {
55 1     1   4 my $self = shift;
56 1         2 my ($document, $base_url, $args) = @_;
57 1         19 my $root_resource_obj = Google::API::Resource->new;
58 1         4 for my $resource (keys %{$document->{resources}}) {
  1         6  
59 4         5 my $resource_obj;
60 4 50       14 if ($document->{resources}{$resource}{resources}) {
61 0         0 $resource_obj = $self->_create_resource($document->{resources}{$resource}, $base_url, $args);
62             }
63 4 50       11 if ($document->{resources}{$resource}{methods}) {
64 4 50       9 unless ($resource_obj) {
65 4         12 $resource_obj = Google::API::Resource->new;
66             }
67 4         6 for my $method (keys %{$document->{resources}{$resource}{methods}}) {
  4         13  
68             $resource_obj->set_attr($method, sub {
69 0     0   0 my (%param) = @_;
70 0         0 return Google::API::Method->new(
71             ua => $self->{ua},
72             json_parser => $self->{json_parser},
73             base_url => $base_url,
74             doc => $document->{resources}{$resource}{methods}{$method},
75             opt => \%param,
76             );
77 12         65 });
78             }
79             }
80 4     0   93 $root_resource_obj->set_attr($resource, sub { $resource_obj } );
  0         0  
81             }
82 1 50       5 if ($document->{auth}) {
83 1         3 $root_resource_obj->{auth_doc} = $document->{auth};
84             }
85 1         3 return $root_resource_obj;
86             }
87              
88             sub _new_ua {
89 2     2   420 my $class = shift;
90 2         1066 require LWP::UserAgent;
91 2         27327 my $ua = LWP::UserAgent->new;
92 2         3347 return $ua;
93             }
94              
95             sub _new_json_parser {
96 2     2   5 my $class = shift;
97 2         14 require JSON;
98 2         28 my $parser = JSON->new;
99 2         10 return $parser;
100             }
101              
102             1;
103             __END__