-sub name_to_id {
- my $self = shift;
- my $name = shift;
-
- $name =~ s/[^\w_]/_/g;
- $name =~ s/_+/_/g;
-
- return $name;
-}
-
-sub attributes {
- my ($self, @slurp) = @_;
- my %options = _hashify(@slurp);
-
- my @result = ();
- while (my ($name, $value) = each %options) {
- next unless $name;
- next if $_valueless_attributes{$name} && !$value;
- $value = '' if !defined($value);
- push @result, $_valueless_attributes{$name} ? _H($name) : _H($name) . '="' . _H($value) . '"';
- }
-
- return @result ? ' ' . join(' ', @result) : '';
-}
-
-sub html_tag {
- my ($self, $tag, $content, @slurp) = @_;
- my $attributes = $self->attributes(@slurp);
-
- return "<${tag}${attributes}>" unless defined($content);
- return "<${tag}${attributes}>${content}</${tag}>";
-}
-
-sub img_tag {
- my ($self, @slurp) = @_;
- my %options = _hashify(@slurp);
-
- $options{alt} ||= '';
-
- return $self->html_tag('img', undef, %options);
-}
-
-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 %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 @options;
-
- if ( $with_empty ) {
- push(@options, [undef, $empty_title || '']);
- }
-
- my $normalize_entry = sub {
-
- my ($type, $entry, $sub, $key) = @_;
-
- if ( $sub ) {
- return $sub->($entry);
- }
-
- my $ref = ref($entry);
-
- if ( !$ref ) {
-
- if ( $type eq 'value' || $type eq 'title' ) {
- return $entry;
- }
-
- return 0;
- }
-
- if ( $ref eq 'ARRAY' ) {
-
- if ( $type eq 'value' ) {
- return $entry->[0];
- }
-
- if ( $type eq 'title' ) {
- return $entry->[1];
- }
-
- return $entry->[2];
- }
-
- if ( $ref eq 'HASH' ) {
- return $entry->{$key};
- }
-
- if ( $type ne 'default' || $entry->can($key) ) {
- return $entry->$key;
- }
-
- return undef;
- };
-
- foreach my $entry ( @{ $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) {
- if ( exists($selected{$entry->[0]}) ) {
- $entry->[2] = 1;
- }
- }
-
- my $code = '';
-
- foreach my $entry (@options) {
- my %args = (value => $entry->[0]);
-
- $args{selected} = $entry->[2];
-
- $code .= $self->html_tag('option', _H($entry->[1]), %args);
- }
-
- $code = $self->html_tag('select', $code, %attributes, name => $name);
-
- return $code;
-}
-
-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);
-}