File Coverage

blib/lib/Webservice/Shipment/Carrier/USPS.pm
Criterion Covered Total %
statement 66 67 98.5
branch 15 24 62.5
condition 1 2 50.0
subroutine 15 16 93.7
pod 6 6 100.0
total 103 115 89.5


line stmt bran cond sub pod time code
1             package Webservice::Shipment::Carrier::USPS;
2              
3 2     2   55427 use Mojo::Base 'Webservice::Shipment::Carrier';
  2         12  
  2         13  
4              
5 2     2   257 use constant DEBUG => $ENV{MOJO_SHIPMENT_DEBUG};
  2         4  
  2         102  
6              
7 2     2   283 use Mojo::Template;
  2         2671  
  2         11  
8 2     2   55 use Mojo::URL;
  2         4  
  2         7  
9 2     2   39 use Mojo::IOLoop;
  2         4  
  2         11  
10 2     2   321 use Time::Piece;
  2         4811  
  2         8  
11              
12             has api_url => sub { Mojo::URL->new('http://production.shippingapis.com/ShippingAPI.dll?API=TrackV2') };
13              
14             has template => <<'XML';
15             % my ($self, $id) = @_;
16            
17            
18             1
19             127.0.0.1
20             Restore Health
21            
22            
23             XML
24              
25             has validation_regex => sub { qr/\b(9\d\d\d ?\d\d\d\d ?\d\d\d\d ?\d\d\d\d ?\d\d\d\d ?\d\d|91\d\d ?\d\d\d\d ?\d\d\d\d ?\d\d\d\d ?\d\d\d\d)\b/i };
26              
27             sub human_url {
28 4     4 1 13 my ($self, $id, $dom) = @_;
29 4         21 return Mojo::URL->new('https://tools.usps.com/go/TrackConfirmAction')->query(tLabels => $id);
30             }
31              
32             sub extract_destination {
33 18     18 1 35 my ($self, $id, $dom, $target) = @_;
34              
35 18         65 my %targets = (
36             postal_code => 'DestinationZip',
37             state => 'DestinationState',
38             city => 'DestinationCity',
39             country => 'DestinationCountryCode',
40             );
41              
42 18 100       55 my $t = $targets{$target} or return;
43 12 100       27 my $addr = $dom->at($t) or return;
44 9         2095 return $addr->text;
45             }
46              
47             sub extract_service {
48 3     3 1 10 my ($self, $id, $dom) = @_;
49 3         8 my $class = $dom->at('Class');
50 3         457 my $service = 'USPS';
51 3 50       9 $service .= ' ' . $class->text if $class;
52 3         94 return $service;
53             }
54              
55             sub extract_status{
56 3     3 1 10 my ($self, $id, $dom) = @_;
57 3         9 my $summary = $dom->at('TrackSummary');
58 3 50       2116 return unless $summary;
59 3         26 my $event = $summary->at('Event')->text;
60 3 50       716 my $delivered = ($event =~ /delivered/i) ? 1 : 0;
61              
62 3         10 my $desc = $dom->at('StatusSummary');
63 3 50       1898 $desc = $desc ? $desc->text : $event;
64              
65 3         91 my $date = $summary->at('EventDate');
66 3 50       550 $date = $date ? $date->text : '';
67 3         84 my $fmt = '%B %d, %Y';
68              
69 3 50       9 if ($date) {
70 3 50       9 if (my $time = $summary->at('EventTime')) {
71 3         449 $time = $time->text;
72 3         74 $date .= " T $time";
73 3         6 $fmt .= ' T %H:%M %p';
74             }
75 3   50     9 $date = eval { Time::Piece->strptime($date, $fmt) } || '';
76 3 50       425 warn $@ if $@;
77             }
78 3         18 return ($desc, $date, $delivered);
79             }
80              
81 3     3 1 9 sub extract_weight { '' }
82              
83             sub request {
84 3     3 1 20 my ($self, $id, $cb) = @_;
85              
86 3         15 my $xml = Mojo::Template->new->render($self->template, $self, $id);
87 3         4301 warn "Request:\n$xml" if DEBUG;
88 3         14 my $url = $self->api_url->clone->query({XML => $xml});
89              
90 3 100       1015 unless ($cb) {
91 2         11 my $tx = $self->ua->get($url);
92 2         4900 return _handle_response($tx);
93             }
94              
95             Mojo::IOLoop->delay(
96 1     1   153 sub { $self->ua->get($url, shift->begin) },
97             sub {
98 1     1   2475 my ($ua, $tx) = @_;
99 1 50       10 die $tx->error->{message} unless $tx->success;
100 1         23 my $dom = _handle_response($tx);
101 1         349 $self->$cb(undef, $dom);
102             },
103 1     0   11 )->tap(on => error => sub{ $self->$cb($_[1], undef) })->wait;
  0         0  
104             }
105              
106             sub _handle_response {
107 3     3   6 my $tx = shift;
108 3         9 my $dom = $tx->res->dom;
109 3         29720 warn "Response:\n$dom\n" if DEBUG;
110 3         16 return $dom->at('TrackResponse TrackInfo');
111             }
112              
113             1;
114              
115             =head1 NAME
116              
117             Webservice::Shipment::Carrier::USPS - USPS handling for Webservice::Shipment
118              
119             =head1 DESCRIPTION
120              
121             Implements USPS handling for L.
122             It is a subclass of L which implements all the necessary methods.
123              
124             =head1 ATTRIBUTES
125              
126             L implements all of the attributes from L and implements the following new ones
127              
128             =head2 template
129              
130             The string template used with L to format the request.
131              
132             =head1 NOTES
133              
134             The service does not provide weight information, so C will always return an empty string.
135