cpan/CPANPLUS/t/05_CPANPLUS-Internals-Fetch.t

   1 ### make sure we can find our conf.pl file
   2 BEGIN {
   3     use FindBin;
   4     require "$FindBin::Bin/inc/conf.pl";
   5 }
   6
   7 use strict;
   8
   9 use CPANPLUS::Backend;
  10
  11 use Test::More 'no_plan';
  12 use Data::Dumper;
  13 use File::Spec;
  14 use Cwd;
  15 use File::Basename;
  16 use CPANPLUS::Internals::Constants;
  17
  18 my $conf = gimme_conf();
  19
  20 my $cb = CPANPLUS::Backend->new( $conf );
  21 isa_ok($cb, "CPANPLUS::Internals" );
  22
  23 my $mod = $cb->module_tree( TEST_CONF_MODULE );
  24 isa_ok( $mod,  'CPANPLUS::Module' );
  25
  26 ### fail host tests ###
  27 {   my $host = {};
  28     my $rv   = $cb->_add_fail_host( host => $host );
  29
  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" );
  35 }
  36
  37 ### refetch, even if it's there already ###
  38 {   my $where = $cb->_fetch( module => $mod, force => 1 );
  39
  40     ok( $where,                 "File downloaded to '$where'" );
  41     ok( -s $where,              "   File exists" );
  42     unlink $where;
  43     ok(!-e $where,              "   File removed" );
  44 }
  45
  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',
  50                     path    => "$0/$0" };
  51
  52     unshift @$hosts, $fail;
  53     $conf->set_conf( hosts => $hosts );
  54
  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" );
  59
  60     ### but the error should be recorded ###
  61     like( CPANPLUS::Error->stack_as_string, qr/Fetching of .*? failed/s,
  62                                 "   Error recorded appropriately" );
  63
  64     ### host marked as bad? ###
  65     ok(!$cb->_host_ok( host => $fail ),
  66                                 "   Failed host logged properly" );
  67
  68     ### restore the hosts ###
  69     shift @$hosts; $conf->set_conf( hosts => $hosts );
  70 }
  71
  72 ### try and fetch a URI
  73 {   my $base    = basename($0);
  74
  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
  79     my $cwd     = cwd();
  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 ) ),
  84               $base
  85           );
  86
  87     my $target  = CREATE_FILE_URI->($in_file);
  88
  89     my $fake    = $cb->parse_module( module => $target );
  90
  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" );
  95
  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" );
 102 }
 103
 104
 105 # Local variables:
 106 # c-indentation-style: bsd
 107 # c-basic-offset: 4
 108 # indent-tabs-mode: nil
 109 # End:
 110 # vim: expandtab shiftwidth=4: