code/UI_Tag/update_order_status.tag

   1 # Copyright 2002-2008 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 # $Id: update_order_status.tag,v 1.13 2008-06-26 12:43:44 mheins Exp $
   9
  10 UserTag update-order-status Order   order_number
  11 UserTag update-order-status addAttr
  12 UserTag update-order-status Version $Revision: 1.13 $
  13 UserTag update-order-status Routine <<EOR
  14 sub {
  15         my ($on, $opt) = @_;
  16 #::logDebug("Shipping order number $on, opt=" . ::uneval($opt));
  17         my $die = sub {
  18                 logError(@_);
  19                 return undef;
  20         };
  21         my $odb = database_exists_ref($opt->{orderline_table} || 'orderline')
  22                 or return $die->("No %s table!", 'orderline');
  23         my $tdb = database_exists_ref($opt->{transactions_table} || 'transactions')
  24                 or return $die->("No %s table!", 'transactions');
  25         my $udb = database_exists_ref($opt->{userdb_table} || 'userdb')
  26                 or return $die->("No %s table!", 'userdb');
  27
  28         my $trec = $tdb->row_hash($on);
  29
  30         if(! $trec) {
  31                 return $die->("Bad transaction number: %s", $on);
  32         }
  33
  34         my $user       = $trec->{username};
  35         my $wants_copy;
  36         if($udb->column_exists('email_copy')) {
  37                 $wants_copy = $udb->field($user, 'email_copy');
  38         }
  39         else {
  40                 $wants_copy = 1;
  41         }
  42
  43         for(qw/
  44                         archive
  45                         auth_code
  46                         cancel_order
  47                         do_archive
  48                         lines_shipped
  49                         send_email
  50                         settle_transaction
  51                         ship_all
  52                         status
  53                         tracking_number
  54                         void_transaction
  55                 /)
  56         {
  57                 $opt->{$_} = $CGI::values{$_} if ! defined $opt->{$_};
  58         }
  59
  60         my @track_keys = grep /tracking_number__1$/, keys %CGI::values;
  61         my @otracks;
  62         for(@track_keys) {
  63                 if(m{^(\d+)_}) {
  64                         $otracks[$1] = $CGI::values{$_};
  65                 }
  66                 else {
  67                         $otracks[0] = $CGI::values{$_};
  68                 }
  69         }
  70
  71         if($opt->{ship_all} == 2 or $opt->{void_transaction} or $opt->{cancel_order}) {
  72                 $opt->{cancel_order} = 1;
  73                 $opt->{ship_all} = 2;
  74         }
  75
  76         $opt->{archive} ||= $opt->{do_archive};
  77
  78         $wants_copy = $opt->{send_email} if length $opt->{send_email};
  79 #Log("Order number=$on username=$user wants=$wants_copy");
  80         delete $::Scratch->{ship_notice_username};
  81         delete $::Scratch->{ship_notice_email};
  82         if($wants_copy) {
  83                 $::Scratch->{ship_notice_username} = $user;
  84                 $::Scratch->{ship_notice_email} = $udb->field($user, 'email')
  85                         or delete $::Scratch->{ship_notice_username};
  86         }
  87
  88
  89         if($opt->{settle_transaction}) {
  90                 my $oid = $trec->{order_id};
  91                 my $amount = $trec->{total_cost};
  92                 SETTLE: {
  93                         if(! $oid) {
  94                                 Vend::Tags->error( {
  95                                                                 name => 'settle_transaction',
  96                                                                 set => "No order ID to settle!",
  97                                                         });
  98                                 return undef;
  99                         }
 100                         elsif($oid =~ /\*$/) {
 101                                 Vend::Tags->error( {
 102                                                                 name => 'settle_transaction',
 103                                                                 set => "Order ID $oid already settled!",
 104                                                         });
 105                                 return undef;
 106                         }
 107                         else {
 108 #::logDebug("auth-code: $trec->{auth_code} oid=$oid");
 109                                 my $settled  = Vend::Tags->charge( {
 110                                                                         route => $::Variable->{MV_PAYMENT_MODE},
 111                                                                         order_id => $oid,
 112                                                                         amount => $amount,
 113                                                                         auth_code => $trec->{auth_code},
 114                                                                         transaction => 'settle_prior',
 115                                                                 });
 116                                 if($settled) {
 117                                         $tdb->set_field($on, 'order_id', "$oid*");
 118                                         Vend::Tags->warning(
 119                                                                  errmsg(
 120                                                                         "Order ID %s settled with processor.",
 121                                                                         $oid,
 122                                                                  ),
 123                                                         );
 124                                 }
 125                                 else {
 126                                         Vend::Tags->error( {
 127                                                 name => 'settle_transaction',
 128                                                 set => errmsg(
 129                                                                 "Order ID %s settle operation failed. Reason: %s",
 130                                                                 $oid,
 131                                                                 $Vend::Session->{payment_result}{MErrMsg},
 132                                                                 ),
 133                                                         });
 134                                                 return undef;
 135                                 }
 136
 137                         }
 138                 }
 139         }
 140         elsif($opt->{void_transaction}) {
 141                 my $oid = $trec->{order_id};
 142                 $oid =~ s/\*$//;
 143                 my $amount = $trec->{total_cost};
 144                 SETTLE: {
 145                         if(! $oid) {
 146                                 Vend::Tags->error( {
 147                                                                 name => 'void_transaction',
 148                                                                 set => "No order ID to void!",
 149                                                         });
 150                                 return undef;
 151                         }
 152                         elsif($oid =~ /-$/) {
 153                                 Vend::Tags->error( {
 154                                                                 name => 'void_transaction',
 155                                                                 set => "Order ID $oid already voided!",
 156                                                         });
 157                                 return undef;
 158                         }
 159                         else {
 160 #::logDebug("auth-code: $trec->{auth_code} oid=$oid");
 161                                 my $voided  = Vend::Tags->charge( {
 162                                                                         route => $::Variable->{MV_PAYMENT_MODE},
 163                                                                         order_id => $oid,
 164                                                                         amount => $amount,
 165                                                                         auth_code => $trec->{auth_code},
 166                                                                         transaction => 'void',
 167                                                                 });
 168                                 if($voided) {
 169                                         $tdb->set_field($on, 'order_id', $oid . "-");
 170                                         Vend::Tags->warning(
 171                                                                  errmsg(
 172                                                                         "Order ID %s voided.",
 173                                                                         $oid,
 174                                                                  ),
 175                                                         );
 176                                 }
 177                                 else {
 178                                         Vend::Tags->error( {
 179                                                 name => 'void_transaction',
 180                                                 set => errmsg(
 181                                                                 "Order ID %s void operation failed. Reason: %s",
 182                                                                 $oid,
 183                                                                 $Vend::Session->{payment_result}{MErrMsg},
 184                                                                 ),
 185                                                         });
 186                                                 return undef;
 187                                 }
 188
 189                         }
 190                 }
 191         }
 192
 193         if($opt->{status} =~ /\d\d\d\d/) {
 194                 $tdb->set_field($on, 'status', $opt->{status});
 195         }
 196         else {
 197                 $tdb->set_field($on, 'status', 'shipped');
 198         }
 199
 200         if($opt->{tracking_number} =~ /\w/) {
 201                 $tdb->set_field($on, 'tracking_number', $opt->{tracking_number});
 202         }
 203
 204         my $need_shiplines;
 205         my @shiplines;
 206         if($opt->{lines_shipped}) {
 207                 @shiplines = grep /\S/, split /\0/, $opt->{lines_shipped};
 208         }
 209         else {
 210                 $need_shiplines = 1;
 211         }
 212
 213         if(! @shiplines and ! $opt->{ship_all}) {
 214                 my @keys = grep /status__1/, keys %CGI::values;
 215 #::logDebug("keys to ship: " . join(',', @keys));
 216                 my %stuff;
 217                 for(@keys) {
 218 #::logDebug("examining $_");
 219                         my $n = 0;
 220                         m/^(\d+)_/ and $n = $1;
 221                         $n++;
 222                         if($opt->{ship_all} or $CGI::values{$_} eq 'shipped') {
 223                                 push @shiplines, $n;
 224 #::logDebug("ship $n");
 225                         }
 226                 }
 227                 undef $need_shiplines;
 228         }
 229         else {
 230                 @shiplines = map { s/.*\D//; $_; } @shiplines;
 231         }
 232
 233         my $count_q = "select * from orderline where order_number = '$on'";
 234         my $lines_ary =  $odb->query($count_q);
 235         if(! $lines_ary) {
 236                 $::Scratch->{ui_message} = "No order lines for order $on";
 237                 return;
 238         }
 239         my $total_lines = scalar @$lines_ary;
 240
 241         my $odb_keypos = $odb->config('KEY_INDEX');
 242
 243         # See if some items have already shipped
 244         my %shipping;
 245         my %already;
 246
 247         my $target_status = $opt->{cancel_order} ? 'canceled' : 'shipped';
 248
 249         my $i = 0;
 250         for(@$lines_ary) {
 251                 my $code = $_->[$odb_keypos];
 252                 my $status = $odb->field($code, 'status');
 253                 if (@otracks) {
 254                         $odb->set_field($code,'tracking_number',$otracks[$i]);
 255                 }
 256                 my $line = $code;
 257                 push @shiplines, $line if $need_shiplines;
 258                 $line =~ s/.*\D//;
 259                 $line =~ s/^0+//;
 260                 if($status eq $target_status and ! $opt->{cancel_order}) {
 261                         $already{$line} = 1;
 262                 }
 263                 elsif($opt->{ship_all}) {
 264                         $shipping{$line} = 1;
 265                 }
 266                 $i++;
 267         }
 268
 269         my $to_ship = scalar @shiplines;
 270
 271 #::logDebug("total_lines=$total_lines to_ship=$to_ship shiplines=" . uneval(\@shiplines));
 272
 273         my $ship_mesg;
 274         my $g_status;
 275
 276         @shiplines = grep ! $already{$_}, @shiplines;
 277         @shipping{@shiplines} = @shiplines;
 278
 279         if($total_lines == $to_ship) {
 280                 $ship_mesg = "Order $on complete, $total_lines lines set shipped.";
 281                 $::Scratch->{ship_notice_complete} = $ship_mesg;
 282                 $g_status = $target_status;
 283         }
 284         else {
 285                 $ship_mesg = "Order $on partially shipped ($to_ship of $total_lines lines).";
 286                 delete $::Scratch->{ship_notice_complete};
 287                 $g_status = 'partial';
 288         }
 289
 290         my $minor_mesg = '';
 291
 292         my $email_mesg = $::Scratch->{ship_notice_username}
 293                                         ? "Email copy sent to $::Scratch->{ship_notice_email}."
 294                                         : "No email copy sent as per user preference.";
 295
 296         my $dotime = $odb->config('DSN');
 297         my $update_date;
 298         $dotime = $dotime =~ /dbi:mysql:/ ? 0 : 1;
 299         $update_date = POSIX::strftime('%Y-%m-%d %H:%M:%S %z', localtime());
 300
 301         # Actually update the orderline database
 302         for(@$lines_ary) {
 303                 my $code = $_->[$odb_keypos];
 304                 my $line = $code;
 305                 $line =~ s/.*\D//;
 306                 next if $already{$line};
 307                 my $status = $shipping{$line} ? $target_status : 'backorder';
 308                 $odb->set_field($code, 'status', $status)
 309                         or do {
 310                                 $::Scratch->{ui_message} = "Orderline $code ship status update failed.";
 311                                 return;
 312                         };
 313                 if($dotime) {
 314                         $odb->set_field($code, 'update_date', $update_date)
 315                                 or do {
 316                                         $::Scratch->{ui_message} = "Orderline $code ship date update failed.";
 317                                         return;
 318                                 };
 319                 }
 320
 321         }
 322
 323         for(keys %already) {
 324                 $shipping{$_} = $_;
 325         }
 326
 327         my $total_shipped_now = scalar keys %shipping;
 328
 329         delete $::Scratch->{ship_now_complete};
 330
 331         if($opt->{cancel_order}) {
 332                 $g_status = 'canceled';
 333                 $ship_mesg = "Order $on canceled.";
 334         }
 335         elsif (
 336                 $total_lines != scalar @shiplines
 337                         and
 338                 $total_shipped_now == $total_lines
 339           )
 340         {
 341                 $g_status = 'shipped';
 342                 $::Scratch->{ship_now_complete} = 1
 343                         if $total_shipped_now == $total_lines;
 344                 $ship_mesg = "Order $on now complete (all $total_lines lines).";
 345         }
 346
 347         $tdb->set_field($on, 'status', $g_status);
 348         $tdb->set_field($on, 'archived', 1)
 349                 if $opt->{archive} and $g_status eq $target_status;
 350
 351         Vend::Tags->warning("$ship_mesg $email_mesg");
 352         delete $::Scratch->{ship_notice_username};
 353         delete $::Scratch->{ship_notice_email};
 354         delete $::Scratch->{ship_notice_order_number};
 355         if($wants_copy) {
 356                 $::Scratch->{ship_notice_order_number} = $on;
 357                 $::Scratch->{ship_notice_username} = $user;
 358                 $::Scratch->{ship_notice_email} = $trec->{email}
 359                         or delete $::Scratch->{ship_notice_username};
 360                 if($opt->{send_email}) {
 361                         my $filename = $opt->{ship_notice_template} || 'etc/ship_notice';
 362                         my $contents = $Tag->file($filename);
 363                         if($contents) {
 364                                 $contents = interpolate_html($contents);
 365                                 $contents =~ s/^\s+//;
 366                                 $contents =~ s/\s*$/\n/;
 367                                 $Tag->email_raw({}, $contents);
 368                         }
 369                         else {
 370                                 $Tag->warnings(
 371                                                 errmsg("No ship_notice_template '%s' found", $filename),
 372                                         );
 373                         }
 374                 }
 375         }
 376         return;
 377 }
 378 EOR