lib/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 ### Redirect errors to file ###
  21 local $CPANPLUS::Error::ERROR_FH = output_handle() unless @ARGV;
  22 local $CPANPLUS::Error::MSG_FH   = output_handle() unless @ARGV;
  23
  24 my $cb = CPANPLUS::Backend->new( $conf );
  25 isa_ok($cb, "CPANPLUS::Internals" );
  26
  27 my $mod = $cb->module_tree( TEST_CONF_MODULE );
  28 isa_ok( $mod,  'CPANPLUS::Module' );
  29
  30 ### fail host tests ###
  31 {   my $host = {};
  32     my $rv   = $cb->_add_fail_host( host => $host );
  33
  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" );
  39 }
  40
  41 ### refetch, even if it's there already ###
  42 {   my $where = $cb->_fetch( module => $mod, force => 1 );
  43
  44     ok( $where,                 "File downloaded to '$where'" );
  45     ok( -s $where,              "   File exists" );
  46     unlink $where;
  47     ok(!-e $where,              "   File removed" );
  48 }
  49
  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',
  54                     path    => "$0/$0" };
  55
  56     unshift @$hosts, $fail;
  57     $conf->set_conf( hosts => $hosts );
  58
  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" );
  63
  64     ### but the error should be recorded ###
  65     like( CPANPLUS::Error->stack_as_string, qr/Fetching of .*? failed/s,
  66                                 "   Error recorded appropriately" );
  67
  68     ### host marked as bad? ###
  69     ok(!$cb->_host_ok( host => $fail ),
  70                                 "   Failed host logged properly" );
  71
  72     ### restore the hosts ###
  73     shift @$hosts; $conf->set_conf( hosts => $hosts );
  74 }
  75
  76 ### try and fetch a URI
  77 {   my $base    = basename($0);
  78
  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() ),
  87                         ),
  88                         $base
  89                     )
  90                   );
  91
  92     my $fake    = $cb->parse_module( module => $target );
  93
  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" );
  98
  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" );
 105 }
 106
 107
 108 # Local variables:
 109 # c-indentation-style: bsd
 110 # c-basic-offset: 4
 111 # indent-tabs-mode: nil
 112 # End:
 113 # vim: expandtab shiftwidth=4: