Add $self->capture() method to extract route captures

(Inspired by Dancer2's captures())

4 files changed, 39 insertions, 5 deletions

diff --git a/Build.PL b/Build.PL
index 8236ca7..0a3f5f3 100644
--- a/Build.PL
+++ b/Build.PL
@@ -9,7 +9,7 @@ Module::Build->new(
   dist_abstract => 'The Ultimate Website Framework',
   license       => 'mit',
   requires => {
-    perl => '5.8.0',
+    perl => '5.10.0',
   },
   recommends => {
     'DBI'                  => 0,
diff --git a/examples/singlefile.pl b/examples/singlefile.pl
index 283c96c..267a0ed 100755
--- a/examples/singlefile.pl
+++ b/examples/singlefile.pl
@@ -31,7 +31,7 @@ TUWF::register(
 
   # and this regex matches all URIs below /sub/, and passes the part after
   # /sub/ as the second argument to subpage().
-  qr/sub\/(.*)/ => \&subpage,
+  qr/sub\/(?<capturename>.*)/ => \&subpage,
 
   qr{api/echo\.json} => \&echoapi,
 
@@ -70,6 +70,10 @@ sub subpage {
   # output a plain text file containing $uri
   $self->resHeader('Content-Type' => 'text/plain; charset=UTF-8');
   lit $uri;
+  lit "\n";
+  lit $self->capture(1);
+  lit "\n";
+  lit $self->capture('capturename');
 }
 
 
diff --git a/lib/TUWF.pm b/lib/TUWF.pm
index 4b65472..109f19c 100644
--- a/lib/TUWF.pm
+++ b/lib/TUWF.pm
@@ -286,17 +286,21 @@ sub _handle_request {
     (my $loc = $self->reqPath) =~ s/^\///;
     study $loc;
     my $han = $self->{_TUWF}{error_404_handler};
-    my @args;
+    $self->{_TUWF}{captures_pos} = [];
+    $self->{_TUWF}{captures_named} = {};
     for (@handlers ? 0..$#handlers/2 : ()) {
       if($loc =~ /^$handlers[$_*2]$/) {
-        @args = map defined $-[$_] ? substr $loc, $-[$_], $+[$_]-$-[$_] : undef, 1..$#- if $#-;
+        $self->{_TUWF}{captures_pos} = [
+            map defined $-[$_] ? substr $loc, $-[$_], $+[$_]-$-[$_] : undef, 1..$#-
+        ];
+        $self->{_TUWF}{captures_named} = { %+ };
         $han = $handlers[$_*2+1];
         last;
       }
     }
 
     # execute handler
-    $han->($self, @args);
+    $han->($self, @{$self->{_TUWF}{captures_pos}});
 
     # execute post request handler, if any
     $self->{_TUWF}{post_request_handler}->($self) if $self->{_TUWF}{post_request_handler};
@@ -362,6 +366,14 @@ sub debug {
 }
 
 
+sub capture {
+  my($self, $key) = @_;
+  $key =~ /^[0-9]+$/
+    ? $self->{_TUWF}{captures_pos}[$key-1]
+    : $self->{_TUWF}{captures_named}{$key};
+}
+
+
 # writes a message to the log file. date, time and URL are automatically added
 sub log {
   my($self, $msg) = @_;
diff --git a/lib/TUWF.pod b/lib/TUWF.pod
index 6db9a88..d269a16 100644
--- a/lib/TUWF.pod
+++ b/lib/TUWF.pod
@@ -507,6 +507,24 @@ TUWF object provides many other methods as well, which are implemented and
 documented in the various sub-modules. See the documentation of each sub-module
 for the methods it provides.
 
+=head2 capture(key)
+
+Returns the capture group from the route regex. Both positional captures and
+named captures can be used, for example:
+
+  TUWF::register(qr{user/(?<uid>[1-9][0-9]*)} => sub {
+    my($self, $uid) = @_;
+
+    # capture(1) is equivalent to $1 from the regex.
+    $self->capture(1) == $uid;
+
+    # capture('uid') is equivalent to $+{uid} from the regex.
+    $self->capture('uid') == $uid;
+  });
+
+Note that C<captures(0)> is not available; This would be equivalent to
+C<< $self->reqPath >>, save for the leading slash.
+
 =head2 debug()
 
 Returns the value of the I<debug> setting.