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