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 | use Test::More 'no_plan'; |
9 | use File::Basename 'dirname'; |
10 | |
11 | use Data::Dumper; |
12 | use CPANPLUS::Error; |
13 | use CPANPLUS::Internals::Constants; |
14 | |
15 | my $conf = gimme_conf(); |
16 | |
17 | ### purposely avert messages and errors to a file? ### |
18 | my $Trap_Output = @ARGV ? 0 : 1; |
19 | |
20 | my $Class = 'CPANPLUS::Backend'; |
21 | ### D::C has troubles with the 'use_ok' -- it finds the wrong paths. |
22 | ### for now, do a 'use' instead |
23 | #use_ok( $Class ) or diag "$Class not found"; |
24 | use CPANPLUS::Backend; |
25 | |
26 | my $cb = $Class->new( $conf ); |
27 | isa_ok( $cb, $Class ); |
28 | |
29 | my $mt = $cb->module_tree; |
30 | my $at = $cb->author_tree; |
31 | ok( scalar keys %$mt, "Module tree has entries" ); |
32 | ok( scalar keys %$at, "Author tree has entries" ); |
33 | |
34 | ### module_tree tests ### |
35 | my $Name = TEST_CONF_MODULE; |
36 | my $mod = $cb->module_tree($Name); |
37 | |
38 | ### XXX SOURCEFILES FIX |
39 | { my @mods = $cb->module_tree($Name,$Name); |
40 | my $none = $cb->module_tree( TEST_CONF_INVALID_MODULE ); |
41 | |
42 | ok( IS_MODOBJ->(mod => $mod), "Module object found" ); |
43 | is( scalar(@mods), 2, " Module list found" ); |
44 | ok( IS_MODOBJ->(mod => $mods[0]), " ISA module object" ); |
45 | ok( !IS_MODOBJ->(mod => $none), " Bogus module detected"); |
46 | } |
47 | |
48 | ### author_tree tests ### |
49 | { my @auths = $cb->author_tree( $mod->author->cpanid, |
50 | $mod->author->cpanid ); |
51 | my $none = $cb->author_tree( 'fnurk' ); |
52 | |
53 | ok( IS_AUTHOBJ->(auth => $mod->author), "Author object found" ); |
54 | is( scalar(@auths), 2, " Author list found" ); |
55 | ok( IS_AUTHOBJ->( author => $auths[0] )," ISA author object" ); |
56 | is( $mod->author, $auths[0], " Objects are identical" ); |
57 | ok( !IS_AUTHOBJ->( author => $none ), " Bogus author detected" ); |
58 | } |
59 | |
60 | my $conf_obj = $cb->configure_object; |
61 | ok( IS_CONFOBJ->(conf => $conf_obj), "Configure object found" ); |
62 | |
63 | |
64 | ### parse_module tests ### |
65 | { my @map = ( # author package version |
66 | $Name => [ $mod->author->cpanid, $mod->package_name, $mod->version ], |
67 | $mod => [ $mod->author->cpanid, $mod->package_name, $mod->version ], |
68 | 'Foo-Bar-EU-NOXS' |
69 | => [ $mod->author->cpanid, $mod->package_name, $mod->version ], |
70 | 'Foo-Bar-EU-NOXS-0.01' |
71 | => [ $mod->author->cpanid, $mod->package_name, '0.01' ], |
72 | 'EUNOXS/Foo-Bar-EU-NOXS' |
73 | => [ 'EUNOXS', $mod->package_name, $mod->version ], |
74 | 'EUNOXS/Foo-Bar-EU-NOXS-0.01' |
75 | => [ 'EUNOXS', $mod->package_name, '0.01' ], |
76 | 'Foo-Bar-EU-NOXS-0.09' |
77 | => [ $mod->author->cpanid, $mod->package_name, '0.09' ], |
78 | 'MBXS/Foo-Bar-EU-NOXS-0.01' |
79 | => [ 'MBXS', $mod->package_name, '0.01' ], |
80 | 'EUNOXS/Foo-Bar-EU-NOXS-0.09' |
81 | => [ 'EUNOXS', $mod->package_name, '0.09' ], |
82 | 'EUNOXS/Foo-Bar-EU-NOXS-0.09.zip' |
83 | => [ 'EUNOXS', $mod->package_name, '0.09' ], |
84 | 'FROO/Flub-Flob-1.1.zip' |
85 | => [ 'FROO', 'Flub-Flob', '1.1' ], |
86 | 'G/GO/GOYALI/SMS_API_3_01.tar.gz' |
87 | => [ 'GOYALI', 'SMS_API', '3_01' ], |
88 | 'E/EY/EYCK/Net/Lite/Net-Lite-FTP-0.091' |
89 | => [ 'EYCK', 'Net-Lite-FTP', '0.091' ], |
90 | 'EYCK/Net/Lite/Net-Lite-FTP-0.091' |
91 | => [ 'EYCK', 'Net-Lite-FTP', '0.091' ], |
92 | 'M/MA/MAXDB/DBD-MaxDB-7.5.00.24a' |
93 | => [ 'MAXDB', 'DBD-MaxDB', '7.5.00.24a' ], |
94 | 'EUNOXS/perl5.005_03.tar.gz' |
95 | => [ 'EUNOXS', 'perl', '5.005_03' ], |
96 | 'FROO/Flub-Flob-v1.1.0.tbz' |
97 | => [ 'FROO', 'Flub-Flob', 'v1.1.0' ], |
98 | 'FROO/Flub-Flob-1.1_2.tbz' |
99 | => [ 'FROO', 'Flub-Flob', '1.1_2' ], |
100 | 'LDS/CGI.pm-3.27.tar.gz' |
101 | => [ 'LDS', 'CGI', '3.27' ], |
102 | 'FROO/Text-Tabs+Wrap-2006.1117.tar.gz' |
103 | => [ 'FROO', 'Text-Tabs+Wrap', '2006.1117' ], |
104 | 'JETTERO/Crypt-PBC-0.7.20.0-0.4.9', |
105 | => [ 'JETTERO', 'Crypt-PBC', '0.7.20.0-0.4.9' ], |
106 | |
107 | ); |
108 | |
109 | while ( my($guess, $attr) = splice @map, 0, 2 ) { |
110 | my( $author, $pkg, $version ) = @$attr; |
111 | |
112 | ok( $guess, "Attempting to parse $guess" ); |
113 | |
114 | my $obj = $cb->parse_module( module => $guess ); |
115 | |
116 | ok( $obj, " Result returned" ); |
117 | ok( IS_MODOBJ->( mod => $obj ), |
118 | " parse_module success by '$guess'" ); |
119 | |
120 | is( $obj->version, $version, |
121 | " Proper version found: $version" ); |
122 | is( $obj->package_version, $version, |
123 | " Found in package_version as well" ); |
124 | is( $obj->package_name, $pkg, |
125 | " Proper package found: $pkg" ); |
126 | unlike( $obj->package_name, qr/\d/, |
127 | " No digits in package name" ); |
128 | like( $obj->author->cpanid, "/$author/i", |
129 | " Proper author found: $author"); |
130 | like( $obj->path, "/$author/i", |
131 | " Proper path found: " . $obj->path ); |
132 | } |
133 | |
134 | |
135 | ### test for things that look like real modules, but aren't ### |
136 | { local $CPANPLUS::Error::MSG_FH = output_handle() if $Trap_Output; |
137 | local $CPANPLUS::Error::ERROR_FH = output_handle() if $Trap_Output; |
138 | |
139 | my @map = ( |
140 | [ $Name . $$ => [ |
141 | [qr/does not contain an author/,"Missing author part detected"], |
142 | [qr/Cannot find .+? in the module tree/,"Unable to find module"] |
143 | ] ], |
144 | [ {}, => [ |
145 | [ qr/module string from reference/,"Unable to parse ref"] |
146 | ] ], |
147 | ); |
148 | |
149 | for my $entry ( @map ) { |
150 | my($mod,$aref) = @$entry; |
151 | |
152 | my $none = $cb->parse_module( module => $mod ); |
153 | ok( !IS_MODOBJ->(mod => $none), |
154 | "Non-existant module detected" ); |
155 | ok( !IS_FAKE_MODOBJ->(mod => $none), |
156 | "Non-existant fake module detected" ); |
157 | |
158 | my $str = CPANPLUS::Error->stack_as_string; |
159 | for my $pair (@$aref) { |
160 | my($re,$diag) = @$pair; |
161 | like( $str, $re," $diag" ); |
162 | } |
163 | } |
164 | } |
165 | |
166 | ### test parsing of arbitrary URI |
167 | for my $guess ( qw[ http://foo/bar.gz |
168 | http://a/b/c/d/e/f/g/h/i/j |
169 | flub://floo ] |
170 | ) { |
171 | my $obj = $cb->parse_module( module => $guess ); |
172 | ok( IS_FAKE_MODOBJ->(mod => $obj), "parse_module success by '$guess'" ); |
173 | is( $obj->status->_fetch_from, $guess, |
174 | " Fetch from set ok" ); |
175 | } |
176 | } |
177 | |
178 | ### RV tests ### |
179 | { my $method = 'readme'; |
180 | my %args = ( modules => [$Name] ); |
181 | |
182 | my $rv = $cb->$method( %args ); |
183 | ok( IS_RVOBJ->( $rv ), "Got an RV object" ); |
184 | ok( $rv->ok, " Overall OK" ); |
185 | cmp_ok( $rv, '==', 1, " Overload OK" ); |
186 | is( $rv->function, $method, " Function stored OK" ); |
187 | is_deeply( $rv->args, \%args, " Arguments stored OK" ); |
188 | is( $rv->rv->{$Name}, $mod->readme, " RV as expected" ); |
189 | } |
190 | |
191 | ### reload_indices tests ### |
192 | { |
193 | my $file = File::Spec->catfile( $conf->get_conf('base'), |
194 | $conf->_get_source('mod'), |
195 | ); |
196 | |
197 | ok( $cb->reload_indices( update_source => 0 ), "Rebuilding trees" ); |
198 | my $age = -M $file; |
199 | |
200 | ### make sure we are 'newer' on faster machines with a sleep.. |
201 | ### apparently Win32's FAT isn't granual enough on intervals |
202 | ### < 2 seconds, so it may give the same answer before and after |
203 | ### the sleep, causing the test to fail. so sleep atleast 2 seconds. |
204 | sleep 2; |
205 | ok( $cb->reload_indices( update_source => 1 ), |
206 | "Rebuilding and refetching trees" ); |
207 | cmp_ok( $age, '>', -M $file, " Source file '$file' updated" ); |
208 | } |
209 | |
210 | ### flush tests ### |
211 | { |
212 | for my $cache( qw[methods hosts modules lib all] ) { |
213 | ok( $cb->flush($cache), "Cache $cache flushed ok" ); |
214 | } |
215 | } |
216 | |
217 | ### installed tests ### |
218 | { |
219 | ok( scalar $cb->installed, "Found list of installed modules" ); |
220 | } |
221 | |
222 | ### autobudle tests ### |
223 | { |
224 | my $where = $cb->autobundle; |
225 | ok( $where, "Autobundle written" ); |
226 | ok( -s $where, " File has size" ); |
227 | } |
228 | |
229 | ### local_mirror tests ### |
230 | { ### turn off md5 checks for the 'fake' packages we have |
231 | my $old_md5 = $conf->get_conf('md5'); |
232 | $conf->set_conf( md5 => 0 ); |
233 | |
234 | ### otherwise 'status->fetch' might be undef! ### |
235 | my $rv = $cb->local_mirror( path => 'dummy-localmirror' ); |
236 | ok( $rv, "Local mirror created" ); |
237 | |
238 | for my $mod ( values %{ $cb->module_tree } ) { |
239 | my $name = $mod->module; |
240 | |
241 | my $cksum = File::Spec->catfile( |
242 | dirname($mod->status->fetch), |
243 | CHECKSUMS ); |
244 | ok( -e $mod->status->fetch, " Module '$name' fetched" ); |
245 | ok( -s _, " Module '$name' has size" ); |
246 | ok( -e $cksum, " Checksum fetched for '$name'" ); |
247 | ok( -s _, " Checksum for '$name' has size" ); |
248 | } |
249 | |
250 | $conf->set_conf( md5 => $old_md5 ); |
251 | } |
252 | |
253 | ### check ENV variable |
254 | { ### process id |
255 | { my $name = 'PERL5_CPANPLUS_IS_RUNNING'; |
256 | ok( $ENV{$name}, "Env var '$name' set" ); |
257 | is( $ENV{$name}, $$, " Set to current process id" ); |
258 | } |
259 | |
260 | ### Version |
261 | { my $name = 'PERL5_CPANPLUS_IS_VERSION'; |
262 | ok( $ENV{$name}, "Env var '$name' set" ); |
263 | |
264 | ### version.pm formats ->VERSION output... *sigh* |
265 | is( $ENV{$name}, $Class->VERSION, |
266 | " Set to current process version" ); |
267 | } |
268 | |
269 | } |
270 | |
271 | __END__ |
272 | |
273 | # Local variables: |
274 | # c-indentation-style: bsd |
275 | # c-basic-offset: 4 |
276 | # indent-tabs-mode: nil |
277 | # End: |
278 | # vim: expandtab shiftwidth=4: |
279 | |