summaryrefslogtreecommitdiff
path: root/cpan/CPANPLUS/t/03_CPANPLUS-Internals-Source.t
diff options
context:
space:
mode:
Diffstat (limited to 'cpan/CPANPLUS/t/03_CPANPLUS-Internals-Source.t')
-rw-r--r--cpan/CPANPLUS/t/03_CPANPLUS-Internals-Source.t261
1 files changed, 261 insertions, 0 deletions
diff --git a/cpan/CPANPLUS/t/03_CPANPLUS-Internals-Source.t b/cpan/CPANPLUS/t/03_CPANPLUS-Internals-Source.t
new file mode 100644
index 0000000000..65f1e54c35
--- /dev/null
+++ b/cpan/CPANPLUS/t/03_CPANPLUS-Internals-Source.t
@@ -0,0 +1,261 @@
+### make sure we can find our conf.pl file
+BEGIN {
+ use FindBin;
+ require "$FindBin::Bin/inc/conf.pl";
+}
+
+use strict;
+
+use Module::Load;
+use Test::More eval {
+ load $ENV{CPANPLUS_SOURCE_ENGINE} if $ENV{CPANPLUS_SOURCE_ENGINE}; 1
+ } ? 'no_plan'
+ : (skip_all => "SQLite engine not available");
+
+use CPANPLUS::Error;
+use CPANPLUS::Backend;
+use CPANPLUS::Internals::Constants;
+
+use Data::Dumper;
+use File::Basename qw[dirname];
+
+my $conf = gimme_conf();
+my $cb = CPANPLUS::Backend->new( $conf );
+
+### XXX temp
+# $conf->set_conf( verbose => 1 );
+
+isa_ok($cb, "CPANPLUS::Internals" );
+
+my $modname = TEST_CONF_MODULE;
+
+### test lookups
+{ my $mt = $cb->_module_tree;
+ my $at = $cb->_author_tree;
+
+ ### source files should be copied from the 'server' now
+ for my $name (qw[auth mod dslip] ) {
+ my $file = File::Spec->catfile(
+ $conf->get_conf('base'),
+ $conf->_get_source($name)
+ );
+ ok( (-e $file && -f _ && -s _), "$file exists" );
+ }
+
+ ok( $at, "Authortree loaded successfully" );
+ ok( scalar keys %$at, " Authortree has items in it" );
+ ok( $mt, "Moduletree loaded successfully" );
+ ok( scalar keys %$mt, " Moduletree has items in it" );
+
+ my $auth = $at->{'EUNOXS'};
+ my $mod = $mt->{$modname};
+
+ isa_ok( $auth, 'CPANPLUS::Module::Author' );
+ isa_ok( $mod, 'CPANPLUS::Module' );
+}
+
+### save state tests
+SKIP: {
+ skip "Save state tests for custom engine $ENV{CPANPLUS_SOURCE_ENGINE}", 7
+ if $ENV{CPANPLUS_SOURCE_ENGINE};
+
+ ok( 1, "Testing save state functionality" );
+
+
+ ### check we dont have a status set yet
+ { my $mod = $cb->_module_tree->{$modname};
+ ok( !$mod->_status, " No status set yet in module object" );
+ ok( $mod->status, " Status now set" );
+ }
+
+ ### now save this to disk
+ { CPANPLUS::Error->flush;
+
+ my $rv = $cb->save_state;
+ ok( $rv, " State information saved" );
+
+ like( CPANPLUS::Error->stack_as_string, qr/Writing compiled source/,
+ " Diagnostics confirmed" );
+ }
+
+ ### now we rebuild the trees from disk and
+ ### check if the module object has a status saved with it
+ { CPANPLUS::Error->flush;
+ ok( $cb->_build_trees( uptodate => 1, use_stored => 1),
+ " Trees are rebuilt" );
+
+ like( CPANPLUS::Error->stack_as_string, qr/Retrieving/,
+ " Diagnostics confirmed" );
+
+
+ my $mod = $cb->_module_tree->{$modname};
+ ok( $mod->status, " Status now set in module object" );
+ }
+}
+
+### check custom sources
+### XXX whitebox test
+SKIP: {
+ ### first, find a file to serve as a source
+ my $mod = $cb->_module_tree->{$modname};
+ my $package = File::Spec->rel2abs(
+ File::Spec->catfile(
+ $FindBin::Bin,
+ TEST_CONF_CPAN_DIR,
+ $mod->path,
+ $mod->package,
+ )
+ );
+
+ ok( $package, "Found file for custom source" );
+ ok( -e $package, " File '$package' exists" );
+
+ ### remote uri
+ my $uri = $cb->_host_to_uri(
+ scheme => 'file',
+ host => '',
+ path => File::Spec->catfile( dirname($package) )
+ );
+
+ my $expected_file = $cb->__custom_module_source_index_file( uri => $uri );
+
+ ok( $expected_file, "Sources should be written to '$uri'" );
+
+ skip( "Index file size too long (>260 chars). Can't write to disk", 28 )
+ if length $expected_file > 260 and ON_WIN32;
+
+
+ ### local file
+ ### 2 tests
+ my $src_file = $cb->_add_custom_module_source( uri => $uri );
+ ok( $src_file, "Sources written to '$src_file'" );
+ ok( -e $src_file, " File exists" );
+
+ ### and write the file
+ ### 5 tests
+ { my $meth = '__write_custom_module_index';
+ can_ok( $cb, $meth );
+
+ my $rv = $cb->$meth(
+ path => dirname( $package ),
+ to => $src_file
+ );
+
+ ok( $rv, " Sources written" );
+ is( $rv, $src_file, " Written to expected file" );
+ ok( -e $src_file, " Source file exists" );
+ ok( -s $src_file, " File has non-zero size" );
+ }
+
+ ### let's see if we can find our custom files
+ ### 3 tests
+ { my $meth = '__list_custom_module_sources';
+ can_ok( $cb, $meth );
+
+ my %files = $cb->$meth;
+ ok( scalar(keys(%files)),
+ " Got list of sources" );
+
+ ### on VMS, we can't predict the case unfortunately
+ ### so grep for it instead;
+ my $found = map {
+ my $src_re = quotemeta($src_file);
+ $_ =~ /$src_re/i;
+ } keys %files;
+
+ ok( $found, " Found proper entry for $src_file" );
+ }
+
+ ### now we can have it be loaded in
+ ### 6 tests
+ { my $meth = '__create_custom_module_entries';
+ can_ok( $cb, $meth );
+
+ ### now add our own sources
+ ok( $cb->$meth, "Sources file loaded" );
+
+ my $add_name = TEST_CONF_INST_MODULE;
+ my $add = $cb->_module_tree->{$add_name};
+ ok( $add, " Found added module" );
+
+ ok( $add->status->_fetch_from,
+ " Full download path set" );
+ is( $add->author->cpanid, CUSTOM_AUTHOR_ID,
+ " Attributed to custom author" );
+
+ ### since we replaced an existing module, there should be
+ ### a message on the stack
+ like( CPANPLUS::Error->stack_as_string, qr/overwrite module tree/i,
+ " Addition message recorded" );
+ }
+
+ ### test updating custom sources
+ ### 3 tests
+ { my $meth = '__update_custom_module_sources';
+ can_ok( $cb, $meth );
+
+ ### mark what time it is now, sleep 1 second for better measuring
+ my $now = time;
+ sleep 1;
+
+ my $ok = $cb->$meth;
+
+ ok( $ok, "Custom sources updated" );
+ cmp_ok( [stat $src_file]->[9], '>=', $now,
+ " Timestamp on sourcefile updated" );
+ }
+
+ ### now update it individually
+ ### 3 tests
+ { my $meth = '__update_custom_module_source';
+ can_ok( $cb, $meth );
+
+ ### mark what time it is now, sleep 1 second for better measuring
+ my $now = time;
+ sleep 1;
+
+ my $ok = $cb->$meth( remote => $uri );
+
+ ok( $ok, "Custom source for '$uri' updated" );
+ cmp_ok( [stat $src_file]->[9], '>=', $now,
+ " Timestamp on sourcefile updated" );
+ }
+
+ ### now update using the higher level API, see if it's part of the update
+ ### 3 tests
+ { CPANPLUS::Error->flush;
+
+ ### mark what time it is now, sleep 1 second for better measuring
+ my $now = time;
+ sleep 1;
+
+ my $ok = $cb->_build_trees(
+ uptodate => 0,
+ use_stored => 0,
+ );
+
+ ok( $ok, "All sources updated" );
+ cmp_ok( [stat $src_file]->[9], '>=', $now,
+ " Timestamp on sourcefile updated" );
+
+ like( CPANPLUS::Error->stack_as_string, qr/Updating sources from/,
+ " Update recorded in the log" );
+ }
+
+ ### now remove the index file;
+ ### 3 tests
+ { my $meth = '_remove_custom_module_source';
+ can_ok( $cb, $meth );
+
+ my $file = $cb->$meth( uri => $uri );
+ ok( $file, "Index file removed" );
+ ok( ! -e $file, " File '$file' no longer on disk" );
+ }
+}
+
+# Local variables:
+# c-indentation-style: bsd
+# c-basic-offset: 4
+# indent-tabs-mode: nil
+# End:
+# vim: expandtab shiftwidth=4:
View Lorry Controller Status