[Bps-public-commit] plient branch, master, updated. 2e757c42fbf91fa6493f6489df57e96242e9df80
? sunnavy
sunnavy at bestpractical.com
Wed Apr 21 10:18:49 EDT 2010
The branch, master has been updated
via 2e757c42fbf91fa6493f6489df57e96242e9df80 (commit)
via 0f8d55980a626f70ad86e0103ccf0375bbe6245a (commit)
via 8663d17be678568401002e7cbf36f7ac8553c400 (commit)
via 0da02e1023b6b09214848b69a0b2fc8e1d653b5e (commit)
via 920d6994983e4cdb0a00648ab9cb0d330714bfec (commit)
via 1860de76f9bbee37f95bf29108f67e722737e01b (commit)
from f8cbaf58606ca52f443da53214ef2c8161dd1398 (commit)
Summary of changes:
lib/Plient.pm | 71 +++++++++++++++++++++++++++++++++++-------------
lib/Plient/Handler.pm | 3 ++
lib/Plient/Protocol.pm | 10 +++++--
3 files changed, 62 insertions(+), 22 deletions(-)
- Log -----------------------------------------------------------------
commit 1860de76f9bbee37f95bf29108f67e722737e01b
Author: sunnavy <sunnavy at bestpractical.com>
Date: Wed Apr 21 21:50:40 2010 +0800
add $args to support_method so we can test the options in the future, e.g. auth, proxy, etc.
diff --git a/lib/Plient/Handler.pm b/lib/Plient/Handler.pm
index 5569848..cb9b8f3 100644
--- a/lib/Plient/Handler.pm
+++ b/lib/Plient/Handler.pm
@@ -23,6 +23,9 @@ sub support_protocol {
sub support_method {
my $class = shift;
my $method = shift;
+ # TODO we should check args to do more serioud check
+ # e.g. proxy, auth, etc.
+ my $args = shift;
$class->method->{ $method };
}
diff --git a/lib/Plient/Protocol.pm b/lib/Plient/Protocol.pm
index 3b336bf..1172650 100644
--- a/lib/Plient/Protocol.pm
+++ b/lib/Plient/Protocol.pm
@@ -8,17 +8,21 @@ sub prefix { warn "needs subclass prefix"; '' }
sub methods { warn "needs subclass methods"; '' }
sub support_method {
- # trans $uri and $args here to let handlers to decide to pass or not
- my ( $class, $method_name ) = @_;
+ # trans $args here to let handlers to decide to pass or not
+ my ( $class, $method_name, $args ) = @_;
+ $method_name = lc $method_name;
if ( !grep { $method_name eq $_ } $class->methods ) {
warn "$method_name for $class is not officially supported yet";
}
+ return $class->can($method_name) if $class->can($method_name);
my $handler_method_name = $class->prefix . "_$method_name";
for my $handler ( Plient->handlers( $class->prefix ) ) {
$handler->init if $handler->can('init');
- if ( my $method = $handler->support_method($handler_method_name) ) {
+ if ( my $method =
+ $handler->support_method( $handler_method_name, $args ) )
+ {
return $method;
}
}
commit 920d6994983e4cdb0a00648ab9cb0d330714bfec
Author: sunnavy <sunnavy at bestpractical.com>
Date: Wed Apr 21 21:53:46 2010 +0800
trans $args to dispatch
diff --git a/lib/Plient.pm b/lib/Plient.pm
index 8ab9b65..159528c 100644
--- a/lib/Plient.pm
+++ b/lib/Plient.pm
@@ -22,9 +22,9 @@ sub plient {
# http://localhost:5000 => http://localhost:5000/
$uri .= '/' if $uri =~ m{^https?://[^/]+$};
- my $sub = dispatch( $method, $uri );
+ my $sub = dispatch( $method, $uri, $args );
if ( $sub ) {
- $sub->( $args );
+ $sub->();
}
else {
warn "failed to $method on $uri";
@@ -39,7 +39,7 @@ my %dispatch_map = (
);
sub dispatch {
- my ( $method, $uri ) = @_;
+ my ( $method, $uri, $args ) = @_;
$method = lc $method;
$method ||= 'get'; # people use get most of the time.
@@ -47,8 +47,8 @@ sub dispatch {
if ( $uri =~ m{^\Q$prefix} ) {
my $class = $dispatch_map{$prefix};
eval "require $class" or warn "failed to require $class" && return;
- if ( my $sub = $class->can($method) || $class->support_method($method) ) {
- return sub { $sub->( $uri, @_ ) };
+ if ( my $sub = $class->support_method($method, $args) ) {
+ return sub { $sub->( $uri, $args ) };
}
else {
warn "unsupported $method";
commit 0da02e1023b6b09214848b69a0b2fc8e1d653b5e
Author: sunnavy <sunnavy at bestpractical.com>
Date: Wed Apr 21 21:59:48 2010 +0800
refactor, though a bit tedious, get rid of one eval string
diff --git a/lib/Plient.pm b/lib/Plient.pm
index 159528c..3857507 100644
--- a/lib/Plient.pm
+++ b/lib/Plient.pm
@@ -32,28 +32,34 @@ sub plient {
}
}
-my %dispatch_map = (
- 'file:' => 'Plient::Protocol::File',
- 'http://' => 'Plient::Protocol::HTTP',
- 'https://' => 'Plient::Protocol::HTTPS',
-);
sub dispatch {
my ( $method, $uri, $args ) = @_;
$method = lc $method;
$method ||= 'get'; # people use get most of the time.
- for my $prefix ( keys %dispatch_map ) {
- if ( $uri =~ m{^\Q$prefix} ) {
- my $class = $dispatch_map{$prefix};
- eval "require $class" or warn "failed to require $class" && return;
- if ( my $sub = $class->support_method($method, $args) ) {
- return sub { $sub->( $uri, $args ) };
- }
- else {
- warn "unsupported $method";
- }
- }
+ my $class;
+ if ( $uri =~ /^file:/ ) {
+ require Plient::Protocol::File;
+ $class = 'Plient::Protocol::File';
+ }
+ elsif ( $uri =~ m{^http://} ) {
+ require Plient::Protocol::HTTP;
+ $class = 'Plient::Protocol::HTTP';
+ }
+ elsif ( $uri =~ m{^https://} ) {
+ require Plient::Protocol::HTTPS;
+ $class = 'Plient::Protocol::HTTPS';
+ }
+ else {
+ warn "unsupported protocol";
+ }
+
+ if ( my $sub = $class->support_method( $method, $args ) ) {
+ return sub { $sub->( $uri, $args ) };
+ }
+ else {
+ warn "unsupported $method";
}
}
commit 8663d17be678568401002e7cbf36f7ac8553c400
Author: sunnavy <sunnavy at bestpractical.com>
Date: Wed Apr 21 22:01:17 2010 +0800
should return undef if no sub found
diff --git a/lib/Plient.pm b/lib/Plient.pm
index 3857507..b083672 100644
--- a/lib/Plient.pm
+++ b/lib/Plient.pm
@@ -32,7 +32,6 @@ sub plient {
}
}
-
sub dispatch {
my ( $method, $uri, $args ) = @_;
$method = lc $method;
@@ -60,6 +59,7 @@ sub dispatch {
}
else {
warn "unsupported $method";
+ return;
}
}
commit 0f8d55980a626f70ad86e0103ccf0375bbe6245a
Author: sunnavy <sunnavy at bestpractical.com>
Date: Wed Apr 21 22:02:05 2010 +0800
return asap
diff --git a/lib/Plient.pm b/lib/Plient.pm
index b083672..bb47a5f 100644
--- a/lib/Plient.pm
+++ b/lib/Plient.pm
@@ -52,6 +52,7 @@ sub dispatch {
}
else {
warn "unsupported protocol";
+ return;
}
if ( my $sub = $class->support_method( $method, $args ) ) {
commit 2e757c42fbf91fa6493f6489df57e96242e9df80
Author: sunnavy <sunnavy at bestpractical.com>
Date: Wed Apr 21 22:18:08 2010 +0800
refactor code
diff --git a/lib/Plient.pm b/lib/Plient.pm
index bb47a5f..0295ef4 100644
--- a/lib/Plient.pm
+++ b/lib/Plient.pm
@@ -32,28 +32,54 @@ sub plient {
}
}
-sub dispatch {
- my ( $method, $uri, $args ) = @_;
- $method = lc $method;
- $method ||= 'get'; # people use get most of the time.
+sub _extract_protocol {
+ shift if $_[0] && $_[0] eq __PACKAGE__;
+ my $uri = shift;
+ return unless $uri;
+ if ( $uri =~ /^http:/i ) {
+ return 'http';
+ }
+ elsif ( $uri =~ /^https:/i ) {
+ return 'https';
+ }
+ elsif ( $uri =~ /^file:/i ) {
+ return 'file';
+ }
+ else {
+ warn "unsupported $uri";
+ return;
+ }
+}
- my $class;
- if ( $uri =~ /^file:/ ) {
+sub _dispatch_protocol {
+ shift if $_[0] && $_[0] eq __PACKAGE__;
+ my $protocol = shift;
+ return unless $protocol;
+ if ( $protocol eq 'file' ) {
require Plient::Protocol::File;
- $class = 'Plient::Protocol::File';
+ return 'Plient::Protocol::File';
}
- elsif ( $uri =~ m{^http://} ) {
+ elsif ( $protocol eq 'http' ) {
require Plient::Protocol::HTTP;
- $class = 'Plient::Protocol::HTTP';
+ return 'Plient::Protocol::HTTP';
}
- elsif ( $uri =~ m{^https://} ) {
+ elsif ( $protocol eq 'https' ) {
require Plient::Protocol::HTTPS;
- $class = 'Plient::Protocol::HTTPS';
+ return 'Plient::Protocol::HTTPS';
}
else {
warn "unsupported protocol";
return;
}
+}
+
+
+sub dispatch {
+ my ( $method, $uri, $args ) = @_;
+ $method = lc $method;
+ $method ||= 'get'; # people use get most of the time.
+ my $class = _dispatch_protocol( _extract_protocol($uri) );
+ return unless $class;
if ( my $sub = $class->support_method( $method, $args ) ) {
return sub { $sub->( $uri, $args ) };
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list