view release on metacpan or  search on metacpan

t/01_File-Fetch.t  view on Meta::CPAN

BEGIN { chdir 't' if -d 't' };

use strict;
use warnings;
use lib '../lib';

use Test::More 'no_plan';

use Cwd             qw[cwd];
use File::Basename  qw[basename];
use File::Path      qw[rmtree];
use Data::Dumper;

use_ok('File::Fetch');

### optionally set debugging ###
$File::Fetch::DEBUG = $File::Fetch::DEBUG   = 1 if $ARGV[0];
$IPC::Cmd::DEBUG    = $IPC::Cmd::DEBUG      = 1 if $ARGV[0];

$File::Fetch::FORCEIPV4 = $File::Fetch::FORCEIPV4 = 1;

$File::Fetch::TIMEOUT = $File::Fetch::TIMEOUT = 30;

unless( $ENV{PERL_CORE} ) {
    warn qq[

####################### NOTE ##############################

Some of these tests assume you are connected to the
internet. If you are not, or if certain protocols or hosts
are blocked and/or firewalled, these tests could fail due
to no fault of the module itself.

###########################################################

];

    sleep 3 unless $File::Fetch::DEBUG;
}

### show us the tools IPC::Cmd will use to run binary programs
if( $File::Fetch::DEBUG ) {
    ### stupid 'used only once' warnings ;(
    diag( "IPC::Run enabled: " .
            $IPC::Cmd::USE_IPC_RUN || $IPC::Cmd::USE_IPC_RUN );
    diag( "IPC::Run available: " . IPC::Cmd->can_use_ipc_run );
    diag( "IPC::Run vesion: $IPC::Run::VERSION" );
    diag( "IPC::Open3 enabled: " .
            $IPC::Cmd::USE_IPC_OPEN3 || $IPC::Cmd::USE_IPC_OPEN3 );
    diag( "IPC::Open3 available: " . IPC::Cmd->can_use_ipc_open3 );
    diag( "IPC::Open3 vesion: $IPC::Open3::VERSION" );
}

### Heuristics
my %heuristics = map { $_ => 1 } qw(http ftp rsync file git);
### _parse_uri tests
### these go on all platforms
my @map = (
    {   uri     => 'ftp://cpan.org/pub/mirror/index.txt',
        scheme  => 'ftp',
        host    => 'cpan.org',
        path    => '/pub/mirror/',
        file    => 'index.txt'
    },
    {	uri	    => 'rsync://cpan.pair.com/CPAN/MIRRORING.FROM',
        scheme	=> 'rsync',
        host	=> 'cpan.pair.com',
        path	=> '/CPAN/',
        file	=> 'MIRRORING.FROM',
    },
    {	uri	    => 'git://github.com/Perl-Toolchain-Gang/file-fetch.git',
        scheme	=> 'git',
        host	=> 'github.com',
        path	=> '/Perl-Toolchain-Gang/',
        file	=> 'file-fetch.git',
    },
    {   uri     => 'http://localhost/tmp/index.txt',
        scheme  => 'http',
        host    => 'localhost',          # host is empty only on 'file://'
        path    => '/tmp/',
        file    => 'index.txt',
    },
    {   uri     => 'http://localhost',   # non-canonical URI
        scheme  => 'http',
        host    => 'localhost',
        path    => '/',                  # default path is '/'
        file    => '',
    },

    ### only test host part, the rest is OS dependant
    {   uri     => 'file://localhost/tmp/index.txt',