1# -*- mode: cperl; tab-width: 8; indent-tabs-mode: nil; basic-offset: 2 -*- 2# vim:ts=8:sw=2:et:sta:sts=2 3 4use strict; 5use warnings; 6use Test::More 0.82; 7use IO::File; 8use File::Spec; 9use File::Temp; 10use File::Basename; 11use Cwd (); 12use File::Path; 13use Data::Dumper; 14 15plan tests => 61; 16 17require_ok('Module::Metadata'); 18 19{ 20 # class method C<find_module_by_name> 21 my $module = Module::Metadata->find_module_by_name( 22 'Module::Metadata' ); 23 ok( -e $module, 'find_module_by_name() succeeds' ); 24} 25 26######################### 27 28BEGIN { 29 my $cwd = File::Spec->rel2abs(Cwd::cwd); 30 sub original_cwd { return $cwd } 31} 32 33# Set up a temp directory 34sub tmpdir { 35 my (@args) = @_; 36 my $dir = $ENV{PERL_CORE} ? original_cwd : File::Spec->tmpdir; 37 return File::Temp::tempdir('MMD-XXXXXXXX', CLEANUP => 0, DIR => $dir, @args); 38} 39 40my $tmp; 41BEGIN { $tmp = tmpdir; note "using temp dir $tmp"; } 42 43END { 44 die "tests failed; leaving temp dir $tmp behind" 45 if $ENV{AUTHOR_TESTING} and not Test::Builder->new->is_passing; 46 note "removing temp dir $tmp"; 47 chdir original_cwd; 48 File::Path::rmtree($tmp); 49} 50 51# generates a new distribution: 52# files => { relative filename => $content ... } 53# returns the name of the distribution (not including version), 54# and the absolute path name to the dist. 55{ 56 my $test_num = 0; 57 sub new_dist { 58 my %opts = @_; 59 60 my $distname = 'Simple' . $test_num++; 61 my $distdir = File::Spec->catdir($tmp, $distname); 62 note "using dist $distname in $distdir"; 63 64 File::Path::mkpath($distdir) or die "failed to create '$distdir'"; 65 66 foreach my $rel_filename (keys %{$opts{files}}) 67 { 68 my $abs_filename = File::Spec->catfile($distdir, $rel_filename); 69 my $dirname = File::Basename::dirname($abs_filename); 70 unless (-d $dirname) { 71 File::Path::mkpath($dirname) or die "Can't create '$dirname'"; 72 } 73 74 note "creating $abs_filename"; 75 my $fh = IO::File->new(">$abs_filename") or die "Can't write '$abs_filename'\n"; 76 print $fh $opts{files}{$rel_filename}; 77 close $fh; 78 } 79 80 chdir $distdir; 81 return ($distname, $distdir); 82 } 83} 84 85{ 86 # fail on invalid module name 87 my $pm_info = Module::Metadata->new_from_module( 88 'Foo::Bar', inc => [] ); 89 ok( !defined( $pm_info ), 'fail if can\'t find module by module name' ); 90} 91 92{ 93 # fail on invalid filename 94 my $file = File::Spec->catfile( 'Foo', 'Bar.pm' ); 95 my $pm_info = Module::Metadata->new_from_file( $file, inc => [] ); 96 ok( !defined( $pm_info ), 'fail if can\'t find module by file name' ); 97} 98 99{ 100 my $file = File::Spec->catfile('lib', 'Simple.pm'); 101 my ($dist_name, $dist_dir) = new_dist(files => { $file => "package Simple;\n" }); 102 103 # construct from module filename 104 my $pm_info = Module::Metadata->new_from_file( $file ); 105 ok( defined( $pm_info ), 'new_from_file() succeeds' ); 106 107 # construct from filehandle 108 my $handle = IO::File->new($file); 109 $pm_info = Module::Metadata->new_from_handle( $handle, $file ); 110 ok( defined( $pm_info ), 'new_from_handle() succeeds' ); 111 $pm_info = Module::Metadata->new_from_handle( $handle ); 112 is( $pm_info, undef, "new_from_handle() without filename returns undef" ); 113 close($handle); 114} 115 116{ 117 # construct from module name, using custom include path 118 my $pm_info = Module::Metadata->new_from_module( 119 'Simple', inc => [ 'lib', @INC ] ); 120 ok( defined( $pm_info ), 'new_from_module() succeeds' ); 121} 122 123 124{ 125 # Find each package only once 126 my $file = File::Spec->catfile('lib', 'Simple.pm'); 127 my ($dist_name, $dist_dir) = new_dist(files => { $file => <<'---' } ); 128package Simple; 129$VERSION = '1.23'; 130package Error::Simple; 131$VERSION = '2.34'; 132package Simple; 133--- 134 135 my $pm_info = Module::Metadata->new_from_file( $file ); 136 137 my @packages = $pm_info->packages_inside; 138 is( @packages, 2, 'record only one occurence of each package' ); 139} 140 141{ 142 # Module 'Simple.pm' does not contain package 'Simple'; 143 # constructor should not complain, no default module name or version 144 my $file = File::Spec->catfile('lib', 'Simple.pm'); 145 my ($dist_name, $dist_dir) = new_dist(files => { $file => <<'---' } ); 146package Simple::Not; 147$VERSION = '1.23'; 148--- 149 150 my $pm_info = Module::Metadata->new_from_file( $file ); 151 152 is( $pm_info->name, undef, 'no default package' ); 153 is( $pm_info->version, undef, 'no version w/o default package' ); 154} 155 156# parse $VERSION lines scripts for package main 157my @scripts = ( 158 <<'---', # package main declared 159#!perl -w 160package main; 161$VERSION = '0.01'; 162--- 163 <<'---', # on first non-comment line, non declared package main 164#!perl -w 165$VERSION = '0.01'; 166--- 167 <<'---', # after non-comment line 168#!perl -w 169use strict; 170$VERSION = '0.01'; 171--- 172 <<'---', # 1st declared package 173#!perl -w 174package main; 175$VERSION = '0.01'; 176package _private; 177$VERSION = '999'; 178--- 179 <<'---', # 2nd declared package 180#!perl -w 181package _private; 182$VERSION = '999'; 183package main; 184$VERSION = '0.01'; 185--- 186 <<'---', # split package 187#!perl -w 188package main; 189package _private; 190$VERSION = '999'; 191package main; 192$VERSION = '0.01'; 193--- 194 <<'---', # define 'main' version from other package 195package _private; 196$::VERSION = 0.01; 197$VERSION = '999'; 198--- 199 <<'---', # define 'main' version from other package 200package _private; 201$VERSION = '999'; 202$::VERSION = 0.01; 203--- 204); 205 206my ( $i, $n ) = ( 1, scalar( @scripts ) ); 207foreach my $script ( @scripts ) { 208 my $file = File::Spec->catfile('bin', 'simple.plx'); 209 my ($dist_name, $dist_dir) = new_dist(files => { $file => $script } ); 210 my $pm_info = Module::Metadata->new_from_file( $file ); 211 212 is( $pm_info->version, '0.01', "correct script version ($i of $n)" ); 213 $i++; 214} 215 216{ 217 # examine properties of a module: name, pod, etc 218 my $file = File::Spec->catfile('lib', 'Simple.pm'); 219 my ($dist_name, $dist_dir) = new_dist(files => { $file => <<'---' } ); 220package Simple; 221$VERSION = '0.01'; 222package Simple::Ex; 223$VERSION = '0.02'; 224 225=head1 NAME 226 227Simple - It's easy. 228 229=head1 AUTHOR 230 231Simple Simon 232 233You can find me on the IRC channel 234#simon on irc.perl.org. 235 236=cut 237--- 238 239 my $pm_info = Module::Metadata->new_from_module( 240 'Simple', inc => [ 'lib', @INC ] ); 241 242 is( $pm_info->name, 'Simple', 'found default package' ); 243 is( $pm_info->version, '0.01', 'version for default package' ); 244 245 # got correct version for secondary package 246 is( $pm_info->version( 'Simple::Ex' ), '0.02', 247 'version for secondary package' ); 248 249 my $filename = $pm_info->filename; 250 ok( defined( $filename ) && -e $filename, 251 'filename() returns valid path to module file' ); 252 253 my @packages = $pm_info->packages_inside; 254 is( @packages, 2, 'found correct number of packages' ); 255 is( $packages[0], 'Simple', 'packages stored in order found' ); 256 257 # we can detect presence of pod regardless of whether we are collecting it 258 ok( $pm_info->contains_pod, 'contains_pod() succeeds' ); 259 260 my @pod = $pm_info->pod_inside; 261 is_deeply( \@pod, [qw(NAME AUTHOR)], 'found all pod sections' ); 262 263 is( $pm_info->pod('NONE') , undef, 264 'return undef() if pod section not present' ); 265 266 is( $pm_info->pod('NAME'), undef, 267 'return undef() if pod section not collected' ); 268 269 270 # collect_pod 271 $pm_info = Module::Metadata->new_from_module( 272 'Simple', inc => [ 'lib', @INC ], collect_pod => 1 ); 273 274 my %pod; 275 for my $section (qw(NAME AUTHOR)) { 276 my $content = $pm_info->pod( $section ); 277 if ( $content ) { 278 $content =~ s/^\s+//; 279 $content =~ s/\s+$//; 280 } 281 $pod{$section} = $content; 282 } 283 my %expected = ( 284 NAME => q|Simple - It's easy.|, 285 AUTHOR => <<'EXPECTED' 286Simple Simon 287 288You can find me on the IRC channel 289#simon on irc.perl.org. 290EXPECTED 291 ); 292 for my $text (values %expected) { 293 $text =~ s/^\s+//; 294 $text =~ s/\s+$//; 295 } 296 is( $pod{NAME}, $expected{NAME}, 'collected NAME pod section' ); 297 is( $pod{AUTHOR}, $expected{AUTHOR}, 'collected AUTHOR pod section' ); 298} 299 300{ 301 # test things that look like POD, but aren't 302 my $file = File::Spec->catfile('lib', 'Simple.pm'); 303 my ($dist_name, $dist_dir) = new_dist(files => { $file => <<'---' } ); 304package Simple; 305 306=YES THIS STARTS POD 307 308our $VERSION = '999'; 309 310=cute 311 312our $VERSION = '666'; 313 314=cut 315 316*foo 317=*no_this_does_not_start_pod; 318 319our $VERSION = '1.23'; 320 321--- 322 my $pm_info = Module::Metadata->new_from_file('lib/Simple.pm'); 323 is( $pm_info->name, 'Simple', 'found default package' ); 324 is( $pm_info->version, '1.23', 'version for default package' ); 325} 326 327{ 328 # Make sure processing stops after __DATA__ 329 my $file = File::Spec->catfile('lib', 'Simple.pm'); 330 my ($dist_name, $dist_dir) = new_dist(files => { $file => <<'---' } ); 331package Simple; 332$VERSION = '0.01'; 333__DATA__ 334*UNIVERSAL::VERSION = sub { 335 foo(); 336}; 337--- 338 339 my $pm_info = Module::Metadata->new_from_file('lib/Simple.pm'); 340 is( $pm_info->name, 'Simple', 'found default package' ); 341 is( $pm_info->version, '0.01', 'version for default package' ); 342 my @packages = $pm_info->packages_inside; 343 is_deeply(\@packages, ['Simple'], 'packages inside'); 344} 345 346{ 347 # Make sure we handle version.pm $VERSIONs well 348 my $file = File::Spec->catfile('lib', 'Simple.pm'); 349 my ($dist_name, $dist_dir) = new_dist(files => { $file => <<'---' } ); 350package Simple; 351$VERSION = version->new('0.60.' . (qw$Revision: 128 $)[1]); 352package Simple::Simon; 353$VERSION = version->new('0.61.' . (qw$Revision: 129 $)[1]); 354--- 355 356 my $pm_info = Module::Metadata->new_from_file('lib/Simple.pm'); 357 is( $pm_info->name, 'Simple', 'found default package' ); 358 is( $pm_info->version, '0.60.128', 'version for default package' ); 359 my @packages = $pm_info->packages_inside; 360 is_deeply([sort @packages], ['Simple', 'Simple::Simon'], 'packages inside'); 361 is( $pm_info->version('Simple::Simon'), '0.61.129', 'version for embedded package' ); 362} 363 364# check that package_versions_from_directory works 365 366{ 367 my $file = File::Spec->catfile('lib', 'Simple.pm'); 368 my ($dist_name, $dist_dir) = new_dist(files => { $file => <<'---' } ); 369package Simple; 370$VERSION = '0.01'; 371package Simple::Ex; 372$VERSION = '0.02'; 373{ 374 package main; # should ignore this 375} 376{ 377 package DB; # should ignore this 378} 379{ 380 package Simple::_private; # should ignore this 381} 382 383=head1 NAME 384 385Simple - It's easy. 386 387=head1 AUTHOR 388 389Simple Simon 390 391=cut 392--- 393 394 my $exp_pvfd = { 395 'Simple' => { 396 'file' => 'Simple.pm', 397 'version' => '0.01' 398 }, 399 'Simple::Ex' => { 400 'file' => 'Simple.pm', 401 'version' => '0.02' 402 } 403 }; 404 405 my $got_pvfd = Module::Metadata->package_versions_from_directory('lib'); 406 407 is_deeply( $got_pvfd, $exp_pvfd, "package_version_from_directory()" ) 408 or diag explain $got_pvfd; 409 410{ 411 my $got_provides = Module::Metadata->provides(dir => 'lib', version => 2); 412 my $exp_provides = { 413 'Simple' => { 414 'file' => 'lib/Simple.pm', 415 'version' => '0.01' 416 }, 417 'Simple::Ex' => { 418 'file' => 'lib/Simple.pm', 419 'version' => '0.02' 420 } 421 }; 422 423 is_deeply( $got_provides, $exp_provides, "provides()" ) 424 or diag explain $got_provides; 425} 426 427{ 428 my $got_provides = Module::Metadata->provides(dir => 'lib', prefix => 'other', version => 1.4); 429 my $exp_provides = { 430 'Simple' => { 431 'file' => 'other/Simple.pm', 432 'version' => '0.01' 433 }, 434 'Simple::Ex' => { 435 'file' => 'other/Simple.pm', 436 'version' => '0.02' 437 } 438 }; 439 440 is_deeply( $got_provides, $exp_provides, "provides()" ) 441 or diag explain $got_provides; 442} 443} 444 445# Check package_versions_from_directory with regard to case-sensitivity 446{ 447 my $file = File::Spec->catfile('lib', 'Simple.pm'); 448 my ($dist_name, $dist_dir) = new_dist(files => { $file => <<'---' } ); 449package simple; 450$VERSION = '0.01'; 451--- 452 453 my $pm_info = Module::Metadata->new_from_file('lib/Simple.pm'); 454 is( $pm_info->name, undef, 'no default package' ); 455 is( $pm_info->version, undef, 'version for default package' ); 456 is( $pm_info->version('simple'), '0.01', 'version for lower-case package' ); 457 is( $pm_info->version('Simple'), undef, 'version for capitalized package' ); 458 ok( $pm_info->is_indexable(), 'an indexable package is found' ); 459 ok( $pm_info->is_indexable('simple'), 'the simple package is indexable' ); 460 ok( !$pm_info->is_indexable('Simple'), 'the Simple package would not be indexed' ); 461} 462 463{ 464 my $file = File::Spec->catfile('lib', 'Simple.pm'); 465 my ($dist_name, $dist_dir) = new_dist(files => { $file => <<'---' } ); 466package simple; 467$VERSION = '0.01'; 468package Simple; 469$VERSION = '0.02'; 470package SiMpLe; 471$VERSION = '0.03'; 472--- 473 474 my $pm_info = Module::Metadata->new_from_file('lib/Simple.pm'); 475 is( $pm_info->name, 'Simple', 'found default package' ); 476 is( $pm_info->version, '0.02', 'version for default package' ); 477 is( $pm_info->version('simple'), '0.01', 'version for lower-case package' ); 478 is( $pm_info->version('Simple'), '0.02', 'version for capitalized package' ); 479 is( $pm_info->version('SiMpLe'), '0.03', 'version for mixed-case package' ); 480 ok( $pm_info->is_indexable('simple'), 'the simple package is indexable' ); 481 ok( $pm_info->is_indexable('Simple'), 'the Simple package is indexable' ); 482} 483 484{ 485 my $file = File::Spec->catfile('lib', 'Simple.pm'); 486 my ($dist_name, $dist_dir) = new_dist(files => { $file => <<'---' } ); 487package ## hide from PAUSE 488 simple; 489$VERSION = '0.01'; 490--- 491 492 my $pm_info = Module::Metadata->new_from_file('lib/Simple.pm'); 493 is( $pm_info->name, undef, 'no package names found' ); 494 ok( !$pm_info->is_indexable('simple'), 'the simple package would not be indexed' ); 495 ok( !$pm_info->is_indexable('Simple'), 'the Simple package would not be indexed' ); 496 ok( !$pm_info->is_indexable(), 'no indexable package is found' ); 497} 498