lib/CPANPLUS/t/30_CPANPLUS-Internals-Selfupdate.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 use Test::More 'no_plan';
  12 use Data::Dumper;
  13
  14 my $conf = gimme_conf();
  15 $conf->set_conf( verbose => 0 );
  16
  17 my $Class       = 'CPANPLUS::Selfupdate';
  18 my $ModClass    = "CPANPLUS::Selfupdate::Module";
  19 my $CB          = CPANPLUS::Backend->new( $conf );
  20 my $Acc         = 'selfupdate_object';
  21 my $Conf        = $Class->_get_config;
  22 my $Dep         = TEST_CONF_PREREQ;   # has to be in our package file && core!
  23 my $Feat        = 'some_feature';
  24 my $Prereq      = { $Dep => 0 };
  25
  26 ### test the object
  27 {   ok( $CB,                    "New backend object created" );
  28     can_ok( $CB,                $Acc );
  29
  30     ok( $Conf,                  "Got configuration hash" );
  31
  32     my $su = $CB->$Acc;
  33     ok( $su,                    "Selfupdate object retrieved" );
  34     isa_ok( $su,                $Class );
  35 }
  36
  37
  38 ### check specifically if our bundled shells dont trigger a
  39 ### dependency (see #26077).
  40 ### do this _before_ changing the built in conf!
  41 {   my $meth = 'modules_for_feature';
  42     my $type = 'shell';
  43     my $cobj = $CB->configure_object;
  44     my $cur  = $cobj->get_conf( $type );
  45
  46     for my $shell ( SHELL_DEFAULT, SHELL_CLASSIC ) {
  47         ok( $cobj->set_conf( $type => $shell ),
  48                             "Testing dependencies for '$shell'" );
  49
  50         my $rv = $CB->$Acc->$meth( $type => 1);
  51         ok( !$rv,           "   No dependencies for '$shell' -- bundled" );
  52     }
  53
  54     for my $shell ( 'CPANPLUS::Test::Shell' ) {
  55         ok( $cobj->set_conf( $type => $shell ),
  56                             "Testing dependencies for '$shell'" );
  57
  58         my $rv = $CB->$Acc->$meth( $type => 1 );
  59         ok( $rv,            "   Got prereq hash" );
  60         isa_ok( $rv,        'HASH',
  61                             "   Return value" );
  62         is_deeply( $rv, { $shell => '0.0' },
  63                             "   With the proper entries" );
  64     }
  65 }
  66
  67 ### test the feature list
  68 {   ### start with defining our OWN type of config, as not all mentioned
  69     ### modules will be present in our bundled package files.
  70     ### XXX WHITEBOX TEST!!!!
  71     {   delete $Conf->{$_} for keys %$Conf;
  72         $Conf->{'dependencies'}         = $Prereq;
  73         $Conf->{'core'}                 = $Prereq;
  74         $Conf->{'features'}->{$Feat}    = [ $Prereq, sub { 1 } ];
  75     }
  76
  77     is_deeply( $Conf, $Class->_get_config,
  78                                 "Config updated succesfully" );
  79
  80     my @cat  = $CB->$Acc->list_categories;
  81     ok( scalar(@cat),           "Category list returned" );
  82
  83     my @feat = $CB->$Acc->list_features;
  84     ok( scalar(@feat),          "Features list returned" );
  85
  86     ### test if we get modules for each feature
  87     for my $feat (@feat) {
  88         my $meth = 'modules_for_feature';
  89         my @mods = $CB->$Acc->$meth( $feat );
  90
  91         ok( $feat,              "Testing feature '$feat'" );
  92         ok( scalar( @mods ),    "   Module list returned" );
  93
  94         my $acc = 'is_installed_version_sufficient';
  95         for my $mod (@mods) {
  96             isa_ok( $mod,       "CPANPLUS::Module" );
  97             isa_ok( $mod,       $ModClass );
  98             can_ok( $mod,       $acc );
  99             ok( $mod->$acc,    "   Module uptodate" );
 100         }
 101
 102         ### check if we can get a hashref
 103         {   my $href = $CB->$Acc->$meth( $feat, 1 );
 104             ok( $href,          "Got result as hash" );
 105             isa_ok( $href,      'HASH' );
 106             is_deeply( $href, $Prereq,
 107                                 "   With the proper entries" );
 108
 109         }
 110     }
 111
 112     ### see if we can get a list of modules to be updated
 113     {   my $cat  = 'core';
 114         my $meth = 'list_modules_to_update';
 115
 116         ### XXX just test the mechanics, make sure is_uptodate
 117         ### returns false
 118         ### declare twice because warnings are hateful
 119         ### declare in a block to quelch 'sub redefined' warnings.
 120         { local *CPANPLUS::Selfupdate::Module::is_uptodate = sub { return }; }
 121           local *CPANPLUS::Selfupdate::Module::is_uptodate = sub { return };
 122
 123         my %list = $CB->$Acc->$meth( update => $cat, latest => 1 );
 124
 125         cmp_ok( scalar(keys(%list)), '==', 1,
 126                                 "Got modules for '$cat' from '$meth'" );
 127
 128         my $aref = $list{$cat};
 129         ok( $aref,              "   Got module list" );
 130         cmp_ok( scalar(@$aref), '==', 1,
 131                                 "   With right amount of modules" );
 132         isa_ok( $aref->[0],     $ModClass );
 133         is( $aref->[0]->name, $Dep,
 134                                 "   With the right name ($Dep)" );
 135     }
 136
 137     ### find enabled features
 138     {   my $meth = 'list_enabled_features';
 139         can_ok( $Class,         $meth );
 140
 141         my @list = $CB->$Acc->$meth;
 142         ok( scalar(@list),      "Retrieved enabled features" );
 143         is_deeply( [$Feat], \@list,
 144                                 "   Proper features found" );
 145     }
 146
 147     ### find dependencies/core modules
 148     for my $meth ( qw[list_core_dependencies list_core_modules] ) {
 149         can_ok( $Class,         $meth );
 150
 151         my @list = $CB->$Acc->$meth;
 152         ok( scalar(@list),      "Retrieved modules" );
 153         is( scalar(@list), 1,   "   1 Found" );
 154         isa_ok( $list[0],       $ModClass );
 155         is( $list[0]->name, $Dep,
 156                                 "   Correct module found" );
 157
 158         ### check if we can get a hashref
 159         {   my $href = $CB->$Acc->$meth( 1 );
 160             ok( $href,          "Got result as hash" );
 161             isa_ok( $href,      'HASH' );
 162             is_deeply( $href, $Prereq,
 163                                 "   With the proper entries" );
 164         }
 165     }
 166
 167
 168     ### now selfupdate ourselves
 169     {   ### XXX just test the mechanics, make sure install returns true
 170         ### declare twice because warnings are hateful
 171         ### declare in a block to quelch 'sub redefined' warnings.
 172         { local *CPANPLUS::Selfupdate::Module::install = sub { 1 }; }
 173           local *CPANPLUS::Selfupdate::Module::install = sub { 1 };
 174
 175         my $meth = 'selfupdate';
 176         can_ok( $Class,         $meth );
 177         ok( $CB->$Acc->$meth( update => 'all'),
 178                                 "   Selfupdate successful" );
 179     }
 180 }
 181