From d5e6d99aa238054b426aa2b714c532e8ed8b13c1 Mon Sep 17 00:00:00 2001 From: David Precious Date: Thu, 7 Dec 2023 11:24:32 +0000 Subject: [PATCH 1/4] Handle multi-line sub attributes For use with Catalyst::Plugin::CheckFileUploadTypes, I needed to provide a fairly long list of acceptable MIME types. This means that my handler code would be e.g.: ```perl sub index_POST: ExpectUploads(image/png image/jpeg application/pdf) { ... } ``` ... which is fine, but the list of types to support grew longer and longer, not helped by some very long MIME types such as `application/vnd.openxmlformats-officedocument.wordprocessingml.document` So, I wanted to make it much more readable, for e.g.: ```perl sub index_POST: ExpectUploads( image/jpeg image/png image/bmp application/pdf application/vnd.openxmlformats-officedocument.wordprocessingml.document application/vnd.openxmlformats-officedocument.spreadsheetml.sheet ) { ... } ``` That looks like it should be fine, but failed, because the code in `Catalyst::Controller::_parse_attrs()` which parse subroutine attributes expected it to be all on line line. This change makes it work correctly for me, both for single-line attributes with and without a value and for multi-lined ones as per the example above too - and makes the parsing code a little more readable too, I think. --- lib/Catalyst/Controller.pm | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/lib/Catalyst/Controller.pm b/lib/Catalyst/Controller.pm index 34ad3505f..661fa5495 100644 --- a/lib/Catalyst/Controller.pm +++ b/lib/Catalyst/Controller.pm @@ -400,14 +400,22 @@ sub _parse_attrs { my %raw_attributes; foreach my $attr (@attrs) { - # Parse out :Foo(bar) into Foo => bar etc (and arrayify) - - if ( my ( $key, $value ) = ( $attr =~ /^(.*?)(?:\(\s*(.+?)?\s*\))?$/ ) ) + if ( my ( $key, $value ) = $attr =~ m{ + \A + (\S*?) # match the key e.g. Foo in example + (?: + \( \s* + (.+?)? # match attr content e.g. "bar" in example + \s* \) + )? + \z + }xms ) { if ( defined $value ) { - ( $value =~ s/^'(.*)'$/$1/ ) || ( $value =~ s/^"(.*)"/$1/ ); + # Unquote single/double quoted attr values e.g. Foo("bar") + ( $value =~ s/^'(.*)'$/$1/s ) || ( $value =~ s/^"(.*)"/$1/s ); } push( @{ $raw_attributes{$key} }, $value ); } From f6257a5db382f8eb0197f689e8f87dfecdf2f743 Mon Sep 17 00:00:00 2001 From: David Precious Date: Thu, 7 Dec 2023 22:17:18 +0000 Subject: [PATCH 2/4] Test multi-line sub attribute handling. Test the changes to allow multi-line sub attributes on handlers, and that normal ones (with and without a value) continue to work as expected. --- t/aggregate/live_component_controller_action_action.t | 8 ++++++++ t/lib/TestApp/Controller/Action/Action.pm | 7 ++++++- 2 files changed, 14 insertions(+), 1 deletion(-) diff --git a/t/aggregate/live_component_controller_action_action.t b/t/aggregate/live_component_controller_action_action.t index 41e2b165c..908ee35fe 100644 --- a/t/aggregate/live_component_controller_action_action.t +++ b/t/aggregate/live_component_controller_action_action.t @@ -190,6 +190,14 @@ sub run_tests { my $action = eval $response->content; is_deeply $action->attributes->{extra_attribute}, [13]; is_deeply $action->attributes->{another_extra_attribute}, ['foo']; + + # Test a multi-line attribute on the action comes through as expected + is_deeply $action->attributes->{MultiLineAttr}, ["one\n two\n three"]; + # and a normal one e.g. `Foo('bar')` + is_deeply $action->attributes->{Foo}, ['bar']; + # and one without a value, e.g. `Baz` - note that the presence of + # the arrayref shows it was there + is_deeply $action->attributes->{Baz}, [undef]; } { ok( my $response = request('http://localhost/action_action_nine'), diff --git a/t/lib/TestApp/Controller/Action/Action.pm b/t/lib/TestApp/Controller/Action/Action.pm index 515fb2a42..66b62b9f0 100644 --- a/t/lib/TestApp/Controller/Action/Action.pm +++ b/t/lib/TestApp/Controller/Action/Action.pm @@ -53,7 +53,11 @@ sub action_action_seven : Global : ActionClass('~TestExtraArgsAction') { $c->forward('TestApp::View::Dump::Request'); } -sub action_action_eight : Global { +sub action_action_eight : Global Foo('bar') MultiLineAttr( + one + two + three +) Baz { my ( $self, $c ) = @_; $c->forward('TestApp::View::Dump::Action'); } @@ -62,4 +66,5 @@ sub action_action_nine : Global : ActionClass('~TestActionArgsFromConstructor') my ( $self, $c ) = @_; $c->forward('TestApp::View::Dump::Request'); } + 1; From 1384412de46df0ef9fcfd821d3b7196ddc471835 Mon Sep 17 00:00:00 2001 From: David Precious Date: Thu, 9 May 2024 17:21:13 +0100 Subject: [PATCH 3/4] Clearer attribute unquoting Replace the two regexes with one. This also fixes a subtle already-present bug in the double-quote unquoting where it's missing the anchor to the end of string - I think that's not actually bitten anyone because the `.*` capture is greedy, so it'll capture as much as it can, so the `"` at the end will match the last double quote, not the first one it sees. --- lib/Catalyst/Controller.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/Catalyst/Controller.pm b/lib/Catalyst/Controller.pm index 661fa5495..7d15dfcd4 100644 --- a/lib/Catalyst/Controller.pm +++ b/lib/Catalyst/Controller.pm @@ -415,7 +415,7 @@ sub _parse_attrs { if ( defined $value ) { # Unquote single/double quoted attr values e.g. Foo("bar") - ( $value =~ s/^'(.*)'$/$1/s ) || ( $value =~ s/^"(.*)"/$1/s ); + $value =~ s/^(['"])(.*)\1$/$2/s; } push( @{ $raw_attributes{$key} }, $value ); } From 5787472308f996a90b6d1c45223204a994487cac Mon Sep 17 00:00:00 2001 From: David Precious Date: Thu, 9 May 2024 17:32:39 +0100 Subject: [PATCH 4/4] Additional test for unquoting multiline attrs As discussed on the PR[1], there was concern around the stripping of quoting from multi-line attrs. Added tests to show that when unquoting a multi-line attribute, inner quotes are left alone. For e.g. ```perl sub do_foo MultiLineAttr(" 'foo', 'bar' ") { ... } ``` ... doesn't have the `'foo'` / `'bar'` unquoted, but the outer quotes go. [1]: https://github.com/perl-catalyst/catalyst-runtime/pull/189#issuecomment-2102952664 --- .../live_component_controller_action_action.t | 35 +++++++++++++++++++ t/lib/TestApp/Controller/Action/Action.pm | 9 +++++ 2 files changed, 44 insertions(+) diff --git a/t/aggregate/live_component_controller_action_action.t b/t/aggregate/live_component_controller_action_action.t index 908ee35fe..9b8b7e14b 100644 --- a/t/aggregate/live_component_controller_action_action.t +++ b/t/aggregate/live_component_controller_action_action.t @@ -199,6 +199,41 @@ sub run_tests { # the arrayref shows it was there is_deeply $action->attributes->{Baz}, [undef]; } + + { + ok( my $response = request('http://localhost/action_action_eightpointfive'), + 'Request' ); + ok( $response->is_success, 'Response Successful 2xx' ); + is( $response->content_type, 'text/plain', 'Response Content-Type' ); + is( $response->header('X-Catalyst-Action'), + 'action_action_eightpointfive', 'Test Action' ); + is( + $response->header('X-Test-Class'), + 'TestApp::Controller::Action::Action', + 'Test Class' + ); + like( + $response->content, + qr/^bless\( .* 'Catalyst::Action' \)$/s, + 'Content is a serialized Catalyst::Action' + ); + + require Catalyst::Action; # when running against a remote server, we + # need to load the class in the test process + # to be able to introspect the action instance + # later. + my $action = eval $response->content; + is_deeply $action->attributes->{extra_attribute}, [13]; + + # Test a multi-line attribute on the action comes through as expected + is_deeply $action->attributes->{MultiLineAttrQuoted}, ["\n 'one'\n 'two'\n 'three'\n"]; + # and a normal one e.g. `Foo('bar')` + is_deeply $action->attributes->{Foo}, ['bar']; + # and one without a value, e.g. `Baz` - note that the presence of + # the arrayref shows it was there + is_deeply $action->attributes->{Baz}, [undef]; + } + { ok( my $response = request('http://localhost/action_action_nine'), 'Request' ); diff --git a/t/lib/TestApp/Controller/Action/Action.pm b/t/lib/TestApp/Controller/Action/Action.pm index 66b62b9f0..74fb71051 100644 --- a/t/lib/TestApp/Controller/Action/Action.pm +++ b/t/lib/TestApp/Controller/Action/Action.pm @@ -62,6 +62,15 @@ sub action_action_eight : Global Foo('bar') MultiLineAttr( $c->forward('TestApp::View::Dump::Action'); } +sub action_action_eightpointfive : Global Foo('bar') MultiLineAttrQuoted(" + 'one' + 'two' + 'three' +") Baz { + my ( $self, $c ) = @_; + $c->forward('TestApp::View::Dump::Action'); +} + sub action_action_nine : Global : ActionClass('~TestActionArgsFromConstructor') { my ( $self, $c ) = @_; $c->forward('TestApp::View::Dump::Request');