File Coverage

blib/lib/Net/TrackUPS.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

package Net::TrackUPS;

use strict;
use warnings;

our $VERSION = '0.01';

use HTTP::Request;
use LWP::UserAgent;
use XML::Simple qw(XMLin);

sub new {
    my $class = shift;

    bless {
        # Production Tracking URL, this can be overridden.
        URI => 'https://www.ups.com/ups.app/xml/Track',

        # This URL should be used for testing and integration
        # URI => 'https://wwwcie.ups.com/ups.app/xml/Track',

        @_,
    }, ref($class) || $class;
}

sub track {
    my ($self, $number) = @_;

    my $req = HTTP::Request->new(
        'POST', $self->URI, undef, $self->_req_xml($number),
    );
    my $resp = $self->_ua->request($req);

    unless ($resp->is_success) {
        die "Connection error: " . $resp->status_line;
    }

    XMLin($resp->content);
}

sub _ua {
    my $self = shift;
    my %opts;

    if ('HASH' eq ref($self->{lwp_options})) {
        %opts = %{$self->{lwp_options}};
    }

    LWP::UserAgent->new(
        agent => ref($self) . '/' . $self->VERSION,
        %opts,
    );
}

sub _req_xml {
    my ($self, $tracking_number) = @_;

    # Simple but effective way of constructing XML requests.
    my $xml=<<'XML';


    %s
    %s
    %s




        Track
        %s

    %s

XML

    sprintf($xml, $self->access_key, $self->ID, $self->password, $self->request_option, $tracking_number);
}

# Auto-generate accessors/mutators:
for my $method (qw(URI ID password access_key request_option)) {
    no strict 'refs';

    *{$method} = sub {
        my $self = shift;
        if (@_) {
            $self->{$method} = shift;
        }
        return $self->{$method};
    };
}

1;

__END__