sub parse {
my ($self, $spec) = @_;
+ $spec =~ s/\s+//g; # whitespace is not valid
return $self->_cache->{$spec} ||= $self->_parse_spec($spec);
}
my ($self, $spec, $nested) = @_;
for ($_[1]) {
my @match;
- /^\G\s*/; # eat leading whitespace
PARSE: { do {
push @match, $self->_parse_spec_section($_)
or $self->_blam("Unable to work out what the next section is");
# !something
/\G!/gc and
- return do {
- my $match = $self->_parse_spec_section($_);
- return sub {
- return {} unless $match->(@_);
- return;
- };
- };
+ return match_not($self->_parse_spec_section($_));
# ?<param spec>
/\G\?/gc and
my ($self) = @_;
for ($_[1]) {
my @path;
- my $full_path = '$';
+ my $end = '';
PATH: while (/\G\//gc) {
/\G\.\.\./gc
and do {
- $full_path = '';
+ $end = '(/.*)';
last PATH;
};
push @path, $self->_url_path_segment_match($_)
or $self->_blam("Couldn't parse path match segment");
}
- my $re = '^('.join('/','',@path).')'.($full_path ? '$' : '(/.*)$');
+ if (@path && !$end) {
+ length and $_ .= '(?:\.\w+)?' for $path[-1];
+ }
+ my $re = '^('.join('/','',@path).')'.$end.'$';
$re = qr/$re/;
- if ($full_path) {
+ if ($end) {
+ return match_path_strip($re);
+ } else {
return match_path($re);
}
- return match_path_strip($re);
}
return;
}
for ($_[1]) {
# trailing / -> require / on end of URL
/\G(?:(?=[+|\)])|$)/gc and
- return '$';
+ return '';
# word chars only -> exact path part match
- /\G(\w+)/gc and
+ /\G([\w\-]+)/gc and
return "\Q$1";
# ** -> capture unlimited path parts
/\G\*\*/gc and
return '(.*?[^/])';
# * -> capture path part
/\G\*/gc and
- return '([^/]+)';
+ return '([^/]+?)';
}
return ();
}
sub _url_extension_match {
my ($self, $str, $extension) = @_;
- if ($extension eq '*') {
- sub {
- if ((my $tmp = shift->{PATH_INFO}) =~ s/\.(\w+)$//) {
- ({ PATH_INFO => $tmp }, $1);
- } else {
- ();
- }
- };
- } else {
- sub {
- if ((my $tmp = shift->{PATH_INFO}) =~ s/\.\Q${extension}\E$//) {
- ({ PATH_INFO => $tmp });
- } else {
- ();
- }
- };
- }
+ match_extension($extension);
}
sub _parse_param_handler {