Commit | Line | Data |
---|---|---|
ea49d0e1 PH |
1 | # This is a little perl script that adjusts the "received" time in a -H file, |
2 | # so that retry timeouts etc can be more easily tested. Its arguments are: | |
3 | # | |
4 | # (1) The number of the message on the queue whose time is to be adjusted; 1 | |
5 | # for the first message, 2 for the second, etc. | |
6 | # | |
7 | # (2) A positive or negative number by which to adjust the received time. | |
8 | ||
9 | $fileno = $ARGV[0] - 1; | |
10 | $adjust = $ARGV[1]; | |
11 | ||
12 | opendir(DIR, "spool/input"); | |
13 | while (($_ = readdir(DIR))) { push(@files, $_) if /.*-H$/; } | |
14 | closedir(DIR); | |
15 | ||
16 | @files = sort @files; | |
17 | ||
18 | open(IN, "spool/input/$files[$fileno]") || | |
19 | die "can't open spool/input/$files[$fileno]"; | |
20 | ||
21 | open(OUT, ">test-H"); | |
22 | ||
23 | $_ = <IN>; print OUT; | |
24 | $_ = <IN>; print OUT; | |
25 | $_ = <IN>; print OUT; | |
26 | $_ = <IN>; | |
27 | ($rtime,$rest) = $_ =~ /^(\d+)(.*)/; | |
28 | $rtime += $adjust; | |
29 | print OUT "$rtime$rest\n"; | |
30 | print OUT while (<IN>); | |
31 | ||
32 | close(IN); | |
33 | close(OUT); | |
34 | ||
35 | rename("test-H", "spool/input/$files[$fileno]") || die "rename failed\n"; | |
36 | ||
37 | exit(0); | |
38 | ||
39 | # End |