1# Vend::Form - Generate Form widgets
2#
3# $Id: Form.pm,v 2.76 2008-05-10 14:39:53 mheins Exp $
4#
5# Copyright (C) 2002-2008 Interchange Development Group
6# Copyright (C) 1996-2002 Red Hat, Inc.
7#
8# This program was originally based on Vend 0.2 and 0.3
9# Copyright 1995 by Andrew M. Wilcox <amw@wilcoxsolutions.com>
10#
11# This program is free software; you can redistribute it and/or modify
12# it under the terms of the GNU General Public License as published by
13# the Free Software Foundation; either version 2 of the License, or
14# (at your option) any later version.
15#
16# This program is distributed in the hope that it will be useful,
17# but WITHOUT ANY WARRANTY; without even the implied warranty of
18# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
19# GNU General Public License for more details.
20#
21# You should have received a copy of the GNU General Public
22# License along with this program; if not, write to the Free
23# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
24# MA  02110-1301  USA.
25
26package Vend::Form;
27
28require HTML::Entities;
29*encode = \&HTML::Entities::encode_entities;
30use Vend::Interpolate;
31use Vend::Util;
32use Vend::Tags;
33use strict;
34no warnings qw(uninitialized numeric);
35use POSIX qw{strftime};
36
37use vars qw/@ISA @EXPORT @EXPORT_OK $VERSION %Template %ExtraMeta/;
38
39require Exporter;
40@ISA = qw(Exporter);
41
42$VERSION = substr(q$Revision: 2.76 $, 10);
43
44@EXPORT = qw (
45	display
46);
47
48=head1 NAME
49
50Vend::Form -- Interchange form element routines
51
52=head1 SYNOPSIS
53
54(no external use)
55
56=head1 DESCRIPTION
57
58Provides form element routines for Interchange, emulating the old
59tag_accessories stuff. Allows user-added widgets.
60
61=head1 ROUTINES
62
63=cut
64
65my $Some = '[\000-\377]*?';
66my $Codere = '[-\w#/.]+';
67my $Tag = new Vend::Tags;
68
69%Template = (
70	value =>
71		qq({PREPEND}{VALUE}{APPEND})
72		,
73	selecthead =>
74		qq({PREPEND}<select name="{NAME}")
75		.
76		qq({ROWS?} size="{ROWS}"{/ROWS?})
77		.
78		qq({DISABLED?} disabled{/DISABLED?})
79		.
80		qq({MULTIPLE?} multiple{/MULTIPLE?})
81		.
82		qq({EXTRA?} {EXTRA}{/EXTRA?})
83		.
84		qq(>)
85		,
86	selecttail =>
87		qq(</select>{APPEND})
88		,
89	textarea =>
90		qq({PREPEND})
91		.
92		qq(<textarea name="{NAME}")
93		.
94		qq({ROWS?} rows="{ROWS}"{/ROWS?})
95		.
96		qq({COLS?} cols="{COLS}"{/COLS?})
97		.
98		qq({DISABLED?} disabled{/DISABLED?})
99		.
100		qq({MAXLENGTH?} maxlength="{MAXLENGTH}"{/MAXLENGTH?})
101		.
102		qq({TTITLE?} title="{TTITLE}"{/TTITLE?})
103		.
104		qq({WRAP?} wrap="{WRAP}"{/WRAP?})
105		.
106		qq({EXTRA?} {EXTRA}{/EXTRA?})
107		.
108		qq(>{ENCODED}</textarea>)
109			.
110		qq({APPEND})
111		,
112	password =>
113		qq({PREPEND}<input type="password" name="{NAME}" value="{ENCODED}")
114		.
115		qq({COLS?} size="{COLS}"{/COLS?})
116		.
117		qq({MAXLENGTH?} maxlength="{MAXLENGTH}"{/MAXLENGTH?})
118		.
119		qq({EXTRA?} {EXTRA}{/EXTRA?})
120		.
121		qq(>{APPEND})
122		,
123	file =>
124		qq({PREPEND}<input type="file" name="{NAME}" value="{ENCODED}")
125		.
126		qq({TTITLE?} title="{TTITLE}"{/TTITLE?})
127		.
128		qq({COLS?} size="{COLS}"{/COLS?})
129		.
130		qq({EXTRA?} {EXTRA}{/EXTRA?})
131		.
132		qq(>{APPEND})
133		,
134	filetext =>
135		qq({PREPEND}<input type="file" name="{NAME}" value="{ENCODED}")
136		.
137		qq({TTITLE?} title="{TTITLE}"{/TTITLE?})
138		.
139		qq({COLS?} size="{COLS}"{/COLS?})
140		.
141		qq({EXTRA?} {EXTRA}{/EXTRA?})
142		.
143		qq(><br{XTRAILER}><textarea cols="{WIDTH}" rows="{HEIGHT}" name="{NAME}">{ENCODED}</textarea>{APPEND})
144		,
145	text =>
146		qq({PREPEND}<input type="text" name="{NAME}" value="{ENCODED}")
147		.
148		qq({COLS?} size="{COLS}"{/COLS?})
149		.
150		qq({TTITLE?} title="{TTITLE}"{/TTITLE?})
151		.
152		qq({DISABLED?} disabled{/DISABLED?})
153		.
154		qq({MAXLENGTH?} maxlength="{MAXLENGTH}"{/MAXLENGTH?})
155		.
156		qq({TTITLE?} title="{TTITLE}"{/TTITLE?})
157		.
158		qq({EXTRA?} {EXTRA}{/EXTRA?})
159		.
160		qq(>{APPEND})
161		,
162	hidden =>
163		qq({PREPEND}<input type="hidden" name="{NAME}" value="{ENCODED}")
164		.
165		qq({EXTRA?} {EXTRA}{/EXTRA?})
166		.
167		qq(>{APPEND})
168		,
169	hiddentext =>
170		qq({PREPEND}<input type="hidden" name="{NAME}" value="{ENCODED}")
171		.
172		qq({EXTRA?} {EXTRA}{/EXTRA?})
173		.
174		qq(>{FILTERED?}{FILTERED}{/FILTERED?}{FILTERED:}{ENCODED}{/FILTERED:}{APPEND})
175		,
176	boxstd =>
177		qq(<input type="{VARIANT}" name="{NAME}" value="{TVALUE}")
178		.
179		qq({EXTRA?} {EXTRA}{/EXTRA?})
180		.
181		qq({TTITLE?} title="{TTITLE}"{/TTITLE?})
182		.
183		qq({DISABLED?} disabled{/DISABLED?})
184		.
185		qq({SELECTED?} checked{/SELECTED?})
186		.
187		qq(>&nbsp;{TTITLE?}<span title="{TTITLE}">{/TTITLE?}{TLABEL}{TTITLE?}</span>{/TTITLE?})
188		,
189	boxnbsp =>
190		qq(<input type="{VARIANT}" name="{NAME}" value="{TVALUE}")
191		.
192		qq({TTITLE?} title="{TTITLE}"{/TTITLE?})
193		.
194		qq({EXTRA?} {EXTRA}{/EXTRA?})
195		.
196		qq({DISABLED?} disabled{/DISABLED?})
197		.
198		qq({SELECTED?} checked{/SELECTED?})
199		.
200		qq(>&nbsp;{TTITLE?}<span title="{TTITLE}">{/TTITLE?}{TLABEL}{TTITLE?}</span>{/TTITLE?}&nbsp;&nbsp;)
201		,
202	boxlabel =>
203		qq(<td{TD_LABEL?} {TD_LABEL}{/TD_LABEL?}{TTITLE?} title="{TTITLE}"{/TTITLE?}>)
204		.
205		qq({FONT?}<font size="{FONT}">{/FONT?})
206		.
207		qq({TLABEL}{FONT?}</font>{/FONT?})
208		.
209		qq(</td>)
210		,
211	boxvalue =>
212		qq(<td{TD_VALUE?} {TD_VALUE}{/TD_VALUE?}>)
213		.
214		qq(<input type="{VARIANT}" name="{NAME}" value="{TVALUE}")
215		.
216		qq({TTITLE?} title="{TTITLE}"{/TTITLE?})
217		.
218		qq({DISABLED?} disabled{/DISABLED?})
219		.
220		qq({EXTRA?} {EXTRA}{/EXTRA?})
221		.
222		qq({SELECTED?} checked{/SELECTED?})
223		.
224		qq(>)
225		.
226		qq(</td>)
227		,
228	boxgroup =>
229		qq(</tr><tr><td{TD_GROUP?} {TD_GROUP}{/TD_GROUP?} colspan="2">)
230		.
231		qq(<b>{TVALUE}</b>)
232		.
233		qq(</td></tr>)
234		,
235);
236
237$Template{default} = $Template{text};
238
239sub attr_list {
240	my ($body, $hash) = @_;
241	return $body unless ref($hash) eq 'HASH';
242
243	$body =~ s!\{([A-Z_]+)\}!$hash->{lc $1}!g;
244	$body =~ s!\{([A-Z_]+)\|($Some)\}!$hash->{lc $1} || $2!eg;
245	$body =~ s!\{([A-Z_]+)\s+($Some)\}! $hash->{lc $1} ? $2 : ''!eg;
246	1 while $body =~ s!\{([A-Z_]+)\?\}($Some){/\1\?\}! $hash->{lc $1} ? $2 : ''!eg;
247	1 while $body =~ s!\{([A-Z_]+)\:\}($Some){/\1\:\}! $hash->{lc $1} ? '' : $2!eg;
248	return $body;
249}
250
251sub show_data {
252	my $opt = shift;
253	my $ary = shift;
254	return undef if ! $ary;
255	my @out;
256	for(@$ary) {
257		push @out, join "=", @$_;
258	}
259	my $delim = Vend::Interpolate::get_joiner($opt->{delimiter}, ',');
260	return join $delim, @out;
261}
262
263sub show_options {
264	my $opt = shift;
265	my $ary = shift;
266	my $idx = shift || 0;
267	return undef if ! $ary;
268	my @out;
269	eval {
270		@out = map {$_->[$idx]} @$ary;
271	};
272	my $delim = Vend::Interpolate::get_joiner($opt->{delimiter}, ',');
273	return join $delim, @out;
274}
275
276sub show_labels {
277	return show_options($_[0], $_[1], 1);
278}
279
280sub template_sub {
281	my $opt = shift;
282	return attr_list($Template{$opt->{type}} || $Template{default}, $opt);
283}
284
285## Retrieve the *first* current label
286sub current_label {
287	my($opt, $data) = @_;
288	my $val;
289	my $default;
290	if (defined $opt->{value}) {
291		$val = $opt->{value};
292	}
293	elsif(defined $opt->{default}) {
294		$val = $opt->{default};
295	}
296	$val =~ s/\0//;
297	for(@$data) {
298		my ($setting, $label) = @$_;
299		$default = $label if $label =~ s/\*$//;
300		return ($label || $setting) if $val eq $setting;
301	}
302	return $val || $default;
303}
304
305sub links {
306	my($opt, $opts) = @_;
307
308	$opt->{joiner} = Vend::Interpolate::get_joiner($opt->{joiner}, "<br$Vend::Xtrailer>");
309	my $name = $opt->{name};
310	my $default = defined $opt->{value} ? $opt->{value} : $opt->{default};
311
312	$opt->{extra} = " $opt->{extra}" if $opt->{extra};
313
314	my $template = $opt->{template} || <<EOF;
315<a href="{URL}"{EXTRA}>{SELECTED <b>}{LABEL}{SELECTED </b>}</a>
316EOF
317
318	my $o_template = $opt->{o_template} || <<EOF;
319<b>{TVALUE}</b>
320EOF
321
322	my $href = $opt->{href} || $Global::Variable->{MV_PAGE};
323	$opt->{form} = "mv_action=return" unless $opt->{form};
324
325	my $no_encode = $opt->{pre_filter} eq 'decode_entities' ? 1 : 0;
326
327	my @out;
328	for(@$opts) {
329#warn "iterating links opt $_ = " . uneval_it($_) . "\n";
330		my $attr = { extra => $opt->{extra}};
331
332		s/\*$// and $attr->{selected} = 1;
333
334		($attr->{value},$attr->{label}) = @$_;
335		encode($attr->{label}, $ESCAPE_CHARS::std) unless $no_encode;
336		if($attr->{value} =~ /^\s*\~\~(.*)\~\~\s*$/) {
337			my $lab = $1;
338			$lab =~ s/"/&quot;/g;
339			$opt->{tvalue} = $lab;
340			$opt->{tlabel} = $lab;
341			push @out, attr_list($o_template, $opt);
342			next;
343		}
344
345		next if ! $attr->{value} and ! $opt->{empty};
346		if( ! length($attr->{label}) ) {
347			$attr->{label} = $attr->{value} or next;
348		}
349
350		if ($default) {
351			$attr->{selected} = $default eq $attr->{value} ? 1 : '';
352		}
353
354		my $form = $opt->{form};
355
356		$attr->{label} =~ s/\s/&nbsp;/g if $opt->{nbsp};
357
358		$attr->{url} = Vend::Interpolate::tag_area(
359						$href,
360						undef,
361						{
362							form => "$name=$attr->{value}\n$opt->{form}",
363							secure => $opt->{secure},
364						},
365						);
366		push @out, attr_list($template, $attr);
367	}
368	return join $opt->{joiner}, @out;
369}
370
371my @Years;
372my @Months;
373my @Days;
374
375INITTIME: {
376	my @t = localtime();
377	(@Years) = ( $t[5] + 1899 .. $t[5] + 1910 );
378
379	for(1 .. 12) {
380		$t[4] = $_ - 1;
381		$t[3] = 1;
382		push @Months, [sprintf("%02d", $_), POSIX::strftime("%B", @t)];
383	}
384
385	for(1 .. 31) {
386		push @Days, [sprintf("%02d", $_), $_];
387	}
388}
389
390sub round_to_fifteen {
391	my $val = shift;
392#::logDebug("round_to_fifteen val in=$val");
393	$val = substr($val, 0, 4);
394	$val = "0$val" if length($val) == 3;
395	return '0000' if length($val) < 4;
396	if($val !~ /(00|15|30|45)$/) {
397		my $hr = substr($val, 0, 2);
398		$hr =~ s/^0//;
399		my $min = substr($val, 2, 2);
400		$min =~ s/^0//;
401		if($min > 45 and $hr < 23) {
402			$hr++;
403			$min = 0;
404		}
405		elsif($min > 30) {
406			$min = 45;
407		}
408		elsif($min > 15) {
409			$min = 30;
410		}
411		elsif($min > 0) {
412			$min = 15;
413		}
414		elsif ($hr == 23) {
415			$min = 45;
416		}
417		else {
418			$min = 0;
419		}
420		$val = sprintf('%02d%02d', $hr, $min);
421	}
422#::logDebug("round_to_fifteen val out=$val");
423	return $val;
424}
425
426sub date_widget {
427	my($opt) = @_;
428
429	my $name = $opt->{name};
430	my $val  = $opt->{value};
431
432	if($val =~ /\D/) {
433		$val = Vend::Interpolate::filter_value('date_change', $val);
434	}
435	my $now;
436	if($opt->{time} and $opt->{time_adjust} =~ /([-+]?)(\d+)/) {
437		my $sign = $1 || '+';
438		my $adjust = $2;
439		$adjust *= 3600;
440		$now = time;
441		$now += $sign eq '+' ? $adjust : -$adjust;
442	}
443
444	my $sel_extra;
445	my $opt_extra;
446	for(qw/ class style extra /) {
447		my $stag = "select_$_";
448		my $otag = "option_$_";
449		my $selapp;
450		my $optapp;
451
452		if($_ eq 'extra') {
453			$selapp = " $opt->{$stag}";
454			$optapp = " $opt->{$otag}";
455		}
456		else {
457			$selapp = qq{ $_="$opt->{$stag}"};
458			$optapp = qq{ $_="$opt->{$otag}"};
459		}
460		$sel_extra .= $opt->{$stag} ? $selapp : '';
461		$opt_extra .= $opt->{$otag} ? $optapp : '';
462	}
463
464	my @t = localtime($now || time);
465	my $sel = 0;
466	my $out = qq{<select name="$name"$sel_extra>};
467	my $o;
468	if ($opt->{blank}) {
469		$out .= qq{<option value="0"$opt_extra>------</option>};
470	} elsif (not $val) {
471		# use current time with possible adjustments as default value
472		$t[2]++ if $t[2] < 23;
473		$val = POSIX::strftime("%Y%m%d%H00", @t);
474	}
475	for(@Months) {
476		$o = qq{<option value="$_->[0]"$opt_extra>} . errmsg($_->[1]) . '</option>';
477		($out .= $o, next) unless ! $sel and $val;
478		$o =~ s/>/ SELECTED>/ && $sel++
479			if substr($val, 4, 2) eq $_->[0];
480		$out .= $o;
481	}
482	$sel = 0;
483	$out .= qq{</select>};
484	$out .= qq{<input type="hidden" name="$name" value="/">};
485	$out .= qq{<select name="$name"$sel_extra>};
486	if ($opt->{blank}) {
487		$out .= qq{<option value="0"$opt_extra>--</option>};
488	}
489	for(@Days) {
490		$o = qq{<option value="$_->[0]"$opt_extra>$_->[1]} . '</option>';
491		($out .= $o, next) unless ! $sel and $val;
492		$o =~ s/>/ SELECTED>/ && $sel++
493			if substr($val, 6, 2) eq $_->[0];
494		$out .= $o;
495	}
496	$sel = 0;
497	$out .= qq{</select>};
498	$out .= qq{<input type="hidden" name="$name" value="/">};
499	$out .= qq{<select name="$name"$sel_extra>};
500	if(my $by = $opt->{year_begin} || $::Variable->{UI_DATE_BEGIN}) {
501		my $cy = $t[5] + 1900;
502		my $ey = $opt->{year_end}  || $::Variable->{UI_DATE_END} || ($cy + 10);
503		if($by < 100) {
504			$by = $cy - abs($by);
505		}
506		if($ey < 100) {
507			$ey += $cy;
508		}
509		@Years = $by <= $ey ? ($by .. $ey) : reverse ($ey .. $by);
510	}
511	if ($opt->{blank}) {
512		$out .= qq{<option value="0000"$opt_extra>----</option>};
513	}
514	for(@Years) {
515		$o = qq{<option$opt_extra>$_} . '</option>';
516		($out .= $o, next) unless ! $sel and $val;
517		$o =~ s/>/ SELECTED>/ && $sel++
518			if substr($val, 0, 4) eq $_;
519		$out .= $o;
520	}
521	$out .= qq{</select>};
522	return $out unless $opt->{time};
523
524	$val =~ s/^(\d{8})//;
525	# If the date is blank (0000-00-00), treat time of 00:00 as blank,
526	# not midnight, in the option selection below
527	my $blank_time = ($opt->{blank} and $1 !~ /[1-9]/);
528	$val =~ s/\D+//g;
529	$val = round_to_fifteen($val);
530	$out .= qq{<input type="hidden" name="$name" value=":">};
531	$out .= qq{<select name="$name"$sel_extra>};
532	if ($opt->{blank}) {
533		$out .= qq{<option value="0"$opt_extra>--:--</option>};
534	}
535
536	my $ampm = defined $opt->{ampm} ? $opt->{ampm} : 1;
537	my $mod = '';
538	undef $sel;
539	my %special = qw/ 0 midnight 12 noon /;
540
541	my @min;
542
543	$opt->{minutes} ||= '';
544
545	if($opt->{minutes} =~ /half/i) {
546		@min = (0,30);
547	}
548	elsif($opt->{minutes} =~ /hourly/i) {
549		@min = (0);
550	}
551	elsif($opt->{minutes} =~ /ten/i) {
552		@min = (0,10,20,30,40,50);
553	}
554	elsif($opt->{minutes} =~ /[\0,]/) {
555		@min = grep /^\d+$/ && $_ <= 59, split /[\0,\s]+/, $opt->{minutes};
556	}
557	else {
558		@min = (0,15,30,45);
559	}
560
561	$opt->{start_hour} ||= 0;
562	for(qw/start_hour end_hour/) {
563		$opt->{$_} = int(abs($opt->{$_}));
564		if($opt->{$_} > 23) {
565			$opt->{$_} = 0;
566		}
567	}
568	$opt->{start_hour}	||= 0;
569	$opt->{end_hour}	||= 23;
570
571	for my $hr ( $opt->{start_hour} .. $opt->{end_hour} ) {
572		next if defined $opt->{start_hour} and $hr < $opt->{start_hour};
573		next if defined $opt->{end_hour} and $hr > $opt->{end_hour};
574		for my $min ( @min ) {
575			my $disp_hour = $hr;
576			if($opt->{ampm}) {
577				if( $hr < 12) {
578					$mod = 'am';
579				}
580				else {
581					$mod = 'pm';
582					$disp_hour = $hr - 12 unless $hr == 12;
583				}
584				$mod = errmsg($mod);
585				$mod = " $mod";
586			}
587			if($special{$hr} and $min == 0) {
588				$disp_hour = errmsg($special{$hr});
589			}
590			elsif($ampm) {
591				$disp_hour = sprintf("%2d:%02d%s", $disp_hour, $min, $mod);
592			}
593			else {
594				$disp_hour = sprintf("%02d:%02d", $hr, $min);
595			}
596			my $time = sprintf "%02d%02d", $hr, $min;
597			$o = sprintf qq{<option value="%s"$opt_extra>%s}, $time, $disp_hour;
598			($out .= $o, next) unless ! $sel and $val;
599#::logDebug("prospect=$time actual=$val");
600			$o =~ s/>/ SELECTED>/ && $sel++
601				if ! $blank_time and $val eq $time;
602			$out .= $o;
603		}
604	}
605	$out .= "</select>";
606	return $out;
607}
608
609sub option_widget_box {
610	my ($name, $val, $lab, $default, $width) = @_;
611	my $half = int($width / 2);
612	my $sel = $default ? ' SELECTED' : '';
613	$val =~ s/"/&quot;/g;
614	$lab =~ s/"/&quot;/g;
615	$width = 10 if ! $width;
616	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><select name="$name"><option value="0">no<option value="1"$sel>default*</select></small></td></tr>};
617}
618
619sub option_widget {
620	my($opt) = @_;
621	my($name, $val) = ($opt->{name}, $opt->{value});
622
623	my $width = $opt->{width} || 16;
624	$opt->{filter} = 'option_format'
625		unless length($opt->{filter});
626	$val = Vend::Interpolate::filter_value($opt->{filter}, $val);
627	my @opts = split /\s*,\s*/, $val;
628
629	my $out = qq{<table cellpadding="0" cellspacing="0"><tr><th><small>};
630	$out .= errmsg('Value');
631	$out .= qq{</small></th><th align="left" colspan="2"><small>};
632	$out .= errmsg('Label');
633	$out .= qq{</small></th></tr>};
634
635	my $done;
636	my $height = $opt->{height} || 5;
637	$height -= 2;
638	for(@opts) {
639		my ($v,$l) = split /\s*=\s*/, $_, 2;
640		next unless $l || length($v);
641		$done++;
642		my $default;
643		($l =~ s/\*$// or ! $l && $v =~ s/\*$//)
644			and $default = 1;
645		$out .= option_widget_box($name, $v, $l, $default, $width);
646	}
647	while($done++ < $height) {
648		$out .= option_widget_box($name, '', '', '', $width);
649	}
650	$out .= option_widget_box($name, '', '', '', $width);
651	$out .= option_widget_box($name, '', '', '', $width);
652	$out .= "</table>";
653}
654
655
656sub movecombo {
657	my ($opt, $opts) = @_;
658	my $name = $opt->{name};
659	$opt->{name} = "X$name";
660	my $usenl = $opt->{rows} > 1 ? 1 : 0;
661	my $only = $opt->{replace} ? 1 : 0;
662	$opt->{extra} .= qq{ onChange="addItem(this.form['X$name'],this.form['$name'],$usenl,$only)"}
663            unless $opt->{extra} =~ m/\bonchange\s*=/i;
664
665	$opt->{rows} = $opt->{height} unless length($opt->{rows});
666	$opt->{cols} = $opt->{width} unless length($opt->{cols});
667
668	my $tbox = '';
669	my $out = dropdown($opt, $opts);
670
671	my $template = $opt->{o_template} || '';
672	if(! $template) {
673		if($opt->{rows} > 1) {
674			$template .= q(<textarea rows="{ROWS|4}" wrap="{WRAP|virtual}");
675			$template .= q( cols="{COLS|20}" name="{NAME}">{ENCODED}</textarea>);
676		}
677		else {
678			$template .= qq(<input type="text" size="{COLS||40}");
679			$template .= qq( name="{NAME}" value="{ENCODED}">);
680		}
681	}
682	$opt->{name} = $name;
683	$tbox = attr_list($template, $opt);
684
685	return $opt->{reverse} ? $tbox . $out : $out . $tbox;
686}
687
688sub combo {
689	my ($opt, $opts) = @_;
690	my $addl;
691	if($opt->{textarea}) {
692		my $template = $opt->{o_template};
693		if(! $template) {
694			$template = "<br$Vend::Xtrailer>";
695			if(! $opt->{rows} or $opt->{rows} > 1) {
696				$template .= q(<textarea rows="{ROWS|2}" wrap="{WRAP|virtual}");
697				$template .= q( cols="{COLS|60}" name="{NAME}">);
698				$template .= '{ENCODED}'
699					unless $opt->{conditional_text} and length($opt->{value}) < 3;
700				$template .= q(</textarea>);
701			}
702			else {
703				$template .= qq(<input type="text" size="{COLS|40}");
704				$template .= qq( name="{NAME}" value=");
705				$template .= '{ENCODED}'
706					unless $opt->{conditional_text} and length($opt->{value}) < 3;
707				$template .= qq(">);
708			}
709		}
710		$addl = attr_list($template, $opt);
711	}
712	else {
713		$addl = qq|<input type="text" name="$opt->{name}"|;
714		$addl   .= qq| size="$opt->{cols}" value="">|;
715	}
716	if($opt->{reverse}) {
717		$opt->{append} = length($opt->{append}) ? "$addl$opt->{append}" : $addl;
718	}
719	else {
720		$opt->{prepend} = length($opt->{prepend}) ? "$opt->{prepend}$addl" : $addl;
721	}
722	return dropdown($opt, $opts);
723}
724
725sub dropdown {
726	my($opt, $opts) = @_;
727#::logDebug("called select opt=" . ::uneval($opt) . "\nopts=" . ::uneval($opts));
728	$opt->{multiple} = 1 if $opt->{type} eq 'multiple';
729
730	$opts ||= [];
731
732	my $price = $opt->{price} || {};
733
734	my $select;
735#::logDebug("template for selecthead: $Template{selecthead}");
736#::logDebug("opt is " . ::uneval($opt));
737	my $run = attr_list($Template{selecthead}, $opt);
738#::logDebug("run is now: $run");
739	my ($multi, $re_b, $re_e, $regex);
740#::logDebug("select multiple=$opt->{multiple}");
741	if($opt->{multiple}) {
742		$multi = 1;
743		if($opt->{rawvalue}) {
744			$re_b = '(?:\0|^)';
745			$re_e = '(?:\0|$)';
746		}
747		else {
748			$re_b = '(?:[\0,\s]|^)';
749			$re_e = '(?:[\0,\s]|$)';
750		}
751	}
752	else {
753		$re_b = '^';
754		$re_e = '$';
755	}
756
757	my $limit;
758	if($opt->{cols}) {
759		my $cols = $opt->{cols};
760		$limit = sub {
761			return $_[0] if length($_[0]) <= $cols;
762			return substr($_[0], 0, $cols - 2) . '..';
763		};
764	}
765	else {
766		$limit = sub { return $_[0] };
767	}
768
769	my $default = $opt->{value};
770
771	my $optgroup_one;
772	my $no_encode = $opt->{pre_filter} eq 'decode_entities' ? 1 : 0;
773
774	for(@$opts) {
775		my ($value, $label, $help) = @$_;
776		encode($label, $ESCAPE_CHARS::std) unless $no_encode;
777		encode($help, $ESCAPE_CHARS::std) if $help;
778		if($value =~ /^\s*\~\~(.*)\~\~\s*$/) {
779			my $label = $1;
780			if($optgroup_one++) {
781				$run .= "</optgroup>";
782			}
783			$run .= qq{<optgroup label="$label">};
784			next;
785		}
786		$run .= '<option';
787		$select = '';
788
789		if($label) {
790			$label =~ s/\*$// and $select = 1;
791		}
792		else {
793			$value =~ s/\*$// and $select = 1;
794		}
795
796		$select = '' if defined $default;
797
798		my $extra = '';
799		my $attr = {};
800		if(my $p = $price->{$value}) {
801			$attr->{negative} = $p < 0 ? 1 : 0;
802			$attr->{price_noformat} = $p;
803			$attr->{absolute} = currency(abs($p), undef, 1);
804			$attr->{price} = $extra = currency($p, undef, 1);
805			$extra = " ($extra)";
806		}
807
808		my $vvalue = $value;
809		encode($vvalue, $ESCAPE_CHARS::std);
810		$run .= qq| value="$vvalue"|;
811		$run .= qq| title="$help"| if $help;
812		if (length($default)) {
813			$regex	= qr/$re_b\Q$value\E$re_e/;
814			$default =~ $regex and $select = 1;
815		} elsif (defined($default) && length($value) == 0) {
816			$select = 1;
817		}
818		$run .= ' SELECTED' if $select;
819		$run .= '>';
820		if($opt->{option_template}) {
821			$attr->{label} = $label || $value;
822			$attr->{value} = $value;
823			$run .= attr_list($opt->{option_template}, $attr);
824		}
825		elsif($label) {
826			$run .= $limit->($label);
827			$run .= $extra;
828		}
829		else {
830			$run .= $limit->($value);
831			$run .= $extra;
832		}
833	}
834	$run .= "</optgroup>" if $optgroup_one++;
835	$run .= attr_list($Template{selecttail}, $opt);
836}
837
838=head2 yesno
839
840Provides an easy "Yes/No" widget. C<No> returns a value of blank/false,
841and C<Yes> returns 1/true.
842
843Calling:
844
845  {
846    name => 'varname' || undef,       ## Derived from item if called by
847                                       # [PREFIX-options] or [PREFIX-accessories]
848    type => 'yesno' || 'yesno radio', ## Second is shorthand for variant=>radio
849    variant => 'radio' || 'select',   ## Default is select
850  }
851
852The data array passed by C<passed> is never used, it is overwritten
853with the equivalent of '=No,1=Yes'. C<No> and C<Yes> are generated from
854the locale, so if you want a translated version set those keys in the locale.
855
856If you want another behavior the same widget can be constructed with:
857
858	[display passed="=My no,0=My yes" type=select ...]
859
860=cut
861
862
863sub yesno {
864	my $opt = shift;
865	$opt->{value} = is_yes($opt->{value});
866	my $yes = defined $opt->{yes_value} ? $opt->{yes_value} : 1;
867	my $no  = defined $opt->{no_value} ? $opt->{no_value} : '';
868	my $yes_title = defined $opt->{yes_title} ? $opt->{yes_title} : errmsg('Yes');
869	my $no_title  = defined $opt->{no_title} ? $opt->{no_title} : errmsg('No');
870	my @opts;
871	my $routine = $opt->{subwidget} || \&dropdown;
872	if($opt->{variant} eq 'checkbox') {
873		@opts = [$yes, ' '];
874	}
875	else {
876		@opts = (
877					[$no, $no_title],
878					[$yes, $yes_title],
879				);
880	}
881	return $routine->($opt, \@opts);
882}
883
884=head2 noyes
885
886Same as C<yesno> except sense is reversed. C<No> returns a value of 1/true,
887and C<Yes> returns blank/false.
888
889=cut
890
891sub noyes {
892	my $opt = shift;
893	$opt->{value} = is_no($opt->{value});
894	my @opts = (
895					['1', errmsg('No')],
896					['', errmsg('Yes')],
897				);
898	my $routine = $opt->{subwidget} || \&dropdown;
899	return $routine->($opt, \@opts);
900}
901
902sub box {
903	my($opt, $opts) = @_;
904#::logDebug("Called box type=$opt->{type}");
905	my $inc = $opt->{breakmod};
906	my ($xlt, $template, $o_template, $header, $footer, $row_hdr, $row_ftr);
907
908	$opt->{variant} ||= $opt->{type};
909
910	$header = $template = $footer = $row_hdr = $row_ftr = '';
911
912	if($opt->{nbsp}) {
913		$xlt = 1;
914		$template = $Template{boxnbsp};
915	}
916	elsif ($opt->{left}) {
917		$header = '<table>';
918		$footer = '</table>';
919		$template = '<tr>' unless $inc;
920		$template .= $Template{boxvalue};
921		$template .= $Template{boxlabel};
922		$template .= '</tr>' unless $inc;
923		$o_template = $Template{boxgroup};
924	}
925	elsif ($opt->{right}) {
926		$header = '<table>';
927		$footer = '</table>';
928		$template = '<tr>' unless $inc;
929		$template .= $Template{boxlabel};
930		$template .= $Template{boxvalue};
931		$template .= '</tr>' unless $inc;
932		$o_template = $Template{boxgroup};
933	}
934	else {
935		$template = $Template{boxstd};
936	}
937	$o_template ||= "<br$Vend::Xtrailer><b>{TVALUE}</b><br$Vend::Xtrailer>";
938
939	my $run = $header;
940
941	my $price = $opt->{price} || {};
942
943	my $i = 0;
944	my $default = $opt->{value};
945	my $no_encode = $opt->{pre_filter} eq 'decode_entities' ? 1 : 0;
946
947	for(@$opts) {
948		my($value,$label,$help) = @$_;
949		encode($label, $ESCAPE_CHARS::std) unless $no_encode;
950		encode($help, $ESCAPE_CHARS::std) if $help;
951		if($value =~ /^\s*\~\~(.*)\~\~\s*$/) {
952			my $lab = $1;
953			$lab =~ s/"/&quot;/g;
954			$opt->{tvalue} = $lab;
955			$opt->{tlabel} = $lab;
956			$run .= attr_list($o_template, $opt);
957			$i = 0;
958			next;
959		}
960		$value = ''     if ! length($value);
961		$label = $value if ! length($label);
962
963		$run .= '<tr>' if $inc && ! ($i % $inc);
964		$i++;
965
966		undef $opt->{selected};
967		$label =~ s/\*$//
968			and $opt->{selected} = 1;
969		$opt->{selected} = '' if defined $opt->{value};
970
971		my $extra;
972		my $attr = { label => $label, value => $value };
973		if(my $p = $price->{$value}) {
974			$attr->{negative} = $p < 0 ? 1 : 0;
975			$attr->{price_noformat} = $p;
976			$attr->{absolute} = currency(abs($p), undef, 1);
977			$attr->{price} = $extra = currency($p, undef, 1);
978			$label .= "&nbsp;($attr->{price})";
979		}
980
981		$value eq ''
982			and defined $default
983			and $default eq ''
984			and $opt->{selected} = 1;
985
986		if(length $value) {
987			my $regex	= $opt->{contains}
988						? qr/\Q$value\E/
989						: qr/\b\Q$value\E\b/;
990			$default =~ $regex and $opt->{selected} = 1;
991		}
992
993		$opt->{tvalue} = encode($value, $ESCAPE_CHARS::std);
994
995		if($opt->{option_template}) {
996			$opt->{tlabel} = attr_list($opt->{option_template}, $attr);
997			$opt->{tlabel} =~ s/ /&nbsp;/g if $xlt;
998		}
999		else {
1000			$label =~ s/ /&nbsp;/g if $xlt;
1001			$opt->{tlabel} = $label;
1002		}
1003
1004		$opt->{ttitle} = $help;
1005
1006		$run .= attr_list($template, $opt);
1007		$run .= '</tr>' if $inc && ! ($i % $inc);
1008	}
1009	$run .= $footer;
1010}
1011
1012sub options_to_array {
1013	my ($passed, $opt) = @_;
1014	return $passed if ref($passed) eq 'ARRAY'
1015		and (
1016			! scalar @$passed
1017				or
1018			ref($passed->[0]) eq 'ARRAY'
1019		);
1020
1021	$opt ||= {};
1022	my @out;
1023
1024	if($passed =~ m{^[^=]*\0}) {
1025		$passed = Vend::Interpolate::filter_value($passed, 'option_format');
1026	}
1027
1028	my $delim = $opt->{delimiter} || ',';
1029	$delim = '\s*' . $delim . '\s*';
1030
1031	if (ref $passed eq 'SCALAR') {
1032		$passed = [ split /$delim/, $$passed ];
1033	}
1034	elsif(! ref $passed) {
1035		$passed = [ split /$delim/, $passed ];
1036	}
1037
1038	if (ref $passed eq 'ARRAY') {
1039		for(@$passed) {
1040			push @out, [split /\s*=\s*/, HTML::Entities::decode($_), 2];
1041		}
1042	}
1043	elsif (ref $passed eq 'HASH') {
1044		my @keys;
1045		my $sub;
1046		my $nsub = sub { ($_->{$a} || $a) <=> ($_->{$b} || $b) };
1047		my $asub = sub { ($_->{$a} || $a) cmp ($_->{$b} || $b) };
1048		if(! $opt->{sort_option}) {
1049			$sub = $asub;
1050		}
1051		elsif($opt->{sort_option} eq 'none') {
1052			# do nothing
1053		}
1054		elsif($opt->{sort_option} =~ /n/i) {
1055			$sub = $nsub;
1056		}
1057		else {
1058			$sub = $asub;
1059		}
1060
1061		@keys = $sub ? (sort $sub keys %$passed) : (keys %$passed);
1062
1063		for(@keys) {
1064			push @out, [$_, $passed->{$_}];
1065		}
1066	}
1067	else {
1068		die "bad data type to options_to_array";
1069	}
1070
1071	if ($opt->{applylocale}) {
1072		for (@out) {
1073			$_->[1] = errmsg($_->[1]);
1074		}
1075	}
1076
1077	return \@out;
1078}
1079
1080sub display {
1081	my($opt, $item, $data) = @_;
1082
1083if($opt->{debug}) {
1084	::logDebug("display called, options=" . uneval($opt));
1085	::logDebug("item=" . uneval($item)) if $item;
1086}
1087
1088	if(! ref $opt) {
1089		### Has effect of simple default widget for name
1090		### or some text output
1091		if($opt =~ /^$Codere$/) {
1092			$opt = { name => $opt };
1093		}
1094		else {
1095			return $opt;
1096		}
1097	}
1098	elsif (ref $opt eq 'ARRAY') {
1099		### Handle multiple things passed
1100		my @out;
1101		for(@$opt) {
1102			push @out, display( ref $_ eq 'ARRAY' ? @$_ : ($_));
1103		}
1104		return join "", @out;
1105	}
1106
1107	if($opt->{override}) {
1108		$opt->{value} = $opt->{default};
1109	}
1110
1111	$opt->{default} = $opt->{value}    if defined $opt->{value};
1112
1113	if($opt->{pre_filter} and defined $opt->{value}) {
1114		$opt->{value} = Vend::Interpolate::filter_value(
1115							$opt->{pre_filter},
1116							$opt->{value},
1117						);
1118	}
1119
1120	my $ishash;
1121	if(ref ($item) eq 'HASH') {
1122#::logDebug("item=$item");
1123		$ishash = 1;
1124	}
1125	else {
1126		$item = get_option_hash($item || $opt->{item});
1127	}
1128#::logDebug("item=" . ::uneval($item));
1129
1130	# Just in case
1131	$opt  ||= {};
1132	$item ||= {};
1133
1134	## Set some defaults, can't have attribute or type '0';
1135	## Note the fact that attribute can take its value from name
1136	## and vice-versa
1137	$opt->{attribute} ||= $opt->{name};
1138	$opt->{prepend}   = ''  unless defined $opt->{prepend};
1139	$opt->{append}    = ''  unless defined $opt->{append};
1140	$opt->{delimiter} = ',' unless length($opt->{delimiter});
1141	$opt->{cols}      ||= $opt->{width} || $opt->{size};
1142	$opt->{rows}      ||= $opt->{height};
1143
1144	if($opt->{js_check}) {
1145		my @checks = grep /\w/, split /[\s,\0]+/, $opt->{js_check};
1146		for(@checks) {
1147			if(my $sub = Vend::Util::codedef_routine('JavaScriptCheck', $_)) {
1148				$sub->($opt);
1149			}
1150			else {
1151				::logError('Unknown %s: %s', 'JavaScriptCheck', $_);
1152			}
1153		}
1154	}
1155
1156	# This handles the embedded attribute information in certain types,
1157	# for example:
1158	#
1159	#	text_60       is the same as type => 'text', width => '60'
1160	#   datetime_ampm is the same as type => 'datetime', ampm => 1
1161
1162	# Warning -- this sets $opt->{type} and has possible side-effects
1163	#            in $opt
1164	my $type = parse_type($opt);
1165
1166#::logDebug("name=$opt->{name} type=$type");
1167
1168	my $look;
1169
1170	if($look = $opt->{lookup_query}) {
1171#::logDebug("lookup_query called, opt=" . uneval($opt));
1172		my $tab = $opt->{db} || $opt->{table} || $Vend::Cfg->{ProductFiles}[0];
1173		my $db = Vend::Data::database_exists_ref($tab);
1174		my @looks = split /\s*;\s*/, $look;
1175		$data = [];
1176		for my $l (@looks) {
1177			next unless $db;
1178			next unless $l =~ /^\s*select\s+/i;
1179			my $qr = $db->query($l);
1180			ref($qr) eq 'ARRAY' and push @$data, @$qr;
1181		}
1182		if($data->[0] and @{$data->[0]} > 2) {
1183			my $j = $opt->{label_joiner} || '-';
1184			for(@$data) {
1185				$_->[1] = join $j, splice @$_, 1;
1186			}
1187		}
1188	}
1189	elsif($look = $opt->{lookup}) {
1190#::logDebug("lookup called, opt=" . uneval($opt));
1191		LOOK: {
1192			my $tab = $opt->{db} || $opt->{table} || $Vend::Cfg->{ProductFiles}[0];
1193			my $db = Vend::Data::database_exists_ref($tab)
1194				or last LOOK;
1195			my $fld = $opt->{field} || $look;
1196			my $key = $look;
1197
1198			if($key ne $fld and $fld !~ /,/) {
1199				$fld = "$key,$fld";
1200			}
1201
1202			my @f = split /\s*,\s*/, $fld;
1203			my $order = $opt->{sort} || $f[1] || $f[0];
1204			last LOOK unless $tab;
1205			my $q = qq{SELECT DISTINCT $fld FROM $tab ORDER BY $order};
1206			eval {
1207				$data = $db->query($q) || die;
1208				if(@f > 2) {
1209					for(@$data) {
1210						my $join = $opt->{label_joiner} || '-';
1211						my $string = join $join, splice @$_, 1;
1212						$_->[1] = $string;
1213					}
1214				}
1215			};
1216		}
1217	}
1218	elsif($opt->{passed}) {
1219		$data = options_to_array($opt->{passed}, $opt);
1220	}
1221	elsif(! $opt->{already_got_data} and $opt->{column} and $opt->{table} ) {
1222		GETDATA: {
1223			last GETDATA if $opt->{table} eq 'mv_null';
1224			my $key = $opt->{outboard} || $item->{code} || $opt->{code};
1225			last GETDATA unless length($key);
1226			last GETDATA unless ::database_exists_ref($opt->{table});
1227			$opt->{passed} = $Tag->data($opt->{table}, $opt->{column}, $key)
1228				and
1229			$data = options_to_array($opt->{passed}, $opt);
1230		}
1231	}
1232
1233	## This means a lookup was attempted above
1234	if($look and $data) {
1235		my $ary;
1236		if($opt->{options}) {
1237			$ary = options_to_array($opt->{options}, $opt) || [];
1238		}
1239		elsif(! scalar(@$data)) {
1240			$ary = [['', errmsg('--no current values--')]];
1241		}
1242		if($opt->{lookup_exclude}) {
1243			my $sub;
1244			eval {
1245				$sub = sub { $_[0] !~ m{$opt->{lookup_exclude}} };
1246			};
1247			if ($@) {
1248				logError(
1249					"Bad lookup pattern m{%s}: %s", $opt->{lookup_exclude}, $@,
1250				);
1251				undef $sub;
1252			}
1253			if($sub) {
1254				@$data = grep $_,
1255							map {
1256								$sub->(join '=', @$_)
1257									or return undef;
1258								return $_;
1259							} @$data;
1260			}
1261		}
1262
1263		unless($opt->{lookup_merge}) {
1264			unshift @$data, @$ary if $ary;
1265		}
1266		elsif($ary) {
1267			my %existing;
1268			for(@$ary) {
1269				$existing{$_->[0]}++;
1270			}
1271			for(@$data) {
1272				next if $existing{$_->[0]};
1273				push @$ary, $_;
1274			}
1275			$data = $ary;
1276		}
1277	}
1278
1279## Some legacy stuff, has to do with default behavior when called from
1280## item-accessories or item-options
1281	if($ishash) {
1282		my $adder;
1283		$adder = $item->{mv_ip} if	defined $item->{mv_ip}
1284								and $opt->{item} || ! $opt->{name};
1285		$opt->{name} = $opt->{attribute}
1286			unless $opt->{name};
1287		$opt->{value} = $item->{$opt->{attribute} || $opt->{name}};
1288		$opt->{name} .= $adder if defined $adder;
1289#::logDebug("tag_accessories: name=$opt->{name} ISHASH");
1290	}
1291	else {
1292#::logDebug("display: name=$opt->{name} IS NOT HASH");
1293		$opt->{name} = "mv_order_$opt->{attribute}" unless $opt->{name};
1294	}
1295
1296	$opt->{price} = get_option_hash($opt->{price_data})
1297		if $opt->{price};
1298
1299	$opt->{name} ||= $opt->{attribute};
1300
1301	if(defined $opt->{value}) {
1302		# do nothing
1303	}
1304	elsif(defined $item->{$opt->{name}}) {
1305	   $opt->{value}   = $item->{$opt->{name}};
1306	}
1307	elsif($opt->{cgi_default} and ! $opt->{override}) {
1308		my $def = $CGI::values{$opt->{name}};
1309		$opt->{value} = $def if defined($def);
1310	}
1311	elsif($opt->{values_default} and ! $opt->{override}) {
1312		my $def = $::Values->{$opt->{name}};
1313		$opt->{value} = $def if defined($def);
1314	}
1315
1316	$opt->{value} = $opt->{default} if ! defined $opt->{value};
1317
1318	if(length($opt->{blank_default}) and ! length($opt->{value}) ) {
1319		$opt->{value} = $opt->{blank_default};
1320	}
1321
1322    $opt->{encoded} = encode($opt->{value}, $ESCAPE_CHARS::std);
1323	if($opt->{display_filter}) {
1324		my $newv = Vend::Interpolate::filter_value(
1325								$opt->{display_filter},
1326								$opt->{value},
1327							);
1328		$opt->{filtered} = encode($newv, $ESCAPE_CHARS::std);
1329	}
1330    $opt->{value} =~ s/&#91;/\[/g if $opt->{enable_itl};
1331
1332	if($opt->{class}) {
1333		if($opt->{extra}) {
1334			$opt->{extra} =~ s{(^|\s+)class=(["'])?[^\s'"]+\2}{$1};
1335			$opt->{extra} =~ s/\s+$//;
1336			$opt->{extra} .= qq{ class="$opt->{class}"};
1337		}
1338		else {
1339			$opt->{extra} = qq{class="$opt->{class}"};
1340		}
1341	}
1342
1343	# Optimization for large lists, we cache the widgets
1344	$Vend::UserWidget ||= Vend::Config::map_widgets();
1345	$Vend::UserWidgetDefault ||= Vend::Config::map_widget_defaults();
1346
1347	my $sub =  $Vend::UserWidget->{$type};
1348	if(! $sub and $Global::AccumulateCode) {
1349		$sub = Vend::Config::code_from_file('Widget', $type)
1350			and $Vend::UserWidget->{$type} = $sub;
1351	}
1352
1353	# Last in case "default" widget is removed
1354	$sub ||= $Vend::UserWidget->{default} || \&template_sub;
1355
1356	if(my $attr = $Vend::UserWidgetDefault->{$type}) {
1357		while (my ($k, $v) = each %$attr) {
1358			next if defined $opt->{$k};
1359			$opt->{$k} = $v;
1360		}
1361	}
1362
1363	if($opt->{variant}) {
1364#::logDebug("variant='$opt->{variant}'");
1365		$opt->{subwidget}	=  $Vend::UserWidget->{$opt->{variant}}
1366							||  $Vend::UserWidget->{default};
1367	}
1368
1369	if(my $c = $opt->{check}) {
1370		$c = "$opt->{name}=$c" unless $c =~ /=/;
1371		HTML::Entities::encode($c);
1372		$opt->{append} .= qq{<input type="hidden" name="mv_individual_profile" value="$c">};
1373	}
1374
1375	if($opt->{js}) {
1376		$opt->{extra} ||= '';
1377		$opt->{extra} .= " $opt->{js}";
1378		$opt->{extra} =~ s/^\s+//;
1379	}
1380	return $sub->($opt, $data);
1381}
1382
1383sub parse_type {
1384	my $opt = shift;
1385	if(ref($opt) ne 'HASH') {
1386		warn "parse_type: needs passed hash reference";
1387		return $opt;
1388	}
1389
1390	my %alias = (qw/ datetime date_time /);
1391	my $type = $opt->{type} = lc($opt->{type}) || 'text';
1392	$type = $alias{$type} if $alias{$type};
1393	return $type if $type =~ /^[a-z][a-z0-9]*$/;
1394
1395	if($type =~ /^text/i) {
1396		my $cols;
1397		if ($type =~ /^textarea(?:_(\d+)_(\d+))?(_[a-z]+)?/i) {
1398			my $rows = $1 || $opt->{rows} || 4;
1399			$cols = $2 || $opt->{cols} || 40;
1400			$opt->{type} = 'textarea';
1401			$opt->{rows} = $rows;
1402			$opt->{cols} = $cols;
1403		}
1404		elsif("\L$type" =~ /^text_?(\d+)$/) {
1405			$opt->{cols} = $1;
1406			$opt->{type} = 'text';
1407		}
1408		else {
1409			$opt->{type} = 'text';
1410		}
1411	}
1412	elsif($type =~ /^(date|time)(.*)/i) {
1413		$opt->{type} = lc $1;
1414		my $extra = $2;
1415		if ($extra) {
1416			$opt->{time} = 1 if $extra =~ /time/i;
1417			$opt->{ampm} = 1 if $extra =~ /ampm/i;
1418			$opt->{blank} = 1 if $extra =~ /blank/i;
1419			($extra =~ /\(\s*(\s*\d+\s*(,\s*\d+\s*)+)\s*\)/i
1420					and $opt->{minutes} = $1)
1421			  or
1422			($extra =~ /half/i and $opt->{minutes} = 'half_hourly')
1423			  or
1424			($extra =~ /hourly/i and $opt->{minutes} = 'hourly')
1425			  or
1426			($extra =~ /tens/i and $opt->{minutes} = 'tens')
1427			;
1428			if($extra =~ s/(\d+)-(\d+)//) {
1429				$opt->{start_hour} = $1;
1430				$opt->{end_hour} = $2;
1431			}
1432			$opt->{time_adjust} = $1
1433				if $extra =~ /([+-]?\d+)/i;
1434		}
1435#::logDebug("minutes=$opt->{minutes}");
1436	}
1437	elsif($type =~ /^hidden_text/i) {
1438		$opt->{type} = 'hiddentext';
1439	}
1440	elsif($type =~ /^password/i) {
1441		$type =~ /(\d+)/ and $opt->{cols} = $1;
1442		$opt->{type} = 'password';
1443	}
1444	# Ranging type, for price breaks based on quantity
1445	elsif ($type =~ s/^range:?(.*)//) {
1446		my $select = $1 || 'quantity';
1447		$opt->{type} = 'range';
1448		my $default;
1449		$opt->{default} = $opt->{item}{$select}
1450			 if $opt->{item};
1451	}
1452	elsif ($type =~ /^(radio|check)/i) {
1453		$opt->{type} = 'box';
1454		if ($type =~ /check/i) {
1455			$opt->{type} = 'checkbox';
1456		}
1457		else {
1458			$opt->{type} = 'radio';
1459		}
1460
1461		if ($type  =~ /font(?:size)?[\s_]*(-?\d)/i ) {
1462			$opt->{fontsize} = $1;
1463		}
1464
1465		if($type =~ /nbsp/i) {
1466			$opt->{nbsp} = 1;
1467		}
1468		elsif ($type  =~ /left[\s_]*(\d*)/i ) {
1469			$opt->{breakmod} = $1;
1470			$opt->{left} = 1;
1471		}
1472		elsif ($type  =~ /right[\s_]*(\d*)/i ) {
1473			$opt->{breakmod} = $1;
1474			$opt->{right} = 1;
1475		}
1476	}
1477	elsif($type =~ /^combo[ _]*(?:(\d+)(?:[ _]+(\d+))?)?/i) {
1478		$opt->{rows} = $opt->{rows} || $1 || 1;
1479		$opt->{cols} = $opt->{cols} || $2 || 16;
1480		$opt->{type} = 'combo';
1481	}
1482	elsif($type =~ /^fillin_combo[ _]*(?:(\d+)(?:[ _]+(\d+))?)?/i) {
1483		$opt->{rows} ||= $1;
1484		$opt->{cols} ||= $2;
1485		$opt->{type} = 'combo';
1486		$opt->{textarea} = 1;
1487		$opt->{reverse} = 1;
1488		$opt->{conditional_text} = 1;
1489	}
1490	elsif($type =~ /^reverse_combo[ _]*(?:(\d+)(?:[ _]+(\d+))?)?/i) {
1491		$opt->{rows} = $opt->{rows} || $1 || 1;
1492		$opt->{cols} = $opt->{cols} || $2 || 16;
1493		$opt->{type} = 'combo';
1494		$opt->{reverse} = 1;
1495	}
1496	elsif($type =~ /^links_*nbsp/i) {
1497		$opt->{nbsp} = 1;
1498		$opt->{type} = 'links';
1499	}
1500	elsif($type =~ /^move_*combo[ _]*(?:(\d+)(?:[ _]+(\d+))?)?/i) {
1501		$opt->{rows} = $opt->{rows} || $opt->{height} || $1 || 1;
1502		$opt->{cols} = $opt->{cols} || $opt->{width} || $2 || 16;
1503		$opt->{type} = 'movecombo';
1504		$opt->{replace} = 1 if $type =~ /replace/;
1505	}
1506	elsif($type =~ /multi/i) {
1507		$opt->{type} = 'select';
1508		$opt->{multiple} = 1;
1509		$type =~ /.*?multiple\s+(.*)/
1510			and $opt->{extra} ||= $1;
1511	}
1512	elsif($type =~ /^yesno/i) {
1513		$type =~ s/^yesno[_\s]+//;
1514		$opt->{type}    = 'yesno';
1515		$type =~ s/\W+//g;
1516		$opt->{variant} = $type =~ /radio/ ? 'radio' : $type;
1517	}
1518	elsif($type =~ /^noyes/i) {
1519		$type =~ s/^noyes[_\s]+//;
1520		$opt->{type}    = 'noyes';
1521		$type =~ s/\W+//g;
1522		$opt->{variant} = $type =~ /radio/ ? 'radio' : $type;
1523	}
1524
1525	return $opt->{type};
1526}
1527
15281;
1529