summaryrefslogtreecommitdiff
path: root/cpan/File-Fetch
diff options
context:
space:
mode:
authorChris Williams <chris@bingosnet.co.uk>2009-11-11 23:52:00 +0000
committerChris Williams <chris@bingosnet.co.uk>2009-11-11 23:52:00 +0000
commit314f55841dc68fd504716c81f13bff95860a6211 (patch)
tree72a40a2ca5e7277fda116959bac86bc9efeb998a /cpan/File-Fetch
parent2489f03d17f65312c4370377c30587ab801b844f (diff)
downloadperl-314f55841dc68fd504716c81f13bff95860a6211.tar.gz
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
Diffstat (limited to 'cpan/File-Fetch')
-rw-r--r--cpan/File-Fetch/lib/File/Fetch.pm74
-rw-r--r--cpan/File-Fetch/t/01_File-Fetch.t2
2 files changed, 72 insertions, 4 deletions
diff --git a/cpan/File-Fetch/lib/File/Fetch.pm b/cpan/File-Fetch/lib/File/Fetch.pm
index d093560126..dfe0484f19 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 1cd7e8d126..652c10ce36 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, $_ );
}
}