Akron | 150b29e | 2016-02-14 23:06:48 +0100 | [diff] [blame] | 1 | #!/usr/bin/env perl |
| 2 | use strict; |
| 3 | use warnings; |
Akron | 31a08cb | 2019-02-20 20:43:26 +0100 | [diff] [blame] | 4 | use Data::Dumper; |
Akron | 150b29e | 2016-02-14 23:06:48 +0100 | [diff] [blame] | 5 | use Test::More; |
| 6 | use File::Basename 'dirname'; |
| 7 | use File::Spec::Functions qw/catfile catdir/; |
| 8 | use File::Temp qw/tempdir/; |
Akron | a351837 | 2024-01-22 23:29:00 +0100 | [diff] [blame^] | 9 | use Test::Output qw/:stdout :stderr :functions/; |
Akron | 150b29e | 2016-02-14 23:06:48 +0100 | [diff] [blame] | 10 | |
Nils Diewald | b3e9ccd | 2016-10-24 15:16:52 +0200 | [diff] [blame] | 11 | use KorAP::XML::Archive; |
Akron | 150b29e | 2016-02-14 23:06:48 +0100 | [diff] [blame] | 12 | |
| 13 | my $file = catfile(dirname(__FILE__), 'corpus','archive.zip'); |
| 14 | my $archive = KorAP::XML::Archive->new($file); |
| 15 | |
| 16 | unless ($archive->test_unzip) { |
| 17 | plan skip_all => 'unzip not found'; |
| 18 | }; |
| 19 | |
| 20 | ok($archive->test, 'Test archive'); |
Akron | 08385f6 | 2016-03-22 20:37:04 +0100 | [diff] [blame] | 21 | like($archive->path(0), qr/archive\.zip$/, 'Archive path'); |
Akron | 150b29e | 2016-02-14 23:06:48 +0100 | [diff] [blame] | 22 | |
Akron | 2080758 | 2016-10-26 17:11:34 +0200 | [diff] [blame] | 23 | ok($archive->check_prefix, 'Archive has dot prefix'); |
| 24 | |
Akron | 150b29e | 2016-02-14 23:06:48 +0100 | [diff] [blame] | 25 | my @list = $archive->list_texts; |
| 26 | is(scalar @list, 10, 'Found all tests'); |
| 27 | is($list[0], './TEST/BSP/1', 'First document'); |
Akron | e8adfcc | 2016-03-22 13:18:26 +0100 | [diff] [blame] | 28 | is($list[-1], './TEST/BSP/10', 'First document'); |
Akron | 150b29e | 2016-02-14 23:06:48 +0100 | [diff] [blame] | 29 | |
| 30 | my @path = $archive->split_path('./TEST/BSP/9'); |
| 31 | is($path[0],'.', 'Prefix'); |
| 32 | is($path[1],'TEST', 'Prefix'); |
| 33 | is($path[2],'BSP', 'Prefix'); |
| 34 | is($path[3],'9', 'Prefix'); |
| 35 | |
| 36 | my $dir = tempdir(CLEANUP => 1); |
| 37 | |
| 38 | { |
| 39 | local $SIG{__WARN__} = sub {}; |
Akron | a351837 | 2024-01-22 23:29:00 +0100 | [diff] [blame^] | 40 | my $stdout = stdout_from( |
| 41 | sub { |
| 42 | ok($archive->extract_sigle(0, ['TEST/BSP/8'], $dir), 'Wrong path'); |
| 43 | } |
| 44 | ); |
| 45 | like($stdout, qr!Extract unzip!); |
Akron | 150b29e | 2016-02-14 23:06:48 +0100 | [diff] [blame] | 46 | }; |
| 47 | |
| 48 | ok(-d catdir($dir, 'TEST'), 'Test corpus directory exists'); |
| 49 | ok(-f catdir($dir, 'TEST', 'header.xml'), 'Test corpus header exists'); |
| 50 | ok(-d catdir($dir, 'TEST', 'BSP'), 'Test doc directory exists'); |
| 51 | ok(-f catdir($dir, 'TEST', 'BSP', 'header.xml'), 'Test doc header exists'); |
| 52 | |
Akron | 2080758 | 2016-10-26 17:11:34 +0200 | [diff] [blame] | 53 | $file = catfile(dirname(__FILE__), 'corpus','archive_rei.zip'); |
| 54 | $archive = KorAP::XML::Archive->new($file); |
| 55 | ok(!$archive->check_prefix, 'Archive has no prefix'); |
| 56 | |
Akron | 60a8caa | 2017-02-17 21:51:27 +0100 | [diff] [blame] | 57 | # No leading '.' |
| 58 | $file = catfile(dirname(__FILE__), 'corpus','archive_rei.zip'); |
| 59 | $archive = KorAP::XML::Archive->new($file); |
| 60 | ok(!$archive->check_prefix, 'Archive has no dot prefix'); |
Akron | 08385f6 | 2016-03-22 20:37:04 +0100 | [diff] [blame] | 61 | |
Akron | 31a08cb | 2019-02-20 20:43:26 +0100 | [diff] [blame] | 62 | my @cmd = map { join ' ', @{$_} } $archive->cmds_from_sigle(['REI/RB*', 'REI/BNG/00071']); |
| 63 | |
| 64 | like($cmd[0], qr!unzip -qo -uo t/corpus/archive_rei\.zip!); |
| 65 | like($cmd[0], qr!\QREI/header.xml REI/RB*/header.xml REI/RB* REI/BNG/header.xml REI/BNG/00071/*\E!); |
| 66 | ok(!$cmd[1]); |
| 67 | |
| 68 | # New temporary directory |
| 69 | $dir = tempdir(CLEANUP => 1); |
| 70 | |
| 71 | { |
| 72 | local $SIG{__WARN__} = sub {}; |
Akron | a351837 | 2024-01-22 23:29:00 +0100 | [diff] [blame^] | 73 | my $stdout = stdout_from( |
| 74 | sub { |
| 75 | ok($archive->extract_sigle(1, ['REI/RB*', 'REI/BNG/00071'], $dir), 'Fine'); |
| 76 | } |
| 77 | ); |
| 78 | is($stdout, ''); |
Akron | 31a08cb | 2019-02-20 20:43:26 +0100 | [diff] [blame] | 79 | }; |
| 80 | |
Akron | a351837 | 2024-01-22 23:29:00 +0100 | [diff] [blame^] | 81 | |
Akron | 31a08cb | 2019-02-20 20:43:26 +0100 | [diff] [blame] | 82 | ok(-d catdir($dir, 'REI'), 'Test corpus directory exists'); |
| 83 | ok(-d catdir($dir, 'REI','BNG'), 'Test corpus directory exists'); |
| 84 | ok(-d catdir($dir, 'REI','BNG','00071'), 'Test corpus directory exists'); |
| 85 | |
| 86 | ok(-f catdir($dir, 'REI', 'header.xml'), 'Test corpus directory exists'); |
| 87 | ok(-f catdir($dir, 'REI','BNG', 'header.xml'), 'Test corpus directory exists'); |
| 88 | ok(-f catdir($dir, 'REI','BNG','00071', 'header.xml'), 'Test corpus directory exists'); |
| 89 | |
| 90 | ok(-f catdir($dir, 'REI','RBR', 'header.xml'), 'Test corpus directory exists'); |
| 91 | ok(-f catdir($dir, 'REI','RBR','00610', 'header.xml'), 'Test corpus directory exists'); |
| 92 | ok(-f catdir($dir, 'REI','RBR','00610', 'header.xml'), 'Test corpus directory exists'); |
| 93 | |
| 94 | ok(!-e catdir($dir, 'REI','BNG','00128'), 'Test corpus directory does not exist'); |
| 95 | |
| 96 | |
Akron | 150b29e | 2016-02-14 23:06:48 +0100 | [diff] [blame] | 97 | done_testing; |
| 98 | |
| 99 | __END__ |