File Coverage

blib/lib/Google/API/Client.pm

Criterion	Covered	Total	%
statement	85	89	95.5
branch	21	24	87.5
condition	30	33	90.9
subroutine	14	16	87.5
pod	3	3	100.0
total	153	165	92.7

package Google::API::Client;

use strict;
use 5.008_001;
our $VERSION = '0.15';

use Google::API::Method;
use Google::API::Resource;


use constant AUTH_URI => 'https://accounts.google.com/o/oauth2/auth';
use constant TOKEN_URI => 'https://accounts.google.com/o/oauth2/token';

sub new {
    my $class = shift;
    my ($param) = @_;
    unless (defined $param->{ua}) {
        $param->{ua} = $class->_new_ua;
    }
    unless (defined $param->{json_parser}) {
        $param->{json_parser} = $class->_new_json_parser;
    }
    bless { %$param }, $class;
}

sub build {
    my $self = shift;
    my ($service, $version, $args) = @_;

    my $discovery_service_url;
    if ($args->{discovery_service_url}) {
        $discovery_service_url = $args->{discovery_service_url};
    } else {
        $discovery_service_url = 'https://{api}.googleapis.com/$discovery/rest';
        if ($version) {
            $discovery_service_url .= '?version={apiVersion}';
        }

        $service = $self->_replace_to_subdomain($service);

        if ($self->_is_v1_discovery_url($service, $version)) {
            $discovery_service_url = 'https://www.googleapis.com/discovery/v1/apis/{api}/{apiVersion}/rest';
        }
    }
    $discovery_service_url =~ s/{api}/$service/;
    $discovery_service_url =~ s/{apiVersion}/$version/;

    my $req = HTTP::Request->new(GET => $discovery_service_url);
    my $res = $self->{ua}->request($req);
    $self->{ua}{response} = $res;
    unless ($res->is_success) {
        # throw an error
        die 'could not get service document.' . $res->status_line;
    }
    my $document = $self->{json_parser}->decode($res->content);
    $self->build_from_document($document, $discovery_service_url, $args);
}

sub build_from_document {
    my $self = shift;
    my ($document, $url, $args) = @_;
    my $base = $document->{rootUrl}.$document->{servicePath};
    my $base_url = URI->new($base);
    my $resource = $self->_create_resource($document, $base_url, $args);
    return $resource;
}

sub _create_resource {
    my $self = shift;
    my ($document, $base_url, $args) = @_;
    my $root_resource_obj = Google::API::Resource->new;
    for my $resource (keys %{$document->{resources}}) {
        my $resource_obj;
        if ($document->{resources}{$resource}{resources}) {
            $resource_obj = $self->_create_resource($document->{resources}{$resource}, $base_url, $args);
        }
        if ($document->{resources}{$resource}{methods}) {
            unless ($resource_obj) {
                $resource_obj = Google::API::Resource->new;
            }
            for my $method (keys %{$document->{resources}{$resource}{methods}}) {
                $resource_obj->set_attr($method, sub {
                    my (%param) = @_;
                    return Google::API::Method->new(
                        ua => $self->{ua},
                        json_parser => $self->{json_parser},
                        base_url => $base_url,
                        doc => $document->{resources}{$resource}{methods}{$method},
                        opt => \%param,
                    );
                });
            }
        }
        $root_resource_obj->set_attr($resource, sub { $resource_obj } );
    }
    if ($document->{auth}) {
        $root_resource_obj->{auth_doc} = $document->{auth};
    }
    return $root_resource_obj;
}

sub _new_ua {
    my $class = shift;
    require LWP::UserAgent;
    my $ua = LWP::UserAgent->new;
    return $ua;
}

sub _new_json_parser {
    my $class = shift;
    require JSON;
    my $parser = JSON->new;
    return $parser;
}

sub _replace_to_subdomain {
    my ($self, $service) = @_;

    # Following services are different from subdomains.
    # It needs to be converted.
    my %replacement = (
        'adexchangebuyer2'  => 'adexchangebuyer',
        'calendar'          => 'calendar-json',
        'content'           => 'shoppingcontent',
        'prod_tt_sasportal' => 'prod-tt-sasportal',
        'translate'         => 'translation',
    );
    if (grep { $service eq $_ } keys %replacement) {
        $service = $replacement{$service};
    }
    return $service;
}

sub _is_v1_discovery_url {
    my ($self, $service, $version) = @_;
    # Following services are still using V1 type URL
    if (($service eq 'compute' && $version eq 'alpha') ||
        ($service eq 'compute' && $version eq 'beta') ||
        ($service eq 'compute' && $version eq 'v1') ||
        ($service eq 'drive' && $version eq 'v2') ||
        ($service eq 'drive' && $version eq 'v3') ||
        ($service eq 'oauth2' && $version eq 'v2')) {
        return 1;
    }
    return;
}

1;
__END__