File Coverage

blib/lib/Validation/Class/Plugin/FormFields.pm

Criterion	Covered	Total	%
statement	21	258	8.1
branch	0	64	0.0
condition	0	44	0.0
subroutine	7	39	17.9
pod	18	22	81.8
total	46	427	10.7

# ABSTRACT: HTML Form Field Renderer for Validation::Class

package Validation::Class::Plugin::FormFields;

use strict;
use warnings;
use overload '""' => \&render, fallback => 1;

use Carp;

use List::MoreUtils 'any';
use Validation::Class::Util;
use HTML::Element;

our $VERSION = '7.900022'; # VERSION


sub new {

    my $class     = shift;
    my $prototype = shift;

    my $self = {
        target    => '',
        elements  => {},
        prototype => $prototype
    };

    return bless $self, $class;

}


sub checkbox {

    my ($self, $name, %attributes) = @_;

    $self->{target} = $name;

    $self->declare('checkbox', $name, %attributes);

    return $self;

}


sub checkgroup {

    my ($self, $name, %attributes) = @_;

    $self->{target} = $name;

    $self->declare('checkgroup', $name, %attributes);

    return $self;

}


sub error_count {

    my $self = shift;

    return $self->prototype->error_count(@_);

}


sub error_fields {

    my $self = shift;

    return $self->prototype->error_fields(@_);

}


sub errors {

    my $self = shift;

    return $self->prototype->errors(@_);

}


sub errors_to_string {

    my $self = shift;

    return $self->prototype->errors_to_string(@_);

}

sub declare {

    my ($self, $method, $name, %attributes) = @_;

    my $proto = $self->{prototype};

    croak qq(Can't declare new element without a field and type),
        unless $name && $method
    ;

    croak qq(Can't locate field $name for use with element $method),
        unless $proto->fields->has($name)
    ;

    my $field = $proto->fields->get($name);

    $attributes{id}   ||= $field->name;
    $attributes{name} ||= $field->name;

    my $value;

    if (defined $attributes{value}) {
        $value = $attributes{value};
    }

    else {
        $value = $field->default;
    }

    my $param = []; # everything gets easier if we always expect an arrayref

    if ($proto->params->has($name)) {
        $param = $proto->params->get($name);
        $param = isa_arrayref($param) ? $param : [$param];
    }

    my $processor = "_declare_$method";

    $self->$processor($field, $param, $value, %attributes)
        if $self->can($processor)
    ;

    return $self;

}

sub _declare_checkbox {

    my ($self, $field, $param, $value, %attributes) = @_;

    my $name = $field->name;

    my $element = HTML::Element->new('input');

    my $proto = $self->proto;

    $attributes{type} ||= 'checkbox';

    $value = isa_arrayref($value) ? $value->[0] : $value;

    croak qq(Can't process checkbox without a default value for field $name)
        unless $value
    ;

    # set value attribute
    $attributes{value} = $value;

    # set checked attribute
    if (any { $_ eq $value } @{$param}) {
        $attributes{checked} = 'checked';
    }

    # set attributes
    while (my($key, $val) = each(%attributes)) {
        $element->attr($key, $val);
    }

    return $self->{elements}->{$name} = $element;

}

sub _declare_checkgroup {

    my ($self, $field, $param, $value, %attributes) = @_;

    my $name = $field->name;

    my @elements = ();

    my $proto = $self->proto;

    $attributes{type} ||= 'checkbox';

    $value = isa_arrayref($value) ? $value->[0] : $value;

    # set value attribute (although it'll likely be overwritten)
    $attributes{value} = $value;

    my @opts = grep defined, @{$field->options};

    croak qq(Can't process checkbox group without options for field $name),
        unless @opts
    ;

    my %values = map { $_ => $_ } @{$param};

    foreach my $opt (@opts) {

        my ($v, $c);

        if ($opt =~ /^([^\|]+)?\|(.*)/) {
            ($v, $c) = $opt =~ /^([^\|]+)?\|(.*)/;
        }

        elsif (isa_arrayref($opt)) {
            ($v, $c) = @{$opt};
        }

        else {
            ($v, $c) = ($opt, $opt);
        }

        my $element = HTML::Element->new('input');

        # set basic attributes
        while (my($key, $val) = each(%attributes)) {
            $element->attr($key, $val);
        }

        $element->attr(value => $v);
        $element->push_content(HTML::Element->new('span', _content => [$c]));
        $element->attr(checked => 'checked') if $v eq $values{$v};

        push @elements, $element;

    }

    return $self->{elements}->{$name} = \@elements;

}

sub _declare_hidden {

    my ($self, $field, $param, $value, %attributes) = @_;

    my $name = $field->name;

    my $element = HTML::Element->new('input');

    my $proto = $self->proto;

    $attributes{type} ||= 'hidden';

    $value = isa_arrayref($value) ? $value->[0] : $value;

    croak qq(Can't process hidden field without a default value for field $name)
        unless $value
    ;

    # set value attribute
    $attributes{value} = $value;

    # set attributes
    while (my($key, $val) = each(%attributes)) {
        $element->attr($key, $val);
    }

    return $self->{elements}->{$name} = $element;

}

sub _declare_selectbox {

    my ($self, $field, $param, $value, %attributes) = @_;

    my $name = $field->name;

    my $element = HTML::Element->new('select');

    # default state (minor liberties taken)
    if (defined $attributes{placeholder}) {
        $element->push_content(
            HTML::Element->new('option',
                value => '', _content => [
                    delete $attributes{placeholder}
                ]
            )
        );
    }

    # set basic attributes
    while (my($key, $val) = each(%attributes)) {
        $element->attr($key, $val);
    }

    my $proto = $self->proto;

    $value = isa_arrayref($value) ? $value->[0] : $value;

    my @opts = grep defined, @{$field->options};

    croak qq(Can't process selectbox without options for field $name),
        unless @opts
    ;

    my %values = map { $_ => $_ } @{$param};

    foreach my $opt (@opts) {

        my ($v, $c);

        if ($opt =~ /^([^\|]+)?\|(.*)/) {
            ($v, $c) = $opt =~ /^([^\|]+)?\|(.*)/;
        }

        elsif (isa_arrayref($opt)) {
            ($v, $c) = @{$opt};
        }

        else {
            ($v, $c) = ($opt, $opt);
        }

        my $option = HTML::Element->new('option');

        $option->attr(value => $v || '');
        $option->push_content( $c || '');
        $option->attr(selected => 'selected')
            if ($v && $values{$v}) and ($v eq $values{$v})
        ;

        $element->push_content($option);

    }

    return $self->{elements}->{$name} = $element;

}

sub _declare_radiobutton {

    my ($self, $field, $param, $value, %attributes) = @_;

    my $name = $field->name;

    my $element = HTML::Element->new('input');

    my $proto = $self->proto;

    $attributes{type} ||= 'radio';

    $value = isa_arrayref($value) ? $value->[0] : $value;

    croak qq(Can't process radiobutton without a default value for field $name)
        unless $value
    ;

    # set value attribute
    $attributes{value} = $value;

    # set checked attribute
    if (any { $_ eq $value } @{$param}) {
        $attributes{checked} = 'checked';
    }

    # set attributes
    while (my($key, $val) = each(%attributes)) {
        $element->attr($key, $val);
    }

    return $self->{elements}->{$name} = $element;

}

sub _declare_radiogroup {

    my ($self, $field, $param, $value, %attributes) = @_;

    my $name = $field->name;

    my @elements = ();

    my $proto = $self->proto;

    $attributes{type} ||= 'radio';

    $value = isa_arrayref($value) ? $value->[0] : $value;

    # set value attribute (although it'll likely be overwritten)
    $attributes{value} = $value;

    my @opts = grep defined, @{$field->options};

    croak qq(Can't process radio group without options for field $name),
        unless @opts
    ;

    my %values = map { $_ => $_ } @{$param};

    foreach my $opt (@opts) {

        my ($v, $c);

        if ($opt =~ /^([^\|]+)?\|(.*)/) {
            ($v, $c) = $opt =~ /^([^\|]+)?\|(.*)/;
        }

        elsif (isa_arrayref($opt)) {
            ($v, $c) = @{$opt};
        }

        else {
            ($v, $c) = ($opt, $opt);
        }

        my $element = HTML::Element->new('input');

        # set basic attributes
        while (my($key, $val) = each(%attributes)) {
            $element->attr($key, $val);
        }

        $element->attr(value => $v);
        $element->push_content(HTML::Element->new('span', _content => [$c]));
        $element->attr(checked => 'checked') if $v eq $values{$v};

        push @elements, $element;

    }

    return $self->{elements}->{$name} = \@elements;

}

sub _declare_textarea {

    my ($self, $field, $param, $value, %attributes) = @_;

    my $name = $field->name;

    my $element = HTML::Element->new('textarea');

    my $proto = $self->proto;

    $attributes{type} ||= 'text';

    $value = $param->[0] || (isa_arrayref($value) ? $value->[0] : $value);

    $element->push_content($value || '');

    # set basic attributes
    while (my($key, $val) = each(%attributes)) {
        $element->attr($key, $val);
    }

    return $self->{elements}->{$name} = $element;

}

sub _declare_textbox {

    my ($self, $field, $param, $value, %attributes) = @_;

    my $name = $field->name;

    my $element = HTML::Element->new('input');

    my $proto = $self->proto;

    $attributes{type} ||= 'text';

    $value = $param->[0] || (isa_arrayref($value) ? $value->[0] : $value);

    # set value attribute
    $attributes{value} = $value;

    # set attributes
    while (my($key, $val) = each(%attributes)) {
        $element->attr($key, $val);
    }

    return $self->{elements}->{$name} = $element;

}


sub element {

    my ($self, $target) = @_;

    $target ||= $self->{target};

    return $self->{elements}->{$target};

}


sub hidden {

    my ($self, $name, %attributes) = @_;

    $self->{target} = $name;

    $self->declare('hidden', $name, %attributes);

    return $self;

}


sub lockbox {

    goto &password;

}


sub multiselect {

    my ($self, $name, %attributes) = @_;

    $self->{target} = $name;

    $attributes{multiple} = 'yes';

    $self->selectbox($name, %attributes);

    return $self;

}


sub password {

    my ($self, $name, %attributes) = @_;

    $attributes{type} = 'password';

    $self->textbox($name, %attributes);

    return $self;

}

sub proto {

    goto &prototype;

}


sub prototype {

    my ($self) = @_;

    return $self->{prototype};

}


sub radiobutton {

    my ($self, $name, %attributes) = @_;

    $self->{target} = $name;

    $self->declare('radiobutton', $name, %attributes);

    return $self;

}


sub radiogroup {

    my ($self, $name, %attributes) = @_;

    $self->{target} = $name;

    $self->declare('radiogroup', $name, %attributes);

    return $self;

}


sub selectbox {

    my ($self, $name, %attributes) = @_;

    $self->{target} = $name;

    $self->declare('selectbox', $name, %attributes);

    return $self;

}


sub textarea {

    my ($self, $name, %attributes) = @_;

    $self->{target} = $name;

    $self->declare('textarea', $name, %attributes);

    return $self;

}


sub textbox {

    my ($self, $name, %attributes) = @_;

    $self->{target} = $name;

    $self->declare('textbox', $name, %attributes);

    return $self;

}


sub render {

    my ($self, $target)  = @_;

    my $element = $self->element($target);

    return isa_arrayref($element) ?
        [map { $_->as_HTML } @{$element}] : $element->as_HTML
    ;

}

sub render_inner {

    my ($self)  = @_;

    my @pairs;
    my %attrs = $self->element->all_attr;

    my $type = delete $attrs{_tag};

    for (keys %attrs) {
        delete $attrs{$_} if /^_/;
    }

    my @attrs = %attrs;

    push @pairs, sprintf('%s="%s"', splice(@attrs, 0, 2)) while @attrs;

    return $type . ' ' . join ' ', @pairs;

}

1;

__END__