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::Configure; |
10 | use CPANPLUS::Backend; |
11 | use CPANPLUS::Module::Fake; |
12 | use CPANPLUS::Module::Author::Fake; |
13 | use CPANPLUS::Internals::Constants; |
14 | |
15 | use Test::More 'no_plan'; |
16 | use Data::Dumper; |
4443dd53 |
17 | use File::Spec; |
6aaee015 |
18 | use File::Path (); |
19 | |
6aaee015 |
20 | my $Conf = gimme_conf(); |
21 | my $CB = CPANPLUS::Backend->new( $Conf ); |
22 | |
23 | ### start with fresh sources ### |
24 | ok( $CB->reload_indices( update_source => 0 ), "Rebuilding trees" ); |
25 | |
5879cbe1 |
26 | my $AuthName = TEST_CONF_AUTHOR; |
6aaee015 |
27 | my $Auth = $CB->author_tree( $AuthName ); |
28 | my $ModName = TEST_CONF_MODULE; |
29 | my $Mod = $CB->module_tree( $ModName ); |
30 | my $CoreName = TEST_CONF_PREREQ; |
31 | my $CoreMod = $CB->module_tree( $CoreName ); |
32 | |
33 | isa_ok( $Auth, 'CPANPLUS::Module::Author' ); |
34 | isa_ok( $Mod, 'CPANPLUS::Module' ); |
35 | isa_ok( $CoreMod, 'CPANPLUS::Module' ); |
36 | |
37 | ### author accessors ### |
38 | is( $Auth->author, 'ExtUtils::MakeMaker No XS Code', |
39 | "Author name: " . $Auth->author ); |
40 | is( $Auth->cpanid, $AuthName, "Author CPANID: " . $Auth->cpanid ); |
41 | is( $Auth->email, DEFAULT_EMAIL,"Author email: " . $Auth->email ); |
42 | isa_ok( $Auth->parent, 'CPANPLUS::Backend' ); |
43 | |
44 | ### module accessors ### |
45 | { my %map = ( |
46 | ### method ### result |
47 | module => $ModName, |
48 | name => $ModName, |
49 | comment => undef, |
50 | package => 'Foo-Bar-0.01.tar.gz', |
5bc5f6dc |
51 | path => 'authors/id/EUNOXS', |
6aaee015 |
52 | version => '0.01', |
53 | dslip => 'cdpO ', |
54 | description => 'CPANPLUS Test Package', |
55 | mtime => '', |
56 | author => $Auth, |
57 | ); |
58 | |
59 | my @acc = $Mod->accessors; |
60 | ok( scalar(@acc), "Retrieved module accessors" ); |
61 | |
62 | ### remove private accessors |
63 | is_deeply( [ sort keys %map ], [ sort grep { $_ !~ /^_/ } @acc ], |
64 | " About to test all accessors" ); |
65 | |
66 | ### check all the accessors |
67 | while( my($meth,$res) = each %map ) { |
68 | is( $Mod->$meth, $res, " Mod->$meth: " . ($res || '<empty>') ); |
69 | } |
70 | |
71 | ### check accessor objects ### |
72 | isa_ok( $Mod->parent, 'CPANPLUS::Backend' ); |
73 | isa_ok( $Mod->author, 'CPANPLUS::Module::Author' ); |
74 | is( $Mod->author->author, $Auth->author, |
75 | "Module eq Author" ); |
76 | } |
77 | |
78 | ### convenience methods ### |
79 | { ok( 1, "Convenience functions" ); |
5bc5f6dc |
80 | is( $Mod->package_name, 'Foo-Bar', " Package name"); |
6aaee015 |
81 | is( $Mod->package_version, '0.01', " Package version"); |
82 | is( $Mod->package_extension, 'tar.gz', " Package extension"); |
83 | ok( !$Mod->package_is_perl_core, " Package not core"); |
84 | ok( !$Mod->module_is_supplied_with_perl_core, " Module not core" ); |
85 | ok( !$Mod->is_bundle, " Package not bundle"); |
86 | } |
87 | |
88 | ### clone & status tests |
89 | { my $clone = $Mod->clone; |
90 | ok( $clone, "Module cloned" ); |
91 | isa_ok( $clone, 'CPANPLUS::Module' ); |
92 | |
93 | for my $acc ( $Mod->accessors ) { |
94 | is( $clone->$acc, $Mod->$acc, |
95 | " Clone->$acc matches Mod->$acc " ); |
96 | } |
97 | |
98 | ### XXX whitebox test |
99 | ok( !$clone->_status, "Status object empty on start" ); |
100 | |
101 | my $status = $clone->status; |
102 | ok( $status, " Status object defined after query" ); |
103 | is( $status, $clone->_status, |
104 | " Object stored as expected" ); |
105 | isa_ok( $status, 'Object::Accessor' ); |
106 | } |
107 | |
108 | { ### extract + error test ### |
109 | ok( !$Mod->extract(), "Cannot extract unfetched file" ); |
110 | like( CPANPLUS::Error->stack_as_string, qr/You have not fetched/, |
111 | " Error properly logged" ); |
112 | } |
113 | |
114 | { ### fetch tests ### |
115 | ### enable signature checks for checksums ### |
116 | my $old = $Conf->get_conf('signature'); |
117 | $Conf->set_conf(signature => 1); |
118 | |
119 | my $where = $Mod->fetch( force => 1 ); |
120 | ok( $where, "Module fetched" ); |
121 | ok( -f $where, " Module is a file" ); |
122 | ok( -s $where, " Module has size" ); |
123 | |
124 | $Conf->set_conf( signature => $old ); |
125 | } |
126 | |
127 | { ### extract tests ### |
128 | my $dir = $Mod->extract( force => 1 ); |
129 | ok( $dir, "Module extracted" ); |
130 | ok( -d $dir, " Dir exsits" ); |
131 | } |
132 | |
133 | |
134 | { ### readme tests ### |
135 | my $readme = $Mod->readme; |
136 | ok( length $readme, "Readme found" ); |
137 | is( $readme, $Mod->status->readme, |
138 | " Readme stored in module object" ); |
139 | } |
140 | |
141 | { ### checksums tests ### |
142 | SKIP: { |
143 | skip(q[You chose not to enable checksum verification], 5) |
144 | unless $Conf->get_conf('md5'); |
145 | |
4443dd53 |
146 | my $cksum_file = $Mod->checksums; |
6aaee015 |
147 | ok( $cksum_file, "Checksum file found" ); |
148 | is( $cksum_file, $Mod->status->checksums, |
149 | " File stored in module object" ); |
150 | ok( -e $cksum_file, " File exists" ); |
151 | ok( -s $cksum_file, " File has size" ); |
152 | |
153 | ### XXX test checksum_value if there's digest::md5 + config wants it |
154 | ok( $Mod->status->checksum_ok, |
155 | " Checksum is ok" ); |
4443dd53 |
156 | |
157 | ### check ttl code for checksums; fetching it now means the cache |
158 | ### should kick in |
159 | { CPANPLUS::Error->flush; |
160 | ok( $Mod->checksums, |
161 | " Checksums re-fetched" ); |
162 | like( CPANPLUS::Error->stack_as_string, qr/Using cached file/, |
163 | " Cached file used" ); |
164 | } |
6aaee015 |
165 | } |
166 | } |
167 | |
168 | |
169 | { ### installer type tests ### |
170 | my $installer = $Mod->get_installer_type; |
171 | ok( $installer, "Installer found" ); |
172 | is( $installer, INSTALLER_MM, |
173 | " Proper installer found" ); |
174 | } |
175 | |
176 | { ### check signature tests ### |
177 | SKIP: { |
178 | skip(q[You chose not to enable signature checks], 1) |
179 | unless $Conf->get_conf('signature'); |
180 | |
181 | ok( $Mod->check_signature, |
182 | "Signature check OK" ); |
183 | } |
184 | } |
185 | |
5879cbe1 |
186 | ### dslip & related |
187 | { my $dslip = $Mod->dslip; |
188 | ok( $dslip, "Got dslip information from $ModName ($dslip)" ); |
4443dd53 |
189 | |
5879cbe1 |
190 | ### now find it for a submodule |
191 | { my $submod = $CB->module_tree( TEST_CONF_MODULE_SUB ); |
192 | ok( $submod, " Found submodule " . $submod->name ); |
193 | ok( $submod->dslip, " Got dslip info (".$submod->dslip.")" ); |
194 | is( $submod->dslip, $dslip, |
195 | " It's identical to $ModName" ); |
196 | } |
197 | } |
198 | |
6aaee015 |
199 | { ### details() test ### |
200 | my $href = { |
201 | 'Support Level' => 'Developer', |
202 | 'Package' => $Mod->package, |
203 | 'Description' => $Mod->description, |
204 | 'Development Stage' => |
205 | 'under construction but pre-alpha (not yet released)', |
206 | 'Author' => sprintf("%s (%s)", $Auth->author, $Auth->email), |
207 | 'Version on CPAN' => $Mod->version, |
208 | 'Language Used' => |
209 | 'Perl-only, no compiler needed, should be platform independent', |
210 | 'Interface Style' => |
211 | 'Object oriented using blessed references and/or inheritance', |
212 | 'Public License' => 'Unknown', |
213 | ### XXX we can't really know what you have installed ### |
214 | #'Version Installed' => '0.06', |
215 | }; |
216 | |
217 | my $res = $Mod->details; |
218 | |
219 | ### delete they key of which we don't know the value ### |
220 | delete $res->{'Version Installed'}; |
221 | |
222 | is_deeply( $res, $href, "Details OK" ); |
223 | } |
224 | |
225 | { ### contians() test ### |
226 | ### XXX ->contains works based on package name. in our sourcefiles |
227 | ### we use 4x the same package name for different modules. So use |
228 | ### the only unique package name here, which is the one for the core mod |
229 | my @list = $CoreMod->contains; |
230 | |
231 | ok( scalar(@list), "Found modules contained in this one" ); |
232 | is_deeply( \@list, [$CoreMod], |
233 | " Found all modules expected" ); |
234 | } |
235 | |
236 | { ### testing distributions() ### |
237 | my @mdists = $Mod->distributions; |
238 | is( scalar @mdists, 1, "Distributions found via module" ); |
239 | |
240 | my @adists = $Auth->distributions; |
241 | is( scalar @adists, 3, "Distributions found via author" ); |
242 | } |
243 | |
244 | { ### test status->flush ### |
245 | ok( $Mod->status->mk_flush, |
246 | "Status flushed" ); |
247 | ok(!$Mod->status->fetch," Fetch status empty" ); |
248 | ok(!$Mod->status->extract, |
249 | " Extract status empty" ); |
250 | ok(!$Mod->status->checksums, |
251 | " Checksums status empty" ); |
252 | ok(!$Mod->status->readme, |
253 | " Readme status empty" ); |
254 | } |
255 | |
256 | { ### testing bundles ### |
257 | my $bundle = $CB->module_tree('Bundle::Foo::Bar'); |
258 | isa_ok( $bundle, 'CPANPLUS::Module' ); |
259 | |
260 | ok( $bundle->is_bundle, " It's a Bundle:: module" ); |
261 | ok( $bundle->fetch, " Fetched the bundle" ); |
262 | ok( $bundle->extract, " Extracted the bundle" ); |
263 | |
264 | my @objs = $bundle->bundle_modules; |
265 | is( scalar(@objs), 5, " Found all prerequisites" ); |
266 | |
267 | for( @objs ) { |
268 | isa_ok( $_, 'CPANPLUS::Module', |
269 | " Prereq " . $_->module ); |
270 | ok( defined $bundle->status->prereqs->{$_->module}, |
271 | " Prereq was registered" ); |
272 | } |
273 | } |
274 | |
4443dd53 |
275 | { ### testing autobundles |
276 | my $file = File::Spec->catfile( |
277 | dummy_cpan_dir(), |
278 | $Conf->_get_build('autobundle'), |
279 | 'Snapshot.pm' |
280 | ); |
281 | my $uri = $CB->_host_to_uri( scheme => 'file', path => $file ); |
282 | my $bundle = $CB->parse_module( module => $uri ); |
283 | |
284 | ok( -e $file, "Creating bundle from '$file'" ); |
285 | ok( $bundle, " Object created" ); |
286 | isa_ok( $bundle, 'CPANPLUS::Module', |
287 | " Object" ); |
288 | ok( $bundle->is_bundle, " Recognized as bundle" ); |
289 | ok( $bundle->is_autobundle, " Recognized as autobundle" ); |
290 | |
291 | my $type = $bundle->get_installer_type; |
292 | ok( $type, " Found installer type" ); |
293 | is( $type, INSTALLER_AUTOBUNDLE, |
294 | " Installer type is $type" ); |
295 | |
296 | my $where = $bundle->fetch; |
297 | ok( $where, " Autobundle fetched" ); |
298 | ok( -e $where, " File exists" ); |
299 | |
300 | |
301 | my @list = $bundle->bundle_modules; |
302 | ok( scalar(@list), " Prereqs found" ); |
303 | is( scalar(@list), 1, " Right number of prereqs" ); |
304 | isa_ok( $list[0], 'CPANPLUS::Module', |
305 | " Object" ); |
306 | |
307 | ### skiptests to make sure we don't get any test header mismatches |
308 | my $rv = $bundle->create( prereq_target => 'create', skiptest => 1 ); |
309 | ok( $rv, " Tested prereqs" ); |
310 | |
311 | } |
312 | |
6aaee015 |
313 | ### test module from perl core ### |
314 | { isa_ok( $CoreMod, 'CPANPLUS::Module', |
315 | "Core module " . $CoreName ); |
316 | ok( $CoreMod->package_is_perl_core, |
317 | " Package found in perl core" ); |
318 | |
319 | ### check if it's core with 5.6.1 |
320 | { local $] = '5.006001'; |
321 | ok( $CoreMod->module_is_supplied_with_perl_core, |
322 | " Module also found in perl core"); |
323 | } |
324 | |
325 | ok( !$CoreMod->install, " Package not installed" ); |
326 | like( CPANPLUS::Error->stack_as_string, qr/core Perl/, |
327 | " Error properly logged" ); |
328 | } |
329 | |
330 | ### test third-party modules |
331 | SKIP: { |
332 | skip "Module::ThirdParty not installed", 10 |
333 | unless eval { require Module::ThirdParty; 1 }; |
334 | |
335 | ok( !$Mod->is_third_party, |
336 | "Not a 3rd party module: ". $Mod->name ); |
337 | |
338 | my $fake = $CB->parse_module( module => 'LOCAL/SVN-Core-1.0' ); |
339 | ok( $fake, "Created module object for ". $fake->name ); |
340 | ok( $fake->is_third_party, |
341 | " It is a 3rd party module" ); |
342 | |
343 | my $info = $fake->third_party_information; |
344 | ok( $info, "Got 3rd party package information" ); |
345 | isa_ok( $info, 'HASH' ); |
346 | |
347 | for my $item ( qw[name url author author_url] ) { |
348 | ok( length($info->{$item}), |
349 | " $item field is filled" ); |
350 | } |
351 | } |
352 | |
353 | ### testing EU::Installed methods in Dist::MM tests ### |
354 | |
355 | # Local variables: |
356 | # c-indentation-style: bsd |
357 | # c-basic-offset: 4 |
358 | # indent-tabs-mode: nil |
359 | # End: |
360 | # vim: expandtab shiftwidth=4: |