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