lib/CPANPLUS/t/03_CPANPLUS-Internals-Source.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 use CPANPLUS::Internals::Constants;
  11
  12 use Test::More 'no_plan';
  13 use Data::Dumper;
  14 use File::Basename qw[dirname];
  15
  16 my $conf = gimme_conf();
  17 my $cb   = CPANPLUS::Backend->new( $conf );
  18
  19 ### XXX temp
  20 # $conf->set_conf( verbose => 1 );
  21
  22 isa_ok($cb, "CPANPLUS::Internals" );
  23
  24 my $mt      = $cb->_module_tree;
  25 my $at      = $cb->_author_tree;
  26 my $modname = TEST_CONF_MODULE;
  27
  28 for my $name (qw[auth mod dslip] ) {
  29     my $file = File::Spec->catfile(
  30                         $conf->get_conf('base'),
  31                         $conf->_get_source($name)
  32                 );
  33     ok( (-e $file && -f _ && -s _), "$file exists" );
  34 }
  35
  36 ok( scalar keys %$at,           "Authortree loaded successfully" );
  37 ok( scalar keys %$mt,           "Moduletree loaded successfully" );
  38
  39 ### test lookups
  40 {   my $auth    = $at->{'EUNOXS'};
  41     my $mod     = $mt->{$modname};
  42
  43     isa_ok( $auth,              'CPANPLUS::Module::Author' );
  44     isa_ok( $mod,               'CPANPLUS::Module' );
  45 }
  46
  47 ### check custom sources
  48 ### XXX whitebox test
  49 SKIP: {
  50     ### first, find a file to serve as a source
  51     my $mod     = $mt->{$modname};
  52     my $package = File::Spec->rel2abs(
  53                         File::Spec->catfile(
  54                             $FindBin::Bin,
  55                             TEST_CONF_CPAN_DIR,
  56                             $mod->path,
  57                             $mod->package,
  58                         )
  59                     );
  60
  61     ok( $package,               "Found file for custom source" );
  62     ok( -e $package,            "   File '$package' exists" );
  63
  64     ### remote uri
  65     my $uri      =  $cb->_host_to_uri(
  66                         scheme  => 'file',
  67                         host    => '',
  68                         path    => File::Spec->catfile( dirname($package) )
  69                     );
  70
  71     my $expected_file = $cb->__custom_module_source_index_file( uri => $uri );
  72
  73     ok( $expected_file,         "Sources should be written to '$uri'" );
  74
  75     skip( "Index file size too long (>260 chars). Can't write to disk", 28 )
  76         if length $expected_file > 260 and ON_WIN32;
  77
  78
  79     ### local file
  80     ### 2 tests
  81     my $src_file = $cb->_add_custom_module_source( uri => $uri );
  82     ok( $src_file,              "Sources written to '$src_file'" );
  83     ok( -e $src_file,           "   File exists" );
  84
  85     ### and write the file
  86     ### 5 tests
  87     {   my $meth = '__write_custom_module_index';
  88         can_ok( $cb,    $meth );
  89
  90         my $rv = $cb->$meth(
  91                         path => dirname( $package ),
  92                         to   => $src_file
  93                     );
  94
  95         ok( $rv,                "   Sources written" );
  96         is( $rv, $src_file,     "       Written to expected file" );
  97         ok( -e $src_file,       "       Source file exists" );
  98         ok( -s $src_file,       "       File has non-zero size" );
  99     }
 100
 101     ### let's see if we can find our custom files
 102     ### 3 tests
 103     {   my $meth = '__list_custom_module_sources';
 104         can_ok( $cb,    $meth );
 105
 106         my %files = $cb->$meth;
 107         ok( scalar(keys(%files)),
 108                                 "   Got list of sources" );
 109
 110         ### on VMS, we can't predict the case unfortunately
 111         ### so grep for it instead;
 112         my $found = map {
 113             my $src_re = quotemeta($src_file);
 114             $_ =~ /$src_re/i;
 115         } keys %files;
 116
 117         ok( $found,             "   Found proper entry for $src_file" );
 118     }
 119
 120     ### now we can have it be loaded in
 121     ### 6 tests
 122     {   my $meth = '__create_custom_module_entries';
 123         can_ok( $cb,    $meth );
 124
 125         ### now add our own sources
 126         ok( $cb->$meth,         "Sources file loaded" );
 127
 128         my $add_name = TEST_CONF_INST_MODULE;
 129         my $add      = $mt->{$add_name};
 130         ok( $add,               "   Found added module" );
 131
 132         ok( $add->status->_fetch_from,
 133                                 "       Full download path set" );
 134         is( $add->author->cpanid, CUSTOM_AUTHOR_ID,
 135                                 "       Attributed to custom author" );
 136
 137         ### since we replaced an existing module, there should be
 138         ### a message on the stack
 139         like( CPANPLUS::Error->stack_as_string, qr/overwrite module tree/i,
 140                                 "   Addition message recorded" );
 141     }
 142
 143     ### test updating custom sources
 144     ### 3 tests
 145     {   my $meth    = '__update_custom_module_sources';
 146         can_ok( $cb,    $meth );
 147
 148         ### mark what time it is now, sleep 1 second for better measuring
 149         my $now     = time;
 150         sleep 1;
 151
 152         my $ok      = $cb->$meth;
 153
 154         ok( $ok,                    "Custom sources updated" );
 155         cmp_ok( [stat $src_file]->[9], '>=', $now,
 156                                     "   Timestamp on sourcefile updated" );
 157     }
 158
 159     ### now update it individually
 160     ### 3 tests
 161     {   my $meth    = '__update_custom_module_source';
 162         can_ok( $cb,    $meth );
 163
 164         ### mark what time it is now, sleep 1 second for better measuring
 165         my $now     = time;
 166         sleep 1;
 167
 168         my $ok      = $cb->$meth( remote => $uri );
 169
 170         ok( $ok,                    "Custom source for '$uri' updated" );
 171         cmp_ok( [stat $src_file]->[9], '>=', $now,
 172                                     "   Timestamp on sourcefile updated" );
 173     }
 174
 175     ### now update using the higher level API, see if it's part of the update
 176     ### 3 tests
 177     {   CPANPLUS::Error->flush;
 178
 179         ### mark what time it is now, sleep 1 second for better measuring
 180         my $now = time;
 181         sleep 1;
 182
 183         my $ok  = $cb->_build_trees(
 184                         uptodate    => 0,
 185                         use_stored  => 0,
 186                     );
 187
 188         ok( $ok,                    "All sources updated" );
 189         cmp_ok( [stat $src_file]->[9], '>=', $now,
 190                                     "   Timestamp on sourcefile updated" );
 191
 192         like( CPANPLUS::Error->stack_as_string, qr/Updating sources from/,
 193                                     "   Update recorded in the log" );
 194     }
 195
 196     ### now remove the index file;
 197     ### 3 tests
 198     {   my $meth = '_remove_custom_module_source';
 199         can_ok( $cb,    $meth );
 200
 201         my $file = $cb->$meth( uri => $uri );
 202         ok( $file,                  "Index file removed" );
 203         ok( ! -e $file,             "   File '$file' no longer on disk" );
 204     }
 205 }
 206
 207 # Local variables:
 208 # c-indentation-style: bsd
 209 # c-basic-offset: 4
 210 # indent-tabs-mode: nil
 211 # End:
 212 # vim: expandtab shiftwidth=4: