Skip to content

Commit

Permalink
Handle multi-line sub attributes
Browse files Browse the repository at this point in the history
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.
  • Loading branch information
bigpresh committed Dec 7, 2023
1 parent 7c1f15f commit d5e6d99
Showing 1 changed file with 12 additions and 4 deletions.
16 changes: 12 additions & 4 deletions lib/Catalyst/Controller.pm
Original file line number Diff line number Diff line change
Expand Up @@ -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 );
}
Expand Down

0 comments on commit d5e6d99

Please sign in to comment.