[interchange-cvs] interchange - jon modified 2 files
interchange-cvs at icdevgroup.org
interchange-cvs at icdevgroup.org
Mon Jan 24 22:54:19 EST 2005
User: jon
Date: 2005-01-25 03:54:19 GMT
Modified: dist/test/products tests.asc
Modified: lib/Vend Interpolate.pm
Log:
New Perl object $Row available in PREFIX-calc blocks for access to the
current loop row. Avoids quoting problems.
Contributed by Ethan Rowe <ethan at endpoint.com>. His description:
Introduces a new Perl object, defined only in the context of [PREFIX-calc]
loop subtags, providing a hashref to the current row. The application
programmer can use this new object, $Row, to directly retrieve values
from the different fields within the current row, rather than quoting
the interpolated values of [PREFIX-param], [PREFIX-code], etc.
Thus, instead of:
[sql-calc]
my $value = q{[sql-param some_column]} * 5;
return "The value times five is $value";
[/sql-calc]
The application programmer can instead use:
[sql-calc]
my $value = $Row->{some_column} * 5;
return "The value times five is $value";
[/sql-calc]
The $Row hashref will be undefined when accessed in standard [perl]
or [calc] blocks; it is only valid in the context of a loop ([loop],
[query], [item-list]). Note further that, when used in a search-type loop
(e.g. [loop search="..."]), return fields should be specified within the
search in order for the row hash to be populated correctly; otherwise,
only the sku/primary key will have a value in the $Row hash.
Revision Changes Path
2.19 +53 -8 interchange/dist/test/products/tests.asc
rev 2.19, prev_rev 2.18
Index: tests.asc
===================================================================
RCS file: /var/cvs/interchange/dist/test/products/tests.asc,v
retrieving revision 2.18
retrieving revision 2.19
diff -u -u -r2.18 -r2.19
--- tests.asc 25 Jan 2005 01:02:59 -0000 2.18
+++ tests.asc 25 Jan 2005 03:54:19 -0000 2.19
@@ -2697,20 +2697,65 @@
%%
Tests for discount-space support: discount-space tag, discount_space attributes for total-cost, subtotal, fly-tax, salestax, discount, item-list
%%%
-999999
+000157
%%
-[the test] [perl]
-# Make this come out right
-return 'The expected result as a regex.';
-[/perl]
+[loop
+ lr=1
+ delimiter='|'
+ head_skip=1
+ prefix=loopcalc1
+ list="
+key|emotion|maximum
+1|happiness|joy
+2|sadness|despair
+3|humour|hilarity
+"][loopcalc1-calc]
+ "$Row->{key} $Row->{emotion}=$Row->{maximum}"
+[/loopcalc1-calc]
+[/loop][calcn]
+ @{$Carts->{main}} = ();
+ undef;
+[/calcn][loop
+ prefix=loopcalc2
+ search=|
+co=yes
+sf=artist
+se=Van Gogh
+op=rm
+rf=code,title,artist,description
+tf=title
+|][loopcalc2-calc]
+ push @{$Carts->{main}}, { code => $Row->{code}, quantity => 1 };
+ "$Row->{code} $Row->{title} $Row->{artist}"
+[/loopcalc2-calc] [loopcalc2-calc] $Row->{description} [/loopcalc2-calc]
+[/loop][item-list][item-calc]
+ "$Row->{quantity} $Row->{code}"
+[/item-calc] [item-price noformat]
+[/item-list][query
+ list=1
+ sql=|
+SELECT code, artist, title, description, price
+FROM products
+WHERE artist = 'Vincent Van Gogh'
+ORDER BY title
+|][sql-calc] "$Row->{code} $Row->{title}" [/sql-calc] [sql-calc] $Row->{artist} [/sql-calc]
+[/query]
%%
-The expected result as a regex.
+1 happiness=joy
+2 sadness=despair
+3 humour=hilarity
+00-341 Sunflowers Vincent Van Gogh SUNFLOWERS, by Van Gogh
+00-342 The Starry Night Vincent Van Gogh THE STARRY NIGHT, Van Gogh
+1 00-341 40000000
+1 00-342 20000000
+00-341 Sunflowers Vincent Van Gogh
+00-342 The Starry Night Vincent Van Gogh
%%
-The NOT expected result.
+
%%
%%
-Skeleton test.
+Verify operation of the $Row standard Perl object in [item-calc], [loop-calc], [sql-calc] subtags.
%%%
999999
%%
2.230 +27 -7 interchange/lib/Vend/Interpolate.pm
rev 2.230, prev_rev 2.229
Index: Interpolate.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Interpolate.pm,v
retrieving revision 2.229
retrieving revision 2.230
diff -u -u -r2.229 -r2.230
--- Interpolate.pm 25 Jan 2005 01:02:59 -0000 2.229
+++ Interpolate.pm 25 Jan 2005 03:54:19 -0000 2.230
@@ -1,8 +1,8 @@
# Vend::Interpolate - Interpret Interchange tags
#
-# $Id: Interpolate.pm,v 2.229 2005/01/25 01:02:59 jon Exp $
+# $Id: Interpolate.pm,v 2.230 2005/01/25 03:54:19 jon Exp $
#
-# Copyright (C) 2002-2003 Interchange Development Group
+# Copyright (C) 2002-2005 Interchange Development Group
# Copyright (C) 1996-2002 Red Hat, Inc.
#
# This program was originally based on Vend 0.2 and 0.3
@@ -28,7 +28,7 @@
require Exporter;
@ISA = qw(Exporter);
-$VERSION = substr(q$Revision: 2.229 $, 10);
+$VERSION = substr(q$Revision: 2.230 $, 10);
@EXPORT = qw (
@@ -130,6 +130,7 @@
$Config
%Sql
$Items
+ $Row
$Scratch
$Shipping
$Session
@@ -3547,10 +3548,13 @@
my $fa = $obj->{mv_return_fields} || undef;
my $fh = $obj->{mv_field_hash} || undef;
my $fn = $obj->{mv_field_names} || undef;
+ my $row_fields = $fa;
$ary = tag_sort_ary($opt->{sort}, $ary) if $opt->{sort};
if ($fa and $fn) {
my $idx = 0;
$fh = {};
+ $row_fields = [];
+ @$row_fields = @{$fn}[@$fa];
for(@$fa) {
$fh->{$fn->[$_]} = $idx++;
}
@@ -3558,13 +3562,15 @@
elsif (! $fh and $fn) {
my $idx = 0;
$fh = {};
+ $row_fields = $fn;
for(@$fn) {
$fh->{$_} = $idx++;
}
}
$opt->{mv_return_fields} = $fa;
#::logDebug("Missing mv_field_hash and/or mv_field_names in Vend::Interpolate::labeled_list") unless ref $fh eq 'HASH';
- $r = iterate_array_list($i, $end, $count, $text, $ary, $opt_select, $fh, $opt);
+ # Pass the field arrayref ($row_fields) for support in iterate_array_list of new $Row object...
+ $r = iterate_array_list($i, $end, $count, $text, $ary, $opt_select, $fh, $opt, $row_fields);
}
$MVSAFE::Unsafe = $save_unsafe;
return $r;
@@ -3917,11 +3923,15 @@
}
sub iterate_array_list {
- my ($i, $end, $count, $text, $ary, $opt_select, $fh, $opt) = @_;
+ my ($i, $end, $count, $text, $ary, $opt_select, $fh, $opt, $fa) = @_;
#::logDebug("passed opt=" . ::uneval($opt));
my $r = '';
$opt ||= {};
+ # The $Row object needs to be built per-row, so undef it initially.
+ $fa ||= [];
+ undef $Row;
+
my $lim;
if($lim = $Vend::Cfg->{Limit}{list_text_size} and length($text) > $lim) {
my $len = length($text);
@@ -4061,7 +4071,13 @@
: pull_else($4)!ige;
$run =~ s#$B$QR{_tag}($Some$E[-_]tag[-_]\1\])#
tag_dispatch($1,$count, $row, $ary, $2)#ige;
- $run =~ s#$B$QR{_calc}$E$QR{'/_calc'}#tag_calc($1)#ige;
+ $run =~ s#$B$QR{_calc}$E$QR{'/_calc'}#
+ unless ($Row) {
+ $Row = {};
+ @{$Row}{@$fa} = @$row;
+ }
+ tag_calc($1)
+ #ige;
$run =~ s#$B$QR{_exec}$E$QR{'/_exec'}#
init_calc() if ! $Vend::Calc_initialized;
(
@@ -4086,7 +4102,7 @@
$Ary_code{next}->($1) != 0 ? next : '' #ixge;
$run =~ s/<option\s*/<OPTION SELECTED /i
if $opt_select and $opt_select->($code);
-
+ undef $Row;
$r .= $run;
last if $return;
}
@@ -4165,6 +4181,8 @@
resolve_nested_if($1, $2)
}se;
+ # undef the $Row object, as it should only be set as needed by [PREFIX-calc]
+ undef $Row;
for ( ; $i <= $end; $i++, $count++) {
$item = $hash->[$i];
@@ -4264,6 +4282,7 @@
: pull_else($4)!ige;
$run =~ s#$B$QR{_tag}($All$E[-_]tag[-_]\1\])#
tag_dispatch($1,$count, $item, $hash, $2)#ige;
+ $Row = $item;
$run =~ s#$B$QR{_calc}$E$QR{'/_calc'}#tag_calc($1)#ige;
$run =~ s#$B$QR{_exec}$E$QR{'/_exec'}#
init_calc() if ! $Vend::Calc_initialized;
@@ -4289,6 +4308,7 @@
if $opt_select and $opt_select->($code);
$r .= $run;
+ undef $Row;
#::logDebug("item $code mv_cache_price: $item->{mv_cache_price}");
delete $item->{mv_cache_price};
last if $return;
More information about the interchange-cvs
mailing list