SL/Presenter/Tag.pm

   1 package SL::Presenter::Tag;
   2
   3 use strict;
   4
   5 use SL::HTML::Restrict;
   6 use SL::Presenter::EscapedText qw(escape);
   7 use Scalar::Util qw(blessed);
   8
   9 use Exporter qw(import);
  10 our @EXPORT_OK = qw(
  11   html_tag input_tag hidden_tag javascript man_days_tag name_to_id select_tag
  12   checkbox_tag button_tag submit_tag ajax_submit_tag input_number_tag
  13   stringify_attributes restricted_html textarea_tag link_tag date_tag
  14   div_tag radio_button_tag img_tag);
  15 our %EXPORT_TAGS = (ALL => \@EXPORT_OK);
  16
  17 use Carp;
  18
  19 my %_valueless_attributes = map { $_ => 1 } qw(
  20   checked compact declare defer disabled ismap multiple noresize noshade nowrap
  21   readonly selected hidden
  22 );
  23
  24 my %_singleton_tags = map { $_ => 1 } qw(
  25   area base br col command embed hr img input keygen link meta param source
  26   track wbr
  27 );
  28
  29 sub _call_on {
  30   my ($object, $method, @params) = @_;
  31   return $object->$method(@params);
  32 }
  33
  34 { # This will give you an id for identifying html tags and such.
  35   # It's guaranteed to be unique unless you exceed 10 mio calls per request.
  36   # Do not use these id's to store information across requests.
  37 my $_id_sequence = int rand 1e7;
  38 sub _id {
  39   return ( $_id_sequence = ($_id_sequence + 1) % 1e7 );
  40 }
  41 }
  42
  43 sub _J {
  44   my $string = shift;
  45   $string    =~ s/(\"|\'|\\)/\\$1/g;
  46   return $string;
  47 }
  48
  49 sub stringify_attributes {
  50   my (%params) = @_;
  51
  52   my @result = ();
  53   while (my ($name, $value) = each %params) {
  54     next unless $name;
  55     next if $_valueless_attributes{$name} && !$value;
  56     $value = '' if !defined($value);
  57     push @result, $_valueless_attributes{$name} ? escape($name) : escape($name) . '="' . escape($value) . '"';
  58   }
  59
  60   return @result ? ' ' . join(' ', @result) : '';
  61 }
  62
  63 sub html_tag {
  64   my ($tag, $content, %params) = @_;
  65   my $attributes = stringify_attributes(%params);
  66
  67   return "<${tag}${attributes}>" if !defined($content) && $_singleton_tags{$tag};
  68   return "<${tag}${attributes}>${content}</${tag}>";
  69 }
  70
  71 sub input_tag {
  72   my ($name, $value, %attributes) = @_;
  73
  74   _set_id_attribute(\%attributes, $name);
  75   $attributes{type} ||= 'text';
  76
  77   html_tag('input', undef, %attributes, name => $name, value => $value);
  78 }
  79
  80 sub hidden_tag {
  81   my ($name, $value, %attributes) = @_;
  82   input_tag($name, $value, %attributes, type => 'hidden');
  83 }
  84
  85 sub man_days_tag {
  86   my ($name, $object, %attributes) = @_;
  87
  88   my $size           =  delete($attributes{size})   || 5;
  89   my $method         =  $name;
  90   $method            =~ s/^.*\.//;
  91
  92   my $time_selection = input_tag("${name}_as_man_days_string", _call_on($object, "${method}_as_man_days_string"), %attributes, size => $size);
  93   my $unit_selection = select_tag("${name}_as_man_days_unit",   [[ 'h', $::locale->text('h') ], [ 'man_day', $::locale->text('MD') ]],
  94                                           %attributes, default => _call_on($object, "${method}_as_man_days_unit"));
  95
  96   return $time_selection . $unit_selection;
  97 }
  98
  99 sub name_to_id {
 100   my ($name) = @_;
 101
 102   $name =~ s/\[\+?\]/ _id() /ge; # give constructs with [] or [+] unique ids
 103   $name =~ s/[^\w_]/_/g;
 104   $name =~ s/_+/_/g;
 105
 106   return $name;
 107 }
 108
 109 sub select_tag {
 110   my ($name, $collection, %attributes) = @_;
 111
 112   _set_id_attribute(\%attributes, $name);
 113
 114   $collection         = [] if defined($collection) && !ref($collection) && ($collection eq '');
 115
 116   my $with_filter     = delete($attributes{with_filter});
 117   my $fil_placeholder = delete($attributes{filter_placeholder});
 118   my $value_key       = delete($attributes{value_key})   || 'id';
 119   my $title_key       = delete($attributes{title_key})   || $value_key;
 120   my $default_key     = delete($attributes{default_key}) || 'selected';
 121   my $default_val_key = delete($attributes{default_value_key});
 122   my $default_coll    = delete($attributes{default});
 123
 124   my $value_title_sub = delete($attributes{value_title_sub});
 125
 126   my $value_sub       = delete($attributes{value_sub});
 127   my $title_sub       = delete($attributes{title_sub});
 128   my $default_sub     = delete($attributes{default_sub});
 129
 130   my $with_empty      = delete($attributes{with_empty});
 131   my $empty_title     = delete($attributes{empty_title});
 132
 133   my $with_optgroups  = delete($attributes{with_optgroups});
 134
 135   undef $default_key if $default_sub || $default_val_key;
 136
 137   my $normalize_entry = sub {
 138     my ($type, $entry, $sub, $key) = @_;
 139
 140     return $sub->($entry) if $sub;
 141
 142     my $ref = ref($entry);
 143
 144     if ( !$ref ) {
 145       return $entry if $type eq 'value' || $type eq 'title';
 146       return 0;
 147     }
 148
 149     if ( $ref eq 'ARRAY' ) {
 150       return $entry->[ $type eq 'value' ? 0 : $type eq 'title' ? 1 : 2 ];
 151     }
 152
 153     return $entry->{$key} if $ref  eq 'HASH';
 154     return $entry->$key   if $type ne 'default' || $entry->can($key);
 155     return undef;
 156   };
 157
 158   my %selected;
 159   if (defined($default_coll) && !ref $default_coll) {
 160     %selected = ($default_coll => 1);
 161
 162   } elsif (ref($default_coll) eq 'HASH') {
 163     %selected = %{ $default_coll };
 164
 165   } elsif ($default_coll) {
 166     $default_coll = [ $default_coll ] unless 'ARRAY' eq ref $default_coll;
 167
 168     %selected = $default_val_key ? map({ ($normalize_entry->('value', $_, undef, $default_val_key) => 1) } @{ $default_coll })
 169               :                    map({ ($_                                                       => 1) } @{ $default_coll });
 170   }
 171
 172   my $list_to_code = sub {
 173     my ($sub_collection) = @_;
 174
 175     if ('ARRAY' ne ref $sub_collection) {
 176       $sub_collection = [ $sub_collection ];
 177     }
 178
 179     my @options;
 180     foreach my $entry ( @{ $sub_collection } ) {
 181       my $value;
 182       my $title;
 183
 184       if ( $value_title_sub ) {
 185         ($value, $title) = @{ $value_title_sub->($entry) };
 186       } else {
 187
 188         $value = $normalize_entry->('value', $entry, $value_sub, $value_key);
 189         $title = $normalize_entry->('title', $entry, $title_sub, $title_key);
 190       }
 191
 192       my $default = $default_key ? $normalize_entry->('default', $entry, $default_sub, $default_key) : 0;
 193
 194       push(@options, [$value, $title, $selected{$value} || $default]);
 195     }
 196
 197     return join '', map { html_tag('option', escape($_->[1]), value => $_->[0], selected => $_->[2]) } @options;
 198   };
 199
 200   my $code  = '';
 201   $code    .= html_tag('option', escape($empty_title || ''), value => '') if $with_empty;
 202
 203   if (!$with_optgroups) {
 204     $code .= $list_to_code->($collection);
 205
 206   } else {
 207     $code .= join '', map {
 208       my ($optgroup_title, $sub_collection) = @{ $_ };
 209       html_tag('optgroup', $list_to_code->($sub_collection), label => $optgroup_title)
 210     } @{ $collection };
 211   }
 212
 213   my $select_html = html_tag('select', $code, %attributes, name => $name);
 214
 215   if ($with_filter) {
 216     my $input_style;
 217
 218     if (($attributes{style} // '') =~ m{width: *(\d+) *px}i) {
 219       $input_style = "width: " . ($1 - 22) . "px";
 220     }
 221
 222     my $input_html = html_tag(
 223       'input', undef,
 224       autocomplete     => 'off',
 225       type             => 'text',
 226       id               => $attributes{id} . '_filter',
 227       'data-select-id' => $attributes{id},
 228       (placeholder     => $fil_placeholder) x !!$fil_placeholder,
 229       (style           => $input_style)     x !!$input_style,
 230     );
 231     $select_html = html_tag('div', $input_html . $select_html, class => "filtered_select");
 232   }
 233
 234   return $select_html;
 235 }
 236
 237 sub checkbox_tag {
 238   my ($name, %attributes) = @_;
 239
 240   _set_id_attribute(\%attributes, $name);
 241
 242   $attributes{value}   = 1 unless defined $attributes{value};
 243   my $label            = delete $attributes{label};
 244   my $checkall         = delete $attributes{checkall};
 245   my $for_submit       = delete $attributes{for_submit};
 246
 247   if ($attributes{checked}) {
 248     $attributes{checked} = 'checked';
 249   } else {
 250     delete $attributes{checked};
 251   }
 252
 253   my $code  = '';
 254   $code    .= hidden_tag($name, 0, %attributes, id => $attributes{id} . '_hidden') if $for_submit;
 255   $code    .= html_tag('input', undef,  %attributes, name => $name, type => 'checkbox');
 256   $code    .= html_tag('label', $label, for => $attributes{id}) if $label;
 257   $code    .= javascript(qq|\$('#$attributes{id}').checkall('$checkall');|) if $checkall;
 258
 259   return $code;
 260 }
 261
 262 sub radio_button_tag {
 263   my ($name, %attributes) = @_;
 264
 265   $attributes{value}   = 1 unless exists $attributes{value};
 266
 267   _set_id_attribute(\%attributes, $name, 1);
 268   my $label            = delete $attributes{label};
 269
 270   _set_id_attribute(\%attributes, $name . '_' . $attributes{value});
 271
 272   if ($attributes{checked}) {
 273     $attributes{checked} = 'checked';
 274   } else {
 275     delete $attributes{checked};
 276   }
 277
 278   my $code  = html_tag('input', undef,  %attributes, name => $name, type => 'radio');
 279   $code    .= html_tag('label', $label, for => $attributes{id}) if $label;
 280
 281   return $code;
 282 }
 283
 284 sub button_tag {
 285   my ($onclick, $value, %attributes) = @_;
 286
 287   _set_id_attribute(\%attributes, $attributes{name}) if $attributes{name};
 288   $attributes{type} ||= 'button';
 289
 290   $onclick = 'if (!confirm("'. _J(delete($attributes{confirm})) .'")) return false; ' . $onclick if $attributes{confirm};
 291
 292   html_tag('input', undef, %attributes, value => $value, onclick => $onclick);
 293 }
 294
 295 sub submit_tag {
 296   my ($name, $value, %attributes) = @_;
 297
 298   _set_id_attribute(\%attributes, $attributes{name}) if $attributes{name};
 299
 300   if ( $attributes{confirm} ) {
 301     $attributes{onclick} = 'return confirm("'. _J(delete($attributes{confirm})) .'");';
 302   }
 303
 304   input_tag($name, $value, %attributes, type => 'submit', class => 'submit');
 305 }
 306
 307 sub ajax_submit_tag {
 308   my ($url, $form_selector, $text, %attributes) = @_;
 309
 310   $url           = _J($url);
 311   $form_selector = _J($form_selector);
 312   my $onclick    = qq|kivi.submit_ajax_form('${url}', '${form_selector}')|;
 313
 314   button_tag($onclick, $text, %attributes);
 315 }
 316
 317 sub input_number_tag {
 318   my ($name, $value, %params) = @_;
 319
 320   _set_id_attribute(\%params, $name);
 321   my @onchange = $params{onchange} ? (onChange => delete $params{onchange}) : ();
 322   my @classes  = ('numeric');
 323   push @classes, delete($params{class}) if $params{class};
 324   my %class    = @classes ? (class => join(' ', @classes)) : ();
 325
 326   $::request->layout->add_javascripts('kivi.Validator.js');
 327   $::request->presenter->need_reinit_widgets($params{id});
 328
 329   input_tag(
 330     $name, $::form->format_amount(\%::myconfig, $value, $params{precision}),
 331     "data-validate" => "number",
 332     %params,
 333     %class, @onchange,
 334   );
 335 }
 336
 337
 338 sub javascript {
 339   my ($data) = @_;
 340   html_tag('script', $data, type => 'text/javascript');
 341 }
 342
 343 sub _set_id_attribute {
 344   my ($attributes, $name, $unique) = @_;
 345
 346   if (!delete($attributes->{no_id}) && !$attributes->{id}) {
 347     $attributes->{id}  = name_to_id($name);
 348     $attributes->{id} .= '_' . $attributes->{value} if $unique;
 349   }
 350
 351   %{ $attributes };
 352 }
 353
 354 my $html_restricter;
 355
 356 sub restricted_html {
 357   my ($value) = @_;
 358
 359   $html_restricter ||= SL::HTML::Restrict->create;
 360   return $html_restricter->process($value);
 361 }
 362
 363 sub textarea_tag {
 364   my ($name, $content, %attributes) = @_;
 365
 366   _set_id_attribute(\%attributes, $name);
 367   $attributes{rows}  *= 1; # required by standard
 368   $attributes{cols}  *= 1; # required by standard
 369
 370   html_tag('textarea', $content, %attributes, name => $name);
 371 }
 372
 373 sub link_tag {
 374   my ($href, $content, %params) = @_;
 375
 376   $href ||= '#';
 377
 378   html_tag('a', $content, %params, href => $href);
 379 }
 380 # alias for compatibility
 381 sub link { goto &link_tag }
 382
 383 sub date_tag {
 384   my ($name, $value, %params) = @_;
 385
 386   _set_id_attribute(\%params, $name);
 387   my @onchange = $params{onchange} ? (onChange => delete $params{onchange}) : ();
 388   my @classes  = $params{no_cal} || $params{readonly} ? () : ('datepicker');
 389   push @classes, delete($params{class}) if $params{class};
 390   my %class    = @classes ? (class => join(' ', @classes)) : ();
 391
 392   $::request->layout->add_javascripts('kivi.Validator.js');
 393   $::request->presenter->need_reinit_widgets($params{id});
 394
 395   $params{'data-validate'} = join(' ', "date", grep { $_ } (delete $params{'data-validate'}));
 396
 397   input_tag(
 398     $name, blessed($value) ? $value->to_lxoffice : $value,
 399     size   => 11,
 400     %params,
 401     %class, @onchange,
 402   );
 403 }
 404
 405 sub div_tag {
 406   my ($content, %params) = @_;
 407   return html_tag('div', $content, %params);
 408 }
 409
 410 sub img_tag {
 411   my (%params) = @_;
 412
 413   $params{alt} ||= '';
 414
 415   return html_tag('img', undef, %params);
 416 }
 417
 418 1;
 419 __END__
 420
 421 =pod
 422
 423 =encoding utf8
 424
 425 =head1 NAME
 426
 427 SL::Presenter::Tag - Layouting / tag generation
 428
 429 =head1 SYNOPSIS
 430
 431 Usage in a template:
 432
 433   [% USE P %]
 434
 435   [% P.select_tag('direction', [ [ 'left', 'To the left' ], [ 'right', 'To the right', 1 ] ]) %]
 436
 437   [% P.select_tag('direction', [ { direction => 'left',  display => 'To the left'  },
 438                                  { direction => 'right', display => 'To the right' } ],
 439                                value_key => 'direction', title_key => 'display', default => 'right') %]
 440
 441   [% P.select_tag('direction', [ { direction => 'left',  display => 'To the left'  },
 442                                  { direction => 'right', display => 'To the right', selected => 1 } ],
 443                                value_key => 'direction', title_key => 'display') %]
 444
 445   # Use an RDBO object and its n:m relationship as the default
 446   # values. For example, a user can be a member of many groups. "All
 447   # groups" is therefore the full collection and "$user->groups" is a
 448   # list of RDBO AuthGroup objects whose IDs must match the ones in
 449   # "All groups". This could look like the following:
 450   [% P.select_tag('user.groups[]', SELF.all_groups, multiple=1,
 451                   default=SELF.user.groups, default_value_key='id' ) %]
 452
 453 =head1 DESCRIPTION
 454
 455 A module modeled a bit after Rails' ActionView helpers. Several small
 456 functions that create HTML tags from various kinds of data sources.
 457
 458 The C<id> attribute is usually calculated automatically. This can be
 459 overridden by either specifying an C<id> attribute or by setting
 460 C<no_id> to trueish.
 461
 462 =head1 FUNCTIONS
 463
 464 =head2 LOW-LEVEL FUNCTIONS
 465
 466 =over 4
 467
 468 =item C<html_tag $tag_name, $content_string, %attributes>
 469
 470 Creates an opening and closing HTML tag for C<$tag_name> and puts
 471 C<$content_string> between the two. If C<$content_string> is undefined
 472 or empty then only a E<lt>tag/E<gt> tag will be created. Attributes
 473 are key/value pairs added to the opening tag.
 474
 475 C<$content_string> is not HTML escaped.
 476
 477 =item C<name_to_id $name>
 478
 479 Converts a name to a HTML id by replacing various characters.
 480
 481 =item C<stringify_attributes %items>
 482
 483 Creates a string from all elements in C<%items> suitable for usage as
 484 HTML tag attributes. Keys and values are HTML escaped even though keys
 485 must not contain non-ASCII characters for browsers to accept them.
 486
 487 =item C<restricted_html $html>
 488
 489 Returns HTML stripped of unknown tags. See L<SL::HTML::Restrict>.
 490
 491 =back
 492
 493 =head2 HIGH-LEVEL FUNCTIONS
 494
 495 =over 4
 496
 497 =item C<input_tag $name, $value, %attributes>
 498
 499 Creates a HTML 'input type=text' tag named C<$name> with the value
 500 C<$value> and with arbitrary HTML attributes from C<%attributes>. The
 501 tag's C<id> defaults to C<name_to_id($name)>.
 502
 503 =item C<submit_tag $name, $value, %attributes>
 504
 505 Creates a HTML 'input type=submit class=submit' tag named C<$name> with the
 506 value C<$value> and with arbitrary HTML attributes from C<%attributes>. The
 507 tag's C<id> defaults to C<name_to_id($name)>.
 508
 509 If C<$attributes{confirm}> is set then a JavaScript popup dialog will
 510 be added via the C<onclick> handler asking the question given with
 511 C<$attributes{confirm}>. The request is only submitted if the user
 512 clicks the dialog's ok/yes button.
 513
 514 =item C<ajax_submit_tag $url, $form_selector, $text, %attributes>
 515
 516 Creates a HTML 'input type="button"' tag with a very specific onclick
 517 handler that submits the form given by the jQuery selector
 518 C<$form_selector> to the URL C<$url> (the actual JavaScript function
 519 called for that is C<kivi.submit_ajax_form()> in
 520 C<js/client_js.js>). The button's label will be C<$text>.
 521
 522 =item C<button_tag $onclick, $text, %attributes>
 523
 524 Creates a HTML 'input type="button"' tag with an onclick handler
 525 C<$onclick> and a value of C<$text>. The button does not have a name
 526 nor an ID by default.
 527
 528 If C<$attributes{confirm}> is set then a JavaScript popup dialog will
 529 be prepended to the C<$onclick> handler asking the question given with
 530 C<$attributes{confirm}>. The request is only submitted if the user
 531 clicks the dialog's "ok/yes" button.
 532
 533 =item C<man_days_tag $name, $object, %attributes>
 534
 535 Creates two HTML inputs: a text input for entering a number and a drop
 536 down box for chosing the unit (either 'man days' or 'hours').
 537
 538 C<$object> must be a L<Rose::DB::Object> instance using the
 539 L<SL::DB::Helper::AttrDuration> helper.
 540
 541 C<$name> is supposed to be the name of the underlying column,
 542 e.g. C<time_estimation> for an instance of
 543 C<SL::DB::RequirementSpecItem>. If C<$name> has the form
 544 C<prefix.method> then the full C<$name> is used for the input's base
 545 names while the methods called on C<$object> are only the suffix. This
 546 makes it possible to write statements like e.g.
 547
 548   [% P.man_days_tag("requirement_spec_item.time_estimation", SELF.item) %]
 549
 550 The attribute C<size> can be used to set the text input's size. It
 551 defaults to 5.
 552
 553 =item C<hidden_tag $name, $value, %attributes>
 554
 555 Creates a HTML 'input type=hidden' tag named C<$name> with the value
 556 C<$value> and with arbitrary HTML attributes from C<%attributes>. The
 557 tag's C<id> defaults to C<name_to_id($name)>.
 558
 559 =item C<checkbox_tag $name, %attributes>
 560
 561 Creates a HTML 'input type=checkbox' tag named C<$name> with arbitrary
 562 HTML attributes from C<%attributes>. The tag's C<id> defaults to
 563 C<name_to_id($name)>. The tag's C<value> defaults to C<1>.
 564
 565 If C<%attributes> contains a key C<label> then a HTML 'label' tag is
 566 created with said C<label>. No attribute named C<label> is created in
 567 that case.
 568
 569 If C<%attributes> contains a key C<checkall> then the value is taken as a
 570 JQuery selector and clicking this checkbox will also toggle all checkboxes
 571 matching the selector.
 572
 573 =item C<radio_button_tag $name, %attributes>
 574
 575 Creates a HTML 'input type=radio' tag named C<$name> with arbitrary
 576 HTML attributes from C<%attributes>. The tag's C<value> defaults to
 577 C<1>. The tag's C<id> defaults to C<name_to_id($name . "_" . $value)>.
 578
 579 If C<%attributes> contains a key C<label> then a HTML 'label' tag is
 580 created with said C<label>. No attribute named C<label> is created in
 581 that case.
 582
 583 =item C<select_tag $name, \@collection, %attributes>
 584
 585 Creates an HTML 'select' tag named C<$name> with the contents of one
 586 'E<lt>optionE<gt>' tag for each element in C<\@collection> and with arbitrary
 587 HTML attributes from C<%attributes>. The value
 588 to use and the title to display are extracted from the elements in
 589 C<\@collection>. Each element can be one of four things:
 590
 591 =over 12
 592
 593 =item 1. An array reference with at least two elements. The first element is
 594 the value, the second element is its title. The third element is optional and and should contain a boolean.
 595 If it is true, than the element will be used as default.
 596
 597 =item 2. A scalar. The scalar is both the value and the title.
 598
 599 =item 3. A hash reference. In this case C<%attributes> must contain
 600 I<value_key>, I<title_key> and may contain I<default_key> keys that name the keys in the element to use
 601 for the value, title and default respectively.
 602
 603 =item 4. A blessed reference. In this case C<%attributes> must contain
 604 I<value_key>, I<title_key> and may contain I<default_key> keys that name functions called on the blessed
 605 reference whose return values are used as the value, title and default
 606 respectively.
 607
 608 =back
 609
 610 For cases 3 and 4 C<$attributes{value_key}> defaults to C<id>,
 611 C<$attributes{title_key}> defaults to C<$attributes{value_key}> and
 612 C<$attributes{default_key}> defaults to C<selected>. Note that
 613 C<$attributes{default_key}> is set to C<undef> if
 614 C<$attributes{default_value_key}> is used as well (see below).
 615
 616 In addition to pure keys/method you can also provide coderefs as I<value_sub>
 617 and/or I<title_sub> and/or I<default_sub>. If present, these take precedence over keys or methods,
 618 and are called with the element as first argument. It must return the value, title or default.
 619
 620 Lastly a joint coderef I<value_title_sub> may be provided, which in turn takes
 621 precedence over the C<value_sub> and C<title_sub> subs. It will only be called once for each
 622 element and must return a list of value and title.
 623
 624 If the option C<with_empty> is set then an empty element (value
 625 C<undef>) will be used as the first element. The title to display for
 626 this element can be set with the option C<empty_title> and defaults to
 627 an empty string.
 628
 629 The tag's C<id> defaults to C<name_to_id($name)>.
 630
 631 The option C<default> can be quite a lot of things:
 632
 633 =over 4
 634
 635 =item 1. A scalar value. This is the value of the entry that's
 636 selected by default.
 637
 638 =item 2. A hash reference for C<multiple=1>. Whether or not an entry
 639 is selected by default is looked up in this hash.
 640
 641 =item 3. An array reference containing scalar values. Same as 1., just
 642 for the case of C<multiple=1>.
 643
 644 =item 4. If C<default_value_key> is given: an array reference of hash
 645 references. For each hash reference the value belonging to the key
 646 C<default_value_key> is treated as one value to select by
 647 default. Constructs a hash that's treated like 3.
 648
 649 =item 5. If C<default_value_key> is given: an array reference of
 650 blessed objects. For each object the value returne from calling the
 651 function named C<default_value_key> on the object is treated as one
 652 value to select by default. Constructs a hash that's treated like 3.
 653
 654 =back
 655
 656 5. also applies to single RDBO instances (due to 'wantarray'
 657 shenanigans assigning RDBO's relationships to a hash key will result
 658 in a single RDBO object being assigned instead of an array reference
 659 containing that single RDBO object).
 660
 661 If the option C<with_optgroups> is set then this function expects
 662 C<\@collection> to be one level deeper. The upper-most level is
 663 translated into an HTML C<optgroup> tag. So the structure becomes:
 664
 665 =over 4
 666
 667 =item 1. Array of array references. Each element in the
 668 C<\@collection> is converted into an optgroup.
 669
 670 =item 2. The optgroup's C<label> attribute will be set to the
 671 first element in the array element. The second array element is then
 672 converted to a list of C<option> tags as described above.
 673
 674 =back
 675
 676 Example for use of optgroups:
 677
 678   # First in a controller:
 679   my @collection = (
 680     [ t8("First optgroup with three items"),
 681       [ { id => 42, name => "item one" },
 682         { id => 54, name => "second item" },
 683         { id => 23, name => "and the third one" },
 684       ] ],
 685     [ t8("Another optgroup, with a lot of items from Rose"),
 686       SL::DB::Manager::Customer->get_all_sorted ],
 687   );
 688
 689   # Later in the template:
 690   [% L.select_tag('the_selection', COLLECTION, with_optgroups=1, title_key='name') %]
 691
 692 =back
 693
 694 =head1 BUGS
 695
 696 Nothing here yet.
 697
 698 =head1 AUTHOR
 699
 700 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>,
 701 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
 702
 703 =cut