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

[sartak at bestpractical.com]

Author: sartak
Date: Fri Aug  1 13:57:32 2008
New Revision: 14715

Modified:
   Path-Dispatcher/trunk/   (props changed)
   Path-Dispatcher/trunk/lib/Path/Dispatcher/Declarative.pm
   Path-Dispatcher/trunk/t/101-subclass.t

Log:
 r68288 at onn:  sartak | 2008-08-01 13:56:06 -0400
 Declarative dispatchers take their name from the package into which they're installed


Modified: Path-Dispatcher/trunk/lib/Path/Dispatcher/Declarative.pm
==============================================================================
--- Path-Dispatcher/trunk/lib/Path/Dispatcher/Declarative.pm	(original)
+++ Path-Dispatcher/trunk/lib/Path/Dispatcher/Declarative.pm	Fri Aug  1 13:57:32 2008
@@ -5,6 +5,8 @@
 use Sub::Exporter;
 use Path::Dispatcher;
 
+our $CALLER; # Sub::Exporter doesn't make this available
+
 my $exporter = Sub::Exporter::build_exporter({
     into_level => 1,
     groups => {
@@ -23,13 +25,16 @@
         push @{ $pkg . '::ISA' }, $self;
     }
 
+    local $CALLER = $pkg;
     $exporter->($self, @args);
 }
 
 sub build_sugar {
     my ($class, $group, $arg) = @_;
 
-    my $dispatcher = Path::Dispatcher->new;
+    my $dispatcher = Path::Dispatcher->new(
+        name => $CALLER,
+    );
 
     # if this is a subclass, then we want to set up a super dispatcher
     if ($class ne __PACKAGE__) {

Modified: Path-Dispatcher/trunk/t/101-subclass.t
==============================================================================
--- Path-Dispatcher/trunk/t/101-subclass.t	(original)
+++ Path-Dispatcher/trunk/t/101-subclass.t	Fri Aug  1 13:57:32 2008
@@ -1,7 +1,7 @@
 #!/usr/bin/env perl
 use strict;
 use warnings;
-use Test::More tests => 3;
+use Test::More tests => 5;
 use lib 't/lib';
 use Path::Dispatcher::Test::App;
 
@@ -37,3 +37,7 @@
     'app after foo',
 ]);
 
+for ('Path::Dispatcher::Test::Framework', 'Path::Dispatcher::Test::App') {
+    is($_->dispatcher->name, $_, "correct dispatcher name for $_");
+}
+