File Coverage

blib/lib/Business/UPS.pm

Criterion	Covered	Total	%
statement	9	99	9.0
branch	0	68	0.0
condition	0	20	0.0
subroutine	4	7	57.1
pod	2	3	66.6
total	15	197	7.6

package Business::UPS;

use strict;
use warnings;

use LWP::UserAgent;
require 5.008;

require Exporter;

our @ISA = qw(Exporter AutoLoader);

our @EXPORT = qw/ getUPS UPStrack /;

#	Copyright 2003 Justin Wheeler
#	Copyright 1998 Mark Solomon  (See GNU GPL)
#	Started 01/07/1998 Mark Solomon

our $VERSION = '2.02';

sub getUPS {

    my (
        $product, $origin, $dest,      $weight, $country, $rate_chart, $length,
        $width,   $height, $oversized, $cod
    ) = @_;

    $country ||= 'US';

    my $ups_cgi    = 'https://www.ups.com/using/services/rave/qcostcgi.cgi';
    my $workString = "?";
    $workString .= "accept_UPS_license_agreement=yes&";
    $workString .= "10_action=3&";
    $workString .= "13_product=" . $product . "&";
    $workString .= "15_origPostal=" . $origin . "&";
    $workString .= "19_destPostal=" . $dest . "&";
    $workString .= "23_weight=" . $weight;
    $workString .= "&22_destCountry=" . $country   if $country;
    $workString .= "&25_length=" . $length         if $length;
    $workString .= "&26_width=" . $width           if $width;
    $workString .= "&27_height=" . $height         if $height;
    $workString .= "&29_oversized=1"               if $oversized;
    $workString .= "&47_rate_chart=" . $rate_chart if $rate_chart;
    $workString .= "&30_cod=1"                     if $cod;
    $workString = "${ups_cgi}${workString}";

    my $lwp    = LWP::UserAgent->new();
    my $result = $lwp->get($workString);

    Error("Failed fetching data.") unless $result->is_success;

    my @ret = split( '%', $result->content );

    if ( !$ret[5] ) {

        # Error
        return ( undef, undef, $ret[1] );
    }
    else {
        # Good results
        my $total_shipping = $ret[10];
        my $ups_zone       = $ret[6];
        return ( $total_shipping, $ups_zone, undef );
    }
}

sub UPStrack {
    my $tracking_number = shift;
    my %retValue;

    $tracking_number || Error("No number to track in UPStrack()");

    my $lwp    = LWP::UserAgent->new();
    my $result = $lwp->get("https://wwwapps.ups.com/tracking/tracking.cgi?tracknum=$tracking_number");
    Error("Cannot get data from UPS") unless $result->is_success();

    my $tracking_data = $result->content();
    my %post_data;
    my ( $url, $data );

    if ( ( $url, $data ) = $tracking_data =~ /(.+)<\/form>/ims and $1 =~ /WebTracking\/processRequest/ ) {
        while ( $data =~ s///ims ) {
            $post_data{$1} = $2;
        }
    }
    else {
        Error("Cannot parse output from UPS!");
    }

    my ($imagename) = $tracking_data =~ //;

    $post_data{"${imagename}.x"} = 0;
    $post_data{"${imagename}.y"} = 0;

    my $result2 = $lwp->post( $url, \%post_data, Referer => "https://wwwaaps.ups.com/tracking/tracking.cgi?tracknum=$tracking_number" );

    Error("Failed fetching tracking data from UPS!") unless $result2->is_success;

    my $raw_data = $result2->content();

    $raw_data =~ tr/\r//d;
    $raw_data =~ s/<.*?>//gims;
    $raw_data =~ s/ / /gi;
    $raw_data =~ s/^\s+//gms;
    $raw_data =~ s/\s+$//gms;
    $raw_data =~ s/\s{2,}/ /gms;

    my @raw_data = split( /\n/, $raw_data );
    my %scanning;
    my $progress;
    my $count = 0;
    my $reference;

    for ( my $q = 0; $q < @raw_data; $q++ ) {

        # flip thru the text in the page line-by-line
        if ( $progress == 1 ) {

            # progress will == 1 when we've found the line that says 'package progress'
            # which means from here on in, we're tracking the package.

            if ( $raw_data[$q] =~ /Tracking results provided by UPS: (.+)/ ) {
                $progress = 0;
                $retValue{'Last Updated'} = $1 . ' ' . $raw_data[ $q + 1 ];
            }
            elsif ( $raw_data[$q] =~ /\w+\s+\d+,\s+\d+/ ) {

                # would match jun 10, 2003
                $reference = $raw_data[$q];
            }
            elsif ( $raw_data[$q] =~ /\d+:\d+\s+\w\.\w\./ ) {

                # matches 2:10 a.m.
                $scanning{ ++$count }{'time'} = $raw_data[$q];

                $scanning{$count}{'date'} ||= $reference;
            }
            elsif ( $raw_data[$q] =~ /,$/ ) {

                # if it ends in a comma, then it's an unfinished location e.g.:
                # austin,
                # tx,
                # us

                $scanning{$count}{'location'} .= ' ' . $raw_data[$q];
            }
            else {
                # if all else fails, it's either the last line of the
                # location, or it's the description.  we check that by
                # seeing if the current location ends in a comma.

                next unless $scanning{$count}{'date'};

                if ( $scanning{$count}{'location'} =~ /,$/ ) {
                    $scanning{$count}{'location'} .= ' ' . $raw_data[$q];
                }
                else {
                    $scanning{$count}{'activity'} = $raw_data[$q];
                }
            }
        }
        else {
            # html tables make life easy. :)

            $retValue{'Current Status'} = $raw_data[ $q + 1 ] if uc( $raw_data[$q] ) eq 'STATUS:';

            $retValue{'Shipped To'} = $raw_data[ $q + 1 ] if uc( $raw_data[$q] ) eq 'SHIPPED TO:';
            $retValue{'Shipped To'} .= ' ' . $raw_data[ $q + 2 ] if $raw_data[ $q + 1 ] =~ /,$/ and uc( $raw_data[$q] ) eq 'SHIPPED TO:';
            $retValue{'Shipped To'} .= ' ' . $raw_data[ $q + 3 ] if $raw_data[ $q + 2 ] =~ /,$/ and uc( $raw_data[$q] ) eq 'SHIPPED TO:';

            $retValue{'Delivered To'} = $raw_data[ $q + 1 ] if uc( $raw_data[$q] ) eq 'DELIVERED TO:';
            $retValue{'Delivered To'} .= ' ' . $raw_data[ $q + 2 ] if $raw_data[ $q + 1 ] =~ /,$/ and uc( $raw_data[$q] ) eq 'DELIVERED TO:';
            $retValue{'Delivered To'} .= ' ' . $raw_data[ $q + 3 ] if $raw_data[ $q + 2 ] =~ /,$/ and uc( $raw_data[$q] ) eq 'DELIVERED TO:';

            $retValue{'Shipped On'}    = $raw_data[ $q + 1 ] if uc( $raw_data[$q] ) eq 'SHIPPED OR BILLED ON:';
            $retValue{'Service Type'}  = $raw_data[ $q + 1 ] if uc( $raw_data[$q] ) eq 'SERVICE TYPE:';
            $retValue{'Weight'}        = $raw_data[ $q + 1 ] if uc( $raw_data[$q] ) eq 'WEIGHT:';
            $retValue{'Delivery Date'} = $raw_data[ $q + 1 ] if uc( $raw_data[$q] ) eq 'DELIVERED ON:';
            $retValue{'Signed By'}     = $raw_data[ $q + 1 ] if uc( $raw_data[$q] ) eq 'SIGNED BY:';
            $retValue{'Location'}      = $raw_data[ $q + 1 ] if uc( $raw_data[$q] ) eq 'LOCATION:';

            $progress = 1 if uc( $raw_data[$q] ) eq 'PACKAGE PROGRESS:';
        }
    }

    $retValue{'Scanning'}       = \%scanning;
    $retValue{'Activity Count'} = $count;
    $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.";

    return %retValue;
}

sub Error {
    my $error = shift;
    print STDERR "$error\n";
    exit(1);
}

END { }

# Autoload methods go after =cut, and are processed by the autosplit program.

1;

__END__