1 #!/usr/bin/perl |
|
2 |
|
3 use strict; |
|
4 use warnings; |
|
5 |
|
6 my $purge_cmd = "./purge-proe"; |
|
7 |
|
8 my $stem = "a"; |
|
9 my $subdir = "x"; |
|
10 my $proe_first_line = "#UGC:"; |
|
11 my $num_empty = 69; |
|
12 my $num_non_proe = 101; |
|
13 my @nums_before = (0, 1, 2, 7, 13, 17, 23, 42, '0815', 4711); |
|
14 |
|
15 use Test::Simple tests => 53; |
|
16 |
|
17 my $files = { |
|
18 |
|
19 in_workdir => [ map "$stem.$_", @nums_before ], |
|
20 in_subdir => [ map "$subdir/$stem.$_", @nums_before ], |
|
21 empty => "$subdir/$stem.$num_empty", |
|
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 ] |
|
26 |
|
27 }; |
|
28 |
|
29 sub prepare; |
|
30 |
|
31 prepare({ dirs => [$subdir], files => $files, proe_first_line => $proe_first_line }); |
|
32 ok(qx/$purge_cmd/, "Running '$purge_cmd'"); |
|
33 my (@absent, @present); |
|
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 '$_'"); } |
|
41 |
|
42 for (@present, "y/abc") { unlink || warn "Can't unlink '$_': $!" if -f; } |
|
43 rmdir $subdir or warn "Can't rmdir '$subdir': $!"; |
|
44 |
|
45 # $opts = { |
|
46 # dirs => ['dir1', 'dir2', ..], |
|
47 # files => { |
|
48 # in_workdir => ['file1', 'file2', ..], |
|
49 # in_subdir => ['path1', 'path2', ..], |
|
50 # empty => 'path_to_an_empty_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', ..] |
|
55 # }, |
|
56 # proe_first_line => 'something that should appear in the first line of a file to match' |
|
57 # } |
|
58 sub prepare { |
|
59 |
|
60 my ($opts) = @_; |
|
61 |
|
62 for (@{$opts->{dirs}}) { mkdir $_ or warn "Can't mkdir '$_': $!"; } |
|
63 |
|
64 for (map { @{$_} } @{$opts->{files}}{qw(in_workdir in_subdir errors_lst trail_txt info_trf)}) { |
|
65 |
|
66 open F, '>', $_ or warn "Can't open F, '>', '$_': $!"; |
|
67 print F $proe_first_line; |
|
68 close F; |
|
69 |
|
70 } |
|
71 |
|
72 my $empty = $opts->{files}->{empty}; |
|
73 open F, '>', $empty or warn "Can't open F, '>', '$empty': $!"; |
|
74 close F; |
|
75 |
|
76 my $non_proe = $opts->{files}->{non_proe}; |
|
77 open F, '>', $non_proe or warn "Can't open F, '>', '$non_proe': $!"; |
|
78 print F "foo"; |
|
79 close F; |
|
80 |
|
81 } |
|