1use strict;
2use warnings;
3use Test::More 0.96;
4use Test::Fatal;
5
6my $mod = 'Dist::Metadata::Archive';
7eval "require $mod" or die $@;
8
9# default_file_spec
10is( $mod->default_file_spec, 'Unix', 'most archive files use unix paths' );
11
12test_constructor_errors($mod);
13
14# test file type determination
15my $base = 'corpus/Dist-Metadata-Test-NoMetaFile-0.1';
16foreach my $test (
17  [Zip => "$base.zip"],
18  [Tar => "$base.tar.gz"],
19){
20  my ($type, $file) = @$test;
21
22  my $distclass = "Dist::Metadata::$type";
23
24  # instantiate using base 'Archive' class which will determine subclass
25  my $archive = new_ok($mod => [file => $file]);
26
27  isa_ok($archive, $distclass);
28  isa_ok($archive->archive, "Archive::$type");
29
30  # file
31  is($archive->file, $file, 'dumb accessor works');
32
33  # determine_name_and_version
34  $archive->determine_name_and_version();
35  is($archive->name, 'Dist-Metadata-Test-NoMetaFile', 'name from file');
36  is($archive->version, '0.1', 'version from file');
37
38  # file_content
39  is(
40    $archive->file_content('README'),
41    qq[This "dist" is for testing Dist::Metadata.\n],
42    'got file content without specifying root dir'
43  );
44
45  # perllocale says, "By default Perl ignores the current locale."
46
47  # find_files
48  is_deeply(
49    [sort $archive->find_files],
50    [qw(
51      Dist-Metadata-Test-NoMetaFile-0.1/README
52      Dist-Metadata-Test-NoMetaFile-0.1/lib/Dist/Metadata/Test/NoMetaFile.pm
53      Dist-Metadata-Test-NoMetaFile-0.1/lib/Dist/Metadata/Test/NoMetaFile/PM.pm
54    )],
55    'find_files'
56  );
57
58  # list_files (no root)
59  is_deeply(
60    [sort $archive->list_files],
61    [qw(
62      README
63      lib/Dist/Metadata/Test/NoMetaFile.pm
64      lib/Dist/Metadata/Test/NoMetaFile/PM.pm
65    )],
66    'files listed without root directory'
67  );
68
69  # root
70  is($archive->root, 'Dist-Metadata-Test-NoMetaFile-0.1', 'root dir');
71
72  # do this last so that successful new() has already loaded the distclass
73  test_constructor_errors($distclass);
74}
75
76done_testing;
77
78# required_attribute
79# file doesn't exist
80sub test_constructor_errors {
81  my $mod = shift;
82
83  my $att = 'file';
84  is( $mod->required_attribute, $att, "'$att' attribute required" );
85  my $ex = exception { $mod->new() };
86  like($ex, qr/'$att' parameter required/, "new dies without '$att'");
87
88  my $dist = new_ok( $mod, [ file => 'does-not._exist_' ] );
89  $ex = exception { $dist->archive };
90  like($ex, qr/does not exist/, 'file does not exist');
91}
92