File Coverage

blib/lib/HTML/SuperForm/Field.pm

Criterion	Covered	Total	%
statement	12	217	5.5
branch	0	106	0.0
condition	0	43	0.0
subroutine	4	28	14.2
pod	4	19	21.0
total	20	413	4.8

package HTML::SuperForm::Field;

use overload;
use strict;

use Carp;

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;
__END__