File Coverage

blib/lib/Business/UPS.pm

Criterion	Covered	Total	%
statement	10	100	10.0
branch	0	68	0.0
condition	0	20	0.0
subroutine	4	7	57.1
pod	2	3	66.6
total	16	198	8.0

package Business::UPS;

use LWP::UserAgent;
use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
require 5.003;

require Exporter;

@ISA = qw(Exporter AutoLoader);

@EXPORT = qw(
	     getUPS
	     UPStrack
);

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

$VERSION = '2.01';

sub getUPS {

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

    $country ||= 'US';

    my $ups_cgi = 'http://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("http://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 => "http://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__