[Catalyst-commits] r11750 - in Catalyst-Runtime/5.80/branches/refactoring_dispatcher/lib/Catalyst: . DispatchType

jnapiorkowski at dev.catalyst.perl.org jnapiorkowski at dev.catalyst.perl.org
Wed Nov 4 22:45:48 GMT 2009


Author: jnapiorkowski
Date: 2009-11-04 22:45:46 +0000 (Wed, 04 Nov 2009)
New Revision: 11750

Modified:
   Catalyst-Runtime/5.80/branches/refactoring_dispatcher/lib/Catalyst/Action.pm
   Catalyst-Runtime/5.80/branches/refactoring_dispatcher/lib/Catalyst/DispatchType/Chained.pm
   Catalyst-Runtime/5.80/branches/refactoring_dispatcher/lib/Catalyst/DispatchType/Path.pm
Log:
first go at the MatchArgs code.  got support in action and in Path, Chained.  Needs a test case, but does not break anything

Modified: Catalyst-Runtime/5.80/branches/refactoring_dispatcher/lib/Catalyst/Action.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/refactoring_dispatcher/lib/Catalyst/Action.pm	2009-11-04 22:45:46 UTC (rev 11749)
+++ Catalyst-Runtime/5.80/branches/refactoring_dispatcher/lib/Catalyst/Action.pm	2009-11-04 22:45:46 UTC (rev 11750)
@@ -76,6 +76,32 @@
     return scalar( @{ $c->req->args } ) == $args;
 }
 
+sub match_captures {
+    my ($self, $c) = @_;
+    if(my $match_args = $self->attributes->{MatchArgs}) {
+        return $self->_compare_args_to_signature($c, $match_args)
+    } else {
+        return 1; ## if no MatchArgs, assume all is well
+    }
+}
+
+## MatchArgs("/d/d","/w/d",...)
+sub _compare_args_to_signature {
+    my ($self, $c, $match_args) = @_;
+    my @incoming_args = @{ $c->req->args };
+    my $splitter = qr/,(?=(?:[^\"]*\"[^\"]*\")*(?![^\"]*\"))/;
+    my @parsed_match_args = map {qr/$_/} split($splitter, $match_args);
+    foreach my $arg (@incoming_args) {
+        my $match_arg = shift(@parsed_match_args);
+        if($arg =~ $match_arg) {
+            next;
+        } else {
+            return 0;
+        }
+    }
+    return 1;
+}
+
 sub compare {
     my ($a1, $a2) = @_;
 
@@ -125,6 +151,11 @@
 Check Args attribute, and makes sure number of args matches the setting.
 Always returns true if Args is omitted.
 
+=head2 match_captures( $c )
+
+Check MatchArgs attribute, and makes the incoming args match the given 
+signature.
+
 =head2 compare
 
 Compares 2 actions based on the value of the C<Args> attribute, with no C<Args>

Modified: Catalyst-Runtime/5.80/branches/refactoring_dispatcher/lib/Catalyst/DispatchType/Chained.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/refactoring_dispatcher/lib/Catalyst/DispatchType/Chained.pm	2009-11-04 22:45:46 UTC (rev 11749)
+++ Catalyst-Runtime/5.80/branches/refactoring_dispatcher/lib/Catalyst/DispatchType/Chained.pm	2009-11-04 22:45:46 UTC (rev 11750)
@@ -233,7 +233,8 @@
             else {
                 {
                     local $c->req->{arguments} = [ @{$c->req->args}, @parts ];
-                    next TRY_ACTION unless $action->match($c);
+                    next TRY_ACTION
+                      unless ($action->match($c) && $action->match_captures($c));
                 }
                 my $args_attr = $action->attributes->{Args}->[0];
 

Modified: Catalyst-Runtime/5.80/branches/refactoring_dispatcher/lib/Catalyst/DispatchType/Path.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/refactoring_dispatcher/lib/Catalyst/DispatchType/Path.pm	2009-11-04 22:45:46 UTC (rev 11749)
+++ Catalyst-Runtime/5.80/branches/refactoring_dispatcher/lib/Catalyst/DispatchType/Path.pm	2009-11-04 22:45:46 UTC (rev 11750)
@@ -80,6 +80,7 @@
 
     foreach my $action ( @actions ) {
         next unless $action->match($c);
+        next unless $action->match_captures($c);
         $c->req->action($path);
         $c->req->match($path);
         $c->action($action);




More information about the Catalyst-commits mailing list