File Coverage

blib/lib/SOAP/Amazon/MerchantTransport.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             package SOAP::Amazon::MerchantTransport;
2              
3 1     1   26523 use warnings;
  1         3  
  1         38  
4 1     1   6 use strict;
  1         2  
  1         58  
5              
6             =head1 NAME
7              
8             SOAP::Amazon::MerchantTransport - An easy to connect to Amazon Merchant Services
9              
10             =head1 VERSION
11              
12             Version 0.02
13             $Id: MerchantTransport.pm,v 1.1 2006/01/30 17:58:42 nathan Exp $
14              
15             =cut
16              
17             our $VERSION = '0.02';
18              
19 1     1   6 use Carp qw(carp croak);
  1         17  
  1         71  
20 1     1   462 use SOAP::Lite;
  0            
  0            
21             use MIME::Entity;
22             use Data::Dumper; $Data::Dumper::Indent = 1;
23              
24             die "SOAP::Amazon::MerchantTransport requires SOAP::Lite 0.67 or higher.\n"
25             unless $SOAP::Lite::VERSION >= 0.67;
26              
27             =head1 SYNOPSIS
28              
29             This module provides a simple way to access Amazon's Merchant Services via
30             SOAP. It is based on L.
31              
32             use SOAP::Amazon::MerchantTransport;
33              
34             my $a = SOAP::Amazon::MerchantTransport->new(
35             merchantname => 'Bill Shop',
36             merchant => 'Q_M_FOOBAR_1234',
37             username => 'joe@schmo.com.com',
38             password => 'SDNDJNDNFJDJ',
39             url => 'https://merchant-api-qa.amazon.com/foobar/'
40             );
41              
42             $som = $a->getAllPendingDocumentInfo($doctype);
43             $som = $a->getDocument($documentID);
44             $som = $a->postDocument($requesttype, $document);
45             $som = $a->postDocumentDownloadAck(@documentIdentifiers)
46              
47             All of these methods, by default return a L Object unless you
48             specify a handler for the return values.
49              
50             NOTE: It is possible to write your own handlers to return a different object,
51             but no such modules have been created at the time of this writing. Therefore
52             the documentation will always refer to the return value of the get/post
53             documents as being a L, but obviously if you specify a handler the
54             return object will be different.
55              
56             If you want to debug, simply import SOAP::Lite with debugging options
57             on into your script. This has the global effect of turning debugging on. e.g.
58              
59             use SOAP::Lite +trace => [qw( debug )];
60              
61             =head2 Module Scope
62              
63             This module is to ease the submission of XML Feeds to Amazon.
64              
65             This module does not write your Amazon XML Feeds, it only simplifies the
66             submission of those feeds. If you need help writing the Amazon XML Feeds for
67             pricing, inventory, orders, etc. view the sample feeds in the Amazon
68             Documentation. Contact your integration manager for access to these.
69              
70             Also this module does not handle SOAP errors for you. It uses L
71             to submit the XML requests and returns a L object, unless
72             another handler is specified.
73              
74             =cut
75              
76             # -------- Globals -------- #
77             our $gURI="http://www.amazon.com/merchants/merchant-interface/MerchantInterface";
78             our %gSOAPActionKeys = ( # STATIC - defined by Amazon WSDL
79             getAllPendingDocumentInfo => "KEx3YXNwY1NlcnZlci9BbXpJU0EvTWVyY2hhbnQ7TGphdmEvbGFuZy9TdHJpbmc7KVtMd2FzcGNTZXJ2ZXIvQW16SVNBL01lcmNoYW50RG9jdW1lbnRJbmZvOw==",
80             postDocument => "KEx3YXNwY1NlcnZlci9BbXpJU0EvTWVyY2hhbnQ7TGphdmEvbGFuZy9TdHJpbmc7TG9yZy9pZG9veC93YXNwL3R5cGVzL1JlcXVlc3RNZXNzYWdlQXR0YWNobWVudDspTHdhc3BjU2VydmVyL0FteklTQS9Eb2N1bWVudFN1Ym1pc3Npb25SZXNwb25zZTs=",
81             getDocument => "KEx3YXNwY1NlcnZlci9BbXpJU0EvTWVyY2hhbnQ7TGphdmEvbGFuZy9TdHJpbmc7TG9yZy9pZG9veC93YXNwL3R5cGVzL1Jlc3BvbnNlTWVzc2FnZUF0dGFjaG1lbnQ7KUxqYXZhL2xhbmcvU3RyaW5nOw==",
82             postDocumentDownloadAck => "KEx3YXNwY1NlcnZlci9BbXpJU0EvTWVyY2hhbnQ7W0xqYXZhL2xhbmcvU3RyaW5nOylbTHdhc3BjU2VydmVyL0FteklTQS9Eb2N1bWVudERvd25sb2FkQWNrU3RhdHVzOw==",
83             getDocumentProcessingStatus => "KEx3YXNwY1NlcnZlci9BbXpJU0EvTWVyY2hhbnQ7SilMd2FzcGNTZXJ2ZXIvQW16SVNBL0RvY3VtZW50UHJvY2Vzc2luZ0luZm87",
84             getLastNDocumentInfo => "KEx3YXNwY1NlcnZlci9BbXpJU0EvTWVyY2hhbnQ7TGphdmEvbGFuZy9TdHJpbmc7SSlbTHdhc3BjU2VydmVyL0FteklTQS9NZXJjaGFudERvY3VtZW50SW5mbzs=",
85             );
86              
87             our %gMessageTypes = ( # STATIC
88             product => "_POST_PRODUCT_DATA_",
89             productRelationship => "_POST_PRODUCT_RELATIONSHIP_DATA_",
90             productOverrides => "_POST_PRODUCT_OVERRIDES_DATA_",
91             image => "_POST_PRODUCT_IMAGE_DATA_",
92             productPricing => "_POST_PRODUCT_PRICING_DATA_",
93             inventory => "_POST_INVENTORY_AVAILABILITY_DATA_",
94             testOrders => "_POST_TEST_ORDERS_DATA_",
95             orderAck => "_POST_ORDER_ACKNOWLEDGEMENT_DATA_",
96             orderFulfillment => "_POST_ORDER_FULFILLMENT_DATA_",
97             paymentAdjustment => "_POST_PAYMENT_ADJUSTMENT_DATA_",
98             storeData => "_POST_STORE_DATA_",
99              
100             _POST_PRODUCT_DATA_ => "_POST_PRODUCT_DATA_",
101             _POST_PRODUCT_RELATIONSHIP_DATA_ => "_POST_PRODUCT_RELATIONSHIP_DATA_",
102             _POST_PRODUCT_OVERRIDES_DATA_ => "_POST_PRODUCT_OVERRIDES_DATA_",
103             _POST_PRODUCT_IMAGE_DATA_ => "_POST_PRODUCT_IMAGE_DATA_",
104             _POST_PRODUCT_PRICING_DATA_ => "_POST_PRODUCT_PRICING_DATA_",
105             _POST_INVENTORY_AVAILABILITY_DATA_=> "_POST_INVENTORY_AVAILABILITY_DATA_",
106             _POST_TEST_ORDERS_DATA_ => "_POST_TEST_ORDERS_DATA_",
107             _POST_ORDER_ACKNOWLEDGEMENT_DATA_ => "_POST_ORDER_ACKNOWLEDGEMENT_DATA_",
108             _POST_ORDER_FULFILLMENT_DATA_ => "_POST_ORDER_FULFILLMENT_DATA_",
109             _POST_PAYMENT_ADJUSTMENT_DATA_ => "_POST_PAYMENT_ADJUSTMENT_DATA_",
110             _POST_STORE_DATA_ => "_POST_STORE_DATA_",
111             );
112              
113             our %gPendingValid = ( # STATIC
114             orders => "_GET_ORDERS_DATA_",
115             payments => "_GET_PAYMENT_SETTLEMENT_DATA_",
116             _GET_ORDERS_DATA_ => "_GET_ORDERS_DATA_",
117             _GET_PAYMENT_SETTLEMENT_DATA_ => "_GET_PAYMENT_SETTLEMENT_DATA_",
118             );
119              
120             # ------ End Globals ------ #
121              
122             =head1 CONSTRUCTOR AND STARTUP
123              
124             =head2 $sub->new( );
125              
126             Creating a new MerchantTransport object is easy:
127             my $a = SOAP::Amazon::MerchantTransport->new(
128             merchantname => 'Bill Shop',
129             merchant => 'Q_M_FOOBAR_1234',
130             username => 'joe@schmo.com.com',
131             password => 'SDNDJNDNFJDJ',
132             url => 'https://merchant-api-qa.amazon.com/foobar/'
133             );
134              
135             All of these parameters are required.
136              
137             If you want the response to be something other than an L object
138             you can pass in the qualified name of the module you want to use as the
139             return values. e.g.
140             ...
141             handler => 'SOAP::Amazon::MSReturnVal',
142             ...
143             This module is currently ficticious. See L
144             for more information.
145              
146             =cut
147              
148             sub new
149             {
150             my $class = shift;
151             my %args = @_;
152             my $self = bless {}, $class;
153              
154             for (qw/merchantname merchant username password url/) {
155             $self->{$_} = $args{$_} or croak "Need to set $_ when calling 'new'";
156             }
157             for (qw/handler/) {
158             $self->{$_} = $args{$_} if $args{$_};
159             }
160             $self
161             }
162              
163              
164             =head1 METHODS
165              
166             =cut
167              
168             =head2 $a->getAllPendingDocumentInfo( $doctype )
169              
170             Given a type of document to retrieve, returns an array of TODO s.
171              
172             Valid values for the $doctype are: C, or C. You can also
173             pass the exact values Amazon calls for: C<_GET_ORDERS_DATA_> or
174             C<_GET_PAYMENT_SETTLEMENT_DATA_>, but the first method is preferred.
175              
176             =cut
177              
178             sub getAllPendingDocumentInfo
179             {
180             my $this = shift;
181             my ($msgtype) = @_;
182             croak "$msgtype is not a valid msgtype. Try 'orders' or 'payments'."
183             unless defined $gPendingValid{$msgtype};
184              
185             my $soap=$this->_getsoap
186             ->getAllPendingDocumentInfo( ams => $this,
187             messagetype => $gPendingValid{$msgtype});
188             $this->returnsoap($soap)
189             }
190              
191             =head2 $a->getDocumentProcessingStatus( $documentID )
192              
193             Given the documentTransactionID (given to you by Amazon) returns a
194             L containing the document.
195              
196             =cut
197              
198             sub getDocumentProcessingStatus {
199             my $this = shift;
200             my $docid = $_[0];
201             my $soap = $this->_getsoap
202             ->getDocumentProcessingStatus( ams => $this, docid => $docid );
203             $this->returnsoap($soap)
204             }
205              
206             =head2 $a->getDocument( $documentID )
207              
208             Given the DocumentID received from getAllPendingDocumentInfo returns the
209             a L containing the return values.
210              
211             =cut
212              
213             sub getDocument {
214             my $this = shift;
215             my ($docid) = @_;
216             my $soap = $this->_getsoap
217             ->getDocument( ams => $this, docid => $docid );
218             $this->returnsoap($soap)
219             }
220              
221             =head2 $a->postDocument( $requesttype, $localID, $content )
222              
223             Given a request type string, local identifier, and an Amazon xml content
224             string returns a L containing the return values.
225              
226             Valid Request Types are:
227              
228             product
229             productRelationship
230             productOverrides
231             productImage
232             productPricing
233             inventoryAvailability
234             testOrders
235             orderAck
236             orderFulfillment
237             paymentAdjustment
238             storeData
239              
240             $localID is a local identifier. You could try L.
241              
242             $content is a string containing the XML you want to post to Amazon.
243              
244             =cut
245              
246             sub postDocument {
247             my $this = shift;
248             my ($rt, $id, $con) = @_;
249             croak "$rt is not a valid request type. See ".__FILE__." docs or Amazon API"
250             unless defined $gMessageTypes{$rt};
251              
252             my $ent = build MIME::Entity
253             Type => "application/octetstream",
254             Encoding => "binary",
255             Disposition => "attachment",
256             Id => "<".$id.">",
257             Data => $con;
258              
259             my @parts = ($ent);
260             #Carp::confess(Data::Dumper::Dumper(\@parts));
261              
262             my $soap = $this->_getsoap
263             ->parts(\@parts)
264             ->serializer(AMSSerializer->new)
265             ->postDocument( ams => $this,
266             messagetype => $gMessageTypes{$rt},
267             contentid => $id );
268             $this->returnsoap($soap)
269             }
270              
271             =head2 $a->postDocumentDownloadAck( @documentIdentifiers )
272              
273             TODO
274              
275             =cut
276              
277             sub postDocumentDownloadAck {
278             }
279              
280             =head2 $a->merchantname( [$merchantname] )
281             =head2 $a->merchant( [$merchant] )
282             =head2 $a->username( [$username] )
283             =head2 $a->password( [$password] )
284             =head2 $a->url( [$url] )
285              
286             If no argument is given it returns the appropriate value. If there is an
287             argument the value is set.
288              
289             Examples:
290              
291             $a->merchantname('Foo Bar Merch');
292             $a->merchant('Q_M_FOOBAR_1234');
293             $a->username('joe@schmo.com');
294             $a->password('raboof');
295             $a->url('https://merchant-api-qa.amazon.com/whatever/');
296              
297             my $m = $a->merchant; # $m is now 'Q_M_FOOBAR_1234'
298             etc...
299              
300             =cut
301              
302             sub merchant { $_[1] ? shift->{merchant} = $_[1] : shift->{merchant} }
303             sub username { $_[1] ? shift->{username} = $_[1] : shift->{username} }
304             sub password { $_[1] ? shift->{password} = $_[1] : shift->{password} }
305             sub url { $_[1] ? shift->{url} = $_[1] : shift->{url} }
306             sub merchantname { $_[1] ? shift->{merchantname}=$_[1] : shift->{merchantname}}
307              
308             =head1 Writing Your Own Response Handler
309              
310             TODO: this feauture is not yet complete.
311              
312             =cut
313              
314             sub returnsoap
315             {
316             my $this = shift;
317             # TODO this is where you would add the handler to return something
318             # other than a SOAP::SOM
319             $_[0]
320             }
321              
322             ############################################
323             # Private Methods
324             ############################################
325              
326             sub _getsoap
327             {
328             my $this = shift;
329             (my $funcname = (caller(1))[3]) =~ s/.*::(\w+)$/$1/;
330             my $soap = SOAP::Lite
331             ->on_action( sub { return "\"$gURI#$funcname#" .
332             $gSOAPActionKeys{$funcname} .
333             "\""; } )
334             ->ns( $gURI )
335             ->proxy( $this->proxy )
336             ->serializer(AMSSerializer->new);
337            
338             $soap
339             }
340              
341             sub proxy
342             {
343             my $this = shift;
344             local $_ = $this->url;
345             s/(?<=^https:\/\/)/\%s:\%s\@/ or die "$_ must use https:";
346             sprintf $_, map $this->url_encode($_), $this->username, $this->password
347             }
348              
349             sub url_encode
350             {
351             my $this = shift;
352             local $_ = $_[0];
353             s/(\W)/sprintf'%%%02X',ord$1/eg;
354             $_
355             }
356             1; # End of SOAP::Amazon::MerchantTransport
357              
358             ############################################
359             # package AMSSerializer
360             ############################################
361              
362             BEGIN {
363             package AMSSerializer; @AMSSerializer::ISA = 'SOAP::Serializer';
364             import SOAP::Data qw/name value/;
365              
366             sub envelope {
367             my $this = shift;
368             my ($morr, $func, %args) = @_;
369             my ($ms, $mtype, $content, $conid, $docid, $howmany) =
370             ($args{ams}, $args{messagetype}, $args{content},
371             $args{contentid}, $args{docid}, $args{howmany});
372             my @data;
373             my $docidtag;
374             my $ans= $gURI;
375             my $sns='http://systinet.com/xsd/SchemaTypes/';
376              
377             if ($docid) {
378             $docidtag = $func =~ /getDocumentProcessingStatus/ ?
379             "documentTransactionIdentifier" :
380             $func =~ /getDocument/ ?
381             "documentIdentifier" :
382             "documentIdentifier";
383             }
384              
385             if ($docid) {
386             for($func) {
387             if (/getDocumentProcessingStatus/) {
388             push @data, name(getDocumentProcessingStatus => $docid)->type("long");
389             }
390             elsif (/getDocument/) {
391             push @data, name(getDocument => $docid)->type("string");
392             }
393             }
394             }
395              
396             push @data, name(messageType => $mtype) if $mtype;
397             push @data, name(howMany => $howmany) if $howmany;
398             push @data, name("doc")->uri($sns)->attr({href => "cid:$conid"}) if $conid;
399              
400             $this->SUPER::envelope(freeform =>
401             name(merchant =>
402             \SOAP::Data->value( # note the dereferencing
403             name(merchantIdentifier=>$ms->merchant)->uri($ans),
404             name(merchantName => $ms->merchantname)->uri($ans)
405             ) # end value
406             )->uri($sns), # end merchant
407             @data
408             ); # end SUPER::envelope
409             } # end envelope
410              
411             1;
412             } # end BEGIN block
413              
414             ############################################
415             # end AMSSerializer
416             ############################################
417              
418             =head1 AUTHOR
419              
420             Nate Murray, C<< >>
421              
422             =head1 KNOWN BUGS AND LIMITATIONS
423              
424             There are no known bugs as of version 0.2, just a couple incomplete features.
425              
426             Please report any bugs or feature requests to
427             C, or through the web interface at
428             L.
429             I will be notified, and then you'll automatically be notified of progress on
430             your bug as I make changes.
431              
432             =head1 SUPPORT
433              
434             You can find documentation for this module with the perldoc command.
435              
436             perldoc SOAP::Amazon::MerchantTransport
437              
438             You can also look for information at:
439              
440             =over 4
441              
442             =item * AnnoCPAN: Annotated CPAN documentation
443              
444             L
445              
446             =item * CPAN Ratings
447              
448             L
449              
450             =item * RT: CPAN's request tracker
451              
452             L
453              
454             =item * Search CPAN
455              
456             L
457              
458             =back
459              
460             =head1 COPYRIGHT & LICENSE
461              
462             Copyright 2006 Nate Murray, all rights reserved.
463              
464             This program is free software; you can redistribute it and/or modify it
465             under the same terms as Perl itself.
466              
467             =cut
468