File Coverage

blib/lib/Business/UPS.pm
Criterion Covered Total %
statement 91 91 100.0
branch 51 56 91.0
condition 12 13 92.3
subroutine 9 9 100.0
pod 2 2 100.0
total 165 171 96.4


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__