Add HTTP::Tiny as a dual-life core module

HTTP::Tiny 0.008 has been added as a dual-life module.  It is a very
small, simple HTTP/1.1 client designed for simple GET requests and file
mirroring.  It has has been added to enable CPAN.pm and CPANPLUS to
"bootstrap" HTTP access to CPAN using pure Perl without relying on external
binaries like F<curl> or F<wget>.

1 files changed, 177 insertions, 0 deletions

diff --git a/cpan/HTTP-Tiny/t/Util.pm b/cpan/HTTP-Tiny/t/Util.pm
new file mode 100644
index 0000000000..f6c5f321de
--- /dev/null
+++ b/cpan/HTTP-Tiny/t/Util.pm
@@ -0,0 +1,177 @@
+#
+# This file is part of HTTP-Tiny
+#
+# This software is copyright (c) 2011 by Christian Hansen.
+#
+# This is free software; you can redistribute it and/or modify it under
+# the same terms as the Perl 5 programming language system itself.
+#
+package t::Util;
+
+use strict;
+use warnings;
+
+use IO::File q[SEEK_SET];
+use IO::Dir;
+
+BEGIN {
+    our @EXPORT_OK = qw(
+        rewind
+        tmpfile
+        dir_list
+        slurp
+        parse_case
+        hashify
+        sort_headers
+        connect_args
+        clear_socket_source
+        set_socket_source
+        monkey_patch
+        $CRLF
+        $LF
+    );
+
+    require Exporter;
+    *import = \&Exporter::import;
+}
+
+our $CRLF = "\x0D\x0A";
+our $LF   = "\x0A";
+
+sub rewind(*) {
+    seek($_[0], 0, SEEK_SET)
+      || die(qq/Couldn't rewind file handle: '$!'/);
+}
+
+sub tmpfile {
+    my $fh = IO::File->new_tmpfile
+      || die(qq/Couldn't create a new temporary file: '$!'/);
+
+    binmode($fh)
+      || die(qq/Couldn't binmode temporary file handle: '$!'/);
+
+    if (@_) {
+        print({$fh} @_)
+          || die(qq/Couldn't write to temporary file handle: '$!'/);
+
+        seek($fh, 0, SEEK_SET)
+          || die(qq/Couldn't rewind temporary file handle: '$!'/);
+    }
+
+    return $fh;
+}
+
+sub dir_list {
+    my ($dir, $filter) = @_;
+    $filter ||= qr/./;
+    my $d = IO::Dir->new($dir)
+        or return;
+    return map { "$dir/$_" } sort grep { /$filter/ } grep { /^[^.]/ } $d->read;
+}
+
+sub slurp (*) {
+    my ($fh) = @_;
+
+    rewind($fh);
+
+    binmode($fh)
+      || die(qq/Couldn't binmode file handle: '$!'/);
+
+    my $exp = -s $fh;
+    my $buf = do { local $/; <$fh> };
+    my $got = length $buf;
+
+    ($exp == $got)
+      || die(qq[I/O read mismatch (expexted: $exp got: $got)]);
+
+    return $buf;
+}
+
+sub parse_case {
+    my ($case) = @_;
+    my %args;
+    my $key = '';
+    for my $line ( split "\n", $case ) {
+        chomp $line;
+        if ( substr($line,0,1) eq q{ } ) {
+            $line =~ s/^\s+//;
+            push @{$args{$key}}, $line;
+        }
+        else {
+            $key = $line;
+        }
+    }
+    return \%args;
+}
+
+sub hashify {
+    my ($lines) = @_;
+    return unless $lines;
+    my %hash;
+    for my $line ( @$lines ) {
+        my ($k,$v) = ($line =~ m{^([^:]+): (.*)$}g);
+        $hash{$k} = [ $hash{$k} ] if exists $hash{$k} && ref $hash{$k} ne 'ARRAY';
+        if ( ref($hash{$k}) eq 'ARRAY' ) {
+            push @{$hash{$k}}, $v;
+        }
+        else {
+            $hash{$k} = $v;
+        }
+    }
+    return %hash;
+}
+
+sub sort_headers {
+    my ($text) = shift;
+    my @lines = split /$CRLF/, $text;
+    my $request = shift(@lines) || '';
+    my @headers;
+    while (my $line = shift @lines) {
+        last unless length $line;
+        push @headers, $line;
+    }
+    @headers = sort @headers;
+    return join($CRLF, $request, @headers, '', @lines);
+}
+
+{
+    my (@req_fh, @res_fh, $monkey_host, $monkey_port);
+
+    sub clear_socket_source {
+        @req_fh = ();
+        @res_fh = ();
+    }
+
+    sub set_socket_source {
+        my ($req_fh, $res_fh) = @_;
+        push @req_fh, $req_fh;
+        push @res_fh, $res_fh;
+    }
+
+    sub connect_args { return ($monkey_host, $monkey_port) }
+
+    sub monkey_patch {
+        no warnings qw/redefine once/;
+        *HTTP::Tiny::Handle::can_read = sub {1};
+        *HTTP::Tiny::Handle::can_write = sub {1};
+        *HTTP::Tiny::Handle::connect = sub {
+            my ($self, $scheme, $host, $port) = @_;
+            $self->{host} = $monkey_host = $host;
+            $self->{port} = $monkey_port = $port;
+            $self->{fh} = shift @req_fh;
+            return $self;
+        };
+        my $original_write_request = \&HTTP::Tiny::Handle::write_request;
+        *HTTP::Tiny::Handle::write_request = sub {
+            my ($self, $request) = @_;
+            $original_write_request->($self, $request);
+            $self->{fh} = shift @res_fh;
+        };
+        *HTTP::Tiny::Handle::close = sub { 1 }; # don't close our temps
+    }
+}
+
+1;
+
+
+# vim: et ts=4 sts=4 sw=4: