| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package Business::UPS; |
|
2
|
|
|
|
|
|
|
|
|
3
|
3
|
|
|
3
|
|
242572
|
use strict; |
|
|
3
|
|
|
|
|
5
|
|
|
|
3
|
|
|
|
|
83
|
|
|
4
|
3
|
|
|
3
|
|
19
|
use warnings; |
|
|
3
|
|
|
|
|
5
|
|
|
|
3
|
|
|
|
|
151
|
|
|
5
|
|
|
|
|
|
|
|
|
6
|
3
|
|
|
3
|
|
19
|
use Carp; |
|
|
3
|
|
|
|
|
5
|
|
|
|
3
|
|
|
|
|
144
|
|
|
7
|
3
|
|
|
3
|
|
1920
|
use LWP::UserAgent; |
|
|
3
|
|
|
|
|
145652
|
|
|
|
3
|
|
|
|
|
137
|
|
|
8
|
3
|
|
|
3
|
|
2163
|
use JSON::PP qw(decode_json encode_json); |
|
|
3
|
|
|
|
|
39032
|
|
|
|
3
|
|
|
|
|
271
|
|
|
9
|
3
|
|
|
3
|
|
22
|
use Exporter 'import'; |
|
|
3
|
|
|
|
|
3
|
|
|
|
3
|
|
|
|
|
66
|
|
|
10
|
3
|
|
|
3
|
|
34
|
use 5.014; |
|
|
3
|
|
|
|
|
7
|
|
|
11
|
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
our @EXPORT = qw/ getUPS UPStrack /; |
|
13
|
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
# Copyright 2003 Justin Wheeler |
|
15
|
|
|
|
|
|
|
# Copyright 1998 Mark Solomon (See GNU GPL) |
|
16
|
|
|
|
|
|
|
# Started 01/07/1998 Mark Solomon |
|
17
|
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
our $VERSION = '2.04'; |
|
19
|
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
sub getUPS { |
|
21
|
|
|
|
|
|
|
|
|
22
|
7
|
|
|
7
|
1
|
149254
|
warnings::warnif( 'deprecated', |
|
23
|
|
|
|
|
|
|
'getUPS() is deprecated: the UPS rate quoting endpoint (qcostcgi.cgi) ' |
|
24
|
|
|
|
|
|
|
. 'has been retired by UPS. This function will be removed in a future ' |
|
25
|
|
|
|
|
|
|
. 'release. See Business::UPS documentation for alternatives.' ); |
|
26
|
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
my ( |
|
28
|
7
|
|
|
|
|
61
|
$product, $origin, $dest, $weight, $country, $rate_chart, $length, |
|
29
|
|
|
|
|
|
|
$width, $height, $oversized, $cod |
|
30
|
|
|
|
|
|
|
) = @_; |
|
31
|
|
|
|
|
|
|
|
|
32
|
7
|
|
100
|
|
|
31
|
$country ||= 'US'; |
|
33
|
|
|
|
|
|
|
|
|
34
|
7
|
|
|
|
|
10
|
my $ups_cgi = 'https://www.ups.com/using/services/rave/qcostcgi.cgi'; |
|
35
|
7
|
|
|
|
|
9
|
my $workString = "?"; |
|
36
|
7
|
|
|
|
|
11
|
$workString .= "accept_UPS_license_agreement=yes&"; |
|
37
|
7
|
|
|
|
|
10
|
$workString .= "10_action=3&"; |
|
38
|
7
|
|
|
|
|
14
|
$workString .= "13_product=" . $product . "&"; |
|
39
|
7
|
|
|
|
|
9
|
$workString .= "15_origPostal=" . $origin . "&"; |
|
40
|
7
|
|
|
|
|
9
|
$workString .= "19_destPostal=" . $dest . "&"; |
|
41
|
7
|
|
|
|
|
22
|
$workString .= "23_weight=" . $weight; |
|
42
|
7
|
50
|
|
|
|
18
|
$workString .= "&22_destCountry=" . $country if $country; |
|
43
|
7
|
100
|
|
|
|
15
|
$workString .= "&25_length=" . $length if $length; |
|
44
|
7
|
100
|
|
|
|
10
|
$workString .= "&26_width=" . $width if $width; |
|
45
|
7
|
100
|
|
|
|
11
|
$workString .= "&27_height=" . $height if $height; |
|
46
|
7
|
100
|
|
|
|
11
|
$workString .= "&29_oversized=1" if $oversized; |
|
47
|
7
|
100
|
|
|
|
15
|
$workString .= "&47_rate_chart=" . $rate_chart if $rate_chart; |
|
48
|
7
|
100
|
|
|
|
12
|
$workString .= "&30_cod=1" if $cod; |
|
49
|
7
|
|
|
|
|
10
|
$workString = "${ups_cgi}${workString}"; |
|
50
|
|
|
|
|
|
|
|
|
51
|
7
|
|
|
|
|
29
|
my $lwp = LWP::UserAgent->new( |
|
52
|
|
|
|
|
|
|
agent => "Business-UPS/$VERSION", |
|
53
|
|
|
|
|
|
|
timeout => 30, |
|
54
|
|
|
|
|
|
|
); |
|
55
|
7
|
|
|
|
|
72
|
my $result = $lwp->get($workString); |
|
56
|
|
|
|
|
|
|
|
|
57
|
7
|
100
|
|
|
|
61
|
croak("Failed fetching data.") unless $result->is_success; |
|
58
|
|
|
|
|
|
|
|
|
59
|
6
|
|
|
|
|
28
|
my @ret = split( '%', $result->content ); |
|
60
|
|
|
|
|
|
|
|
|
61
|
6
|
100
|
|
|
|
47
|
if ( !$ret[5] ) { |
|
62
|
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
# Error |
|
64
|
1
|
|
|
|
|
6
|
return ( undef, undef, $ret[1] ); |
|
65
|
|
|
|
|
|
|
} |
|
66
|
|
|
|
|
|
|
else { |
|
67
|
|
|
|
|
|
|
# Good results |
|
68
|
5
|
|
|
|
|
8
|
my $total_shipping = $ret[10]; |
|
69
|
5
|
|
|
|
|
6
|
my $ups_zone = $ret[6]; |
|
70
|
5
|
|
|
|
|
40
|
return ( $total_shipping, $ups_zone, undef ); |
|
71
|
|
|
|
|
|
|
} |
|
72
|
|
|
|
|
|
|
} |
|
73
|
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
sub UPStrack { |
|
75
|
15
|
|
|
15
|
1
|
170464
|
my $tracking_number = shift; |
|
76
|
15
|
|
|
|
|
18
|
my %retValue; |
|
77
|
|
|
|
|
|
|
|
|
78
|
15
|
100
|
|
|
|
199
|
$tracking_number || croak("No tracking number provided to UPStrack()"); |
|
79
|
|
|
|
|
|
|
|
|
80
|
13
|
|
|
|
|
19
|
my $ups_url = 'https://www.ups.com/track/api/Track/GetStatus?loc=en_US'; |
|
81
|
13
|
|
|
|
|
63
|
my $payload = encode_json( { |
|
82
|
|
|
|
|
|
|
Locale => 'en_US', |
|
83
|
|
|
|
|
|
|
TrackingNumber => [$tracking_number], |
|
84
|
|
|
|
|
|
|
} ); |
|
85
|
|
|
|
|
|
|
|
|
86
|
13
|
|
|
|
|
1549
|
my $lwp = LWP::UserAgent->new( |
|
87
|
|
|
|
|
|
|
agent => "Business-UPS/$VERSION", |
|
88
|
|
|
|
|
|
|
timeout => 30, |
|
89
|
|
|
|
|
|
|
); |
|
90
|
13
|
|
|
|
|
54
|
my $result = $lwp->post( |
|
91
|
|
|
|
|
|
|
$ups_url, |
|
92
|
|
|
|
|
|
|
'Content-Type' => 'application/json', |
|
93
|
|
|
|
|
|
|
Content => $payload, |
|
94
|
|
|
|
|
|
|
); |
|
95
|
|
|
|
|
|
|
|
|
96
|
13
|
100
|
|
|
|
78
|
croak("Cannot get tracking data from UPS") unless $result->is_success(); |
|
97
|
|
|
|
|
|
|
|
|
98
|
12
|
|
|
|
|
40
|
my $json; |
|
99
|
12
|
|
|
|
|
17
|
eval { $json = decode_json( $result->content() ) }; |
|
|
12
|
|
|
|
|
24
|
|
|
100
|
12
|
100
|
|
|
|
18254
|
croak("Cannot parse JSON response from UPS: $@") if $@; |
|
101
|
|
|
|
|
|
|
|
|
102
|
11
|
|
|
|
|
15
|
my $details = $json->{trackDetails}; |
|
103
|
11
|
100
|
66
|
|
|
264
|
croak("No tracking details returned from UPS") unless $details && ref($details) eq 'ARRAY' && @$details; |
|
|
|
|
100
|
|
|
|
|
|
104
|
|
|
|
|
|
|
|
|
105
|
9
|
|
|
|
|
50
|
my $track = $details->[0]; |
|
106
|
|
|
|
|
|
|
|
|
107
|
9
|
50
|
|
|
|
30
|
$retValue{'Current Status'} = $track->{packageStatus} if $track->{packageStatus}; |
|
108
|
9
|
100
|
|
|
|
18
|
$retValue{'Service Type'} = $track->{service} if $track->{service}; |
|
109
|
|
|
|
|
|
|
|
|
110
|
9
|
100
|
|
|
|
18
|
if ( my $w = $track->{weight} ) { |
|
111
|
4
|
100
|
|
|
|
8
|
if ( $w->{weight} ) { |
|
112
|
3
|
|
100
|
|
|
9
|
my $unit = $w->{unitOfMeasurement} || ''; |
|
113
|
3
|
100
|
|
|
|
11
|
$retValue{'Weight'} = length($unit) ? "$w->{weight} $unit" : $w->{weight}; |
|
114
|
|
|
|
|
|
|
} |
|
115
|
|
|
|
|
|
|
} |
|
116
|
|
|
|
|
|
|
|
|
117
|
9
|
100
|
|
|
|
15
|
if ( my $addr = $track->{shipToAddress} ) { |
|
118
|
4
|
|
|
|
|
6
|
my @parts = grep { $_ } @{$addr}{qw(city state country)}; |
|
|
12
|
|
|
|
|
24
|
|
|
|
4
|
|
|
|
|
9
|
|
|
119
|
4
|
50
|
|
|
|
16
|
$retValue{'Shipped To'} = join( ', ', @parts ) if @parts; |
|
120
|
|
|
|
|
|
|
} |
|
121
|
|
|
|
|
|
|
|
|
122
|
9
|
|
100
|
|
|
28
|
my $delivery_date = $track->{scheduledDeliveryDate} || $track->{deliveredDate}; |
|
123
|
9
|
100
|
|
|
|
29
|
$retValue{'Delivery Date'} = $delivery_date if $delivery_date; |
|
124
|
9
|
100
|
|
|
|
30
|
$retValue{'Signed By'} = $track->{receivedBy} if $track->{receivedBy}; |
|
125
|
9
|
100
|
|
|
|
13
|
$retValue{'Location'} = $track->{leftAt} if $track->{leftAt}; |
|
126
|
|
|
|
|
|
|
|
|
127
|
9
|
|
|
|
|
9
|
my %scanning; |
|
128
|
9
|
|
|
|
|
11
|
my $count = 0; |
|
129
|
|
|
|
|
|
|
|
|
130
|
9
|
100
|
|
|
|
15
|
if ( my $activities = $track->{shipmentProgressActivities} ) { |
|
131
|
4
|
|
|
|
|
8
|
for my $act (@$activities) { |
|
132
|
5
|
|
|
|
|
5
|
$count++; |
|
133
|
5
|
50
|
|
|
|
16
|
$scanning{$count}{'date'} = $act->{date} if $act->{date}; |
|
134
|
5
|
100
|
|
|
|
9
|
$scanning{$count}{'time'} = $act->{time} if $act->{time}; |
|
135
|
5
|
100
|
|
|
|
10
|
$scanning{$count}{'location'} = $act->{location} if $act->{location}; |
|
136
|
5
|
50
|
|
|
|
12
|
$scanning{$count}{'activity'} = $act->{activityScan} if $act->{activityScan}; |
|
137
|
|
|
|
|
|
|
} |
|
138
|
|
|
|
|
|
|
} |
|
139
|
|
|
|
|
|
|
|
|
140
|
9
|
|
|
|
|
14
|
$retValue{'Scanning'} = \%scanning; |
|
141
|
9
|
|
|
|
|
11
|
$retValue{'Activity Count'} = $count; |
|
142
|
9
|
|
|
|
|
15
|
$retValue{'Notice'} = "UPS authorizes you to use UPS tracking systems solely to track shipments tendered by or for you to UPS for delivery and for no other purpose. Any other use of UPS tracking systems and information is strictly prohibited."; |
|
143
|
|
|
|
|
|
|
|
|
144
|
9
|
|
|
|
|
96
|
return %retValue; |
|
145
|
|
|
|
|
|
|
} |
|
146
|
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
1; |
|
148
|
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
__END__ |