### make sure we can find our conf.pl file BEGIN { use FindBin; require "$FindBin::Bin/inc/conf.pl"; } use strict; use CPANPLUS::Backend; use CPANPLUS::Internals::Constants; use Test::More 'no_plan'; use Data::Dumper; my $conf = gimme_conf(); $conf->set_conf( verbose => 0 ); my $Class = 'CPANPLUS::Selfupdate'; my $ModClass = "CPANPLUS::Selfupdate::Module"; my $CB = CPANPLUS::Backend->new( $conf ); my $Acc = 'selfupdate_object'; my $Conf = $Class->_get_config; my $Dep = TEST_CONF_PREREQ; # has to be in our package file && core! my $Feat = 'some_feature'; my $Prereq = { $Dep => 0 }; ### test the object { ok( $CB, "New backend object created" ); can_ok( $CB, $Acc ); ok( $Conf, "Got configuration hash" ); my $su = $CB->$Acc; ok( $su, "Selfupdate object retrieved" ); isa_ok( $su, $Class ); } ### check specifically if our bundled shells dont trigger a ### dependency (see #26077). ### do this _before_ changing the built in conf! { my $meth = 'modules_for_feature'; my $type = 'shell'; my $cobj = $CB->configure_object; my $cur = $cobj->get_conf( $type ); for my $shell ( SHELL_DEFAULT, SHELL_CLASSIC ) { ok( $cobj->set_conf( $type => $shell ), "Testing dependencies for '$shell'" ); my $rv = $CB->$Acc->$meth( $type => 1); ok( !$rv, " No dependencies for '$shell' -- bundled" ); } for my $shell ( 'CPANPLUS::Test::Shell' ) { ok( $cobj->set_conf( $type => $shell ), "Testing dependencies for '$shell'" ); my $rv = $CB->$Acc->$meth( $type => 1 ); ok( $rv, " Got prereq hash" ); isa_ok( $rv, 'HASH', " Return value" ); is_deeply( $rv, { $shell => '0.0' }, " With the proper entries" ); } } ### test the feature list { ### start with defining our OWN type of config, as not all mentioned ### modules will be present in our bundled package files. ### XXX WHITEBOX TEST!!!! { delete $Conf->{$_} for keys %$Conf; $Conf->{'dependencies'} = $Prereq; $Conf->{'core'} = $Prereq; $Conf->{'features'}->{$Feat} = [ $Prereq, sub { 1 } ]; } is_deeply( $Conf, $Class->_get_config, "Config updated succesfully" ); my @cat = $CB->$Acc->list_categories; ok( scalar(@cat), "Category list returned" ); my @feat = $CB->$Acc->list_features; ok( scalar(@feat), "Features list returned" ); ### test if we get modules for each feature for my $feat (@feat) { my $meth = 'modules_for_feature'; my @mods = $CB->$Acc->$meth( $feat ); ok( $feat, "Testing feature '$feat'" ); ok( scalar( @mods ), " Module list returned" ); my $acc = 'is_installed_version_sufficient'; for my $mod (@mods) { isa_ok( $mod, "CPANPLUS::Module" ); isa_ok( $mod, $ModClass ); can_ok( $mod, $acc ); ok( $mod->$acc, " Module uptodate" ); } ### check if we can get a hashref { my $href = $CB->$Acc->$meth( $feat, 1 ); ok( $href, "Got result as hash" ); isa_ok( $href, 'HASH' ); is_deeply( $href, $Prereq, " With the proper entries" ); } } ### see if we can get a list of modules to be updated { my $cat = 'core'; my $meth = 'list_modules_to_update'; ### XXX just test the mechanics, make sure is_uptodate ### returns false ### declare twice because warnings are hateful ### declare in a block to quelch 'sub redefined' warnings. { local *CPANPLUS::Selfupdate::Module::is_uptodate = sub { return }; } local *CPANPLUS::Selfupdate::Module::is_uptodate = sub { return }; my %list = $CB->$Acc->$meth( update => $cat, latest => 1 ); cmp_ok( scalar(keys(%list)), '==', 1, "Got modules for '$cat' from '$meth'" ); my $aref = $list{$cat}; ok( $aref, " Got module list" ); cmp_ok( scalar(@$aref), '==', 1, " With right amount of modules" ); isa_ok( $aref->[0], $ModClass ); is( $aref->[0]->name, $Dep, " With the right name ($Dep)" ); } ### find enabled features { my $meth = 'list_enabled_features'; can_ok( $Class, $meth ); my @list = $CB->$Acc->$meth; ok( scalar(@list), "Retrieved enabled features" ); is_deeply( [$Feat], \@list, " Proper features found" ); } ### find dependencies/core modules for my $meth ( qw[list_core_dependencies list_core_modules] ) { can_ok( $Class, $meth ); my @list = $CB->$Acc->$meth; ok( scalar(@list), "Retrieved modules" ); is( scalar(@list), 1, " 1 Found" ); isa_ok( $list[0], $ModClass ); is( $list[0]->name, $Dep, " Correct module found" ); ### check if we can get a hashref { my $href = $CB->$Acc->$meth( 1 ); ok( $href, "Got result as hash" ); isa_ok( $href, 'HASH' ); is_deeply( $href, $Prereq, " With the proper entries" ); } } ### now selfupdate ourselves { ### XXX just test the mechanics, make sure install returns true ### declare twice because warnings are hateful ### declare in a block to quelch 'sub redefined' warnings. { local *CPANPLUS::Selfupdate::Module::install = sub { 1 }; } local *CPANPLUS::Selfupdate::Module::install = sub { 1 }; my $meth = 'selfupdate'; can_ok( $Class, $meth ); ok( $CB->$Acc->$meth( update => 'all'), " Selfupdate successful" ); } }