view release on metacpan or  search on metacpan

lib/Tie/Google/Sheets/Client.pm  view on Meta::CPAN

        my $ua_arg     = delete $args{ua};
        my $any_ua_arg = delete $args{any_ua};
        croak 'only one of ua or any_ua may be given' if defined $ua_arg && defined $any_ua_arg;

        my $batch_size = delete $args{batch_size};
        croak 'batch_size must be a positive integer'
            if defined $batch_size && $batch_size !~ /\A[1-9][0-9]*\z/;

        my $backoff_retry = delete $args{backoff_retry};
        croak 'backoff_retry must be a positive integer'
            if defined $backoff_retry && $backoff_retry !~ /\A[1-9][0-9]*\z/;

        croak "unknown constructor argument(s): @{[ sort keys %args ]}" if %args;

        my $ua = $any_ua_arg // HTTP::AnyUA->new( ua => $ua_arg // do {
            require HTTP::Tiny;
            HTTP::Tiny->new
        });

        return {
            spreadsheet_id  => $spreadsheet_id,
            ua              => $ua,
            access_token    => $access_token,
            service_account => defined $service_account
                ? $class->_load_service_account($service_account)
                : undef,
            batch_size      => $batch_size,
            backoff_retry   => $backoff_retry,
        };
    }

    sub _load_service_account ($class, $val) {
        return $val if is_plain_hashref($val);
        croak 'service_account must be a hashref of the decoded key file, or a path to one'
            unless !is_ref($val) && path($val)->is_file;

        my $json;
        try { $json = path($val)->slurp_raw }
        catch ($e) { croak "unable to open service account key file $val: $!" }

        return decode_json($json);
    }

    sub _access_token ($self) {
        if(defined(my $token = $self->access_token)) {
            return is_plain_coderef($token) ? $token->() : $token;
        }

        return $self->token if $self->token && time() < $self->token_expires - 30;

        my $sa  = $self->service_account;
        my $now = time();
        my $jwt = encode_jwt(
            payload => {
                iss   => $sa->{client_email},
                scope => SCOPE,
                aud   => $sa->{token_uri} // TOKEN_URI,
                iat   => $now,
                exp   => $now + 3600,
            },
            key => \$sa->{private_key},
            alg => 'RS256',
        );

        my $body = join '&',
            'grant_type=' . uri_escape('urn:ietf:params:oauth:grant-type:jwt-bearer'),
            'assertion=' . uri_escape($jwt);

        my $res = $self->ua->request( 'POST', $sa->{token_uri} // TOKEN_URI, {
            headers => { 'content-type' => 'application/x-www-form-urlencoded' },
            content => $body,
        });
        $self->_croak_on_error($res);

        my $data = decode_json($res->{content});
        $self->token($data->{access_token});
        $self->token_expires($now + ($data->{expires_in} // 3600));

        return $self->token;
    }

    sub _croak_on_error ($self, $res) {
        return if $res->{success};

        my $message = $res->{reason} // 'unknown error';
        if($res->{content}) {
            my $data;
            try {
                $data = decode_json $res->{content};
                $message = $data->{error}{message} if is_plain_hashref($data) && $data->{error}{message};
            } catch ($e) {
                warn "warning decoding JSON: $e";
            }
        }
        croak "Google Sheets API error ($res->{status}): $message";
    }

    sub _request ($self, $method, $url, %opts) {
        my %headers = ( authorization => 'Bearer ' . $self->_access_token, ( $opts{headers} // {} )->%* );
        my %http_opts = ( headers => \%headers );
        if(defined $opts{body}) {
            $headers{'content-type'} = 'application/json';
            $http_opts{content} = encode_json($opts{body});
        }

        my $attempts = ($self->backoff_retry // 0) + 1;
        my $res;
        for my $attempt (1 .. $attempts) {
            $res = $self->ua->request($method, $url, \%http_opts);
            last if $res->{success} || $res->{status} != 429 || $attempt == $attempts;
            $SLEEP->(2 ** ($attempt - 1));
        }
        $self->_croak_on_error($res);

        return undef unless length $res->{content};
        return decode_json($res->{content});
    }

    sub _url ($self, $segments = [], $action = undef, %query) {
        my $uri = URI->new(API_BASE);
        $uri->path_segments($uri->path_segments, $self->spreadsheet_id, $segments->@*);