diff options
Diffstat (limited to 't')
| -rw-r--r-- | t/00-compile.t | 60 | ||||
| -rw-r--r-- | t/00-report-prereqs.dd | 68 | ||||
| -rw-r--r-- | t/00-report-prereqs.t | 184 | ||||
| -rw-r--r-- | t/archive.t | 91 | ||||
| -rw-r--r-- | t/determine.t | 129 | ||||
| -rw-r--r-- | t/dir.t | 115 | ||||
| -rw-r--r-- | t/dists.t | 219 | ||||
| -rw-r--r-- | t/file_spec.t | 32 | ||||
| -rw-r--r-- | t/load_meta.t | 55 | ||||
| -rw-r--r-- | t/module_info.t | 126 | ||||
| -rw-r--r-- | t/no_index.t | 86 | ||||
| -rw-r--r-- | t/package_versions.t | 55 | ||||
| -rw-r--r-- | t/struct.t | 69 | ||||
| -rw-r--r-- | t/tar.t | 29 | ||||
| -rw-r--r-- | t/zip.t | 21 |
15 files changed, 1339 insertions, 0 deletions
diff --git a/t/00-compile.t b/t/00-compile.t new file mode 100644 index 0000000..e16fa2d --- /dev/null +++ b/t/00-compile.t @@ -0,0 +1,60 @@ +use 5.006; +use strict; +use warnings; + +# this test was generated with Dist::Zilla::Plugin::Test::Compile 2.052 + +use Test::More; + +plan tests => 7 + ($ENV{AUTHOR_TESTING} ? 1 : 0); + +my @module_files = ( + 'Dist/Metadata.pm', + 'Dist/Metadata/Archive.pm', + 'Dist/Metadata/Dir.pm', + 'Dist/Metadata/Dist.pm', + 'Dist/Metadata/Struct.pm', + 'Dist/Metadata/Tar.pm', + 'Dist/Metadata/Zip.pm' +); + + + +# fake home for cpan-testers +use File::Temp; +local $ENV{HOME} = File::Temp::tempdir( CLEANUP => 1 ); + + +my $inc_switch = -d 'blib' ? '-Mblib' : '-Ilib'; + +use File::Spec; +use IPC::Open3; +use IO::Handle; + +open my $stdin, '<', File::Spec->devnull or die "can't open devnull: $!"; + +my @warnings; +for my $lib (@module_files) +{ + # see L<perlfaq8/How can I capture STDERR from an external command?> + my $stderr = IO::Handle->new; + + my $pid = open3($stdin, '>&STDERR', $stderr, $^X, $inc_switch, '-e', "require q[$lib]"); + binmode $stderr, ':crlf' if $^O eq 'MSWin32'; + my @_warnings = <$stderr>; + waitpid($pid, 0); + is($?, 0, "$lib loaded ok"); + + if (@_warnings) + { + warn @_warnings; + push @warnings, @_warnings; + } +} + + + +is(scalar(@warnings), 0, 'no warnings found') + or diag 'got warnings: ', ( Test::More->can('explain') ? Test::More::explain(\@warnings) : join("\n", '', @warnings) ) if $ENV{AUTHOR_TESTING}; + + diff --git a/t/00-report-prereqs.dd b/t/00-report-prereqs.dd new file mode 100644 index 0000000..c378a45 --- /dev/null +++ b/t/00-report-prereqs.dd @@ -0,0 +1,68 @@ +do { my $x = { + 'configure' => { + 'requires' => { + 'ExtUtils::MakeMaker' => '0', + 'perl' => '5.006' + } + }, + 'develop' => { + 'requires' => { + 'Archive::Any::Create' => '0.03', + 'Pod::Coverage::TrustPod' => '0', + 'Test::CPAN::Changes' => '0.19', + 'Test::CPAN::Meta' => '0', + 'Test::CPAN::Meta::JSON' => '0.16', + 'Test::EOL' => '0', + 'Test::Kwalitee' => '1.21', + 'Test::More' => '0.88', + 'Test::NoTabs' => '0', + 'Test::Pod' => '1.41', + 'Test::Pod::Coverage' => '1.08', + 'Test::Spelling' => '0.12', + 'Test::Synopsis' => '0', + 'Test::Version' => '1' + } + }, + 'runtime' => { + 'requires' => { + 'Archive::Tar' => '1', + 'Archive::Zip' => '1.30', + 'CPAN::DistnameInfo' => '0.12', + 'CPAN::Meta' => '2.1', + 'Carp' => '0', + 'Digest' => '1.03', + 'Digest::MD5' => '2', + 'Digest::SHA' => '5', + 'File::Basename' => '0', + 'File::Find' => '0', + 'File::Spec::Native' => '1.002', + 'File::Temp' => '0.19', + 'List::Util' => '0', + 'Module::Metadata' => '0', + 'Path::Class' => '0.24', + 'Try::Tiny' => '0.09', + 'parent' => '0', + 'perl' => '5.006', + 'strict' => '0', + 'warnings' => '0' + } + }, + 'test' => { + 'recommends' => { + 'CPAN::Meta' => '2.120900' + }, + 'requires' => { + 'ExtUtils::MakeMaker' => '0', + 'File::Spec' => '0', + 'File::Temp' => '0.19', + 'IO::Handle' => '0', + 'IPC::Open3' => '0', + 'Test::Fatal' => '0', + 'Test::MockObject' => '1.09', + 'Test::More' => '0.96', + 'perl' => '5.006' + } + } + }; + $x; + }
\ No newline at end of file diff --git a/t/00-report-prereqs.t b/t/00-report-prereqs.t new file mode 100644 index 0000000..cce9245 --- /dev/null +++ b/t/00-report-prereqs.t @@ -0,0 +1,184 @@ +#!perl + +use strict; +use warnings; + +# This test was generated by Dist::Zilla::Plugin::Test::ReportPrereqs 0.021 + +use Test::More tests => 1; + +use ExtUtils::MakeMaker; +use File::Spec; + +# from $version::LAX +my $lax_version_re = + qr/(?: undef | (?: (?:[0-9]+) (?: \. | (?:\.[0-9]+) (?:_[0-9]+)? )? + | + (?:\.[0-9]+) (?:_[0-9]+)? + ) | (?: + v (?:[0-9]+) (?: (?:\.[0-9]+)+ (?:_[0-9]+)? )? + | + (?:[0-9]+)? (?:\.[0-9]+){2,} (?:_[0-9]+)? + ) + )/x; + +# hide optional CPAN::Meta modules from prereq scanner +# and check if they are available +my $cpan_meta = "CPAN::Meta"; +my $cpan_meta_pre = "CPAN::Meta::Prereqs"; +my $HAS_CPAN_META = eval "require $cpan_meta; $cpan_meta->VERSION('2.120900')" && eval "require $cpan_meta_pre"; ## no critic + +# Verify requirements? +my $DO_VERIFY_PREREQS = 1; + +sub _max { + my $max = shift; + $max = ( $_ > $max ) ? $_ : $max for @_; + return $max; +} + +sub _merge_prereqs { + my ($collector, $prereqs) = @_; + + # CPAN::Meta::Prereqs object + if (ref $collector eq $cpan_meta_pre) { + return $collector->with_merged_prereqs( + CPAN::Meta::Prereqs->new( $prereqs ) + ); + } + + # Raw hashrefs + for my $phase ( keys %$prereqs ) { + for my $type ( keys %{ $prereqs->{$phase} } ) { + for my $module ( keys %{ $prereqs->{$phase}{$type} } ) { + $collector->{$phase}{$type}{$module} = $prereqs->{$phase}{$type}{$module}; + } + } + } + + return $collector; +} + +my @include = qw( + JSON::PP + JSON +); + +my @exclude = qw( + +); + +# Add static prereqs to the included modules list +my $static_prereqs = do 't/00-report-prereqs.dd'; + +# Merge all prereqs (either with ::Prereqs or a hashref) +my $full_prereqs = _merge_prereqs( + ( $HAS_CPAN_META ? $cpan_meta_pre->new : {} ), + $static_prereqs +); + +# Add dynamic prereqs to the included modules list (if we can) +my ($source) = grep { -f } 'MYMETA.json', 'MYMETA.yml'; +if ( $source && $HAS_CPAN_META ) { + if ( my $meta = eval { CPAN::Meta->load_file($source) } ) { + $full_prereqs = _merge_prereqs($full_prereqs, $meta->prereqs); + } +} +else { + $source = 'static metadata'; +} + +my @full_reports; +my @dep_errors; +my $req_hash = $HAS_CPAN_META ? $full_prereqs->as_string_hash : $full_prereqs; + +# Add static includes into a fake section +for my $mod (@include) { + $req_hash->{other}{modules}{$mod} = 0; +} + +for my $phase ( qw(configure build test runtime develop other) ) { + next unless $req_hash->{$phase}; + next if ($phase eq 'develop' and not $ENV{AUTHOR_TESTING}); + + for my $type ( qw(requires recommends suggests conflicts modules) ) { + next unless $req_hash->{$phase}{$type}; + + my $title = ucfirst($phase).' '.ucfirst($type); + my @reports = [qw/Module Want Have/]; + + for my $mod ( sort keys %{ $req_hash->{$phase}{$type} } ) { + next if $mod eq 'perl'; + next if grep { $_ eq $mod } @exclude; + + my $file = $mod; + $file =~ s{::}{/}g; + $file .= ".pm"; + my ($prefix) = grep { -e File::Spec->catfile($_, $file) } @INC; + + my $want = $req_hash->{$phase}{$type}{$mod}; + $want = "undef" unless defined $want; + $want = "any" if !$want && $want == 0; + + my $req_string = $want eq 'any' ? 'any version required' : "version '$want' required"; + + if ($prefix) { + my $have = MM->parse_version( File::Spec->catfile($prefix, $file) ); + $have = "undef" unless defined $have; + push @reports, [$mod, $want, $have]; + + if ( $DO_VERIFY_PREREQS && $HAS_CPAN_META && $type eq 'requires' ) { + if ( $have !~ /\A$lax_version_re\z/ ) { + push @dep_errors, "$mod version '$have' cannot be parsed ($req_string)"; + } + elsif ( ! $full_prereqs->requirements_for( $phase, $type )->accepts_module( $mod => $have ) ) { + push @dep_errors, "$mod version '$have' is not in required range '$want'"; + } + } + } + else { + push @reports, [$mod, $want, "missing"]; + + if ( $DO_VERIFY_PREREQS && $type eq 'requires' ) { + push @dep_errors, "$mod is not installed ($req_string)"; + } + } + } + + if ( @reports ) { + push @full_reports, "=== $title ===\n\n"; + + my $ml = _max( map { length $_->[0] } @reports ); + my $wl = _max( map { length $_->[1] } @reports ); + my $hl = _max( map { length $_->[2] } @reports ); + + if ($type eq 'modules') { + splice @reports, 1, 0, ["-" x $ml, "", "-" x $hl]; + push @full_reports, map { sprintf(" %*s %*s\n", -$ml, $_->[0], $hl, $_->[2]) } @reports; + } + else { + splice @reports, 1, 0, ["-" x $ml, "-" x $wl, "-" x $hl]; + push @full_reports, map { sprintf(" %*s %*s %*s\n", -$ml, $_->[0], $wl, $_->[1], $hl, $_->[2]) } @reports; + } + + push @full_reports, "\n"; + } + } +} + +if ( @full_reports ) { + diag "\nVersions for all modules listed in $source (including optional ones):\n\n", @full_reports; +} + +if ( @dep_errors ) { + diag join("\n", + "\n*** WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING ***\n", + "The following REQUIRED prerequisites were not satisfied:\n", + @dep_errors, + "\n" + ); +} + +pass; + +# vim: ts=4 sts=4 sw=4 et: diff --git a/t/archive.t b/t/archive.t new file mode 100644 index 0000000..f75539b --- /dev/null +++ b/t/archive.t @@ -0,0 +1,91 @@ +use strict; +use warnings; +use Test::More 0.96; +use Test::Fatal; + +my $mod = 'Dist::Metadata::Archive'; +eval "require $mod" or die $@; + +# default_file_spec +is( $mod->default_file_spec, 'Unix', 'most archive files use unix paths' ); + +test_constructor_errors($mod); + +# test file type determination +my $base = 'corpus/Dist-Metadata-Test-NoMetaFile-0.1'; +foreach my $test ( + [Zip => "$base.zip"], + [Tar => "$base.tar.gz"], +){ + my ($type, $file) = @$test; + + my $distclass = "Dist::Metadata::$type"; + + # instantiate using base 'Archive' class which will determine subclass + my $archive = new_ok($mod => [file => $file]); + + isa_ok($archive, $distclass); + isa_ok($archive->archive, "Archive::$type"); + + # file + is($archive->file, $file, 'dumb accessor works'); + + # determine_name_and_version + $archive->determine_name_and_version(); + is($archive->name, 'Dist-Metadata-Test-NoMetaFile', 'name from file'); + is($archive->version, '0.1', 'version from file'); + + # file_content + is( + $archive->file_content('README'), + qq[This "dist" is for testing Dist::Metadata.\n], + 'got file content without specifying root dir' + ); + + # perllocale says, "By default Perl ignores the current locale." + + # find_files + is_deeply( + [sort $archive->find_files], + [qw( + Dist-Metadata-Test-NoMetaFile-0.1/README + Dist-Metadata-Test-NoMetaFile-0.1/lib/Dist/Metadata/Test/NoMetaFile.pm + Dist-Metadata-Test-NoMetaFile-0.1/lib/Dist/Metadata/Test/NoMetaFile/PM.pm + )], + 'find_files' + ); + + # list_files (no root) + is_deeply( + [sort $archive->list_files], + [qw( + README + lib/Dist/Metadata/Test/NoMetaFile.pm + lib/Dist/Metadata/Test/NoMetaFile/PM.pm + )], + 'files listed without root directory' + ); + + # root + is($archive->root, 'Dist-Metadata-Test-NoMetaFile-0.1', 'root dir'); + + # do this last so that successful new() has already loaded the distclass + test_constructor_errors($distclass); +} + +done_testing; + +# required_attribute +# file doesn't exist +sub test_constructor_errors { + my $mod = shift; + + my $att = 'file'; + is( $mod->required_attribute, $att, "'$att' attribute required" ); + my $ex = exception { $mod->new() }; + like($ex, qr/'$att' parameter required/, "new dies without '$att'"); + + my $dist = new_ok( $mod, [ file => 'does-not._exist_' ] ); + $ex = exception { $dist->archive }; + like($ex, qr/does not exist/, 'file does not exist'); +} diff --git a/t/determine.t b/t/determine.t new file mode 100644 index 0000000..4f9f49b --- /dev/null +++ b/t/determine.t @@ -0,0 +1,129 @@ +use strict; +use warnings; +use Test::More 0.96; + +my $mod = 'Dist::Metadata'; +my $smod = "${mod}::Struct"; +eval "require $_" || die $@ + for $mod, $smod; + +$Dist::Metadata::VERSION ||= 0; # avoid undef warnings + +{ + foreach my $test ( + [ + '/tmp/No-Existy-1.01', + [], + ['No-Existy', '1.01'], + undef # same + ], + [ + # main module: No::Existy::3 (like perl5i::2) + 'No-Existy-3-v2.1.3', + [], + ['No-Existy-3', 'v2.1.3'], + undef # same + ], + [ + # constructor args override + 'No-Existy-3-v2.1.3', + [ + name => 'Who-Cares' + ], + ['No-Existy-3', 'v2.1.3'], + ['Who-Cares', 'v2.1.3'], + ], + [ + # constructor args override + 'No-Existy-3-v2.1.3', + [ + name => 'Who-Cares', + version => 5, + ], + ['No-Existy-3', 'v2.1.3'], + ['Who-Cares', '5'], + ], + ){ + my ($base, $args, $parsed, $att) = @$test; + $att ||= $parsed; + # test dir name and tar file name + foreach my $path ( $base, "$base.tar.gz", "$base.tgz" ){ + my $dm = new_ok($smod, [files => {}, @$args]); + + my @nv = $dm->parse_name_and_version($path); + is_deeply(\@nv, $parsed, 'parsed name and version'); + + $dm->set_name_and_version(@nv); + is_deeply([$dm->name, $dm->version], $att, "set dist name and version"); + } + } +} + +{ + my $struct = { + files => { + 'README' => 'we need a file to establish the root dir', + 'lib/Bunnies.pm' => <<'BUNNIES', +package Bunnies; +our $VERSION = 2.3; + +package # comment + HiddenBunnies; +our $VERSION = 2.4; + +package TooManyBunnies; +our $VERSION = 2.5; +BUNNIES + 'lib/Rabbit/Hole.pm' => <<'HOLE', +package Rabbit::Hole; +our $VERSION = '1.1'; + +package Rabbit::Hole::Cover; +our $VERSION = '1.1'; +HOLE + # Test something that doesn't match the "simile" regexp in DM:determine_packages. + # Module::Metadata 1.000009 will find this but for obvious reasons PAUSE would not index it. + # If MM stops finding this we'll have to determine if there are + # any other possible file names that wouldn't match the regexp. + 'lib/.pm' => <<'GOOFY', +package Goofy; +our $VERSION = '0.1'; +GOOFY + }, + }; + + is_deeply + new_ok($mod, [struct => $struct, include_inner_packages => 1])->determine_packages, + { + Bunnies => { file => 'lib/Bunnies.pm', version => '2.3', }, + TooManyBunnies => { file => 'lib/Bunnies.pm', version => '2.5', }, + Goofy => { file => 'lib/.pm', version => '0.1', }, + 'Rabbit::Hole' => { file => 'lib/Rabbit/Hole.pm', version => '1.1' }, + 'Rabbit::Hole::Cover' => { file => 'lib/Rabbit/Hole.pm', version => '1.1' }, + }, + 'determine all (not hidden) packages'; + + is_deeply + new_ok($mod, [struct => $struct])->determine_packages, + { + Bunnies => { file => 'lib/Bunnies.pm', version => '2.3', }, + 'Rabbit::Hole' => { file => 'lib/Rabbit/Hole.pm', version => '1.1' }, + }, + 'determine only "simile" packages'; + + { + my $dm = new_ok($mod, [struct => $struct]); + my $cpan_meta = $dm->default_metadata; + push @{ $cpan_meta->{no_index}{namespace} ||= [] }, 'Rabbit'; # this is only about bunnies + + is_deeply + $dm->determine_packages($dm->meta_from_struct($cpan_meta)), + { + Bunnies => { file => 'lib/Bunnies.pm', version => '2.3', }, + }, + 'determine only loadable modules, minus no_index/namespace'; + } + +} + +done_testing; @@ -0,0 +1,115 @@ +use strict; +use warnings; +use Test::More 0.96; +use Test::Fatal; +use Test::MockObject 1.09 (); +use Path::Class 0.24 qw(file dir); +use File::Spec (); + +my $tmpdir = File::Spec->tmpdir; + +my $mod = 'Dist::Metadata::Dir'; +eval "require $mod" or die $@; + +# required_attribute +# extract_into +{ + my $att = 'dir'; + is($mod->required_attribute, $att, "'$att' attribute required"); + my $ex = exception { $mod->new() }; + like($ex, qr/'$att' parameter required/, "new dies without '$att'"); + + $ex = exception { $mod->new(dir => $tmpdir)->extract_into($tmpdir) }; + like( $ex, qr/A directory doesn't need to be extracted/, 'no extraction' ); +} + +# default_file_spec + is( $mod->default_file_spec, 'Native', 'default to native file spec for dir' ); + +# dir +# file_content +# find_files +# physical_directory + +{ + # with no root dir + my $path = dir( qw(corpus noroot) ); + my $dir = $path->stringify; + my $dist = new_ok( $mod, [ dir => $dir ] ); + + test_phys_dir($dist, $dir, $path); + + my @files = ( + file( qw(lib Dist Metadata Test NoRoot PM.pm) )->stringify, + file( qw(lib Dist Metadata Test NoRoot.pm) )->stringify, + 'README' + ); + + # no root, same as below + is_deeply([sort $dist->find_files], [sort @files], 'all files listed (full paths)'); + # root stripped + is_deeply([sort $dist->list_files], [sort @files], 'all files listed (no root)'); +} +# with root dir +{ + my $path = dir( qw(corpus subdir) ); + my $dir = $path->stringify; + my $dist = new_ok( $mod, [ dir => $dir ] ); + + test_phys_dir($dist, $dir, $path->subdir($dist->root)); + + my @files = ( + file( qw(lib Dist Metadata Test SubDir PM.pm) )->stringify, + file( qw(lib Dist Metadata Test SubDir.pm) )->stringify, + 'README' + ); + + # root present + is_deeply([sort $dist->find_files], [sort map { file($dist->root, $_)->stringify } @files], 'all files listed (full paths)'); + # root stripped + is_deeply([sort $dist->list_files], [sort @files], 'all files listed (no root)'); +} + +# determine_name_and_version +{ + my %nv = (name => 'Dist-Metadata-Test-MetaFile', version => 2.2); + my $dir = dir( 'corpus', join('-', @nv{qw(name version)}) ); + my $dist = new_ok( $mod, [ dir => $dir ] ); + + ok(!exists($dist->{$_}), "no dist $_" ) + for keys %nv; + + $dist->determine_name_and_version; + + is($dist->$_, $nv{$_}, "determined dist $_" ) + for keys %nv; +} + +done_testing; + +sub test_phys_dir { + my ($dist, $dir, $subroot) = @_; + $subroot = $subroot->absolute; + + is( $dist->dir, $dir, 'dir attribute from constructor arg' ); + is( $dist->physical_directory, $subroot, 'dir + root' ); + + is_deeply( + [$dist->physical_directory('README')], + [$subroot, $subroot->file('README')], + 'physical directory with adjusted file' + ); + + is( + $dist->file_content('README'), + qq[This "dist" is for testing Dist::Metadata.\n], + 'file content' + ); + + like( + exception { $dist->file_content('missing.file') }, + qr{Failed to open file 'corpus.+\w+.+missing\.file':}, + 'die on missing file' + ); + +} diff --git a/t/dists.t b/t/dists.t new file mode 100644 index 0000000..aa79260 --- /dev/null +++ b/t/dists.t @@ -0,0 +1,219 @@ +use strict; +use warnings; +use Test::More 0.96; +use Path::Class 0.24 qw(file); + +my $mod = 'Dist::Metadata'; +eval "require $mod" or die $@; +$Dist::Metadata::VERSION ||= 0; # quiet warnings + +# we may need to prepend $FindBin::Bin +my $root = 'corpus'; +my $structs = do "$root/structs.pl"; + +# NOTE: Portability tests report issues with file names being long +# and containing periods, so there could be issues... + +foreach my $test ( + [ + [ + metafile => + 'Dist-Metadata-Test-MetaFile-2.2', + ], + { + name => 'Dist-Metadata-Test-MetaFile', + version => '2.2', + provides => { + 'Dist::Metadata::Test::MetaFile' => { + file => 'lib/Dist/Metadata/Test/MetaFile.pm', + version => '2.1', + }, + 'Dist::Metadata::Test::MetaFile::PM' => { + file => 'lib/Dist/Metadata/Test/MetaFile/PM.pm', + version => '2.0', + }, + }, + }, + ], + [ + [ + metafile_incomplete => + 'Dist-Metadata-Test-MetaFile-Incomplete-2.1', + ], + { + name => 'Dist-Metadata-Test-MetaFile-Incomplete', + version => '2.1', + provides => { + 'Dist::Metadata::Test::MetaFile::Incomplete' => { + file => 'lib/Dist/Metadata/Test/MetaFile/Incomplete.pm', + version => '2.1', + }, + }, + }, + ], + [ + [ + nometafile => + 'Dist-Metadata-Test-NoMetaFile-0.1', + ], + { + name => 'Dist-Metadata-Test-NoMetaFile', + version => '0.1', + provides => { + 'Dist::Metadata::Test::NoMetaFile' => { + file => 'lib/Dist/Metadata/Test/NoMetaFile.pm', + version => '0.1', + }, + 'Dist::Metadata::Test::NoMetaFile::PM' => { + file => 'lib/Dist/Metadata/Test/NoMetaFile/PM.pm', + version => '0.1', + }, + }, + }, + ], + + [ + [ + index_like_pause => 'Dist-Metadata-Test-LikePause-0.1', + ], + { + name => 'Dist-Metadata-Test-LikePause', + version => '0.1', + provides => { + 'Dist::Metadata::Test::LikePause' => { + file => 'lib/Dist/Metadata/Test/LikePause.pm', + version => '0.1', + }, + }, + }, + ], + + [ + [ + index_like_pause => 'Dist-Metadata-Test-LikePause-0.1', + ], + { + name => 'Dist-Metadata-Test-LikePause', + version => '0.1', + provides => { + 'Dist::Metadata::Test::LikePause' => { + file => 'lib/Dist/Metadata/Test/LikePause.pm', + version => '0.1', + }, + 'ExtraPackage' => { + file => 'lib/Dist/Metadata/Test/LikePause.pm', + version => '0.2', + }, + }, + }, + { + # this we should find the Extra (inner) package + include_inner_packages => 1, + }, + ], + + [ + [ + nometafile_dev_release => + 'Dist-Metadata-Test-NoMetaFile-DevRelease-0.1_1', + ], + { + name => 'Dist-Metadata-Test-NoMetaFile-DevRelease', + version => '0.1_1', + provides => { + 'Dist::Metadata::Test::NoMetaFile::DevRelease' => { + file => 'lib/Dist/Metadata/Test/NoMetaFile/DevRelease.pm', + version => '0.1_1', + }, + }, + }, + ], + [ + [ + subdir => + 'Dist-Metadata-Test-SubDir-1.5', + 'subdir', + ], + { + name => 'Dist-Metadata-Test-SubDir', + version => '1.5', + provides => { + 'Dist::Metadata::Test::SubDir' => { + file => 'lib/Dist/Metadata/Test/SubDir.pm', + version => '1.1', + }, + 'Dist::Metadata::Test::SubDir::PM' => { + file => 'lib/Dist/Metadata/Test/SubDir/PM.pm', + version => '1.0', + }, + }, + }, + ], + [ + 'noroot', + { + # can't guess name/version without formatted file name or root dir + name => 'noroot', # modified in loop + version => '0', + provides => { + 'Dist::Metadata::Test::NoRoot' => { + file => 'lib/Dist/Metadata/Test/NoRoot.pm', + version => '3.3', + }, + 'Dist::Metadata::Test::NoRoot::PM' => { + file => 'lib/Dist/Metadata/Test/NoRoot/PM.pm', + version => '3.25', + }, + }, + }, + ], +){ + my ( $dists, $exp, $opts ) = @$test; + $exp->{package_versions} = do { + my $p = $exp->{provides}; + +{ map { ($_ => $p->{$_}{version}) } keys %$p }; + }; + + $dists = [ ($dists) x 2 ] + unless ref $dists; + + my ($key, $file, $dir) = @$dists; + + $dir ||= $file; + $_ = "corpus/$_" for ($file, $dir); + + $_ = file($root, $_)->stringify + for @$dists; + + + + foreach my $args ( + [file => "$file.tar.gz"], + [file => "$file.zip"], + [dir => $dir], + [struct => { files => $structs->{$key} }], + ){ + + push @{ $args }, %{ $opts || {} }; + + my $dm = new_ok( $mod, $args ); + # minimal name can be determined from file or dir but not struct + $exp->{name} = Dist::Metadata::UNKNOWN() if $key eq 'noroot' && $args->[0] eq 'struct'; + + # FIXME: perl 5.6.2 weirdness: http://www.cpantesters.org/cpan/report/4297a762-a314-11e0-b62c-be5be1de4735 + # # Failed test 'verify corpus/noroot/lib/Dist/Metadata/Test/NoRoot/PM.pm for dir corpus/noroot' + # # at t/dists.t line 124. + # # Structures begin differing at: + # # $got = HASH(0x11c22d0) + # # $expected = undef + is_deeply( $dm->$_, $exp->{$_}, "verify $_ for @$args" ) || dump_if_automated([$dm, $_, $exp]) + for keys %$exp; + } +} + +done_testing; + +sub dump_if_automated { + diag(explain(@_)) + if $ENV{AUTOMATED_TESTING}; +} diff --git a/t/file_spec.t b/t/file_spec.t new file mode 100644 index 0000000..a8c0ab3 --- /dev/null +++ b/t/file_spec.t @@ -0,0 +1,32 @@ +use strict; +use warnings; +use Test::More 0.96; + +my $mod = 'Dist::Metadata::Struct'; +eval "require $mod" or die $@; + +# all these translate into "Native" +foreach my $test ( + [ '' => 'Native' ], + [ qw( File::Spec Native ) ], + [ qw( File::Spec::Native Native ) ], + [ qw( Native Native ) ], + [ qw( Win32 Win32 ) ], + [ qw( File::Spec::Win32 Win32 ) ], +) { + my ( $spec, $exp ) = @$test; + my $dist = new_ok( $mod, [ file_spec => $spec, files => {} ] ); + is( $dist->file_spec, $exp, "spec '$spec' => '$exp'" ); +} + +# test using default File::Spec +{ + my $dist = new_ok( $mod, [ file_spec => '', files => { + README => 'read me', + 'Module.pm' => \"package Some::Module;\nour \$VERSION = 2;", + } ] ); + is_deeply( $dist->determine_packages, {'Some::Module' => { file => 'Module.pm', version => 2 }}, + 'found package in root' ); +} + +done_testing; diff --git a/t/load_meta.t b/t/load_meta.t new file mode 100644 index 0000000..e19fcdc --- /dev/null +++ b/t/load_meta.t @@ -0,0 +1,55 @@ +use strict; +use warnings; +use Test::More 0.96; +use Test::MockObject 1.09; + +my ( $default, $loaded, $created ) = (-1) x 3; + +Test::MockObject->new->fake_module('CPAN::Meta', + VERSION => sub { 2 }, + new => sub { bless { %{ $_[1] } }, $_[0] }, + create => sub { $created = $_[1]; shift->new(@_) }, + #as_struct => sub { +{ %{ $_[0] } } }, # unbless + (map { ( $_ => sub { undef } ) } qw(name version provides)), + map { + ( "load_${_}_string" => sub { $loaded = $_[1]; $_[0]->new({loaded => $_[1]}); } ) + } qw(json yaml) +); + +my $mod = 'Dist::Metadata'; +eval "require $mod" or die $@; +$Dist::Metadata::VERSION ||= 0; # quiet warnings + +foreach my $test ( + [ json => j => { 'META.json' => 'j' } ], + [ yaml => y => { 'META.yml' => 'y' } ], + + # usually it's spelled .yml but yaml spec suggests .yaml + [ yaml => y => { 'tar/META.yaml' => 'y' } ], + + # json preferred + [ json => j => { 'tar/META.json' => 'j', 'tar/META.yaml' => 'y' } ], + ) +{ + my ( $type, $content, $files ) = @$test; + my $struct = { files => $files }; + + new_ok( $mod, [ struct => $struct, determine_packages => 0 ] )->load_meta; + is( $loaded, $content, "loaded $type" ); + is( $created, $default, "loaded not created" ); +} + +reset_vars(); + +new_ok( $mod, + [ struct => { files => { 'README' => 'nevermind' } }, determine_packages => 0 ] +)->load_meta; + +is( $loaded, $default, 'meta file not found, not loaded' ); +is( ref($created), 'HASH', 'hash passed to create()' ); + +done_testing; + +sub reset_vars { + ( $loaded, $created ) = ($default) x 2; +} diff --git a/t/module_info.t b/t/module_info.t new file mode 100644 index 0000000..1fb8bc3 --- /dev/null +++ b/t/module_info.t @@ -0,0 +1,126 @@ +use strict; +use warnings; +use Test::More 0.96; +use Test::Fatal; +use Path::Class; + +my $mod = 'Dist::Metadata'; +eval "require $mod" or die $@; + +test_module_info( + [file => file(qw(corpus Dist-Metadata-Test-NoMetaFile-0.1.tar.gz))->stringify], + { + 'Dist::Metadata::Test::NoMetaFile' => { + file => 'lib/Dist/Metadata/Test/NoMetaFile.pm', + version => '0.1', + md5 => 'd4a5a07d20dd1fdad6191d5950287609', + sha1 => '99d1aa7e3dbaa54dc16f178a8a4d2a9ba4d33da2', + sha256 => '7d888a6c321041adbc1225b3ca12ae22ebfccdf221e5e3f0ccb2dec1a9c0a71a', + }, + 'Dist::Metadata::Test::NoMetaFile::PM' => { + file => 'lib/Dist/Metadata/Test/NoMetaFile/PM.pm', + version => '0.1', + md5 => '6e8845e06e7297bc913ebf3f1447c89a', + sha1 => '843ce5cd5443c7ae2792f7b58e069fcab64963c8', + sha256 => 'bc61da45e576a43155fcf296d03f74532bfe3a410f88aeaa75ade9155f67d049', + }, + }, +); + +test_module_info( + [file => file(qw(corpus Dist-Metadata-Test-MetaFile-2.2.zip))->stringify], + { + 'Dist::Metadata::Test::MetaFile' => { + file => 'lib/Dist/Metadata/Test/MetaFile.pm', + version => '2.1', + md5 => '95fe72abee727b584941eda6da89f049', + sha1 => '2c4341d7778a78702e364f2c38c6c97b8410387d', + sha256 => '17dbde0b5b534d2a9ff9d188133da11670e3909ce853ac333aaa6973b348701e', + }, + 'Dist::Metadata::Test::MetaFile::PM' => { + file => 'lib/Dist/Metadata/Test/MetaFile/PM.pm', + version => '2.0', + md5 => '873b2db91af4418020350d3337f6c173', + sha1 => '29553e76693b13b1e3d9f4493ee9d05c4cd4f6fb', + sha256 => '53c79b083cb731e2f642ae409459756a483b6912b99ed61c34edbbfb483ea7d1', + }, + } +); + +{ + my $args = [ + struct => { + files => { + 'fb/lib/Foo/Bar.pm' => "package Foo::Bar;\nour \$VERSION = 13;\n", + 'fb/README.txt' => "anything\n", + } + } + ]; + my $exp = { + 'Foo::Bar' => { + file => 'lib/Foo/Bar.pm', + version => '13', + md5 => '8642ef750b6ca0d9c9afe5db4174e009', + sha1 => '2a4899cefacd1defd114731fec0e58c747eb9471', + sha256 => '368e2f18d80a866537153885807ddf6e0733168b683b0a7ecac6d257943ac894', + }, + }; + + test_module_info($args, $exp); + + my $dm = new_ok($mod => $args); + my $provides = { + 'Who::Cares' => { + file => 'README.txt', + version => 0, + }, + }; + + # specify our own 'provides' + my $mi = $dm->module_info({digest => ['MD5', 'SHA-256'], provides => $provides}); + + # use official names + my $checksums = { + 'MD5' => 'f5b1321af715fbd4866590170ddbe8f6', + 'SHA-256' => 'ce32b18ae7f79e70f7cde4cf6077ae8b4195044307a78a4ea8761ddfedf9badc', + }; + + @{ $provides->{'Who::Cares'} }{ keys %$checksums } = values %$checksums; + + is_deeply $provides, $mi, 'module info with official checksum names'; +} + +done_testing; + +sub test_module_info { + my ($args, $info) = @_; + my $dm = new_ok($mod => $args); + + my $p = $dm->provides; + { + my $m = $dm->module_info; + is_deeply $p, $m, 'provides and module_info have the same'; + is_deeply limit_keys($info), $m, 'sanity check - no checksums'; + } + + foreach my $checksums ( + 'md5', + ['sha1'], + [qw(md5 sha256)], + ){ + is_deeply limit_keys($info, $checksums), $dm->module_info({checksum => $checksums}); + } +} + +sub limit_keys { + my $hash = { %{ shift() } }; + my @keys = map { ref($_) eq 'ARRAY' ? @$_ : $_ } (qw(file version), @_); + + foreach my $mod ( keys %$hash ){ + my $info = delete $hash->{ $mod }; + my $new = $hash->{ $mod } = {}; + @$new{ @keys } = @$info{ @keys }; + } + + return $hash; +} diff --git a/t/no_index.t b/t/no_index.t new file mode 100644 index 0000000..0443244 --- /dev/null +++ b/t/no_index.t @@ -0,0 +1,86 @@ +use strict; +use warnings; +use Test::More 0.96; +use Path::Class qw( foreign_file ); + +my $mod = 'Dist::Metadata'; +eval "require $mod" or die $@; +$Dist::Metadata::VERSION ||= 0; # quiet warnings + +# specifically test that expected paths are not indexed on various platforms +foreach my $spec ( qw(Unix Win32 Mac) ){ + my $dm = new_ok($mod, [struct => { + file_spec => $spec, + files => { + README => 'nevermind', + foreign_file($spec => qw(lib Mod Name.pm)) => "package Mod::Name;\nour \$VERSION = 0.11;", + foreign_file($spec => qw(inc No.pm)) => "package No;\nour \$VERSION = 0.11;", + foreign_file($spec => qw(t lib YU.pm)) => "package YU;\nour \$VERSION = 0.11;", + } + }]); + + is $dm->dist->file_spec, $spec, "dist faking file spec: $spec"; + + is_deeply + [sort $dm->dist->perl_files], + [sort grep { !/README/ } keys %{ $dm->dist->{files} }], + 'perl files listed'; + + is_deeply + $dm->package_versions, + {'Mod::Name' => '0.11'}, + 't and inc not indexed'; + + is_deeply + $dm->determine_packages, + {'Mod::Name' => {file => 'lib/Mod/Name.pm', version => '0.11'}}, + 'determined package with translated path'; +} + +sub indexed_ok { + my ($files, $exp, $desc) = @_; + + my $dm = new_ok($mod, [struct => { + file_spec => 'Unix', + files => $files, + }]); + + is_deeply $dm->package_versions, $exp, $desc; +} + +sub _pkg { + my ($name, $version) = @_; + return "package $name;\nour \$VERSION = 0.$version;\n"; +} + + +indexed_ok + { + 'META.json' => <<JSON, +{ + "name": "X", + "version": "1.1", + "no_index": { + "directory": [ "notthis" ] + } +} +JSON + 'lib/A/B.pm' => _pkg('A::B' => 2), + 't/T.pm' => _pkg('T' => 3), + 'xt/XT.pm' => _pkg('XT' => 4), + 'inc/Inc.pm' => _pkg('Inc' => 5), + 'local/Local.pm' => _pkg('Local' => 6), + 'perl5/Perl5.pm' => _pkg('Perl5' => 7), + 'fatlib/FatLib.pm' => _pkg('FatLib' => 8), + 'Root.pm' => _pkg('Some::Root' => 9), + 'notthis/More.pm' => _pkg('Some::More' => 10), + 'butthis/Moar.pm' => _pkg('Moar' => 11), + }, + { + 'A::B' => '0.2', + 'Some::Root' => '0.9', + 'Moar' => '0.11', + }, + q[Merge 'always' no_index dirs with specified no_index dirs]; + +done_testing; diff --git a/t/package_versions.t b/t/package_versions.t new file mode 100644 index 0000000..8af1be9 --- /dev/null +++ b/t/package_versions.t @@ -0,0 +1,55 @@ +use strict; +use warnings; +use Test::More 0.96; + +my $mod = 'Dist::Metadata'; +eval "require $mod" or die $@; + +{ + foreach my $test ( + [ + { + buzzwords => { + file => 'lib/buzzwords.pm', + version => '0.1', + }, + }, + { + buzzwords => '0.1', + } + ], + [ + { + fulfillment_issues => { + file => 'lib/fulfillment_issues.pm' + } + }, + { + fulfillment_issues => undef, + } + ], + [ + { + 'Design::Patterns' => { + file => 'lib/Design/Patterns.pm', + version => 0.2 + }, + 'Paradigm::Shift' => { + file => 'lib/Paradigm/Shift.pm', + version => 'v1.3.5', + } + }, + { + 'Design::Patterns' => 0.2, + 'Paradigm::Shift' => 'v1.3.5', + }, + ], + ){ + + my ($provides, $exp) = @$test; + + is_deeply($mod->package_versions($provides), $exp, 'package_versions'); + } +} + +done_testing; diff --git a/t/struct.t b/t/struct.t new file mode 100644 index 0000000..7eb265c --- /dev/null +++ b/t/struct.t @@ -0,0 +1,69 @@ +use strict; +use warnings; +use Test::More 0.96; +use Test::Fatal; +use Test::MockObject 1.09 (); +use Path::Class 0.24 qw(file dir); + +my $mod = 'Dist::Metadata::Struct'; +eval "require $mod" or die $@; + +# required_attribute +{ + my $att = 'files'; + is( $mod->required_attribute, $att, "'$att' attribute required" ); + my $ex = exception { $mod->new() }; + like( $ex, qr/'$att' parameter required/, "new dies without '$att'" ); +} + +# don't create a dependency on IO::String or IO::Scalar for this simple test. +my $io = Test::MockObject->new({}); +$io->mock(getline => sub { 'read me' }); + +# file_content +# find_files +foreach my $test ( + [ string => 'read me' ], + [ scalar_ref => \'read me' ], + [ io => $io ], +) { + my ( $type, $content ) = @$test; + my $dist = new_ok( $mod, [ files => { README => $content } ] ); + is( $dist->file_content('README'), 'read me', "content returned for $type" ); + is_deeply( [ $dist->find_files ], ['README'], 'all files listed' ); +} + +{ + my $dist = new_ok( $mod, [ files => { 'root/README' => 'please', 'root/SECRET' => 'shhhh' } ] ); + { + my $dir = $dist->physical_directory('README'); + ok( -d $dir, 'phyiscal directory exists' ); + } + my @dir_and_files = $dist->physical_directory('README'); + is(scalar @dir_and_files, 2, 'list returned'); + is($dir_and_files[1], file($dir_and_files[0], 'README'), 'full path to file'); + ok(-e $dir_and_files[1], 'extracted file exists'); +} + +# default_file_spec +# file_spec +# find_files +# determine_packages +{ + my $defspec = 'Unix'; + my $spec = 'Win32'; + my $dist = new_ok($mod, [file_spec => $spec, files => { + README => 'nevermind', + 'lib\\Mod\\Name.pm' => "package Mod::Name;\nour \$VERSION = 0.11;" + }]); + is( $dist->default_file_spec, $defspec, "struct defaults to $defspec" ); + is( $dist->file_spec, $spec, "struct has custom spec: $spec" ); + + # TODO: should paths always come out in unix format? perhaps not if you specify an alternate... + is_deeply( [sort $dist->find_files], ['README', 'lib\\Mod\\Name.pm'], 'all files listed' ); + + is_deeply( $dist->determine_packages, {'Mod::Name' => {file => 'lib/Mod/Name.pm', version => '0.11'}}, + 'determined package with translated path' ); +} + +done_testing; @@ -0,0 +1,29 @@ +use strict; +use warnings; +use Test::More 0.96; + +my $mod = 'Dist::Metadata::Tar'; +eval "require $mod" or die $@; + +my $base = 'corpus/Dist-Metadata-Test-NoMetaFile-0.1'; + +# test that instantiating this class directly does not negotiate type +new_ok($mod => [file => "$base.zip"]); + +my $file = "$base.tar.gz"; +my $tar = new_ok($mod => [file => $file]); + +# file_content, and find_files tested in t/archive.t + +# read_archive +isa_ok($tar->read_archive($file), 'Archive::Tar'); + +# tar +{ + my $warning; + local $SIG{__WARN__} = sub { $warning = $_[0] }; + isa_ok($tar->tar, 'Archive::Tar'); + like($warning, qr/deprecated/, 'tar() works but is deprecated'); +} + +done_testing; @@ -0,0 +1,21 @@ +use strict; +use warnings; +use Test::More 0.96; + +my $mod = 'Dist::Metadata::Zip'; +eval "require $mod" or die $@; + +my $base = 'corpus/Dist-Metadata-Test-NoMetaFile-0.1'; + +# test that instantiating this class directly does not negotiate type +new_ok($mod => [file => "$base.tgz"]); + +my $file = "$base.zip"; +my $zip = new_ok($mod => [file => $file]); + +# file_content, and find_files tested in t/archive.t + +# read_archive +isa_ok($zip->read_archive($file), 'Archive::Zip'); + +done_testing; |