<![CDATA[
#!/usr/bin/perl
=pod Notes and ToDo
Con-way XML Sample Code for Bill of Lading Interface
required software: Expat (http://sourceforge.net/projects/expat/)
TODO:
* replace the USERNAME and PASSWORD String values below
with your Con-way username and password
Send questions to Con-way XML Support at xmlsupport@Con-way.com
=cut
use strict;
use Date::Format;
use HTTP::Request::Common;
use LWP::UserAgent;
use Crypt::SSLEay;
use URI::Escape;
use XML::Parser;
use XML::SimpleObject;
=pod
Documentation for XML::SimpleObject here:
http://aspn.activestate.com/ASPN/CodeDoc/XML-SimpleObject/SimpleObject.html
=cut
## Replace USERNAME and PASSWORD strings with your Con-way username and password
my $username = 'USERNAME';
my $password = 'PASSWORD';
my $requestType = 'BOLrequest';
my $responseType = 'BOLresponse';
my $postUri = 'https://www.Con-way.com/XMLj/X-BOL';
my $today = time2str("%D", time);
=pod XML Data setup
In actual use, you would probably populate the BOL Request parameters
(Weights, Classes, Zip Codes, etc.) from data submitted via an on-line order form or database.
For this sample we will just hard code some dummy data.
=cut
my $pronumber='';
my $originzip='97202';
my $destzip='10941';
# Create Commodity Items Array
my @items;
# Add Commodity Items
push @items, {qty=>'44', pkgtype=>'PLT', weight=>'644', desc=>'widget-arms', cmdtyClass=>'775', nmfc=>'', hazmat=>'N' };
push @items, {qty=>'66', pkgtype=>'PCS', weight=>'1223', desc=>'cam-shafts', cmdtyClass=>'100', nmfc=>'', hazmat=>'N' };
# Create Accessorials Array
my @accessorials;
# Add Accessorials
push @accessorials, {chgcode => 'P', acccode => 'GUR'};
push @accessorials, {chgcode => 'C', acccode => 'DID'};
push @accessorials, {chgcode => 'C', acccode => 'DST'};
## Build the XML Request - use single quotes for these strings because they contain '@' for email addresses
my $xmlRequest = '
<BOLrequest testmode="Y">
<RequesterUserId shipcode="S">'. $username .'</RequesterUserId>
<ChargeCode>P</ChargeCode>
<PRONmbr>'. $pronumber .'</PRONmbr>
<CustRefNmbrs>
<PurchaseOrderNmbr>3338889</PurchaseOrderNmbr>
<PurchaseOrderNmbr>3338890</PurchaseOrderNmbr>
<OtherRefNmbr refcode="SKU" refdesc="SKU Number">3213A</OtherRefNmbr>
<OtherRefNmbr refcode="UPC" refdesc="UPC number">789283</OtherRefNmbr>
</CustRefNmbrs>
<Shipper>
<ShipperName>Alan Shipley</ShipperName>
<ShipperAddr>1234 NE Main</ShipperAddr>
<ShipperCity>Portland</ShipperCity>
<ShipperState>OR</ShipperState>
<ShipperZip country="US">'. $originzip .'</ShipperZip>
<ShipperPhone extension="6055">503.450.6055</ShipperPhone>
<ShipperEmail>vonderluft.andrew@Con-way.com</ShipperEmail>
</Shipper>
<Consignee>
<ConsigneeCustNmbr>883885</ConsigneeCustNmbr>
<ConsigneePhone extension="6666">503.450.6800</ConsigneePhone>
<ConsigneeEmail>vonderluft.andrew@Con-way.com</ConsigneeEmail>
</Consignee>';
## Add commodity items
for my $item (@items) {
$xmlRequest .= '
<Item>
<Quantity pkgtype="'. $item->{'pkgtype'} .'">'. $item->{'qty'} .'</Quantity>
<Weight unit="lbs">'. $item->{'weight'} .'</Weight>
<Description>'. $item->{'desc'} .'</Description>
<CmdtyClass>'. $item->{'cmdtyClass'} .'</CmdtyClass>
<NMFClass>'. $item->{'nmfc'} .'</NMFClass>
<HazMat>'. $item->{'hazmat'} .'</HazMat>
</Item>';
}
## Add accessorials
for my $acc (@accessorials) {
$xmlRequest .= '
<Accessorial chargecode="'. $acc->{'chgcode'} .'">'. $acc->{'acccode'} .'</Accessorial>';
}
$xmlRequest .= '
<ShippingRemarks>TEST TEST TEST</ShippingRemarks>
<EmergencyContact></EmergencyContact>
<PickupRequest>
<PickupDate>'. $today .'</PickupDate>
<PickupReadyTime>4:00 pm</PickupReadyTime>
<DockCloseTime>7:00 pm</DockCloseTime>
<ContactName>Frank</ContactName>
<ContactCompany>Franklin Arms</ContactCompany>
<ContactPhone>(333)444-4321</ContactPhone>
</PickupRequest>
<SendBOLemail/>';
$xmlRequest .= '</BOLrequest>';
## print $xmlRequest . "\n\n";
## URL Encode the XML String
$xmlRequest = uri_escape($xmlRequest);
## Set up the HTTP request
my $req = HTTP::Request->new(POST => $postUri);
$req->authorization_basic($username, $password);
$req->content_type('application/x-www-form-urlencoded');
$req->content("$requestType=$xmlRequest");
my $userAgent = LWP::UserAgent->new;
my $resp = $userAgent->request($req);
## Abort now with error message if not successful
if (!$resp->is_success) {
print $resp->error_as_HTML;
exit;
}
## Parse the XML response
my $parser = XML::Parser->new(ErrorContext => 2, Style => "Tree");
my $respObj = XML::SimpleObject->new( $parser->parse($resp->content) );
my $rootEl = $respObj->child($responseType);
## Some ways to access the XML response data:
## To print out information for the entire XML response:
parseElement($rootEl);
## To get information for just one child element of the root:
my $respElement = "Status";
parseElement($rootEl->child($respElement));
## If you only want to get some key data:
my $respValue = $rootEl->child($respElement)->value;
print "\n $respElement: $respValue";
=item
This subroutine accesses and prints the XML tree for the element argument,
printing element names, attibutes and text values, but not in any order.
It processess recursively, so as to print the entire tree for the given element.
=cut
sub parseElement {
my $parseEl = $_[0];
print "Parsing element <", $parseEl->name, ">:\n";
printElementAttributes($parseEl);
printElementValue($parseEl);
foreach my $element ($parseEl->children()) {
print "<", $element->name, "> element - \n";
printElementAttributes($element);
printElementValue($element);
if ($element->children()) {
print " Beginning children of <",$element->name,">: \n\n";
parseElement($element);
print " End of children for <", $element->name, ">\n";
}
print "\n";
}
}
sub printElementAttributes {
my $element = $_[0];
if ($element->attributes()) {
my %attributes = $element->attributes();
print "\t", "Attributes: ";
foreach my $key (keys %attributes) {
my $value = $attributes{$key};
print $key."=\"".$value ."\" ";
}
print "\n";
}
}
sub printElementValue {
if ($_[0]->value) {
print "\t", "Value: ", $_[0]->value, "\n";
}
}
]]>