Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Use Util::MetaRole in H::F::Moose; support has_field in roles

  • Loading branch information...
commit a8c1f232cbf54026a0120d058153a76336de4ffe 1 parent 06b3b7f
gerda.shank@gmail.com authored
View
190 lib/HTML/FormHandler.pm
@@ -139,51 +139,10 @@ L<HTML::FormHandler::Manual>.
=head2 has_field
-This is not actually a Moose attribute. It is just sugar to allow the
-declarative specification of fields. It will not create accessors for the
-fields. The 'type' is not a Moose type, but an L<HTML::FormHandler::Field>
-type. To use this sugar, you must do
-
- use HTML::FormHandler::Moose;
-
-instead of C< use Moose; >. Don't forget C< no HTML::FormHandler::Moose; > at
-the end of the package. Use the syntax:
+See L<HTML::FormHandler::Manual::Intro> for a description of the 'has_field'
+syntax.
has_field 'title' => ( type => 'Text', required => 1 );
- has_field 'authors' => ( type => 'Select' );
-
-instead of:
-
- has '+field_list' => ( default => sub { {
- fields => {
- title => {
- type => 'Text',
- required => 1,
- },
- authors => 'Select',
- }
- }
- }
- );
-
-or:
-
- sub field_list {
- return {
- fields => {
- title => {
- type => 'Text',
- required => 1,
- },
- authors => 'Select',
- }
- }
- }
-
-Fields specified in a field_list will overwrite fields specified with 'has_field'.
-After processing, fields live in the 'fields' array, and can be accessed with the
-field method: C<< $form->field('title') >>.
-
=head2 field_list
@@ -460,14 +419,16 @@ has 'submit' => ( is => 'rw' );
=head2 params
Stores HTTP parameters.
-Also: set_param, get_param, _params, delete_param, from
-Moose 'Collection::Hash' metaclass. The 'munge_params'
+Also: set_param, get_param, clear_params, delete_param,
+has_params from Moose 'Collection::Hash' metaclass. The 'munge_params'
method is called whenever params is set
-The 'set_param' method could be used to add an additional field
-input:
+The 'set_param' method could be used to add additional field
+input that doesn't come from the HTML form, similar to a hidden field:
- $form->set_param('title', 'This is a title');
+ my $form = MyApp::Form->new( $item, $params );
+ $form->set_param('comment', 'updated by edit form');
+ return unless $form->update;
=cut
@@ -650,8 +611,7 @@ This method can also be used for non-database forms:
$form->process( params => $params );
-The return value of this method tells you whether the form validated.
-There is no need to check the 'validated' flag.
+This method returns the 'validated' flag. (C<< $form->validated >>)
=cut
@@ -683,10 +643,10 @@ sub update
warn "HFH: update ", $self->name, "\n" if $self->verbose;
$self->init_from_object;
$self->load_options;
- my $validated = $self->validate if $self->has_params;
- $self->update_model if $validated;
+ $self->validate if $self->has_params;
+ $self->update_model if $self->validated;
$self->dump_fields if $self->verbose;
- return $validated;
+ return $self->validated;
}
=head2 validate
@@ -746,23 +706,14 @@ sub validate
{
# Trim values and move to "input" slot
$field->input( $field->trim_value( $params->{$field->full_name} ) )
- if $params->{$field->full_name};
+ if exists $params->{$field->full_name};
next if $field->clear; # Skip validation
# Validate each field and "inflate" input -> value.
- $field->validate_field;
+ $field->validate_field; # this calls the field's 'validate' routine
next unless defined $field->value;
# these methods have access to the inflated values
- my $field_name = $field->name;
- my $prefix = $self->name_prefix;
- $field_name =~ s/^$prefix\.//g if $prefix;
- my $method = 'validate_' . $field_name;
- $self->$method($field) if $self->can($method);
- $method = $field->validate_meth;
+ my $method = $field->validate_meth;
$self->$method($field) if $method && $self->can($method);
- if ( $self->verbose )
- {
- my $field_validated = $field->has_errors ? 'has errors' : 'validated';
- }
}
$self->cross_validate($params);
@@ -781,14 +732,19 @@ sub validate
$self->validated( !$errors );
$self->dump_validated if $self->verbose;
+ $_->clear_input for $self->fields;
-
return $self->validated;
}
=head2 db_validate
Convenience function to allow validating values in the database object.
+This is not intended for use with HTML forms. If you've written some nice
+validators for form data, but there is unvalidated data in the
+database, this function could be used in a script to check the validity
+of values in the database. See the test script in
+L<HTML::FormHandler::Manual::Intro>, and the t/db_validate.t test.
my $form = MyApp::Form::Book->new( item => $item );
my $validated = $form->db_validate;
@@ -855,8 +811,7 @@ sub clear_values
my $self = shift;
for ( $self->fields )
{
- $_->value(undef);
- $_->input(undef);
+ $_->clear_value;
$_->clear_errors;
}
}
@@ -896,50 +851,13 @@ sub dump_validated
for $self->fields;
}
-=head2 init_from_object
-
-Populates the field 'value' attributes from $form->item
-by calling a form's custom init_value_$fieldname method, passing in
-the field and the item. If a custom init_value_ method doesn't exist,
-uses the generic 'init_value' routine from the model.
-
-The value is stored in both the 'init_value' attribute, and the 'value'
-attribute.
-
-=cut
-
-sub init_from_object
-{
- my $self = shift;
-
- $self->item( $self->build_item ) if $self->item_id && !$self->item;
- my $item = $self->init_object || $self->item || return;
- warn "HFH: init_from_object ", $self->name, "\n" if $self->verbose;
- for my $field ( $self->fields )
- {
- my @values;
- my $method = 'init_value_' . $field->name;
- if ( $self->can($method) )
- {
- @values = $self->$method( $field, $item );
- }
- else
- {
- @values = $self->init_value( $field, $item );
- }
- my $value = @values > 1 ? \@values : shift @values;
-
- # Handy for later compare
- $field->init_value($value);
- $field->value($value);
- }
-}
-
-
=head2 fif (fill in form)
Returns a hash of values suitable for use with HTML::FillInForm
or for filling in a form with C<< $form->fif->{fieldname} >>.
+The fif value for a 'title' field in a TT form:
+
+ [% form.fif.title %]
=cut
@@ -1217,9 +1135,21 @@ sub _build_meta_field_list
my @field_list;
foreach my $sc ( reverse $self->meta->linearized_isa )
{
- if ( $sc->meta->can('field_list') && defined $sc->meta->field_list )
+ my $meta = $sc->meta;
+ my $role_comp = $meta->roles->[0];
+ if( $role_comp )
{
- push @field_list, @{$sc->meta->field_list};
+ foreach my $role ( @{$role_comp->get_roles} )
+ {
+ if ( $role->can('field_list') && defined $role->field_list )
+ {
+ push @field_list, @{$role->field_list};
+ }
+ }
+ }
+ if ( $meta->can('field_list') && defined $meta->field_list )
+ {
+ push @field_list, @{$meta->field_list};
}
}
return \@field_list if scalar @field_list;
@@ -1314,6 +1244,46 @@ sub make_field
return $field;
}
+=head2 init_from_object
+
+Populates the field 'value' attributes from $form->item
+by calling a form's custom init_value_$fieldname method, passing in
+the field and the item. If a custom init_value_ method doesn't exist,
+uses the generic 'init_value' routine from the model.
+
+The value is stored in both the 'init_value' attribute, and the 'value'
+attribute.
+
+=cut
+
+sub init_from_object
+{
+ my $self = shift;
+
+ $self->item( $self->build_item ) if $self->item_id && !$self->item;
+ my $item = $self->init_object || $self->item || return;
+ warn "HFH: init_from_object ", $self->name, "\n" if $self->verbose;
+ for my $field ( $self->fields )
+ {
+ my @values;
+ my $method = 'init_value_' . $field->name;
+ if ( $self->can($method) )
+ {
+ @values = $self->$method( $field, $item );
+ }
+ else
+ {
+ @values = $self->init_value( $field, $item );
+ }
+ my $value = @values > 1 ? \@values : shift @values;
+
+ # Handy for later compare
+ $field->init_value($value);
+ $field->value($value);
+ }
+}
+
+
=head2 load_options
For 'Select' or 'Multiple' fields (fields which have an 'options' method),
View
37 lib/HTML/FormHandler/Field.pm
@@ -126,6 +126,8 @@ The user does not need to set this field except in validation methods.
has 'value' => (
is => 'rw',
+ clearer => 'clear_value',
+ predicate => 'has_value',
trigger => sub {
my ( $self, $value ) = @_;
$self->fif($self->fif_value($value))
@@ -137,16 +139,19 @@ has 'value' => (
=head2 input
Input value for the field, moved from the parameter hash.
-The setter for this attribute is for internal use for fields
-in L<HTML::FormHandler>. If you want to set an input value, use
-the 'set_param' method. A field validation routine may copy
-the value of this attribute to the 'value' attribute. A change in this
-attribute triggers setting 'fif'.
+In L<HTML::FormHandler>, the setter for this attribute is for internal
+use. If you want to set an input value, use the 'set_param' method.
+A field validation routine may copy the value of this attribute to
+the 'value' attribute. The setter may be used in field tests and
+if a field class is used standalone. A change in this attribute triggers
+setting 'fif'.
=cut
has 'input' => (
is => 'rw',
+ clearer => 'clear_input',
+ predicate => '_has_input',
trigger => sub {
my ( $self, $input ) = @_;
$self->fif($input)
@@ -501,10 +506,26 @@ has 'errors' => (
=head2 validate_meth
Specify the form method to be used to validate this field.
+The default is C<< 'validate_' . $field->name >>. (Periods in
+field names will be changed to underscores.) If you have
+a number of fields that require the same validation and don't
+want to write a field class, you could set them all to the same
+method name.
+
+ has_field 'title' => ( isa => 'Str', validate_meth => 'check_title' );
+ has_field 'subtitle' => ( isa => 'Str', validate_meth => 'check_title' );
=cut
-has 'validate_meth' => ( isa => 'Str', is => 'rw' );
+has 'validate_meth' => ( isa => 'Str', is => 'rw', lazy => 1,
+ default => sub {
+ my $self = shift;
+ my $name = $self->name;
+ $name =~ s/\./_/g;
+ return 'validate_' . $name;
+ }
+);
+
# tell Moose to make this class immutable
__PACKAGE__->meta->make_immutable;
@@ -624,7 +645,7 @@ sub validate_field
my $field = shift;
$field->clear_errors;
- $field->value(undef);
+ $field->clear_value;
# See if anything was submitted
unless ( $field->has_input )
@@ -791,7 +812,7 @@ Returns true if $self->input contains any non-blank input.
sub has_input
{
my ($self) = @_;
-
+ return unless $self->_has_input;
my $value = $self->input;
# check for one value as defined
return grep { /\S/ } @$value
View
80 lib/HTML/FormHandler/Manual/Intro.pod
@@ -160,8 +160,11 @@ You can also create a new form on each request with new:
Here you use 'update', because 'process' is a convenience function
that calls 'clear' and 'update', and you don't want to clear. There is
-normally no need to check the 'validated' flag, since that is the
-return value from the 'process', 'update', and 'validate' methods.
+often no need to check the 'validated' flag, since that is the
+return value from the 'process', 'update', and 'validate' methods,
+although it can be useful if you are doing anything between the
+update/process/validate call and displaying the form, such as setting
+the fillinform stash key.
Form processing is a two-pass operation. The first time through
the parameters will be an empty hashref, since the form has not been
@@ -201,9 +204,9 @@ methods, you will need to set that up yourself in an 'end' routine
or a finalize method. One option would be to set the 'fif' hash in a
stash variable:
- my $validated = $self->form->process( ... );
+ $self->form->process( ... );
$c->stash( fillinform => $self->form->fif );
- return unless $validated;
+ return unless $form->validated;
and then check for the stash variable in your end routine and call
FillInForm:
@@ -246,7 +249,67 @@ from the database. The database row is stored in the form's "item" attribute.
The C<< $form->process >> or C<< $form->update >> methods will validate
the parameters and then update or create the database row object.
+=head1 has_field
+This is not actually a Moose attribute. It is just sugar to allow the
+declarative specification of fields. It will not create accessors for the
+fields. The 'type' is not a Moose type, but an L<HTML::FormHandler::Field>
+type. To use this sugar, you must do
+
+ use HTML::FormHandler::Moose;
+
+instead of C< use Moose; >. Don't forget C< no HTML::FormHandler::Moose; > at
+the end of the package. Use the syntax:
+
+ has_field 'title' => ( type => 'Text', required => 1 );
+ has_field 'authors' => ( type => 'Select' );
+
+instead of:
+
+ sub field_list {
+ return {
+ fields => {
+ title => {
+ type => 'Text',
+ required => 1,
+ },
+ authors => 'Select',
+ }
+ }
+ }
+
+Fields specified in a field_list will overwrite fields specified with 'has_field'.
+After processing, fields live in the 'fields' array, and can be accessed with the
+field method: C<< $form->field('title') >>.
+
+Forms with 'has_field' field declarations may be subclassed. Or use
+L<HTML::FormHandler::Moose::Role> to create roles with the 'has_field' syntax:
+
+ package Form::Role::Address;
+
+ use HTML::FormHandler::Moose::Role;
+
+ has_field 'street' => ( type => 'Text', size => '50' );
+ has_field 'city' => ( type = 'Text', size => 24 );
+ has_field 'state' => ( type => 'Select );
+ has_field 'zip' => ( type => '+Zip', required => 1 );
+
+ no HTML::FormHandler::Moose::Role;
+ 1;
+
+You can use roles to define fields and validations and include them in form
+classes using 'with':
+
+ package Form::Member;
+ use HTML::FormHandler::Moose;
+ with ('Form::Role::Person', 'Form::Role::Address');
+ extends 'HTML::FormHandler::Model::DBIC';
+
+ has_field 'user_name' => ( type => 'Text', required => 1 );
+
+ no HTML::FormHandler::Moose;
+ 1;
+
=head1 The form field_list
Returns a hashref of field definitions.
@@ -474,6 +537,15 @@ Do per-field validation customization not handled by the Field class.
if $field->value < 18;
}
+A different form method name for this can be specified with the field's
+'validate_meth' attribute:
+
+ has_field 'age' => ( type => 'Text', validate_meth => 'check_age' );
+
+ sub check_age {
+ ...
+ }
+
=item cross_validate
Handle cross-field validation, or any validation that needs to be done after the entire
View
12 lib/HTML/FormHandler/Meta/Class.pm → lib/HTML/FormHandler/Meta/Role.pm
@@ -1,11 +1,11 @@
package # hide from Pause
- HTML::FormHandler::Meta::Class;
-use Moose;
-extends 'Moose::Meta::Class';
+ HTML::FormHandler::Meta::Role;
+
+use Moose::Role;
=head1 NAME
-HTML::FormHandler::Meta::Class
+HTML::FormHandler::Meta::Role
=head1 SYNOPSIS
@@ -22,8 +22,10 @@ Gerda Shank, gshank@cpan.org
=head1 COPYRIGHT
-Same terms as Perl itself.
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
=cut
+no Moose::Role;
1;
View
16 lib/HTML/FormHandler/Moose.pm
@@ -1,7 +1,10 @@
package HTML::FormHandler::Moose;
+use Moose;
use Moose::Exporter;
-use HTML::FormHandler::Meta::Class;
+use Moose::Util::MetaRole;
+use HTML::FormHandler::Meta::Role;
+
=head1 NAME
@@ -30,8 +33,15 @@ Moose::Exporter->setup_import_methods(
);
sub init_meta {
- my $self = shift;
- Moose->init_meta( @_, metaclass => 'HTML::FormHandler::Meta::Class' );
+ my $class = shift;
+
+ my %options = @_;
+ Moose->init_meta( %options );
+ my $meta = Moose::Util::MetaRole::apply_metaclass_roles(
+ for_class => $options{for_class},
+ metaclass_roles => ['HTML::FormHandler::Meta::Role'],
+ );
+ return $meta;
}
sub has_field
View
64 lib/HTML/FormHandler/Moose/Role.pm
@@ -0,0 +1,64 @@
+package HTML::FormHandler::Moose::Role;
+
+use Moose::Role;
+use Moose::Exporter;
+
+=head1 NAME
+
+HTML::FormHandler::Moose::Role - to add FormHandler sugar to Roles
+
+=head1 SYNOPSIS
+
+Enables the use of field specification sugar (has_field) in roles.
+Use this module instead of C< use Moose::Role; >
+
+ package MyApp::Form::Foo;
+ use HTML::FormHandler::Moose::Role;
+
+ has_field 'username' => ( type => 'Text', ... );
+ has_field 'something_else' => ( ... );
+
+ no HTML::FormHandler::Moose::Role;
+ 1;
+
+=cut
+
+Moose::Exporter->setup_import_methods(
+ with_caller => [ 'has_field' ],
+ also => 'Moose::Role',
+);
+
+sub init_meta {
+ my $class = shift;
+
+ my %options = @_;
+ Moose::Role->init_meta( %options );
+ my $meta = Moose::Util::MetaRole::apply_metaclass_roles(
+ for_class => $options{for_class},
+ metaclass_roles => ['HTML::FormHandler::Meta::Role'],
+ );
+ return $meta;
+}
+
+sub has_field
+{
+ my ( $class, $name, %options ) = @_;
+
+ my $value = $class->meta->field_list || [];
+ push @{$value}, ($name => \%options);
+ $class->meta->field_list($value);
+}
+
+=head1 AUTHOR
+
+Gerda Shank, gshank@cpan.org
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
+
+
+1;
View
7 t/errors.t
@@ -19,7 +19,10 @@ use_ok( 'HTML::FormHandler' );
},
fruit => 'Select',
optname => 'Text',
- silly_name => 'Text',
+ silly_name => {
+ type =>'Text',
+ validate_meth => 'valid_silly'
+ }
},
};
}
@@ -30,7 +33,7 @@ use_ok( 'HTML::FormHandler' );
3 => 'kiwi',
);
}
- sub validate_silly_name
+ sub valid_silly
{
my ( $self, $field ) = @_;
$field->add_error( 'Not a valid silly_name' )
View
13 t/fif.t
@@ -6,7 +6,7 @@ use lib 't/lib';
BEGIN {
eval "use DBIx::Class";
plan skip_all => 'DBIX::Class required' if $@;
- plan tests => 18;
+ plan tests => 20;
}
use_ok( 'HTML::FormHandler' );
@@ -46,15 +46,13 @@ is_deeply( $fif, {
pages => '702',
}, 'get form fif' );
-$form->clear_state;
-
$fif->{pages} = '501';
$form = BookDB::Form::Book->new(item => $book, schema => $schema, params => $fif);
ok( $form, 'use params parameters on new' );
is( $form->field('pages')->fif, 702, 'get field fif value' );
-is( $form->params->{pages}, '501', 'params contains new value' );
+is( $form->get_param('pages'), '501', 'params contains new value' );
is( $form->field('author')->fif, 'S.Else', 'get another field fif value' );
@@ -62,12 +60,17 @@ my $validated = $form->validate;
ok( $validated, 'validated without params' );
+is( $form->field('author')->fif, 'S.Else', 'get field fif value after validate' );
+ok( !$form->field('author')->has_input, 'no input for field');
+
+
$form->clear_state;
my $params = {
title => 'Testing form',
isbn => '02340234',
pages => '699',
author => 'J.Doe',
+ publisher => '',
};
$form = BookDB::Form::Book->new(item => $book, schema => $schema, params => $params);
@@ -84,5 +87,5 @@ is_deeply( $form->fif, {
title => 'Testing form',
isbn => '02340234',
pages => '699',
- author => 'J.Doe'}, 'get form fif after validation' );
+ author => 'J.Doe' }, 'get form fif after validation' );
View
10 t/form_handler.t
@@ -1,7 +1,7 @@
use strict;
use warnings;
use Test::More;
-my $tests = 15;
+my $tests = 18;
plan tests => $tests;
use_ok( 'HTML::FormHandler' );
@@ -17,6 +17,8 @@ use_ok( 'HTML::FormHandler' );
has_field 'reqname' => ( required => 1 );
+ has_field 'somename';
+
sub field_list {
return {
fields => {
@@ -50,11 +52,17 @@ my $good = {
};
ok( $form->validate( $good ), 'Good data' );
+is( $form->field('somename')->value, undef, 'no value for somename');
+ok( !$form->field('somename')->has_value, 'predicate no value');
+$form->field('somename')->input('testing');
+$form->validate;
+is( $form->field('somename')->value, 'testing', 'use input for extra data');
ok( !$form->validate( {} ), 'form doesn\'t validate with empty params' );
is( $form->num_errors, 0, 'form doesn\'t have errors with empty params' );
my $bad_1 = {
+ reqname => '',
optname => 'not req',
fruit => 4,
};
View
21 t/has_field.t
@@ -1,35 +1,32 @@
-use Test::More tests => 14;
+use Test::More tests => 18;
use lib 't/lib';
use_ok( 'HTML::FormHandler' );
use_ok( 'Form::Two' );
-
my $form = Form::Two->new;
-
ok( $form, 'get subclassed form' );
-
is( $form->field('optname')->temp, 'Txxt', 'new field');
-
ok( $form->field('reqname'), 'get old field' );
-
ok( $form->field('fruit'), 'fruit field' );
use_ok( 'Form::Test' );
-
$form = Form::Test->new;
-
ok( $form, 'get base form' );
ok( !$form->field_exists('new_field'), 'no new field');
ok( $form->field_exists('optname'), 'base field exists');
+# forms with multiple inheritance
use_ok( 'Form::Multiple' );
-
$form = Form::Multiple->new;
-
ok( $form, 'create multiple inheritance form' );
-
ok( $form->field('city'), 'field from superclass exists' );
-
ok( $form->field('telephone'), 'field from other superclass exists' );
+
+# forms with roles
+use_ok( 'Form::MultipleRole');
+$form = Form::MultipleRole->new;
+ok( $form, 'get form with roles' );
+ok( $form->field_exists('street'), 'field from Address role' );
+ok( $form->field_exists('email'), 'field from Person role' );
View
2  t/lib/BookDB/Form/BookAuto.pm
@@ -40,7 +40,7 @@ sub field_list {
#}
-sub validate_year {
+sub validate_book_year {
my ( $self, $field ) = @_;
$field->add_error('Invalid year')
if (($field->value > 3000) || ($field->value < 1600));
Please sign in to comment.
Something went wrong with that request. Please try again.