$FTP_PASSIVE $TIMEOUT $DEBUG $WARN
];
-$VERSION = '0.38';
+$VERSION = '0.42';
$VERSION = eval $VERSION; # avoid warnings with development releases
$PREFER_BIN = 0; # XXX TODO implement
$FROM_EMAIL = 'File-Fetch@example.com';
http => [ qw|lwp httptiny wget curl lftp fetch httplite lynx iosock| ],
ftp => [ qw|lwp netftp wget curl lftp fetch ncftp ftp| ],
file => [ qw|lwp lftp file| ],
- rsync => [ qw|rsync| ]
+ rsync => [ qw|rsync| ],
+ git => [ qw|git| ],
};
### silly warnings ###
File::Fetch is a generic file fetching mechanism.
It allows you to fetch any file pointed to by a C<ftp>, C<http>,
-C<file>, or C<rsync> uri by a number of different means.
+C<file>, C<git> or C<rsync> uri by a number of different means.
See the C<HOW IT WORKS> section further down for details.
}
+### use git to fetch files
+sub _git_fetch {
+ my $self = shift;
+ my %hash = @_;
+
+ my ($to);
+ my $tmpl = {
+ to => { required => 1, store => \$to }
+ };
+ check( $tmpl, \%hash ) or return;
+ my $git;
+ unless ( $git = can_run('git') ) {
+ $METHOD_FAIL->{'git'} = 1;
+ return;
+ }
+
+ my $cmd = [ $git, 'clone' ];
+
+ #push(@$cmd, '--timeout=' . $TIMEOUT) if $TIMEOUT;
+
+ push(@$cmd, '--quiet') unless $DEBUG;
+
+ ### DO NOT quote things for IPC::Run, it breaks stuff.
+ push @$cmd, $self->uri, $to;
+
+ ### with IPC::Cmd > 0.41, this is fixed in teh library,
+ ### and there's no need for special casing any more.
+ ### DO NOT quote things for IPC::Run, it breaks stuff.
+ # $IPC::Cmd::USE_IPC_RUN
+ # ? ($to, $self->uri)
+ # : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE);
+
+ my $captured;
+ unless(run( command => $cmd,
+ buffer => \$captured,
+ verbose => $DEBUG )
+ ) {
+
+ return $self->_error(loc("Command %1 failed: %2",
+ "@$cmd" || '', $captured || ''));
+ }
+
+ return $to;
+
+}
+
#################################
#
# Error code
http => LWP, HTTP::Lite, wget, curl, lftp, fetch, lynx, iosock
ftp => LWP, Net::FTP, wget, curl, lftp, fetch, ncftp, ftp
rsync => rsync
+ git => git
If you'd like to disable the use of one or more of these utilities
and/or modules, see the C<$BLACKLIST> variable further down.
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.
+C<git> only supports C<git://> style urls.
+
A special note about fetching files from an ftp uri:
By default, all ftp connections are done in passive mode. To change
use Cwd qw[cwd];
use File::Basename qw[basename];
+use File::Path qw[rmtree];
use Data::Dumper;
use_ok('File::Fetch');
}
### Heuristics
-my %heuristics = map { $_ => 1 } qw(http ftp rsync file);
+my %heuristics = map { $_ => 1 } qw(http ftp rsync file git);
### _parse_uri tests
### these go on all platforms
my @map = (
path => '/CPAN/',
file => 'MIRRORING.FROM',
},
+ { uri => 'git://github.com/jib/file-fetch.git',
+ scheme => 'git',
+ host => 'github.com',
+ path => '/jib/',
+ file => 'file-fetch.git',
+ },
{ uri => 'http://localhost/tmp/index.txt',
scheme => 'http',
host => 'localhost', # host is empty only on 'file://'
}
}
+### Heuristics
+{
+ require IO::Socket::INET;
+ my $sock = IO::Socket::INET->new( PeerAddr => 'github.com', PeerPort => 9418, Timeout => 20 )
+ or $heuristics{git} = 0;
+}
+
+### git:// tests ###
+{ my $uri = 'git://github.com/jib/file-fetch.git';
+
+ for (qw[git]) {
+ _fetch_uri( git => $uri, $_ );
+ }
+}
+
sub _fetch_uri {
my $type = shift;
my $uri = shift;
for my $to ( 'tmp', do { \my $o } ) { SKIP: {
- my $how = ref $to ? 'slurp' : 'file';
+ my $how = ref $to && $type ne 'git' ? 'slurp' : 'file';
my $skip = ref $to ? 4 : 3;
ok( 1, " Fetching '$uri' in $how mode" );
ok( $file, " File ($file) fetched with $method ($uri)" );
### check we got some contents if we were meant to slurp
- if( ref $to ) {
+ if( ref $to && $type ne 'git' ) {
ok( $$to, " Contents slurped" );
}
is( $file && basename($file), $ff->output_file,
" File has expected name" );
- unlink $file;
+ rmtree $file;
}}
}
}