HTML::Widget::Result - Result Class

    my @errors = $form->errors;
    my @errors = $form->errors('foo');
    my @errors = $form->errors( 'foo', 'ASCII' );

    my @form = $f->elements;
    my $age  = $f->elements('age');

    my @names = $form->has_errors;
    my $error = $form->has_errors($name);

    my @names = $form->valid;
    my $valid = $form->valid($name);

    $result->add_error({ name => 'foo' });

    if ( ! $result->has_errors ) {
        my $user = $result->valid('username');
        my $pass = $result->valid('password');

        if ( ! $app->login( $user, $pass ) ) {
            $result->add_error({
                name => 'password',
                message => 'Incorrect Password',
            });
        }
    }

package HTML::Widget::Result;

use warnings;
use strict;
use base qw/HTML::Widget::Accessor/;
use HTML::Widget::Container;
use HTML::Widget::Error;
use HTML::Element;
use Storable 'dclone';
use Carp qw/carp croak/;

__PACKAGE__->mk_accessors(
    qw/attributes container subcontainer strict submitted
        element_container_class implicit_subcontainer/
);
__PACKAGE__->mk_attr_accessors(qw/action enctype id method empty_errors/);

use overload '""' => sub { return shift->as_xml }, fallback => 1;

*attrs        = \&attributes;
*name         = \&id;
*error        = \&errors;
*has_error    = \&has_errors;
*have_errors  = \&has_errors;
*element      = \&elements;
*parameters   = \&params;
*tag          = \&container;
*subtag       = \&subcontainer;
*is_submitted = \&submitted;

sub as_xml {
    my $self = shift;

    my $element_container_class = $self->{element_container_class};

    my $c = HTML::Element->new( $self->container );

    $c->attr( $_ => ${ $self->attributes }{$_} )
        for ( keys %{ $self->attributes } );

    my $params = dclone $self->{_params};

    for my $element (
        $self->_get_elements(
            $self->{_elements}, $params, $element_container_class
        ) )
    {
        $c->push_content( $element->as_list ) unless $element->passive;
    }
    return $c->as_XML;
}

sub errors {
    my ( $self, $name, $type ) = @_;

    return 0 if $name && !$self->{_errors}->{$name};

    my $errors = [];
    my @names = $name || keys %{ $self->{_errors} };
    for my $n (@names) {
        for my $error ( @{ $self->{_errors}->{$n} } ) {
            next if $type && $error->{type} ne $type;
            push @$errors, $error;
        }
    }
    return @$errors;
}

sub elements {
    my ( $self, $name ) = @_;

    my $params = dclone $self->{_params};

    if ( $self->implicit_subcontainer ) {
        return $self->_get_elements(
            $self->{_elements}->[0]->content, $params,
            $self->{element_container_class}, $name
        );
    }

    return $self->_get_elements( $self->{_elements}, $params,
        $self->{element_container_class}, $name );
}

sub elements_ref {
    my $self = shift;

    return [ $self->elements(@_) ];
}

sub find_result_element {
    my ( $self, $name ) = @_;

    my @elements = $self->find_elements( name => $name );
    return unless @elements;

    my $params = dclone $self->{_params};

    return $self->_get_elements( [ $elements[0] ],
        $params, $self->{element_container_class}, $name );
}

sub elements_for {
    my ( $self, $name ) = @_;

    my @elements = $self->find_elements( name => $name );
    return unless @elements;

    my $ble = $elements[0];
    return unless $ble->isa('HTML::Widget::Element::NullContainer');

    my $params = dclone $self->{_params};

    return $self->_get_elements( $ble->content, $params,
        $self->{element_container_class} );
}

# code reuse++
sub _get_elements {
    my ( $self, $elements, $params, $element_container_class, $name ) = @_;

    my %javascript;
    for my $js_callback ( @{ $self->{_js_callbacks} } ) {
        my $javascript = $js_callback->( $self->name );
        for my $key ( keys %$javascript ) {
            $javascript{$key} .= $javascript->{$key} if $javascript->{$key};
        }
    }

    # the hashref of args is carried through - recursively as necessary
    #  - to _containerize_elements().
    return $self->_containerize_elements(
        $elements,
        {   name                    => $name,
            params                  => $params,
            element_container_class => $element_container_class,
            javascript              => \%javascript,
            toplevel                => 1,
            submitted               => $self->submitted,
        } );
}

# also called by HTML::Element::Block, so code reuse++ again
sub _containerize_elements {
    my ( $self, $elements, $argsref ) = @_;

    my $args = dclone $argsref;    # make copy to pass on
    my ( $element_container_class, $javascript, $name, $params, $toplevel )
        = @$args{qw(element_container_class javascript name params toplevel)};
    delete $args->{toplevel};

    my @content;
    for my $element (@$elements) {
        local $element->{container_class} = $element_container_class
            if $element_container_class;
        local $element->{_anonymous} = 1
            if ( $self->implicit_subcontainer and $toplevel );
        my ( $value, $error ) = ( undef, undef );
        my $ename = $element->{name};
        $value = $params->{$ename} if ( defined($ename) && $params );
        next if ( defined($name) && defined($ename) && ( $ename ne $name ) );
        $value = $params->{$ename} if ( defined($ename) && $params );
        $error = $self->{_errors}->{$ename} if defined $ename;
        my $container = $element->containerize( $self, $value, $error, $args );
        $container->{javascript} ||= '';
        $container->{javascript} .= $javascript->{$ename}
            if ( $ename and $javascript->{$ename} );
        return $container if defined $name;
        push @content, $container;
    }
    return @content;
}

sub find_elements {

    # WARNING: Not safe for subclassing
    return shift->HTML::Widget::find_elements(@_);
}

sub has_errors {
    my ( $self, $name ) = @_;
    my @names = keys %{ $self->{_errors} };
    return @names unless $name;
    return 1 if grep {/$name/} @names;
    return 0;
}

sub param {
    my $self = shift;

    carp 'param method is readonly' if @_ > 1;

    if ( @_ == 1 ) {

        my $param = shift;

        my $valid = $self->valid($param);
        if ( !$valid || ( !exists $self->{_params}->{$param} ) ) {
            return wantarray ? () : undef;
        }

        if ( ref $self->{_params}->{$param} eq 'ARRAY' ) {
            return (wantarray)
                ? @{ $self->{_params}->{$param} }
                : $self->{_params}->{$param}->[0];
        }
        else {
            return (wantarray)
                ? ( $self->{_params}->{$param} )
                : $self->{_params}->{$param};
        }
    }

    return $self->valid;
}

sub params {
    my $self  = shift;
    my @names = $self->valid;
    my %params;
    for my $name (@names) {
        my @values = $self->param($name);
        if ( @values > 1 ) {
            $params{$name} = \@values;
        }
        else {
            $params{$name} = $values[0];
        }
    }
    return \%params;
}

sub valid {
    my ( $self, $name ) = @_;
    my @errors = $self->has_errors;
    my @names;
    if ( $self->strict ) {
        for my $constraint ( @{ $self->{_constraints} } ) {
            my $names = $constraint->names;
            push @names, @$names if $names;
        }
    }
    else {
        @names = keys %{ $self->{_params} };
    }
    my %valid;
CHECK: for my $name (@names) {
        for my $error (@errors) {
            next CHECK if $name eq $error;
        }
        $valid{$name}++;
    }
    my @valid = keys %valid;
    return @valid unless $name;
    return 1 if grep {/\Q$name/} @valid;
    return 0;
}

sub add_valid {
    my ( $self, $key, $value ) = @_;
    $self->{_params}->{$key} = $value;
    return $value;
}

sub add_error {
    my ( $self, $args ) = @_;

    croak "name argument required" unless defined $args->{name};

    $args->{type}    = 'Custom'        if not exists $args->{type};
    $args->{message} = 'Invalid Input' if not exists $args->{message};

    my $error = HTML::Widget::Error->new($args);

    push @{ $self->{_errors}->{ $args->{name} } }, $error;

    return $error;
}

1;