Commit | Line | Data |
6aaee015 |
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; |
494f1016 |
10 | use CPANPLUS::Internals::Constants; |
6aaee015 |
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 | |
494f1016 |
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 | |
6aaee015 |
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 | |
622d31ac |
80 | my @cat = $CB->$Acc->list_categories; |
81 | ok( scalar(@cat), "Category list returned" ); |
82 | |
6aaee015 |
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 | |
622d31ac |
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'" ); |
6aaee015 |
127 | |
622d31ac |
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)" ); |
6aaee015 |
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 | } |
622d31ac |
166 | |
6aaee015 |
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 }; } |
494f1016 |
173 | local *CPANPLUS::Selfupdate::Module::install = sub { 1 }; |
6aaee015 |
174 | |
175 | my $meth = 'selfupdate'; |
176 | can_ok( $Class, $meth ); |
177 | ok( $CB->$Acc->$meth( update => 'all'), |
178 | " Selfupdate successful" ); |
179 | } |
180 | } |
181 | |