From: Chris Williams <chris@bingosnet.co.uk>
Date: Wed, 11 Nov 2009 23:52:00 +0000 (+0000)
Subject: Update File::Fetch to cpan version 0.21_01
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=314f55841dc68fd504716c81f13bff95860a6211;p=p5sagit%2Fp5-mst-13.2.git

Update File::Fetch to cpan version 0.21_01

  Changes for 0.21_01     Wed Nov 11 23:38:27 2009
  =================================================
  * Added a simple IO::Socket/IO::Select based http retriever,
    based on code suggested by Paul 'Leonerd' Evans
---

diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl
index 41001af..0b58929 100755
--- a/Porting/Maintainers.pl
+++ b/Porting/Maintainers.pl
@@ -660,7 +660,7 @@ use File::Glob qw(:case);
     'File::Fetch' =>
 	{
 	'MAINTAINER'	=> 'kane',
-	'DISTRIBUTION'	=> 'KANE/File-Fetch-0.20.tar.gz',
+	'DISTRIBUTION'	=> 'BINGOS/File-Fetch-0.21_01.tar.gz',
 	'FILES'		=> q[cpan/File-Fetch],
 	'CPAN'		=> 1,
 	'UPSTREAM'	=> 'cpan',
diff --git a/cpan/File-Fetch/lib/File/Fetch.pm b/cpan/File-Fetch/lib/File/Fetch.pm
index d093560..dfe0484 100644
--- a/cpan/File-Fetch/lib/File/Fetch.pm
+++ b/cpan/File-Fetch/lib/File/Fetch.pm
@@ -22,7 +22,7 @@ use vars    qw[ $VERBOSE $PREFER_BIN $FROM_EMAIL $USER_AGENT
                 $FTP_PASSIVE $TIMEOUT $DEBUG $WARN
             ];
 
-$VERSION        = '0.20';
+$VERSION        = '0.21_01';
 $VERSION        = eval $VERSION;    # avoid warnings with development releases
 $PREFER_BIN     = 0;                # XXX TODO implement
 $FROM_EMAIL     = 'File-Fetch@example.com';
@@ -36,7 +36,7 @@ $WARN           = 1;
 
 ### methods available to fetch the file depending on the scheme
 $METHODS = {
-    http    => [ qw|lwp wget curl lftp lynx| ],
+    http    => [ qw|lwp wget curl lftp lynx iosock| ],
     ftp     => [ qw|lwp netftp wget curl lftp ncftp ftp| ],
     file    => [ qw|lwp lftp file| ],
     rsync   => [ qw|rsync| ]
@@ -584,6 +584,70 @@ sub _lwp_fetch {
     }
 }
 
+### Simple IO::Socket::INET fetching ###
+sub _iosock_fetch {
+    my $self = shift;
+    my %hash = @_;
+
+    my ($to);
+    my $tmpl = {
+        to  => { required => 1, store => \$to }
+    };
+    check( $tmpl, \%hash ) or return;
+
+    my $use_list = {
+        'IO::Socket::INET' => '0.0',
+        'IO::Select'       => '0.0',
+    };
+
+    if( can_load(modules => $use_list) ) {
+        my $sock = IO::Socket::INET->new( 
+            PeerHost => $self->host,
+            ( $self->host =~ /:/ ? () : ( PeerPort => 80 ) ),
+        );
+
+        unless ( $sock ) {
+            return $self->_error(loc("Could not open socket to '%1', '%2'",$self->host,$!));
+        }
+
+        my $fh = FileHandle->new;
+
+        # Check open()
+
+        unless ( $fh->open($to,'>') ) {
+            return $self->_error(loc(
+                 "Could not open '%1' for writing: %2",$to,$!));
+        }
+
+        $sock->send( "GET $self->path HTTP/1.0\x0d\x0aHost: $self->host\x0d\x0a\x0d\x0a" );
+
+        my $select = IO::Select->new( $sock );
+
+        my $resp = '';
+        my $normal = 0;
+        while ( $select->can_read( $TIMEOUT || 60 ) ) {
+          my $ret = $sock->sysread( $resp, 4096, length($resp) );
+          if ( !defined $ret or $ret == 0 ) {
+            $select->remove( $sock );
+            $normal++;
+          }
+        }
+        close $sock;
+
+        unless ( $normal ) {
+            return $self->_error(loc("Socket timed out after '%1' seconds", ( $TIMEOUT || 60 )));
+        }
+
+        print $fh +($resp =~ m/\x0d\x0a\x0d\x0a(.*)$/s )[0];
+        close $fh;
+        return $to;
+
+    } else {
+        $METHOD_FAIL->{'iosock'} = 1;
+        return;
+    }
+}
+
 ### Net::FTP fetching
 sub _netftp_fetch {
     my $self = shift;
@@ -1186,7 +1250,7 @@ Below is a mapping of what utilities will be used in what order
 for what schemes, if available:
 
     file    => LWP, lftp, file
-    http    => LWP, wget, curl, lftp, lynx
+    http    => LWP, wget, curl, lftp, lynx, iosock
     ftp     => LWP, Net::FTP, wget, curl, lftp, ncftp, ftp
     rsync   => rsync
 
@@ -1198,6 +1262,9 @@ If a utility or module isn't available, it will be marked in a cache
 tried again. The C<fetch> method will only fail when all options are
 exhausted, and it was not able to retrieve the file.
 
+C<iosock> is a very limited L<IO::Socket::INET> based mechanism for
+retrieving C<http> schemed urls. It doesn't follow redirects for instance.
+
 A special note about fetching files from an ftp uri:
 
 By default, all ftp connections are done in passive mode. To change
@@ -1304,6 +1371,7 @@ the $BLACKLIST, $METHOD_FAIL and other internal functions.
     curl        => curl
     rsync       => rsync
     lftp        => lftp
+    IO::Socket  => iosock
 
 =head1 FREQUENTLY ASKED QUESTIONS
 
diff --git a/cpan/File-Fetch/t/01_File-Fetch.t b/cpan/File-Fetch/t/01_File-Fetch.t
index 1cd7e8d..652c10c 100644
--- a/cpan/File-Fetch/t/01_File-Fetch.t
+++ b/cpan/File-Fetch/t/01_File-Fetch.t
@@ -177,7 +177,7 @@ for my $entry (@map) {
                   'http://www.cpan.org/index.html?q=1',
                   'http://www.cpan.org/index.html?q=1&y=2',
     ) {
-        for (qw[lwp wget curl lftp lynx]) {
+        for (qw[lwp wget curl lftp lynx iosock]) {
             _fetch_uri( http => $uri, $_ );
         }
     }