<![CDATA[
#!/usr/bin/perl
=pod Notes and ToDo
Con-way XML Sample Code for Rating 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
* to get customer-specific discounts, replace CUSTNMBR String value
below with your Con-way customer number
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';
## to get a customer-specific discount, replace the CUSTNMBR string below with
## your Con-way customer number, then uncomment the <CustNmbr> line below.
my $custNmbr = 'CUSTNMBR';
my $requestType = 'RateRequest';
my $responseType = 'RateQuote';
my $postUri = 'https://www.Con-way.com/XMLj/X-Rate';
my $today = time2str("%D", time);
=pod XML Data setup
In actual use, you would probably populate the Rating 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 $originzip='33172';
my $destzip='10941';
# Create Commodity Items Array
my @items;
# Add Commodity Items
push @items, {cmdtyClass => '775', weight =>'644'};
push @items, {cmdtyClass => '100', weight =>'824'};
## Build the XML Request
my $xmlRequest = "
<RateRequest>
<OriginZip country=\"us\">$originzip</OriginZip>
<DestinationZip country=\"us\">$destzip</DestinationZip>";
## To get customer specific discount, uncomment this line:
## $xmlRequest .= "<CustNmbr shipcode=\"S\">$custNmbr</CustNmbr>";
$xmlRequest .= "<ChargeCode>P</ChargeCode>
<DiscountRate>100</DiscountRate>
<EffectiveDate>$today</EffectiveDate>";
for my $item (@items) {
$xmlRequest .= "
<Item>
<CmdtyClass>$item->{'cmdtyClass'}</CmdtyClass>
<Weight unit=\"lbs\">$item->{'weight'}</Weight>
</Item>";
}
$xmlRequest .= "</RateRequest>";
## print $xmlRequest;
## 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 = "NetCharge";
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";
}
}
]]>