use strict;
use warnings;
package HTML::Widget::Plugin::Select;
# ABSTRACT: a widget for selection from a list
$HTML::Widget::Plugin::Select::VERSION = '0.202';
use parent 'HTML::Widget::Plugin';
#pod =head1 SYNOPSIS
#pod
#pod $widget_factory->select({
#pod id => 'the-selector', # if no name attr given, defaults to id value
#pod value => 10,
#pod options => [
#pod [ 0 => "Zero" ],
#pod [ 5 => "Five" ],
#pod [ 10 => "Ten" ],
#pod ],
#pod });
#pod
#pod =head1 DESCRIPTION
#pod
#pod This plugin provides a select-from-list widget.
#pod
#pod The C<default_classes> attribute may be used to add a default class to every
#pod produced input. This class cannot be overridden.
#pod
#pod my $plugin = HTML::Widget::Factory::Input->new({
#pod default_classes => [ qw(foo bar) ],
#pod });
#pod
#pod =head1 METHODS
#pod
#pod =head2 C< provided_widgets >
#pod
#pod This plugin provides the following widgets: select
#pod
#pod =cut
sub provided_widgets { qw(select) }
#pod =head2 C< select >
#pod
#pod This method returns a select-from-list widget.
#pod
#pod In addition to the generic L<HTML::Widget::Plugin> attributes, the following
#pod are valid arguments:
#pod
#pod =over
#pod
#pod =item disabled
#pod
#pod If true, this option indicates that the select widget can't be changed by the
#pod user.
#pod
#pod =item ignore_invalid
#pod
#pod If this is given and true, an invalid value is ignored instead of throwing an
#pod exception.
#pod
#pod =item options
#pod
#pod This may be an arrayref of arrayrefs, each containing a value/name pair, or it
#pod may be a hashref of values and names.
#pod
#pod Use the array form if you need multiple entries for a single value or if order
#pod is important.
#pod
#pod =item value
#pod
#pod If this argument is given, the option with this value will be pre-selected in
#pod the widget's initial state.
#pod
#pod An exception will be thrown if more or less than one of the provided options
#pod has this value.
#pod
#pod =back
#pod
#pod =cut
use HTML::Element;
sub _attribute_args { qw(disabled) }
sub _boolean_args { qw(disabled) }
sub select { ## no critic Builtin
my ($self, $factory, $arg) = @_;
$self->build($factory, $arg);
}
#pod =head2 C< build >
#pod
#pod my $widget = $class->build($factory, \%arg)
#pod
#pod This method does the actual construction of the widget based on the args set up
#pod in the exported widget-constructing call. It's here for subclasses to exploit.
#pod
#pod =cut
sub build {
my ($self, $factory, $arg) = @_;
$arg->{attr}{name} = $arg->{attr}{id} unless $arg->{attr}{name};
my $widget = HTML::Element->new('select');
my @options;
if (ref $arg->{options} eq 'HASH') {
@options = map { [ $_, $arg->{options}{$_} ] } keys %{ $arg->{options} };
} else {
@options = @{ $arg->{options} };
Carp::croak "undefined value passed to select widget"
if grep { not(defined $_) or ref $_ and not defined $_->[0] } @options;
}
$self->validate_value($arg->{value}, \@options) unless $arg->{ignore_invalid};
for my $entry (@options) {
my ($value, $name) = (ref $entry) ? @$entry : ($entry) x 2;
my $option = $self->make_option($factory, $value, $name, $arg);
$widget->push_content($option);
}
$widget->attr($_ => $arg->{attr}{$_}) for keys %{ $arg->{attr} };
return $widget->as_XML;
}
#pod =head2 C< make_option >
#pod
#pod my $option = $class->make_option($factory, $value, $name, $arg);
#pod
#pod This method constructs the HTML::Element option element that will represent one
#pod of the options that may be put into the select box. This is here for
#pod subclasses to exploit.
#pod
#pod =cut
sub make_option {
my ($self, $factory, $value, $name, $arg) = @_;
my $option = HTML::Element->new('option', value => $value);
$option->push_content($name);
$option->attr(selected => 'selected')
if defined $arg->{value} and $arg->{value} eq $value;
return $option;
}
#pod =head2 C< validate_value >
#pod
#pod This method checks whether the given value option is valid. See C<L</select>>
#pod for an explanation of its default rules.
#pod
#pod =cut
sub validate_value {
my ($class, $value, $options) = @_;
my @options = map { ref $_ ? $_->[0] : $_ } @$options;
# maybe this should be configurable?
if ($value) {
my $matches = grep { $value eq $_ } @options;
if (not $matches) {
Carp::croak "provided value '$value' not in given options: "
. join(q{ }, map { "'$_'" } @options);
} elsif ($matches > 1) {
Carp::croak "provided value '$matches' matches more than one option";
}
}
}
sub rewrite_arg {
my ($self, $arg, @rest) = @_;
$arg = $self->SUPER::rewrite_arg($arg, @rest);
if ($self->{default_classes}) {
my $class = join q{ }, @{ $self->{default_classes} };
$arg->{attr}{class} = defined $arg->{attr}{class}
? "$class $arg->{attr}{class}"
: $class;
}
return $arg;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
HTML::Widget::Plugin::Select - a widget for selection from a list
=head1 VERSION
version 0.202
=head1 SYNOPSIS
$widget_factory->select({
id => 'the-selector', # if no name attr given, defaults to id value
value => 10,
options => [
[ 0 => "Zero" ],
[ 5 => "Five" ],
[ 10 => "Ten" ],
],
});
=head1 DESCRIPTION
This plugin provides a select-from-list widget.
The C<default_classes> attribute may be used to add a default class to every
produced input. This class cannot be overridden.
my $plugin = HTML::Widget::Factory::Input->new({
default_classes => [ qw(foo bar) ],
});
=head1 METHODS
=head2 C< provided_widgets >
This plugin provides the following widgets: select
=head2 C< select >
This method returns a select-from-list widget.
In addition to the generic L<HTML::Widget::Plugin> attributes, the following
are valid arguments:
=over
=item disabled
If true, this option indicates that the select widget can't be changed by the
user.
=item ignore_invalid
If this is given and true, an invalid value is ignored instead of throwing an
exception.
=item options
This may be an arrayref of arrayrefs, each containing a value/name pair, or it
may be a hashref of values and names.
Use the array form if you need multiple entries for a single value or if order
is important.
=item value
If this argument is given, the option with this value will be pre-selected in
the widget's initial state.
An exception will be thrown if more or less than one of the provided options
has this value.
=back
=head2 C< build >
my $widget = $class->build($factory, \%arg)
This method does the actual construction of the widget based on the args set up
in the exported widget-constructing call. It's here for subclasses to exploit.
=head2 C< make_option >
my $option = $class->make_option($factory, $value, $name, $arg);
This method constructs the HTML::Element option element that will represent one
of the options that may be put into the select box. This is here for
subclasses to exploit.
=head2 C< validate_value >
This method checks whether the given value option is valid. See C<L</select>>
for an explanation of its default rules.
=head1 AUTHOR
Ricardo SIGNES
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2005 by Ricardo SIGNES.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut