1 ### make sure we can find our conf.pl file
4 require "$FindBin::Bin/inc/conf.pl";
11 use Test::More 'no_plan';
16 use CPANPLUS::Internals::Constants;
18 my $conf = gimme_conf();
20 my $cb = CPANPLUS::Backend->new( $conf );
21 isa_ok($cb, "CPANPLUS::Internals" );
23 my $mod = $cb->module_tree( TEST_CONF_MODULE );
24 isa_ok( $mod, 'CPANPLUS::Module' );
26 ### fail host tests ###
28 my $rv = $cb->_add_fail_host( host => $host );
30 ok( $rv, "Failed host added " );
31 ok(!$cb->_host_ok( host => $host),
32 " Host registered as failed" );
33 ok( $cb->_host_ok( host => {} ),
34 " Fresh host unregistered" );
37 ### refetch, even if it's there already ###
38 { my $where = $cb->_fetch( module => $mod, force => 1 );
40 ok( $where, "File downloaded to '$where'" );
41 ok( -s $where, " File exists" );
43 ok(!-e $where, " File removed" );
46 ### try to fetch something that doesn't exist ###
47 { ### set up a bogus host first ###
48 my $hosts = $conf->get_conf('hosts');
49 my $fail = { scheme => 'file',
52 unshift @$hosts, $fail;
53 $conf->set_conf( hosts => $hosts );
55 ### the fallback host will get it ###
56 my $where = $cb->_fetch( module => $mod, force => 1, verbose => 0 );
57 ok($where, "File downloaded to '$where'" );
58 ok( -s $where, " File exists" );
60 ### but the error should be recorded ###
61 like( CPANPLUS::Error->stack_as_string, qr/Fetching of .*? failed/s,
62 " Error recorded appropriately" );
64 ### host marked as bad? ###
65 ok(!$cb->_host_ok( host => $fail ),
66 " Failed host logged properly" );
68 ### restore the hosts ###
69 shift @$hosts; $conf->set_conf( hosts => $hosts );
72 ### try and fetch a URI
73 { my $base = basename($0);
75 ### do an ON_UNIX test, cygwin will fail tests otherwise (#14553)
76 ### create a file URI. Make sure to split it by LOCAL rules
77 ### and JOIN by unix rules, so we get a proper file uri
78 ### otherwise, we might break win32. See bug #18702
80 my $in_file = $^O eq 'VMS'
81 ? VMS::Filespec::unixify( File::Spec->catfile($cwd, $base) )
82 : File::Spec::Unix->catfile(
83 File::Spec::Unix->catdir( File::Spec->splitdir( $cwd ) ),
87 my $target = CREATE_FILE_URI->($in_file);
89 my $fake = $cb->parse_module( module => $target );
91 ok( IS_FAKE_MODOBJ->(mod => $fake),
92 "Fake module created from $0" );
93 is( $fake->status->_fetch_from, $target,
94 " Fetch from set ok" );
96 my $where = $fake->fetch;
97 ok( $where, " $target fetched ok" );
98 ok( -s $where, " $where exists" );
99 like( $where, '/'. UNKNOWN_DL_LOCATION .'/',
100 " Saved to proper location" );
101 like( $where, qr/$base$/, " Saved with proper name" );
106 # c-indentation-style: bsd
108 # indent-tabs-mode: nil
110 # vim: expandtab shiftwidth=4: