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' ); }