[Bps-public-commit] r16928 - in Path-Dispatcher/trunk: lib/Path/Dispatcher

[sartak at bestpractical.com]

Author: sartak
Date: Wed Nov 19 13:17:41 2008
New Revision: 16928

Modified:
   Path-Dispatcher/trunk/   (props changed)
   Path-Dispatcher/trunk/lib/Path/Dispatcher/Rule.pm

Log:
 r75812 at onn:  sartak | 2008-11-19 13:17:24 -0500
 Begin implementing a debugging tracer


Modified: Path-Dispatcher/trunk/lib/Path/Dispatcher/Rule.pm
==============================================================================
--- Path-Dispatcher/trunk/lib/Path/Dispatcher/Rule.pm	(original)
+++ Path-Dispatcher/trunk/lib/Path/Dispatcher/Rule.pm	Wed Nov 19 13:17:41 2008
@@ -29,7 +29,12 @@
     my $path = shift;
 
     my ($result, $leftover) = $self->_match($path);
-    return unless $result;
+
+    if (!$result) {
+        $self->trace(leftover => $leftover, match => undef, path => $path)
+            if $ENV{'PATH_DISPATCHER_TRACE'};
+        return;
+    }
 
     $leftover = '' if !defined($leftover);
 
@@ -51,6 +56,8 @@
         leftover => $leftover,
     );
 
+    $self->trace(match => $match) if $ENV{'PATH_DISPATCHER_TRACE'};
+
     return $match;
 }
 
@@ -62,6 +69,26 @@
     $self->block->(@_);
 }
 
+sub trace {
+    my $self = shift;
+    my %args = @_;
+    my $trace = "$self";
+    $trace .= " (" . $self->name . ")" if $self->has_name;
+
+    if (my $match = $args{match}) {
+        $trace .= " matched against (" . $match->path->path . ")";
+        $trace .= " with (" . $match->leftover . ") left over"
+            if length($match->leftover);
+    }
+    else {
+        $trace .= " did not match against (" . $args{path} . ")";
+    }
+
+    $trace .= ".\n";
+
+    warn $trace;
+}
+
 __PACKAGE__->meta->make_immutable;
 no Moose;