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 ### Redirect errors to file ###
21 local $CPANPLUS::Error::ERROR_FH = output_handle() unless @ARGV;
22 local $CPANPLUS::Error::MSG_FH = output_handle() unless @ARGV;
24 my $cb = CPANPLUS::Backend->new( $conf );
25 isa_ok($cb, "CPANPLUS::Internals" );
27 my $mod = $cb->module_tree( TEST_CONF_MODULE );
28 isa_ok( $mod, 'CPANPLUS::Module' );
30 ### fail host tests ###
32 my $rv = $cb->_add_fail_host( host => $host );
34 ok( $rv, "Failed host added " );
35 ok(!$cb->_host_ok( host => $host),
36 " Host registered as failed" );
37 ok( $cb->_host_ok( host => {} ),
38 " Fresh host unregistered" );
41 ### refetch, even if it's there already ###
42 { my $where = $cb->_fetch( module => $mod, force => 1 );
44 ok( $where, "File downloaded to '$where'" );
45 ok( -s $where, " File exists" );
47 ok(!-e $where, " File removed" );
50 ### try to fetch something that doesn't exist ###
51 { ### set up a bogus host first ###
52 my $hosts = $conf->get_conf('hosts');
53 my $fail = { scheme => 'file',
56 unshift @$hosts, $fail;
57 $conf->set_conf( hosts => $hosts );
59 ### the fallback host will get it ###
60 my $where = $cb->_fetch( module => $mod, force => 1, verbose => 0 );
61 ok($where, "File downloaded to '$where'" );
62 ok( -s $where, " File exists" );
64 ### but the error should be recorded ###
65 like( CPANPLUS::Error->stack_as_string, qr/Fetching of .*? failed/s,
66 " Error recorded appropriately" );
68 ### host marked as bad? ###
69 ok(!$cb->_host_ok( host => $fail ),
70 " Failed host logged properly" );
72 ### restore the hosts ###
73 shift @$hosts; $conf->set_conf( hosts => $hosts );
76 ### try and fetch a URI
77 { my $base = basename($0);
79 ### do an ON_UNIX test, cygwin will fail tests otherwise (#14553)
80 ### create a file URI. Make sure to split it by LOCAL rules
81 ### and JOIN by unix rules, so we get a proper file uri
82 ### otherwise, we might break win32. See bug #18702
83 my $target = CREATE_FILE_URI->(
84 File::Spec::Unix->catfile(
85 File::Spec::Unix->catdir(
86 File::Spec->splitdir( cwd() ),
92 my $fake = $cb->parse_module( module => $target );
94 ok( IS_FAKE_MODOBJ->(mod => $fake),
95 "Fake module created from $0" );
96 is( $fake->status->_fetch_from, $target,
97 " Fetch from set ok" );
99 my $where = $fake->fetch;
100 ok( $where, " $target fetched ok" );
101 ok( -s $where, " $where exists" );
102 like( $where, '/'. UNKNOWN_DL_LOCATION .'/',
103 " Saved to proper location" );
104 like( $where, qr/$base$/, " Saved with proper name" );
109 # c-indentation-style: bsd
111 # indent-tabs-mode: nil
113 # vim: expandtab shiftwidth=4: