[interchange-cvs] interchange - heins modified 7 files
interchange-core@interchange.redhat.com
interchange-core@interchange.redhat.com
Thu Jan 31 23:22:00 2002
User: heins
Date: 2002-02-01 04:21:47 GMT
Modified: code/SystemTag banner.coretag
Modified: dist catalog_after.cfg
Modified: dist/foundation catalog.cfg
Modified: dist/test/products tests.asc
Modified: lib/Vend Form.pm Interpolate.pm
Added: code/Filter date2time.filter
Log:
* Make Vend::Form live. Now passes all known tests, and runs
accessories/widgets (apparently) flawlessly in foundation,
barry, simple, and the UI.
* Remove tons of redundant code from Vend::Interpolate.
* Add the first outboard system filter.
* Change catalog.cfg to highlight etc/after.cfg.
* Add a couple more regression tests for widgets.
* More to come, UI::Primitive will soon be widget-free....
Revision Changes Path
1.1 interchange/code/Filter/date2time.filter
rev 1.1, prev_rev 1.0
Index: date2time.filter
===================================================================
CodeDef date2time Filter
CodeDef date2time Routine <<EOR
sub {
my $val = shift;
use Time::Local;
$val =~ s/\0+//g;
if($val =~ m:(\d+)[-/]+(\d+)[-/]+(\d+):) {
my ($yr, $mon, $day) = ($3, $1, $2);
my $time;
$val =~ /:(\d+)$/
and $time = $1;
if(length($yr) < 4) {
$yr =~ s/^0//;
$yr = $yr < 50 ? $yr + 2000 : $yr + 1900;
}
$mon =~ s/^0//;
$day =~ s/^0//;
$val = sprintf("%d%02d%02d", $yr, $mon, $day);
return $val unless $time;
$val .= sprintf('%04d', $time);
}
my $time;
$val =~ /^(\d\d\d\d)(\d\d)(\d\d)(\d\d)?(\d\d)?/;
my ($yr, $mon, $day, $hr, $min) = ($1 || 0, $2 || 1, $3 || 1, $4 || 0, $5 || 0);
$mon--;
eval {
$time = timelocal(0, $min, $hr, $day, $mon, $yr);
};
if($@) {
logError("bad time value passed to date2time: %s", $@);
return 0;
}
return $time;
}
EOR
1.2 +40 -0 interchange/code/SystemTag/banner.coretag
rev 1.2, prev_rev 1.1
Index: banner.coretag
===================================================================
RCS file: /anon_cvs/repository/interchange/code/SystemTag/banner.coretag,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- banner.coretag 29 Jan 2002 05:52:38 -0000 1.1
+++ banner.coretag 1 Feb 2002 04:21:46 -0000 1.2
@@ -5,6 +5,46 @@
sub {
my ($place, $opt) = @_;
+ sub initialize_banner_directory {
+ my ($dir, $category, $opt) = @_;
+ mkdir $dir, 0777 if ! -d $dir;
+ my $t = $opt->{table} || 'banner';
+ my $c_field;
+ my $append = '';
+ if($category) {
+ $append = ' AND ';
+ $append .= ($opt->{c_field} || 'category');
+ $category =~ s/'/''/g;
+ $append .= " = '$category'";
+ }
+ my $db = database_exists_ref($t);
+ if(! $db) {
+ my $weight_file = "$dir/total_weight";
+ return undef if -f $weight_file;
+ $t = "no banners db $t\n";
+ Vend::Util::writefile( $weight_file, $t, $opt);
+ ::logError($t);
+ return undef;
+ }
+ my $w_field = $opt->{w_field} || 'weight';
+ my $b_field = $opt->{b_field} || 'banner';
+ my $q = "select $w_field, $b_field from $t where $w_field >= 1$append";
+ my $banners = $db->query({
+ query => $q,
+ st => 'db',
+ });
+ my $i = 0;
+ for(@$banners) {
+ my ($weight, $text) = @$_;
+ for(1 .. $weight) {
+ Vend::Util::writefile(">$dir/$i", $text, $opt);
+ $i++;
+ }
+ }
+ Vend::Util::writefile(">$dir/total_weight", $i, $opt);
+ }
+
+
sub tag_weighted_banner {
my ($category, $opt) = @_;
my $dir = catfile($Vend::Cfg->{ScratchDir}, 'Banners');
2.1 +0 -1 interchange/dist/catalog_after.cfg
rev 2.1, prev_rev 2.0
Index: catalog_after.cfg
===================================================================
RCS file: /anon_cvs/repository/interchange/dist/catalog_after.cfg,v
retrieving revision 2.0
retrieving revision 2.1
diff -u -r2.0 -r2.1
--- catalog_after.cfg 18 Jul 2001 02:20:40 -0000 2.0
+++ catalog_after.cfg 1 Feb 2002 04:21:46 -0000 2.1
@@ -45,7 +45,6 @@
#regenerate
#rotate_file
#row_edit
-#set_alias
#substitute_file
#uneval
#unlink_file
2.6 +7 -5 interchange/dist/foundation/catalog.cfg
rev 2.6, prev_rev 2.5
Index: catalog.cfg
===================================================================
RCS file: /anon_cvs/repository/interchange/dist/foundation/catalog.cfg,v
retrieving revision 2.5
retrieving revision 2.6
diff -u -r2.5 -r2.6
--- catalog.cfg 27 Nov 2001 17:01:23 -0000 2.5
+++ catalog.cfg 1 Feb 2002 04:21:46 -0000 2.6
@@ -83,8 +83,6 @@
include dbconf/default_db/default_db.cfg
endif
-ProductFiles products
-
#==========================================================================#
# The URLs which are written to refer back to our catalog.
@@ -194,9 +192,6 @@
## Set this if you have a different secure server
#AlwaysSecure order ord/checkout ord/basket login change_password process
-PriceField 0
-CommonAdjust :sale_price, ;:price, ;$, ==:options
-
EncryptKey __PGP_KEY__
# This prevents a user from setting this value, you may want to unset
@@ -412,6 +407,13 @@
return 1;
}
EOR
+
+### WARNING -- if you have an etc/after.cfg file it may override these settings!
+PriceField 0
+CommonAdjust :sale_price, ;:price, ;$, ==:options
+
+ProductFiles products
+### WARNING -- look below
#==========================================================================#
2.2 +18 -14 interchange/dist/test/products/tests.asc
rev 2.2, prev_rev 2.1
Index: tests.asc
===================================================================
RCS file: /anon_cvs/repository/interchange/dist/test/products/tests.asc,v
retrieving revision 2.1
retrieving revision 2.2
diff -u -r2.1 -r2.2
--- tests.asc 23 Jan 2002 17:12:01 -0000 2.1
+++ tests.asc 1 Feb 2002 04:21:46 -0000 2.2
@@ -1986,6 +1986,7 @@
[assign subtotal=100]
[total-cost noformat=1] [salestax noformat=1] [shipping noformat=1] [handling noformat=1]
[assign clear=1]
+[calc] $Carts->{main} = []; return; [/calc]
%%
OK\s+109.50*\s+0*.50*\s+4\s+5
%%
@@ -2017,31 +2018,34 @@
%%
Skeleton test.
%%%
-999999
+000131
%%
-[the test] [perl]
-# Make this come out right
-return 'The expected result as a regex.';
-[/perl]
+[value name=something set=OK hide=1]
+[either][value something][or]ERROR[/either]
+[value name=something set="" hide=1]
+[either][value something][or]OK[/either]
+[value name=something set=" " hide=1]
+[either][value something][or]OK[/either]
%%
-The expected result as a regex.
+OK\s+OK\s+OK
%%
-The NOT expected result.
+ERROR
%%
%%
-Skeleton test.
+Test of [item-accessories attribute]
%%%
-999999
+000132
%%
-[the test] [perl]
-# Make this come out right
-return 'The expected result as a regex.';
+[perl]
+ $Carts->{main} = [ { code => '99-102', quantity => 1, size => 'S' } ];
+ return;
[/perl]
+[item-list][item-accessories size][item-accessories size, value][/item-list]
%%
-The expected result as a regex.
+"S" SELECTED>Small.*S\s*$
%%
-The NOT expected result.
+accessories
%%
%%
2.4 +31 -5 interchange/lib/Vend/Form.pm
rev 2.4, prev_rev 2.3
Index: Form.pm
===================================================================
RCS file: /anon_cvs/repository/interchange/lib/Vend/Form.pm,v
retrieving revision 2.3
retrieving revision 2.4
diff -u -r2.3 -r2.4
--- Form.pm 31 Jan 2002 16:03:41 -0000 2.3
+++ Form.pm 1 Feb 2002 04:21:46 -0000 2.4
@@ -1,6 +1,6 @@
# Vend::Form - Generate Form widgets
#
-# $Id: Form.pm,v 2.3 2002/01/31 16:03:41 mheins Exp $
+# $Id: Form.pm,v 2.4 2002/02/01 04:21:46 mheins Exp $
#
# Copyright (C) 1996-2001 Red Hat, Inc. <interchange@redhat.com>
#
@@ -36,7 +36,7 @@
require Exporter;
@ISA = qw(Exporter);
-$VERSION = substr(q$Revision: 2.3 $, 10);
+$VERSION = substr(q$Revision: 2.4 $, 10);
@EXPORT = qw (
display
@@ -251,6 +251,30 @@
return $body;
}
+sub show_data {
+ my $opt = shift;
+ my $ary = shift;
+ return undef if ! $ary;
+ my @out;
+ for(@$ary) {
+ push @out, join "=", @$_;
+ }
+ my $delim = Vend::Interpolate::get_joiner($opt->{delimiter}, ',');
+ return join $delim, @out;
+}
+
+sub show_options {
+ my $opt = shift;
+ my $ary = shift;
+ return undef if ! $ary;
+ my @out;
+ eval {
+ @out = map {$_->[0]} @$ary;
+ };
+ my $delim = Vend::Interpolate::get_joiner($opt->{delimiter}, ',');
+ return join $delim, @out;
+}
+
sub template_sub {
my $opt = shift;
return attr_list($Template{$opt->{type}} || $Template{default}, $opt);
@@ -743,7 +767,9 @@
my %daction = (
value => \&processed_value,
display => \¤t_label,
- show => sub { return $data },
+ value => sub { my $opt = shift; return $opt->{value} },
+ show => \&show_data,
+ options => \&show_options,
select => \&dropdown,
default => \&template_sub,
radio => \&box,
@@ -802,8 +828,8 @@
return $opt;
}
- return if $opt->{type} =~ /^[a-z]+$/;
- $opt->{type} = lc $opt->{type} || 'text';
+ $opt->{type} = lc($opt->{type}) || 'text';
+ return if $opt->{type} =~ /^[a-z][a-z0-9]*$/;
my $type = $opt->{type};
return if $type =~ /^[a-z]+$/;
2.50 +20 -574 interchange/lib/Vend/Interpolate.pm
rev 2.50, prev_rev 2.49
Index: Interpolate.pm
===================================================================
RCS file: /anon_cvs/repository/interchange/lib/Vend/Interpolate.pm,v
retrieving revision 2.49
retrieving revision 2.50
diff -u -r2.49 -r2.50
--- Interpolate.pm 1 Feb 2002 00:18:07 -0000 2.49
+++ Interpolate.pm 1 Feb 2002 04:21:46 -0000 2.50
@@ -1,6 +1,6 @@
# Vend::Interpolate - Interpret Interchange tags
#
-# $Id: Interpolate.pm,v 2.49 2002/02/01 00:18:07 racke Exp $
+# $Id: Interpolate.pm,v 2.50 2002/02/01 04:21:46 mheins Exp $
#
# Copyright (C) 1996-2001 Red Hat, Inc. <interchange@redhat.com>
#
@@ -27,7 +27,7 @@
require Exporter;
@ISA = qw(Exporter);
-$VERSION = substr(q$Revision: 2.49 $, 10);
+$VERSION = substr(q$Revision: 2.50 $, 10);
@EXPORT = qw (
@@ -224,9 +224,6 @@
return;
}
-sub uninit_calc {
-}
-
# Regular expression pre-compilation
my %T;
my %QR;
@@ -452,12 +449,6 @@
return length($joiner) ? $joiner : $default;
}
-sub comment_out {
- my ($bit) = @_;
- $bit =~ s/([[<_])/$Comment_out{$1}/ge;
- return '<!--' . $bit . '-->';
-}
-
sub substitute_image {
my ($text) = @_;
@@ -549,16 +540,6 @@
return ($parse->{OUT});
}
-##
-##
-##
-sub var_ui_sub {
- my ($key, $type) = @_;
-
- if(! $type) {
- }
-}
-
sub dynamic_var {
my $varname = shift;
@@ -1494,276 +1475,6 @@
return $out;
}
-sub show_current_accessory_label {
- my($val, $choices) = @_;
- my $default = '';
- my @choices;
- @choices = split /\s*,\s*/, $choices;
- for(@choices) {
- my ($setting, $label) = split /=/, $_, 2;
- $default = $label if $label =~ s/\*$//;
- return ($label || $setting) if $val eq $setting;
- }
- return $default;
-}
-
-sub build_accessory_links {
- my($name, $type, $default, $opt, @opts) = @_;
-
- $opt->{joiner} = get_joiner($opt->{joiner}, "<BR>");
-
- my $template = $opt->{template} || <<EOF;
-<A HREF="{URL}"{EXTRA}>{SELECTED <B>}{LABEL}{SELECTED </B>}</A>
-EOF
-
- my $href = $opt->{href} || $Global::Variable->{MV_PAGE};
- $opt->{form} = "mv_action=return" unless $opt->{form};
-
- my @out;
- for(@opts) {
- my $attr = { EXTRA => $opt->{extra}};
-
- s/\*$// and $attr->{SELECTED} = 1;
-
- ($attr->{VALUE},$attr->{LABEL}) = split /=/, $_, 2;
-
- next if ! $attr->{VALUE} and ! $opt->{empty};
- if( ! length($attr->{LABEL}) ) {
- $attr->{LABEL} = $attr->{VALUE} or next;
- }
-
- if ($default) {
- $attr->{SELECTED} = $default eq $attr->{VALUE} ? 1 : '';
- }
-
- my $form = $opt->{form};
-
- $attr->{URL} = tag_area(
- $href,
- '',
- {
- form => "$opt->{form}\n$name=$attr->{VALUE}",
- secure => $opt->{secure},
- },
- );
- push @out, tag_attr_list($template, $attr);
- }
- return join $opt->{joiner}, @out;
-}
-
-sub build_accessory_textarea {
- my($name, $type, $default, $opt) = @_;
-
- my $select;
- my $run = qq|<TEXTAREA NAME="$name"|;
-
- if($opt->{rows}) {
- $run .= qq{ ROWS=$opt->{rows}}
- if $opt->{rows};
- $run .= qq{ COLS=$opt->{cols}}
- if $opt->{cols};
- }
- else {
- while($type =~ m/\b(row|col)(?:umn)s?[=\s'"]*(\d+)/gi) {
- $run .= " \U$1\ES=$2";
- }
- }
-
- if ($type =~ m/\bwrap[=\s'"]*(\w+)/i) {
- $run .= qq{ WRAP="$1"};
- }
- $run .= " $opt->{extra}" if $opt->{extra};
- $run .= '>';
- $run .= $default;
- $run .= '</TEXTAREA>';
-}
-
-
-sub build_accessory_select {
- my($name, $type, $default, $opt, @opts) = @_;
-
- my $price = $opt->{price} || {};
-
- my $select;
- my $run = qq|<SELECT NAME="$name"|;
- $run .= qq{ SIZE="$opt->{rows}"} if $opt->{rows};
- $run .= " $opt->{js}" if $opt->{js};
- $run .= " $opt->{extra}" if $opt->{extra};
- my ($multi, $re_b, $re_e, $regex);
-
- if($type =~ /multiple/i) {
- $run .= " $type ";
- $multi = 1;
- $re_b = '(?:[\0,\s]|^)';
- $re_e = '(?:[\0,\s]|$)';
- }
- elsif ($type =~ /^multi/i ) {
- $run .= ' MULTIPLE';
- $multi = 1;
- $re_b = '(?:\0|^)';
- $re_e = '(?:\0|$)';
- }
- else {
- $re_b = '(?:\0|^)';
- $re_e = '(?:\0|$)';
- }
-
- my $limit;
- if($opt->{cols}) {
- my $cols = $opt->{cols};
- $limit = sub {
- return $_[0] if length($_[0]) <= $cols;
- return substr($_[0], 0, $cols - 2) . '..';
- };
- }
- else {
- $limit = sub { return $_[0] };
- }
-
- $run .= '>';
- my $optgroup_one;
-
- for(@opts) {
- if(/^\s*\~\~(.*)\~\~\s*$/) {
- my $label = $1;
- $label =~ s/"/"/g;
- if($optgroup_one++) {
- $run .= "</optgroup>";
- }
- $run .= qq{<optgroup label="$label">};
- next;
- }
- $run .= '<OPTION';
- $select = '';
- s/\*$// and $select = 1;
- if ($default) {
- $select = '';
- }
- my ($value,$label) = split /=/, $_, 2;
-
- my $extra;
- if($price->{$value}) {
- $extra = currency($price->{$value}, undef, 1);
- $extra = " ($extra)";
- }
-
- my $vvalue = $value;
- $vvalue =~ s/"/"/;
- HTML::Entities::decode($value);
- $run .= qq| VALUE="$vvalue"|;
- if ($default) {
- $regex = qr/$re_b\Q$value\E$re_e/;
- $default =~ $regex and $select = 1;
- }
- $run .= ' SELECTED' if $select;
- $run .= '>';
- if($label) {
- $run .= $limit->($label);
- }
- else {
- $run .= $limit->($value);
- }
- $run .= $extra if $extra;
- }
- $run .= '</SELECT>';
-}
-
-sub build_accessory_box {
- my($name, $type, $default, $opt, @opts) = @_;
-
- my ($inc, $select, $xlt, $template, $header, $footer, $row_hdr, $row_ftr);
-
- $header = $template = $footer = $row_hdr = $row_ftr = '';
-
- my $font;
- my $variant;
- if ($type =~ /check/i) {
- $variant = 'checkbox';
- $default = '' if ! length($default) and $opt->{item};
- }
- else {
- $variant = 'radio';
- }
- if ($type =~ /font(?:size)?[\s_]*(-?\d)/i ) {
- $font = qq{<FONT SIZE="$1">};
- }
-
- if($type =~ /nbsp/i) {
- $xlt = 1;
- $template = qq{<INPUT TYPE="$variant" NAME="$name" VALUE="__VALUE__"__SEL__> __LABEL__ };
- }
- elsif ($type =~ /left[\s_]*(\d?)/i ) {
- $inc = $1 || undef;
- $header = '<TABLE>';
- $footer = '</TABLE>';
- $template = '<TR>' unless $inc;
- $template .= <<EOF;
-<TD>$font<INPUT TYPE="$variant" NAME="$name" VALUE="__VALUE__"__SEL__></TD><TD>__LABEL__</TD>
-EOF
- $template .= '</TR>' unless $inc;
- }
- elsif ($type =~ /right[\s_]*(\d?)/i ) {
- $inc = $1 || undef;
- $header = '<TABLE>';
- $footer = '</TABLE>';
- $template = '<TR>' unless $inc;
- $template .= <<EOF;
-<TD>${font}__LABEL__</TD><TD><INPUT TYPE="$variant" NAME="$name" VALUE="__VALUE__"__SEL__></TD>
-EOF
- $template .= '</TR>' unless $inc;
- }
- else {
- $template = <<EOF;
-<INPUT TYPE="$variant" NAME="$name" VALUE="__VALUE__"__SEL__> __LABEL__
-EOF
- $template =~ s/\s+$/<BR>/ if $type =~ /break/i;
- }
-
- my $run = $header;
-
- my $price = $opt->{price} || {};
-
- my $i = 0;
- for(@opts) {
- $run .= '<TR>' if $inc && ! ($i % $inc);
- $i++;
- $run .= $template;
- $select = '';
- s/\*$// and $select = "CHECKED";
-
-#::logDebug("select=$select, default is '" . (defined $default ? $default : 'undef') . "'");
- $select = '' if defined $default;
-
- my ($value,$label) = split /=/, $_, 2;
- $label = $value unless $label;
-
- my $extra;
- if($price->{$value}) {
- $label .= " (" . currency($price->{$value}, undef, 1) . ")";
- }
-
- $value =~ s/"/"/g;
-
- $value eq '' and defined $default and $default eq '' and $select = "CHECKED";
-
- if(length $value) {
- my $regex = $opt->{contains}
- ? qr/\Q$value\E/
- : qr/\b\Q$value\E\b/;
- $default =~ $regex and $select = "CHECKED";
- }
-
- $label =~ s/ / /g if $xlt;
-
- $run =~ s/__SEL__/ $select/;
- $run =~ s/__VALUE__/$value/;
- $run =~ s/__LABEL__/$label/;
- $run .= '</TR>' if $inc && ! ($i % $inc);
-
- }
- $run .= $footer;
-}
-
# This generates a *session-based* Autoload routine based
# on the contents of a preset Profile (see the Profile directive).
#
@@ -2202,210 +1913,33 @@
$extra =~ s/\s+$//;
@{$opt}{qw/attribute type column table name outboard passed/} =
split /\s*,\s*/, $extra;
- if($code) {
- $opt->{type} ||= 'select';
- if(! $opt->{table}) {
- my $col = $opt->{column} || $opt->{attribute};
- $opt->{passed} ||= product_field($col, $code)
- if $col;
- }
- }
}
($attribute, $type, $field, $db, $name, $outboard, $passed) =
@{$opt}{qw/attribute type column table name outboard passed/};
- return Vend::Form::display($opt, $item)
- if $::Variable->{MV_DANGEROUS_NEW_FORM}
- or $Global::Variable->{MV_DANGEROUS_NEW_FORM};
- $item ||= {};
- my $p = $opt->{prepend} || '';
- my $a = $opt->{append} || '';
- my $delimiter = $opt->{delimiter} || ',';
-
- $type = 'select' unless $type;
- $field = $attribute unless $field;
- $code = $outboard if $outboard;
-#::logDebug("accessory type=$type db=$db field=$field code=$code attr=$attribute name=$name passed=$passed attr_value=$item->{$attribute}");
-
- return "$p$item->{$attribute}$a" if $type eq 'value';
-
- my $data;
- if($passed) {
- $data = $passed;
- }
- else {
- $data = $db ? tag_data($db, $field, $code) : product_field($field,$code);
- }
-
- unless ($data || $type =~ /^text|^hidden|^password|^combo/i) {
- return '' if $item;
- }
-
- return show_current_accessory_label($item->{$attribute},$data)
- if "\L$type" eq 'display' and $item;
-
- return $data if "\L$type" eq 'show';
-
- my $attrib_value = $item ? HTML::Entities::encode($item->{$attribute}) : '';
-
- if($ishash) {
-#::logDebug("tag_accessories: name=$name item=$item=" . ::uneval_it($item) . " opt_item=$opt->{item} attr=$attribute");
- my $adder;
- $adder = $item->{mv_ip} if defined $item->{mv_ip}
- and $opt->{item} || ! $name;
-#::logDebug("tag_accessories: adder=$adder");
- $name = $attribute unless $name;
- $name .= $adder if defined $adder;
-#::logDebug("tag_accessories: name=$name");
- }
- else {
- $name = "mv_order_$attribute" unless $name;
- }
-
- return qq|$p<INPUT TYPE="hidden" NAME="$name" VALUE="$attrib_value">$a|
- if "\L$type" eq 'hidden';
- return qq|$p<INPUT TYPE="hidden" NAME="$name" VALUE="$attrib_value">$attrib_value$a|
- if $type =~ /hidden/;
-
- if($type =~ /^text/i) {
- $opt->{extra} = " $opt->{extra}" if $opt->{extra} ||= $opt->{js};
- my $cols;
- if ($type =~ /^textarea(?:_(\d+)_(\d+))?/i) {
- my $rows = $1 || $opt->{rows} || 4;
- $cols = $2 || $opt->{cols} || 40;
- $type =~ s/^textarea[_\d]+/textarea/;
- $opt->{rows} = $rows;
- $opt->{cols} = $cols;
- return build_accessory_textarea(
- $name,
- $type,
- $attrib_value,
- $opt,
- );
- }
- elsif("\L$type" =~ /^text_(\d+)$/) {
- $cols = $1;
- }
- $cols = ($opt->{cols} || $opt->{width} || 60)
- if ! $cols;
- return qq|$p<INPUT TYPE=text NAME="$name" SIZE="$cols" VALUE="$attrib_value"$opt->{extra}>$a|;
- }
- elsif($type =~ /^password/i) {
-#::logDebug("hit password");
- $opt->{extra} = " $opt->{extra}" if $opt->{extra};
- return qq|$p<INPUT TYPE=password NAME="$name" SIZE=$1 VALUE="$attrib_value"$opt->{extra}>$a|
- if "\L$type" =~ /_(\d+)/;
- my $cols = $opt->{cols} || $opt->{width} || 12;
- return qq|$p<INPUT TYPE=password NAME="$name" SIZE="$cols" VALUE="$attrib_value"$opt->{extra}>$a|;
- }
-
- my ($default, $label, $select, $value, $run);
-
- my @opts = split /\s*$delimiter\s*/, $data;
-
- if($type =~ s/\branges\b//i || $opt->{ranges} ) {
- produce_range(\@opts);
- }
-
-#::logDebug("item in tag_accessories: " . ::uneval_it($item));
- if(exists $item->{$attribute}) {
-#::logDebug("default from attribute=$attribute, value=$item->{$attribute}");
- $default = $item->{$attribute};
- }
- elsif (exists $opt->{default}) {
-#::logDebug("default from opt");
- $default = $opt->{default};
- }
- elsif ($name) {
-#::logDebug("default from values");
- $default = $::Values->{$name};
- }
-
- # returns just list of options, no labels
- if($type eq 'options') {
- return join "\n", (map { s/\s*=.*//; $_ } @opts);
- }
- # returns just list of labels, no options
- elsif ($type eq 'labels') {
- return join "\n", (map { s/.*?=//; $_ } @opts);
- }
-
- $opt->{price} = get_option_hash($opt->{price_data}) if $opt->{price};
-
- # Ranging type, for price breaks based on quantity
- if ($type =~ s/^range:?(.*)//) {
- $select = $1 || 'quantity';
- $default = ($item && defined $item->{$select}) ? $item->{$select} : undef;
- my $min;
- my $max;
- for(@opts) {
- /^ (-?[\d.]+) - (-?[\d.]*) \s*=\s* (.+) /x
- or next;
- $min = $1;
- $max = $2;
- $label = $3;
- if($label =~ s/\*$// and ! $default) {
- $default = $min;
+ ## Code only passed when we are a product
+ if($code) {
+ GETACC: {
+ my $col = $opt->{column} || $opt->{attribute};
+ my $key = $opt->{outboard} || $code;
+ last GETACC if ! $col;
+ if($opt->{table}) {
+ $opt->{passed} ||= tag_data($opt->{table}, $col, $key);
+ }
+ else {
+ $opt->{passed} ||= product_field($col, $key);
}
- next unless $default >= $min;
- next unless $default <= $max;
- last;
}
- ($item->{$attribute} = $label, return '') if $item;
- return qq|<INPUT TYPE="hidden" NAME="$name" VALUE="$label">|;
- }
-
- # Building select, textarea, or radio/check box if got here
- if ($type =~ /^(radio|check)/i) {
- return $p . build_accessory_box($name, $type, $default, $opt, @opts) . $a;
- }
- elsif($type eq 'links') {
- return $p . build_accessory_links($name, $type, $default, $opt, @opts) . $a;
- }
- elsif($type =~ /^combo[ _]*(?:(\d+)(?:[ _]+(\d+))?)?/i) {
- $opt->{rows} = $opt->{rows} || $1 || 1;
- $opt->{cols} = $opt->{cols} || $2 || 16;
- unless($opts[0] =~ /^=/) {
- unshift @opts, ($opt->{new} || "=<-- " . errmsg('New'));
- }
- my $out = qq|<INPUT TYPE=text NAME="$name" SIZE=$opt->{cols} VALUE="">|;
- $out .= build_accessory_select($name, $type, $default, $opt, @opts);
- return "$p$out$a";
- }
- elsif($type =~ /^reverse_combo[ _]*(?:(\d+)(?:[ _]+(\d+))?)?/i) {
- $opt->{rows} = $opt->{rows} || $1 || 1;
- $opt->{cols} = $opt->{cols} || $2 || 16;
- unless($opts[0] =~ /^=/) {
- unshift @opts, ($opt->{new} || "=Current -->");
- }
- my $out = build_accessory_select($name, $type, $default, $opt, @opts);
- $out .= qq|<INPUT TYPE=text NAME="$name" SIZE=$opt->{cols} VALUE="$default">|;
- return "$p$out$a";
- }
- elsif($type =~ /^move_combo[ _]*(?:(\d+)(?:[ _]+(\d+))?)?/i) {
- $opt->{rows} = $opt->{rows} || $1 || 1;
- $opt->{cols} = $opt->{cols} || $2 || 16;
- my $ejs = ",1" if $opt->{rows} > 1;
- $opt->{js} = qq{onChange="addItem(this.form['X$name'],this.form['$name']$ejs)"}
- unless $opt->{js};
- my $out = build_accessory_select("X$name", $type, '', $opt, @opts);
- if($opt->{rows} > 1) {
- $out .= qq|<TEXTAREA ROWS="$opt->{rows}" WRAP=virtual COLS="$opt->{cols}" NAME="$name">$default</TEXTAREA>|;
- }
- else {
- $out .= qq|<INPUT SIZE="$opt->{cols}" NAME="$name" VALUE="$default">|;
- }
- return "$p$out$a";
- }
- else {
-#::logDebug("build_accessory_select is run");
- #return $p . build_accessory_select($name, $type, $default, $opt, @opts) . $a;
- my $s = $p . build_accessory_select($name, $type, $default, $opt, @opts) . $a;
-#::logDebug("build_accessory_select returns $s");
- return $s;
+ return unless $opt->{passed} || $opt->{type};
+ $opt->{type} ||= 'select';
+ return unless
+ $opt->{passed}
+ or
+ $opt->{type} =~ /^(text|password|hidden)/i;
}
+ return Vend::Form::display($opt, $item);
}
# MVASP
@@ -2991,31 +2525,6 @@
}
# Returns the text of a user entered field named VAR.
-sub tag_cgi {
- my($var, $opt) = @_;
- my($value);
-
- local($^W) = 0;
- $CGI::values{$var} = $opt->{set} if defined $opt->{set};
- $value = defined $CGI::values{$var} ? ($CGI::values{$var}) : '';
- if ($value) {
- # Eliminate any Interchange tags
- $value =~ s~<([A-Za-z]*[^>]*\s+[Mm][Vv]\s*=\s*)~<$1~g;
- $value =~ s/\[/[/g;
- }
- if($opt->{filter}) {
- $value = filter_value($opt->{filter}, $value, $var);
- $CGI::values{$var} = $value unless $opt->{keep};
- }
-
- return '' if $opt->{hide};
-
- $value =~ s/</</g
- unless $opt->{enable_html};
- return $value;
-}
-
-# Returns the text of a user entered field named VAR.
sub tag_value_extended {
my($var, $opt) = @_;
@@ -3123,47 +2632,6 @@
return join $joiner, @ary;
}
-sub initialize_banner_directory {
- my ($dir, $category, $opt) = @_;
- mkdir $dir, 0777 if ! -d $dir;
- my $t = $opt->{table} || 'banner';
- my $c_field;
- my $append = '';
- if($category) {
- $append = ' AND ';
- $append .= ($opt->{c_field} || 'category');
- $category =~ s/'/''/g;
- $append .= " = '$category'";
- }
- my $db = database_exists_ref($t);
- if(! $db) {
- my $weight_file = "$dir/total_weight";
- return undef if -f $weight_file;
- $t = "no banners db $t\n";
- Vend::Util::writefile( $weight_file, $t, $opt);
- ::logError($t);
- return undef;
- }
- my $w_field = $opt->{w_field} || 'weight';
- my $b_field = $opt->{b_field} || 'banner';
- my $q = "select $w_field, $b_field from $t where $w_field >= 1$append";
-#::logDebug("banner query: $q");
- my $banners = $db->query({
- query => $q,
- st => 'db',
- });
- my $i = 0;
-#::logDebug("banner query result: " . ::uneval($banners));
- for(@$banners) {
- my ($weight, $text) = @$_;
- for(1 .. $weight) {
- Vend::Util::writefile(">$dir/$i", $text, $opt);
- $i++;
- }
- }
- Vend::Util::writefile(">$dir/total_weight", $i, $opt);
-}
-
sub format_auto_transmission {
my $ref = shift;
@@ -3961,22 +3429,6 @@
return $options || '';
}
-sub tag_search_list {
- my($opt, $text) = @_;
- $opt->{prefix} = 'item';
- my $obj;
-
- $obj = $opt->{object}
- || $::Instance->{SearchObject}{$opt->{label}}
- || perform_search()
- || return;
- $text =~ s:\[if-(field\s+|data\s+):[if-item-$1:gi
- and $text =~ s:\[/if${D}(field|data)\]:[/if-item-$1]:gi;
- $text =~ s:\[on${D}change\b:[item-change:gi
- and $text =~ s:\[/on${D}change\b:[/item-change:gi;
- return labeled_list($opt, $text, $obj);
-}
-
# Artificial for better variable passing
{
my( $next_anchor,
@@ -5910,12 +5362,6 @@
push @Vend::TmpScratch, $var;
$::Scratch->{$var} = $val;
return '';
-}
-
-sub tag_lookup {
- my($selector,$field,$key,$rest) = @_;
- return $rest if (defined $rest and $rest);
- return tag_data($selector,$field,$key);
}
sub timed_build {