package HTML::FormFu::MultiForm;
use Moose;
use MooseX::Attribute::Chained;
with
'HTML::FormFu::Role::FormAndElementMethods' =>
{ -excludes => 'model_config' },
'HTML::FormFu::Role::NestedHashUtils',
'HTML::FormFu::Role::Populate';
use HTML::FormFu;
use HTML::FormFu::Attribute qw(
mk_attrs mk_attr_accessors
mk_inherited_accessors mk_output_accessors
mk_inherited_merging_accessors
);
use HTML::FormFu::ObjectUtil qw(
populate form
clone stash
parent
load_config_file load_config_filestem
_string_equals _object_equals
);
use HTML::FormFu::QueryType::CGI;
use Carp qw( croak );
use Clone ();
use Crypt::CBC;
use List::MoreUtils qw( uniq );
use Scalar::Util qw( blessed refaddr );
use Storable qw( nfreeze thaw );
use overload (
'eq' => '_string_equals',
'==' => '_object_equals',
'""' => sub { return shift->render },
bool => sub {1},
fallback => 1
);
__PACKAGE__->mk_attrs(qw( attributes crypt_args ));
__PACKAGE__->mk_attr_accessors(qw( id action enctype method ));
# accessors shared with HTML::FormFu
our @ACCESSORS = qw(
indicator filename
javascript javascript_src
default_args
query_type
force_error_message localize_class
tt_module nested_name
nested_subscript default_model
model_config auto_fieldset
params_ignore_underscore tmp_upload_dir
);
for my $name (@ACCESSORS) {
has $name => ( is => 'rw', traits => ['Chained'] );
}
has forms => ( is => 'rw', traits => ['Chained'] );
has query => ( is => 'rw', traits => ['Chained'] );
has current_form_number => ( is => 'rw', traits => ['Chained'] );
has current_form => ( is => 'rw', traits => ['Chained'] );
has multiform_hidden_name => ( is => 'rw', traits => ['Chained'] );
has default_multiform_hidden_name => ( is => 'rw', traits => ['Chained'] );
has combine_params => ( is => 'rw', traits => ['Chained'] );
has complete => ( is => 'rw', traits => ['Chained'] );
has _data => ( is => 'rw' );
__PACKAGE__->mk_output_accessors(qw( form_error_message ));
# accessors shared with HTML::FormFu
our @INHERITED_ACCESSORS = qw(
auto_id auto_label
auto_error_class auto_error_message
auto_constraint_class auto_inflator_class
auto_validator_class auto_transformer_class
render_method render_processed_value
force_errors repeatable_count
config_file_path locale
);
__PACKAGE__->mk_inherited_accessors(@INHERITED_ACCESSORS);
# accessors shared with HTML::FormFu
our @INHERITED_MERGING_ACCESSORS = qw(
tt_args
config_callback
);
__PACKAGE__->mk_inherited_merging_accessors(@INHERITED_MERGING_ACCESSORS);
*loc = \&localize;
for my $name ( qw(
persist_stash
_file_fields
) )
{
has $name => (
is => 'rw',
default => sub { [] },
lazy => 1,
isa => 'ArrayRef',
);
}
has languages => (
is => 'rw',
default => sub { ['en'] },
lazy => 1,
isa => 'ArrayRef',
);
sub BUILD {
my ( $self, $args ) = @_;
my %defaults = (
tt_args => {},
model_config => {},
combine_params => 1,
default_multiform_hidden_name => '_multiform',
);
$self->populate( \%defaults );
return $self;
}
sub process {
my ( $self, $query ) = @_;
$query ||= $self->query;
# save it for further calls to process()
if ($query) {
$self->query($query);
}
my $hidden_name = $self->multiform_hidden_name;
if ( !defined $hidden_name ) {
$hidden_name = $self->default_multiform_hidden_name;
}
my $input;
if ( defined $query && blessed($query) ) {
$input = $query->param($hidden_name);
}
elsif ( defined $query ) {
# it's not an object, just a hashref.
# and HTML::FormFu::FakeQuery doesn't work with a MultiForm object
$input = $self->get_nested_hash_value( $query, $hidden_name );
}
my $data = $self->_process_get_data($input);
my $current_form_num;
my @forms;
eval { @forms = @{ $self->forms } };
croak "forms() must be an arrayref" if $@;
if ( defined $data ) {
$current_form_num = $data->{current_form};
my $current_form
= $self->_load_current_form( $current_form_num, $data );
# are we on the last form?
# are we complete?
if ( ( $current_form_num == scalar @forms )
&& $current_form->submitted_and_valid )
{
$self->complete(1);
}
$self->_data($data);
}
else {
# default to first form
$self->_load_current_form(1);
}
return;
}
sub _process_get_data {
my ( $self, $input ) = @_;
return if !defined $input || !length $input;
my $crypt = Crypt::CBC->new( %{ $self->crypt_args } );
my $data;
eval { $data = $crypt->decrypt_hex($input) };
if ( defined $data ) {
$data = thaw($data);
$self->_file_fields( $data->{file_fields} );
# rebless all file uploads as basic CGI objects
for my $name ( @{ $data->{file_fields} } ) {
my $value = $self->get_nested_hash_value( $data->{params}, $name );
_rebless_upload($value);
}
}
else {
# TODO: should handle errors better
$data = undef;
}
return $data;
}
sub _rebless_upload {
my ($value) = @_;
if ( ref $value eq 'ARRAY' ) {
for my $value (@$value) {
_rebless_upload($value);
}
}
elsif ( blessed($value) ) {
bless $value, 'HTML::FormFu::QueryType::CGI';
}
return;
}
sub _load_current_form {
my ( $self, $current_form_num, $data ) = @_;
my $current_form = HTML::FormFu->new;
my $current_data = Clone::clone( $self->forms->[ $current_form_num - 1 ] );
# merge constructor args
for my $key ( @ACCESSORS, @INHERITED_ACCESSORS,
@INHERITED_MERGING_ACCESSORS )
{
my $value = $self->$key;
if ( defined $value ) {
$current_form->$key($value);
}
}
# copy attrs
my $attrs = $self->attrs;
for my $key ( keys %$attrs ) {
$current_form->$key( $attrs->{$key} );
}
# copy stash
my $stash = $self->stash;
while ( my ( $key, $value ) = each %$stash ) {
$current_form->stash->{$key} = $value;
}
# persist_stash
if ( defined $data ) {
for my $key ( @{ $self->persist_stash } ) {
$current_form->stash->{$key} = $data->{persist_stash}{$key};
}
}
# build form
$current_form->populate($current_data);
# add hidden field
if ( ( !defined $self->multiform_hidden_name ) && $current_form_num > 1 ) {
my $field = $current_form->element( {
type => 'Hidden',
name => $self->default_multiform_hidden_name,
} );
$field->constraint( { type => 'Required', } );
}
$current_form->query( $self->query );
$current_form->process;
# combine params
if ( defined $data && $self->combine_params ) {
my $params = $current_form->params;
for my $name ( @{ $data->{valid_names} } ) {
next if $self->nested_hash_key_exists( $params, $name );
my $value = $self->get_nested_hash_value( $data->{params}, $name );
# need to set upload object's parent manually
# for now, parent points to the form
# when formfu fixes this, this code will need updated
_reparent_upload( $value, $current_form );
$current_form->add_valid( $name, $value );
}
}
$self->current_form_number($current_form_num);
$self->current_form($current_form);
return $current_form;
}
sub _reparent_upload {
my ( $value, $form ) = @_;
if ( ref $value eq 'ARRAY' ) {
for my $value (@$value) {
_reparent_upload( $value, $form );
}
}
elsif ( blessed($value) && $value->isa('HTML::FormFu::Upload') ) {
$value->parent($form);
}
return;
}
sub render {
my $self = shift;
my $form = $self->current_form;
croak "process() must be called before render()"
if !defined $form;
if ( $self->complete ) {
# why would you render if it's complete?
# anyway, just show the last form
return $form->render(@_);
}
if ( $form->submitted_and_valid ) {
# return the next form
return $self->next_form->render(@_);
}
# return the current form
return $form->render(@_);
}
sub next_form {
my ($self) = @_;
my $form = $self->current_form;
croak "process() must be called before next_form()"
if !defined $form;
my $current_form_num = $self->current_form_number;
# is there a next form defined?
return if $current_form_num >= scalar @{ $self->forms };
my $form_data = Clone::clone( $self->forms->[$current_form_num] );
my $next_form = HTML::FormFu->new;
# merge constructor args
for my $key ( @ACCESSORS, @INHERITED_ACCESSORS,
@INHERITED_MERGING_ACCESSORS )
{
my $value = $self->$key;
if ( defined $value ) {
$next_form->$key($value);
}
}
# copy attrs
my $attrs = $self->attrs;
while ( my ( $key, $value ) = each %$attrs ) {
$next_form->$key($value);
}
# copy stash
my $current_form = $self->current_form;
my $current_stash = $current_form->stash;
while ( my ( $key, $value ) = each %$current_stash ) {
$next_form->stash->{$key} = $value;
}
# persist_stash
for my $key ( @{ $self->persist_stash } ) {
$next_form->stash->{$key} = $current_form->stash->{$key};
}
# build the form
$next_form->populate($form_data);
# add hidden field
if ( !defined $self->multiform_hidden_name ) {
my $field = $next_form->element( {
type => 'Hidden',
name => $self->default_multiform_hidden_name,
} );
$field->constraint( { type => 'Required', } );
}
$next_form->process;
# encrypt params in hidden field
$self->_save_hidden_data( $current_form_num, $next_form, $form );
return $next_form;
}
sub _save_hidden_data {
my ( $self, $current_form_num, $next_form, $form ) = @_;
my @valid_names = $form->valid;
my $hidden_name = $self->multiform_hidden_name;
if ( !defined $hidden_name ) {
$hidden_name = $self->default_multiform_hidden_name;
}
# don't include the hidden-field's name in valid_names
@valid_names = grep { $_ ne $hidden_name } @valid_names;
my %params;
my @file_fields = @{ $self->_file_fields || [] };
for my $name (@valid_names) {
my $value = $form->param_value($name);
$self->set_nested_hash_value( \%params, $name, $value );
# populate @file_field
if ( ref $value ne 'ARRAY' ) {
$value = [$value];
}
for my $value (@$value) {
if ( blessed($value) && $value->isa('HTML::FormFu::Upload') ) {
push @file_fields, $name;
last;
}
}
}
@file_fields = sort uniq @file_fields;
my $crypt = Crypt::CBC->new( %{ $self->crypt_args } );
my $data = {
current_form => $current_form_num + 1,
valid_names => \@valid_names,
params => \%params,
persist_stash => {},
file_fields => \@file_fields,
};
# persist_stash
for my $key ( @{ $self->persist_stash } ) {
$data->{persist_stash}{$key} = $form->stash->{$key};
}
# save file_fields
$self->_file_fields( \@file_fields );
# to freeze, we need to remove anything that might have a
# file handle or code block
# make sure we restore them, after freezing
my $current_form = $self->current_form;
my $input = $current_form->input;
my $query = $current_form->query;
my $processed_params = $current_form->_processed_params;
my $parent = $current_form->parent;
my $stash = $current_form->stash;
$current_form->input( {} );
$current_form->query( {} );
$current_form->_processed_params( {} );
$current_form->parent( {} );
# empty the stash
%{ $current_form->stash } = ();
# save a map of upload refaddrs to their parent
my %upload_parent;
for my $name (@file_fields) {
next if !$self->nested_hash_key_exists( \%params, $name );
my $value = $self->get_nested_hash_value( \%params, $name );
_save_upload_parent( \%upload_parent, $value );
}
# freeze
local $Storable::canonical = 1;
$data = nfreeze($data);
# restore form
$current_form->input($input);
$current_form->query($query);
$current_form->_processed_params($processed_params);
$current_form->parent($parent);
%{ $current_form->stash } = %$stash;
for my $name (@file_fields) {
next if !$self->nested_hash_key_exists( \%params, $name );
my $value = $self->get_nested_hash_value( \%params, $name );
_restore_upload_parent( \%upload_parent, $value );
}
# store data in hidden field
$data = $crypt->encrypt_hex($data);
my $hidden_field
= $next_form->get_field( { nested_name => $hidden_name, } );
$hidden_field->default($data);
return;
}
sub _save_upload_parent {
my ( $upload_parent, $value ) = @_;
if ( ref $value eq 'ARRAY' ) {
for my $value (@$value) {
_save_upload_parent( $upload_parent, $value );
}
}
elsif ( blessed($value) && $value->isa('HTML::FormFu::Upload') ) {
my $refaddr = refaddr($value);
$upload_parent->{$refaddr} = $value->parent;
$value->parent(undef);
}
return;
}
sub _restore_upload_parent {
my ( $upload_parent, $value ) = @_;
if ( ref $value eq 'ARRAY' ) {
for my $value (@$value) {
_restore_upload_parent( $upload_parent, $value );
}
}
elsif ( blessed($value) && $value->isa('HTML::FormFu::Upload') ) {
my $refaddr = refaddr($value);
$value->parent( $upload_parent->{$refaddr} );
}
return;
}
__PACKAGE__->meta->make_immutable;
1;
__END__
=head1 NAME
HTML::FormFu::MultiForm
=head1 AUTHOR
Carl Franks, C<cfranks@cpan.org>
=head1 LICENSE
This library is free software, you can redistribute it and/or modify it under
the same terms as Perl itself.
=cut