10 my $proe_first_line = "#UGC:"; |
10 my $proe_first_line = "#UGC:"; |
11 my $num_empty = 69; |
11 my $num_empty = 69; |
12 my $num_non_proe = 101; |
12 my $num_non_proe = 101; |
13 my @nums_before = (0, 1, 2, 7, 13, 17, 23, 42, '0815', 4711); |
13 my @nums_before = (0, 1, 2, 7, 13, 17, 23, 42, '0815', 4711); |
14 |
14 |
15 use Test::Simple tests => 23; |
15 use Test::Simple tests => 53; |
16 #use Test::More tests => 23; |
|
17 |
16 |
18 my $files = { |
17 my $files = { |
19 |
18 |
20 in_workdir => [ map "$stem.$_", @nums_before ], |
19 in_workdir => [ map "$stem.$_", @nums_before ], |
21 in_subdir => [ map "$subdir/$stem.$_", @nums_before ], |
20 in_subdir => [ map "$subdir/$stem.$_", @nums_before ], |
22 empty => "$subdir/$stem.$num_empty", |
21 empty => "$subdir/$stem.$num_empty", |
23 non_proe => "$subdir/$stem.$num_non_proe" |
22 non_proe => "$subdir/$stem.$num_non_proe", |
|
23 errors_lst => [ map "errors.lst.$_", @nums_before ], |
|
24 trail_txt => [ map "trail.txt.$_", @nums_before ], |
|
25 info_trf => [ map "info.trf.$_", @nums_before ] |
24 |
26 |
25 }; |
27 }; |
26 |
28 |
27 sub prepare; |
29 sub prepare; |
28 |
30 |
29 prepare({ dirs => [$subdir], files => $files, proe_first_line => $proe_first_line }); |
31 prepare({ dirs => [$subdir], files => $files, proe_first_line => $proe_first_line }); |
30 ok(qx/$purge_cmd/, "Running '$purge_cmd'"); |
32 ok(qx/$purge_cmd/, "Running '$purge_cmd'"); |
31 my @iw = @{$files->{in_workdir}}; |
33 my (@absent, @present); |
32 my @is = @{$files->{in_subdir}}; |
34 @present = @{$files}{qw(empty non_proe)}; |
|
35 for (qw(in_workdir in_subdir errors_lst trail_txt info_trf)) { |
|
36 push @present, splice @{$files->{$_}}, -3, 3; |
|
37 push @absent, @{$files->{$_}}; |
|
38 } |
|
39 for (@present) { ok(-f $_, "Checking for presence of file '$_'"); } |
|
40 for (@absent) { ok(! -e $_, "Checking for absence of '$_'"); } |
33 |
41 |
34 for (@iw[$#iw-2 .. $#iw], @is[$#is-2 .. $#is], $files->{empty}, $files->{non_proe}) { ok(-f $_, "Checking for presence of file '$_'"); } |
42 for (@present, "y/abc") { unlink || warn "Can't unlink '$_': $!" if -f; } |
35 for (@iw[0 .. $#iw-3], @is[0 .. $#iw-3]) { ok(! -e $_, "Checking for absence of '$_'"); } |
|
36 |
|
37 for (@iw[$#iw-2 .. $#iw], @is[$#is-2 .. $#is], $files->{empty}, $files->{non_proe}, "y/abc") { unlink || warn "Can't unlink '$_': $!" if -f; } |
|
38 rmdir $subdir or warn "Can't rmdir '$subdir': $!"; |
43 rmdir $subdir or warn "Can't rmdir '$subdir': $!"; |
39 |
44 |
40 # $opts = { |
45 # $opts = { |
41 # dirs => ['dir1', 'dir2', ..], |
46 # dirs => ['dir1', 'dir2', ..], |
42 # files => { |
47 # files => { |
43 # in_workdir => ['file1', 'file2', ..], |
48 # in_workdir => ['file1', 'file2', ..], |
44 # in_subdir => ['path1', 'path2', ..], |
49 # in_subdir => ['path1', 'path2', ..], |
45 # empty => 'path_to_an_empty_file', |
50 # empty => 'path_to_an_empty_file', |
46 # non_proe => 'path_to_a_nonempty_nonproe_file' |
51 # non_proe => 'path_to_a_nonempty_nonproe_file' |
|
52 # errors_lst => [ 'errors.lst.n1', 'errors.lst.n2', ..], |
|
53 # trail_txt => [ 'trail.txt.n1', 'trail.txt.n2', ..], |
|
54 # info_trf => [ 'info.trf.n1', 'info.trf.n2', ..] |
47 # }, |
55 # }, |
48 # proe_first_line => 'something that should appear in the first line of a file to match' |
56 # proe_first_line => 'something that should appear in the first line of a file to match' |
49 # } |
57 # } |
50 sub prepare { |
58 sub prepare { |
51 |
59 |
52 my ($opts) = @_; |
60 my ($opts) = @_; |
53 |
61 |
54 for (@{$opts->{dirs}}) { mkdir $_ or warn "Can't mkdir '$_': $!"; } |
62 for (@{$opts->{dirs}}) { mkdir $_ or warn "Can't mkdir '$_': $!"; } |
55 |
63 |
56 for (@{$opts->{files}->{in_workdir}}, @{$opts->{files}->{in_subdir}}) { |
64 for (map { @{$_} } @{$opts->{files}}{qw(in_workdir in_subdir errors_lst trail_txt info_trf)}) { |
57 |
65 |
58 open F, '>', $_ or warn "Can't open F, '>', '$_': $!"; |
66 open F, '>', $_ or warn "Can't open F, '>', '$_': $!"; |
59 print F $proe_first_line; |
67 print F $proe_first_line; |
60 close F; |
68 close F; |
61 |
69 |
62 } |
70 } |
63 |
71 |
64 my $empty = $opts->{files}->{empty}; |
72 my $empty = $opts->{files}->{empty}; |
65 open F, '>', $empty or warn "Can't open F, '>', '$empty': $!"; |
73 open F, '>', $empty or warn "Can't open F, '>', '$empty': $!"; |
66 close F; |
74 close F; |