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