File Coverage

blib/lib/Amazon/MWS/XML/Order.pm
Criterion Covered Total %
statement 77 122 63.1
branch 8 22 36.3
condition 3 7 42.8
subroutine 23 37 62.1
pod 19 19 100.0
total 130 207 62.8


line stmt bran cond sub pod time code
1             package Amazon::MWS::XML::Order;
2              
3 7     7   91075 use Amazon::MWS::XML::Address;
  7         30  
  7         308  
4 7     7   2935 use Amazon::MWS::XML::OrderlineItem;
  7         37  
  7         396  
5              
6 7     7   81 use strict;
  7         22  
  7         202  
7 7     7   48 use warnings;
  7         25  
  7         243  
8 7     7   4829 use DateTime;
  7         3409877  
  7         408  
9 7     7   3379 use DateTime::Format::ISO8601;
  7         705304  
  7         470  
10 7     7   769 use Data::Dumper;
  7         9111  
  7         633  
11              
12 7     7   60 use Moo;
  7         16  
  7         68  
13 7     7   6307 use MooX::Types::MooseLike::Base qw(:all);
  7         51681  
  7         3474  
14 7     7   80 use namespace::clean;
  7         18  
  7         202  
15              
16             =head1 NAME
17              
18             Amazon::MWS::XML::Order
19              
20             =head1 DESCRIPTION
21              
22             Class to handle the xml structures returned by ListOrders and
23             ListOrderItems.
24              
25             The constructor is meant to be called by L<Amazon::MWS::Uploader> when
26             C<get_orders> is called. A list of objects of this class will be
27             returned.
28              
29             =head1 SYNOPSIS
30              
31             my $order = Amazon::MWS::XML::Order->new(order => $struct, orderline => \@struct);
32             my @items = $order->items;
33             print $order->order_number, $order->amazon_order_number;
34              
35             =head1 ACCESSORS
36              
37             They should be passed to the constructor and are complex structures
38             parsed from the output of L<Amazon::MWS::Client>.
39              
40             =head2 order
41              
42             It should be the output of C<ListOrders> or C<GetOrder> without the
43             root, e.g. C<$response->{Orders}->{Order}->[0]>
44              
45             Field description:
46              
47             http://docs.developer.amazonservices.com/en_US/orders/2013-09-01/Orders_GetOrder.html
48              
49             =head2 orderline
50              
51             It should be the output of C<ListOrderItems> without the root, like
52             C<$response->{OrderItems}->{OrderItem}>.
53              
54             =head2 retrieve_orderline_sub
55              
56             If you want to save API calls, instead of initialize the orderline,
57             you may want to pass a subroutine (which will accept no arguments, so
58             it should be a closure) to the constructor instead, which will be
59             called lazily if the object needs to access the orderline.
60              
61             =head2 order_number
62              
63             Our order ID.
64              
65             =head2 shipping_address
66              
67             Shipping address as C<Amazon::MWS::Client::Address> object.
68              
69             =cut
70              
71              
72             has order => (is => 'rw',
73             required => 1,
74             isa => HashRef);
75              
76             has orderline => (is => 'lazy',
77             isa => ArrayRef);
78              
79             has retrieve_orderline_sub => (is => 'ro',
80             isa => CodeRef);
81              
82              
83             sub _build_orderline {
84 1     1   10 my $self = shift;
85 1         4 my $sub = $self->retrieve_orderline_sub;
86 1 50       4 die "Missing retrieve_orderline_sub" unless $sub;
87 1         3 return $sub->();
88             }
89              
90             has order_number => (is => 'rw');
91              
92              
93             =head1 METHODS
94              
95             They are mostly shortcuts to retrieve the correct information.
96              
97             =cut
98              
99             sub amazon_order_number {
100 3     3 1 134 return shift->order->{AmazonOrderId};
101             }
102              
103             =head2 amazon_order_number
104              
105             The Amazon order id.
106              
107             =head2 remote_shop_order_id
108              
109             Same as C<amazon_order_number>
110              
111             =cut
112              
113             sub remote_shop_order_id {
114 1     1 1 10 return shift->amazon_order_number;
115             }
116              
117              
118             =head2 email
119              
120             Buyer's email
121              
122             =cut
123              
124             sub email {
125 0     0 1 0 return shift->order->{BuyerEmail};
126             }
127              
128             =head2 shipping_address
129              
130             An L<Amazon::MWS::XML::Address> object with the shipping address.
131              
132             =cut
133              
134             has shipping_address => (is => 'lazy');
135            
136             sub _build_shipping_address {
137 2     2   541 my $self = shift;
138 2         27 my $address = $self->order->{ShippingAddress};
139 2         59 return Amazon::MWS::XML::Address->new(%$address);
140             }
141              
142             =head2 first_name
143              
144             Buyer's first name (built lazily using euristics).
145              
146             =head2 last_name
147              
148             Buyer's last_name (built lazily using euristics)
149              
150             =cut
151              
152             has first_name => (is => 'lazy');
153              
154             sub _build_first_name {
155 2     2   104 my $self = shift;
156 2         41 my ($first, $last) = $self->_get_first_last_name;
157 2   100     14 return $first || '';
158             }
159              
160             has last_name => (is => 'lazy');
161              
162             sub _build_last_name {
163 2     2   18 my $self = shift;
164 2         5 my ($first, $last) = $self->_get_first_last_name;
165 2   50     14 return $last || '';
166             }
167              
168             sub _get_first_last_name {
169 4     4   10 my $self = shift;
170 4         66 my $address = $self->shipping_address;
171 4 50       48 die "Missing name in shipping address" unless $address->name;
172             # this is totally euristic
173 4         10 my ($first_name, $last_name) = ('', '');
174 4 50       15 if (my $name = $address->name) {
175 4 100       43 if ($name =~ m/\s*(.+?)\s+([\w-]+)\s*$/) {
    50          
176 2         5 $first_name = $1;
177 2         3 $last_name = $2;
178             }
179             elsif ($name =~ m/\s*(.+?)\s*$/) {
180             # nothing to split, so this is just the last name
181 2         7 $last_name = $1;
182             }
183             }
184 4         14 return ($first_name, $last_name);
185             }
186              
187              
188             has items_ref => (is => 'lazy');
189              
190             sub _build_items_ref {
191 2     2   17 my ($self) = @_;
192 2         30 my $orderline = $self->orderline;
193 2         591 my @items;
194 2         6 foreach my $item (@$orderline) {
195             # print Dumper($item);
196 2         28 push @items, Amazon::MWS::XML::OrderlineItem->new(%$item);
197             }
198 2         38 return \@items;
199             }
200              
201             =head2 items
202              
203             Return a list of L<Amazon::MWS::XML::OrderlineItem> objects with the
204             ordered items.
205              
206             =cut
207              
208             sub items {
209 3     3 1 544 my $self = shift;
210 3         5 return @{ $self->items_ref };
  3         55  
211             }
212              
213             =head2 order_date
214              
215             Return a L<DateTime> object with th purchase date.
216              
217             =cut
218              
219             sub order_date {
220 0     0 1 0 my ($self) = @_;
221 0         0 return $self->_get_dt($self->order->{PurchaseDate});
222             }
223              
224             sub _get_dt {
225 0     0   0 my ($self, $date) = @_;
226 0         0 return DateTime::Format::ISO8601->parse_datetime($date);
227             }
228              
229             =head2 shipping_cost
230              
231             The total shipping cost, built summing up the shipping cost of each
232             item.
233              
234             =cut
235              
236              
237             sub shipping_cost {
238 0     0 1 0 my $self = shift;
239 0         0 my @items = $self->items;
240 0         0 my $shipping = 0;
241 0         0 foreach my $i (@items) {
242 0         0 $shipping += $i->shipping;
243             }
244 0         0 return sprintf('%.2f', $shipping);
245             }
246              
247             =head2 subtotal
248              
249             The subtotal of the order, built summing up the subtotal of each
250             orderline's item.
251              
252             =cut
253              
254             sub subtotal {
255 1     1 1 2538 my $self = shift;
256 1         4 my @items = $self->items;
257 1         4 my $total = 0;
258 1         4 foreach my $i (@items) {
259 1         6 $total += $i->subtotal;
260             }
261 1         14 return sprintf('%.2f', $total);
262             }
263              
264             =head2 number_of_items
265              
266             Total number of items ordered.
267              
268             =cut
269              
270             sub number_of_items {
271 0     0 1 0 my $self = shift;
272 0         0 my @items = $self->items;
273 0         0 my $total = 0;
274 0         0 foreach my $i (@items) {
275 0         0 $total += $i->quantity;
276             }
277 0         0 return $total;
278             }
279              
280             =head2 total_cost;
281              
282             Return OrderTotal.Amount. Throws an exception if it doesn't match
283             shipping_cost + subtotal.
284              
285             =cut
286              
287              
288             sub total_cost {
289 0     0 1 0 my $self = shift;
290 0         0 my $total_cost = sprintf('%.2f', $self->order->{OrderTotal}->{Amount});
291 0 0       0 die "Couldn't retrieve the OrderTotal/Amount " . Dumper($self->order)
292             unless defined $total_cost;
293 0         0 my $subtotal = $self->subtotal;
294 0         0 my $shipping = $self->shipping_cost;
295 0 0       0 if (_kinda_equal($subtotal + $shipping, $total_cost)) {
296 0         0 return $total_cost;
297             }
298             else {
299 0         0 die "subtotal $subtotal + shipping $shipping is not $total_cost\n";
300             }
301             }
302              
303             =head2 currency
304              
305             The currency of the order. Looked up in OrderTotal.CurrencyCode.
306              
307             =cut
308              
309             sub currency {
310 0     0 1 0 my $self = shift;
311 0         0 my $currency = $self->order->{OrderTotal}->{CurrencyCode};
312 0 0       0 die "Couldn't find OrderTotal/Currency " . Dumper($self->order)
313             unless $currency;
314 0         0 return $currency;
315             }
316              
317             =head2 as_ack_order_hashref
318              
319             Return an hashref suitable to build an order ack feed.
320              
321             =cut
322              
323             sub as_ack_order_hashref {
324 0     0 1 0 my $self = shift;
325 0         0 my @items;
326 0         0 foreach my $item ($self->items) {
327 0         0 push @items, $item->as_ack_orderline_item_hashref;
328             }
329             return {
330 0         0 AmazonOrderID => $self->amazon_order_number,
331             MerchantOrderID => $self->order_number,
332             Item => \@items,
333             };
334             }
335              
336             sub _kinda_equal {
337 0     0   0 return abs($_[0] - $_[1]) < 0.01;
338             }
339              
340             =head2 reported_order_number
341              
342             If the order was acknowlegded, we should find our order number in this
343             method (read-only, use the C<order_number> setter if you need to
344             ackwnoledge.
345              
346             =cut
347              
348             sub reported_order_number {
349 0     0 1 0 return shift->order->{SellerOrderId};
350             }
351              
352             =head2 order_is_shipped
353              
354             Return true if the order is marked as shipped by Amazon
355              
356             =cut
357              
358             sub order_is_shipped {
359 2     2 1 4 my $self = shift;
360 2         6 my $status = $self->order_status;
361 2 50       23 $status eq 'Shipped' ? return 1 : return;
362             }
363              
364             =head2 order_status
365              
366             Shortcut to orders' OrderStatus
367              
368             =cut
369              
370             sub order_status {
371 2     2 1 44 return shift->order->{OrderStatus};
372             }
373              
374             =head2 can_be_imported
375              
376             Return false if the status is Pending or Canceled.
377              
378             =cut
379              
380             sub can_be_imported {
381 0     0 1 0 my $self = shift;
382 0         0 my $status = $self->order_status;
383 0 0 0     0 if ($status eq 'Pending' or
384             $status eq 'Canceled') {
385 0         0 return;
386             }
387             else {
388 0         0 return 1;
389             }
390             }
391              
392              
393             =head2 shop_type
394              
395             Returns C<amazon>
396              
397             =head2 comments
398              
399             Returns an empty string.
400              
401             =head2 payment_method
402              
403             Always returns C<Amazon>
404              
405             =head2 shipping_method
406              
407             Returns the generic ShipmentServiceLevelCategory (not the
408             ShipServiceLevel which is a non-typed string).
409              
410             http://docs.developer.amazonservices.com/en_US/orders/2013-09-01/Orders_Datatypes.html
411              
412             Available values:
413              
414             =over 4
415              
416             =item Expedited
417              
418             =item FreeEconomy
419              
420             =item NextDay
421              
422             =item SameDay
423              
424             =item SecondDay
425              
426             =item Scheduled
427              
428             =item Standard
429              
430             =back
431              
432             Or the empty string if nothing is found.
433              
434             =cut
435              
436             sub shop_type {
437 0     0 1 0 return 'amazon';
438             }
439              
440             sub comments {
441             # unclear if we have something like that
442 0     0 1 0 return '';
443             }
444              
445             sub payment_method {
446 0     0 1 0 return 'Amazon';
447             }
448              
449             sub shipping_method {
450             # this should return
451 1     1 1 26 my $order = shift->order;
452 1 50       10 if (my $shipping = $order->{ShipmentServiceLevelCategory}) {
453 1         4 return $shipping;
454             }
455             else {
456 0           return '';
457             }
458             }
459              
460              
461             1;