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(> {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(> {TTITLE?}<span title="{TTITLE}">{/TTITLE?}{TLABEL}{TTITLE?}</span>{/TTITLE?} ) 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/"/"/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/ /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/"/"/g; 614 $lab =~ s/"/"/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/"/"/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 .= " ($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/ / /g if $xlt; 998 } 999 else { 1000 $label =~ s/ / /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/[/\[/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