[Bps-public-commit] plient branch, master, updated. c9c338717ea5edfa34186fafc4516476510bad02

? sunnavy sunnavy at bestpractical.com
Mon Apr 19 14:15:43 EDT 2010


The branch, master has been updated
       via  c9c338717ea5edfa34186fafc4516476510bad02 (commit)
       via  007f6be2f416f4105cd166d6ad7675ff7e11b1bb (commit)
       via  0afbed93c319af17c3f2669612e99fa8b8f1a534 (commit)
       via  7651cbd06948567ad480345fb209f9de39e48945 (commit)
       via  e77e06923cdfee87ad8e26c1e5d8b9920f37c7fa (commit)
       via  7ee111a014be1ce02a2fbb45158e8ae97d6469f4 (commit)
       via  0399dd957959fddd3c9df48ec66e01bc39e8436d (commit)
       via  629336c584ffb4fc42db9646273b5874cbd1d8b2 (commit)
       via  787c06eefcf966aa84bc96203586d0f375f7b001 (commit)
       via  08cbd952e85879899a6f17b36498b6bbb40cf9f8 (commit)
      from  fa20c641876fb78e5807849d9d110ddeea47de76 (commit)

Summary of changes:
 lib/Plient/Handler/curl.pm |   37 +++++++++++++++++++++-
 lib/Plient/Handler/wget.pm |   15 +++++++--
 lib/Plient/Test.pm         |   72 ++++++++++++++++++++++++++++++++++++++++++++
 t/http/app.psgi            |   27 ++++++++++++++++
 t/http/get.t               |   13 ++++++++
 t/http/post.t              |   14 ++++++++
 6 files changed, 173 insertions(+), 5 deletions(-)
 create mode 100644 lib/Plient/Test.pm
 create mode 100644 t/http/app.psgi
 create mode 100644 t/http/get.t
 create mode 100644 t/http/post.t

- Log -----------------------------------------------------------------
commit 08cbd952e85879899a6f17b36498b6bbb40cf9f8
Author: sunnavy <sunnavy at bestpractical.com>
Date:   Mon Apr 19 22:41:47 2010 +0800

    Test.pm

diff --git a/lib/Plient/Test.pm b/lib/Plient/Test.pm
new file mode 100644
index 0000000..9cf57ff
--- /dev/null
+++ b/lib/Plient/Test.pm
@@ -0,0 +1,65 @@
+package Plient::Test;
+
+use warnings;
+use strict;
+use Carp;
+use FindBin '$Bin';
+use base 'Exporter';
+use File::Spec::Functions;
+our @EXPORT = qw/start_http_server stop_http_server/;
+my @pids;
+sub start_http_server {
+    my $psgi = catfile( $Bin, 'app.psgi' );
+    my $port = 5000 + int(rand(1000));
+    my $pid = fork;
+    if ( defined $pid ) {
+        if ($pid) {
+            sleep 1;
+            push @pids, $pid;
+            return "http://localhost:$port";
+        }
+        else {
+            exec "plackup --port $port -E deployment $psgi";
+            exit;
+        }
+    }
+    else {
+        die "fork server failed";
+    }
+}
+
+END {
+    kill TERM => @pids;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Plient::Test - 
+
+
+=head1 SYNOPSIS
+
+    use Plient::Test;
+
+=head1 DESCRIPTION
+
+
+=head1 INTERFACE
+
+
+=head1 AUTHOR
+
+sunnavy  C<< <sunnavy at bestpractical.com> >>
+
+
+=head1 LICENCE AND COPYRIGHT
+
+Copyright 2010 Best Practical Solutions.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+

commit 787c06eefcf966aa84bc96203586d0f375f7b001
Author: sunnavy <sunnavy at bestpractical.com>
Date:   Tue Apr 20 01:07:39 2010 +0800

    consider if people have no plackup

diff --git a/lib/Plient/Test.pm b/lib/Plient/Test.pm
index 9cf57ff..44513fa 100644
--- a/lib/Plient/Test.pm
+++ b/lib/Plient/Test.pm
@@ -3,18 +3,24 @@ package Plient::Test;
 use warnings;
 use strict;
 use Carp;
+use Plient::Util 'which';
+use File::Spec::Functions;
 use FindBin '$Bin';
+
 use base 'Exporter';
-use File::Spec::Functions;
-our @EXPORT = qw/start_http_server stop_http_server/;
+our @EXPORT = qw/start_http_server/;
 my @pids;
+
 sub start_http_server {
+    my $plackup = which('plackup');
+    return unless $plackup;
+
     my $psgi = catfile( $Bin, 'app.psgi' );
     my $port = 5000 + int(rand(1000));
     my $pid = fork;
     if ( defined $pid ) {
         if ($pid) {
-            sleep 1;
+            sleep 1; # give plackup sometime to run ;)
             push @pids, $pid;
             return "http://localhost:$port";
         }

commit 629336c584ffb4fc42db9646273b5874cbd1d8b2
Author: sunnavy <sunnavy at bestpractical.com>
Date:   Tue Apr 20 01:15:07 2010 +0800

    plackup is really fast to load, let us sleep 0.1s to reduce the test time

diff --git a/lib/Plient/Test.pm b/lib/Plient/Test.pm
index 44513fa..957791f 100644
--- a/lib/Plient/Test.pm
+++ b/lib/Plient/Test.pm
@@ -4,6 +4,7 @@ use warnings;
 use strict;
 use Carp;
 use Plient::Util 'which';
+use Time::HiRes 'usleep';
 use File::Spec::Functions;
 use FindBin '$Bin';
 
@@ -20,7 +21,7 @@ sub start_http_server {
     my $pid = fork;
     if ( defined $pid ) {
         if ($pid) {
-            sleep 1; # give plackup sometime to run ;)
+            usleep 100_000; # give plackup sometime to run ;)
             push @pids, $pid;
             return "http://localhost:$port";
         }

commit 0399dd957959fddd3c9df48ec66e01bc39e8436d
Author: sunnavy <sunnavy at bestpractical.com>
Date:   Tue Apr 20 01:17:51 2010 +0800

    initial http tests

diff --git a/t/http/app.psgi b/t/http/app.psgi
new file mode 100644
index 0000000..116846c
--- /dev/null
+++ b/t/http/app.psgi
@@ -0,0 +1,19 @@
+#!/usr/bin/env perl -w
+use strict;
+use warnings;
+use Plack::Builder;
+my $app = sub {
+    my $env = shift;
+    if ( $env->{REQUEST_METHOD} eq 'GET' ) {
+        if ( $env->{PATH_INFO} eq '/hello' ) {
+            return [ 200, [ 'Content-Type' => 'text/plain' ], ['hello'] ] 
+        }
+    }
+    [ 200, [], ['ok']];
+};
+
+builder {
+#    enable 'Debug';
+    $app;
+};
+
diff --git a/t/http/get.t b/t/http/get.t
new file mode 100644
index 0000000..3e1457e
--- /dev/null
+++ b/t/http/get.t
@@ -0,0 +1,13 @@
+use strict;
+use warnings;
+
+use Test::More tests => 3;
+
+use_ok('Plient');
+use_ok('Plient::Test');
+
+my $url = start_http_server();
+SKIP: {
+    skip 'no plackup available', 1 unless $url;
+    is( plient( GET => "$url/hello" ), 'hello', 'get /hello' );
+}

commit 7ee111a014be1ce02a2fbb45158e8ae97d6469f4
Author: sunnavy <sunnavy at bestpractical.com>
Date:   Tue Apr 20 01:30:01 2010 +0800

    tiny tweak

diff --git a/lib/Plient/Handler/curl.pm b/lib/Plient/Handler/curl.pm
index 0d53efa..68b4624 100644
--- a/lib/Plient/Handler/curl.pm
+++ b/lib/Plient/Handler/curl.pm
@@ -40,10 +40,9 @@ sub init {
                 return;
             }
         };
+        $method{https_get} = $method{http_get} if exists $protocol{https};
     }
 
-    # have you seen https is available while http is not?
-    $method{https_get} = $method{http_get} if exists $protocol{https};
     return 1;
 }
 

commit e77e06923cdfee87ad8e26c1e5d8b9920f37c7fa
Author: sunnavy <sunnavy at bestpractical.com>
Date:   Tue Apr 20 01:31:02 2010 +0800

    try to find wget's https info by invoking https://

diff --git a/lib/Plient/Handler/wget.pm b/lib/Plient/Handler/wget.pm
index eb2f5b9..785acbe 100644
--- a/lib/Plient/Handler/wget.pm
+++ b/lib/Plient/Handler/wget.pm
@@ -9,8 +9,6 @@ my ( $wget, %protocol, %all_protocol, %method );
 
 sub all_protocol { return \%all_protocol }
 
-#XXX TODO get the real protocols wget supports
-# too sad that there's no wget-config stuff
 @all_protocol{qw/http https ftp/} = ();
 
 sub protocol { return \%protocol }
@@ -23,8 +21,18 @@ sub init {
 
     $wget = $ENV{PLIENT_WGET} || which('wget');
     return unless $wget;
+
     @protocol{qw/http https ftp/}     = ();
-    $method{http_get} = $method{https_get} = sub {
+
+    {
+        local $ENV{LC_ALL} = 'en_US';
+        my $message = `$wget https:// 2>&1`;
+        if ( $message && $message =~ /HTTPS support not compiled in/i ) {
+            delete $protocol{https};
+        }
+    }
+    
+    $method{http_get} = sub {
         my ( $uri, $args ) = @_;
         if ( open my $fh, "$wget -q -O - $uri |" ) {
             local $/;
@@ -35,6 +43,7 @@ sub init {
             return;
         }
     };
+    $method{https_get} = $method{http_get} if exists $protocol{https};
     return 1;
 }
 

commit 7651cbd06948567ad480345fb209f9de39e48945
Author: sunnavy <sunnavy at bestpractical.com>
Date:   Tue Apr 20 01:48:03 2010 +0800

    enlarge the usleep time longer

diff --git a/lib/Plient/Test.pm b/lib/Plient/Test.pm
index 957791f..504924d 100644
--- a/lib/Plient/Test.pm
+++ b/lib/Plient/Test.pm
@@ -21,7 +21,7 @@ sub start_http_server {
     my $pid = fork;
     if ( defined $pid ) {
         if ($pid) {
-            usleep 100_000; # give plackup sometime to run ;)
+            usleep 300_000; # give plackup sometime to run ;)
             push @pids, $pid;
             return "http://localhost:$port";
         }

commit 0afbed93c319af17c3f2669612e99fa8b8f1a534
Author: sunnavy <sunnavy at bestpractical.com>
Date:   Tue Apr 20 02:00:14 2010 +0800

    initial post tests

diff --git a/t/http/app.psgi b/t/http/app.psgi
index 116846c..f096db9 100644
--- a/t/http/app.psgi
+++ b/t/http/app.psgi
@@ -2,13 +2,21 @@
 use strict;
 use warnings;
 use Plack::Builder;
+use Plack::Request;
 my $app = sub {
     my $env = shift;
-    if ( $env->{REQUEST_METHOD} eq 'GET' ) {
-        if ( $env->{PATH_INFO} eq '/hello' ) {
+    my $req = Plack::Request->new($env);
+    if ( $req->method eq 'GET' ) {
+        if ( $req->path eq '/hello' ) {
             return [ 200, [ 'Content-Type' => 'text/plain' ], ['hello'] ] 
         }
     }
+    if ( $req->method eq 'POST' ) {
+        my $name = $req->body_parameters->get_all('name');
+        if ( $req->path eq '/hello' ) {
+            return [ 200, [ 'Content-Type' => 'text/plain' ], ["hello $name"] ]; 
+        }
+    }
     [ 200, [], ['ok']];
 };
 
diff --git a/t/http/post.t b/t/http/post.t
new file mode 100644
index 0000000..395ce6e
--- /dev/null
+++ b/t/http/post.t
@@ -0,0 +1,14 @@
+use strict;
+use warnings;
+
+use Test::More tests => 3;
+
+use_ok('Plient');
+use_ok('Plient::Test');
+
+my $url = start_http_server();
+SKIP: {
+    skip 'no plackup available', 1 unless $url;
+    is( plient( POST => "$url/hello", { name => 'foo' } ),
+        'hello foo', 'post /hello' );
+}

commit 007f6be2f416f4105cd166d6ad7675ff7e11b1bb
Author: sunnavy <sunnavy at bestpractical.com>
Date:   Tue Apr 20 02:09:06 2010 +0800

    $args->{body} has the post data

diff --git a/t/http/post.t b/t/http/post.t
index 395ce6e..4caba8f 100644
--- a/t/http/post.t
+++ b/t/http/post.t
@@ -9,6 +9,6 @@ use_ok('Plient::Test');
 my $url = start_http_server();
 SKIP: {
     skip 'no plackup available', 1 unless $url;
-    is( plient( POST => "$url/hello", { name => 'foo' } ),
+    is( plient( POST => "$url/hello", { body => { name => 'foo' } } ),
         'hello foo', 'post /hello' );
 }

commit c9c338717ea5edfa34186fafc4516476510bad02
Author: sunnavy <sunnavy at bestpractical.com>
Date:   Tue Apr 20 02:09:36 2010 +0800

    initial curl post support

diff --git a/lib/Plient/Handler/curl.pm b/lib/Plient/Handler/curl.pm
index 68b4624..24ad0df 100644
--- a/lib/Plient/Handler/curl.pm
+++ b/lib/Plient/Handler/curl.pm
@@ -41,6 +41,40 @@ sub init {
             }
         };
         $method{https_get} = $method{http_get} if exists $protocol{https};
+
+        $method{http_post} = sub {
+            my ( $uri, $args ) = @_;
+            $args ||= {};
+
+            my $data = '';
+            if ( $args->{body} ) {
+                my %kv = %{$args->{body}};
+                for my $k ( keys %kv ) {
+                    if ( defined $kv{$k} ) {
+                        if ( ref $kv{$k} && ref $kv{$k} eq 'ARRAY' ) {
+                            for my $i ( @{ $kv{$k} } ) {
+                                $data .= " -d $k=$i";
+                            }
+                        }
+                        else {
+                            $data .= " -d $k=$kv{$k}";
+                        }
+                    }
+                    else {
+                        $data .= " -d $k=";
+                    }
+                }
+            }
+
+            if ( open my $fh, "$curl -s -L $uri $data |" ) {
+                local $/;
+                <$fh>;
+            }
+            else {
+                warn "failed to post $uri with curl: $!";
+                return;
+            }
+        };
     }
 
     return 1;

-----------------------------------------------------------------------



More information about the Bps-public-commit mailing list