code/UserTag/usps_query.tag

   1 # Copyright 2002-2009 Interchange Development Group and others
   2 #
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 2 of the License, or
   6 # (at your option) any later version.  See the LICENSE file for details.
   7
   8 UserTag  usps-query  Order   service weight
   9 UserTag  usps-query  addAttr
  10 UserTag  usps-query  Version 1.10
  11 UserTag  usps-query  Routine <<EOR
  12
  13 sub {
  14     my ($service, $weight, $opt) = @_;
  15     my ($rate, $resp, $xml, $mailtype, @intl, $m_rep, $m_mod);
  16     my %supported_services = (
  17                               'EXPRESS'     => 1,
  18                               'FIRST CLASS' => 1,
  19                               'PRIORITY'    => 1,
  20                               'PARCEL'      => 1,
  21                               'BPM'         => 1,
  22                               'LIBRARY'     => 1,
  23                               'MEDIA'       => 1,
  24                               'GLOBAL EXPRESS GUARANTEED'                              => 1,
  25                               'GLOBAL EXPRESS GUARANTEED NON-DOCUMENT RECTANGULAR'     => 1,
  26                               'GLOBAL EXPRESS GUARANTEED NON-DOCUMENT NON-RECTANGULAR' => 1,
  27                               'USPS GXG ENVELOPES'                                     => 1,
  28                               'EXPRESS MAIL INTERNATIONAL (EMS)'                       => 1,
  29                               'EXPRESS MAIL INTERNATIONAL (EMS) FLAT-RATE ENVELOPE'    => 1,
  30                               'PRIORITY MAIL INTERNATIONAL'                            => 1,
  31                               'PRIORITY MAIL INTERNATIONAL FLAT-RATE ENVELOPE'         => 1,
  32                               'PRIORITY MAIL INTERNATIONAL REGULAR FLAT-RATE BOXES'    => 1,
  33                               'PRIORITY MAIL INTERNATIONAL LARGE FLAT-RATE BOX'        => 1,
  34                               'PRIORITY MAIL INTERNATIONAL SMALL FLAT-RATE BOX'        => 1,
  35                               'FIRST CLASS MAIL INTERNATIONAL LARGE ENVELOPE'          => 1,
  36                               'FIRST CLASS MAIL INTERNATIONAL PACKAGE'                 => 1,
  37                               'MATTER FOR THE BLIND - ECONOMY MAIL'            => 1,
  38                               );
  39     my %package_sizes = (
  40                          'REGULAR'  => 1,
  41                          'LARGE'    => 1,
  42                          'OVERSIZE' => 1,
  43                          );
  44     my %mailtypes = (
  45                      'package'                  => 1,
  46                      'postcards or aerogrammes' => 1,
  47                      'matter for the blind'     => 1,
  48                      'envelope'                 => 1,
  49                      );
  50
  51     my $error_msg = 'USPS: ';
  52     my $origin = $opt->{origin} || $::Variable->{USPS_ORIGIN} || $::Variable->{UPS_ORIGIN};
  53     my $destination = $opt->{destination} || $::Values->{zip} || $::Variable->{SHIP_DEFAULT_ZIP};
  54     my $userid = $opt->{userid} || $::Variable->{USPS_ID};
  55     my $passwd = $opt->{passwd} || $::Variable->{USPS_PASSWORD};
  56     my $url = $opt->{url} || $::Variable->{USPS_URL} || 'http://Production.ShippingAPIs.com/ShippingAPI.dll';
  57     my $container = $opt->{container} || $::Variable->{USPS_CONTAINER} || 'None';
  58     my $machinable = $opt->{machinable} || $::Variable->{USPS_MACHINABLE} || 'False';
  59
  60     $service = uc $service;
  61     if (! $supported_services{$service}) {
  62         $error_msg .= "unknown service type $service.";
  63         return;
  64     }
  65
  66     my $size = uc ($opt->{size} || $::Variable->{USPS_SIZE} || 'REGULAR');
  67     if (! $package_sizes{$size}) {
  68         $error_msg .= "unknown package size $size.";
  69         return;
  70         }
  71
  72     if ($service eq 'PARCEL') {
  73         if ($weight < .375 or $weight > 35) {
  74             $machinable = 'False';
  75         }
  76     }
  77
  78     if ($opt->{country}) {
  79         $mailtype = lc ($opt->{mailtype} || $::Variable->{USPS_MAILTYPE} || 'package');
  80         unless ($mailtypes{$mailtype}) {
  81             $error_msg = "unknown mail type '$mailtype'.";
  82             return;
  83         }
  84     }
  85
  86     my $modulo = $opt->{modulo} || $::Variable->{USPS_MODULO};
  87     if ($modulo and ($modulo < $weight)) {
  88         $m_rep = int $weight / $modulo;
  89         $m_mod = $weight % $modulo;
  90         $weight = $modulo;
  91     }
  92
  93
  94 RATEQUOTE: {
  95     my $ounces = int(($weight - int($weight)) * 16);
  96     $weight = int $weight;
  97
  98     if ($opt->{country}) {
  99         my %map = (
 100             q{United Kingdom} => q{Great Britain},
 101             q{Virgin Islands, British} => q{British Virgin Islands},
 102             q{Viet Nam} => q{Vietnam},
 103             q{Tanzania, United Republic Of} => q{Tanzania},
 104             q{Slovakia} => q{Slovak Republic},
 105             q{Serbia} => q{Serbia-Montenegro},
 106             q{Montenegro} => q{Serbia-Montenegro},
 107             q{Samoa} => q{Western Samoa},
 108             q{Saint Kitts And Nevis} => q{St. Christopher and Nevis},
 109             q{Russian Federation} => q{Russia},
 110             q{Pitcairn} => q{Pitcairn Island},
 111             q{Moldova, Republic Of} => q{Moldova},
 112             q{Marshall Islands} => q{Republic of the Marshall Islands},
 113             q{Macedonia, The Former Yugoslav R} => q{Macedonia, Republic of},
 114             q{Libyan Arab Jamahiriya} => q{Libya},
 115             q{Lao People's Democratic Republic} => q{Laos},
 116             q{Korea, Republic of} => q{South Korea},
 117             q{Iran, Islamic Republic Of} => q{Iran},
 118             q{Holy See (Vatican City State)} => q{Vatican City},
 119             q{Georgia} => q{Georgia, Republic of},
 120             q{Falkland Islands (Malvinas)} => q{Falkland Islands},
 121             q{Cote d'Ivoire (Ivory Coast)} => q{Cote d'Ivoire},
 122             q{Congo, The Democratic Republic O} => q{Democratic Republic of the Congo},
 123             q{Congo} => q{Congo, Republic of the},
 124             q{Bosnia And Herzegowina} => q{Bosnia-Herzegovina},
 125         );
 126
 127         my $usps_country = $map{ $opt->{country} }
 128             || $opt->{country};
 129
 130         $xml = qq{API=IntlRate\&XML=<IntlRateRequest USERID="$userid" PASSWORD="$passwd">};
 131         $xml .= <<EOXML;
 132         <Package ID="0">
 133             <Pounds>$weight</Pounds>
 134             <Ounces>$ounces</Ounces>
 135             <MailType>$mailtype</MailType>
 136             <Country>$usps_country</Country>
 137         </Package>
 138         </IntlRateRequest>
 139 EOXML
 140     }
 141     else {
 142         $xml = qq{API=Rate\&XML=<RateRequest USERID="$userid" PASSWORD="$passwd">};
 143         $xml .= <<EOXML;
 144         <Package ID="0">
 145             <Service>$service</Service>
 146             <ZipOrigination>$origin</ZipOrigination>
 147             <ZipDestination>$destination</ZipDestination>
 148             <Pounds>$weight</Pounds>
 149             <Ounces>$ounces</Ounces>
 150             <Container>$container</Container>
 151             <Size>$size</Size>
 152             <Machinable>$machinable</Machinable>
 153         </Package>
 154         </RateRequest>
 155 EOXML
 156     }
 157
 158     my $ua = new LWP::UserAgent;
 159     my $req = new HTTP::Request 'POST', "$url";
 160     $req->content_type('application/x-www-form-urlencoded');
 161     $req->content($xml);
 162     my $response = $ua->request($req);
 163
 164     $error_msg = 'USPS: ';
 165     if ($response->is_success) {
 166         $resp = $response->content;
 167     }
 168     else {
 169         $error_msg .= 'Error obtaining rate quote from usps.com.';
 170     }
 171
 172     if ($resp =~ /<Error>/i) {
 173         $resp =~ m|<Description>(.+)</Description>|;
 174         $error_msg .=  $1;
 175     }
 176     else {
 177         if ($opt->{country}) {
 178             @intl = split /<Service/, $resp;
 179             foreach (@intl) {
 180                 m|<SvcDescription>(.+)</SvcDescription>|;
 181                 $resp = uc $1;
 182                 if ($resp eq $service) {
 183                     m|<Postage>(.+)</Postage>|;
 184                     $rate += $1;
 185                     undef $error_msg;
 186                     last;
 187                 }
 188             }
 189         }
 190         else {
 191             $resp =~ m|<Postage>(.+)</Postage>|;
 192             $rate += $1;
 193             undef $error_msg;
 194         }
 195     }
 196 }
 197
 198     if ($m_rep) {
 199         $rate *= $m_rep; undef $m_rep;
 200     }
 201     if ($m_mod) {
 202         $weight = $m_mod; undef $m_mod;
 203         goto RATEQUOTE;
 204     }
 205
 206     $::Session->{ship_message} .= " $error_msg" if $error_msg;
 207     return $rate;
 208 }
 209 EOR
 210
 211 UserTag  usps-query  Documentation <<EOD
 212
 213 =head1 NAME
 214
 215
 216 usps-query tag -- calculate USPS costs via www
 217
 218 =head1 SYNOPSIS
 219
 220   [usps-query
 221     service="service name"
 222     weight="NNN"
 223     userid="USPS webtools user id"*
 224     passwd="USPS webtools password"*
 225     origin="NNNNN"*
 226     destination="NNNNN"*
 227     url="applet URL"*
 228     container="container type"*
 229     size="package size"*
 230     machinable="True/False"*
 231     mailtype="mailing type"*
 232     country="Country name"*
 233     modulo="NN"*
 234   ]
 235
 236 =head1 DESCRIPTION
 237
 238 Calculates USPS costs via the WWW using the United States Postal Service Rate
 239 Rate Calculator API. You *MUST* register with USPS in order to use this service.
 240 Visit http://www.usps.com/webtools and follow the link(s) to register. You will
 241 receive a confirmation email upon completing the registration process. You
 242 *MUST* follow the instructions in this email to obtain access to the production
 243 rate quote server. THIS USERTAG WILL NOT WORK WITH USPS's TEST SERVER.
 244
 245
 246 =head1 PARAMETERS
 247
 248 =head2 Base Parameters (always required):
 249
 250
 251 =over 4
 252
 253 =item service
 254
 255 The USPS service you wish to get a rate quote for. Services currently supported:
 256
 257     EXPRESS
 258     FIRST CLASS
 259     PRIORITY
 260     PARCEL
 261     BPM
 262     LIBRARY
 263     MEDIA
 264     GLOBAL EXPRESS GUARANTEED
 265     GLOBAL EXPRESS GUARANTEED NON-DOCUMENT RECTANGULAR
 266     GLOBAL EXPRESS GUARANTEED NON-DOCUMENT NON-RECTANGULAR
 267     USPS GXG ENVELOPES
 268     EXPRESS MAIL INTERNATIONAL (EMS)
 269     EXPRESS MAIL INTERNATIONAL (EMS) FLAT-RATE ENVELOPE
 270     PRIORITY MAIL INTERNATIONAL
 271     PRIORITY MAIL INTERNATIONAL FLAT-RATE ENVELOPE
 272     PRIORITY MAIL INTERNATIONAL REGULAR FLAT-RATE BOXES
 273     PRIORITY MAIL INTERNATIONAL LARGE FLAT-RATE BOX
 274     PRIORITY MAIL INTERNATIONAL SMALL FLAT-RATE BOX
 275     FIRST CLASS MAIL INTERNATIONAL LARGE ENVELOPE
 276     FIRST CLASS MAIL INTERNATIONAL PACKAGE
 277     MATTER FOR THE BLIND - ECONOMY MAIL
 278
 279
 280 =item weight
 281
 282 The total weight of the items to be mailed/shipped.
 283
 284 =item userid
 285
 286 Your USPS webtools userid, which was obtained by registering.
 287 This will default to $Variable->{USPS_ID}, which is the preferred
 288 way to set this parameter.
 289
 290 =item passwd
 291
 292 Your USPS webtools passwd, which was obtained by registering.
 293 This will default to $Variable->{USPS_PASSWORD}, which is the
 294 preferred way to set this parameter.
 295
 296 =back
 297
 298 =head2 Extended Parameters (domestic and international services)
 299
 300
 301 =over 4
 302
 303 =item url
 304
 305 The URL of the USPS rate quote API. The default is $Variable->{USPS_URL}
 306 or 'http://Production.ShippingAPIs.com/ShippingAPI.dll'.
 307
 308 =item modulo
 309
 310 Enables a rudimentary method of obtaining rate quotes for multi-box shipments.
 311 'modulo' is a number which represents the maximum weight per box; the default
 312 is $Variable->{USPS_MODULO}. When modulo > 0, the shipping weight will be divided
 313 into the number of individual parcels of max. weight 'modulo' which will accommodate
 314 the whole shipment, and the total rate will be calculated accordingly.
 315 Example: with modulo = 10, a 34.5lbs. shipment will be calculated as 3 parcels
 316 weighing 10lbs. each, plus one parcel weighing 4lbs. 8oz.
 317
 318 =back
 319
 320 =head2 Extended Parameters for domestic (U.S.) services only
 321
 322
 323 =over 4
 324
 325 =item origin
 326
 327 Origin zip code. Default is $Variable->{USPS_ORIGIN} or $Variable->{UPS_ORIGIN}.
 328
 329 =item destination
 330
 331 Destination zip code. Default is $Values->{zip} or $Variable->{SHIP_DEFAULT_ZIP}.
 332
 333 =item container
 334
 335 The USPS-defined container type for the shipment. Default is
 336 Variable->{USPS_CONTAINER} or 'None". Please see the Technical Guide to the
 337 Domestic Rates Calculator Application Programming Interface for a complete
 338 list of container types.
 339
 340 =item size
 341
 342 The USPS-defined package size for the shipment. Valid choices are
 343 'REGULAR', 'LARGE', and 'OVERSIZE'. The default is $Variable->{USPS_SIZE} or
 344 'REGULAR'. Please see the Technical Guide to the Domestic Rates Calculator
 345 Application Programming Interface for a definition of package sizes.
 346
 347 =item machinable (for PARCEL service only)
 348
 349 Possible value are 'True' and 'False'. Indicates whether or not the shipment
 350 qualifies for machine processing by UPS. Default is $Variable->{USPS_MACHINABLE}
 351 or 'False". Consult the USPS service guides for more info on this subject.
 352
 353 =back
 354
 355 =head2 Extended parameters for International services only
 356
 357
 358 =over 4
 359
 360 =item mailtype
 361
 362 The USPS-defined mail type for the shipment. Valid choices are:
 363
 364     package
 365     postcards or aerogrammes
 366     matter for the blind
 367     envelope
 368
 369 Default is $Variable->{USPS_MAILTYPE} or 'package'. See the USPS international
 370 service guides for more information on this topic.
 371
 372 =item country (required for international services)
 373
 374 Destination country. No default. You must pass the name of the country, not the ISO
 375 code or abbreviation (i.e. 'Canada', not 'CA'). Note that USPS maintains a table of
 376 valid country names which does not necessarily match all entries in the country
 377 table which is distributed with the standard demo, so modifications may be needed
 378 if you intend to use USPS international services. Consult the USPS International
 379 Services guide for more information.
 380
 381 =back
 382
 383 =head1 BUGS
 384
 385 We shall see....
 386
 387 =head1 AUTHORS
 388
 389  Ed LaFrance <edl@newmediaems.com>
 390  Josh Lavin <josh@perusion.com>
 391  Mathew Jones <mat@bibliopolis.com>
 392
 393 =cut
 394 EOD