File Coverage

blib/lib/Shipment/Generic.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package Shipment::Generic;
$Shipment::Generic::VERSION = '0.18';
use strict;
use warnings;


use Moose 2.0000;

extends 'Shipment::Base';


sub _build_services {
    {   generic => Shipment::Service->new(
            id   => 'generic',
            name => 'Generic Service',
        ),
    };
}


sub rate {
    my ($self, $service_id, $rate) = @_;

    $service_id ||= 'generic';
    $rate       ||= 0;

    use Data::Currency;
    use Shipment::Service;
    $self->service(
        new Shipment::Service(
            id   => $service_id,
            name => $service_id,
            cost => Data::Currency->new($rate, $self->currency),
        )
    );

}


sub ship {
    my ($self, $service_id, $tracking_id, $rate) = @_;

    $self->rate($service_id, $rate);

    if (!$tracking_id) {
        foreach (@{$self->packages}) {
            $tracking_id = $_->tracking_id if $_->tracking_id;
            last if $_->tracking_id;
        }
    }

    $tracking_id ||= 'n/a';

    $self->tracking_id($tracking_id);

    use Shipment::Label;

    foreach (@{$self->packages}) {
        $_->tracking_id($tracking_id) if !$_->tracking_id;
        $_->label(
            Shipment::Label->new(
                {   tracking_id  => $_->tracking_id,
                    content_type => 'text/plain',
                    data         => qq|
FROM:
| . $self->from_address->name . qq|
| . $self->from_address->company . qq|
| . $self->from_address->address1 . qq|
| . $self->from_address->address2 . qq|
|
                      . $self->from_address->city . qq|, |
                      . $self->from_address->province_code . qq| |
                      . $self->from_address->postal_code . qq|
| . $self->from_address->country_code . qq|
| . $self->from_address->phone . qq|

TO:
| . $self->to_address->name . qq|
| . $self->to_address->company . qq|
| . $self->to_address->address1 . qq|
| . $self->to_address->address2 . qq|
|
                      . $self->to_address->city . qq|, |
                      . $self->to_address->province_code . qq| |
                      . $self->to_address->postal_code . qq|
| . $self->to_address->country_code . qq|
| . $self->to_address->phone . qq|
|,
                    file_name => $_->tracking_id . '.txt',
                },
            )
        );
    }

}


sub cancel {
    my $self = shift;

    return 'success';
}

no Moose;


1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Shipment::Generic

=head1 VERSION

version 0.18

=head1 SYNOPSIS

This module does not DO a whole lot,

  use Shipment::Generic;
  use Shipment::Address;
  use Shipment::Package;

  my $shipment = Shipment::Generic->new(
    from_address => Shipment::Address->new( ... ),
    to_address => Shipment::Address->new( ... ),
    packages => [ Shipment::Package->new( ... ), ],
  );

  $shipment->rate( 'ground' );

  $shipment->ship( 'ground' );

=head1 NAME

Shipment::Generic - a very Generic shipping interface

=head1 ABOUT

This class provides a Generic interface for a shipping service.

=head1 Class Attributes

This class does not override or provide any additional attributes.

=head1 Class Methods

=head2 _build_services

This routine simply adds a single "generic" service

=head2 rate

This routine populates $self->service

It optionally accepts the cost passed as the second argument

  $shipment->rate( 'ground', '12.34 );
  print $shipment->service->cost . "\n";

=head2 ship

This routine sets $self->tracking_id and calls $self->rate
Also sets a label for each package

  $shipment->ship( 'ground', '123456789', '12.32' );

TODO: create generic thermal, pdf, and png labels so that we can do:
  $shipment->get_package(0)->label->save;

=head2 cancel

This routine really does nothing but return 'success'

  $shipment->tracking_id( '12345' );
  $shipment->cancel;

=head1 AUTHOR

Andrew Baerg @ <andrew at pullingshots dot ca>

http://pullingshots.ca/

=head1 BUGS

Please contact me directly.

=head1 COPYRIGHT

Copyright (C) 2010 Andrew J Baerg, All Rights Reserved

=head1 NO WARRANTY

Absolutely, positively NO WARRANTY, neither express or implied, is
offered with this software.  You use this software at your own risk.  In
case of loss, no person or entity owes you anything whatsoever.  You
have been warned.

=head1 LICENSE

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=head1 AUTHOR

Andrew Baerg <[e-mail]>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2013 by Andrew Baerg.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut