[interchange-cvs] interchange - danb modified lib/Vend/Ship.pm

[interchange-cvs at icdevgroup.org]

User:      danb
Date:      2008-04-11 07:47:16 GMT
Modified:  lib/Vend Ship.pm
Log:
Augment shipping.asc with shipping_callout SpecialSub.

This change allows you to call another function after the normal shipping
has been calculated, but before the result is returned. It's useful for
the type of customization that would require modifying too many shipping
table entries or using entirely custom shipping code, because it allows
you to build on the powerful shipping features interchange already has.
It is backwards-compatible. For example:

# Calculate shipping as normal with shipping.asc, then apply a discount
# for dealers using UPS shipping methods.
Sub custom_shipping <<EOF
sub {
    Â  Â  my ($final, $mode, $opt, $o) = @_;
    Â  Â  $final *= .90 if $Scratch->{dealer} and $mode =~ /UPS/i;
    Â  Â  return $final;
}
EOF
SpecialSub shipping_callout custom_shipping

Revision  Changes    Path
2.27                 interchange/lib/Vend/Ship.pm


rev 2.27, prev_rev 2.26
Index: Ship.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Ship.pm,v
retrieving revision 2.26
retrieving revision 2.27
diff -u -r2.26 -r2.27
--- Ship.pm	9 Aug 2007 13:40:54 -0000	2.26
+++ Ship.pm	11 Apr 2008 07:47:16 -0000	2.27
@@ -1,8 +1,8 @@
 # Vend::Ship - Interchange shipping code
 # 
-# $Id: Ship.pm,v 2.26 2007-08-09 13:40:54 pajamian Exp $
+# $Id: Ship.pm,v 2.27 2008-04-11 07:47:16 danb Exp $
 #
-# Copyright (C) 2002-2007 Interchange Development Group
+# Copyright (C) 2002-2008 Interchange Development Group
 # Copyright (C) 1996-2002 Red Hat, Inc.
 #
 # This program was originally based on Vend 0.2 and 0.3
@@ -909,6 +909,16 @@
 			}
 			undef $opt->{default};
 		}
+		if (my $callout_name = $Vend::Cfg->{SpecialSub}{shipping_callout}) {
+#::logDebug("Execute shipping callout '$callout_name(...)'");
+			my $sub = $Vend::Cfg->{Sub}{$callout_name} 
+				|| $Global::GlobalSub->{$callout_name};
+			eval {
+				my $callout_result = $sub->($final, $mode, $opt, $o);
+				$final = $callout_result if defined $callout_result;
+			};
+			::logError("Shipping callout '$callout_name' died: $@") if $@;
+		}
 		return $final unless $opt->{label};
 		my $number;
 		if($o->{free} and $final == 0) {