1#!/usr/bin/perl
2#
3# Script to run a QIF file.
4
5use strict;
6use warnings;
7
8use File::Compare qw(compare);
9use File::Copy qw(copy);
10use File::Path qw(remove_tree);
11use File::Spec::Functions qw(catfile);
12use Getopt::Long qw(GetOptions);
13
14my $cleanup = 1;
15
16GetOptions(
17    "aggressive=i"      => \my $aggressive,
18    "table-size=i"      => \my $table_size,
19    "immed-ack=i"       => \my $immed_ack,
20    "risked-streams=i"  => \my $risked_streams,
21    "no-cleanup"        => sub { $cleanup = 0 },
22);
23
24# To reduce the number of tests from doubling, check HTTP/1.x mode in some
25# input, but not others.  The value of this setting is easy to determine.
26my $http1x = ($aggressive + $table_size + $immed_ack + $risked_streams) & 1;
27
28my $dir = catfile(($ENV{TMP} || $ENV{TEMP} || "/tmp"),
29                                                "run-qif-out-" . rand . $$);
30mkdir $dir or die "cannot create temp directory $dir";
31if (!$cleanup)
32{
33    print "created temp directory: $dir\n";
34}
35
36END {
37    if (defined($dir) && $cleanup) {
38        remove_tree($dir);
39    }
40}
41
42my $encode_log = catfile($dir, "encode.log");
43my $qif_file = catfile($dir, "qif");
44my $bin_file = catfile($dir, "out");
45my $resulting_qif_file = catfile($dir, "qif-result");
46
47my ($encode_args, $decode_args) = ('', '');
48if ($aggressive) {
49    $encode_args="$encode_args -A";
50}
51
52if ($immed_ack) {
53    $encode_args="$encode_args -a 1";
54}
55
56if (defined $risked_streams) {
57    $encode_args = "$encode_args -s $risked_streams";
58    $decode_args = "$decode_args -s $risked_streams";
59}
60
61if (defined $table_size) {
62    $encode_args = "$encode_args -t $table_size";
63    $decode_args = "$decode_args -t $table_size";
64}
65
66copy($ARGV[0], $qif_file) or die "cannot copy original $ARGV[0] to $qif_file";
67
68if ($^O eq 'MSWin32') {
69    system('interop-encode', $encode_args, '-i', $qif_file, '-o', $bin_file)
70        and die "interop-encode failed";
71    system('interop-decode', $decode_args, '-m', '1', '-i', $bin_file, '-o', $resulting_qif_file, '-H', $http1x)
72        and die "interop-decode failed";
73} else {
74    system("interop-encode $encode_args -i $qif_file -o $bin_file")
75        and die "interop-encode failed";
76    system("interop-decode $decode_args -m 1 -i $bin_file -o $resulting_qif_file -H $http1x")
77        and die "interop-decode failed";
78}
79
80sub sort_qif {
81    no warnings 'uninitialized';
82    my ($in, $out) = @_;
83    local $/ = "\n\n";
84    open F, $in or die "cannot open $in for reading: $!";
85    my @chunks = map $$_[1],
86		 sort { $$a[0] <=> $$b[0] }
87		 map { /^#\s*stream\s+(\d+)/; [ $1, $_ ] }
88		 <F>;
89    close F;
90    for (@chunks) {
91        s/^#.*\n//mg;
92    }
93    open F, ">", $out or die "cannot open $out for writing: $!";
94    print F @chunks;
95    close F;
96}
97
98sort_qif($qif_file, "$qif_file.canonical");
99sort_qif($resulting_qif_file, "$resulting_qif_file.canonical");
100
101exit compare "$qif_file.canonical", "$resulting_qif_file.canonical";
102