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