Changeset 10418 for lang/perl/HTTPx-Dispatcher/trunk

Timestamp:

04/25/08 12:43:07 (5 years ago)

Author:

tokuhirom

Message:

黒魔術レス

Files:

• lang/perl/HTTPx-Dispatcher/trunk/lib/HTTPx/Dispatcher.pm (modified) (4 diffs)

lang/perl/HTTPx-Dispatcher/trunk/lib/HTTPx/Dispatcher.pm

@@ -8 +8 @@
 use Scalar::Util qw/blessed/;
 use Carp;
+use base qw/Exporter/;
 
-sub import {
-    my $pkg = caller(0);
-    no strict 'refs';
-    unshift @{"$pkg\::ISA"}, 'Class::Data::Inheritable';
-    $pkg->mk_classdata( '__rules' => [] );
+our @EXPORT = qw/connect match uri_for/;
 
-    foreach my $export qw(connect match uri_for) {
-        *{"$pkg\::$export"} = \&{$export};
-    }
-}
+my $rules;
 
 sub connect
@@ -24 +18 @@
     my $pkg = caller(0);
     my @args = @_;
-    my $rules = $pkg->__rules;
-    push @$rules, HTTPx::Dispatcher::Rule->new(@args);
-    $pkg->__rules( $rules );
+
+    push @{ $rules->{$pkg} } , HTTPx::Dispatcher::Rule->new(@args);
 }
 
@@ -34 +27 @@
     croak "request required" unless blessed $req;
 
-    for my $rule (@{ $class->__rules }) {
+    for my $rule (@{ $rules->{$class} }) {
         if (my $result = $rule->match($req)) {
             return $result;
@@ -46 +39 @@
     my ($class, @args) = @_;
 
-    for my $rule ( @{ $class->__rules } ) {
+    for my $rule ( @{ $rules->{$class} } ) {
         if (my $result = $rule->uri_for( @args ) ) {
             return $result;