view release on metacpan or  search on metacpan

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

package Ark::Form;
use utf8;
use Mouse;

use Clone 'clone';
use Exporter::AutoClean;
use HTML::Escape ();
use HTML::Shakan;

extends 'Class::Data::Inheritable';

__PACKAGE__->mk_classdata('_fields_data');
__PACKAGE__->mk_classdata('_fields_data_order');
__PACKAGE__->mk_classdata('_fields_messages');
__PACKAGE__->mk_classdata('_widgets_class');

has _shakan => (
    is       => 'rw',
    isa      => 'HTML::Shakan',
    handles  => [
        qw/has_error load_function_message get_error_messages is_error is_valid
           set_error set_message/, # _shakan->_fvl
        qw/submitted submitted_and_valid fillin_param fillin_params
          param params upload uploads widgets/, # _shakan
    ],
);

has 'id_tmpl' => (
    is      => 'ro',
    isa     => 'Str',
    default => 'id_%s',
);

has context => (
    is       => 'rw',
    isa      => 'Ark::Context',
    weak_ref => 1,
);

has request => (
    is       => 'rw',
    isa      => 'Object',
    required => 1,
);

has fields => (
    is      => 'ro',
    isa     => 'HashRef',
    lazy    => 1,
    default => sub {
        my $self = shift;

        my $fields = {};

        for my $name (@{ $self->_fields_data_order }) {
            my %params = %{ clone $self->_fields_data->{ $name } };

            my $field;
            my $type = delete $params{type}
                or die 'type parameter is required';

            if (my $cv = delete $params{custom_validation}) {
                $params{custom_validation} = sub { $cv->($self, @_) };
            }

            if (ref $params{choices} eq 'CODE') {
                $params{choices} = $params{choices}->();
            }

            if ($self->needs_localize) {
                if (my $label = delete $params{label}) {
                    $params{label} = $self->localize($label);
                }

                if (my $choices = delete $params{choices}) {
                    $params{choices} = [];
                    while (my ($v, $l) = splice @$choices, 0, 2) {
                        push @{ $params{choices} }, $v, $self->localize($l);
                    }
                }
            }

            if (my ($func) = grep { $type eq $_ } @HTML::Shakan::Fields::EXPORT) {
                $field = $self->can($func)->(%params);