The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
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'
  );

}