[interchange-cvs] interchange - heins modified 7 files

interchange-core@interchange.redhat.com interchange-core@interchange.redhat.com
Sat Feb 2 03:58:00 2002


User:      heins
Date:      2002-02-02 08:57:11 GMT
Modified:  code/UI_Tag read_page.coretag read_ui_page.coretag
Modified:           widget.coretag
Modified:  dist/lib/UI Primitive.pm
Modified:  lib/Vend Form.pm Interpolate.pm
Modified:  scripts  interchange.PL
Log:
	* Continuing work on meta_display and Vend::Form.

	     --- Relocated date and option widgets
		 --- Prepared for breaking out image widgets to code/Widget
		 --- Fixed various bugs in widgets
		 --- Code simplification in Primitive.pm
		 --- Fix widget.coretag to not call UI::Primitive routine
		 --- Redo option_format filtering
	* Intermediate changes in page editor usertag support, preparing
	  to move to module

	* Improve alias_table code in interchange.PL

Revision  Changes    Path
1.2       +7 -4      interchange/code/UI_Tag/read_page.coretag


rev 1.2, prev_rev 1.1
Index: read_page.coretag
===================================================================
RCS file: /anon_cvs/repository/interchange/code/UI_Tag/read_page.coretag,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- read_page.coretag	29 Jan 2002 05:52:40 -0000	1.1
+++ read_page.coretag	2 Feb 2002 08:57:11 -0000	1.2
@@ -122,6 +122,7 @@
 		my $tdir = $Variable->{UI_TEMPLATE_DIR} || 'templates';
 		my $template = $tref->{ui_template_name};
 		undef $tref;
+Debug("tref read from $tdir/$template");
 		($ary) = $Tag->read_ui_template("$tdir/$template");
 		$tref = shift @$ary if $ary;
 Debug("tref $template again from read_ui_template: $tref (no ui_template_elements)");
@@ -166,13 +167,11 @@
 		)
 	{
 		$preamble = $1;
-		$ref->{ui_content} = $2;
+		$ref->{ui_current_content} = $2;
 		$postamble = $3;
 	}
 	else {
-		$ref->{ui_content} = $data;
-		return uneval($ref) if $opt->{textref};
-		return $ref;
+		$ref->{ui_current_content} = $data;
 	}
 
 	my @comps;
@@ -260,8 +259,12 @@
 	$ref->{ui_page_setting} = $tref;
 
 #Log("page reference: " . uneval($ref) );
+Debug("read_page found pref=$ref tref=$tref" );
 	return uneval_it($ref) if $opt->{textref};
+Debug("not textref" );
 	return $ref unless wantarray;
+Debug("wants array");
+Debug("return from read_page, pref=$ref tref=$tref" );
 	return ($ref, $tref);
 
 }



1.2       +2 -2      interchange/code/UI_Tag/read_ui_page.coretag


rev 1.2, prev_rev 1.1
Index: read_ui_page.coretag
===================================================================
RCS file: /anon_cvs/repository/interchange/code/UI_Tag/read_ui_page.coretag,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- read_ui_page.coretag	29 Jan 2002 05:52:40 -0000	1.1
+++ read_ui_page.coretag	2 Feb 2002 08:57:11 -0000	1.2
@@ -131,11 +131,11 @@
 		)
 	{
 		$preamble = $1;
-		$ref->{ui_content} = $2;
+		$ref->{ui_current_content} = $2;
 		$postamble = $3;
 	}
 	else {
-		$ref->{ui_content} = $data;
+		$ref->{ui_current_content} = $data;
 		return uneval($ref) if $opt->{textref};
 		return $ref;
 	}



1.2       +2 -5      interchange/code/UI_Tag/widget.coretag


rev 1.2, prev_rev 1.1
Index: widget.coretag
===================================================================
RCS file: /anon_cvs/repository/interchange/code/UI_Tag/widget.coretag,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- widget.coretag	29 Jan 2002 05:52:40 -0000	1.1
+++ widget.coretag	2 Feb 2002 08:57:11 -0000	1.2
@@ -34,13 +34,10 @@
 				outboard	=> $opt->{key},
 				passed		=> $opt->{data} || $opt->{passed} || $string,
 				type		=> $opt->{type} || 'select',
+				value		=> $value,
 				};
-	my $item = { $ref->{attribute} => $value };
-	if($ref->{type} =~ /date/i) {
-		return UI::Primitive::date_widget($name, $value);
-	}
 
-	my $w = Vend::Interpolate::tag_accessories('', '', $ref, $item);
+	my $w = Vend::Form::display($ref);
 	if($opt->{filter}) {
 		$w .= qq{<INPUT TYPE=hidden NAME="ui_filter:$name" VALUE="};
 		$w .= $opt->{filter};



2.11      +39 -327   interchange/dist/lib/UI/Primitive.pm


rev 2.11, prev_rev 2.10
Index: Primitive.pm
===================================================================
RCS file: /anon_cvs/repository/interchange/dist/lib/UI/Primitive.pm,v
retrieving revision 2.10
retrieving revision 2.11
diff -u -r2.10 -r2.11
--- Primitive.pm	11 Nov 2001 07:15:30 -0000	2.10
+++ Primitive.pm	2 Feb 2002 08:57:11 -0000	2.11
@@ -1,6 +1,6 @@
 # UI::Primitive - Interchange configuration manager primitives
 
-# $Id: Primitive.pm,v 2.10 2001/11/11 07:15:30 mheins Exp $
+# $Id: Primitive.pm,v 2.11 2002/02/02 08:57:11 mheins Exp $
 
 # Copyright (C) 1998-2001 Red Hat, Inc. <interchange@redhat.com>
 
@@ -25,7 +25,7 @@
 
 package UI::Primitive;
 
-$VERSION = substr(q$Revision: 2.10 $, 10);
+$VERSION = substr(q$Revision: 2.11 $, 10);
 
 $DEBUG = 0;
 
@@ -622,207 +622,6 @@
 	return 1;
 }
 
-my @t = localtime();
-
-my (@years) = ( $t[5] + 1899 .. $t[5] + 1910 );
-my (@months);
-my (@days);
-
-for(1 .. 12) {
-	$t[4] = $_ - 1;
-	$t[5] = 1;
-	push @months, [sprintf("%02d", $_), POSIX::strftime("%B", @t)];
-}
-
-for(1 .. 31) {
-	push @days, [sprintf("%02d", $_), $_];
-}
-
-sub round_to_fifteen {
-	my $val = shift;
-#::logDebug("round_to_fifteen val in=$val");
-	$val = substr($val, 0, 4);
-	$val = "0$val" if length($val) == 3;
-	return '0000' if length($val) < 4;
-	if($val !~ /(00|15|30|45)$/) {
-		my $hr = substr($val, 0, 2);
-		$hr =~ s/^0//;
-		my $min = substr($val, 2, 2);
-		$min =~ s/^0//;
-		if($min > 45 and $hr < 23) {
-			$hr++;
-			$min = 0;
-		}
-		elsif($min > 30) {
-			$min = 45;
-		}
-		elsif($min > 15) {
-			$min = 30;
-		}
-		elsif($min > 0) {
-			$min = 15;
-		}
-		elsif ($hr == 23) {
-			$min = 45;
-		}
-		else {
-			$min = 0;
-		}
-		$val = sprintf('%02d%02d', $hr, $min);
-	}
-#::logDebug("round_to_fifteen val out=$val");
-	return $val;
-}
-
-sub date_widget {
-	my($name, $val, $time) = @_;
-	if($val =~ /\D/) {
-		$val = Vend::Interpolate::filter_value('date_change', $val);
-	}
-	my $now;
-	if($time and $time =~ /([-+])(\d+)/) {
-		my $sign = $1;
-		my $adjust = $2;
-		$adjust *= 3600;
-		$now = time;
-		$now += $sign eq '+' ? $adjust : -$adjust;
-	}
-
-	@t = localtime($now || time);
-	if (not $val) {
-		$t[2]++ if $t[2] < 23;
-		$val = POSIX::strftime("%Y%m%d%H00", @t);
-	}
-	my $sel = 0;
-	my $out = qq{<SELECT NAME="$name">};
-	my $o;
-	for(@months) {
-		$o = qq{<OPTION VALUE="$_->[0]">} . errmsg($_->[1]) . '</OPTION>';
-		($out .= $o, next) unless ! $sel and $val;
-		$o =~ s/>/ SELECTED>/ && $sel++
-			if substr($val, 4, 2) eq $_->[0];
-		$out .= $o;
-	}
-	$sel = 0;
-	$out .= qq{</SELECT>};
-	$out .= qq{<INPUT TYPE=hidden NAME="$name" VALUE="/">};
-	$out .= qq{<SELECT NAME="$name">};
-	for(@days) {
-		$o = qq{<OPTION VALUE="$_->[0]">$_->[1]} . '</OPTION>';
-		($out .= $o, next) unless ! $sel and $val;
-		$o =~ s/>/ SELECTED>/ && $sel++
-			if substr($val, 6, 2) eq $_->[0];
-		$out .= $o;
-	}
-	$sel = 0;
-	$out .= qq{</SELECT>};
-	$out .= qq{<INPUT TYPE=hidden NAME="$name" VALUE="/">};
-	$out .= qq{<SELECT NAME="$name">};
-	if($::Variable->{UI_DATE_BEGIN}) {
-		my $cy = $t[5] + 1900;
-		my $by = $::Variable->{UI_DATE_BEGIN};
-		my $ey = $::Variable->{UI_DATE_END} || ($cy + 10);
-		if($by < 100) {
-			$by = $cy - abs($by);
-		}
-		if($ey < 100) {
-			$ey += $cy;
-		}
-		@years = ($by .. $ey);
-	}
-	for(@years) {
-		$o = qq{<OPTION>$_} . '</OPTION>';
-		($out .= $o, next) unless ! $sel and $val;
-		$o =~ s/>/ SELECTED>/ && $sel++
-			if substr($val, 0, 4) eq $_;
-		$out .= $o;
-	}
-	$out .= qq{</SELECT>};
-	return $out unless $time;
-
-	$val =~ s/^\d{8}//;
-	$val =~ s/\D+//g;
-	$val = round_to_fifteen($val);
-	$out .= qq{<INPUT TYPE=hidden NAME="$name" VALUE=":">};
-	$out .= qq{<SELECT NAME="$name">};
-	
-	my $ampm = $time =~ /pm/ ? 1 : 0;
-	my $mod = '';
-	undef $sel;
-	my %special = qw/ 0 midnight 12 noon /;
-	
-	$ampm =1;
-	for my $hr ( 0 .. 23) {
-		for my $min ( 0,15,30,45 ) {
-			my $disp_hour = $hr;
-			if($ampm) {
-				if( $hr < 12) {
-					$mod = 'am';
-				}
-				else {
-					$mod = 'pm';
-					$disp_hour = $hr - 12 unless $hr == 12;
-				}
-				$mod = errmsg($mod);
-				$mod = " $mod";
-			}
-			if($special{$hr} and $min == 0) {
-				$disp_hour = errmsg($special{$hr});
-			}
-			elsif($ampm) {
-				$disp_hour = sprintf("%2d:%02d%s", $disp_hour, $min, $mod);
-			}
-			else {
-				$disp_hour = sprintf("%02d:%02d", $hr, $min);
-			}
-			my $time = sprintf "%02d%02d", $hr, $min;
-			$o = sprintf qq{<OPTION VALUE="%s">%s}, $time, $disp_hour;
-			($out .= $o, next) unless ! $sel and $val;
-#::logDebug("prospect=$time actual=$val");
-			$o =~ s/>/ SELECTED>/ && $sel++
-				if $val eq $time;
-			$out .= $o;
-		}
-	}
-	$out .= "</SELECT>";
-	return $out;
-}
-
-sub option_widget_box {
-	my ($name, $val, $lab, $default, $width) = @_;
-	my $half = int($width / 2);
-	my $sel = $default ? ' SELECTED' : '';
-	$val =~ s/"/&quot;/g;
-	$lab =~ s/"/&quot;/g;
-	$width = 10 if ! $width;
-	return qq{<TR><TD><SMALL><INPUT TYPE=text NAME="$name" VALUE="$val" SIZE=$half></SMALL></TD><TD><SMALL><INPUT TYPE=text NAME="$name" VALUE="$lab" SIZE=$width></SMALL></TD><TD><SMALL><SMALL><SELECT NAME="$name"><OPTION value="0">no<OPTION value="1"$sel>default*</SELECT></SMALL></SMALL></TD></TR>};
-}
-
-sub option_widget {
-	my($name, $val, $opt) = @_;
-	$opt = {} if ! ref $opt;
-	my $width = $opt->{width} || 16;
-	$val = Vend::Interpolate::filter_value('option_format', $val);
-	my @opts = split /\s*,\s*/, $val;
-	my $out = "<TABLE CELLPADDING=0 CELLSPACING=0><TR><TH><SMALL>Value</SMALL></TH><TH ALIGN=LEFT COLSPAN=2><SMALL>Label</SMALL></TH></TR>";
-	my $done;
-	for(@opts) {
-		my ($v,$l) = split /\s*=\s*/, $_, 2;
-		next unless $l || length($v);
-		$done++;
-		my $default;
-		($l =~ s/\*$// or ! $l && $v =~ s/\*$//)
-			and $default = 1;
-		$out .= option_widget_box($name, $v, $l, $default, $width);
-	}
-	while($done++ < 3) {
-		$out .= option_widget_box($name, '', '', '', $width);
-	}
-	$out .= option_widget_box($name, '', '', '', $width);
-	$out .= option_widget_box($name, '', '', '', $width);
-	$out .= "</TABLE>";
-}
-
 sub uploadhelper_widget {
 	# $column, $value, $record->{outboard}, $record->{width}
     my ($name, $val, $path, $size) = @_;
@@ -938,7 +737,7 @@
 	$meta = $meta->ref();
 	if($column eq $meta->config('KEY')) {
 		if($o->{arbitrary} and $value !~ /::.+::/) {
-			$base_entry_value = ($value =~ /^[^:]+::(\w+)$/)
+			$base_entry_value = ($value =~ /^([^:]+)::(\w+)$/)
 								? $1
 								: $value;
 		}
@@ -1002,11 +801,11 @@
 
 		## Here we allow override with the display tag, even with views and
 		## extended
-		my @override = grep defined $o->{$_},
-						qw/
+		my @override = qw/
 							append
 							attribute
 							db
+							extra
 							field
 							filter
 							height
@@ -1015,6 +814,7 @@
 							label
 							lookup
 							lookup_exclude
+							lookup_query
 							name
 							options
 							outboard
@@ -1025,6 +825,8 @@
 							width
 							/;
 		for(@override) {
+			delete $record->{$_} if ! length($record->{$_});
+			next unless defined $o->{$_};
 			$record->{$_} = $o->{$_};
 		}
 
@@ -1044,9 +846,11 @@
 				elsif($passed =~ /^columns(::(\w*))?\s*$/) {
 					my $total = $1;
 					my $tname = $2 || $record->{db} || $table;
-#::logDebug("columns options, total=$total tname=$tname");
-					$tname = $base_entry_value if $total eq '::';
-					my $db = $Vend::Database{$tname};
+::logDebug("columns options, total=$total tname=$tname base_entry_value=$base_entry_value");
+					if ($total eq '::' and $base_entry_value) {
+						$tname = $base_entry_value;
+					}
+					my $db = ::database_exists_ref($tname);
 					$record->{passed} = join (',', "=--none--", $db->columns())
 						if $db;
 				}
@@ -1056,68 +860,8 @@
 				}
 			}
 		}
-		if($record->{pre_filter}) {
-			$value = Vend::Interpolate::filter_value($record->{pre_filter}, $value);
-		}
-		if($record->{lookup}) {
-			my $fld = $record->{field} || $record->{lookup};
-			my $key = $record->{lookup};
-			LOOK: {
-				my $dbname = $record->{db} || $table;
-				my $db = Vend::Data::database_exists_ref($dbname);
-				last LOOK unless $db;
-				my $flds = $key eq $fld ? $key : "$key, $fld";
-				my $query = "select DISTINCT $flds FROM $dbname ORDER BY $fld";
-				my $ary = $db->query(
-						{
-							query => $query,
-							ml => $::Variable->{UI_ACCESS_KEY_LIMIT} || 500,
-							st => 'db',
-						}
-					);
-				last LOOK unless ref($ary);
-				if(! scalar @$ary) {
-					push @$ary, ["=--no current values--"];
-				}
-				undef $record->{type} unless $record->{type} =~ /multi|combo/;
-				my $sub;
-				if($record->{lookup_exclude}) {
-					eval {
-						$sub = sub { $_[0] !~ m{$record->{lookup_exclude}} };
-					};
-					if ($@) {
-						::logError(errmsg(
-										"Bad lookup pattern m{%s}: %s",
-										$record->{exclude},
-										$@,
-									));
-						$sub = \&CORE::length;
-					}
-				}
-				$sub = sub { length(@_) } if ! $sub;
-				$record->{passed} = join ",", grep $sub->($_),
-									map
-										{ $_->[1] =~ s/,/&#44;/g; $_->[0] . "=" . $_->[1]}
-									@$ary;
-				if($record->{options}) {
-					$record->{passed} =
-						join ",", $record->{options}, $record->{passed};
-				}
-				$record->{passed} = "=--no current values--"
-					if ! $record->{passed};
-			}
-		}
-		elsif ($record->{type} eq 'yesno') {
-			$record->{passed}  = '=' . ::errmsg('No');
-			$record->{passed} .= ',1=' . ::errmsg('Yes');
-			$o->{type} = 'select' unless $o->{type} =~ /radio/;
-		}
-		elsif ($record->{type} eq 'noyes') {
-			$record->{passed}  = '1=' . ::errmsg('No');
-			$record->{passed} .= ',=' . ::errmsg('Yes');
-			$o->{type} = 'select' unless $o->{type} =~ /radio/;
-		}
-		elsif ($record->{type} =~ s/^custom\s+//s) {
+
+		if ($record->{type} =~ s/^custom\s+//s) {
 			my $wid = lc $record->{type};
 			$wid =~ tr/-/_/;
 			my $w;
@@ -1138,24 +882,6 @@
 			return $w unless $o->{template};
 			return ($w, $record->{label}, $record->{help}, $record->{help_url});
 		}
-		elsif ($record->{type} eq 'option_format') {
-			my $w = option_widget($record->{name}, $value);
-			$w .= qq{<INPUT TYPE=hidden NAME="ui_filter:$record->{name}" VALUE="option_format">};
-			return $w unless $o->{template};
-			return ($w, $record->{label}, $record->{help}, $record->{help_url});
-		}
-		elsif ($record->{type} eq 'date') {
-			my $w = date_widget($record->{name}, $value);
-			$w .= qq{<INPUT TYPE=hidden NAME="ui_filter:$record->{name}" VALUE="date_change">};
-			return $w unless $o->{template};
-			return ($w, $record->{label}, $record->{help}, $record->{help_url});
-		}
-		elsif ($record->{type} =~ /^date_?time/) {
-			my $w = date_widget($record->{name}, $value, $record->{type});
-			$w .= qq{<INPUT TYPE=hidden NAME="ui_filter:$record->{name}" VALUE="date_change">};
-			return $w unless $o->{template};
-			return ($w, $record->{label}, $record->{help}, $record->{help_url});
-		}
 		elsif ($record->{type} eq 'imagedir') {
 			my $dir = $record->{'outboard'} || $column;
 			my $suf;
@@ -1207,50 +933,36 @@
 			$record->{$_} =~ s/_UI_COLUMN_/$column/g;
 			$record->{$_} =~ s/_UI_KEY_/$key/g;
 		}
-		if($record->{height}) {
-			if($record->{type} =~ /multi/i) {
-				$record->{type} = "MULTIPLE SIZE=$record->{height}";
-			}
-			elsif ($record->{type} =~ /textarea/i) {
-				my $width = $record->{width} || 80;
-				$record->{type} =~ s/textarea/textarea_$record->{height}_$width/;
-			}
-		}
-		elsif ($record->{width}) {
-			if($record->{type} =~ /textarea/) {
-				$record->{type} = "textarea_2_" . $record->{width};
-			}
-			elsif($record->{type} =~ /text/) {
-				$record->{type} = "text_$record->{width}";
-			}
-			elsif($record->{type} =~ /radio|check/) {
-				$record->{type} =~ s/(left|right)[\s_]*\d*/$1 $record->{width}/;
-			}
-		}
 
 		if(! $o->{type} and ! $record->{type}) {
 			$o->{type} = 'text' unless $record->{passed};
 		}
-		$opt = {
-			attribute	=> ($record->{'attribute'}	|| $column),
-			table		=> ($record->{'db'}			|| $meta_db),
-			rows 		=> ($o->{rows} || $record->{height}),
-			cols 		=> ($o->{cols} || $record->{width}),
-			column		=> ($record->{'field'}		|| 'options'),
-			name		=> ($o->{'name'} || $record->{'name'} || $column),
-			outboard	=> ($record->{'outboard'}	|| $metakey),
-			passed		=> ($record->{'passed'}		|| undef),
-			type		=> ($o->{type} || $record->{'type'}		|| undef),
-			prepend		=> ($record->{'prepend'}	|| undef),
-			append		=> ($record->{'append'}		|| undef),
-			extra		=> ($o->{'extra'} || $record->{extra} || undef),
-		};
-		my $w = Vend::Interpolate::tag_accessories(
-				undef, undef, $opt, { $column => $value } );
+# Copied above
+# append attribute db extra field filter height help help_url js label lookup
+# lookup_exclude name options outboard passed pre_filter prepend
+# type width
+
+::logDebug("passed=$record->{passed}") if $record->{debug};
+		my %things = (
+			attribute	=> $column,
+			cols	 	=> $o->{cols}   || $record->{width},
+			field	 	=> $column,
+			passed	 	=> $record->{options},
+			rows 		=> $o->{rows}	|| $record->{height},
+			table		=> $table,
+			value		=> $value,
+		);
+
+		while( my ($k, $v) = each %things) {
+			next if length $record->{$k};
+			$record->{$k} = $v;
+		}
+		
+		my $w = Vend::Form::display($record);
 		my $filter;
-		if($filter = ($o->{filter} || $record->{filter})) {
+		if($opt->{filter}) {
 			$w .= qq{<INPUT TYPE=hidden NAME="ui_filter:$opt->{name}" VALUE="};
-			$w .= $filter;
+			$w .= $opt->{filter};
 			$w .= '">';
 		}
 		return $w unless $o->{template};



2.5       +439 -178  interchange/lib/Vend/Form.pm


rev 2.5, prev_rev 2.4
Index: Form.pm
===================================================================
RCS file: /anon_cvs/repository/interchange/lib/Vend/Form.pm,v
retrieving revision 2.4
retrieving revision 2.5
diff -u -r2.4 -r2.5
--- Form.pm	1 Feb 2002 04:21:46 -0000	2.4
+++ Form.pm	2 Feb 2002 08:57:11 -0000	2.5
@@ -1,6 +1,6 @@
 # Vend::Form - Generate Form widgets
 # 
-# $Id: Form.pm,v 2.4 2002/02/01 04:21:46 mheins Exp $
+# $Id: Form.pm,v 2.5 2002/02/02 08:57:11 mheins Exp $
 #
 # Copyright (C) 1996-2001 Red Hat, Inc. <interchange@redhat.com>
 #
@@ -25,7 +25,6 @@
 package Vend::Form;
 
 require HTML::Entities;
-use Data::Dumper;
 use Vend::Interpolate;
 use Vend::Util;
 use Vend::Tags;
@@ -36,7 +35,7 @@
 require Exporter;
 @ISA = qw(Exporter);
 
-$VERSION = substr(q$Revision: 2.4 $, 10);
+$VERSION = substr(q$Revision: 2.5 $, 10);
 
 @EXPORT = qw (
 	display
@@ -52,11 +51,12 @@
 
 =head1 DESCRIPTION
 
-TBA.
+Provides form element routines for Interchange, emulating the old
+tag_accessories stuff. Allows user-added widgets.
 
-=cut
+=head1 ROUTINES
 
-use Safe;
+=cut
 
 my $Some = '[\000-\377]*?';
 my $Codere = '[-\w#/.]+';
@@ -182,72 +182,14 @@
 
 $Template{default} = $Template{text};
 
-my $Safe;
-
-sub string_to_ref {
-	my ($string) = @_;
-	if(! $Vend::Cfg->{ExtraSecure} and $MVSAFE::Safe) {
-		return eval $string;
-	}
-	elsif ($MVSAFE::Safe) {
-		die errmsg("not allowed to eval in Safe mode.");
-	}
-	my $safe = $Safe ||= new Safe;
-	return $safe->reval($string);
-}
-
-sub get_option_hash {
-	my $string = shift;
-	my $merge = shift;
-	if (ref $string) {
-		return $string unless ref $merge;
-		for(keys %{$merge}) {
-			$string->{$_} = $merge->{$_}
-				unless defined $string->{$_};
-		}
-		return $string;
-	}
-	return {} unless $string =~ /\S/;
-	$string =~ s/^\s+//;
-	$string =~ s/\s+$//;
-	if($string =~ /^{/ and $string =~ /}/) {
-		return string_to_ref($string);
-	}
-
-	my @opts;
-	unless ($string =~ /,/) {
-		@opts = grep $_ ne "=", Text::ParseWords::shellwords($string);
-		for(@opts) {
-			s/^(\w+)=(["'])(.*)\2$/$1$3/;
-		}
-	}
-	else {
-		@opts = split /\s*,\s*/, $string;
-	}
-
-	my %hash;
-	for(@opts) {
-		my ($k, $v) = split /[\s=]+/, $_, 2;
-		$hash{$k} = $v;
-	}
-	if($merge) {
-		return \%hash unless ref $merge;
-		for(keys %$merge) {
-			$hash{$_} = $merge->{$_}
-				unless defined $hash{$_};
-		}
-	}
-	return \%hash;
-}
-
 sub attr_list {
 	my ($body, $hash) = @_;
 	return $body unless ref($hash) eq 'HASH';
-	$body =~ s!\{($Codere)\}!$hash->{lc $1}!g;
-	$body =~ s!\{($Codere)\|($Some)\}!$hash->{lc $1} || $2!eg;
-	$body =~ s!\{($Codere)\s+($Some)\}! $hash->{lc $1} ? $2 : ''!eg;
-	$body =~ s!\{($Codere)\?\}($Some){/\1\?\}! $hash->{lc $1} ? $2 : ''!eg;
-	$body =~ s!\{($Codere)\:\}($Some){/\1\:\}! $hash->{lc $1} ? '' : $2!eg;
+	$body =~ s!\{([A-Z_]+)\}!$hash->{lc $1}!g;
+	$body =~ s!\{([A-Z_]+)\|($Some)\}!$hash->{lc $1} || $2!eg;
+	$body =~ s!\{([A-Z_]+)\s+($Some)\}! $hash->{lc $1} ? $2 : ''!eg;
+	$body =~ s!\{([A-Z_]+)\?\}($Some){/\1\?\}! $hash->{lc $1} ? $2 : ''!eg;
+	$body =~ s!\{([A-Z_]+)\:\}($Some){/\1\:\}! $hash->{lc $1} ? '' : $2!eg;
 	return $body;
 }
 
@@ -363,6 +305,216 @@
 	return join $opt->{joiner}, @out;
 }
 
+my @Years;
+my @Months;
+my @Days;
+
+INITTIME: {
+	my @t = localtime();
+	(@Years) = ( $t[5] + 1899 .. $t[5] + 1910 );
+
+	for(1 .. 12) {
+		$t[4] = $_ - 1;
+		$t[5] = 1;
+		push @Months, [sprintf("%02d", $_), POSIX::strftime("%B", @t)];
+	}
+
+	for(1 .. 31) {
+		push @Days, [sprintf("%02d", $_), $_];
+	}
+}
+
+sub round_to_fifteen {
+	my $val = shift;
+#::logDebug("round_to_fifteen val in=$val");
+	$val = substr($val, 0, 4);
+	$val = "0$val" if length($val) == 3;
+	return '0000' if length($val) < 4;
+	if($val !~ /(00|15|30|45)$/) {
+		my $hr = substr($val, 0, 2);
+		$hr =~ s/^0//;
+		my $min = substr($val, 2, 2);
+		$min =~ s/^0//;
+		if($min > 45 and $hr < 23) {
+			$hr++;
+			$min = 0;
+		}
+		elsif($min > 30) {
+			$min = 45;
+		}
+		elsif($min > 15) {
+			$min = 30;
+		}
+		elsif($min > 0) {
+			$min = 15;
+		}
+		elsif ($hr == 23) {
+			$min = 45;
+		}
+		else {
+			$min = 0;
+		}
+		$val = sprintf('%02d%02d', $hr, $min);
+	}
+#::logDebug("round_to_fifteen val out=$val");
+	return $val;
+}
+
+sub date_widget {
+	my($opt) = @_;
+
+	my $name = $opt->{name};
+	my $val  = $opt->{value};
+
+	if($val =~ /\D/) {
+		$val = Vend::Interpolate::filter_value('date_change', $val);
+	}
+	my $now;
+	if($opt->{time} and $opt->{time_adjust} =~ /([-+]?)(\d+)/) {
+		my $sign = $1 || '+';
+		my $adjust = $2;
+		$adjust *= 3600;
+		$now = time;
+		$now += $sign eq '+' ? $adjust : -$adjust;
+	}
+
+	my @t = localtime($now || time);
+	if (not $val) {
+		$t[2]++ if $t[2] < 23;
+		$val = POSIX::strftime("%Y%m%d%H00", @t);
+	}
+	my $sel = 0;
+	my $out = qq{<SELECT NAME="$name">};
+	my $o;
+	for(@Months) {
+		$o = qq{<OPTION VALUE="$_->[0]">} . errmsg($_->[1]) . '</OPTION>';
+		($out .= $o, next) unless ! $sel and $val;
+		$o =~ s/>/ SELECTED>/ && $sel++
+			if substr($val, 4, 2) eq $_->[0];
+		$out .= $o;
+	}
+	$sel = 0;
+	$out .= qq{</SELECT>};
+	$out .= qq{<INPUT TYPE=hidden NAME="$name" VALUE="/">};
+	$out .= qq{<SELECT NAME="$name">};
+	for(@Days) {
+		$o = qq{<OPTION VALUE="$_->[0]">$_->[1]} . '</OPTION>';
+		($out .= $o, next) unless ! $sel and $val;
+		$o =~ s/>/ SELECTED>/ && $sel++
+			if substr($val, 6, 2) eq $_->[0];
+		$out .= $o;
+	}
+	$sel = 0;
+	$out .= qq{</SELECT>};
+	$out .= qq{<INPUT TYPE=hidden NAME="$name" VALUE="/">};
+	$out .= qq{<SELECT NAME="$name">};
+	if(my $by = $opt->{year_begin} || $::Variable->{UI_DATE_BEGIN}) {
+		my $cy = $t[5] + 1900;
+		my $ey = $opt->{year_end}  || $::Variable->{UI_DATE_END} || ($cy + 10);
+		if($by < 100) {
+			$by = $cy - abs($by);
+		}
+		if($ey < 100) {
+			$ey += $cy;
+		}
+		@Years = ($by .. $ey);
+	}
+	for(@Years) {
+		$o = qq{<OPTION>$_} . '</OPTION>';
+		($out .= $o, next) unless ! $sel and $val;
+		$o =~ s/>/ SELECTED>/ && $sel++
+			if substr($val, 0, 4) eq $_;
+		$out .= $o;
+	}
+	$out .= qq{</SELECT>};
+	return $out unless $opt->{time};
+
+	$val =~ s/^\d{8}//;
+	$val =~ s/\D+//g;
+	$val = round_to_fifteen($val);
+	$out .= qq{<INPUT TYPE=hidden NAME="$name" VALUE=":">};
+	$out .= qq{<SELECT NAME="$name">};
+	
+	my $ampm = defined $opt->{ampm} ? $opt->{ampm} : 1;
+	my $mod = '';
+	undef $sel;
+	my %special = qw/ 0 midnight 12 noon /;
+	
+	for my $hr ( 0 .. 23) {
+		for my $min ( 0,15,30,45 ) {
+			my $disp_hour = $hr;
+			if($opt->{ampm}) {
+				if( $hr < 12) {
+					$mod = 'am';
+				}
+				else {
+					$mod = 'pm';
+					$disp_hour = $hr - 12 unless $hr == 12;
+				}
+				$mod = errmsg($mod);
+				$mod = " $mod";
+			}
+			if($special{$hr} and $min == 0) {
+				$disp_hour = errmsg($special{$hr});
+			}
+			elsif($ampm) {
+				$disp_hour = sprintf("%2d:%02d%s", $disp_hour, $min, $mod);
+			}
+			else {
+				$disp_hour = sprintf("%02d:%02d", $hr, $min);
+			}
+			my $time = sprintf "%02d%02d", $hr, $min;
+			$o = sprintf qq{<OPTION VALUE="%s">%s}, $time, $disp_hour;
+			($out .= $o, next) unless ! $sel and $val;
+#::logDebug("prospect=$time actual=$val");
+			$o =~ s/>/ SELECTED>/ && $sel++
+				if $val eq $time;
+			$out .= $o;
+		}
+	}
+	$out .= "</SELECT>";
+	return $out;
+}
+
+sub option_widget_box {
+	my ($name, $val, $lab, $default, $width) = @_;
+	my $half = int($width / 2);
+	my $sel = $default ? ' SELECTED' : '';
+	$val =~ s/"/&quot;/g;
+	$lab =~ s/"/&quot;/g;
+	$width = 10 if ! $width;
+	return qq{<TR><TD><SMALL><INPUT TYPE=text NAME="$name" VALUE="$val" SIZE=$half></SMALL></TD><TD><SMALL><INPUT TYPE=text NAME="$name" VALUE="$lab" SIZE=$width></SMALL></TD><TD><SMALL><SMALL><SELECT NAME="$name"><OPTION value="0">no<OPTION value="1"$sel>default*</SELECT></SMALL></SMALL></TD></TR>};
+}
+
+sub option_widget {
+	my($opt) = @_;
+	my($name, $val) = ($opt->{name}, $opt->{value});
+	
+	my $width = $opt->{width} || 16;
+	$opt->{filter} = 'option_format'
+		unless length($opt->{filter});
+	$val = Vend::Interpolate::filter_value('option_format', $val);
+	my @opts = split /\s*,\s*/, $val;
+	my $out = "<TABLE CELLPADDING=0 CELLSPACING=0><TR><TH><SMALL>Value</SMALL></TH><TH ALIGN=LEFT COLSPAN=2><SMALL>Label</SMALL></TH></TR>";
+	my $done;
+	for(@opts) {
+		my ($v,$l) = split /\s*=\s*/, $_, 2;
+		next unless $l || length($v);
+		$done++;
+		my $default;
+		($l =~ s/\*$// or ! $l && $v =~ s/\*$//)
+			and $default = 1;
+		$out .= option_widget_box($name, $v, $l, $default, $width);
+	}
+	while($done++ < 3) {
+		$out .= option_widget_box($name, '', '', '', $width);
+	}
+	$out .= option_widget_box($name, '', '', '', $width);
+	$out .= option_widget_box($name, '', '', '', $width);
+	$out .= "</TABLE>";
+}
+
+
 sub movecombo {
 	my ($opt, $opts) = @_;
 	my $name = $opt->{name};
@@ -370,13 +522,24 @@
 	my $ejs = ",1" if $opt->{rows} > 1;
 	$opt->{extra} .= qq{ onChange="addItem(this.form['X$name'],this.form['$name']$ejs)"}
             unless $opt->{extra};
+	my $tbox = '';
 	my $out = dropdown($opt, $opts);
-	if($opt->{rows} > 1) {
-		$out .= qq(<TEXTAREA ROWS="$opt->{rows}");
-		$out .= qq( WRAP="virtual" COLS="$opt->{cols}");
-		$out .= qq( NAME="$name">$opt->{value}</TEXTAREA>);
+
+	my $template = $opt->{o_template} || '';
+	if(! $template) {
+		if($opt->{rows} > 1) {
+			$template .= q(<textarea rows="{ROWS|4}" wrap="{WRAP|virtual}");
+			$template .= q( cols="{COLS|20} name="{NAME}">{ENCODED}</textarea>);
+		}
+		else {
+			$template .= qq(<input TYPE="text" size="{COLS||40}");
+			$template .= qq( name="{NAME}" value="{ENCODED}">);
+		}
 	}
-	return $out;
+	$opt->{name} = $name;
+	$tbox = attr_list($template, $opt);
+
+	return $opt->{reverse} ? $tbox . $out : $out . $tbox;
 }
 
 sub combo {
@@ -396,6 +559,8 @@
 	my($opt, $opts) = @_;
 #::logDebug("called select opt=" . ::uneval($opt) . "\nopts=" . ::uneval($opts));
 
+	$opts ||= [];
+
 	my $price = $opt->{price} || {};
 
 	my $select;
@@ -486,6 +651,60 @@
 	$run .= attr_list($Template{selecttail}, $opt);
 }
 
+=head2 yesno
+
+Provides an easy "Yes/No" widget. C<No> returns a value of blank/false,
+and C<Yes> returns 1/true.
+
+Calling:
+
+  {
+    name => 'varname' || undef,       ## Derived from item if called by
+                                       # [PREFIX-options] or [PREFIX-accessories]
+    type => 'yesno' || 'yesno radio', ## Second is shorthand for variant=>radio
+    variant => 'radio' || 'select',   ## Default is select
+  }
+
+The data array passed by C<passed> is never used, it is overwritten
+with the equivalent of '=No,1=Yes'. C<No> and C<Yes> are generated from
+the locale, so if you want a translated version set those keys in the locale.
+
+If you want another behavior the same widget can be constructed with:
+
+	[display passed="=My no,0=My yes" type=select ...]
+
+=cut
+
+
+sub yesno {
+	my $opt = shift;
+	$opt->{value} = is_yes($opt->{value});
+	my @opts = (
+					['', errmsg('No')],
+					['1', errmsg('Yes')],
+				);
+	my $routine = $opt->{subwidget} || \&dropdown;
+	return $routine->($opt, \@opts);
+}
+
+=head2 noyes
+
+Same as C<yesno> except sense is reversed. C<No> returns a value of 1/true,
+and C<Yes> returns blank/false.
+
+=cut
+
+sub noyes {
+	my $opt = shift;
+	$opt->{value} = is_no($opt->{value});
+	my @opts = (
+					['1', errmsg('No')],
+					['', errmsg('Yes')],
+				);
+	my $routine = $opt->{subwidget} || \&dropdown;
+	return $routine->($opt, \@opts);
+}
+
 sub box {
 	my($opt, $opts) = @_;
 #::logDebug("Called box type=$opt->{type}");
@@ -580,33 +799,6 @@
 	$run .= $footer;
 }
 
-sub produce_range {
-	my ($ary, $max) = @_;
-	$max = $Vend::Cfg->{Limit}{option_list} if ! $max;
-	my @do;
-	for (my $i = 0; $i < scalar(@$ary); $i++) {
-		$ary->[$i] =~ /^\s* ([a-zA-Z0-9]+) \s* \.\.+ \s* ([a-zA-Z0-9]+) \s* $/x
-			or next;
-		my @new = $1 .. $2;
-		if(@new > $max) {
-			::logError(
-				"Refuse to add %d options to option list via range, max %d.",
-				scalar(@new),
-				$max,
-				);
-			next;
-		}
-		push @do, $i, \@new;
-	}
-	my $idx;
-	my $new;
-	while($new = pop(@do)) {
-		my $idx = pop(@do);
-		splice @$ary, $idx, 1, @$new;
-	}
-	return;
-}
-
 sub scalar_to_array {
 	my ($passed, $opt) = @_;
 	return $passed if ref($passed) eq 'ARRAY'
@@ -619,6 +811,10 @@
 	$opt ||= {};
 	my @out;
 
+	if($passed =~ m{^[^=]*\0}) {
+		$passed = filter_value($passed, 'option_format');
+	}
+
 	my $delim = $opt->{delimiter} || ',';
 	$delim = '\s*' . $delim . '\s*';
 
@@ -668,6 +864,11 @@
 sub display {
 	my($opt, $item) = @_;
 
+if($opt->{debug}) {
+	::logDebug("display called, options=" . uneval($opt));
+	::logDebug("item=" . uneval($item)) if $item;
+}
+
 	if(! ref $opt) {
 		### Has effect of simple default widget for name
 		### or some text output
@@ -687,6 +888,13 @@
 		return join "", @out;
 	}
 
+	if($opt->{pre_filter} and defined $opt->{value}) {
+		$opt->{value} = Vend::Interpolate::filter_value(
+							$opt->{pre_filter},
+							$opt->{value},
+						);
+	}
+
 	if($opt->{override}) {
 		$opt->{value} = $opt->{default} || $opt->{override};
 	}
@@ -711,14 +919,24 @@
 	## Note the fact that attribute can take its value from name
 	## and vice-versa
 	$opt->{attribute} ||= $opt->{name};
-	$opt->{field}     ||= $opt->{attribute};
 	$opt->{prepend}   = ''  unless defined $opt->{prepend};
 	$opt->{append}    = ''  unless defined $opt->{append};
 	$opt->{delimiter} = ',' unless length($opt->{delimiter});
 	$opt->{cols}      ||= $opt->{width} || $opt->{size};
+	$opt->{rows}      ||= $opt->{height};
+
+	# This handles the embedded attribute information in certain types,
+	# for example: 
+	# 
+	#	text_60       is the same as type => 'text', width => '60'
+	#   datetime_ampm is the same as type => 'datetime', ampm => 1
+
+	# Warning -- this sets $opt->{type} and has possible side-effects
+	#            in $opt
+	my $type = parse_type($opt);
 
 	my $data;
-	
+	my $look;
 
 	if($opt->{passed}) {
 		$data = scalar_to_array($opt->{passed}, $opt);
@@ -731,55 +949,77 @@
 	elsif(! $Global::VendRoot) {
 		# Not in Interchange
 	}
-	elsif($opt->{lookup_query}) {
+	elsif($look = $opt->{lookup_query}) {
 		my $tab = $opt->{table} || $Vend::Cfg->{ProductFiles}[0];
 		my $db = Vend::Data::database_exists_ref($tab);
-		$data = $db->query($opt->{lookup_query})
+		$data = $db->query($look)
 			if $db;
+		$data ||= [];
 	}
-	elsif(my $look = $opt->{lookup}) {
-		## Replace with Vend::Specific stuff
-		my $tab = $opt->{table} || $Vend::Cfg->{ProductFiles}[0];
-		my @f = split /\s*,\s*/, $look;
-		my $order = $opt->{sort} || $f[1] || $f[0];
+	elsif($look = $opt->{lookup}) {
+::logDebug("lookup called, opt=" . uneval($opt));
 		LOOK: {
-			last LOOK unless $tab;
+			my $tab = $opt->{db} || $opt->{table} || $Vend::Cfg->{ProductFiles}[0];
 			my $db = Vend::Data::database_exists_ref($tab)
 				or last LOOK;
-			my $q = qq{SELECT DISTINCT $look FROM $tab ORDER BY $order};
+			my $fld = $opt->{field} || $look;
+			my $key = $look;
+
+			if($key ne $fld and $fld !~ /,/) {
+				$fld = "$key,$fld";
+			}
+
+			my @f = split /\s*,\s*/, $fld;
+			my $order = $opt->{sort} || $f[1] || $f[0];
+			last LOOK unless $tab;
+			my $q = qq{SELECT DISTINCT $fld FROM $tab ORDER BY $order};
 			eval {
-				$data = $db->query($q);
+				$data = $db->query($q) || die;
+				if(@f > 2) {
+					for(@$data) {
+						my $join = $opt->{label_joiner} || '-';
+						my $string = join $join, splice @$_, 1;
+						$_->[1] = $string;
+					}
+				}
 			};
 		}
 	}
 
-	# This handles the embedded attribute information in certain types,
-	# for example: 
-	# 
-	#	text_60       is the same as type => 'text', width => '60'
-	#   datetime_ampm is the same as type => 'datetime', ampm => 1
-
-#::logDebug("type=$opt->{type}");
-	parse_type($opt);
-#::logDebug("type=$opt->{type} after parse_type(opt)");
-
-	# Action taken for various types
-	my %daction = (
-		value       => \&processed_value,
-		display     => \&current_label,
-		value       => sub { my $opt = shift; return $opt->{value} },
-		show        => \&show_data,
-		options     => \&show_options,
-		select      => \&dropdown,
-		default     => \&template_sub,
-		radio       => \&box,
-		checkbox    => \&box,
-		links		=> \&links,
-		movecombo	=> \&movecombo,
-		combo		=> \&combo,
-	);
+	## This means a lookup was attempted above
+	if($look and $data) {
+		my $ary;
+		if($opt->{options}) {
+			$ary = scalar_to_array($opt->{options}, $opt) || [];
+		}
+		elsif(! scalar(@$data)) {
+			$ary = [['', errmsg('--no current values--')]];
+		}
+		if($opt->{lookup_exclude}) {
+			my $sub;
+			eval {
+				$sub = sub { $_[0] !~ m{$opt->{lookup_exclude}} };
+			};
+			if ($@) {
+				logError(
+					"Bad lookup pattern m{%s}: %s", $opt->{lookup_exclude}, $@,
+				);
+				undef $sub;
+			}
+			if($sub) {
+				@$data = grep $_,
+							map {
+								$sub->(join '=', @$_)
+									or return undef;
+								return $_;
+							} @$data;
+			}
+		}
+		unshift @$data, @$ary if $ary;
+	}
 
-## Some legacy stuff
+## Some legacy stuff, has to do with default behavior when called from
+## item-accessories or item-options
 	if($ishash) {
 		my $adder;
 		$adder = $item->{mv_ip} if	defined $item->{mv_ip}
@@ -817,7 +1057,52 @@
 	$opt->{value} = $opt->{default} if ! defined $opt->{value};
     $opt->{encoded} = HTML::Entities::encode($opt->{value});
 
-	my $sub = $daction{$opt->{type}} || $daction{default};
+	# Action taken for various types
+	my %daction = (
+		checkbox    => \&box,
+		combo		=> \&combo,
+		date		=> \&date_widget,
+		default     => \&template_sub,
+		display     => \&current_label,
+		links		=> \&links,
+		movecombo	=> \&movecombo,
+		noyes		=> \&noyes,
+		option_format => \&option_widget,
+		options     => \&show_options,
+		radio       => \&box,
+		select      => \&dropdown,
+		show        => \&show_data,
+		value       => \&processed_value,
+		value       => sub { my $opt = shift; return $opt->{value} },
+		yesno		=> \&yesno,
+	);
+
+	## The user/admin widget space
+	# Optimization for large lists
+	unless($Vend::UserWidget) {
+		my $ref;
+		$Vend::UserWidget	= ($ref = $Vend::Cfg->{CodeDef}{Widget})
+							? $ref->{Routine}
+							: {};
+		if(my $ref = $Global::CodeDef->{Widget}{Routine}) {
+			while ( my ($k, $v) = each %$ref) {
+				next if $Vend::UserWidget->{$k};
+				$Vend::UserWidget->{$k} = $v;
+			}
+		}
+	}
+
+	my $sub =  $Vend::UserWidget->{$type}
+			|| $daction{$type}
+			|| $daction{default};
+
+	if($opt->{variant}) {
+::logDebug("variant='$opt->{variant}'");
+		$opt->{subwidget}	=  $Vend::UserWidget->{$opt->{variant}}
+							|| $daction{$opt->{variant}}
+							|| $daction{default};
+	}
+
 	return $sub->($opt, $data);
 }
 
@@ -828,11 +1113,8 @@
 		return $opt;
 	}
 
-	$opt->{type} = lc($opt->{type}) || 'text';
-	return if $opt->{type} =~ /^[a-z][a-z0-9]*$/;
-
-	my $type = $opt->{type};
-	return if $type =~ /^[a-z]+$/;
+	my $type = $opt->{type} = lc($opt->{type}) || 'text';
+	return $type if $type =~ /^[a-z][a-z0-9]*$/;
 
 	if($type =~ /^text/i) {
 		my $cols;
@@ -889,7 +1171,7 @@
 		}
 
 		if($type =~ /nbsp/i) {
-			$opt->{nbsp};
+			$opt->{nbsp} = 1;
 		}
 		elsif ($type  =~ /left[\s_]*(\d?)/i ) {
 			$opt->{breakmod} = $1;
@@ -922,41 +1204,20 @@
 		$type =~ /.*?multiple\s+(.*)/
 			and $opt->{extra} ||= $1;
 	}
-}
-
-sub test {
-	my $out = qq{<form action="/">\n};
-	for(qw/
-		text_60
-		select
-		links
-		multi
-		combo
-	/)
-	{
-		$out .= display({
-			name   => 'SelectName',
-			value  => 'Test',
-			type   => $_,
-			left   => 1,
-			breakmod   => 2,
-			passed => '
-				=--select it--,
-				~~Valid~~,
-				Test=Testing,
-				Testing1=Testing again,
-				Testing2=Testing again and again,
-				Testing3=Testing again redux,
-				Testing4=Testing redux redux,
-				~~Invalid~~,
-				Not=Not,
-				Not1=Not again,
-				Not2=Not again and again,
-				',
-		} );
+	elsif($type =~ /^yesno/i) {
+		$type =~ s/^yesno[_\s]+//;
+		$opt->{type}    = 'yesno';
+		$type =~ s/\W+//g;
+		$opt->{variant} = $type =~ /radio/ ? 'radio' : $type;
+	}
+	elsif($type =~ /^noyes/i) {
+		$type =~ s/^noyes[_\s]+//;
+		$opt->{type}    = 'noyes';
+		$type =~ s/\W+//g;
+		$opt->{variant} = $type =~ /radio/ ? 'radio' : $type;
 	}
-	$out .= "</form>\n";
-	return $out;
+
+	return $opt->{type};
 }
 
 1;



2.53      +30 -25    interchange/lib/Vend/Interpolate.pm


rev 2.53, prev_rev 2.52
Index: Interpolate.pm
===================================================================
RCS file: /anon_cvs/repository/interchange/lib/Vend/Interpolate.pm,v
retrieving revision 2.52
retrieving revision 2.53
diff -u -r2.52 -r2.53
--- Interpolate.pm	1 Feb 2002 21:08:26 -0000	2.52
+++ Interpolate.pm	2 Feb 2002 08:57:11 -0000	2.53
@@ -1,6 +1,6 @@
 # Vend::Interpolate - Interpret Interchange tags
 # 
-# $Id: Interpolate.pm,v 2.52 2002/02/01 21:08:26 racke Exp $
+# $Id: Interpolate.pm,v 2.53 2002/02/02 08:57:11 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.52 $, 10);
+$VERSION = substr(q$Revision: 2.53 $, 10);
 
 @EXPORT = qw (
 
@@ -930,29 +930,34 @@
 					return '';
 				},
 	'option_format' =>		sub {
-					my $value = shift;
-					my $pv = $value;
-					$pv =~ s/\0/_NULL_/g;
-					$pv =~ s/\r/_CR_/g;
-#::logDebug("option_format received: $pv");
-					$value =~ s/\00[\s,]*$//;
-					$value =~ s/\0([^\0]*)\0([10])(\0|$)/'=' . $1 . ($2 ? '*' : '') . ",\r"/ge;
-					$pv = $value;
-					$pv =~ s/\0/_NULL_/g;
-					$pv =~ s/\r/_CR_/g;
-#::logDebug("option_format now: $pv");
-					1 while $value =~ s/\r=,\r/\r/;
-					$value =~ s/\0//g;
-					$value =~ s/[ \t]*[\r\n]+[ \t]*/\r/g;
-					$value =~ s/([^,])[\r\n]/$1,/g;
-					$value =~ s/\r//g;
-					$value =~ s/,/,\r/g;
-					$value =~ s/[=\s,]+$//;
-					$pv = $value;
-					$pv =~ s/\0/_NULL_/g;
-					$pv =~ s/\r/_CR_/g;
-#::logDebug("option_format finally: $pv");
-					return $value;
+					my ($value, $tag, $delim) = @_;
+
+					return $value unless $value =~ /\0.*\0/s;
+
+					if(! length($delim) ) {
+						$delim = ',';
+					}
+					else {
+						$delim =~ /pipe/i and $delim = '|' 
+						 or
+						$delim =~ ';'  and $delim =~ /semicolon/i
+						 or
+						$delim =~ ':'  and $delim =~ /colon/i
+						 or
+						$delim =~ ':'  and $delim =~ /null/i;
+					}
+
+					my @opts = split /\0/, $value;
+					my @out;
+
+					while(@opts) {
+						my ($v, $l, $d) = splice @opts, 0, 3;
+						$l = length($l) ? "=$l" : '';
+						$d = $d ? '*' : '';
+						next unless length("$v$l");
+						push @out, "$v$l$d";
+					}
+					return join $delim, @out;
 				},
 	'nullselect' =>		sub {
 					my @some = split /\0+/, shift;



2.19      +16 -4     interchange/scripts/interchange.PL


rev 2.19, prev_rev 2.18
Index: interchange.PL
===================================================================
RCS file: /anon_cvs/repository/interchange/scripts/interchange.PL,v
retrieving revision 2.18
retrieving revision 2.19
diff -u -r2.18 -r2.19
--- interchange.PL	28 Dec 2001 17:16:26 -0000	2.18
+++ interchange.PL	2 Feb 2002 08:57:11 -0000	2.19
@@ -50,7 +50,7 @@
 #
 # Interchange version 4.9.0
 #
-# $Id: interchange.PL,v 2.18 2001/12/28 17:16:26 mheins Exp $
+# $Id: interchange.PL,v 2.19 2002/02/02 08:57:11 mheins Exp $
 #
 # Copyright (C) 1996-2001 Red Hat, Inc. <interchange@redhat.com>
 #
@@ -2229,11 +2229,24 @@
 	$Vend::FinalPath =~ s:^/+::;
 	$Vend::FinalPath =~ s/(\.html?)$//;
 
+	my $record;
+	my $adb;
+
+	if(ref $Vend::Session->{alias_table}) {
+		$record = $Vend::Session->{alias_table}{$Vend::FinalPath};
+		$Vend::Cfg->{AliasTable} ||= 'alias';
+	}
+
 	if(
 		$Vend::Cfg->{AliasTable}
 			and
-		my $record = database_exists_ref($Vend::Cfg->{AliasTable})
-						->row_hash($Vend::FinalPath)
+		$record 
+			or 
+		(
+			$adb = database_exists_ref($Vend::Cfg->{AliasTable})
+			  and 
+			$record = $adb->row_hash($Vend::FinalPath)
+		)
 	 )
 	{
 		$Vend::FinalPath = $record->{real_page};
@@ -2260,7 +2273,6 @@
 		}
 
 	}
-
 
 	$Vend::Session->{extension} = $1 || '';
 #::logDebug("path=$Vend::FinalPath");