Name

update-order-status —

ATTRIBUTES

Attribute Pos. Req. Default Description
order_number Yes
orderline_table
transactions_table
userdb_table
ship_all
void_transaction
cancel_order
archive
do_archive
send_email
settle_transaction
status
tracking_number
lines_shipped
ship_notice_template
interpolate     0 interpolate output?
hide     0 Hide the tag return value?

DESCRIPTION

BEHAVIOR

This tag appears to be affected by, or affects, the following:
Catalog Variables: MV_PAYMENT_MODE

EXAMPLES

No examples are available at this time. We do consider this a problem and will try to supply some.

NOTES

AVAILABILITY

update-order-status is available in Interchange versions:

4.6.0-5.7.0 (git-head)

SOURCE

Interchange 5.7.0:

Source: code/UI_Tag/update_order_status.tag
Lines: 378


# Copyright 2002-2008 Interchange Development Group and others
# 
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.  See the LICENSE file for details.
# 
# $Id: update_order_status.tag,v 1.13 2008-06-26 12:43:44 mheins Exp $

UserTag update-order-status Order   order_number
UserTag update-order-status addAttr
UserTag update-order-status Version $Revision: 1.13 $
UserTag update-order-status Routine <<EOR
sub {
my ($on, $opt) = @_;
#::logDebug("Shipping order number $on, opt=" . ::uneval($opt));
my $die = sub {
  logError(@_);
  return undef;
};
my $odb = database_exists_ref($opt->{orderline_table} || 'orderline')
  or return $die->("No %s table!", 'orderline');
my $tdb = database_exists_ref($opt->{transactions_table} || 'transactions')
  or return $die->("No %s table!", 'transactions');
my $udb = database_exists_ref($opt->{userdb_table} || 'userdb')
  or return $die->("No %s table!", 'userdb');

my $trec = $tdb->row_hash($on);

if(! $trec) {
  return $die->("Bad transaction number: %s", $on);
}

my $user       = $trec->{username};
my $wants_copy;
if($udb->column_exists('email_copy')) {
  $wants_copy = $udb->field($user, 'email_copy');
}
else {
  $wants_copy = 1;
}

for(qw/
    archive
    auth_code
    cancel_order
    do_archive
    lines_shipped
    send_email
    settle_transaction
    ship_all
    status
    tracking_number
    void_transaction
  /)
{
  $opt->{$_} = $CGI::values{$_} if ! defined $opt->{$_};
}

my @track_keys = grep /tracking_number__1$/, keys %CGI::values;
my @otracks;
for(@track_keys) {
  if(m{^(\d+)_}) {
    $otracks[$1] = $CGI::values{$_};
  }
  else {
    $otracks[0] = $CGI::values{$_};
  }
}

if($opt->{ship_all} == 2 or $opt->{void_transaction} or $opt->{cancel_order}) {
  $opt->{cancel_order} = 1;
  $opt->{ship_all} = 2;
}

$opt->{archive} ||= $opt->{do_archive};

$wants_copy = $opt->{send_email} if length $opt->{send_email};
#Log("Order number=$on username=$user wants=$wants_copy");
delete $::Scratch->{ship_notice_username};
delete $::Scratch->{ship_notice_email};
if($wants_copy) {
  $::Scratch->{ship_notice_username} = $user;
  $::Scratch->{ship_notice_email} = $udb->field($user, 'email')
    or delete $::Scratch->{ship_notice_username};
}

 
if($opt->{settle_transaction}) {
  my $oid = $trec->{order_id};
  my $amount = $trec->{total_cost};
  SETTLE: {
    if(! $oid) {
      Vend::Tags->error( {
              name => 'settle_transaction',
              set => "No order ID to settle!",
            });
      return undef;
    }
elsif($oid =~ /\*$/) {
Vend::Tags->error( {
        name => 'settle_transaction',
        set => "Order ID $oid already settled!",
      });
return undef;
}
else {
#::logDebug("auth-code: $trec->{auth_code} oid=$oid");
my $settled  = Vend::Tags->charge( {
          route => $::Variable->{MV_PAYMENT_MODE},
          order_id => $oid,
          amount => $amount,
          auth_code => $trec->{auth_code},
          transaction => 'settle_prior',
              });
      if($settled) {
        $tdb->set_field($on, 'order_id', "$oid*");
        Vend::Tags->warning(
               errmsg(
                 "Order ID %s settled with processor.",
                $oid,
               ),
            );
      }
      else {
        Vend::Tags->error( {
          name => 'settle_transaction',
          set => errmsg(
              "Order ID %s settle operation failed. Reason: %s",
              $oid,
              $Vend::Session->{payment_result}{MErrMsg},
              ),
            });
          return undef;
      }

    }
  }
}
elsif($opt->{void_transaction}) {
  my $oid = $trec->{order_id};
  $oid =~ s/\*$//;
  my $amount = $trec->{total_cost};
  SETTLE: {
    if(! $oid) {
      Vend::Tags->error( {
              name => 'void_transaction',
              set => "No order ID to void!",
            });
      return undef;
    }
elsif($oid =~ /-$/) {
Vend::Tags->error( {
        name => 'void_transaction',
        set => "Order ID $oid already voided!",
      });
return undef;
}
else {
#::logDebug("auth-code: $trec->{auth_code} oid=$oid");
my $voided  = Vend::Tags->charge( {
          route => $::Variable->{MV_PAYMENT_MODE},
          order_id => $oid,
          amount => $amount,
          auth_code => $trec->{auth_code},
          transaction => 'void',
              });
      if($voided) {
        $tdb->set_field($on, 'order_id', $oid . "-");
        Vend::Tags->warning(
               errmsg(
                 "Order ID %s voided.",
                $oid,
               ),
            );
      }
      else {
        Vend::Tags->error( {
          name => 'void_transaction',
          set => errmsg(
              "Order ID %s void operation failed. Reason: %s",
              $oid,
              $Vend::Session->{payment_result}{MErrMsg},
              ),
            });
          return undef;
      }

    }
  }
}

if($opt->{status} =~ /\d\d\d\d/) {
  $tdb->set_field($on, 'status', $opt->{status});
}
else {
  $tdb->set_field($on, 'status', 'shipped');
}

if($opt->{tracking_number} =~ /\w/) {
  $tdb->set_field($on, 'tracking_number', $opt->{tracking_number});
}

my $need_shiplines;
my @shiplines;
if($opt->{lines_shipped}) {
  @shiplines = grep /\S/, split /\0/, $opt->{lines_shipped};
}
else {
  $need_shiplines = 1;
}

if(! @shiplines and ! $opt->{ship_all}) {
  my @keys = grep /status__1/, keys %CGI::values;
#::logDebug("keys to ship: " . join(',', @keys));
  my %stuff;
  for(@keys) {
#::logDebug("examining $_");
    my $n = 0;
    m/^(\d+)_/ and $n = $1;
    $n++;
    if($opt->{ship_all} or $CGI::values{$_} eq 'shipped') {
      push @shiplines, $n;
#::logDebug("ship $n");
    }
  }
  undef $need_shiplines;
}
else {
  @shiplines = map { s/.*\D//; $_; } @shiplines;
}

my $count_q = "select * from orderline where order_number = '$on'";
my $lines_ary =  $odb->query($count_q);
if(! $lines_ary) {
  $::Scratch->{ui_message} = "No order lines for order $on";
  return;
}
my $total_lines = scalar @$lines_ary;

my $odb_keypos = $odb->config('KEY_INDEX');

# See if some items have already shipped
my %shipping;
my %already;

my $target_status = $opt->{cancel_order} ? 'canceled' : 'shipped';

my $i = 0;
for(@$lines_ary) {
  my $code = $_->[$odb_keypos];
  my $status = $odb->field($code, 'status');
  if (@otracks) {
    $odb->set_field($code,'tracking_number',$otracks[$i]);
  }
  my $line = $code;
  push @shiplines, $line if $need_shiplines;
  $line =~ s/.*\D//;
  $line =~ s/^0+//;
  if($status eq $target_status and ! $opt->{cancel_order}) {
    $already{$line} = 1;
  }
  elsif($opt->{ship_all}) {
    $shipping{$line} = 1;
  }
  $i++;
}

my $to_ship = scalar @shiplines;

#::logDebug("total_lines=$total_lines to_ship=$to_ship shiplines=" . uneval(\@shiplines));

my $ship_mesg;
my $g_status;

@shiplines = grep ! $already{$_}, @shiplines;
@shipping{@shiplines} = @shiplines;

if($total_lines == $to_ship) {
  $ship_mesg = "Order $on complete, $total_lines lines set shipped.";
  $::Scratch->{ship_notice_complete} = $ship_mesg;
  $g_status = $target_status;
}
else {
  $ship_mesg = "Order $on partially shipped ($to_ship of $total_lines lines).";
  delete $::Scratch->{ship_notice_complete};
  $g_status = 'partial';
}

my $minor_mesg = '';

my $email_mesg = $::Scratch->{ship_notice_username}
        ? "Email copy sent to $::Scratch->{ship_notice_email}."
        : "No email copy sent as per user preference.";

my $dotime = $odb->config('DSN');
my $update_date;
$dotime = $dotime =~ /dbi:mysql:/ ? 0 : 1;
$update_date = POSIX::strftime('%Y-%m-%d %H:%M:%S %z', localtime());

# Actually update the orderline database
for(@$lines_ary) {
  my $code = $_->[$odb_keypos];
  my $line = $code;
  $line =~ s/.*\D//;
  next if $already{$line};
  my $status = $shipping{$line} ? $target_status : 'backorder';
  $odb->set_field($code, 'status', $status)
    or do {
      $::Scratch->{ui_message} = "Orderline $code ship status update failed.";
      return;
    };
  if($dotime) {
    $odb->set_field($code, 'update_date', $update_date)
      or do {
        $::Scratch->{ui_message} = "Orderline $code ship date update failed.";
        return;
      };
  }

}

for(keys %already) {
  $shipping{$_} = $_;
}

my $total_shipped_now = scalar keys %shipping; 

delete $::Scratch->{ship_now_complete};

if($opt->{cancel_order}) {
  $g_status = 'canceled';
  $ship_mesg = "Order $on canceled.";
}
elsif (
  $total_lines != scalar @shiplines
    and
  $total_shipped_now == $total_lines 
  )
{
  $g_status = 'shipped';
  $::Scratch->{ship_now_complete} = 1
    if $total_shipped_now == $total_lines;
  $ship_mesg = "Order $on now complete (all $total_lines lines).";
}

$tdb->set_field($on, 'status', $g_status);
$tdb->set_field($on, 'archived', 1)
  if $opt->{archive} and $g_status eq $target_status;

Vend::Tags->warning("$ship_mesg $email_mesg");
delete $::Scratch->{ship_notice_username};
delete $::Scratch->{ship_notice_email};
delete $::Scratch->{ship_notice_order_number};
if($wants_copy) {
  $::Scratch->{ship_notice_order_number} = $on;
  $::Scratch->{ship_notice_username} = $user;
  $::Scratch->{ship_notice_email} = $trec->{email}
    or delete $::Scratch->{ship_notice_username};
  if($opt->{send_email}) {
    my $filename = $opt->{ship_notice_template} || 'etc/ship_notice';
    my $contents = $Tag->file($filename);
    if($contents) {
      $contents = interpolate_html($contents);
      $contents =~ s/^\s+//;
      $contents =~ s/\s*$/\n/;
      $Tag->email_raw({}, $contents);
    }
    else {
      $Tag->warnings(
          errmsg("No ship_notice_template '%s' found", $filename),
        );
    }
  }
}
return;
}
EOR

AUTHORS

Interchange Development Group

SEE ALSO

DocBook! Interchange!