Skip to content

Commit d5e6d99

Browse files
committed
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.
1 parent 7c1f15f commit d5e6d99

File tree

1 file changed

+12
-4
lines changed

1 file changed

+12
-4
lines changed

lib/Catalyst/Controller.pm

Lines changed: 12 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -400,14 +400,22 @@ sub _parse_attrs {
400400
my %raw_attributes;
401401

402402
foreach my $attr (@attrs) {
403-
404403
# Parse out :Foo(bar) into Foo => bar etc (and arrayify)
405-
406-
if ( my ( $key, $value ) = ( $attr =~ /^(.*?)(?:\(\s*(.+?)?\s*\))?$/ ) )
404+
if ( my ( $key, $value ) = $attr =~ m{
405+
\A
406+
(\S*?) # match the key e.g. Foo in example
407+
(?:
408+
\( \s*
409+
(.+?)? # match attr content e.g. "bar" in example
410+
\s* \)
411+
)?
412+
\z
413+
}xms )
407414
{
408415

409416
if ( defined $value ) {
410-
( $value =~ s/^'(.*)'$/$1/ ) || ( $value =~ s/^"(.*)"/$1/ );
417+
# Unquote single/double quoted attr values e.g. Foo("bar")
418+
( $value =~ s/^'(.*)'$/$1/s ) || ( $value =~ s/^"(.*)"/$1/s );
411419
}
412420
push( @{ $raw_attributes{$key} }, $value );
413421
}

0 commit comments

Comments
 (0)