view release on metacpan or  search on metacpan

lib/HTML/FormHandler.pm  view on Meta::CPAN

with 'HTML::FormHandler::Blocks';

use Carp;
use Class::MOP;
use HTML::FormHandler::Result;
use HTML::FormHandler::Field;
use Try::Tiny;
use MooseX::Types::LoadableClass qw/ LoadableClass /;
use namespace::autoclean;
use HTML::FormHandler::Merge ('merge');
use Sub::Name;
use Data::Clone;

use 5.008;


# for consistency in api with field nodes
sub form { shift }
sub is_form { 1 }
sub has_form { 1 }

# Moose attributes
has 'name' => (
    isa     => 'Str',
    is      => 'rw',
    default => sub { return 'form' . int( rand 1000 ) }
);
sub full_name { '' }
sub full_accessor { '' }
has 'parent' => ( is => 'rw' );
has 'result' => (
    isa       => 'HTML::FormHandler::Result',
    is        => 'ro',
    writer    => '_set_result',
    clearer   => 'clear_result',
    lazy      => 1,
    builder   => 'build_result',
    predicate => 'has_result',
    handles   => [
        'input',      '_set_input', '_clear_input', 'has_input',
        'value',      '_set_value', '_clear_value', 'has_value',
        'add_result', 'results',    'validated',    'ran_validation',
        'is_valid',
        'form_errors', 'all_form_errors', 'push_form_errors', 'clear_form_errors',
        'has_form_errors', 'num_form_errors',
    ],
);

sub build_result {
    my $self = shift;
    my $result_class = 'HTML::FormHandler::Result';
    if ( $self->widget_form ) {
        my $role = $self->get_widget_role( $self->widget_form, 'Form' );
        $result_class = $result_class->with_traits( $role );
    }
    my $result = $result_class->new( name => $self->name, form => $self );
    return $result;
}

has 'index' => (
    is => 'ro', isa => 'HashRef[HTML::FormHandler::Field]', traits => ['Hash'],
    default => sub {{}},
    handles => {
        add_to_index => 'set',
        field_from_index => 'get',
        field_in_index => 'exists',
    }
);
has '_repeatable_fields' => ( is => 'rw', isa => 'ArrayRef',
    traits => ['Array'], default => sub {[]},
    handles => {
        add_repeatable_field => 'push',
        has_repeatable_fields => 'count',
        all_repeatable_fields => 'elements',
    },
);

has 'field_traits' => ( is => 'ro', traits => ['Array'], isa => 'ArrayRef',
    default => sub {[]}, handles => { 'has_field_traits' => 'count' } );
has 'widget_name_space' => (
    is => 'ro',
    isa => 'HFH::ArrayRefStr',
    traits => ['Array'],
    default => sub {[]},
    coerce => 1,
    handles => {
        add_widget_name_space => 'push',
    },
);
# it only really makes sense to set these before widget_form is applied in BUILD
has 'widget_form'       => ( is => 'ro', isa => 'Str', default => 'Simple', writer => 'set_widget_form' );
has 'widget_wrapper'    => ( is => 'ro', isa => 'Str', default => 'Simple', writer => 'set_widget_wrapper' );
has 'do_form_wrapper' => ( is => 'rw', builder => 'build_do_form_wrapper' );
sub build_do_form_wrapper { 0 }
has 'no_widgets'        => ( is => 'ro', isa => 'Bool' );
has 'no_preload'        => ( is => 'ro', isa => 'Bool' );
has 'no_update'         => ( is => 'rw', isa => 'Bool', clearer => 'clear_no_update' );
has 'active' => (
    is => 'rw',
    traits => ['Array'],
    isa => 'ArrayRef[Str]',
    default => sub {[]},
    handles => {
        add_active => 'push',
        has_active => 'count',
        clear_active => 'clear',
    }
);
has 'inactive' => (
    is => 'rw',
    traits => ['Array'],
    isa => 'ArrayRef[Str]',
    default => sub {[]},
    handles => {
        add_inactive => 'push',
        has_inactive => 'count',
        clear_inactive => 'clear',
    }
);


# object with which to initialize
has 'init_object'         => ( is => 'rw', clearer => 'clear_init_object' );
has 'update_field_list'   => ( is => 'rw',
    isa => 'HashRef',
    default => sub {{}},
    traits => ['Hash'],
    handles => {
        clear_update_field_list => 'clear',
        has_update_field_list => 'count',
        set_update_field_list => 'set',
    },
);
has 'defaults' => ( is => 'rw', isa => 'HashRef', default => sub {{}}, traits => ['Hash'],
    handles => { has_defaults => 'count', clear_defaults => 'clear' },
);
has 'use_defaults_over_obj' => ( is => 'rw', isa => 'Bool', clearer => 'clear_use_defaults_over_obj' );
has 'use_init_obj_over_item' => ( is => 'rw', isa => 'Bool', clearer => 'clear_use_init_obj_over_item' );

lib/HTML/FormHandler.pm  view on Meta::CPAN

    traits     => ['Hash'],
    isa        => 'HashRef',
    is         => 'rw',
    default    => sub { {} },
    trigger    => sub { shift->_munge_params(@_) },
    handles   => {
        set_param => 'set',
        get_param => 'get',
        clear_params => 'clear',
        has_params => 'count',
    },
);
sub submitted { shift->has_params }
has 'dependency' => ( isa => 'ArrayRef', is => 'rw' );
has '_required' => (
    traits     => ['Array'],
    isa        => 'ArrayRef[HTML::FormHandler::Field]',
    is         => 'rw',
    default    => sub { [] },
    handles   => {
        clear_required => 'clear',
        add_required => 'push',
    }
);

# these messages could apply to either fields or form
has 'messages' => ( is => 'rw',
    isa => 'HashRef',
    traits => ['Hash'],
    builder => 'build_messages',
    handles => {
        '_get_form_message' => 'get',
        '_has_form_message' => 'exists',
        'set_message' => 'set',
    },
);
sub build_messages { {} }

my $class_messages = {};
sub get_class_messages  {
    return $class_messages;
}

sub get_message {
    my ( $self, $msg ) = @_;
    return $self->_get_form_message($msg) if $self->_has_form_message($msg);
    return $self->get_class_messages->{$msg};
}
sub all_messages {
    my $self = shift;
    return { %{$self->get_class_messages}, %{$self->messages} };
}

has 'params_class' => (
    is      => 'ro',
    isa     => LoadableClass,
    coerce  => 1,
    default => 'HTML::FormHandler::Params',
);

has 'params_args' => ( is => 'ro', isa => 'ArrayRef' );

sub BUILDARGS {
    my $class = shift;

    if ( scalar @_ == 1 && ref( $_[0]) ne 'HASH' ) {
        my $arg = $_[0];
        return blessed($arg) ? { item => $arg } : { item_id => $arg };
    }
    return $class->SUPER::BUILDARGS(@_);
}

sub BUILD {
    my $self = shift;

    $self->before_build; # hook to allow customizing forms
    # HTML::FormHandler::Widget::Form::Simple is applied in Base
    $self->apply_widget_role( $self, $self->widget_form, 'Form' )
        unless (  $self->no_widgets || $self->widget_form eq 'Simple' );
    $self->_build_fields;    # create the form fields (BuildFields.pm)
    $self->build_active if $self->has_active || $self->has_inactive || $self->has_flag('is_wizard');
    $self->after_build; # hook for customizing
    return if defined $self->item_id && !$self->item;
    # Load values from object (if any)
    # Would rather not load results at all here, but skipping it breaks
    # existing apps that perform certain actions between 'new' and 'process'.
    # Added fudge flag no_preload to enable skipping.
    # A well-behaved program that always does ->process shouldn't need this preloading.
    unless( $self->no_preload ) {
        if ( my $init_object = $self->use_init_obj_over_item ?
            ($self->init_object || $self->item) : ( $self->item || $self->init_object ) ) {
            $self->_result_from_object( $self->result, $init_object );
        }
        else {
            $self->_result_from_fields( $self->result );
        }
    }
    $self->dump_fields if $self->verbose;
    return;
}
sub before_build {}
sub after_build {}

sub process {
    my $self = shift;

    warn "HFH: process ", $self->name, "\n" if $self->verbose;
    $self->clear if $self->processed;
    $self->setup_form(@_);
    $self->validate_form      if $self->posted;
    $self->update_model       if ( $self->validated && !$self->no_update );
    $self->after_update_model if ( $self->validated && !$self->no_update );
    $self->dump_fields        if $self->verbose;
    $self->processed(1);
    return $self->validated;
}

sub run {
    my $self = shift;
    $self->setup_form(@_);
    $self->validate_form      if $self->posted;