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