File Coverage

blib/lib/WWW/Purolator/TrackingInfo.pm

Criterion	Covered	Total	%
statement	38	47	80.8
branch	4	6	66.6
condition	0	2	0.0
subroutine	10	10	100.0
pod	2	2	100.0
total	54	67	80.6

package WWW::Purolator::TrackingInfo;

use warnings;
use strict;

our $VERSION = '1.0105';
use 5.006;
use LWP::UserAgent;
use JSON::PP qw//;
use base 'Class::Accessor::Grouped';
__PACKAGE__->mk_group_accessors( simple => qw/
    error
    _ua
/);

sub new {
    my $class = shift;
    my %options = @_;
    my $self = bless {}, $class;

    $self->_ua(
        LWP::UserAgent->new(
            agent => 'Mozilla/5.0 (X11; Ubuntu; Linux x86_64; rv:26.0) '
                . 'Gecko/20100101 Firefox/26.0', timeout => 30 ),
    );

    return $self;
}

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

    $self->error(undef);

    my $res = $self->_ua->get(
        'http://www.purolator.com/en/ship-track/tracking-details.page?pin='
            . $pin,
    );

    $res->is_success
        or return $self->_set_error('Network error: ' . $res->status_line);

    return $self->_parse( $pin, $res->decoded_content );
}

sub _parse {
    my ( $self, $pin, $content ) = @_;

    my %info = ( pin => $pin );

    $content =~ /Our online tracking system is currently unavailable/
        and return $self->_set_error(
            'Tracking system is currently unavailable'
        );

    my ( $z ) = $content =~ m{var jsHistoryTable = (\[.+?\]);}s;

    my $history_table = eval {
        JSON::PP->new->allow_singlequote->decode( $z );
    };
    $@
    and return $self->_set_error(
            'Error parsing Purolator\'s data: ' . $@
            . '. Perhaps you supplied an invalid PIN/tracking number?'
        );

    for ( @$history_table ) {
        my %data;
        @data{qw/scan_date  scan_time  location  comment/} = @$_;
        $_ =  \%data;
    }

    $info{history} = $history_table;


    my ( $status_code ) = $content =~ m{
        var \s+ detailsData \s+ =
        \s+
        \{
            \s+ "trackingNumber" .+?
            "status": \s+ '([^']+)'
        }six;

    my %possible_statuses = (
        InTransit       => 'in transit',
        Pickup          => 'package picked up',
        DataReceived    => 'shipping label created',
        Attention       => 'attention',
        Delivered       => 'delivered',
    );

    $info{status}
    = $possible_statuses{ $status_code } || 'unknown status code';

    return \%info;
}

sub _set_error {
    my ( $self, $error ) = @_;

    $self->error( $error );

    return;
}

q|
I'd like to make the world a better place,
but they won't give me the source code.
|;
__END__