-sub select_tag {
- my $self = shift;
- my $name = shift;
- my $collection = shift;
- my %attributes = _hashify(@_);
-
- $attributes{id} ||= $self->name_to_id($name);
-
- my $value_key = delete($attributes{value_key}) || 'id';
- my $title_key = delete($attributes{title_key}) || $value_key;
- my $default_key = delete($attributes{default_key}) || 'selected';
-
-
- my $value_title_sub = delete($attributes{value_title_sub});
-
- my $value_sub = delete($attributes{value_sub});
- my $title_sub = delete($attributes{title_sub});
- my $default_sub = delete($attributes{default_sub});
-
- my $with_empty = delete($attributes{with_empty});
- my $empty_title = delete($attributes{empty_title});
-
- my $with_optgroups = delete($attributes{with_optgroups});
-
- my %selected;
-
- if ( ref($attributes{default}) eq 'ARRAY' ) {
-
- foreach my $entry (@{$attributes{default}}) {
- $selected{$entry} = 1;
- }
- } elsif ( defined($attributes{default}) ) {
- $selected{$attributes{default}} = 1;
- }
-
- delete($attributes{default});
-
-
- my @all_options;
- push @all_options, [undef, $empty_title || ''] if $with_empty;
-
- my $normalize_entry = sub {
- my ($type, $entry, $sub, $key) = @_;
-
- return $sub->($entry) if $sub;
-
- my $ref = ref($entry);
-
- if ( !$ref ) {
- return $entry if $type eq 'value' || $type eq 'title';
- return 0;
- }
-
- if ( $ref eq 'ARRAY' ) {
- return $entry->[ $type eq 'value' ? 0 : $type eq 'title' ? 1 : 2 ];
- }
-
- return $entry->{$key} if $ref eq 'HASH';
- return $entry->$key if $type ne 'default' || $entry->can($key);
- return undef;
- };
-
- my $list_to_code = sub {
- my ($sub_collection) = @_;
-
- my @options;
- foreach my $entry ( @{ $sub_collection } ) {
- my $value;
- my $title;
-
- if ( $value_title_sub ) {
- ($value, $title) = @{ $value_title_sub->($entry) };
- } else {
-
- $value = $normalize_entry->('value', $entry, $value_sub, $value_key);
- $title = $normalize_entry->('title', $entry, $title_sub, $title_key);
- }
-
- my $default = $normalize_entry->('default', $entry, $default_sub, $default_key);
-
- push(@options, [$value, $title, $default]);
- }
-
- foreach my $entry (@options) {
- $entry->[2] = 1 if $selected{$entry->[0]};
- }
-
- return join '', map { $self->html_tag('option', _H($_->[1]), value => $_->[0], selected => $_->[2]) } @options;
- };
-
- my $code;
-
- if (!$with_optgroups) {
- $code = $list_to_code->($collection);
-
- } else {
- $code = join '', map {
- my ($optgroup_title, $sub_collection) = @{ $_ };
- $self->html_tag('optgroup', $list_to_code->($sub_collection), label => $optgroup_title)
- } @{ $collection };
- }
-
- return $self->html_tag('select', $code, %attributes, name => $name);
-}
-
-sub textarea_tag {
- my ($self, $name, $content, @slurp) = @_;
- my %attributes = _hashify(@slurp);
-
- $attributes{id} ||= $self->name_to_id($name);
- $attributes{rows} *= 1; # required by standard
- $attributes{cols} *= 1; # required by standard
- $content = $content ? _H($content) : '';
-
- return $self->html_tag('textarea', $content, %attributes, name => $name);
-}