1205a2804SDmitri Tikhonov#!/usr/bin/perl
2205a2804SDmitri Tikhonov#
3205a2804SDmitri Tikhonov# Script to run a QIF file.
4205a2804SDmitri Tikhonov
5205a2804SDmitri Tikhonovuse strict;
6205a2804SDmitri Tikhonovuse warnings;
7205a2804SDmitri Tikhonov
8205a2804SDmitri Tikhonovuse File::Compare qw(compare);
9205a2804SDmitri Tikhonovuse File::Copy qw(copy);
10205a2804SDmitri Tikhonovuse File::Path qw(remove_tree);
11205a2804SDmitri Tikhonovuse File::Spec::Functions qw(catfile);
12205a2804SDmitri Tikhonovuse Getopt::Long qw(GetOptions);
13205a2804SDmitri Tikhonov
14205a2804SDmitri Tikhonovmy $cleanup = 1;
15205a2804SDmitri Tikhonov
16205a2804SDmitri TikhonovGetOptions(
17205a2804SDmitri Tikhonov    "aggressive=i"      => \my $aggressive,
18205a2804SDmitri Tikhonov    "table-size=i"      => \my $table_size,
19205a2804SDmitri Tikhonov    "immed-ack=i"       => \my $immed_ack,
20205a2804SDmitri Tikhonov    "risked-streams=i"  => \my $risked_streams,
21205a2804SDmitri Tikhonov    "no-cleanup"        => sub { $cleanup = 0 },
22205a2804SDmitri Tikhonov);
23205a2804SDmitri Tikhonov
2460620859SDmitri Tikhonov# To reduce the number of tests from doubling, check HTTP/1.x mode in some
2560620859SDmitri Tikhonov# input, but not others.  The value of this setting is easy to determine.
2660620859SDmitri Tikhonovmy $http1x = ($aggressive + $table_size + $immed_ack + $risked_streams) & 1;
2760620859SDmitri Tikhonov
28205a2804SDmitri Tikhonovmy $dir = catfile(($ENV{TMP} || $ENV{TEMP} || "/tmp"),
29205a2804SDmitri Tikhonov                                                "run-qif-out-" . rand . $$);
30205a2804SDmitri Tikhonovmkdir $dir or die "cannot create temp directory $dir";
31205a2804SDmitri Tikhonovif (!$cleanup)
32205a2804SDmitri Tikhonov{
33205a2804SDmitri Tikhonov    print "created temp directory: $dir\n";
34205a2804SDmitri Tikhonov}
35205a2804SDmitri Tikhonov
36205a2804SDmitri TikhonovEND {
37205a2804SDmitri Tikhonov    if (defined($dir) && $cleanup) {
38205a2804SDmitri Tikhonov        remove_tree($dir);
39205a2804SDmitri Tikhonov    }
40205a2804SDmitri Tikhonov}
41205a2804SDmitri Tikhonov
42205a2804SDmitri Tikhonovmy $encode_log = catfile($dir, "encode.log");
43205a2804SDmitri Tikhonovmy $qif_file = catfile($dir, "qif");
44205a2804SDmitri Tikhonovmy $bin_file = catfile($dir, "out");
45205a2804SDmitri Tikhonovmy $resulting_qif_file = catfile($dir, "qif-result");
46205a2804SDmitri Tikhonov
47205a2804SDmitri Tikhonovmy ($encode_args, $decode_args) = ('', '');
48205a2804SDmitri Tikhonovif ($aggressive) {
49205a2804SDmitri Tikhonov    $encode_args="$encode_args -A";
50205a2804SDmitri Tikhonov}
51205a2804SDmitri Tikhonov
52205a2804SDmitri Tikhonovif ($immed_ack) {
53205a2804SDmitri Tikhonov    $encode_args="$encode_args -a 1";
54205a2804SDmitri Tikhonov}
55205a2804SDmitri Tikhonov
56205a2804SDmitri Tikhonovif (defined $risked_streams) {
57205a2804SDmitri Tikhonov    $encode_args = "$encode_args -s $risked_streams";
58205a2804SDmitri Tikhonov    $decode_args = "$decode_args -s $risked_streams";
59205a2804SDmitri Tikhonov}
60205a2804SDmitri Tikhonov
61205a2804SDmitri Tikhonovif (defined $table_size) {
62205a2804SDmitri Tikhonov    $encode_args = "$encode_args -t $table_size";
63205a2804SDmitri Tikhonov    $decode_args = "$decode_args -t $table_size";
64205a2804SDmitri Tikhonov}
65205a2804SDmitri Tikhonov
66205a2804SDmitri Tikhonovcopy($ARGV[0], $qif_file) or die "cannot copy original $ARGV[0] to $qif_file";
67205a2804SDmitri Tikhonov
68205a2804SDmitri Tikhonovif ($^O eq 'MSWin32') {
69630d1f2aSDmitri Tikhonov    system('interop-encode', $encode_args, '-i', $qif_file, '-o', $bin_file)
70205a2804SDmitri Tikhonov        and die "interop-encode failed";
7160620859SDmitri Tikhonov    system('interop-decode', $decode_args, '-m', '1', '-i', $bin_file, '-o', $resulting_qif_file, '-H', $http1x)
72205a2804SDmitri Tikhonov        and die "interop-decode failed";
73205a2804SDmitri Tikhonov} else {
74205a2804SDmitri Tikhonov    system("interop-encode $encode_args -i $qif_file -o $bin_file")
75205a2804SDmitri Tikhonov        and die "interop-encode failed";
7660620859SDmitri Tikhonov    system("interop-decode $decode_args -m 1 -i $bin_file -o $resulting_qif_file -H $http1x")
77205a2804SDmitri Tikhonov        and die "interop-decode failed";
78205a2804SDmitri Tikhonov}
79205a2804SDmitri Tikhonov
80205a2804SDmitri Tikhonovsub sort_qif {
81205a2804SDmitri Tikhonov    no warnings 'uninitialized';
82205a2804SDmitri Tikhonov    my ($in, $out) = @_;
83205a2804SDmitri Tikhonov    local $/ = "\n\n";
84205a2804SDmitri Tikhonov    open F, $in or die "cannot open $in for reading: $!";
85205a2804SDmitri Tikhonov    my @chunks = map $$_[1],
86205a2804SDmitri Tikhonov		 sort { $$a[0] <=> $$b[0] }
87205a2804SDmitri Tikhonov		 map { /^#\s*stream\s+(\d+)/; [ $1, $_ ] }
88205a2804SDmitri Tikhonov		 <F>;
89205a2804SDmitri Tikhonov    close F;
90205a2804SDmitri Tikhonov    for (@chunks) {
91205a2804SDmitri Tikhonov        s/^#.*\n//mg;
92205a2804SDmitri Tikhonov    }
93205a2804SDmitri Tikhonov    open F, ">", $out or die "cannot open $out for writing: $!";
94205a2804SDmitri Tikhonov    print F @chunks;
95205a2804SDmitri Tikhonov    close F;
96205a2804SDmitri Tikhonov}
97205a2804SDmitri Tikhonov
98205a2804SDmitri Tikhonovsort_qif($qif_file, "$qif_file.canonical");
99205a2804SDmitri Tikhonovsort_qif($resulting_qif_file, "$resulting_qif_file.canonical");
100205a2804SDmitri Tikhonov
101205a2804SDmitri Tikhonovexit compare "$qif_file.canonical", "$resulting_qif_file.canonical";
102