+ 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);