cgi-bin/htmlcontrols.pl

   1 #!/usr/bin/perl
   2 #
   3
   4 package LJ;
   5
   6 use strict;
   7
   8 # <LJFUNC>
   9 # name: LJ::html_datetime
  10 # class: component
  11 # des: Creates date and time control HTML form elements.
  12 # info: Parse output later with [func[LJ::html_datetime_decode]].
  13 # args:
  14 # des-:
  15 # returns:
  16 # </LJFUNC>
  17 sub html_datetime
  18 {
  19     my $opts = shift;
  20     my $lang = $opts->{'lang'} || "EN";
  21     my ($yyyy, $mm, $dd, $hh, $nn, $ss);
  22     my $ret;
  23     my $name = $opts->{'name'};
  24     my $id = $opts->{'id'};
  25     my $disabled = $opts->{'disabled'} ? 1 : 0;
  26
  27     my %extra_opts;
  28     foreach (grep { ! /^(name|id|disabled|seconds|notime|lang|default)$/ } keys %$opts) {
  29         $extra_opts{$_} = $opts->{$_};
  30     }
  31
  32     if ($opts->{'default'} =~ /^(\d\d\d\d)-(\d\d)-(\d\d)(?: (\d\d):(\d\d):(\d\d))?/) {
  33         ($yyyy, $mm, $dd, $hh, $nn, $ss) = ($1 > 0 ? $1 : "",
  34                                             $2+0,
  35                                             $3 > 0 ? $3+0 : "",
  36                                             $4 > 0 ? $4 : "",
  37                                             $5 > 0 ? $5 : "",
  38                                             $6 > 0 ? $6 : "");
  39     }
  40     $ret .= html_select({ 'name' => "${name}_mm", 'id' => "${id}_mm", 'selected' => $mm, 'class' => 'select',
  41                           'disabled' => $disabled, %extra_opts },
  42                          map { $_, LJ::Lang::ml(LJ::Lang::month_long_langcode($_)) } (1..12));
  43     $ret .= html_text({ 'name' => "${name}_dd", 'id' => "${id}_dd", 'size' => '2', 'class' => 'text',
  44                         'maxlength' => '2', 'value' => $dd,
  45                         'disabled' => $disabled, %extra_opts });
  46     $ret .= html_text({ 'name' => "${name}_yyyy", 'id' => "${id}_yyyy", 'size' => '4', 'class' => 'text',
  47                         'maxlength' => '4', 'value' => $yyyy,
  48                         'disabled' => $disabled, %extra_opts });
  49     unless ($opts->{'notime'}) {
  50         $ret .= ' ';
  51         $ret .= html_text({ 'name' => "${name}_hh", 'id' => "${id}_hh", 'size' => '2',
  52                             'maxlength' => '2', 'value' => $hh,
  53                             'disabled' => $disabled }) . ':';
  54         $ret .= html_text({ 'name' => "${name}_nn", 'id' => "${id}_nn", 'size' => '2',
  55                             'maxlength' => '2', 'value' => $nn,
  56                             'disabled' => $disabled });
  57         if ($opts->{'seconds'}) {
  58             $ret .= ':';
  59             $ret .= html_text({ 'name' => "${name}_ss", 'id' => "${id}_ss", 'size' => '2',
  60                                 'maxlength' => '2', 'value' => $ss,
  61                                 'disabled' => $disabled });
  62         }
  63     }
  64
  65     return $ret;
  66 }
  67
  68 # <LJFUNC>
  69 # name: LJ::html_datetime_decode
  70 # class: component
  71 # des: Parses output of HTML form controls generated by [func[LJ::html_datetime]].
  72 # info:
  73 # args:
  74 # des-:
  75 # returns:
  76 # </LJFUNC>
  77 sub html_datetime_decode
  78 {
  79     my $opts = shift;
  80     my $hash = shift;
  81     my $name = $opts->{'name'};
  82     return sprintf("%04d-%02d-%02d %02d:%02d:%02d",
  83                    $hash->{"${name}_yyyy"},
  84                    $hash->{"${name}_mm"},
  85                    $hash->{"${name}_dd"},
  86                    $hash->{"${name}_hh"},
  87                    $hash->{"${name}_nn"},
  88                    $hash->{"${name}_ss"});
  89 }
  90
  91 # <LJFUNC>
  92 # name: LJ::html_select
  93 # class: component
  94 # des: Creates a drop-down box or listbox HTML form element (the <select> tag).
  95 # info:
  96 # args: opts
  97 # des-opts: A hashref of options. Special options are:
  98 #           'raw' - inserts value unescaped into select tag;
  99 #           'noescape' - won't escape key values if set to 1;
 100 #           'disabled' - disables the element;
 101 #           'include_ids' - bool. If true, puts id attributes on each element in the drop-down.
 102 #           ids are off by default, to reduce page sizes with large drop-down menus;
 103 #           'multiple' - creates a drop-down if 0, a multi-select listbox if 1;
 104 #           'selected' - if multiple, an arrayref of selected values; otherwise,
 105 #           a scalar equalling the selected value;
 106 #           All other options will be treated as HTML attribute/value pairs.
 107 # returns: The generated HTML.
 108 # </LJFUNC>
 109 sub html_select
 110 {
 111     my $opts = shift;
 112     my @items = @_;
 113     my $ehtml = $opts->{'noescape'} ? 0 : 1;
 114     my $ret;
 115     $ret .= "<select";
 116     $ret .= " $opts->{'raw'}" if $opts->{'raw'};
 117     $ret .= " disabled='disabled'" if $opts->{'disabled'};
 118     $ret .= " multiple='multiple'" if $opts->{'multiple'};
 119     foreach (grep { ! /^(raw|disabled|selected|noescape|multiple)$/ } keys %$opts) {
 120         $ret .= " $_=\"" . ($ehtml ? ehtml($opts->{$_}) : $opts->{$_}) . "\"";
 121     }
 122     $ret .= ">\n";
 123
 124     # build hashref from arrayref if multiple selected
 125     my $selref = undef;
 126     $selref = { map { $_, 1 } @{$opts->{'selected'}} }
 127         if $opts->{'multiple'} && ref $opts->{'selected'} eq 'ARRAY';
 128
 129     my $did_sel = 0;
 130     while (defined (my $value = shift @items)) {
 131
 132         # items can be either pairs of $value, $text or a list of $it hashrefs (or a mix)
 133         my $it = {};
 134         my $text;
 135         my $js_data;
 136         if (ref $value) {
 137             $it = $value;
 138             $value = $it->{value};
 139             $text = $it->{text};
 140             $js_data = $it->{js_data};
 141         } else {
 142             $text = shift @items;
 143         }
 144
 145         if (ref $text) {
 146             my @sub_items = @$text;
 147
 148             $ret .= "<optgroup label='$value'>";
 149
 150             while (defined (my $value = shift @sub_items)) {
 151                 my $it = {};
 152                 my $text;
 153
 154                 if (ref $value) {
 155                     $it = $value;
 156                     $value = $it->{value};
 157                     $text = $it->{text};
 158                 } else {
 159                     $text = shift @sub_items;
 160                 }
 161
 162                 my $sel = "";
 163                 # multiple-mode or single-mode?
 164                 if (ref $selref eq 'HASH' && $selref->{$value} ||
 165                     $opts->{'selected'} eq $value && !$did_sel++) {
 166
 167                     $sel = " selected='selected'";
 168                 }
 169                 $value  = $ehtml ? ehtml($value) : $value;
 170
 171                 my $id;
 172                 if ($opts->{'include_ids'} && $opts->{'name'} ne "" && $value ne "") {
 173                     $id = " id='$opts->{'name'}_$value'";
 174                 }
 175
 176                 # is this individual option disabled?
 177                 my $dis = $it->{'disabled'} ? " disabled='disabled' style='color: #999;'" : '';
 178
 179                 $ret .= "<option value=\"$value\"$id$sel$dis>" .
 180                           ($ehtml ? ehtml($text) : $text) . "</option>\n";
 181             }
 182
 183             $ret .= "</optgroup>";
 184         } else { # non-grouped options
 185             my $sel = "";
 186             # multiple-mode or single-mode?
 187             if (ref $selref eq 'HASH' && $selref->{$value} ||
 188             $opts->{'selected'} eq $value && !$did_sel++) {
 189
 190                 $sel = " selected='selected'";
 191             }
 192             $value  = $ehtml ? ehtml($value) : $value;
 193
 194             my $id;
 195             if ($opts->{'include_ids'} && $opts->{'name'} ne "" && $value ne "") {
 196                 $id = " id='$opts->{'name'}_$value'";
 197             }
 198
 199             # is this individual option disabled?
 200             my $dis = $it->{'disabled'} ? " disabled='disabled' style='color: #999;'" : '';
 201
 202             $ret .= "<option value=\"$value\"$id$sel$dis $js_data>" .
 203                       ($ehtml ? ehtml($text) : $text) . "</option>\n";
 204         }
 205     }
 206     $ret .= "</select>";
 207     return $ret;
 208 }
 209
 210 # <LJFUNC>
 211 # name: LJ::html_check
 212 # class: component
 213 # des: Creates HTML checkbox button, and radio button controls.
 214 # info: Labels for checkboxes are through LJ::labelfy.
 215 #       It does this safely, by not including any HTML elements in the label tag.
 216 # args: type, opts
 217 # des-type: Valid types are 'radio' or 'checkbox'.
 218 # des-opts: A hashref of options. Special options are:
 219 #           'disabled' - disables the element;
 220 #           'selected' - if multiple, an arrayref of selected values; otherwise,
 221 #           a scalar equalling the selected value;
 222 #           'raw' - inserts value unescaped into select tag;
 223 #           'noescape' - won't escape key values if set to 1;
 224 #           'label' - label for checkbox;
 225 # returns:
 226 # </LJFUNC>
 227 sub html_check
 228 {
 229     my $opts = shift;
 230
 231     my $disabled = $opts->{'disabled'} ? " disabled='disabled'" : "";
 232     my $ehtml = $opts->{'noescape'} ? 0 : 1;
 233     my $ret;
 234     if ($opts->{'type'} eq "radio") {
 235         $ret .= "<input type='radio'";
 236     } else {
 237         $ret .= "<input type='checkbox'";
 238     }
 239     if ($opts->{'selected'}) { $ret .= " checked='checked'"; }
 240     if ($opts->{'raw'}) { $ret .= " $opts->{'raw'}"; }
 241     foreach (grep { ! /^(disabled|type|selected|raw|noescape|label)$/ } keys %$opts) {
 242         $ret .= " $_=\"" . ($ehtml ? ehtml($opts->{$_}) : $opts->{$_}) . "\"" if $_;
 243     }
 244     $ret .= "$disabled />";
 245     my $e_label = ($ehtml ? ehtml($opts->{'label'}) : $opts->{'label'});
 246     $e_label = LJ::labelfy($opts->{id}, $e_label);
 247     $ret .= $e_label if $opts->{'label'};
 248     return $ret;
 249 }
 250
 251 # given a string and an id, return the string
 252 # in a label, respecting HTML
 253 sub labelfy {
 254     my ($id, $text) = @_;
 255
 256     $text =~ s!
 257         ^([^<]+)
 258         !
 259         <label for="$id">
 260             $1
 261         </label>
 262         !x;
 263
 264     return $text;
 265 }
 266
 267 # <LJFUNC>
 268 # name: LJ::html_text
 269 # class: component
 270 # des: Creates a text input field, for single-line input.
 271 # info: Allows 'type' =&gt; 'password' flag.
 272 # args:
 273 # des-:
 274 # returns: The generated HTML.
 275 # </LJFUNC>
 276 sub html_text
 277 {
 278     my $opts = shift;
 279
 280     my $disabled = $opts->{'disabled'} ? " disabled='disabled'" : "";
 281     my $ehtml = $opts->{'noescape'} ? 0 : 1;
 282     my $type = $opts->{'type'} eq 'password' || $opts->{'type'} eq 'search' ? $opts->{'type'} : 'text';
 283     my $ret;
 284     $ret .= "<input type=\"$type\"";
 285     foreach (grep { ! /^(type|disabled|raw|noescape)$/ } keys %$opts) {
 286         $ret .= " $_=\"" . ($ehtml ? ehtml($opts->{$_}) : $opts->{$_}) . "\"";
 287     }
 288     if ($opts->{'raw'}) { $ret .= " $opts->{'raw'}"; }
 289     $ret .= "$disabled />";
 290     return $ret;
 291 }
 292
 293 # <LJFUNC>
 294 # name: LJ::html_textarea
 295 # class: component
 296 # des: Creates a text box for multi-line input (the <textarea> tag).
 297 # info:
 298 # args:
 299 # des-:
 300 # returns: The generated HTML.
 301 # </LJFUNC>
 302 sub html_textarea
 303 {
 304     my $opts = shift;
 305
 306     my $disabled = $opts->{'disabled'} ? " disabled='disabled'" : "";
 307     my $ehtml = $opts->{'noescape'} ? 0 : 1;
 308     my $ret;
 309     $ret .= "<textarea";
 310     foreach (grep { ! /^(disabled|raw|value|noescape)$/ } keys %$opts) {
 311         $ret .= " $_=\"" . ($ehtml ? ehtml($opts->{$_}) : $opts->{$_}) . "\"";
 312     }
 313     if ($opts->{'raw'}) { $ret .= " $opts->{'raw'}"; }
 314     $ret .= "$disabled>" . ($ehtml ? ehtml($opts->{'value'}) : $opts->{'value'}) . "</textarea>";
 315     return $ret;
 316 }
 317
 318 # <LJFUNC>
 319 # name: LJ::html_color
 320 # class: component
 321 # des: A text field with attached color preview and button to choose a color.
 322 # info: Depends on the client-side Color Picker.
 323 # args: opts
 324 # des-opts: Valid options are: 'onchange' argument, which happens when
 325 #           color picker button is clicked, or when focus is changed to text box;
 326 #           'disabled'; and 'raw' , for unescaped input.
 327 # returns:
 328 # </LJFUNC>
 329 sub html_color
 330 {
 331     my $opts = shift;
 332
 333     my $htmlname = ehtml($opts->{'name'});
 334     my $des = ehtml($opts->{'des'}) || "Pick a Color";
 335     my $ret;
 336
 337     ## Output the preview box and picker button with script so that
 338     ## they don't appear when JavaScript is unavailable.
 339     $ret .= "<script language=\"JavaScript\"><!--\n".
 340             "document.write('<span style=\"border: 1px solid #000000; ".
 341             "padding-left: 2em; background-color: " . ehtml($opts->{'default'}) . ";\" ".
 342             "id=\"${htmlname}_disp\"";
 343             if ($opts->{no_btn}) {
 344                 $ret .= " onclick=\"spawnPicker(findel(\\'${htmlname}\\')," .
 345                         "findel(\\'${htmlname}_disp\\'),\\'$des\\'); " .
 346                         LJ::ejs($opts->{'onchange'}) .
 347                         " return false;\"";
 348             }
 349     $ret .= ">&nbsp;</span>'); ".
 350             "\n--></script>\n";
 351
 352     # 'onchange' argument happens when color picker button is clicked,
 353     # or when focus is changed to text box
 354
 355     $ret .= html_text({ 'size' => 8, 'maxlength' => 7, 'name' => $htmlname, 'id' => $htmlname,
 356                         'onchange' => "setBGColorWithId(findel('${htmlname}_disp'),'${htmlname}');",
 357                         'onfocus' => $opts->{'onchange'},
 358                         'disabled' => $opts->{'disabled'}, 'value' => $opts->{'default'},
 359                         'noescape' => 1, 'raw' => $opts->{'raw'},
 360                       });
 361
 362     unless ($opts->{no_btn}) {
 363         my $disabled = $opts->{'disabled'} ? "disabled=\'disabled\'" : '';
 364         $ret .= "<script language=\"JavaScript\"><!--\n".
 365                 "document.write('<button ".
 366                 "onclick=\"spawnPicker(findel(\\'${htmlname}\\')," .
 367                 "findel(\\'${htmlname}_disp\\'),\\'$des\\'); " .
 368                 LJ::ejs($opts->{'onchange'}) .
 369                 " return false;\"$disabled>Choose...</button>'); ".
 370                 "\n--></script>\n";
 371     }
 372
 373     # A little help for the non-JavaScript folks
 374     $ret .= "<noscript> (#<var>rr</var><var>gg</var><var>bb</var>)</noscript>";
 375
 376     return $ret;
 377 }
 378
 379 # <LJFUNC>
 380 # name: LJ::html_hidden
 381 # class: component
 382 # des: Makes the HTML for a hidden form element.
 383 # args: name, val, opts
 384 # des-name: Name of form element (will be HTML escaped).
 385 # des-val: Value of form element (will be HTML escaped).
 386 # des-opts: Can optionally take arguments that are hashrefs
 387 #           and extract name/value/other standard keys from that. Can also be
 388 #           mixed with the older style key/value array calling format.
 389 # returns: HTML
 390 # </LJFUNC>
 391 sub html_hidden
 392 {
 393     my $ret;
 394
 395     while (@_) {
 396         my $name = shift;
 397         my $val;
 398         my $ehtml = 1;
 399         my $extra;
 400         if (ref $name eq 'HASH') {
 401             my $opts = $name;
 402
 403             $val = $opts->{value};
 404             $name = $opts->{name};
 405
 406             $ehtml = $opts->{'noescape'} ? 0 : 1;
 407             foreach (grep { ! /^(name|value|raw|noescape)$/ } keys %$opts) {
 408                 $extra .= " $_=\"" . ($ehtml ? ehtml($opts->{$_}) : $opts->{$_}) . "\"";
 409             }
 410
 411             $extra .= " $opts->{'raw'}" if $opts->{'raw'};
 412
 413         } else {
 414             $val = shift;
 415         }
 416
 417         $ret .= "<input type='hidden'";
 418         # allow override of these in 'raw'
 419         $ret .= " name=\"" . ($ehtml ? ehtml($name) : $name) . "\"" if $name;
 420         $ret .= " value=\"" . ($ehtml ? ehtml($val) : $val) . "\"" if defined $val;
 421         $ret .= "$extra />";
 422     }
 423     return $ret;
 424 }
 425
 426 # <LJFUNC>
 427 # name: LJ::html_submit
 428 # class: component
 429 # des: Makes the HTML for a submit button.
 430 # info: If only one argument is given it is
 431 #       assumed LJ::html_submit(undef, 'value') was meant.
 432 # args: name, val, opts?, type
 433 # des-name: Name of form element (will be HTML escaped).
 434 # des-val: Value of form element, and label of button (will be HTML escaped).
 435 # des-opts: Optional hashref of additional tag attributes.
 436 #           A hashref of options. Special options are:
 437 #           'raw' - inserts value unescaped into select tag;
 438 #           'disabled' - disables the element;
 439 #           'noescape' - won't escape key values if set to 1;
 440 # des-type: Optional. Value format is type =&gt; (submit|reset). Defaults to submit.
 441 # returns: HTML
 442 # </LJFUNC>
 443 sub html_submit
 444 {
 445     my ($name, $val, $opts) = @_;
 446
 447     # if one argument, assume (undef, $val)
 448     if (@_ == 1) {
 449         $val = $name;
 450         $name = undef;
 451     }
 452
 453     my ($eopts, $disabled, $raw);
 454     my $type = 'submit';
 455
 456     my $ehtml;
 457     if ($opts && ref $opts eq 'HASH') {
 458         $disabled = " disabled='disabled'" if $opts->{'disabled'};
 459         $raw = " $opts->{'raw'}" if $opts->{'raw'};
 460         $type = 'reset' if $opts->{'type'} eq 'reset';
 461
 462         $ehtml = $opts->{'noescape'} ? 0 : 1;
 463         foreach (grep { ! /^(raw|disabled|noescape|type)$/ } keys %$opts) {
 464             $eopts .= " $_=\"" . ($ehtml ? ehtml($opts->{$_}) : $opts->{$_}) . "\"";
 465         }
 466     }
 467     my $ret = "<input type='$type'";
 468     # allow override of these in 'raw'
 469     $ret .= " name=\"" . ($ehtml ? ehtml($name) : $name) . "\"" if $name;
 470     $ret .= " value=\"" . ($ehtml ? ehtml($val) : $val) . "\"" if defined $val;
 471     $ret .= "$eopts$raw$disabled />";
 472     return $ret;
 473 }
 474
 475 1;