More working code of the experimental form management

Field.pm

package SyContent::Web::Form::Field;

use Moose;

has name => (
	isa => 'Str',
	is => 'ro',
	required => 1,
);

has form => (
	isa => 'SyContent::Web::Form',
	is => 'ro',
	required => 1,
);

has required => (
	isa => 'Bool',
	is => 'ro',
	default => sub { 0 },
);

has notempty => (
	isa => 'Bool',
	is => 'ro',
	default => sub { 0 },
);

has default_value => (
	is => 'rw',
	trigger => sub { shift->reset },
	predicate => 'has_default_value',
);

has input_value => (
	is => 'rw',
	trigger => sub { shift->reset },
	predicate => 'has_input_value',
);

has output_value => (
	is => 'rw',
	predicate => 'has_output_value',
);

has _is_valid => (
	isa => 'Bool',
	is => 'rw',
	predicate => 'is_validated',
	clearer => 'devalidate',
);
sub is_valid { my $self = shift; $self->populate; $self->validate; return $self->_is_valid }

has param_name => (
	is => 'ro',
	isa => 'Str',
	lazy_build => 1,
);

sub _build_param_name {
	my ( $self ) = @_;
	return $self->form->name.$self->form->param_split_char.$self->name;
}

sub reset {
	my ( $self ) = @_;
	$self->devalidate;
	$self->clear_value;
}

has empty_check => (
	is => 'ro',
	isa => 'CodeRef',
	lazy_build => 1,
);

sub _build_empty_check {
	return sub { shift =~ m/^$/ }
}

has required_error => (
	is => 'rw',
	default => sub { 'This field is required' },
);

has notempty_error => (
	is => 'rw',
	default => sub { 'This field may not be empty' },
);

sub validate {
	my ( $self ) = @_;
	return if $self->is_validated;
	if ($self->has_value) {
		my $empty = $self->empty_check->($self->value);
		if ($empty && $self->notempty) {
			$self->add_error($self->notempty_error);
		} elsif (!$empty) {
			for ($self->all_validators) {
				$self->add_error($_) for ($_->($self,$self->value));
			}
		}
	} elsif ( $self->required ) {
		$self->add_error($self->required_error);
	}
	$self->_is_valid($self->has_errors ? 0 : 1);
}

has value => (
	is => 'rw',
	predicate => 'has_value',
	clearer => 'clear_value',
);

sub populate {
	my ( $self ) = @_;
	return if $self->has_value;
	$self->value($self->default_value) if ( $self->has_default_value && !$self->has_input_value );
	$self->input_to_value if ( $self->has_input_value );
	$self->value_to_output if ( $self->has_value );
}

sub submit_errors {
	my ( $self ) = @_;
	return unless $self->form->is_submitted;
	return $self->errors;
}

has errors => (
	traits  => ['Array'],
	is      => 'ro',
	isa     => 'ArrayRef',
	default => sub {[]},
	handles => {
		all_errors => 'elements',
		add_error => 'push',
		count_errors => 'count',
		has_errors => 'count',
		has_no_errors => 'is_empty',
	},
);

has x => (
	traits  => ['Hash'],
	is      => 'ro',
	isa     => 'HashRef',
	default => sub {{}},
);

sub input_to_value {
	my ( $self ) = @_;
	$self->value($self->input_value);
}

sub value_to_output {
	my ( $self ) = @_;
	$self->output_value($self->value);
}

has validators => (
	traits  => ['Array'],
	is      => 'ro',
	isa     => 'ArrayRef[CodeRef]',
	default => sub {[]},
	handles => {
		all_validators => 'elements',
		add_validator => 'push',
		count_validators => 'count',
		has_validators => 'count',
		has_no_validators => 'is_empty',
	},
);

1;

Form.pm

package SyContent::Web::Form;

use Moose;
use SyContent::Web::Form::Field;
use Data::Dumper;

has name => (
	isa => 'Str',
	is => 'ro',
	required => 1,
);

has param_name => (
	isa => 'Str',
	is => 'ro',
	lazy_build => 1,
);

sub _build_param_name { shift->name }

has fields => (
	traits  => ['Array'],
	is      => 'ro',
	isa     => 'ArrayRef[SyContent::Web::Form::Field]',
	default => sub {[]},
	handles => {
		all_fields => 'elements',
		add_field => 'push',
		map_fields => 'map',
		filter_fields => 'grep',
		get_field => 'get',
		count_fields => 'count',
		has_fields => 'count',
		has_no_fields => 'is_empty',
		sorted_fields => 'sort',
	},
);

has validators => (
	traits  => ['Array'],
	is      => 'ro',
	isa     => 'ArrayRef[CodeRef]',
	default => sub {[]},
	handles => {
		all_validators => 'elements',
		add_validator => 'push',
		count_validators => 'count',
		has_validators => 'count',
		has_no_validators => 'is_empty',
	},
);

sub factory {
	my ( $self, $config ) = @_;
	my %input_values = %{delete $config->{input_values}} if defined $config->{input_values};
	my %fields_hash = %{delete $config->{fields}} if defined $config->{fields};
	my %defaults = %{delete $config->{defaults}} if defined $config->{defaults};
	my @fields;
	die "no fields defined" unless %fields_hash;
	my $form = SyContent::Web::Form->new(
		%{$config},
	);
	for (keys %fields_hash) {
		push @fields, $form->field_factory($_, delete $fields_hash{$_}->{type}, $fields_hash{$_});
	}
	for (@fields) {
		$form->add_field($_);
	}
	if (%defaults) {
		$form->insert_defaults(\%defaults);
	}
	if (%input_values) {
		$form->insert_inputs(\%input_values);
		$form->validate;
	}
	return $form;
}

sub result {
	my ( $self ) = @_;
	if ( $self->is_submitted && $self->is_valid ) {
		my %values;
		for ($self->all_fields) {
			$values{$_->name} = $_->value if $_->has_value;
		}
		return \%values;
	}
	return;
}

sub field_factory {
	my ( $self, $name, $type, $attributes ) = @_;
	my $class;
	$class = $type if ($type && $type =~ m/::/);
	$class = 'SyContent::Web::Form::Field' if (!defined $type);
	$class = 'SyContent::Web::Form::Field::'.ucfirst($type) if !$class;
	return $class->new(
		form => $self,
		name => $name,
		%{$attributes},
	);
}

has param_split_char => (
	isa => 'Str',
	is => 'ro',
	default => sub { '_' },
);

has param_split_char_regex => (
	isa => 'Str',
	is => 'ro',
	default => sub { '_' },
);

sub insert_defaults {
	my ( $self, $defaults ) = @_;
	for ($self->all_fields) {
		if (defined $defaults->{$_->name}) {
			$_->default_value($defaults->{$_->name});
		}
	}
}

sub insert_inputs {
	my ( $self, $params ) = @_;
	$self->is_submitted(1) if ($params->{$self->name});
	my $param_split_char_regex = $self->param_split_char_regex;
	for ($self->all_fields) {
		if ($_->can('input_from_params')) {
			$_->input_from_params($params);
		} else {
			my $param_name = $_->param_name;
			if (defined $params->{$param_name}) {
				$_->input_value($params->{$param_name});
			} else {
				my %values;
				for (keys %{$params}) {
					if ($_ =~ m/^${param_name}${param_split_char_regex}(.+)/) {
						$values{$1} = $params->{$_} if defined $params->{$_};
					}
				}
				$_->input_value(\%values) if %values;
			}
		}
	}
}

has _is_valid => (
	isa => 'Bool',
	is => 'rw',
	predicate => 'is_validated',
	clearer => 'devalidate',
);
sub is_valid { my $self = shift; $self->validate; return $self->_is_valid }

has is_submitted => (
	isa => 'Bool',
	is => 'rw',
	clearer => 'unsubmit',
	default => sub { 0 },
);

sub validate {
	my ( $self ) = @_;
	return if $self->is_validated;
	for ($self->all_validators) {
		$self->add_error($_) for ($_->($self));
	}
	my $valid_fields = 1;
	for ($self->all_fields) {
		$valid_fields = 0 if !$_->is_valid;
	}
	$self->_is_valid(!$self->has_errors && $valid_fields ? 1 : 0);
}

has x => (
	traits  => ['Hash'],
	is      => 'ro',
	isa     => 'HashRef',
	default => sub {{}},
);

has errors => (
	traits  => ['Array'],
	is      => 'ro',
	isa     => 'ArrayRef',
	default => sub {[]},
	handles => {
		all_errors => 'elements',
		add_error => 'push',
		count_errors => 'count',
		has_errors => 'count',
		has_no_errors => 'is_empty',
	},
);

1;

usage example.pm

	$c->stash->{form} = SyContent::Web::Form->factory({
		name => 'site_add',
		fields => {
			name => {
				notempty => 1,
				x => {
					template => 'form/widget/text.tt',
					label => 'Name of new site',
				},
			},
		},
		input_values => $c->req->params,
	});