1 ### make sure we can find our conf.pl file
4 require "$FindBin::Bin/inc/conf.pl";
10 use CPANPLUS::Internals::Constants;
11 use Test::More 'no_plan';
14 my $conf = gimme_conf();
15 $conf->set_conf( verbose => 0 );
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 };
27 { ok( $CB, "New backend object created" );
30 ok( $Conf, "Got configuration hash" );
33 ok( $su, "Selfupdate object retrieved" );
34 isa_ok( $su, $Class );
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';
43 my $cobj = $CB->configure_object;
44 my $cur = $cobj->get_conf( $type );
46 for my $shell ( SHELL_DEFAULT, SHELL_CLASSIC ) {
47 ok( $cobj->set_conf( $type => $shell ),
48 "Testing dependencies for '$shell'" );
50 my $rv = $CB->$Acc->$meth( $type => 1);
51 ok( !$rv, " No dependencies for '$shell' -- bundled" );
54 for my $shell ( 'CPANPLUS::Test::Shell' ) {
55 ok( $cobj->set_conf( $type => $shell ),
56 "Testing dependencies for '$shell'" );
58 my $rv = $CB->$Acc->$meth( $type => 1 );
59 ok( $rv, " Got prereq hash" );
62 is_deeply( $rv, { $shell => '0.0' },
63 " With the proper entries" );
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 } ];
77 is_deeply( $Conf, $Class->_get_config,
78 "Config updated succesfully" );
80 my @cat = $CB->$Acc->list_categories;
81 ok( scalar(@cat), "Category list returned" );
83 my @feat = $CB->$Acc->list_features;
84 ok( scalar(@feat), "Features list returned" );
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 );
91 ok( $feat, "Testing feature '$feat'" );
92 ok( scalar( @mods ), " Module list returned" );
94 my $acc = 'is_installed_version_sufficient';
96 isa_ok( $mod, "CPANPLUS::Module" );
97 isa_ok( $mod, $ModClass );
99 ok( $mod->$acc, " Module uptodate" );
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" );
112 ### see if we can get a list of modules to be updated
114 my $meth = 'list_modules_to_update';
116 ### XXX just test the mechanics, make sure is_uptodate
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 };
123 my %list = $CB->$Acc->$meth( update => $cat, latest => 1 );
125 cmp_ok( scalar(keys(%list)), '==', 1,
126 "Got modules for '$cat' from '$meth'" );
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)" );
137 ### find enabled features
138 { my $meth = 'list_enabled_features';
139 can_ok( $Class, $meth );
141 my @list = $CB->$Acc->$meth;
142 ok( scalar(@list), "Retrieved enabled features" );
143 is_deeply( [$Feat], \@list,
144 " Proper features found" );
147 ### find dependencies/core modules
148 for my $meth ( qw[list_core_dependencies list_core_modules] ) {
149 can_ok( $Class, $meth );
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" );
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" );
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 };
175 my $meth = 'selfupdate';
176 can_ok( $Class, $meth );
177 ok( $CB->$Acc->$meth( update => 'all'),
178 " Selfupdate successful" );