Permalink
Browse files

implement

  • Loading branch information...
1 parent afad4d5 commit b13bcf5c12962d902cc4946e410142fc5246a435 @shelling committed Apr 4, 2012
View
@@ -1,8 +1,58 @@
package Namespace::Dispatch;
-use strict;
-use warnings;
our $VERSION = '0.01';
+use 5.010;
+use UNIVERSAL::filename;
+
+sub import {
+ my $caller = caller;
+
+ *{$caller . "::" . "has_leaf"} = sub {
+ my ($class, $name) = @_;
+ my @leaves = @{$class->leaves} if $class->can("leaves");
+ if ( $name ~~ @leaves ) {
+ return $class . "::" . ucfirst($name);
+ } else {
+ return 0;
+ }
+ };
+
+ *{$caller . "::" . "dispatch"} = sub {
+
+ my $class = shift;
+ my $next = shift;
+ my $handler = $class->has_leaf($next);
+
+ if ($handler) {
+
+ eval qq{ use $handler };
+ die $@ if $@;
+
+ if ($handler->can("dispatch")) {
+ return $handler->dispatch(@_);
+ } else {
+ die "$handler is not set up yet (forgot to use Namespace::Dispatch?)";
+ }
+
+ } else {
+ return $class;
+ }
+
+ };
+
+ *{$caller . '::' . 'leaves'} = sub {
+ my $class = shift;
+ my $file = $class->filename;
+ $file =~ s{.pm$}{}g;
+ use File::Basename;
+ my @submodules = map { $_ = lc basename($_) } glob "$file/*.pm";
+ map { $_ =~ s{\.pm$}{}; } @submodules;
+ [@submodules];
+ };
+
+}
+
+
1;
__END__
View
@@ -0,0 +1,93 @@
+use Modern::Perl;
+use Test::More;
+use Try::Tiny;
+
+use Namespace::Dispatch;
+
+use lib qw(t/lib);
+
+use Foo;
+
+is_deeply (
+ Foo->leaves,
+ [qw(add del help modify)],
+ "Foo has two submodules Add and Del",
+);
+
+is (
+ Foo->dispatch(qw(add)),
+ "Foo::Add",
+ "request Foo to find submodule Add and return Namespace",
+);
+
+is (
+ Foo->dispatch(qw(del)),
+ "Foo::Del",
+ "request Foo to find submodule Del and return Namespace",
+);
+
+is_deeply (
+ Foo::Add->leaves,
+ [qw(user)],
+ "Foo::Add has submodule User",
+);
+
+is_deeply (
+ Foo::Del->leaves,
+ [],
+ "Foo::Del has no submodule",
+);
+
+is (
+ Foo::Add->has_leaf("user"),
+ "Foo::Add::User",
+ "",
+);
+
+is (
+ Foo::Del->has_leaf("user"),
+ 0,
+ "",
+);
+
+is (
+ Foo->dispatch(qw(add user hello)),
+ "Foo::Add::User::Hello",
+ "Foo can do recursive dispatch",
+);
+
+is (
+ Foo::Add->dispatch(qw(user hello)),
+ "Foo::Add::User::Hello",
+ "Any node can alsod do recursive dispatch",
+);
+
+is_deeply (
+ Foo::Add::User->leaves,
+ [qw(hello)],
+ "Foo::Add::User has one submodule Hello",
+);
+
+try {
+ Foo->dispatch(qw(modify));
+} catch {
+ my $e = shift;
+ like (
+ $e,
+ qr{Foo/Modify.pm did not return a true value},
+ "should die when having \$@.",
+ );
+};
+
+try {
+ Foo->dispatch(qw(help));
+} catch {
+ my $e = shift;
+ like (
+ $e,
+ qr{Foo::Help is not set up yet },
+ ""
+ );
+};
+
+done_testing;
View
@@ -0,0 +1,4 @@
+package Foo;
+use Namespace::Dispatch;
+
+1;
View
@@ -0,0 +1,4 @@
+package Foo::Add;
+use Namespace::Dispatch;
+
+1;
View
@@ -0,0 +1,4 @@
+package Foo::Add::User;
+use Namespace::Dispatch;
+
+1;
@@ -0,0 +1,4 @@
+package Foo::Add::User::Hello;
+use Namespace::Dispatch;
+
+1;
View
@@ -0,0 +1,4 @@
+package Foo::Del;
+use Namespace::Dispatch;
+
+1;
View
@@ -0,0 +1,3 @@
+package Foo::Help;
+
+1;
View
No changes.

0 comments on commit b13bcf5

Please sign in to comment.