Some experimental form class

Form.pm

package SyContent::Web::Form;

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

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

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 $name = delete $config->{name};
	my @validators = @{delete $config->{validators}};
	my %params = %{delete $config->{params}};
	my %fields = %{delete $config->{fields}};
	my %defaults = %{delete $config->{defaults}};
	my @fields;
	for (keys %fields) {
		push @fields, $self->get_field($_, delete $fields{$_}->{type}, $fields{$_});
	}
	die "no fields" unless @fields;
	my $form = SyContent::Web::Form->new(
		name => $name,
		validators => \@validators,
		fields => \@fields,
		%{$config},
	);
	if (%defaults) {
		$form->insert_defaults(\%defaults);
	}
	if (%params) {
		$form->insert_inputs(\%params);
		$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;
}

sub get_field {
	my ( $self, $name, $type, $attributes ) = @_;
	my $class;
	$class = $type if ($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($params->{$param_name});
		}
	}
}

sub insert_inputs {
	my ( $self, $params ) = @_;
	$self->_is_submitted(1) if ($params{$self->name});
	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;
	$self->add_error($self->required_error) if ( $self->required && !$self->has_value );
	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 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;

Form::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',
	required => 1,
);

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->depopulate;
}

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

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

has value => (
	is => 'rw',
	predicate => 'is_populated',
	clearer => 'depopulate',
);

sub populate {
	my ( $self ) = @_;
	return if $self->is_populated;
	$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 );
}

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',
	},
);

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;