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


line stmt bran cond sub pod time code
1             ##############################################################################
2             # Bing::ContentAPI
3             #
4             # Add, modify and delete products from the Microsoft Advertising Merchant Center platform
5             # via the Bing Ads / Microsoft Advertising Content API.
6             #
7             # https://learn.microsoft.com/en-us/advertising/shopping-content/
8             #
9             # Authentication is done via OAuth using Authorization Code Grant Flow
10             # https://learn.microsoft.com/en-us/advertising/guides/authentication-oauth
11             #
12             # AUTHOR
13             #
14             # Bill Gerrard
15             #
16             # VERSION HISTORY
17             #
18             # + v1.02 09/28/2022 updated to use the new msads.manage scope for authentication
19             # + v1.01 05/16/2018 dependency and documentation updates
20             # + v1.00 05/04/2018 initial release
21             #
22             # COPYRIGHT AND LICENSE
23             #
24             # Copyright (C) 2018-2022 Bill Gerrard
25             #
26             # This program is free software; you can redistribute it and/or modify
27             # it under the same terms as Perl itself, either Perl version 5.20.2 or,
28             # at your option, any later version of Perl 5 you may have available.
29             #
30             # Disclaimer of warranty: This program is provided by the copyright holder
31             # and contributors "As is" and without any express or implied warranties.
32             # The implied warranties of merchantability, fitness for a particular purpose,
33             # or non-infringement are disclaimed to the extent permitted by your local
34             # law. Unless required by law, no copyright holder or contributor will be
35             # liable for any direct, indirect, incidental, or consequential damages
36             # arising in any way out of the use of the package, even if advised of the
37             # possibility of such damage.
38             #
39             ################################################################################
40              
41             package Bing::ContentAPI;
42              
43 1     1   85710 use strict;
  1         2  
  1         30  
44 1     1   4 use warnings;
  1         1  
  1         24  
45 1     1   4 use Carp;
  1         2  
  1         59  
46              
47 1     1   616 use JSON;
  1         15268  
  1         5  
48 1     1   646 use REST::Client;
  1         46556  
  1         34  
49 1     1   581 use HTML::Entities;
  1         5857  
  1         1014  
50              
51             our $VERSION = '1.02';
52              
53             sub new {
54 0     0 1   my ($class, $param) = @_;
55 0           my $self = {};
56              
57 0           foreach my $val (qw(merchant_id developer_token client_id redirect_uri refresh_token)) {
58 0   0       $self->{$val} = $param->{$val} || croak "param '$val' missing in new()";
59             }
60              
61 0 0         $self->{debug} = 1 if $param->{debug};
62              
63 0           refresh_access_token($self); # sets access_token, refresh_token
64              
65 0           $self->{rest} = init_rest_client($self);
66              
67 0           return bless $self, $class;
68             }
69              
70             sub get {
71 0     0 1   my $self = shift;
72 0 0         croak "Odd number of arguments for get()" if scalar(@_) % 2;
73 0           my $opt = {@_};
74 0           my $method = $self->prepare_method($opt);
75 0           return $self->request('GET', $method);
76             }
77              
78             sub post {
79 0     0 0   my $self = shift;
80 0 0         croak "Odd number of arguments for post()" if scalar(@_) % 2;
81 0           my $opt = {@_};
82 0           my $method = $self->prepare_method($opt);
83 0 0         $opt->{body} = encode_json $opt->{body} if $opt->{body};
84 0           return $self->request('POST', $method, $opt->{body});
85             }
86              
87             sub delete {
88 0     0 1   my $self = shift;
89 0 0         croak "Odd number of arguments for delete()" if scalar(@_) % 2;
90 0           my $opt = {@_};
91 0           my $method = $self->prepare_method($opt);
92 0           return $self->request('DELETE', $method);
93             }
94              
95             sub prepare_method {
96 0     0 0   my $self = shift;
97 0           my $opt = shift;
98              
99 0 0         $opt->{resource} = '' if $opt->{resource} eq 'custom';
100              
101 0 0 0       if ($opt->{resource} eq 'products' || $opt->{resource} eq 'catalogs'
102             ) {
103             # add merchant ID to request URL
104 0           $opt->{resource} = $self->{merchant_id} .'/'. $opt->{resource};
105              
106             # drop list/insert methods; these are for coding convenience only
107 0 0         $opt->{method} = '' if $opt->{method} eq 'list';
108 0 0         $opt->{method} = '' if $opt->{method} eq 'insert';
109              
110             # insert catalog ID to request URL for status
111 0 0         $opt->{method} = $opt->{id} .'/'. $opt->{method} if $opt->{method} eq 'status';
112              
113             # append product ID to end of request URL for get and delete
114 0 0         $opt->{method} = $opt->{id} if $opt->{method} =~ /get|delete/;
115             }
116              
117 0 0         push @{$opt->{params}}, ('dry-run','1') if $opt->{dryrun};
  0            
118 0 0         my $encoded_params = $self->{rest}->buildQuery($opt->{params}) if $opt->{params};
119              
120 0           my $method;
121 0 0         $method .= '/'. $opt->{resource} if $opt->{resource} ne '';
122 0 0         $method .= '/'. $opt->{method} if $opt->{method} ne '';
123 0 0         $method .= $encoded_params if $encoded_params;
124              
125 0           return $method;
126             }
127              
128             sub init_rest_client {
129 0     0 0   my $self = shift;
130 0           my $r = REST::Client->new();
131             ### https://learn.microsoft.com/en-us/advertising/shopping-content/manage-products
132 0           $r->setHost('https://content.api.bingads.microsoft.com/shopping/v9.1/bmc');
133 0           $r->addHeader('AuthenticationToken', $self->{access_token});
134 0           $r->addHeader('DeveloperToken', $self->{developer_token});
135 0           $r->addHeader('Content-type', 'application/json');
136 0           $r->addHeader('charset', 'UTF-8');
137 0           return $r;
138             }
139              
140             my $refresh_token_info = qq|################################################################################
141             This error may be caused by an invalid refresh token. Follow the procedure
142             to authorize app and obtain a valid refresh token.
143             https://learn.microsoft.com/en-us/advertising/guides/authentication-oauth
144             ################################################################################
145             \n|;
146              
147             sub request {
148 0     0 0   my $self = shift;
149 0           my @command = @_;
150              
151 0 0         print join (' ', @command) . "\n" if $self->{debug};
152 0           my $rest = $self->{rest}->request(@command);
153              
154 0 0         unless ($rest->responseCode eq '200') {
155 0 0 0       if ($rest->responseCode eq '204' && $command[0] eq 'DELETE') {
    0          
156             # no-op: delete was successful
157             } elsif ($rest->responseCode eq '109') {
158             # AuthenticationTokenExpired error code (109), request new refresh token
159 0           $self->refresh_access_token();
160 0           $self->{rest} = $self->init_rest_client();
161 0           $rest = $self->{rest}->request(@command);
162             } else {
163 0 0         my $auth_error = ($rest->responseCode ne '401') ? '' : $refresh_token_info;
164 0           die("${auth_error}Error processing REST request:\n",
165             "Request: ", $rest->getHost , $command[1], "\n",
166             "Response Code: ", $rest->responseCode, "\n", $rest->responseContent, "\n");
167             }
168             }
169 0 0         print "Request Response: \n". $rest->responseContent if $self->{debug};
170              
171 0 0         my $response = $rest->responseContent ? decode_json $rest->responseContent : {};
172 0           return { code => $rest->responseCode, response => $response };
173             }
174              
175             sub get_access_token {
176 0     0 0   my $self = shift;
177 0 0         croak "Odd number of arguments for get_access_token()" if scalar(@_) % 2;
178 0           my $opt = {@_};
179              
180 0           my $bapiTokenURI = 'https://login.microsoftonline.com/common/oauth2/v2.0/token';
181              
182             croak "missing grant_type" unless $opt->{grant_type}
183             || $opt->{grant_type} eq 'authorization_code'
184 0 0 0       || $opt->{grant_type} eq 'refresh_token';
      0        
185              
186 0 0         if ($opt->{grant_type} eq 'authorization_code') {
187 0           $opt->{ctype} = 'code';
188 0   0       $opt->{cval} = $opt->{code} || '';
189             } else {
190 0           $opt->{ctype} = 'refresh_token';
191 0   0       $opt->{cval} = $opt->{refresh_token} || '';
192             }
193              
194 0           my $ua = LWP::UserAgent->new();
195             my $response = $ua->post($bapiTokenURI, {
196             client_id => $self->{client_id},
197             redirect_uri => $self->{redirect_uri},
198             grant_type => $opt->{grant_type},
199             $opt->{ctype} => $opt->{cval},
200 0           });
201              
202 1     1   1790 use Data::Dumper;
  1         6379  
  1         239  
203 0           print Dumper $response;
204 0           die;
205             }
206              
207             sub refresh_access_token {
208 0     0 1   my $self = shift;
209             # foreach my $val (qw(client_id redirect_uri refresh_token)) {
210             # $self->{$val} && $self->{$val} ne '' || croak "'$val' not defined for refresh_access_token()";
211             # }
212              
213 0           my $bapiTokenURI = 'https://login.microsoftonline.com/common/oauth2/v2.0/token';
214              
215 0           my $ua = LWP::UserAgent->new();
216             my $response = $ua->post($bapiTokenURI, {
217             grant_type => 'refresh_token',
218             scope => 'offline_access https://ads.microsoft.com/msads.manage',
219             client_id => $self->{client_id},
220             redirect_uri => $self->{redirect_uri},
221             refresh_token => $self->{refresh_token},
222 0           });
223              
224 0 0         unless($response->is_success()) {
225 0           die("Error receiving access token:\n", $response->code, "\n", $response->content, "\n");
226             }
227              
228 0           my $data = decode_json $response->content;
229 0           $self->{access_token} = $data->{access_token};
230 0           $self->{refresh_token} = $data->{refresh_token};
231             }
232              
233             1;
234              
235             __END__