File Coverage

blib/lib/Shipment/Purolator.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             package Shipment::Purolator;
2             $Shipment::Purolator::VERSION = '0.18';
3 1     1   16277 use strict;
  1         1  
  1         35  
4 1     1   3 use warnings;
  1         2  
  1         23  
5              
6              
7 1     1   523 use Try::Tiny;
  1         2005  
  1         65  
8 1     1   841 use Moose 2.0000;
  0            
  0            
9             use Moose::Util::TypeConstraints;
10             use Shipment::SOAP::WSDL;
11              
12             extends 'Shipment::Base';
13              
14              
15             has 'key' => (
16             is => 'rw',
17             isa => 'Str',
18             );
19              
20             has 'password' => (
21             is => 'rw',
22             isa => 'Str',
23             );
24              
25              
26             has 'proxy_domain' => (
27             is => 'rw',
28             isa => enum(
29             [ qw(
30             devwebservices.purolator.com
31             webservices.purolator.com
32             )
33             ]
34             ),
35             default => 'devwebservices.purolator.com',
36             );
37              
38              
39             my %bill_type_map = (
40             'sender' => 'Sender',
41             'recipient' => 'Receiver',
42             'third_party' => 'ThirdParty',
43             );
44              
45             my %pickup_type_map = (
46             'pickup' => 'PreScheduled',
47             'dropoff' => 'DropOff',
48             );
49              
50             my %package_type_map = (
51             'custom' => 'CustomerPackaging',
52             'envelope' => 'ExpressEnvelope',
53             'tube' => '',
54             'box' => 'ExpressBox',
55             'pack' => 'ExpressPack',
56             );
57              
58             my %units_type_map = (
59             'lb' => 'lb',
60             'kg' => 'kg',
61             'in' => 'in',
62             'cm' => 'cm',
63             );
64              
65              
66             my %printer_type_map = (
67             'pdf' => 'Regular',
68             'thermal' => 'Thermal',
69             'image' => '',
70             );
71              
72              
73             has '+currency' => (default => 'CAD',);
74              
75              
76             sub _build_services {
77             my $self = shift;
78              
79             if ($self->from_address && $self->to_address) {
80              
81             use Shipment::Package;
82             use Shipment::Service;
83             use
84             Shipment::Purolator::WSDL::Interfaces::ServiceAvailabilityService::ServiceAvailabilityServiceEndpoint;
85              
86             my $interface =
87             Shipment::Purolator::WSDL::Interfaces::ServiceAvailabilityService::ServiceAvailabilityServiceEndpoint
88             ->new(
89             { proxy_domain => $self->proxy_domain,
90             key => $self->key,
91             password => $self->password,
92             }
93             );
94             my $response;
95              
96             my %services;
97              
98             $response = $interface->GetServicesOptions(
99             { BillingAccountNumber => $self->account,
100             SenderAddress => {
101             City => $self->from_address()->city,
102             Province => $self->from_address()->province_code,
103             Country => $self->from_address()->country_code,
104             PostalCode => $self->from_address()->postal_code,
105             },
106             ReceiverAddress => {
107             City => $self->to_address()->city,
108             Province => $self->to_address()->province_code,
109             Country => $self->to_address()->country_code,
110             PostalCode => $self->to_address()->postal_code,
111             },
112             },
113             { 'Version' => '1.0',
114             'Language' => 'en',
115             'GroupID' => 'xxx',
116             'RequestReference' => 'Shipment::Purolator::_build_services'
117             },
118             );
119              
120             #warn $response;
121              
122             try {
123             foreach my $service (@{$response->get_Services()->get_Service()}) {
124             if ($service->get_PackageType()->get_value eq
125             $package_type_map{$self->package_type})
126             {
127             $services{$service->get_ID()->get_value} =
128             Shipment::Service->new(
129             id => $service->get_ID()->get_value,
130             name => $service->get_Description()->get_value,
131             );
132             my %options;
133             foreach
134             my $option (@{$service->get_Options()->get_Option()})
135             {
136             $options{$option->get_ID()->get_value} =
137             $option->get_ValueType()->get_value;
138             }
139             $services{$service->get_ID()->get_value}
140             ->options(\%options);
141             $services{ground} =
142             $services{$service->get_ID()->get_value}
143             if ($service->get_ID()->get_value =~ /PurolatorGround/);
144             $services{express} =
145             $services{$service->get_ID()->get_value}
146             if ( $service->get_ID()->get_value =~ /PurolatorExpress/
147             && $service->get_ID()->get_value !~
148             /(9AM|10:30AM|12:00|Evening)$/);
149             $services{priority} =
150             $services{$service->get_ID()->get_value}
151             if ( $service->get_ID()->get_value =~ /PurolatorExpress/
152             && $service->get_ID()->get_value
153             =~ /(9AM|10:30AM|12:00|Evening)$/);
154              
155             }
156             }
157             $services{ground} = $services{express}
158             if (!$services{ground} && $services{express});
159             }
160             catch {
161             warn $_;
162             try {
163             warn $response->get_ResponseInformation()->get_Errors()
164             ->get_Error()->[0]->get_Description;
165             $self->error($response->get_ResponseInformation()->get_Errors()
166             ->get_Error()->[0]->get_Description->get_value);
167             }
168             catch {
169             warn $_;
170             warn $response->get_faultstring;
171             $self->error($response->get_faultstring->get_value);
172             };
173             };
174             \%services;
175             }
176             else {
177             warn 'services not fetched. both from and to address required.';
178             $self->error(
179             'services not fetched. both from and to address required.');
180              
181             {};
182             }
183             }
184              
185              
186             sub rate {
187             my ($self, $service_id) = @_;
188              
189             try {
190             $service_id = $self->services->{$service_id}->id;
191             }
192             catch {
193             warn $_;
194             warn "service ($service_id) not available";
195             $self->error("service ($service_id) not available");
196             $service_id = '';
197             };
198             return unless $service_id;
199              
200             my $total_weight;
201             $total_weight += $_->weight for @{$self->packages};
202              
203             my @options;
204             my $signature_option;
205             if ($self->signature_type =~ /^(required|default|adult)$/) {
206             $signature_option = "ResidentialSignatureDomestic"
207             if $self->services->{$service_id}
208             ->options->{ResidentialSignatureDomestic};
209             $signature_option = "ResidentialSignatureIntl"
210             if $self->services->{$service_id}
211             ->options->{ResidentialSignatureIntl};
212             }
213             elsif ($self->signature_type eq 'not_required') {
214             $signature_option = "OriginSignatureNotRequired";
215             }
216              
217             if ($signature_option) {
218             push @options,
219             { ID => $signature_option,
220             Value => 'true',
221             };
222             }
223              
224             my @pieces;
225             foreach (@{$self->packages}) {
226             if ($self->package_type eq 'custom') {
227             push @pieces,
228             { Weight => {
229             Value => sprintf("%.0f", $_->weight) || 1,
230             WeightUnit => $self->weight_unit,
231             },
232             Length => {
233             Value => $_->length,
234             DimensionUnit => $self->dim_unit,
235             },
236             Width => {
237             Value => $_->width,
238             DimensionUnit => $self->dim_unit,
239             },
240             Height => {
241             Value => $_->height,
242             DimensionUnit => $self->dim_unit,
243             },
244             };
245             }
246             else {
247             push @pieces,
248             { Weight => {
249             Value => sprintf("%.0f", $_->weight) || 1,
250             WeightUnit => $self->weight_unit,
251             },
252             };
253             }
254             }
255              
256             use
257             Shipment::Purolator::WSDL::Interfaces::EstimatingService::EstimatingServiceEndpoint;
258             my $interface =
259             Shipment::Purolator::WSDL::Interfaces::EstimatingService::EstimatingServiceEndpoint
260             ->new(
261             { proxy_domain => $self->proxy_domain,
262             key => $self->key,
263             password => $self->password,
264             }
265             );
266              
267             my $response = $interface->GetFullEstimate(
268             { Shipment => {
269             SenderInformation => {
270             Address => {
271             Name => $self->from_address->name,
272             Company => $self->from_address->company,
273             StreetNumber =>
274             $self->from_address->address_components->{number},
275             StreetName =>
276             $self->from_address->address_components->{street}
277             . ' '
278             . $self->from_address->address_components
279             ->{direction},
280             StreetAddress2 => $self->from_address->address2,
281             City => $self->from_address->city,
282             Province => $self->from_address->province_code,
283             Country => $self->from_address->country_code,
284             PostalCode => $self->from_address->postal_code,
285             PhoneNumber => {
286             CountryCode =>
287             $self->from_address->phone_components->{country},
288             AreaCode =>
289             $self->from_address->phone_components->{area},
290             Phone =>
291             $self->from_address->phone_components->{phone},
292             },
293             },
294             },
295             ReceiverInformation => {
296             Address => {
297             Name => $self->to_address->name,
298             Company => $self->to_address->company,
299             StreetNumber =>
300             $self->to_address->address_components->{number},
301             StreetName =>
302             $self->to_address->address_components->{street} . ' '
303             . $self->to_address->address_components->{direction},
304             StreetAddress2 => $self->to_address->address2,
305             City => $self->to_address->city,
306             Province => $self->to_address->province_code,
307             Country => $self->to_address->country_code,
308             PostalCode => $self->to_address->postal_code,
309             PhoneNumber => {
310             CountryCode =>
311             $self->to_address->phone_components->{country},
312             AreaCode =>
313             $self->to_address->phone_components->{area},
314             Phone =>
315             $self->to_address->phone_components->{phone},
316             },
317             },
318             },
319             PackageInformation => {
320             ServiceID => $service_id,
321             TotalWeight => {
322             Value => sprintf("%.0f", $total_weight) || 1,
323             WeightUnit => $self->weight_unit,
324             },
325             TotalPieces => scalar @{$self->packages},
326             PiecesInformation => {Piece => \@pieces,},
327             OptionsInformation =>
328             {Options => {OptionIDValuePair => \@options,},},
329             },
330             PaymentInformation => {
331             PaymentType => 'Sender',
332             RegisteredAccountNumber => $self->account,
333             BillingAccountNumber => $self->account,
334             },
335             PickupInformation => {
336             PickupType => $pickup_type_map{$self->pickup_type}
337             || $self->pickup_type,
338             },
339             TrackingReferenceInformation => {
340             Reference1 => $self->get_reference(0),
341             Reference2 => $self->get_reference(1),
342             Reference3 => $self->get_reference(2),
343             Reference4 => $self->get_reference(3),
344             },
345             },
346             ShowAlternativeServicesIndicator => "false",
347             },
348             { 'Version' => '1.0',
349             'Language' => 'en',
350             'GroupID' => 'xxx',
351             'RequestReference' => 'Shipment::Purolator::rate'
352             },
353             );
354              
355             #warn $response;
356              
357             try {
358             use Data::Currency;
359             use Shipment::Service;
360             my ($y, $m, $d) = split('-',
361             $response->get_ShipmentEstimates()->[0]->get_ShipmentEstimate()
362             ->get_ShipmentDate()->get_value);
363             my $ship_date = {year => $y, month => $m, day => $d};
364             ($y, $m, $d) = split('-',
365             $response->get_ShipmentEstimates()->[0]->get_ShipmentEstimate()
366             ->get_ExpectedDeliveryDate()->get_value);
367             my $eta = {year => $y, month => $m, day => $d};
368             $self->service(
369             new Shipment::Service(
370             id => $service_id,
371             name => $self->services->{$service_id}->name,
372             etd => $response->get_ShipmentEstimates()->[0]
373             ->get_ShipmentEstimate()->get_EstimatedTransitDays()
374             ->get_value,
375             ship_date => $ship_date,
376             eta => $eta,
377             cost => Data::Currency->new(
378             $response->get_ShipmentEstimates()->[0]
379             ->get_ShipmentEstimate()->get_TotalPrice,
380             'CAD'
381             ),
382             )
383             );
384             }
385             catch {
386             warn $_;
387             try {
388             warn $response->get_ResponseInformation()->get_Errors()
389             ->get_Error()->[0]->get_Description;
390             $self->error($response->get_ResponseInformation()->get_Errors()
391             ->get_Error()->[0]->get_Description->get_value);
392             }
393             catch {
394             warn $_;
395             warn $response->get_faultstring;
396             $self->error($response->get_faultstring->get_value);
397             };
398             };
399              
400             }
401              
402              
403             sub ship {
404             my ($self, $service_id) = @_;
405              
406             try {
407             $service_id = $self->services->{$service_id}->id;
408             }
409             catch {
410             warn $_;
411             warn "service ($service_id) not available";
412             $self->error("service ($service_id) not available");
413             $service_id = '';
414             };
415             return unless $service_id;
416              
417             $self->rate($service_id);
418              
419             my $total_weight;
420             $total_weight += $_->weight for @{$self->packages};
421              
422             my @options;
423             my $signature_option;
424             if ($self->signature_type =~ /^(required|default|adult)$/) {
425             $signature_option = "ResidentialSignatureDomestic"
426             if $self->services->{$service_id}
427             ->options->{ResidentialSignatureDomestic};
428             $signature_option = "ResidentialSignatureIntl"
429             if $self->services->{$service_id}
430             ->options->{ResidentialSignatureIntl};
431             }
432             elsif ($self->signature_type eq 'not_required') {
433             $signature_option = "OriginSignatureNotRequired";
434             }
435              
436             if ($signature_option) {
437             push @options,
438             { ID => $signature_option,
439             Value => 'true',
440             };
441             }
442              
443             my $notification_information;
444             if ($self->to_address->email) {
445             $notification_information->{AdvancedShippingNotificationEmailAddress1}
446             = $self->to_address->email;
447             }
448              
449             my @pieces;
450             foreach (@{$self->packages}) {
451             if ($self->package_type eq 'custom') {
452             push @pieces,
453             { Weight => {
454             Value => sprintf("%.0f", $_->weight) || 1,
455             WeightUnit => $self->weight_unit,
456             },
457             Length => {
458             Value => $_->length,
459             DimensionUnit => $self->dim_unit,
460             },
461             Width => {
462             Value => $_->width,
463             DimensionUnit => $self->dim_unit,
464             },
465             Height => {
466             Value => $_->height,
467             DimensionUnit => $self->dim_unit,
468             },
469             };
470             }
471             else {
472             push @pieces,
473             { Weight => {
474             Value => sprintf("%.0f", $_->weight) || 1,
475             WeightUnit => $self->weight_unit,
476             },
477             };
478             }
479             }
480              
481             use
482             Shipment::Purolator::WSDL::Interfaces::ShippingService::ShippingServiceEndpoint;
483             my $interface =
484             Shipment::Purolator::WSDL::Interfaces::ShippingService::ShippingServiceEndpoint
485             ->new(
486             { proxy_domain => $self->proxy_domain,
487             key => $self->key,
488             password => $self->password,
489             }
490             );
491              
492             my $response = $interface->CreateShipment(
493             { Shipment => {
494             SenderInformation => {
495             Address => {
496             Name => $self->from_address->name,
497             Company => $self->from_address->company,
498             StreetNumber =>
499             $self->from_address->address_components->{number},
500             StreetName =>
501             $self->from_address->address_components->{street}
502             . ' '
503             . $self->from_address->address_components
504             ->{direction},
505             StreetAddress2 => $self->from_address->address2,
506             City => $self->from_address->city,
507             Province => $self->from_address->province_code,
508             Country => $self->from_address->country_code,
509             PostalCode => $self->from_address->postal_code,
510             PhoneNumber => {
511             CountryCode =>
512             $self->from_address->phone_components->{country},
513             AreaCode =>
514             $self->from_address->phone_components->{area},
515             Phone =>
516             $self->from_address->phone_components->{phone},
517             },
518             },
519             },
520             ReceiverInformation => {
521             Address => {
522             Name => $self->to_address->name,
523             Company => $self->to_address->company,
524             StreetNumber =>
525             $self->to_address->address_components->{number},
526             StreetName =>
527             $self->to_address->address_components->{street} . ' '
528             . $self->to_address->address_components->{direction},
529             StreetAddress2 => $self->to_address->address2,
530             City => $self->to_address->city,
531             Province => $self->to_address->province_code,
532             Country => $self->to_address->country_code,
533             PostalCode => $self->to_address->postal_code,
534             PhoneNumber => {
535             CountryCode =>
536             $self->to_address->phone_components->{country},
537             AreaCode =>
538             $self->to_address->phone_components->{area},
539             Phone =>
540             $self->to_address->phone_components->{phone},
541             },
542             },
543             },
544             PackageInformation => {
545             ServiceID => $service_id,
546             TotalWeight => {
547             Value => sprintf("%.0f", $total_weight) || 1,
548             WeightUnit => $self->weight_unit,
549             },
550             TotalPieces => scalar @{$self->packages},
551             PiecesInformation => {Piece => \@pieces,},
552             OptionsInformation =>
553             {Options => {OptionIDValuePair => \@options,},},
554             },
555             PaymentInformation => {
556             PaymentType => $bill_type_map{$self->bill_type}
557             || $self->bill_type,
558             RegisteredAccountNumber => $self->account,
559             BillingAccountNumber => $self->bill_account,
560             },
561             PickupInformation => {
562             PickupType => $pickup_type_map{$self->pickup_type}
563             || $self->pickup_type,
564             },
565             TrackingReferenceInformation => {
566             Reference1 => $self->get_reference(0),
567             Reference2 => $self->get_reference(1),
568             Reference3 => $self->get_reference(2),
569             Reference4 => $self->get_reference(3),
570             },
571             NotificationInformation => $notification_information,
572             OtherInformation =>
573             {SpecialInstructions => $self->special_instructions,},
574             },
575             PrinterType => $printer_type_map{$self->printer_type}
576             || $self->printer_type,
577             },
578             { 'Version' => '1.0',
579             'Language' => 'en',
580             'GroupID' => 'xxx',
581             'RequestReference' => 'Shipment::Purolator::ship'
582             },
583             );
584              
585             #warn $response;
586              
587             try {
588             $self->tracking_id(
589             $response->get_ShipmentPIN()->get_Value()->get_value);
590             use Shipment::Label;
591             my $package_index = 0;
592             foreach (@{$response->get_PiecePINs()->get_PIN()}) {
593             $self->get_package($package_index)
594             ->tracking_id($_->get_Value()->get_value);
595             $self->get_package($package_index)->label(
596             Shipment::Label->new(
597             {tracking_id => $_->get_Value()->get_value,},
598             )
599             );
600             $package_index++;
601             }
602             }
603             catch {
604             try {
605             warn $_;
606             warn $response->get_ResponseInformation()->get_Errors()
607             ->get_Error()->[0]->get_Description;
608             $self->error($response->get_ResponseInformation()->get_Errors()
609             ->get_Error()->[0]->get_Description->get_value);
610             }
611             catch {
612             warn $_;
613             warn $response->get_faultstring;
614             $self->error($response->get_faultstring->get_value);
615             };
616             };
617              
618             $self->fetch_documents();
619              
620             }
621              
622              
623             sub fetch_documents {
624             my $self = shift;
625              
626             return unless $self->tracking_id;
627              
628             use
629             Shipment::Purolator::WSDL::Interfaces::ShippingDocumentsService::ShippingDocumentsServiceEndpoint;
630             my $interface =
631             Shipment::Purolator::WSDL::Interfaces::ShippingDocumentsService::ShippingDocumentsServiceEndpoint
632             ->new(
633             { proxy_domain => $self->proxy_domain,
634             key => $self->key,
635             password => $self->password,
636             }
637             );
638              
639             my $response = $interface->GetDocuments(
640             { DocumentCriterium =>
641             {DocumentCriteria => {PIN => {Value => $self->tracking_id,},},},
642             },
643             { 'Version' => '1.0',
644             'Language' => 'en',
645             'GroupID' => 'xxx',
646             'RequestReference' => 'Shipment::Purolator::fetch_documents'
647             },
648             );
649              
650             #warn $response;
651              
652             my $document_url;
653             try {
654             $document_url =
655             $response->get_Documents()->get_Document()->get_DocumentDetails()
656             ->[0]->get_DocumentDetail()->get_URL()->get_value;
657             }
658             catch {
659             warn $_;
660             try {
661             warn $response->get_ResponseInformation()->get_Errors()
662             ->get_Error()->[0]->get_Description;
663             $self->error($response->get_ResponseInformation()->get_Errors()
664             ->get_Error()->[0]->get_Description->get_value);
665             }
666             catch {
667             warn $_;
668             warn $response->get_faultstring;
669             $self->error($response->get_faultstring->get_value);
670             };
671             };
672              
673             use LWP::UserAgent;
674             use Shipment::Label;
675             my $ua = LWP::UserAgent->new('Shipping::Purolator');
676             my $req = HTTP::Request->new(GET => $document_url);
677              
678             ## for multi-piece shipments, the labels are not always ready immediately after generating the shipment... try 10 times, sleeping for a second in between each try.
679             my $label_success;
680             my $res;
681             for (1 .. 10) {
682             $res = $ua->request($req);
683             sleep 1 && next unless $res->is_success && $res->content;
684              
685             $label_success = 1;
686             $self->documents(
687             Shipment::Label->new(
688             tracking_id => $self->tracking_id,
689             content_type => $res->header('Content-Type'),
690             data => $res->content,
691             file_name => $self->tracking_id . '-documents.pdf',
692             )
693             );
694              
695             foreach ($self->all_packages) {
696             $_->label->content_type($res->header('Content-Type'));
697             $_->label->data($res->content);
698             $_->label->file_name($_->tracking_id . '.pdf');
699             }
700             }
701              
702             if (!$label_success) {
703             if (!$res->is_success) {
704             warn $res->status_line;
705             $self->error("Failed to retrieve label(s) from "
706             . $document_url . ": "
707             . $res->status_line);
708             }
709             else {
710             warn "No content returned from label url: " . $document_url;
711             $self->error("Failed to retrieve label(s) from " . $document_url);
712             }
713             $self->cancel;
714             }
715             }
716              
717              
718             sub cancel {
719             my $self = shift;
720              
721             if (!$self->tracking_id) {
722             $self->error('no tracking id provided');
723             return;
724             }
725              
726             use
727             Shipment::Purolator::WSDL::Interfaces::ShippingService::ShippingServiceEndpoint;
728             my $interface =
729             Shipment::Purolator::WSDL::Interfaces::ShippingService::ShippingServiceEndpoint
730             ->new(
731             { proxy_domain => $self->proxy_domain,
732             key => $self->key,
733             password => $self->password,
734             }
735             );
736              
737             my $response = $interface->VoidShipment(
738             {PIN => {Value => $self->tracking_id,},},
739             { 'Version' => '1.0',
740             'Language' => 'en',
741             'GroupID' => 'xxx',
742             'RequestReference' => 'Shipment::Purolator::cancel'
743             },
744             );
745              
746             #warn $response;
747              
748             my $success;
749             try {
750             $success = $response->get_ShipmentVoided->get_value;
751             }
752             catch {
753             try {
754             warn $_;
755             warn $response->get_ResponseInformation()->get_Errors()
756             ->get_Error()->[0]->get_Description;
757             $self->error($response->get_ResponseInformation()->get_Errors()
758             ->get_Error()->[0]->get_Description->get_value);
759             }
760             catch {
761             warn $_;
762             warn $response->get_faultstring;
763             $self->error($response->get_faultstring->get_value);
764             };
765             };
766              
767             return $success;
768             }
769              
770              
771             sub end_of_day {
772             my $self = shift;
773              
774             use DateTime;
775             use
776             Shipment::Purolator::WSDL::Interfaces::ShippingDocumentsService::ShippingDocumentsServiceEndpoint;
777             my $interface =
778             Shipment::Purolator::WSDL::Interfaces::ShippingDocumentsService::ShippingDocumentsServiceEndpoint
779             ->new(
780             { proxy_domain => $self->proxy_domain,
781             key => $self->key,
782             password => $self->password,
783             }
784             );
785              
786             #TODO: call Consolidate before getting manifest document
787              
788             my $response = $interface->GetShipmentManifestDocument(
789             { ShipmentManifestDocumentCriterium => {
790             ShipmentManifestDocumentCriteria =>
791             {ManifestDate => DateTime->now->ymd,}
792             }
793             },
794             { 'Version' => '1.1',
795             'Language' => 'en',
796             'GroupID' => 'xxx',
797             'RequestReference' => 'Shipment::Purolator::end_of_day'
798             },
799             );
800              
801             #warn $response;
802              
803             try {
804             use LWP::UserAgent;
805             my $ua = LWP::UserAgent->new('Shipping::Purolator');
806             my $req =
807             HTTP::Request->new(
808             GET => $response->get_ManifestBatches()->[0]->get_ManifestBatch()
809             ->get_ManifestBatchDetails->get_ManifestBatchDetail->get_URL()
810             ->get_value);
811             my $res = $ua->request($req);
812             $self->manifest(
813             Shipment::Label->new(
814             content_type => $res->header('Content-Type'),
815             data => $res->content,
816             file_name => 'manifest_' . DateTime->now->ymd('_') . '.pdf',
817             )
818             );
819             }
820             catch {
821             warn $_;
822             try {
823             warn $response->get_ResponseInformation()->get_Errors()
824             ->get_Error()->[0]->get_Description;
825             $self->error($response->get_ResponseInformation()->get_Errors()
826             ->get_Error()->[0]->get_Description->get_value);
827             }
828             catch {
829             warn $_;
830             warn $response->get_faultstring;
831             $self->error($response->get_faultstring->get_value);
832             };
833             };
834              
835             }
836              
837             no Moose;
838             no Moose::Util::TypeConstraints;
839              
840              
841             1;
842              
843             __END__
844              
845             =pod
846              
847             =encoding UTF-8
848              
849             =head1 NAME
850              
851             Shipment::Purolator
852              
853             =head1 VERSION
854              
855             version 0.18
856              
857             =head1 SYNOPSIS
858              
859             use Shipment::Purolator;
860             use Shipment::Address;
861             use Shipment::Package;
862              
863             my $shipment = Shipment::Purolator->new(
864             from_address => Shipment::Address->new( ... ),
865             to_address => Shipment::Address->new( ... ),
866             packages => [ Shipment::Package->new( ... ), ],
867             );
868              
869             foreach my $service ( $shipment->all_services ) {
870             print $service->id . "\n";
871             }
872              
873             $shipment->rate( 'express' );
874             print $shipment->service->cost . "\n";
875              
876             $shipment->ship( 'ground' );
877             $shipment->get_package(0)->label->save;
878              
879             =head1 NAME
880              
881             Shipment::Purolator - Interface to Purolator Shipping Web Services
882              
883             =head1 ABOUT
884              
885             This class provides an interface to the Purolator E-Ship Web Services. You must sign up for a development key in order to make use of this module.
886              
887             https://eship.purolator.com
888              
889             It is an extension of L<Shipment::Base>.
890              
891             It makes extensive use of SOAP::WSDL in order to create/decode xml requests and responses. The Shipment::UPS::WSDL interface was created primarily using the wsdl2perl.pl script from SOAP::WSDL.
892              
893             =head1 Class Attributes
894              
895             =head2 key, password
896              
897             Credentials required to access Puroator E-Ship Web Services
898              
899             =head2 proxy_domain
900              
901             This determines whether you will use the Purolator testing environment (for development) or the production (live) environment
902             * devwebservices.purolator.com (development)
903             * webservices.purolator.com (production)
904              
905             =head2 Shipment::Base type maps
906              
907             Shipment::Base provides abstract types which need to be mapped to Purolator codes (i.e. package_type of "custom" maps to Purolator "CustomerPackaging")
908              
909             =head2 printer types
910              
911             Purolator does not offer true thermal printing, all labels are provided as pdfs, thermal labels are simply a 4x6 pdf.
912              
913             =head2 default currency
914              
915             The default currency is CAD
916              
917             =head1 Class Methods
918              
919             =head2 _build_services
920              
921             This calls GetServicesOptions from the Service Availability API
922              
923             Each Service that is returned is added to services
924              
925             The following service mapping is used:
926             * ground => PurolatorGround (when shipping within the same city this gets mapped to PurolatorExpress)
927             * express => PurolatorExpress
928             * priority => PurolatorExpress9AM/10:30AM/12:00/Evening (exact service depends on what is available)
929              
930             All of the available service options are placed in the service->options hashref
931              
932             =head2 rate
933              
934             This method calls GetFullEstimate from the Estimating API
935              
936             =head2 ship
937              
938             This calls CreateShipment from the Shipping API
939              
940             It also calls fetch_documents which is a separate method since Purolator does not return the label along with the create shipment response.
941              
942             =head2 fetch_documents
943              
944             Calls GetDocuments from the Shipping Documents API
945              
946             Purolator returns all of the labels and required documents in a single pdf. Because of this, for a multi-piece shipment, calling
947              
948             $shipment->get_package(0)->label-save;
949              
950             will actually save a pdf file with all of the labels and documents. It is probably a better idea to make use of
951              
952             $shipment->documents->save
953              
954             =head2 cancel
955              
956             Calls VoidShipment from the Shipping API
957              
958             For multi-piece shipments, any 1 of the related tracking id's can be in $shipment->tracking_id. All related packages will be voided. There is no way to void a single package within a multi-piece shipment.
959              
960             returns "true" if successful
961              
962             =head2
963              
964             This depends on calling Consolidate from the Shipping API which has not been implemented yet
965              
966             Calls GetShipmentManifestDocument from the Shipping Documents API
967              
968             =head1 AUTHOR
969              
970             Andrew Baerg @ <andrew at pullingshots dot ca>
971              
972             http://pullingshots.ca/
973              
974             =head1 BUGS
975              
976             Please contact me directly.
977              
978             =head1 COPYRIGHT
979              
980             Copyright (C) 2010 Andrew J Baerg, All Rights Reserved
981              
982             =head1 NO WARRANTY
983              
984             Absolutely, positively NO WARRANTY, neither express or implied, is
985             offered with this software. You use this software at your own risk. In
986             case of loss, no person or entity owes you anything whatsoever. You
987             have been warned.
988              
989             =head1 LICENSE
990              
991             This program is free software; you can redistribute it and/or modify it
992             under the same terms as Perl itself.
993              
994             =head1 AUTHOR
995              
996             Andrew Baerg <baergaj@cpan.org>
997              
998             =head1 COPYRIGHT AND LICENSE
999              
1000             This software is copyright (c) 2013 by Andrew Baerg.
1001              
1002             This is free software; you can redistribute it and/or modify it under
1003             the same terms as the Perl 5 programming language system itself.
1004              
1005             =cut