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