From 402a8c56f1f765d7518574b35e690d36956f802e Mon Sep 17 00:00:00 2001 From: bbrtj Date: Sat, 27 Jul 2024 19:02:24 +0200 Subject: [PATCH 1/5] Fix test for Object::Pad compatibility resolves #16 --- xt/author/01-object-pad.t | 25 +++++++++++++++++-------- 1 file changed, 17 insertions(+), 8 deletions(-) diff --git a/xt/author/01-object-pad.t b/xt/author/01-object-pad.t index 2e64d69..157d616 100644 --- a/xt/author/01-object-pad.t +++ b/xt/author/01-object-pad.t @@ -4,18 +4,25 @@ use warnings; use Test::More; BEGIN { - plan skip_all => 'these tests require Object::Pad' - unless eval { require Object::Pad; }; + my $has_object_pad = eval { + require Object::Pad; + Object::Pad->VERSION('0.57'); + Object::Pad->import; + 1; + }; + + plan skip_all => 'these tests require Object::Pad 0.57' + unless $has_object_pad; } -class ParentForm :repr(HASH) +class ParentForm : repr(HASH) { use Form::Tiny -nomoo; form_field 'f1'; } -class ChildForm isa ParentForm :repr(HASH) +class ChildForm : isa(ParentForm) : repr(HASH) { use Form::Tiny -nomoo; @@ -23,10 +30,12 @@ class ChildForm isa ParentForm :repr(HASH) } my $form = ChildForm->new; -$form->set_input({ - f1 => 'field f1', - f2 => 'field f2', -}); +$form->set_input( + { + f1 => 'field f1', + f2 => 'field f2', + } +); ok $form->valid; can_ok $form, 'form_meta'; From 8f80188cdfec767cb0970428e2e8039d91c79a5a Mon Sep 17 00:00:00 2001 From: bbrtj Date: Sat, 27 Jul 2024 19:04:39 +0200 Subject: [PATCH 2/5] Tidy up, add CI action for checking code tidiness --- .github/workflows/ci.yml | 5 +++++ t/500-subforms/01-default.t | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 6fe5929..865a034 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -41,6 +41,11 @@ jobs: perl -v cpanm -v + - name: Check if the code is tidy + if: ${{ startsWith(matrix.runner, 'ubuntu-') && startsWith(matrix.perl, '5.36') }} + run: | + cpanm --notest Perl::Tidy Code::TidyAll + tidyall -a --check-only - name: Install Test::More if: ${{ startsWith( matrix.perl, '5.10') }} run: | diff --git a/t/500-subforms/01-default.t b/t/500-subforms/01-default.t index e3797da..346f426 100644 --- a/t/500-subforms/01-default.t +++ b/t/500-subforms/01-default.t @@ -63,7 +63,7 @@ subtest 'testing default' => sub { }; subtest 'testing default with error' => sub { - my $form = Form::Parent->new(subform_default => { value1 => [] }); + my $form = Form::Parent->new(subform_default => {value1 => []}); $form->set_input({}); my $err = try sub { From 94772bd2385a3a794b5672c3adc2f11f45060f68 Mon Sep 17 00:00:00 2001 From: Diab Jerius Date: Tue, 23 Jul 2024 13:54:15 -0400 Subject: [PATCH 3/5] horrible proof of concept to add unexpected field names to strict error message --- lib/Form/Tiny/Plugin/Strict.pm | 26 +++++++++++++++++++------- t/251-form-messages.t | 2 +- 2 files changed, 20 insertions(+), 8 deletions(-) diff --git a/lib/Form/Tiny/Plugin/Strict.pm b/lib/Form/Tiny/Plugin/Strict.pm index 6cad1f9..089c8ff 100644 --- a/lib/Form/Tiny/Plugin/Strict.pm +++ b/lib/Form/Tiny/Plugin/Strict.pm @@ -28,7 +28,7 @@ has '_strict_blueprint' => ( sub _check_recursive { - my ($self, $data, $blueprint) = @_; + my ($self, $data, $blueprint, $path ) = @_; return 0 unless defined $blueprint; my $ref = ref $blueprint; @@ -36,17 +36,24 @@ sub _check_recursive if ($ref eq 'ARRAY') { return 0 unless ref $data eq 'ARRAY'; + my $idx; foreach my $value (@$data) { - return 0 - unless $self->_check_recursive($value, $blueprint->[0]); + my @lpath = ( @{$path}, $idx++ ); + if ( ! $self->_check_recursive($value, $blueprint->[0], \@lpath) ) { + @{$path} = @lpath; + return 0; + } } } elsif ($ref eq 'HASH') { return 0 unless ref $data eq 'HASH'; for my $key (keys %$data) { - return 0 - unless $self->_check_recursive($data->{$key}, $blueprint->{$key}); + my @lpath = ( @{$path}, $key ); + if ( ! $self->_check_recursive($data->{$key}, $blueprint->{$key}, \@lpath) ) { + @{$path} = @lpath; + return 0; + } } } else { @@ -67,9 +74,14 @@ sub _check_strict unless $self->is_dynamic; } - my $strict = $self->_check_recursive($input, $blueprint); + my @unexpected_field; + my $strict = $self->_check_recursive($input, $blueprint, \@unexpected_field); if (!$strict) { - $obj->add_error($self->build_error(IsntStrict =>)); + my $field = join( q{.}, @unexpected_field); + my $error = $self->build_error(IsntStrict => ); + $error->set_error( $error->error . ': ' . $field ) + if length($field); + $obj->add_error($error); } return $input; diff --git a/t/251-form-messages.t b/t/251-form-messages.t index 787032c..d534247 100644 --- a/t/251-form-messages.t +++ b/t/251-form-messages.t @@ -54,7 +54,7 @@ subtest 'testing strict message' => sub { ok !$form->valid, 'validation failed ok'; is_deeply $form->errors_hash, { - '' => ['strictmsg'] + '' => ['strictmsg: loose'] }, 'errors ok'; }; From b6381de95868bc37fbe89b58bdf8615a88eddf12 Mon Sep 17 00:00:00 2001 From: bbrtj Date: Sat, 27 Jul 2024 19:27:12 +0200 Subject: [PATCH 4/5] Tidy up POC --- lib/Form/Tiny/Plugin/Strict.pm | 34 +++++++++++++++++----------------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/lib/Form/Tiny/Plugin/Strict.pm b/lib/Form/Tiny/Plugin/Strict.pm index 089c8ff..3a59a86 100644 --- a/lib/Form/Tiny/Plugin/Strict.pm +++ b/lib/Form/Tiny/Plugin/Strict.pm @@ -28,7 +28,7 @@ has '_strict_blueprint' => ( sub _check_recursive { - my ($self, $data, $blueprint, $path ) = @_; + my ($self, $data, $blueprint, $path) = @_; return 0 unless defined $blueprint; my $ref = ref $blueprint; @@ -36,24 +36,24 @@ sub _check_recursive if ($ref eq 'ARRAY') { return 0 unless ref $data eq 'ARRAY'; - my $idx; + my $idx; foreach my $value (@$data) { - my @lpath = ( @{$path}, $idx++ ); - if ( ! $self->_check_recursive($value, $blueprint->[0], \@lpath) ) { - @{$path} = @lpath; - return 0; - } + my @lpath = (@{$path}, $idx++); + if (!$self->_check_recursive($value, $blueprint->[0], \@lpath)) { + @{$path} = @lpath; + return 0; + } } } elsif ($ref eq 'HASH') { return 0 unless ref $data eq 'HASH'; for my $key (keys %$data) { - my @lpath = ( @{$path}, $key ); - if ( ! $self->_check_recursive($data->{$key}, $blueprint->{$key}, \@lpath) ) { - @{$path} = @lpath; - return 0; - } + my @lpath = (@{$path}, $key); + if (!$self->_check_recursive($data->{$key}, $blueprint->{$key}, \@lpath)) { + @{$path} = @lpath; + return 0; + } } } else { @@ -74,13 +74,13 @@ sub _check_strict unless $self->is_dynamic; } - my @unexpected_field; + my @unexpected_field; my $strict = $self->_check_recursive($input, $blueprint, \@unexpected_field); if (!$strict) { - my $field = join( q{.}, @unexpected_field); - my $error = $self->build_error(IsntStrict => ); - $error->set_error( $error->error . ': ' . $field ) - if length($field); + my $field = join(q{.}, @unexpected_field); + my $error = $self->build_error(IsntStrict =>); + $error->set_error($error->error . ': ' . $field) + if length($field); $obj->add_error($error); } From 15f694ec629e6615386d442021a15f0e90bc7001 Mon Sep 17 00:00:00 2001 From: bbrtj Date: Sun, 28 Jul 2024 02:47:31 +0200 Subject: [PATCH 5/5] Improve proof of concept of unexpected field names --- lib/Form/Tiny/Error.pm | 29 ++++++++++++- lib/Form/Tiny/Form.pm | 4 +- lib/Form/Tiny/Manual/Cookbook.pod | 2 +- lib/Form/Tiny/Meta.pm | 3 +- lib/Form/Tiny/Path.pm | 13 +++++- lib/Form/Tiny/Plugin/Strict.pm | 69 +++++++++++++++++-------------- t/031-adding-errors.t | 7 ++-- t/060-strictness.t | 26 ++++++------ t/190-hooks.t | 3 +- t/250-messages.t | 11 ++--- t/251-form-messages.t | 15 +++++-- 11 files changed, 121 insertions(+), 61 deletions(-) diff --git a/lib/Form/Tiny/Error.pm b/lib/Form/Tiny/Error.pm index 8b969fd..96b7d90 100644 --- a/lib/Form/Tiny/Error.pm +++ b/lib/Form/Tiny/Error.pm @@ -32,12 +32,19 @@ sub default_error return 'Unknown error'; } +sub get_error +{ + my ($self) = @_; + + return $self->error; +} + sub as_string { my ($self) = @_; my $field = $self->field // 'general'; - my $error = $self->error; + my $error = $self->get_error; return "$field - $error"; } @@ -79,12 +86,30 @@ sub as_string package Form::Tiny::Error::IsntStrict; - use parent -norequire, 'Form::Tiny::Error'; + use Moo; + use Types::Standard qw(Str); + + extends 'Form::Tiny::Error'; + + has 'extra_field' => ( + is => 'ro', + isa => Str, + required => 1, + ); sub default_error { return 'input data has unexpected fields'; } + + sub get_error + { + my ($self) = @_; + + my $field = $self->extra_field; + my $error = $self->error; + return "$field: $error"; + } } { diff --git a/lib/Form/Tiny/Form.pm b/lib/Form/Tiny/Form.pm index 1b1d789..578ac22 100644 --- a/lib/Form/Tiny/Form.pm +++ b/lib/Form/Tiny/Form.pm @@ -244,7 +244,7 @@ sub add_error if $error->has_field; # unwrap nested form errors - $error = $error->error + $error = $error->get_error if $error->isa('Form::Tiny::Error::NestedFormError'); push @{$self->errors}, $error; @@ -258,7 +258,7 @@ sub errors_hash my %ret; for my $error (@{$self->errors}) { - push @{$ret{$error->field // ''}}, $error->error; + push @{$ret{$error->field // ''}}, $error->get_error; } return \%ret; diff --git a/lib/Form/Tiny/Manual/Cookbook.pod b/lib/Form/Tiny/Manual/Cookbook.pod index feed63b..e7568fc 100644 --- a/lib/Form/Tiny/Manual/Cookbook.pod +++ b/lib/Form/Tiny/Manual/Cookbook.pod @@ -99,7 +99,7 @@ C and translate errors in C hook: my ($self, $error) = @_; $error->set_error( - do_translate($error->error) + do_translate($error->get_error) ); ); diff --git a/lib/Form/Tiny/Meta.pm b/lib/Form/Tiny/Meta.pm index 25713f4..2f023fe 100644 --- a/lib/Form/Tiny/Meta.pm +++ b/lib/Form/Tiny/Meta.pm @@ -522,7 +522,8 @@ reference of parameters, which are the attributes specified above. my $error = $meta->build_error($class => %params); Builds an error of class C<"Form::Tiny::Class::$class"> and uses C<%params> to -contsruct it. If a custom message was defined for this type, it will be used. +contsruct it. If a custom message was defined for this type, it will be used +instead of any error passed in C<%params>. =head3 run_hooks_for diff --git a/lib/Form/Tiny/Path.pm b/lib/Form/Tiny/Path.pm index 6b65a43..433d1e7 100644 --- a/lib/Form/Tiny/Path.pm +++ b/lib/Form/Tiny/Path.pm @@ -113,10 +113,21 @@ sub clone return $self->new(path => [@{$self->path}], meta => [@{$self->meta}]); } +sub prepend +{ + my ($self, $meta, $key) = @_; + $key //= $array_marker + if $meta eq 'ARRAY'; + + unshift @{$self->path}, $key; + unshift @{$self->meta}, $meta; + return $self; +} + sub append { my ($self, $meta, $key) = @_; - $key = $array_marker + $key //= $array_marker if $meta eq 'ARRAY'; push @{$self->path}, $key; diff --git a/lib/Form/Tiny/Plugin/Strict.pm b/lib/Form/Tiny/Plugin/Strict.pm index 3a59a86..d1916e2 100644 --- a/lib/Form/Tiny/Plugin/Strict.pm +++ b/lib/Form/Tiny/Plugin/Strict.pm @@ -5,6 +5,7 @@ use strict; use warnings; use Form::Tiny::Error; +use Form::Tiny::Path; use parent 'Form::Tiny::Plugin'; @@ -28,39 +29,45 @@ has '_strict_blueprint' => ( sub _check_recursive { - my ($self, $data, $blueprint, $path) = @_; - return 0 unless defined $blueprint; - - my $ref = ref $blueprint; - - if ($ref eq 'ARRAY') { - return 0 unless ref $data eq 'ARRAY'; - - my $idx; - foreach my $value (@$data) { - my @lpath = (@{$path}, $idx++); - if (!$self->_check_recursive($value, $blueprint->[0], \@lpath)) { - @{$path} = @lpath; - return 0; - } + my ($self, $data, $blueprint) = @_; + return [{path => Form::Tiny::Path->empty, error => 'unexpected'}] + unless defined $blueprint; + + if (ref $blueprint eq 'ARRAY') { + return [{path => Form::Tiny::Path->empty, error => 'not an array'}] + unless ref $data eq 'ARRAY'; + + my @errors; + foreach my $key (0 .. $#$data) { + my $err = $self->_check_recursive($data->[$key], $blueprint->[0]); + push @errors, map { + $_->{path}->prepend(ARRAY => $key); + $_; + } @$err; } + + return \@errors; } - elsif ($ref eq 'HASH') { - return 0 unless ref $data eq 'HASH'; + elsif (ref $blueprint eq 'HASH') { + return [{path => Form::Tiny::Path->empty, error => 'not an object'}] + unless ref $data eq 'HASH'; + my @errors; for my $key (keys %$data) { - my @lpath = (@{$path}, $key); - if (!$self->_check_recursive($data->{$key}, $blueprint->{$key}, \@lpath)) { - @{$path} = @lpath; - return 0; - } + my $err = $self->_check_recursive($data->{$key}, $blueprint->{$key}); + push @errors, map { + $_->{path}->prepend(HASH => $key); + $_; + } @$err; } + + return \@errors; } else { # we're at leaf and no error occured - we're good. } - return 1; + return []; } sub _check_strict @@ -75,13 +82,15 @@ sub _check_strict } my @unexpected_field; - my $strict = $self->_check_recursive($input, $blueprint, \@unexpected_field); - if (!$strict) { - my $field = join(q{.}, @unexpected_field); - my $error = $self->build_error(IsntStrict =>); - $error->set_error($error->error . ': ' . $field) - if length($field); - $obj->add_error($error); + my $errors = $self->_check_recursive($input, $blueprint, \@unexpected_field); + foreach my $err (@$errors) { + $obj->add_error( + $self->build_error( + 'IsntStrict', + extra_field => $err->{path}->join, + error => $err->{error}, + ) + ); } return $input; diff --git a/t/031-adding-errors.t b/t/031-adding-errors.t index 5a89fdd..fec5a41 100644 --- a/t/031-adding-errors.t +++ b/t/031-adding-errors.t @@ -23,13 +23,14 @@ use Test::Exception; my $form = TestForm->new(input => {}); ok !$form->valid; is scalar @{$form->errors}, 3; -is $form->errors->[0]->error, 'error 1'; +is $form->errors->[0]->get_error, 'error 1'; is $form->errors->[1]->field, 'field'; -is $form->errors->[1]->error, 'error 2'; -is $form->errors->[2]->error, 'error 3'; +is $form->errors->[1]->get_error, 'error 2'; +is $form->errors->[2]->get_error, 'error 3'; dies_ok { $form->add_error(does_not_exist => 'error'); }; done_testing; + diff --git a/t/060-strictness.t b/t/060-strictness.t index 207d08e..16a4958 100644 --- a/t/060-strictness.t +++ b/t/060-strictness.t @@ -12,27 +12,29 @@ my @data = ( [1, {nested => {name => 1}}], [1, {nested => {second => {name => 1}}}], [1, {nested_form => {optional => "yes", int => 1}}], - [0, {nested => "not really"}], - [0, {nested => ["not really"]}], - [0, {nested => {second => 1}}], - [0, {nested_form => {int => 5, nothere => 1}}], - [0, {int => 3, arg2 => 15}], - [0, {arg2 => "more data"}], - [0, {not => {nested => "more data"}}], + [0, {nested => "not really"}, 'general - nested: not an object'], + [0, {nested => ["not really"]}, 'general - nested: not an object'], + [0, {nested => {second => 1}}, 'general - nested.second: not an object'], + [0, {nested_form => {int => 5, nothere => 1}}, 'nested_form - nothere: unexpected'], + [0, {int => 3, arg2 => 15}, 'general - arg2: unexpected'], + [0, {arg2 => "more data"}, 'general - arg2: unexpected'], + [0, {not => {nested => "more data"}}, 'general - not.nested: unexpected'], + [0, {array => [{}, {value => 'x'}]}, 'general - array.1.value: unexpected'], + [0, {not => {'*' => {test => 1}}}, 'general - not.\\*.test: unexpected'], + [0, {'is\\' => {test => 1}}, 'general - is\\\\.test: unexpected'], ); for my $aref (@data) { - my ($result, $input) = @$aref; + my ($result, $input, $error) = @$aref; my $form = TestForm->new(input => $input); is !!$form->valid, !!$result, "validation output ok"; if ($form->valid && $result) { is_deeply($form->fields, $input, "fields do match"); } elsif (!$result) { - for (@{$form->errors}) { - isa_ok($_, "Form::Tiny::Error::IsntStrict"); - } - note Dumper($form->errors) if @{$form->errors} > 1; + is scalar @{$form->errors}, 1, 'error count ok'; + isa_ok($form->errors->[0], "Form::Tiny::Error::IsntStrict"); + is '' . $form->errors->[0], $error, 'error string ok'; } else { note Dumper($form->errors); diff --git a/t/190-hooks.t b/t/190-hooks.t index 8bd6d35..ec66f46 100644 --- a/t/190-hooks.t +++ b/t/190-hooks.t @@ -72,7 +72,7 @@ for my $aref (@data) { } for my $error (@{$form->errors}) { is($error->field, "name.*", "error namespace valid"); - is($error->error, "error got overwritten", "error message ok"); + is($error->get_error, "error got overwritten", "error message ok"); } note Dumper($input); @@ -80,3 +80,4 @@ for my $aref (@data) { } done_testing(); + diff --git a/t/250-messages.t b/t/250-messages.t index 9882fed..a247586 100644 --- a/t/250-messages.t +++ b/t/250-messages.t @@ -41,15 +41,15 @@ for my $error (@{$form->errors}) { for ($error->field) { if (/no_message/) { - $no_message_error = $error->error; + $no_message_error = $error->get_error; } elsif (/plain_message/) { - isnt $error->error, $no_message_error, 'error message is not default'; - like $error->error, qr/just a string/, 'error message ok'; + isnt $error->get_error, $no_message_error, 'error message is not default'; + like $error->get_error, qr/just a string/, 'error message ok'; } elsif (/stringified_message/) { - isnt $error->error, $no_message_error, 'error message is not default'; - like $error->error, qr/it stringifies/, 'error message ok'; + isnt $error->get_error, $no_message_error, 'error message is not default'; + like $error->get_error, qr/it stringifies/, 'error message ok'; } } } @@ -66,3 +66,4 @@ dies_ok { }; done_testing(); + diff --git a/t/251-form-messages.t b/t/251-form-messages.t index d534247..d4ee36a 100644 --- a/t/251-form-messages.t +++ b/t/251-form-messages.t @@ -50,13 +50,22 @@ subtest 'testing invalid format message' => sub { }; subtest 'testing strict message' => sub { - $form->set_input({required => 1, loose => 1}); + $form->set_input({required => 1, loose => 1, nested => {loose => 1}}); ok !$form->valid, 'validation failed ok'; - is_deeply $form->errors_hash, { - '' => ['strictmsg: loose'] + + # ensure deterministic order of errors + my $errors = $form->errors_hash; + @{$errors->{''}} = sort @{$errors->{''}}; + + is_deeply $errors, { + '' => [ + 'loose: strictmsg', + 'nested: strictmsg', + ] }, 'errors ok'; }; done_testing(); +