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