our %accessors = map { $_ => 1 } qw(multiple selectable value default form disabled readonly sticky fallback well_formed values_as_labels);
our %mutators;
sub prepare {}
sub init {}
sub new {
my $class = shift;
my $form;
if(UNIVERSAL::isa($_[0], "HTML::SuperForm")) {
$form = shift;
}
my $config = {};
if(ref($_[0]) eq "HASH") {
$config = shift;
} else {
%$config = @_;
}
overload::OVERLOAD($class, '""' => \&{$class . "::to_html"});
my $self = {
_other_info => {}
};
$self->{_form} = $form;
bless $self, $class;
$self->init($config);
$self->{_readonly} = delete $config->{readonly};
$self->{_disabled} = delete $config->{disabled};
$self->{_multiple} = delete $config->{multiple};
my $labels = delete $config->{labels} || {};
my $all_values = delete $config->{values} || [ keys %$labels ];
if(ref($all_values) ne "ARRAY") {
$all_values = [ $all_values ];
}
if( defined($config->{value}) && @$all_values == 0) {
push(@{$all_values}, $config->{value});
}
if(exists($config->{label})) {
$self->{_label} = delete $config->{label};
}
$self->{_labels} = $labels;
$self->{_all_values} = $all_values;
my %all_values_hash = map { $_ => 1 } @$all_values;
my $default;
if(exists($config->{default})) {
$default = delete $config->{default};
}
if(exists($config->{defaults})) {
$default = delete $config->{defaults};
}
$self->{_default} = $default;
if(ref($self->{_default}) eq "ARRAY" && scalar(@{$self->{_default}}) == 0) {
$self->{_default} = undef;
}
if(UNIVERSAL::isa($form, "HTML::SuperForm")) {
$self->{_fallback} = $self->{_form}->fallback;
$self->{_sticky} = $self->{_form}->sticky;
$self->{_well_formed} = $self->{_form}->well_formed;
$self->{_values_as_labels} = $self->{_form}->values_as_labels;
} else {
$self->{_fallback} = 0;
$self->{_sticky} = 0;
$self->{_well_formed} = 1;
$self->{_values_as_labels} = 1;
}
if($self->{_disabled}) {
$self->{_sticky} = 0;
}
for my $key (qw(fallback sticky well_formed values_as_labels)) {
if(exists($config->{$key})) {
$self->{'_' . $key} = delete $config->{$key};
}
}
if(exists($config->{value_as_label})) {
$self->{_values_as_labels} = delete $config->{value_as_label};
}
$self->{_attributes} = $config;
if($self->{_multiple} || scalar(@{$self->{_all_values}}) > 0) {
$self->{_selectable} = 1;
}
if( UNIVERSAL::isa($form, "HTML::SuperForm") &&
$self->sticky() &&
(exists($config->{name}) &&
$form->exists_param($config->{name}) || !$self->fallback)
) {
$self->{_value} = $form->param($config->{name});
} else {
$self->{_value} = $self->default;
}
if(!$self->selectable && ref($self->{_value}) eq "ARRAY") {
my $i = $self->{_form}->no_of_fields($self->name);
$self->{_value} = $self->{_value}[$i];
}
$self->{_value} = $self->escape_html($self->{_value});
my @select = ();
if(ref($self->{_value}) eq "ARRAY") {
@select = @{$self->{_value}};
} else {
if(defined($self->{_value})) {
@select = ( $self->{_value} );
}
}
for my $s (@select) {
$self->{_selected}{$s} = 1 if $all_values_hash{$s};
}
$self->prepare();
$self->update_form();
return $self;
}
sub escape_html {
my $self = shift;
my $arg = shift;
if(ref($arg) eq "ARRAY") {
my $strings = $arg;
$arg = [];
for(0..$#$strings) {
$arg->[$_] = $strings->[$_];
$arg->[$_] =~ s/(["&<>])/'&#' . ord($1) . ';'/ge;
}
} else {
$arg =~ s/(["&<>])/'&#' . ord($1) . ';'/ge;
}
return $arg;
}
sub name {
my $self = shift;
return $self->{_attributes}{name};
}
sub set {
my $self = shift;
my %hash;
if(ref($_[0]) eq "HASH") {
%hash = %{ shift() };
} else {
%hash = @_;
}
$self->{_other_info} = {
%{$self->{_other_info}},
%hash,
};
return;
}
sub get {
my $self = shift;
my @return;
for my $key (@_) {
if(exists($self->{_other_info}{$key})) {
push(@return, $self->{_other_info}{$key});
} else {
carp "WARNING: nothing stored under key $key";
}
}
return wantarray ? @return :
scalar(@return) == 1 ? $return[0] : \@return;
}
sub label {
my $self = shift;
my $key = shift;
if(defined($key)) {
my $label;
if(exists($self->{_labels}{$key})) {
$label = $self->{_labels}{$key};
} elsif($self->values_as_labels) {
$label = $key;
}
return $label;
}
if(exists($self->{_label})) {
return $self->{_label};
} elsif($self->selectable && $self->values_as_labels && scalar(@{$self->{_all_values}}) == 1) {
return @{$self->{_all_values}}[0];
}
return;
}
sub has_label {
my $self = shift;
if(exists($self->{_label}) || ($self->selectable && $self->values_as_labels && scalar(@{$self->{_all_values}}) == 1)) {
return 1;
}
return;
}
sub get_attribute {
my $self = shift;
my $key = shift;
return $self->{_attributes}{$key};
}
sub selected {
my $self = shift;
my $key = shift;
if(ref($key) eq "ARRAY") {
for my $k (@$key) {
if($self->{_selected}{$k}) {
return 1;
}
}
return 0;
}
return $self->{_selected}{$key};
}
sub selected_str {
my $self = shift;
my $key = shift;
if($self->well_formed) {
return $self->selected($key) ? ' selected="selected"' : '';
}
return $self->selected($key) ? ' selected' : '';
}
sub checked_str {
my $self = shift;
my $key = shift;
if($self->well_formed) {
return $self->selected($key) ? ' checked="checked"' : '';
}
return $self->selected($key) ? ' checked' : '';
}
sub multiple_str {
my $self = shift;
if($self->well_formed) {
return $self->multiple ? ' multiple="' . $self->multiple . '"' : '';
}
return $self->multiple ? ' multiple' : '';
}
sub readonly_str {
my $self = shift;
if($self->well_formed) {
return $self->readonly ? ' readonly="' . $self->readonly . '"' : '';
}
return $self->readonly ? ' readonly' : '';
}
sub disabled_str {
my $self = shift;
if($self->well_formed) {
return $self->disabled ? ' disabled="' . $self->disabled . '"' : '';
}
return $self->disabled ? ' disabled' : '';
}
sub update_form {
my $self = shift;
return unless $self->name();
return unless UNIVERSAL::isa($self->form, "HTML::SuperForm");
if(defined($self->default) || !$self->selectable) {
$self->form->add_default($self->name() => $self->default);
} else {
$self->form->set_default($self->name() => undef);
}
}
sub attribute_str {
my $self = shift;
return " " . join(' ', map { qq|$_="$self->{_attributes}{$_}"| }
keys %{$self->{_attributes}});
}
sub values {
my $self = shift;
return $self->{_all_values};
}
sub AUTOLOAD {
my $self = $_[0];
my ($key) = ${*AUTOLOAD} =~ /::([^:]*)$/;
{
no strict "refs";
if(exists($mutators{$key})) {
*{"HTML::SuperForm::Field::$key"} = sub {
my $self = shift;
my $val = shift;
if(defined($val)) {
$self->{'_' . $key} = $val;
return;
}
return $self->{'_' . $key};
};
goto &{"HTML::SuperForm::Field::$key"};
}
if(exists($accessors{$key})) {
*{"HTML::SuperForm::Field::$key"} = sub {
my $self = shift;
return $self->{'_' . $key};
};
goto &{"HTML::SuperForm::Field::$key"};
}
if(exists($self->{_attributes}{$key})) {
*{"HTML::SuperForm::Field::$key"} = sub {
my $self = shift;
return $self->{_attributes}{$key};
};
goto &{"HTML::SuperForm::Field::$key"};
} else {
croak "ERROR: attribute $key doesn't exist";
}
}
return;
}
sub DESTROY {}
1;