sub quote {
my $self = shift;
+ return ${$_[0]} if ref $_[0] eq 'SCALAR';
return XML::Quote::xml_quote_min($_[0]);
}
my $return = '<' . $tag;
- # add booleans
+ # add boolean attributes
delete $attr->{$_} and $return .= ' '.$_
for qw(selected checked disabled readonly);
+ # add attributes with (escaped) string values
$return .= sprintf ' %s="%s"', $_, $self->quote($attr->{$_})
for sort grep { defined $attr->{$_} } keys %$attr;
if not defined $attr->{value} and defined $name and defined $self->{default};
$attr->{id} = $attr->{name} unless defined $attr->{id};
$attr->{type} = 'text' unless defined $attr->{type} or defined $attr->{rows};
+
+ # textarea does not have value as tag attribute
$value = delete $attr->{value} if defined $attr->{rows};
return defined $attr->{rows} ? sprintf(
if ($attr->{type} eq 'select') {
delete $attr->{type};
+
+ # select option(s) matching the default value
if (defined $default) {
for (@options) {
$_->{selected} = 1 if defined $_->{value} and $_->{value} eq $default;
}
}
+
@return = (
$self->tag(select => $attr),
(map { $self->tag(option => $_) } @options),
);
}
else {
+ # set fallback option id from parent id and value
if (defined $attr->{id} and $attr->{id} ne '') {
defined $_->{id}
or defined $_->{value} and $_->{id} = $attr->{id}.'_'.$_->{value}
for @options;
}
+
+ # put parent label attribute on options
if (defined $attr->{label}) {
defined $_->{value} and not defined $_->{label}
and $_->{label} = $attr->{label}->{$_->{value}}
for @options;
delete $attr->{label};
}
+
+ # check any option matching the default value
if (defined $default) {
for (@options) {
$_->{checked} = 1 if defined $_->{value} and $_->{value} eq $default;
}
}
+
$_ = {%$attr, %$_} for @options;
@return = map {
my $label = delete $_->{label};
my $self = shift;
my ($name, $rows, $label, $default, $attr) = $self->_attr(4, @_);
+ # normalize rows array
if (not defined $rows) {
if (defined $label) {
+ # fill up values with numbers to match labels
$rows = ref $label eq 'ARRAY' ? [1 .. $#$label+1] : [1];
}
else {
$rows = [$rows];
}
+ # add labels
if (defined $label) {
+ # convert options to hash refs so we can add label attributes
$rows = [ map { ref $_ eq 'HASH' ? {%$_} : {value => $_} } @$rows ];
+
if (ref $label eq 'ARRAY') {
$rows->[$_]->{label} = $label->[$_] for 0 .. $#$rows;
} else {
my $self = shift;
my ($name, $label, $checked, $attr) = $self->_attr(3, @_);
+ # create option rows array from label argument
my $rows = defined $label ? ref $label eq 'ARRAY' ? [@$label] : [$label] : [{}];
- ref $_ eq 'HASH' or $_ = {label => $_} for @$rows;
+ # convert options to hash refs sooner rather than later
+ $_ = ref $_ eq 'HASH' ? {%$_} : {label => $_} for @$rows;
+
+ # parse checked argument
if (defined $checked) {
if (ref $checked eq 'ARRAY') {
+ # each checked row corresponding to an option
$rows->[$_]->{checked} = $checked->[$_] for 0 .. $#$rows;
+ # add superfluous rows as new options
push @$rows, map { {checked => $_} } @$checked[@$rows .. $#$checked];
}
else {
+ # a single value for all options
$_->{checked} = $checked for @$rows;
}
}
+
+ # set default option value (argument number)
exists $rows->[$_]->{value} or $rows->[$_]->{value} = $_ + 1 for 0 .. $#$rows;
+
+ # set option id without added value if rows were not given as array
$rows->[0]->{id} = $attr->{id} || $rows->[0]->{name} || $attr->{name} || $name #XXX: //
if ref $label ne 'ARRAY' and defined $rows->[0] and not defined $rows->[0]->{id};