r67400 - in /trunk/libhttp-tiny-perl: Changes MANIFEST META.json META.yml Makefile.PL README debian/changelog eg/get.pl eg/post.pl lib/HTTP/Tiny.pm t/040_content.t t/050_chunked_body.t t/120_put.t t/200_live.t t/cases/put-05.txt

gregoa at users.alioth.debian.org gregoa at users.alioth.debian.org
Fri Jan 14 20:38:00 UTC 2011


Author: gregoa
Date: Fri Jan 14 20:37:54 2011
New Revision: 67400

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=67400
Log:
new upstream release

Added:
    trunk/libhttp-tiny-perl/eg/post.pl
      - copied unchanged from r67399, branches/upstream/libhttp-tiny-perl/current/eg/post.pl
    trunk/libhttp-tiny-perl/t/cases/put-05.txt
      - copied unchanged from r67399, branches/upstream/libhttp-tiny-perl/current/t/cases/put-05.txt
Modified:
    trunk/libhttp-tiny-perl/Changes
    trunk/libhttp-tiny-perl/MANIFEST
    trunk/libhttp-tiny-perl/META.json
    trunk/libhttp-tiny-perl/META.yml
    trunk/libhttp-tiny-perl/Makefile.PL
    trunk/libhttp-tiny-perl/README
    trunk/libhttp-tiny-perl/debian/changelog
    trunk/libhttp-tiny-perl/eg/get.pl
    trunk/libhttp-tiny-perl/lib/HTTP/Tiny.pm
    trunk/libhttp-tiny-perl/t/040_content.t
    trunk/libhttp-tiny-perl/t/050_chunked_body.t
    trunk/libhttp-tiny-perl/t/120_put.t
    trunk/libhttp-tiny-perl/t/200_live.t

Modified: trunk/libhttp-tiny-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libhttp-tiny-perl/Changes?rev=67400&op=diff
==============================================================================
--- trunk/libhttp-tiny-perl/Changes (original)
+++ trunk/libhttp-tiny-perl/Changes Fri Jan 14 20:37:54 2011
@@ -1,4 +1,17 @@
 Release notes for HTTP-Tiny
+
+0.008     2011-01-14 06:34:55 EST5EDT
+
+  - Added support for direct 'https' connections if IO::Socket::SSL
+    is installed
+
+  - Added support for a callback to provide trailing headers for
+    chunked transfer encoding
+
+  - Data callbacks receive the response hashref as a second argument
+    for greater flexibility
+
+  - Additional limitations documented
 
 0.007     2011-01-12 04:56:16 EST5EDT
 

Modified: trunk/libhttp-tiny-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libhttp-tiny-perl/MANIFEST?rev=67400&op=diff
==============================================================================
--- trunk/libhttp-tiny-perl/MANIFEST (original)
+++ trunk/libhttp-tiny-perl/MANIFEST Fri Jan 14 20:37:54 2011
@@ -8,6 +8,7 @@
 dist.ini
 eg/get.pl
 eg/mirror.pl
+eg/post.pl
 lib/HTTP/Tiny.pm
 t/00-compile.t
 t/000_load.t
@@ -55,6 +56,7 @@
 t/cases/put-02.txt
 t/cases/put-03.txt
 t/cases/put-04.txt
+t/cases/put-05.txt
 t/cases/redirect-01.txt
 t/cases/redirect-02.txt
 t/cases/redirect-03.txt

Modified: trunk/libhttp-tiny-perl/META.json
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libhttp-tiny-perl/META.json?rev=67400&op=diff
==============================================================================
--- trunk/libhttp-tiny-perl/META.json (original)
+++ trunk/libhttp-tiny-perl/META.json Fri Jan 14 20:37:54 2011
@@ -42,6 +42,7 @@
       },
       "test" : {
          "requires" : {
+            "Data::Dumper" : 0,
             "Exporter" : 0,
             "File::Basename" : 0,
             "File::Find" : 0,
@@ -56,11 +57,11 @@
    "provides" : {
       "HTTP::Tiny" : {
          "file" : "lib/HTTP/Tiny.pm",
-         "version" : "0.007"
+         "version" : "0.008"
       },
       "HTTP::Tiny::Handle" : {
          "file" : "lib/HTTP/Tiny.pm",
-         "version" : "0.007"
+         "version" : "0.008"
       }
    },
    "release_status" : "stable",
@@ -72,6 +73,6 @@
          "web" : "http://github.com/dagolden/p5-http-tiny/tree"
       }
    },
-   "version" : "0.007"
+   "version" : "0.008"
 }
 

Modified: trunk/libhttp-tiny-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libhttp-tiny-perl/META.yml?rev=67400&op=diff
==============================================================================
--- trunk/libhttp-tiny-perl/META.yml (original)
+++ trunk/libhttp-tiny-perl/META.yml Fri Jan 14 20:37:54 2011
@@ -4,6 +4,7 @@
   - 'Christian Hansen <chansen at cpan.org>'
   - 'David Golden <dagolden at cpan.org>'
 build_requires:
+  Data::Dumper: 0
   Exporter: 0
   File::Basename: 0
   File::Find: 0
@@ -32,10 +33,10 @@
 provides:
   HTTP::Tiny:
     file: lib/HTTP/Tiny.pm
-    version: 0.007
+    version: 0.008
   HTTP::Tiny::Handle:
     file: lib/HTTP/Tiny.pm
-    version: 0.007
+    version: 0.008
 requires:
   Carp: 0
   Errno: 0
@@ -45,4 +46,4 @@
 resources:
   homepage: http://github.com/dagolden/p5-http-tiny/tree
   repository: git://github.com/dagolden/p5-http-tiny.git
-version: 0.007
+version: 0.008

Modified: trunk/libhttp-tiny-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libhttp-tiny-perl/Makefile.PL?rev=67400&op=diff
==============================================================================
--- trunk/libhttp-tiny-perl/Makefile.PL (original)
+++ trunk/libhttp-tiny-perl/Makefile.PL Fri Jan 14 20:37:54 2011
@@ -12,6 +12,7 @@
   'ABSTRACT' => 'A small, simple, correct HTTP/1.1 client',
   'AUTHOR' => 'Christian Hansen <chansen at cpan.org>, David Golden <dagolden at cpan.org>',
   'BUILD_REQUIRES' => {
+    'Data::Dumper' => '0',
     'Exporter' => '0',
     'File::Basename' => '0',
     'File::Find' => '0',
@@ -34,7 +35,7 @@
     'IO::Socket' => '0',
     'Time::Local' => '0'
   },
-  'VERSION' => '0.007',
+  'VERSION' => '0.008',
   'test' => {
     'TESTS' => 't/*.t'
   }

Modified: trunk/libhttp-tiny-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libhttp-tiny-perl/README?rev=67400&op=diff
==============================================================================
--- trunk/libhttp-tiny-perl/README (original)
+++ trunk/libhttp-tiny-perl/README Fri Jan 14 20:37:54 2011
@@ -2,7 +2,7 @@
     HTTP::Tiny - A small, simple, correct HTTP/1.1 client
 
 VERSION
-    version 0.007
+    version 0.008
 
 SYNOPSIS
         use HTTP::Tiny;
@@ -114,20 +114,29 @@
         A scalar to include as the body of the request OR a code reference
         that will be called iteratively to produce the body of the response
 
+    *   trailer_callback
+
+        A code reference that will be called if it exists to provide a
+        hashref of trailing headers (only used with chunked
+        transfer-encoding)
+
     *   data_callback
 
-        A code reference that will be called with chunks of the response
-        body
+        A code reference that will be called for each chunks of the response
+        body received.
 
     If the "content" option is a code reference, it will be called
     iteratively to provide the content body of the request. It should return
     the empty string or undef when the iterator is exhausted.
 
     If the "data_callback" option is provided, it will be called iteratively
-    with a chunk of response body data as the sole argument until the entire
-    response body is received.
-
-    The "response" method returns a hashref containing the response. The
+    until the entire response body is received. The first argument will be a
+    string containing a chunk of the response body, the second argument will
+    be the in-progress response hash reference, as described below. (This
+    allows customizing the action of the callback based on the "status" or
+    "headers" received prior to the content body.)
+
+    The "request" method returns a hashref containing the response. The
     hashref will have the following keys:
 
     *   success
@@ -184,6 +193,15 @@
     *   Persistant connections are not supported. The "Connection" header
         will always be set to "close".
 
+    *   Direct "https" connections are supported only if IO::Socket::SSL is
+        installed. There is no support for "https" connections via proxy.
+
+    *   Cookies are not directly supported. Users that set a "Cookie" header
+        should also set "max_redirect" to zero to ensure cookies are not
+        inappropriately re-transmitted.
+
+    *   Proxy environment variables are not supported.
+
     *   There is no provision for delaying a request body using an "Expect"
         header. Unexpected "1XX" responses are silently ignored as per the
         specification.

Modified: trunk/libhttp-tiny-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libhttp-tiny-perl/debian/changelog?rev=67400&op=diff
==============================================================================
--- trunk/libhttp-tiny-perl/debian/changelog (original)
+++ trunk/libhttp-tiny-perl/debian/changelog Fri Jan 14 20:37:54 2011
@@ -1,4 +1,4 @@
-libhttp-tiny-perl (0.007-1) unstable; urgency=low
+libhttp-tiny-perl (0.008-1) unstable; urgency=low
 
   * Initial Release. (Closes: #609901)
 

Modified: trunk/libhttp-tiny-perl/eg/get.pl
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libhttp-tiny-perl/eg/get.pl?rev=67400&op=diff
==============================================================================
--- trunk/libhttp-tiny-perl/eg/get.pl (original)
+++ trunk/libhttp-tiny-perl/eg/get.pl Fri Jan 14 20:37:54 2011
@@ -25,5 +25,5 @@
     }
 }
 
-print $response->{content} if defined $response->{content};
+print $response->{content} if length $response->{content};
 

Modified: trunk/libhttp-tiny-perl/lib/HTTP/Tiny.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libhttp-tiny-perl/lib/HTTP/Tiny.pm?rev=67400&op=diff
==============================================================================
--- trunk/libhttp-tiny-perl/lib/HTTP/Tiny.pm (original)
+++ trunk/libhttp-tiny-perl/lib/HTTP/Tiny.pm Fri Jan 14 20:37:54 2011
@@ -9,7 +9,7 @@
 #
 package HTTP::Tiny;
 BEGIN {
-  $HTTP::Tiny::VERSION = '0.007';
+  $HTTP::Tiny::VERSION = '0.008';
 }
 use strict;
 use warnings;
@@ -133,7 +133,8 @@
 
     if ($self->{proxy}) {
         $request->{uri} = "$scheme://$request->{host_port}$path_query";
-        # XXX CONNECT for https scheme
+        croak(qq/HTTPS via proxy is not supported/)
+            if $request->{scheme} eq 'https';
         $handle->connect(($self->_split_url($self->{proxy}))[0..2]);
     }
     else {
@@ -157,8 +158,7 @@
     }
     else {
         my $data_cb = $self->_prepare_data_cb($response, $args);
-        my $rh = $response->{headers};
-        $handle->read_body($data_cb, $rh);
+        $handle->read_body($data_cb, $response);
     }
 
     $handle->close;
@@ -198,6 +198,8 @@
                   || $request->{headers}{'transfer-encoding'};
             $request->{cb} = sub { substr $content, 0, length $content, '' };
         }
+        $request->{trailer_cb} = $args->{trailer_callback}
+            if ref $args->{trailer_callback} eq 'CODE';
     }
     return;
 }
@@ -207,21 +209,16 @@
     my $data_cb = $args->{data_callback};
     $response->{content} = '';
 
-    # XXX Should max_size apply even if a data callback is provided?
-    # Perhaps it should for consistency. I'm also not clear why
-    # max_size should be ignored on status other than 2XX.  Perhaps
-    # all $data_cb's should be wrapped in a max_size checking
-    # callback if max_size is true -- dagolden, 2010-12-02
     if (!$data_cb || $response->{status} !~ /^2/) {
         if (defined $self->{max_size}) {
             $data_cb = sub {
-                $response->{content} .= $_[0];
-                Carp::croak(qq/Size of response body exceeds the maximum allowed of $self->{max_size}/)
-                  if length $response->{content} > $self->{max_size};
+                $_[1]->{content} .= $_[0];
+                die(qq/Size of response body exceeds the maximum allowed of $self->{max_size}\n/)
+                  if length $_[1]->{content} > $self->{max_size};
             };
         }
         else {
-            $data_cb = sub { $response->{content} .= $_[0] };
+            $data_cb = sub { $_[1]->{content} .= $_[0] };
         }
     }
     return $data_cb;
@@ -304,7 +301,7 @@
 use Errno      qw[EINTR EPIPE];
 use IO::Socket qw[SOCK_STREAM];
 
-sub BUFSIZE () { 32768 } # XXX Should be an attribute? -- dagolden, 2010-12-03
+sub BUFSIZE () { 32768 }
 
 my $Printable = sub {
     local $_ = shift;
@@ -332,11 +329,17 @@
     @_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/);
     my ($self, $scheme, $host, $port) = @_;
 
-    # XXX IO::Socket::SSL
-    $scheme eq 'http'
-      or croak(qq/Unsupported URL scheme '$scheme'/);
-
-    $self->{fh} = IO::Socket::INET->new(
+    if ( $scheme eq 'https' ) {
+        eval "require IO::Socket::SSL"
+            unless exists $INC{'IO/Socket/SSL.pm'};
+        croak(qq/IO::Socket::SSL must be installed for https support\n/)
+            unless $INC{'IO/Socket/SSL.pm'};
+    }
+    elsif ( $scheme ne 'http' ) {
+      croak(qq/Unsupported URL scheme '$scheme'/);
+    }
+
+    $self->{fh} = 'IO::Socket::INET'->new(
         PeerHost  => $host,
         PeerPort  => $port,
         Proto     => 'tcp',
@@ -346,6 +349,13 @@
 
     binmode($self->{fh})
       or croak(qq/Could not binmode() socket: '$!'/);
+
+    if ( $scheme eq 'https') {
+        IO::Socket::SSL->start_SSL($self->{fh});
+        ref($self->{fh}) eq 'IO::Socket::SSL'
+            and $self->{fh}->verify_hostname( $host, 'http' )
+            or croak(qq/SSL connection failed for $host\n/);
+    }
 
     $self->{host} = $host;
     $self->{port} = $port;
@@ -495,8 +505,7 @@
     @_ == 2 || croak(q/Usage: $handle->write_request(request)/);
     my($self, $request) = @_;
     $self->write_request_header(@{$request}{qw/method uri headers/});
-    $self->write_body($request->{cb}, $request->{headers}{'content-length'})
-        if $request->{cb};
+    $self->write_body($request) if $request->{cb};
     return;
 }
 
@@ -509,7 +518,7 @@
 );
 
 sub write_header_lines {
-    @_ == 2 || croak(q/Usage: $handle->write_header_lines(headers)/);
+    (@_ == 2 && ref $_[1] eq 'HASH') || croak(q/Usage: $handle->write_header_lines(headers)/);
     my($self, $headers) = @_;
 
     my $buf = '';
@@ -535,56 +544,57 @@
 }
 
 sub read_body {
-    @_ == 3 || croak(q/Usage: $handle->read_body(callback, headers)/);
-    my ($self, $cb, $headers) = @_;
-    my $te = $headers->{'transfer-encoding'} || '';
+    @_ == 3 || croak(q/Usage: $handle->read_body(callback, response)/);
+    my ($self, $cb, $response) = @_;
+    my $te = $response->{headers}{'transfer-encoding'} || '';
     if ( grep { /chunked/i } ( ref $te eq 'ARRAY' ? @$te : $te ) ) {
-        $self->read_chunked_body($cb, $headers);
+        $self->read_chunked_body($cb, $response);
     }
     else {
-        $self->read_content_body($cb, $headers->{'content-length'});
+        $self->read_content_body($cb, $response);
     }
     return;
 }
 
 sub write_body {
-    @_ == 2 || @_ == 3 || croak(q/Usage: $handle->write_body(callback [, content_length])/);
-    my ($self, $cb, $content_length) = @_;
-    if ($content_length) {
-        return $self->write_content_body($cb, $content_length);
+    @_ == 2 || croak(q/Usage: $handle->write_body(request)/);
+    my ($self, $request) = @_;
+    if ($request->{headers}{'content-length'}) {
+        return $self->write_content_body($request);
     }
     else {
-        return $self->write_chunked_body($cb);
+        return $self->write_chunked_body($request);
     }
 }
 
 sub read_content_body {
-    @_ == 3 || croak(q/Usage: $handle->read_content_body(callback, content_length)/);
-    my ($self, $cb, $content_length) = @_;
+    @_ == 3 || @_ == 4 || croak(q/Usage: $handle->read_content_body(callback, response, [read_length])/);
+    my ($self, $cb, $response, $content_length) = @_;
+    $content_length ||= $response->{headers}{'content-length'};
 
     if ( $content_length ) {
         my $len = $content_length;
         while ($len > 0) {
             my $read = ($len > BUFSIZE) ? BUFSIZE : $len;
-            $cb->($self->read($read, 0));
+            $cb->($self->read($read, 0), $response);
             $len -= $read;
         }
     }
     else {
         my $chunk;
-        $cb->($chunk) while length( $chunk = $self->read(BUFSIZE, 1) );
-    }
-
-    return $content_length; # XXX ignored? -- dagolden, 2010-12-03
+        $cb->($chunk, $response) while length( $chunk = $self->read(BUFSIZE, 1) );
+    }
+
+    return;
 }
 
 sub write_content_body {
-    @_ == 3 || croak(q/Usage: $handle->write_content_body(callback, content_length)/);
-    my ($self, $cb, $content_length) = @_;
-
-    my $len = 0;
+    @_ == 2 || croak(q/Usage: $handle->write_content_body(request)/);
+    my ($self, $request) = @_;
+
+    my ($len, $content_length) = (0, $request->{headers}{'content-length'});
     while () {
-        my $data = $cb->();
+        my $data = $request->{cb}->();
 
         defined $data && length $data
           or last;
@@ -604,8 +614,8 @@
 }
 
 sub read_chunked_body {
-    @_ == 3 || croak(q/Usage: $handle->read_chunked_body(callback, $headers)/);
-    my ($self, $cb, $headers) = @_;
+    @_ == 3 || croak(q/Usage: $handle->read_chunked_body(callback, $response)/);
+    my ($self, $cb, $response) = @_;
 
     while () {
         my $head = $self->readline;
@@ -616,24 +626,22 @@
         my $len = hex($1)
           or last;
 
-        $self->read_content_body($cb, $len);
+        $self->read_content_body($cb, $response, $len);
 
         $self->read(2) eq "\x0D\x0A"
           or croak(q/Malformed chunk: missing CRLF after chunk data/);
     }
-    $self->read_header_lines($headers);
+    $self->read_header_lines($response->{headers});
     return;
 }
 
 sub write_chunked_body {
-    @_ == 2 || @_ == 3 || croak(q/Usage: $handle->write_chunked_body(callback [, trailers])/);
-    my ($self, $cb, $trailers) = @_;
-
-    $trailers ||= {}; # XXX not used; remove? -- dagolden, 2010-12-03
+    @_ == 2 || croak(q/Usage: $handle->write_chunked_body(request)/);
+    my ($self, $request) = @_;
 
     my $len = 0;
     while () {
-        my $data = $cb->();
+        my $data = $request->{cb}->();
 
         defined $data && length $data
           or last;
@@ -653,7 +661,8 @@
         $self->write($chunk);
     }
     $self->write("0\x0D\x0A");
-    $self->write_header_lines($trailers); # XXX remove? -- dagolden, 2010-12-03
+    $self->write_header_lines($request->{trailer_cb}->())
+        if ref $request->{trailer_cb} eq 'CODE';
     return $len;
 }
 
@@ -680,12 +689,10 @@
 }
 
 sub write_request_header {
-    @_ == 4 || @_ == 5 || croak(q/Usage: $handle->write_request_header(method, request_uri, headers [, protocol])/);
-    my ($self, $method, $request_uri, $headers, $protocol) = @_;
-
-    $protocol ||= 'HTTP/1.1'; # XXX never provided -- dagolden, 2010-12-03
-
-    return $self->write("$method $request_uri $protocol\x0D\x0A")
+    @_ == 4 || croak(q/Usage: $handle->write_request_header(method, request_uri, headers)/);
+    my ($self, $method, $request_uri, $headers) = @_;
+
+    return $self->write("$method $request_uri HTTP/1.1\x0D\x0A")
          + $self->write_header_lines($headers);
 }
 
@@ -745,7 +752,7 @@
 
 =head1 VERSION
 
-version 0.007
+version 0.008
 
 =head1 SYNOPSIS
 
@@ -885,10 +892,17 @@
 
 =item *
 
+trailer_callback
+
+A code reference that will be called if it exists to provide a hashref
+of trailing headers (only used with chunked transfer-encoding)
+
+=item *
+
 data_callback
 
-A code reference that will be called with chunks of the response
-body
+A code reference that will be called for each chunks of the response
+body received.
 
 =back
 
@@ -896,11 +910,14 @@
 to provide the content body of the request.  It should return the empty
 string or undef when the iterator is exhausted.
 
-If the C<data_callback> option is provided, it will be called iteratively
-with a chunk of response body data as the sole argument until the entire
-response body is received.
-
-The C<response> method returns a hashref containing the response.  The hashref
+If the C<data_callback> option is provided, it will be called iteratively until
+the entire response body is received.  The first argument will be a string
+containing a chunk of the response body, the second argument will be the
+in-progress response hash reference, as described below.  (This allows
+customizing the action of the callback based on the C<status> or C<headers>
+received prior to the content body.)
+
+The C<request> method returns a hashref containing the response.  The hashref
 will have the following keys:
 
 =over 4
@@ -989,6 +1006,21 @@
 
 =item *
 
+Direct C<https> connections are supported only if L<IO::Socket::SSL> is
+installed.  There is no support for C<https> connections via proxy.
+
+=item *
+
+Cookies are not directly supported.  Users that set a C<Cookie> header
+should also set C<max_redirect> to zero to ensure cookies are not
+inappropriately re-transmitted.
+
+=item *
+
+Proxy environment variables are not supported.
+
+=item *
+
 There is no provision for delaying a request body using an C<Expect> header.
 Unexpected C<1XX> responses are silently ignored as per the specification.
 

Modified: trunk/libhttp-tiny-perl/t/040_content.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libhttp-tiny-perl/t/040_content.t?rev=67400&op=diff
==============================================================================
--- trunk/libhttp-tiny-perl/t/040_content.t (original)
+++ trunk/libhttp-tiny-perl/t/040_content.t Fri Jan 14 20:37:54 2011
@@ -29,7 +29,11 @@
     my $length   = $nchunks * length $chunk;
 
     {
-        my $got = $handle->write_content_body(sub { $nchunks-- ? $chunk : undef }, $length);
+        my $request = {
+          cb => sub { $nchunks-- ? $chunk : undef },
+          headers => { 'content-length' => $length }
+        };
+        my $got = $handle->write_content_body($request);
         is($got, $length, "written $length octets");
     }
 
@@ -37,7 +41,7 @@
 
     {
         my $got = 0;
-        $handle->read_content_body(sub { $got += length $_[0] }, $length);
+        $handle->read_content_body(sub { $got += length $_[0] }, {}, $length);
         is($got, $length, "read $length octets");
     }
 }

Modified: trunk/libhttp-tiny-perl/t/050_chunked_body.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libhttp-tiny-perl/t/050_chunked_body.t?rev=67400&op=diff
==============================================================================
--- trunk/libhttp-tiny-perl/t/050_chunked_body.t (original)
+++ trunk/libhttp-tiny-perl/t/050_chunked_body.t Fri Jan 14 20:37:54 2011
@@ -28,8 +28,9 @@
     my $exp     = ['A'..'Z'];
     my $got     = [];
     my $cb      = sub { push @$got, $_[0] };
-    $handle->read_chunked_body($cb,my $got_trailing = {});
-    is_deeply($got_trailing, {}, 'chunked trailers');
+    my $response = { headers => {} };
+    $handle->read_chunked_body($cb, $response);
+    is_deeply($response->{headers}, {}, 'chunked trailers');
     is_deeply($got, $exp, "chunked chunks");
 }
 
@@ -43,15 +44,20 @@
 
     {
         my @chunks = @$exp;
-        $handle->write_chunked_body(sub { shift @chunks }, $trailers);
+        my $request = {
+          cb => sub { shift @chunks },
+          trailer_cb => sub { $trailers },
+        };
+        $handle->write_chunked_body($request);
     }
 
     rewind($fh);
 
     {
         my $cb = sub { push @$got, $_[0] };
-        $handle->read_chunked_body($cb,my $got_trailing = {});
-        is_deeply($got_trailing, $trailers, 'roundtrip chunked trailers');
+        my $response = { headers => {} };
+        $handle->read_chunked_body($cb, $response);
+        is_deeply($response->{headers}, $trailers, 'roundtrip chunked trailers');
     }
 
     is_deeply($got, $exp, "roundtrip chunked chunks");

Modified: trunk/libhttp-tiny-perl/t/120_put.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libhttp-tiny-perl/t/120_put.t?rev=67400&op=diff
==============================================================================
--- trunk/libhttp-tiny-perl/t/120_put.t (original)
+++ trunk/libhttp-tiny-perl/t/120_put.t Fri Jan 14 20:37:54 2011
@@ -45,6 +45,10 @@
     $options{content} = eval join "\n", @{$case->{content_cb}};
   }
 
+  if ( $case->{trailer_cb} ) {
+    $options{trailer_callback} = eval join "\n", @{$case->{trailer_cb}};
+  }
+
   # setup mocking and test
   my $res_fh = tmpfile($give_res);
   my $req_fh = tmpfile();

Modified: trunk/libhttp-tiny-perl/t/200_live.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libhttp-tiny-perl/t/200_live.t?rev=67400&op=diff
==============================================================================
--- trunk/libhttp-tiny-perl/t/200_live.t (original)
+++ trunk/libhttp-tiny-perl/t/200_live.t Fri Jan 14 20:37:54 2011
@@ -32,15 +32,17 @@
 
 my $response = HTTP::Tiny->new->get($test_url);
 
-ok( $response->{success}, "Successful request to $test_url" );
-like( $response->{content}, $test_re, "Saw expected content" )
-  or dump_headers($response->{headers});
+ok( $response->{status} ne '599', "Request to $test_url completed" )
+  or dump_hash($response);
+ok( $response->{content}, "Got content" );
 
-sub dump_headers {
+sub dump_hash {
   my $hash = shift;
-  for my $k ( sort keys %$hash ) {
-    print "# $k\: $hash->{$k}\n";
-  }
+  $hash->{content} = substr($hash->{content},0,160) . "...";
+  require Data::Dumper;
+  my $dumped = Data::Dumper::Dumper($hash);
+  $dumped =~ s{^}{# };
+  print $dumped;
 }
 
 done_testing;




More information about the Pkg-perl-cvs-commits mailing list