[interchange-cvs] interchange - heins modified 6 files
interchange-core@interchange.redhat.com
interchange-core@interchange.redhat.com
Sun Jul 7 00:03:01 2002
User: heins
Date: 2002-07-07 04:02:27 GMT
Modified: scripts interchange.PL
Modified: lib/Vend Cart.pm Interpolate.pm Order.pm
Added: code/SystemTag levies.coretag levy_list.coretag
Log:
* Add [levy-list] TEMPLATE CODE [/levy-list] to display the levy-based
tax/shipping stuff.
* Add [levies ...] tag to access shipping, handling, and salestax
charges via ITL.
* Continuing improvement on levy system including cacheing, explicit
recalcs, automatic recalc upon cart toss, labels, currency or
cost display that uses Locale, etc. More to come.
* Fix Profile stuff to properly read a real hash and array instead
of always interpolating a string.
Revision Changes Path
2.40 +2 -2 interchange/scripts/interchange.PL
rev 2.40, prev_rev 2.39
Index: interchange.PL
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /anon_cvs/repository/interchange/scripts/interchange.PL,v
retrieving revision 2.39
retrieving revision 2.40
diff -u -r2.39 -r2.40
--- interchange.PL 3 Jul 2002 16:23:43 -0000 2.39
+++ interchange.PL 7 Jul 2002 04:02:26 -0000 2.40
@@ -3,7 +3,7 @@
#
# Interchange version 4.9.1
#
-# $Id: interchange.PL,v 2.39 2002/07/03 16:23:43 mheins Exp $
+# $Id: interchange.PL,v 2.40 2002/07/07 04:02:26 mheins Exp $
#
# Copyright (C) 1996-2002 Red Hat, Inc. <interchange@redhat.com>
#
@@ -457,7 +457,7 @@
=20
# If the user has put in "0" for any quantity, delete that item
# from the order list. Handles sub-items.
- Vend::Cart::toss_cart($cart);
+ Vend::Cart::toss_cart($cart, $CGI::values{mv_cartname});
=20
#::logDebug("after toss, cart is: " . ::uneval($cart));
=20
1.1 interchange/code/SystemTag/levies.coretag
rev 1.1, prev_rev 1.0
Index: levies.coretag
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
UserTag levies Order group
UserTag levies addAttr
UserTag levies InvalidateCache
UserTag levies PosNumber 1
UserTag levies Routine <<EOR
sub {
my ($group, $opt) =3D @_;
my $cost =3D Vend::Interpolate::levies($opt->{recalculate}, $opt->{cart}, =
$opt);
return $cost unless $opt->{hide};
return '';
}
EOR
1.1 interchange/code/SystemTag/levy_list.coretag
rev 1.1, prev_rev 1.0
Index: levy_list.coretag
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
UserTag levy-list Order name
UserTag levy-list addAttr
UserTag levy-list attrAlias cart name
UserTag levy-list hasEndTag
UserTag levy-list InvalidateCache
UserTag levy-list Routine <<EOR
sub {
my($cart,$opt,$text) =3D @_;
my $lev =3D $Vend::Session->{levies} ||=3D {};
my $obj =3D {
mv_results =3D> $cart
? ($lev->{$cart} ||=3D [] )
: ($lev->{$Vend::CurrentCart || 'main'} ||=3D [] )
};
return if ! $text;
$opt->{prefix} =3D 'levy' unless defined $opt->{prefix};
return labeled_list($opt, $text, $obj);
}
EOR
2.6 +4 -4 interchange/lib/Vend/Cart.pm
rev 2.6, prev_rev 2.5
Index: Cart.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /anon_cvs/repository/interchange/lib/Vend/Cart.pm,v
retrieving revision 2.5
retrieving revision 2.6
diff -u -r2.5 -r2.6
--- Cart.pm 6 Jul 2002 07:13:01 -0000 2.5
+++ Cart.pm 7 Jul 2002 04:02:27 -0000 2.6
@@ -1,6 +1,6 @@
# Vend::Cart - Interchange shopping cart management routines
#
-# $Id: Cart.pm,v 2.5 2002/07/06 07:13:01 mheins Exp $
+# $Id: Cart.pm,v 2.6 2002/07/07 04:02:27 mheins Exp $
#
# Copyright (C) 1996-2002 Red Hat, Inc. <interchange@redhat.com>
#
@@ -24,7 +24,7 @@
=20
package Vend::Cart;
=20
-$VERSION =3D substr(q$Revision: 2.5 $, 10);
+$VERSION =3D substr(q$Revision: 2.6 $, 10);
=20
use strict;
=20
@@ -135,7 +135,7 @@
# If the user has put in "0" for any quantity, delete that item
# from the order list.
sub toss_cart {
- my($s) =3D @_;
+ my($s, $cartname) =3D @_;
my $i;
my $sub;
my (@master);
@@ -238,7 +238,7 @@
@{$s} =3D @items[sort {$a <=3D> $b} keys %save];
}
}
- Vend::Interpolate::levies();
+ Vend::Interpolate::levies(1, $cartname);
return 1;
}
=20
2.82 +88 -12 interchange/lib/Vend/Interpolate.pm
rev 2.82, prev_rev 2.81
Index: Interpolate.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /anon_cvs/repository/interchange/lib/Vend/Interpolate.pm,v
retrieving revision 2.81
retrieving revision 2.82
diff -u -r2.81 -r2.82
--- Interpolate.pm 6 Jul 2002 07:13:01 -0000 2.81
+++ Interpolate.pm 7 Jul 2002 04:02:27 -0000 2.82
@@ -1,6 +1,6 @@
# Vend::Interpolate - Interpret Interchange tags
#=20
-# $Id: Interpolate.pm,v 2.81 2002/07/06 07:13:01 mheins Exp $
+# $Id: Interpolate.pm,v 2.82 2002/07/07 04:02:27 mheins Exp $
#
# Copyright (C) 1996-2002 Red Hat, Inc. <interchange@redhat.com>
#
@@ -27,7 +27,7 @@
require Exporter;
@ISA =3D qw(Exporter);
=20
-$VERSION =3D substr(q$Revision: 2.81 $, 10);
+$VERSION =3D substr(q$Revision: 2.82 $, 10);
=20
@EXPORT =3D qw (
=20
@@ -1549,20 +1549,24 @@
#::logDebug("doing profile $one");
next unless defined $Vend::Cfg->{$one};
my $string;
- my $val;
+ my $val =3D $prof->{$one};
if( ! ref $Vend::Cfg->{$one} ) {
- $val =3D $prof->{$one};
+ # Do nothing
}
- elsif( ref($Vend::Cfg->{$one}) =3D~ /HASH/ ) {
+ elsif( ref($Vend::Cfg->{$one}) eq 'HASH') {
+ if( ref($val) ne 'HASH') {
$string =3D '{' . $prof->{$one} . '}'
unless $prof->{$one} =3D~ /^{/
and $prof->{$one} =3D~ /}\s*$/;
}
- elsif( ref($Vend::Cfg->{$one}) =3D~ /ARRAY/ ) {
+ }
+ elsif( ref($Vend::Cfg->{$one}) eq 'ARRAY') {
+ if( ref($val) ne 'ARRAY') {
$string =3D '[' . $prof->{$one} . ']'
unless $prof->{$one} =3D~ /^\[/
and $prof->{$one} =3D~ /]\s*$/;
}
+ }
else {
::logError( "profile: cannot handle object of type %s.",
$Vend::Cfg->{$one},
@@ -5605,7 +5609,7 @@
$cart =3D $Vend::Items;
}
return if ! ref $cart;
- Vend::Cart::toss_cart($cart);
+ Vend::Cart::toss_cart($cart, $opt->{name});
}
elsif ($func eq 'process') {
::do_process();
@@ -6378,6 +6382,9 @@
$save =3D $Vend::Items;
tag_cart($cart);
}
+
+ levies() unless $Vend::Levying;
+
my $discount =3D defined $Vend::Session->{discount};
$subtotal =3D 0;
$tmp =3D 0;
@@ -6534,12 +6541,38 @@
return $cost;
}
=20
+sub levy_sum {
+ my ($set, $levies, $repos) =3D @_;
+
+ $set ||=3D $Vend::CurrentCart || 'main';
+ $levies ||=3D $Vend::Cfg->{Levies};
+ $repos ||=3D $Vend::Cfg->{Levy_repository};
+
+ my $icart =3D $Vend::Session->{carts}{$set} || [];
+
+ my @sums;
+ for(@$icart) {
+ push @sums, @{$_}{sort keys %$_};
+ }
+ my $items;
+ for(@$levies) {
+ next unless $items =3D $repos->{$_}{check_status};
+ push @sums, @{$::Values}{ split /[\s,\0]/, $items };
+ }
+ return generate_key(@sums);
+}
+
sub levies {
- my($set, $opt) =3D @_;
+ my($recalc, $set, $opt) =3D @_;
+
my $levies;
-#::logDebug("Calling levies");
return unless $levies =3D $Vend::Cfg->{Levies};
+
+
+ $opt ||=3D {};
my $repos =3D $Vend::Cfg->{Levy_repository};
+#::logDebug("Calling levies, recalc=3D$recalc group=3D$opt->{group}");
+
if(! $repos) {
logOnce('error', "Levies set but no levies defined! No tax or shipping."=
);
return;
@@ -6549,6 +6582,20 @@
$set ||=3D 'main';
=20
$Vend::Session->{levies} ||=3D {};
+=09
+ my $lcheck =3D $Vend::Session->{latest_levy} ||=3D {};
+ $lcheck =3D $lcheck->{$set} ||=3D {};
+
+ if($Vend::LeviedOnce and ! $recalc and ! $opt->{group} and $lcheck->{sum}=
) {
+ my $newsum =3D levy_sum($set, $levies, $repos);
+#::logDebug("did levy check, new=3D$newsum old=3D$lcheck->{sum}");
+ if($newsum eq $lcheck->{sum}) {
+ undef $Vend::Levying;
+#::logDebug("levy returning cached value");
+ return $lcheck->{total};
+ }
+ }
+
my $lcart =3D $Vend::Session->{levies}{$set} =3D [];
=20=09
my $run =3D 0;
@@ -6560,7 +6607,17 @@
next;
}
my $type =3D $l->{type} || ($name eq 'salestax' ? 'salestax' : 'shipping=
');
- my $mode =3D $l->{mode} || $name;
+ my $mode;
+
+ if($l->{mode_from_values}) {
+ $mode =3D $::Values->{$l->{mode_from_values}};
+ }
+ elsif($l->{mode_from_scratch}) {
+ $mode =3D $::Scratch->{$l->{mode_from_scratch}};
+ }
+
+ $mode ||=3D ($l->{mode} || $name);
+ my $group =3D $l->{group} || $type;
my $cost =3D 0;
my $sort;
my $desc;
@@ -6583,7 +6640,7 @@
$sort =3D $type eq 'handling' ? 100 : 500;
}
$cost =3D shipping($mode);
- $desc =3D $l->{description} || shipping_desc($mode);
+ $desc =3D $l->{description} || tag_shipping_desc($mode);
}
elsif($type eq 'custom') {
my $sub;
@@ -6605,11 +6662,20 @@
logError("No subroutine found for custom levy '%s'", $name);
}
}
+
+ my $cost_format;
+ unless ($cost_format =3D $l->{cost_format}) {
+ my $digits =3D errmsg('frac_digits') || 2;
+ $cost_format =3D "%.${digits}f";
+ }
my $item =3D {
code =3D> $name,
mode =3D> $mode,
sort =3D> $sort,
- cost =3D> $cost,
+ cost =3D> sprintf($cost_format,$cost),
+ currency =3D> currency($cost),
+ group =3D> $group,
+ label =3D> $l->{label} || $desc,
description =3D> $desc,
};
if($cost =3D=3D 0) {
@@ -6622,9 +6688,19 @@
@$lcart =3D sort { $a->{sort} cmp $b->{sort} } @$lcart;
=20
for(@$lcart) {
+ next if $opt->{group} and $opt->{group} ne $_->{group};
$run +=3D $_->{cost};
}
+
$run =3D round_to_frac_digits($run);
+ if(! $opt->{group}) {
+ $lcheck =3D $Vend::Session->{latest_levy}{$set} =3D {};
+ $lcheck->{sum} =3D levy_sum($set, $levies, $repos);
+ $lcheck->{total} =3D $run;
+ $Vend::LeviedOnce =3D 1;
+ }
+
+ undef $Vend::Levying;
return $run;
}
1;
2.27 +3 -3 interchange/lib/Vend/Order.pm
rev 2.27, prev_rev 2.26
Index: Order.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /anon_cvs/repository/interchange/lib/Vend/Order.pm,v
retrieving revision 2.26
retrieving revision 2.27
diff -u -r2.26 -r2.27
--- Order.pm 4 Jul 2002 23:11:13 -0000 2.26
+++ Order.pm 7 Jul 2002 04:02:27 -0000 2.27
@@ -1,6 +1,6 @@
# Vend::Order - Interchange order routing routines
#
-# $Id: Order.pm,v 2.26 2002/07/04 23:11:13 mheins Exp $
+# $Id: Order.pm,v 2.27 2002/07/07 04:02:27 mheins Exp $
#
# Copyright (C) 1996-2001 Red Hat, Inc. <interchange@redhat.com>
#
@@ -28,7 +28,7 @@
package Vend::Order;
require Exporter;
=20
-$VERSION =3D substr(q$Revision: 2.26 $, 10);
+$VERSION =3D substr(q$Revision: 2.27 $, 10);
=20
@ISA =3D qw(Exporter);
=20
@@ -1986,7 +1986,7 @@
);
do_lockout($msg);
}
- Vend::Cart::toss_cart($cart);
+ Vend::Cart::toss_cart($cart, $CGI::values{mv_cartname});
}
=20
=20