lib/Vend/Ship/QueryUPS.pm

   1 # Vend::Ship::QueryUPS - Interchange shipping code
   2 #
   3 # $Id: QueryUPS.pm,v 1.8 2008-05-14 16:21:02 mheins Exp $
   4 #
   5 # Copyright (C) 2002-2007 Interchange Development Group
   6 # Copyright (C) 1996-2002 Red Hat, Inc.
   7 #
   8 # This program was originally based on Vend 0.2 and 0.3
   9 # Copyright 1995 by Andrew M. Wilcox <amw@wilcoxsolutions.com>
  10 #
  11 # This program is free software; you can redistribute it and/or modify
  12 # it under the terms of the GNU General Public License as published by
  13 # the Free Software Foundation; either version 2 of the License, or
  14 # (at your option) any later version.
  15 #
  16 # This program is distributed in the hope that it will be useful,
  17 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 # GNU General Public License for more details.
  20 #
  21 # You should have received a copy of the GNU General Public
  22 # License along with this program; if not, write to the Free
  23 # Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
  24 # MA  02110-1301  USA.
  25
  26 package Vend::Ship::QueryUPS;
  27
  28 use Vend::Util;
  29 use Vend::Interpolate;
  30 use Vend::Data;
  31 use Vend::Ship;
  32 use POSIX qw(ceil);
  33
  34 my $Have_Business_UPS;
  35 eval {
  36         require Business::UPS;
  37         import Business::UPS;
  38         $Have_Business_UPS = 1;
  39 };
  40
  41 sub calculate {
  42         my ($mode, $weight, $row, $opt, $tagopt, $extra) = @_;
  43
  44         unless($Have_Business_UPS) {
  45                 do_error("Ship mode %s: Requires installation of Business::UPS", $mode);
  46         }
  47
  48         $opt->{service}         ||= $opt->{table};
  49         if(! $opt->{service} and $extra =~ /^\w+$/)  {
  50                 $opt->{service} = $extra;
  51         }
  52         $opt->{service} ||= $opt->{table} || $mode;
  53
  54         $opt->{origin}                  ||= $::Variable->{UPS_ORIGIN};
  55         $opt->{country_field}   ||= $::Variable->{UPS_COUNTRY_FIELD} || 'country';
  56         $opt->{geo}                             ||= $::Variable->{UPS_POSTCODE_FIELD} || 'zip';
  57
  58         my $origin  = $opt->{origin};
  59         my $country = $opt->{country} || $::Values->{$opt->{country_field}};
  60
  61         $country ||= $opt->{default_country} || 'US';
  62
  63         my $zip     = $opt->{zip}         || $::Values->{$opt->{geo}};
  64         $zip ||= $opt->{default_geo};
  65
  66         my $modulo = $opt->{aggregate};
  67
  68         if($modulo and $modulo <= 1) {
  69                 $modulo = $::Variable->{UPS_QUERY_MODULO} || 150;
  70         }
  71         elsif(! $modulo) {
  72                 $modulo = 9999999;
  73         }
  74
  75         $country = uc $country;
  76
  77     my %exception = ( UK => 'GB');
  78
  79         if(! $::Variable->{UPS_COUNTRY_REMAP} ) {
  80                 # do nothing
  81         }
  82         elsif ($::Variable->{UPS_COUNTRY_REMAP} =~ /=/) {
  83                 my $new = Vend::Util::get_option_hash($::Variable->{UPS_COUNTRY_REMAP});
  84                 Vend::Util::get_option_hash(\%exception, $new);
  85         }
  86         else {
  87                 Vend::Util::hash_string($::Variable->{UPS_COUNTRY_REMAP}, \%exception);
  88         }
  89
  90         $country = $exception{$country} if $exception{$country};
  91
  92         # In the U.S., UPS only wants the 5-digit base ZIP code, not ZIP+4
  93         $country eq 'US' and $zip =~ /^(\d{5})/ and $zip = $1;
  94
  95 #::logDebug("calling QueryUPS with: " . join("|", $opt->{service}, $origin, $zip, $weight, $country,$modulo));
  96
  97         my $cache;
  98         my $cache_code;
  99         my $db;
 100         my $now;
 101         my $updated;
 102         my %cline;
 103         my $shipping;
 104         my $zone;
 105         my $error;
 106
 107         my $ctable = $opt->{cache_table} || 'ups_cache';
 108
 109
 110         if($Vend::Database{$ctable}) {
 111                 $Vend::WriteDatabase{$ctable} = 1;
 112                 CACHE: {
 113                         $db = dbref($ctable)
 114                                 or last CACHE;
 115                         my $tname = $db->name();
 116                         $cache = 1;
 117                         $weight = ceil($weight);
 118                         %cline = (
 119                                 weight => $weight,
 120                                 origin => $origin,
 121                                 country => $country,
 122                                 zip     => $zip,
 123                                 shipmode => $opt->{service},
 124                         );
 125
 126                         my @items;
 127                         # reverse sort makes zip first
 128                         for(reverse sort keys %cline) {
 129                                 push @items, "$_ = " . $db->quote($cline{$_}, $_);
 130                         }
 131
 132                         my $string = join " AND ", @items;
 133                         my $q = qq{SELECT code,cost,updated from $tname WHERE $string};
 134                         my $ary = $db->query($q);
 135 #::logDebug("query cache: " . ::uneval($ary));
 136                         if($ary and $ary->[0] and $cache_code = $ary->[0][0]) {
 137                                 $shipping = $ary->[0][1];
 138                                 $updated = $ary->[0][2];
 139                                 $now = time();
 140                                 if($now - $updated > $Variable->{UPS_CACHE_EXPIRE} || 86000) {
 141                                         undef $shipping;
 142                                         $updated = $now;
 143                                 }
 144                                 elsif($shipping <= 0) {
 145                                         $error = $shipping;
 146                                         $updated = $now;
 147                                         $shipping = 0;
 148                                 }
 149                         }
 150 #::logDebug("shipping is: " . (defined $shipping ? $shipping : 'undef'));
 151                 }
 152         }
 153
 154         my $w = $weight;
 155         my $maxcost;
 156         my $tmpcost;
 157
 158         unless(defined $shipping) {
 159                 $shipping = 0;
 160                 while($w > $modulo) {
 161                         $w -= $modulo;
 162                         if($maxcost) {
 163                                 $shipping += $maxcost;
 164                                 next;
 165                         }
 166
 167                         ($maxcost, $zone, $error)
 168                                 = getUPS( $opt->{service}, $origin, $zip, $modulo, $country);
 169                         if($error) {
 170                                 do_error(       "Ship mode %s: Error calling UPS service %s",
 171                                                         $mode,
 172                                                         $opt->{service}, );
 173                                 return 0;
 174                         }
 175                         $shipping += $maxcost;
 176                 }
 177
 178                 undef $error;
 179 #::logDebug("calling getUPS( $opt->{service}, $origin, $zip, $w, $country)");
 180                 ($tmpcost, $zone, $error)
 181                         = getUPS( $opt->{service}, $origin, $zip, $w, $country);
 182
 183                 $shipping += $tmpcost;
 184                 if($cache) {
 185                         $cline{updated} = $now || time();
 186                         $cline{cost} = $shipping || $error;
 187                         $db->set_slice($cache_code, \%cline);
 188                 }
 189         }
 190
 191         if($error) {
 192                 do_error(       "Ship mode %s: Error calling UPS service %s",
 193                                         $mode,
 194                                         $opt->{service}, );
 195                 $shipping = 0;
 196         }
 197         return $shipping;
 198 }
 199
 200 =head1 NAME
 201
 202 Vend::Ship::QueryUPS -- calculate UPS costs via www
 203
 204 =head1 SYNOPSIS
 205
 206   (catalog.cfg)
 207
 208   Shipping  QueryUPS  default_geo  45056
 209
 210   (shipping.asc)
 211   ground: UPS Ground Commercial
 212      origin  45056
 213      service GNDCOM
 214
 215          min    0
 216          max    0
 217          cost   e Nothing to ship!
 218
 219          min    0
 220          max    150
 221          cost   s QueryUPS
 222
 223          min    150
 224          max    99999999
 225          cost   e Too heavy for UPS.
 226
 227 =head1 DESCRIPTION
 228
 229 Calculates UPS costs via the WWW using Business::UPS.
 230
 231 To activate, configure any parameter in catalog.cfg. A good choice
 232 is the default origin zip.
 233
 234 Options:
 235
 236 =over 4
 237
 238 =item weight
 239
 240 Weight in pounds. Required -- normally passed via CRIT parameter.
 241
 242 =item service
 243
 244 Any valid Business::UPS mode (required). Example: 1DA,2DA,GNDCOM. Defaults
 245 to the mode name.
 246
 247 =item geo
 248
 249 Location of field containing zip code. Default is 'zip'.
 250
 251 =item country_field
 252
 253 Location of field containing country code. Default is 'country'.
 254
 255 =item default_geo
 256
 257 The ZIP code to use if none supplied -- for defaulting shipping to some
 258 value in absence of ZIP. No default -- will return 0 and error if
 259 no zip.
 260
 261 =item default_country
 262
 263 The country code to use if none supplied -- for defaulting shipping to some
 264 value in absence of country. Default US.
 265
 266 =item aggregate
 267
 268 If 1, aggregates by a call to weight=150 (or $Variable->{UPS_QUERY_MODULO}).
 269 Multiplies that times number necessary, then runs a call for the
 270 remainder. In other words:
 271
 272         [ups-query weight=400 mode=GNDCOM aggregate=1]
 273
 274 is equivalent to:
 275
 276         [calc]
 277                 [ups-query weight=150 mode=GNDCOM] +
 278                 [ups-query weight=150 mode=GNDCOM] +
 279                 [ups-query weight=100 mode=GNDCOM];
 280         [/calc]
 281
 282 If set to a number above 1, will be the modulo to do repeated calls by. So:
 283
 284         [ups-query weight=400 mode=GNDCOM aggregate=100]
 285
 286 is equivalent to:
 287
 288         [calc]
 289                 [ups-query weight=100 mode=GNDCOM] +
 290                 [ups-query weight=100 mode=GNDCOM] +
 291                 [ups-query weight=100 mode=GNDCOM] +
 292                 [ups-query weight=100 mode=GNDCOM];
 293         [/calc]
 294
 295 To aggregate by 1, use .999999.
 296
 297 =item cache_table
 298
 299 Set to the name of a table (default ups_cache) which can cache the
 300 calls so repeated calls for the same values will not require repeated
 301 calls to UPS.
 302
 303 Table needs to be set up with:
 304
 305         Database   ups_cache        ship/ups_cache.txt         __SQLDSN__
 306         Database   ups_cache        AUTO_SEQUENCE  ups_cache_seq
 307         Database   ups_cache        DEFAULT_TYPE varchar(12)
 308         Database   ups_cache        INDEX  weight origin zip shipmode country
 309
 310 And have the fields:
 311
 312          code weight origin zip country shipmode cost updated
 313
 314 Typical cached data will be like:
 315
 316         code    weight  origin  zip     country shipmode        cost    updated
 317         14      11      45056   99501   US      2DA     35.14   1052704130
 318         15      11      45056   99501   US      1DA     57.78   1052704130
 319         16      11      45056   99501   US      2DA     35.14   1052704132
 320         17      11      45056   99501   US      1DA     57.78   1052704133
 321
 322 Cache expires in one day.
 323
 324 =back
 325
 326 =cut
 327
 328 1;