view release on metacpan or  search on metacpan

lib/Ark/Form.pm  view on Meta::CPAN

                    );
                }
            }
            $target->set_param_data(@_);
        },
        widgets => sub {
            Mouse::load_class($_[0]);
            $target->_widgets_class($_[0]);
        },
    );

    {
        no strict 'refs';
        *{"$target\::x"} = \&x;
    }
}

sub BUILDARGS {
    my ($self, $request, $context) = @_;

    return {
        request => $request,
        $context ? (context => $context) : (),
    };
}

sub BUILD {
    my $self = shift;
    $self->reset;
}

sub reset {
    my $self = shift;

    my $fields = $self->fields;

    $self->_shakan( HTML::Shakan->new(
        request => $self->request,
        fields  => [map { $fields->{$_} } @{ $self->_fields_data_order }],
        $self->can('custom_validation')
            ? (custom_validation => sub { $self->custom_validation(@_) }) : (),
        $self->_widgets_class
            ? (widgets => $self->_widgets_class) : (),
    ));
}

sub field {
    my ($class, $name, $value) = @_;

    if ($value) {
        $class->fields->{ $name } = $value;
    }

    $class->fields->{ $name };
}

sub set_param_data {
    my ($self, $name, %params) = @_;

    my $overwrite = $name =~ s/^\+//;
    my $class     = caller(1);

    $params{name} = $name;

    $class->_fields_messages({}) unless $class->_fields_messages;
    if (my $messages = delete $params{messages}) {
        for my $func (keys %{ $messages || {} }) {
            my $message = $messages->{$func};
            $class->_fields_messages->{ "$name.$func" } = $message;
        }
    }

    $class->_fields_data({}) unless $class->_fields_data;
    if ($overwrite) {
        my $data = $class->_fields_data->{ $name }
            or die qq{param "$name" does not defined by parent class};

        while (my ($k, $v) = each %params) {
            $data->{ $k } = $v;
        }
    }
    else {
        $params{attr} ||= {};
        defined $params{$_} and $params{attr}{$_} ||= $params{$_} for qw/id name value/;

        $class->_fields_data->{ $name } = \%params;
    }

    $class->_fields_data_order([]) unless $class->_fields_data_order;
    push @{ $class->_fields_data_order }, $name
        unless grep { $_ eq $name } @{ $class->_fields_data_order };
}

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

    my $field = $self->field($name) or return;
    my $label = $field->label or return;

    unless ($field->id) {
        $field->id(sprintf($self->id_tmpl, $name));
    }

    sprintf q{<label for="%s">%s</label>},
        HTML::Escape::escape_html($field->id), HTML::Escape::escape_html($label);
}

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

    my $field = $self->field($name) or return;
    $self->widgets->render( $self, $field );
}

sub render {
    my ($self, $name) = @_;
    return $self->_shakan->render unless $name;

    my $res = ($self->label($name) || '')
            . ($self->input($name) || '')
            . ($self->error_message($name) || '');