line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Webservice::Shipment::Carrier::UPS; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
246479
|
use Mojo::Base 'Webservice::Shipment::Carrier'; |
|
2
|
|
|
|
|
11
|
|
|
2
|
|
|
|
|
15
|
|
4
|
|
|
|
|
|
|
|
5
|
2
|
|
|
2
|
|
1112
|
use Mojo::Template; |
|
2
|
|
|
|
|
7312
|
|
|
2
|
|
|
|
|
12
|
|
6
|
2
|
|
|
2
|
|
66
|
use Mojo::URL; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
11
|
|
7
|
2
|
|
|
2
|
|
45
|
use Mojo::IOLoop; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
9
|
|
8
|
2
|
|
|
2
|
|
42
|
use Mojo::IOLoop::Delay; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
8
|
|
9
|
2
|
|
|
2
|
|
1039
|
use Time::Piece; |
|
2
|
|
|
|
|
12916
|
|
|
2
|
|
|
|
|
8
|
|
10
|
2
|
|
|
2
|
|
158
|
use Carp; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
120
|
|
11
|
|
|
|
|
|
|
|
12
|
2
|
|
|
2
|
|
12
|
use constant DEBUG => $ENV{MOJO_SHIPMENT_DEBUG}; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
2545
|
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
has api_key => sub { croak 'api_key is required' }; |
15
|
|
|
|
|
|
|
has api_url => sub { Mojo::URL->new('https://wwwcie.ups.com/ups.app/xml/Track') }; |
16
|
|
|
|
|
|
|
has carrier_description => sub { 'UPS' }; |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
has template => <<'TEMPLATE'; |
19
|
|
|
|
|
|
|
% my ($self, $id) = @_; |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
<%== $self->api_key %> |
23
|
|
|
|
|
|
|
<%== $self->username %> |
24
|
|
|
|
|
|
|
<%== $self->password %> |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
<%== $id %> |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
Track |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
<%== $id %> |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
TEMPLATE |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
has validation_regex => sub { qr/\b(1Z ?[0-9A-Z]{3} ?[0-9A-Z]{3} ?[0-9A-Z]{2} ?[0-9A-Z]{4} ?[0-9A-Z]{3} ?[0-9A-Z]|[\dT]\d\d\d ?\d\d\d\d ?\d\d\d)\b/i }; |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
sub extract_destination { |
41
|
24
|
|
|
24
|
1
|
56
|
my ($self, $id, $dom, $target) = @_; |
42
|
|
|
|
|
|
|
|
43
|
24
|
|
|
|
|
111
|
my %targets = ( |
44
|
|
|
|
|
|
|
postal_code => 'PostalCode', |
45
|
|
|
|
|
|
|
state => 'StateProvinceCode', |
46
|
|
|
|
|
|
|
city => 'City', |
47
|
|
|
|
|
|
|
country => 'CountryCode', |
48
|
|
|
|
|
|
|
address1 => 'AddressLine1', |
49
|
|
|
|
|
|
|
address2 => 'AddressLine2', |
50
|
|
|
|
|
|
|
); |
51
|
|
|
|
|
|
|
|
52
|
24
|
50
|
|
|
|
66
|
my $t = $targets{$target} or return; |
53
|
24
|
100
|
|
|
|
79
|
my $addr = $dom->at("Shipment ShipTo Address $t") or return; |
54
|
12
|
|
|
|
|
12922
|
return $addr->text; |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
sub extract_service { |
58
|
4
|
|
|
4
|
1
|
12
|
my ($self, $id, $dom) = @_; |
59
|
4
|
50
|
|
|
|
14
|
my $service = $dom->at('Shipment Service Description') or return; |
60
|
4
|
|
|
|
|
4001
|
my $text = $service->text; |
61
|
4
|
100
|
|
|
|
142
|
$text = "UPS $text" unless $text =~ /UPS/; |
62
|
4
|
|
|
|
|
27
|
return $text; |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
sub extract_status { |
66
|
4
|
|
|
4
|
1
|
13
|
my ($self, $id, $dom) = @_; |
67
|
|
|
|
|
|
|
|
68
|
4
|
|
|
|
|
18
|
my $activity = $dom->find('Shipment Package Activity'); |
69
|
4
|
|
|
|
|
7531
|
my ($status, $date, $delivered); |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
my $to_date = sub { |
72
|
4
|
|
|
4
|
|
11
|
my $dom = shift; |
73
|
4
|
|
|
|
|
56
|
return Time::Piece->strptime( |
74
|
|
|
|
|
|
|
$dom->at('Date')->text . ' T ' . $dom->at('Time')->text, |
75
|
|
|
|
|
|
|
'%Y%m%d T %H%M%S' |
76
|
|
|
|
|
|
|
); |
77
|
4
|
|
|
|
|
26
|
}; |
78
|
|
|
|
|
|
|
|
79
|
4
|
|
|
4
|
|
27
|
my $d = $activity->first(sub{ $_->at('Status StatusType Code')->text eq 'D' }); |
|
4
|
|
|
|
|
84
|
|
80
|
4
|
50
|
|
|
|
2988
|
if ($d) { |
81
|
4
|
|
|
|
|
30
|
$status = $d->at('Status StatusType Description')->text; |
82
|
4
|
|
|
|
|
2860
|
$date = $d->$to_date(); |
83
|
4
|
|
|
|
|
5139
|
$delivered = 1; |
84
|
|
|
|
|
|
|
} else { |
85
|
|
|
|
|
|
|
my $current = $activity |
86
|
0
|
|
|
0
|
|
0
|
->map(sub{ [$_, $_->$to_date()] }) |
87
|
0
|
|
|
0
|
|
0
|
->sort(sub{ $b->[1] <=> $a->[1] }) |
88
|
0
|
|
|
|
|
0
|
->[0]; |
89
|
|
|
|
|
|
|
|
90
|
0
|
|
|
|
|
0
|
$status = $current->[0]->at('Status StatusType Description'); |
91
|
0
|
0
|
|
|
|
0
|
$status = $status ? $status->text : ''; |
92
|
0
|
|
|
|
|
0
|
$date = $current->[1]; |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
|
95
|
4
|
|
|
|
|
36
|
return($status, $date, $delivered); |
96
|
|
|
|
|
|
|
} |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
sub extract_weight { |
99
|
4
|
|
|
4
|
1
|
14
|
my ($self, $id, $dom) = @_; |
100
|
|
|
|
|
|
|
|
101
|
4
|
50
|
|
|
|
15
|
my $weight = $dom->at('Shipment ShipmentWeight') or return ''; |
102
|
4
|
|
|
|
|
2997
|
return $weight->at('Weight')->text . ' ' . $weight->at('UnitOfMeasurement Code')->text; |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
sub human_url { |
106
|
5
|
|
|
5
|
1
|
15
|
my ($self, $id, $dom) = @_; |
107
|
5
|
|
|
|
|
27
|
return Mojo::URL->new('http://wwwapps.ups.com/WebTracking/track')->query(trackNums => $id, 'track.x' => 'Track'); |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
sub request { |
111
|
4
|
|
|
4
|
1
|
25
|
my ($self, $id, $cb) = @_; |
112
|
|
|
|
|
|
|
|
113
|
4
|
|
|
|
|
30
|
my $xml = Mojo::Template->new->render($self->template, $self, $id); |
114
|
4
|
|
|
|
|
10466
|
warn "Request:\n$xml" if DEBUG; |
115
|
|
|
|
|
|
|
|
116
|
4
|
100
|
|
|
|
15
|
unless ($cb) { |
117
|
3
|
|
|
|
|
15
|
my $tx = $self->ua->post($self->api_url, $xml); |
118
|
3
|
|
|
|
|
10192
|
return _handle_response($tx); |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
Mojo::IOLoop::Delay->new->steps( |
122
|
1
|
|
|
1
|
|
243
|
sub { $self->ua->post($self->api_url, $xml, shift->begin) }, |
123
|
|
|
|
|
|
|
sub { |
124
|
1
|
|
|
1
|
|
3104
|
my ($ua, $tx) = @_; |
125
|
1
|
50
|
|
|
|
5
|
die $tx->error->{message} if $tx->error; |
126
|
1
|
|
|
|
|
20
|
my $dom = _handle_response($tx); |
127
|
1
|
|
|
|
|
6
|
$self->$cb(undef, $dom); |
128
|
|
|
|
|
|
|
}, |
129
|
1
|
|
|
0
|
|
8
|
)->catch(sub{ $self->$cb(pop, undef) })->wait; |
|
0
|
|
|
|
|
0
|
|
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
sub _handle_response { |
133
|
4
|
|
|
4
|
|
10
|
my $tx = shift; |
134
|
4
|
|
|
|
|
14
|
my $dom = $tx->res->dom; |
135
|
4
|
|
|
|
|
20504
|
warn "Response:\n$dom\n" if DEBUG; |
136
|
4
|
|
|
|
|
18
|
$dom = $dom->at('TrackResponse'); |
137
|
|
|
|
|
|
|
|
138
|
4
|
50
|
|
|
|
1366
|
return undef unless $dom->at('Response ResponseStatusCode')->text; # "1" on success |
139
|
4
|
|
|
|
|
1778
|
return $dom; |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
1; |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
=head1 NAME |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
Webservice::Shipment::Carrier::UPS - UPS handling for Webservice::Shipment |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
=head1 DESCRIPTION |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
Implements UPS handling for L. |
151
|
|
|
|
|
|
|
It is a subclass of L which implements all the necessary methods. |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
=head1 ATTRIBUTES |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
L implements all of the attributes from L and implements the following new ones |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
=head2 api_key |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
Your api key for the UPS API. |
160
|
|
|
|
|
|
|
The default implementation dies if used without being specified. |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
=head2 template |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
The string template used with L to format the request. |
165
|
|
|
|
|
|
|
|