File Coverage

blib/lib/Bing/ContentAPI.pm

Criterion	Covered	Total	%
statement	21	107	19.6
branch	0	54	0.0
condition	0	19	0.0
subroutine	7	16	43.7
pod	4	9	44.4
total	32	205	15.6

##############################################################################
# Bing::ContentAPI
#
# Add, modify and delete items from the Bing Merchant Center platform via
# the Bing Ads Content API.
#
# https://docs.microsoft.com/bingads/shopping-content/
#
# Authentication is done via OAuth using Authorization Code Grant Flow
# https://docs.microsoft.com/bingads/guides/authentication-oauth
#
# AUTHOR
#
# Bill Gerrard
#
# VERSION HISTORY
#
# + v1.00       05/04/2018 initial release
#
# COPYRIGHT AND LICENSE
#
# Copyright (C) 2018 Bill Gerrard
#
# This program is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself, either Perl version 5.20.2 or,
# at your option, any later version of Perl 5 you may have available.
#
# Disclaimer of warranty: This program is provided by the copyright holder
# and contributors "As is" and without any express or implied warranties.
# The implied warranties of merchantability, fitness for a particular purpose,
# or non-infringement are disclaimed to the extent permitted by your local
# law. Unless required by law, no copyright holder or contributor will be
# liable for any direct, indirect, incidental, or consequential damages
# arising in any way out of the use of the package, even if advised of the
# possibility of such damage.
#
################################################################################

package Bing::ContentAPI;

use strict;
use warnings;
use Carp;

use JSON;
use REST::Client;
use HTML::Entities;

our $VERSION = '1.00';

sub new {
    my ($class, $param) = @_;
    my $self = {};

    foreach my $val (qw(merchant_id developer_token client_id redirect_uri refresh_token)) {
        $self->{$val} = $param->{$val} || croak "param '$val' missing in new()";
    }

    $self->{debug} = 1 if $param->{debug};

    refresh_access_token($self); # sets access_token, refresh_token

    $self->{rest} = init_rest_client($self);

    return bless $self, $class;
}

sub get {
    my $self = shift;
    croak "Odd number of arguments for get()" if scalar(@_) % 2;
    my $opt = {@_};
    my $method = $self->prepare_method($opt);
    return $self->request('GET', $method);
}

sub post {
    my $self = shift;
    croak "Odd number of arguments for post()" if scalar(@_) % 2;
    my $opt = {@_};
    my $method = $self->prepare_method($opt);
    $opt->{body} = encode_json $opt->{body} if $opt->{body};
    return $self->request('POST', $method, $opt->{body});
}

sub delete {
    my $self = shift;
    croak "Odd number of arguments for delete()" if scalar(@_) % 2;
    my $opt = {@_};
    my $method = $self->prepare_method($opt);
    return $self->request('DELETE', $method);
}

sub prepare_method {
  my $self = shift;
  my $opt = shift;

  $opt->{resource} = '' if $opt->{resource} eq 'custom';

  if ($opt->{resource} eq 'products' || $opt->{resource} eq 'catalogs'
    ) {
    # add merchant ID to request URL
    $opt->{resource} = $self->{merchant_id} .'/'. $opt->{resource};

    # drop list/insert methods; these are for coding convenience only
    $opt->{method} = '' if $opt->{method} eq 'list';
    $opt->{method} = '' if $opt->{method} eq 'insert';

    # insert catalog ID to request URL for status
    $opt->{method} = $opt->{id} .'/'. $opt->{method} if $opt->{method} eq 'status';

    # append product ID to end of request URL for get and delete
    $opt->{method} = $opt->{id} if $opt->{method} =~ /get|delete/;
  }

  push @{$opt->{params}}, ('dry-run','1') if $opt->{dryrun};
  my $encoded_params = $self->{rest}->buildQuery($opt->{params}) if $opt->{params};

  my $method;
  $method .= '/'. $opt->{resource} if $opt->{resource} ne '';
  $method .= '/'. $opt->{method} if $opt->{method} ne '';
  $method .= $encoded_params if $encoded_params;

  return $method;
}

sub init_rest_client {
    my $self = shift;
    my $r = REST::Client->new();
    ### https://docs.microsoft.com/bingads/shopping-content/manage-products
    $r->setHost('https://content.api.bingads.microsoft.com/shopping/v9.1/bmc');
    $r->addHeader('AuthenticationToken', $self->{access_token});
    $r->addHeader('DeveloperToken', $self->{developer_token});
    $r->addHeader('Content-type', 'application/json');
    $r->addHeader('charset', 'UTF-8');
    return $r;
}

my $refresh_token_info = qq|################################################################################
This error may be caused by an invalid refresh token. Follow the procedure
to authorize app and obtain a valid refresh token.
https://docs.microsoft.com/bingads/guides/authentication-oauth#authorizationcode
################################################################################
\n|;

sub request {
    my $self = shift;
    my @command = @_;

    print join (' ', @command) . "\n" if $self->{debug};
    my $rest = $self->{rest}->request(@command);

    unless ($rest->responseCode eq '200') {
        if ($rest->responseCode eq '204' && $command[0] eq 'DELETE') {
          # no-op: delete was successful
      } elsif ($rest->responseCode eq '109') {
            # AuthenticationTokenExpired error code (109), request new refresh token
            $self->refresh_access_token();
            $self->{rest} = $self->init_rest_client();
            $rest = $self->{rest}->request(@command);
        } else {
            my $auth_error = ($rest->responseCode ne '401') ? '' : $refresh_token_info;
            die("${auth_error}Error processing REST request:\n",
                "Request: ", $rest->getHost , $command[1], "\n",
                "Response Code: ", $rest->responseCode, "\n", $rest->responseContent, "\n");
        }
    }
    print "Request Response: \n". $rest->responseContent if $self->{debug};

    my $response = $rest->responseContent ? decode_json $rest->responseContent : {};
    return { code => $rest->responseCode, response => $response };
}

sub get_access_token {
    my $self = shift;
    croak "Odd number of arguments for get_access_token()" if scalar(@_) % 2;
    my $opt = {@_};

    my $bapiTokenURI = 'https://login.live.com/oauth20_token.srf';

    croak "missing grant_type" unless $opt->{grant_type}
        || $opt->{grant_type} eq 'authorization_code'
        || $opt->{grant_type} eq 'refresh_token';

    if ($opt->{grant_type} eq 'authorization_code') {
        $opt->{ctype} = 'code';
        $opt->{cval} = $opt->{code} || '';
    } else {
        $opt->{ctype} = 'refresh_token';
        $opt->{cval} = $opt->{refresh_token} || '';
    }

    my $ua = LWP::UserAgent->new();
    my $response = $ua->post($bapiTokenURI, {
        client_id => $self->{client_id},
        redirect_uri => $self->{redirect_uri},
        grant_type => $opt->{grant_type},
        $opt->{ctype} => $opt->{cval},
    });

    use Data::Dumper;
    print Dumper $response;
    die;
}

sub refresh_access_token {
    my $self = shift;
#    foreach my $val (qw(client_id redirect_uri refresh_token)) {
#        $self->{$val} && $self->{$val} ne '' || croak "'$val' not defined for refresh_access_token()";
#    }

    my $bapiTokenURI = 'https://login.live.com/oauth20_token.srf';

    my $ua = LWP::UserAgent->new();
    my $response = $ua->post($bapiTokenURI, {
        grant_type => 'refresh_token',
        client_id => $self->{client_id},
        redirect_uri => $self->{redirect_uri},
        refresh_token => $self->{refresh_token},
    });

    unless($response->is_success()) {
        die("Error receiving access token:\n", $response->code, "\n", $response->content, "\n");
    }

    my $data = decode_json $response->content;
    $self->{access_token} = $data->{access_token};
    $self->{refresh_token} = $data->{refresh_token};
}

1;

__END__