File Coverage

blib/lib/Marketplace/Ebay.pm
Criterion Covered Total %
statement 18 20 90.0
branch n/a
condition n/a
subroutine 7 7 100.0
pod n/a
total 25 27 92.5


line stmt bran cond sub pod time code
1             package Marketplace::Ebay;
2              
3 1     1   12683 use 5.010001;
  1         2  
4 1     1   3 use strict;
  1         1  
  1         16  
5 1     1   4 use warnings FATAL => 'all';
  1         3  
  1         29  
6              
7 1     1   383 use HTTP::Thin;
  1         59829  
  1         38  
8 1     1   635 use HTTP::Request;
  1         1107  
  1         31  
9 1     1   7 use HTTP::Headers;
  1         2  
  1         30  
10 1     1   312 use XML::LibXML;
  0            
  0            
11             use XML::Compile::Schema;
12             use XML::Compile::Util qw/pack_type/;
13             use Data::Dumper;
14             use XML::LibXML::Simple;
15             use Marketplace::Ebay::Response;
16             use Marketplace::Ebay::Order;
17              
18             use Moo;
19             use MooX::Types::MooseLike::Base qw(:all);
20             use namespace::clean;
21              
22             =head1 NAME
23              
24             Marketplace::Ebay - Making API calls to eBay (with XSD validation)
25              
26             =head1 VERSION
27              
28             Version 0.191
29              
30             =cut
31              
32             our $VERSION = '0.191';
33              
34             =head1 SYNOPSIS
35              
36             my $ebay = Marketplace::Ebay->new(
37             production => 0,
38             site_id => 77,
39             developer_key => '1234',
40             application_key => '6789',
41             certificate_key => '6666',
42             token => 'asd12348',
43             xsd_file => 'ebay.xsd',
44             );
45             my $res = $ebay->api_call('GeteBayOfficialTime', {});
46             print Dumper($res);
47              
48              
49             L
50              
51             =head1 DESCRIPTION
52              
53             =head2 International Selling
54              
55             Products propagate from your local selling account to all Ebay sites
56             where you are going to ship your items to:
57              
58             L
59              
60             =head1 ACCESSORS
61              
62             =head2 Credentials
63              
64             The following are required for a successful API call.
65              
66             =head3 developer_key
67              
68             =head3 application_key
69              
70             =head3 certificate_key
71              
72             =head3 token
73              
74             =head3 site_id
75              
76             The id of the site. E.g., Germany is 77.
77              
78             L
79              
80             =head3 xsd_file
81              
82             Path to the XSD file with the eBay definitions.
83              
84             http://developer.ebay.com/webservices/latest/ebaySvc.xsd
85              
86             =head3 production
87              
88             Boolean. Default to false.
89              
90             By default, the API calls are done against the sandbox. Set it to true
91             in production.
92              
93             =head3 endpoint
94              
95             Set lazily by the class depending on the C value.
96              
97             =head3 compatibility_level
98              
99             The version of API and XSD used. Please keep this in sync with the XSD.
100              
101             =head3 last_response
102              
103             You can get the HTTP::Response object of the last call using this
104             accessor.
105              
106             =head2 last_request
107              
108             You can get the HTTP::Request object of the last call using this
109             accessor.
110              
111             =head3 last_parsed_response
112              
113             Return a L object (or undef on failure)
114             out of the return value of the last C.
115              
116             =head3 log_file
117              
118             A filename where to log requests and responses.
119              
120             =head3 name_from_shipping_address
121              
122             Passed to L. Defaults to true.
123              
124             =cut
125              
126             has developer_key => (is => 'ro', required => 1);
127             has application_key => (is => 'ro', required => 1);
128             has certificate_key => (is => 'ro', required => 1);
129             has token => (is => 'ro', required => 1);
130             has site_id => (is => 'ro', required => 1);
131             has site_code => (is => 'lazy');
132             has name_from_shipping_address => (is => 'ro', isa => Bool, default => sub { 1 });
133              
134             sub _build_site_code {
135             my $self = shift;
136             my $code = $self->ebay_sites_id_to_name->{$self->site_id};
137             die $self->site_id . " doesn't map to a site name!" unless $code;
138             return $code;
139             }
140              
141             # totally random, as per Net::eBay
142             has compatibility_level => (is => 'ro',
143             default => sub { '655' });
144              
145             has session_certificate => (is => 'lazy');
146             has production => (is => 'ro', default => sub { 0 });
147             has endpoint => (is => 'lazy');
148              
149             has last_response => (is => 'rwp');
150             has last_parsed_response => (is => 'rwp');
151             has last_request => (is => 'rwp');
152             has log_file => (is => 'rw');
153              
154             sub _build_endpoint {
155             my $self = shift;
156             if ($self->production) {
157             return 'https://api.ebay.com/ws/api.dll';
158             }
159             else {
160             return 'https://api.sandbox.ebay.com/ws/api.dll';
161             }
162             }
163              
164             sub _build_session_certificate {
165             my $self = shift;
166             return join(';',
167             $self->developer_key,
168             $self->application_key,
169             $self->certificate_key);
170             }
171              
172             has xsd_file => (is => 'ro', required => 1);
173              
174             has schema => (is => 'lazy');
175              
176             sub _build_schema {
177             my $self = shift;
178             my $xsd_file = $self->xsd_file;
179             die "$xsd_file is not a file" unless -f $xsd_file;
180             return XML::Compile::Schema->new($self->xsd_file);
181             }
182              
183              
184             =head1 METHODS
185              
186             =head2 api_call($name, \%data, \%options)
187              
188             Do the API call $name with payload in %data. Return the data structure
189             of the L object. In case of failure,
190             return nothing. In this case, you can inspect the details of the
191             failure inspecting, e.g.,
192              
193             $self->last_response->status_line;
194              
195             With option C set to a true value, the method doesn't
196             return the object, but a plain hashref with the structure returned
197             (old behaviour).
198              
199             With an option C, the XML is parsed using XMLin, not the
200             schema, so the result could be unstable, but on the other hand, you
201             get something out of XML which doesn't comply with the schema.
202              
203             =head2 prepare_xml($name, \%data)
204              
205             Create the XML document to send for the API call $name.
206              
207             =head2 show_xml_template($call, $call_type)
208              
209             Utility for development. Show the expected structure for the API call
210             $call. The second argument is optional, and may be Request or
211             Response, defaulting to Request.
212              
213             =head2 log_event(@data)
214              
215             Append the arguments to the C, if it was defined.
216              
217             =cut
218              
219             sub api_call {
220             my ($self, $call, $data, $options) = @_;
221             $options ||= {};
222             $self->log_event("Preparing call to $call for " . Dumper($data));
223             my $xml = $self->prepare_xml($call, $data);
224             my $headers = $self->_prepare_headers($call);
225             my $request = HTTP::Request->new(POST => $self->endpoint, $headers, $xml);
226             $self->_set_last_request($request);
227             $self->log_event("Doing $call request\n" . $request->as_string);
228             my $response = HTTP::Thin->new->request($request);
229             $self->_set_last_response($response);
230             $self->log_event("Retrieving $call response\n" . $response->as_string);
231             $self->_set_last_parsed_response(undef);
232             if ($response->is_success) {
233             my $struct;
234             my $xml = $response->decoded_content;
235             if ($call eq 'GetOrders') {
236             # until they don't publish an updated xsd
237             $xml =~ s!(false|true)!!g;
238             }
239             if ($options->{no_validate}) {
240             $struct = XMLin($xml);
241             }
242             else {
243             $struct = $self->_parse_response($call, $xml);
244             }
245             if ($struct) {
246             my $obj = Marketplace::Ebay::Response->new(struct => $struct);
247             $self->_set_last_parsed_response($obj);
248             $self->log_event("Got response:" . Dumper($struct));
249             if ($options->{requires_struct}) {
250             return $struct;
251             }
252             else {
253             return $obj;
254             }
255             }
256             }
257             return;
258             }
259              
260             sub _parse_response {
261             my ($self, $call, $xml) = @_;
262             my $reader = $self->schema->compile(READER => $self->_xml_type($call,
263             'Response'));
264             my $struct;
265             eval {
266             $struct = $reader->($xml);
267             };
268             return $struct;
269             }
270              
271             sub log_event {
272             my ($self, @strings) = @_;
273             if (my $file = $self->log_file) {
274             open (my $fh, '>>', $file) or die "Cannot open $file $!";
275             my $now = "\n" . localtime() . "\n";
276             print $fh $now, @strings;
277             close $fh or die "Cannot close $file $!";
278             }
279             }
280              
281             sub _prepare_headers {
282             my ($self, $call) = @_;
283             my $headers = HTTP::Headers->new;
284             $headers->push_header('X-EBAY-API-COMPATIBILITY-LEVEL' => $self->compatibility_level);
285             $headers->push_header('X-EBAY-API-DEV-NAME' => $self->developer_key);
286             $headers->push_header('X-EBAY-API-APP-NAME' => $self->application_key);
287             $headers->push_header('X-EBAY-API-CERT-NAME' => $self->certificate_key);
288             $headers->push_header('X-EBAY-API-CALL-NAME' => $call);
289             $headers->push_header('X-EBAY-API-SITEID' => $self->site_id);
290             $headers->push_header('Content-Type' => 'text/xml');
291             return $headers;
292             }
293              
294             sub show_xml_template {
295             my ($self, $call, $call_type) = @_;
296             return $self->schema->template(PERL => $self->_xml_type($call, $call_type),
297             use_default_namespace => 1);
298             }
299              
300             sub _xml_type {
301             my ($self, $call, $call_type) = @_;
302             $call_type ||= 'Request';
303             die "Second argument must be Request or Response, defaulting to Request"
304             unless ($call_type eq 'Request' or $call_type eq 'Response');
305             return pack_type('urn:ebay:apis:eBLBaseComponents', $call . $call_type);
306             }
307              
308             sub prepare_xml {
309             my ($self, $name, $data) = @_;
310             $data ||= {};
311             # inject the token
312             $data->{RequesterCredentials}->{eBayAuthToken} = $self->token;
313             my $doc = XML::LibXML::Document->new('1.0', 'UTF-8');
314             my $type = $self->_xml_type($name);
315             my $write = $self->schema->compile(WRITER => $type,
316             use_default_namespace => 1);
317             my $xml = $write->($doc, $data);
318             $doc->setDocumentElement($xml);
319             return $doc->toString(1);
320             }
321              
322             =head1 CONVENIENCE METHODS
323              
324             =cut
325              
326             =head2 api_call_wrapper($call, $data, @ids)
327              
328             Call Ebay's API $call with data $data. Then check the response and
329             return it. This ends calling $self->api_call($call, $data), but after
330             that the response is checked and diagnostics are printed out. If you
331             want something quiet and which is not going to die, or you're
332             expecting invalid structures, you should use C directly.
333              
334             Return the response object. If no response object is found, it will
335             die.
336              
337             =head2 api_call_wrapper_silent($call, $data, @ids)
338              
339             Same as C, but do not emit "warn" on warnings. Just
340             print them out. Also, do not print ids or fees.
341              
342             =cut
343              
344             sub api_call_wrapper_silent {
345             my ($self, $call, $data, @identifiers) = @_;
346             my $res = $self->api_call($call, $data);
347             my $message = $call;
348             if (@identifiers) {
349             $message .= " on " . join(' ', @identifiers);
350             }
351             if ($res) {
352             if ($res->request_ok) {
353             if ($res->is_success) {
354             print "$message OK\n";
355             }
356             elsif ($res->errors) {
357             print "$message:\n" . $res->errors_as_string;
358             }
359             else {
360             print "$message not a success but no errors found (OK?)\n";
361             }
362             }
363             elsif ($res->errors) {
364             warn "$message:\n" . $res->errors_as_string;
365             }
366             else {
367             die "$message: Nor success, nor errors!" . Dumper($res);
368             }
369             }
370             else {
371             die "No response found!" . $self->last_response->status_line
372             . "\n" . $self->last_response->content;
373             }
374             return $res;
375             }
376              
377              
378             sub api_call_wrapper {
379             my ($self, $call, $data, @identifiers) = @_;
380             my $res = $self->api_call($call, $data);
381             my $message = $call;
382             if (@identifiers) {
383             $message .= " on " . join(' ', @identifiers);
384             }
385             if ($res) {
386             if ($res->is_success) {
387             print "$message OK\n";
388             }
389             elsif ($res->errors) {
390             warn "$message:\n" . $res->errors_as_string;
391             }
392             else {
393             die "$message: Nor success, nor errors!" . Dumper($res);
394             }
395             if (my $item_id = $res->item_id) {
396             print "$message: ebay id: $item_id\n";
397             }
398             my $fee = $res->total_listing_fee;
399             if (defined $fee) {
400             print "$message Fee is $fee\n";
401             }
402             }
403             else {
404             die "No response found!" . $self->last_response->status_line
405             . "\n" . $self->last_response->content;
406             }
407             return $res;
408             }
409              
410             =head2 cancel_item($identifier, $id, $reason)
411              
412             $identifier is mandatory and can be C or C (depending if
413             you do tracking by sku (this is possible only if the sku was uploaded
414             with InventoryTrackingMethod = SKU) or by ebay item id. The $id is
415             mandatory and is the sku or the ebay_id.
416              
417             Reason can be one of the following, defaulting to OtherListingError: Incorrect, LostOrBroken, NotAvailable, OtherListingError, SellToHighBidder, Sold.
418              
419             It calls EndFixedPriceItem, so this method is useful only for shops.
420              
421             =cut
422              
423             sub cancel_item {
424             my ($self, $key, $value, $reason) = @_;
425             die "Missing SKU or ItemID" unless $key;
426             my %mapping = (
427             SKU => 'sku',
428             ItemID => 'ebay_sku',
429             );
430             my %reasons = (
431             Incorrect => 1,
432             LostOrBroken => 1,
433             NotAvailable => 1,
434             OtherListingError => 1,
435             SellToHighBidder => 1,
436             Sold => 1,
437             );
438             die "Invalid key $key" unless $mapping{$key};
439             unless ($reason && $reasons{$reason}) {
440             $reason = 'OtherListingError';
441             }
442             die "Missing $key" unless $value;
443             my $res = $self
444             ->api_call_wrapper(EndFixedPriceItem => {
445             EndingReason => $reason,
446             ErrorLanguage => 'en_US',
447             $key => $value,
448             }, $key, $value);
449             return $res;
450             }
451              
452             =head2 delete_sku_variations($sku, \@list_of_sku_variations)
453              
454             It uses ReviseFixedPriceItem to cancel variations of a given sku, not
455             passing asking for a deletion, but instead setting the quantity to 0.
456             This because deleting a variation is not possible if a purchase has
457             been done against it.
458              
459             =cut
460              
461             sub delete_sku_variations {
462             my ($self, $sku, $list) = @_;
463             die unless $sku && $list;
464             my @delete = map { +{
465             Quantity => 0,
466             SKU => $_,
467             } } @$list;
468             my $data = {
469             ErrorLanguage => 'en_US',
470             WarningLevel => 'High',
471             Item => {
472             SKU => $sku,
473             Variations => {
474             Variation => \@delete,
475             }
476             },
477             };
478             my $res = $self->api_call_wrapper(ReviseFixedPriceItem => $data, $sku, "delete variations");
479             return $res;
480             }
481              
482             =head2 get_category_specifics($id)
483              
484             Return a dump of the structure found in the GetCategorySpecifics
485              
486             =cut
487              
488             sub get_category_specifics {
489             my ($self, $id) = @_;
490             die "Missing category id" unless $id;
491             my $res = $self->api_call_wrapper(GetCategorySpecifics => {
492             CategoryID => $id,
493             }, "category id $id");
494             return $res;
495             }
496              
497             =head2 get_orders($number_of_days)
498              
499             Retrieve the last orders in the last number of days, defaulting to 7.
500             Return a list of L objects. You can access
501             the raw structures with $object->order.
502              
503             =cut
504              
505             sub get_orders {
506             my ($self, $backlog) = @_;
507             $backlog ||= 7;
508             my $request = {
509             NumberOfDays => $backlog,
510             Pagination => {
511             PageNumber => 1,
512             EntriesPerPage => 100,
513             },
514             ErrorLanguage => 'en_US',
515             };
516             my $repeat = 1;
517             my @orders;
518             do {
519             # we use the silent variant because it's a known warning spammer.
520             my $obj = $self->api_call_wrapper_silent(GetOrders => $request);
521             my $res = $obj->struct;
522             if (exists $res->{OrderArray} and
523             exists $res->{OrderArray}->{Order}) {
524             foreach my $ord (@{$res->{OrderArray}->{Order}}) {
525             push @orders, Marketplace::Ebay::Order->new(order => $ord,
526             name_from_shipping_address => $self->name_from_shipping_address);
527             }
528             }
529             $repeat = $res->{HasMoreOrders};
530             $request->{Pagination}->{PageNumber}++;
531             } while ($repeat);
532              
533             return @orders;
534             }
535              
536             =head2 get_orders_for_site
537              
538             Like get_orders, but filter the orders by the site_id of the object
539             (otherwise you pull the orders from all the international sites).
540              
541             =cut
542              
543             sub get_orders_for_site {
544             my ($self, $backlog) = @_;
545             my @orders = $self->get_orders($backlog);
546             my $name = $self->site_code;
547             return grep { $_->ebay_site eq $name } @orders;
548             }
549              
550             =head2 ebay_site_code_types (internal)
551              
552             L
553             turned into an hashref to map the site name to an id.
554              
555             =head2 ebay_sites_name_to_id
556              
557             Return an hashref for mapping ebay site names and abbreviations to a numeric id.
558              
559             =head2 ebay_sites_id_to_name
560              
561             Return an hashref for mapping ebay site id to its name.
562             # http://developer.ebay.com/devzone/XML/docs/Reference/ebay/types/SiteCodeType.html
563              
564             =cut
565              
566             sub ebay_site_code_types {
567              
568             my %codes = (
569             Australia => { id => 15, abbreviation => "AU" },
570             Austria => { id => 16, abbreviation => "AT" },
571             Belgium_Dutch => { id => 123, abbreviation => "BENL" },
572             Belgium_French => { id => 23, abbreviation => "BEFR" },
573             Canada => { id => 2, abbreviation => "CA" },
574             CanadaFrench => { id => 210, abbreviation => "CAFR" },
575             France => { id => 71, abbreviation => "FR" },
576             Germany => { id => 77, abbreviation => "DE" },
577             HongKong => { id => 201, abbreviation => "HK" },
578             India => { id => 203, abbreviation => "IN" },
579             Ireland => { id => 205, abbreviation => "IE" },
580             Italy => { id => 101, abbreviation => "IT" },
581             Malaysia => { id => 207, abbreviation => "MY" },
582             Netherlands => { id => 146, abbreviation => "NL" },
583             Philippines => { id => 211, abbreviation => "PH" },
584             Poland => { id => 212, abbreviation => "PL" },
585             Russia => { id => 215, abbreviation => "RU" },
586             Singapore => { id => 216, abbreviation => "SG" },
587             Spain => { id => 186, abbreviation => "ES" },
588             Switzerland => { id => 193, abbreviation => "CH" },
589             UK => { id => 3, abbreviation => "UK" },
590             US => { id => 0, abbreviation => "US" },
591             );
592             return %codes;
593             }
594              
595             sub ebay_sites_name_to_id {
596             my $self = shift;
597             my %out;
598             my %codes = $self->ebay_site_code_types;
599             foreach my $k (keys %codes) {
600             $out{$k} = $codes{$k}{id};
601             $out{$codes{$k}{abbreviation}} = $codes{$k}{id};
602             }
603             return \%out;
604             }
605              
606             sub ebay_sites_id_to_name {
607             my $self = shift;
608             my %codes = $self->ebay_site_code_types;
609             my %out;
610             foreach my $k (keys %codes) {
611             $out{$codes{$k}{id}} = $k;
612             }
613             return \%out;
614             }
615              
616             =head1 AUTHOR
617              
618             Marco Pessotto, C<< >>
619              
620             =head1 BUGS
621              
622             Please report any bugs or feature requests to C, or through
623             the web interface at L. I will be notified, and then you'll
624             automatically be notified of progress on your bug as I make changes.
625              
626              
627              
628              
629             =head1 SUPPORT
630              
631             You can find documentation for this module with the perldoc command.
632              
633             perldoc Marketplace::Ebay
634              
635              
636             You can also look for information at:
637              
638             =over 4
639              
640             =item * RT: CPAN's request tracker (report bugs here)
641              
642             L
643              
644             =item * AnnoCPAN: Annotated CPAN documentation
645              
646             L
647              
648             =item * CPAN Ratings
649              
650             L
651              
652             =item * Search CPAN
653              
654             L
655              
656             =back
657              
658              
659             =head1 ACKNOWLEDGEMENTS
660              
661              
662             =head1 LICENSE AND COPYRIGHT
663              
664             Copyright 2014 Marco Pessotto.
665              
666             This program is free software; you can redistribute it and/or modify it
667             under the terms of either: the GNU General Public License as published
668             by the Free Software Foundation; or the Artistic License.
669              
670             See L for more information.
671              
672              
673             =cut
674              
675             1; # End of Marketplace::Ebay