qpdf/performance_check

#!/usr/bin/env perl
require 5.008;
use warnings;
use strict;
use File::Basename;
use Time::HiRes qw(gettimeofday tv_interval);
use File::Path qw(make_path);

my $whoami = basename($0);
$| = 1;

# [ name, [ args ] ]
my @tests = (
    ['no arguments', []],
    ['generate object streams', ['--object-streams=generate']],
    ['disable object streams', ['--object-streams=disable']],
    ['split pages', ['--split-pages', '--remove-unreferenced-resources=no']],
    ['shared resource check', ['--split-pages', '--remove-unreferenced-resources=auto']],
    ['linearize', ['--linearize']],
    ['encrypt', ['--encrypt', 'u', 'o', '256', '--']],
    ['json-output', ['--json-output']],
    ['json-input', ['--json-input']],
    );

# If arg is not found in help output, look here. If not here, skip test.
# { new => old } -- if new is not found, replace with old; if old is
#                   if old is empty, remove argument
my %arg_compat = (
    '--remove-unreferenced-resources=no' => '--preserve-unreferenced-resources',
    '--remove-unreferenced-resources=yes' => '',
    '--remove-unreferenced-resources=auto' => undef,
    );

my $executable = undef;
my $test_dir = undef;
my $test_file = undef;
my $workdir = undef;
my $maxtime = undef;
my $iterations = undef;

my $default_executable = 'build/qpdf/qpdf';
my $default_test_dir = '../performance-test-files';
my $default_test_file = undef;
my $default_workdir = 'build/perf';
my $default_maxtime = 20;
my $default_iterations = 20;

sub usage
{
    die "
Usage: $whoami [ args ]
  --dir dir           test on all files in dir (default: $default_test_dir)
  --file file         test only on the named file
  --executable qpdf   use the specified qpdf (default: $default_executable)
  --workdir           where to write output pdfs (default: $default_workdir)
  --maxtime           maximum time for a test; 0 means unlimited (default: $default_maxtime)
  --iterations        number of iterations (default: $default_iterations)
";
}

while (@ARGV)
{
    my $arg = shift(@ARGV);
    if ('--dir' eq $arg)
    {
        usage() unless @ARGV;
        $test_dir = shift(@ARGV);
        $test_file = undef;
    }
    elsif ('--file' eq $arg)
    {
        usage() unless @ARGV;
        $test_file = shift(@ARGV);
        $test_dir = undef;
    }
    elsif ('--executable' eq $arg)
    {
        usage() unless @ARGV;
        $executable = shift(@ARGV);
    }
    elsif ('--workdir' eq $arg)
    {
        usage() unless @ARGV;
        $workdir = shift(@ARGV);
    }
    elsif ('--maxtime' eq $arg)
    {
        usage() unless @ARGV;
        $maxtime = shift(@ARGV);
    }
    elsif ('--iterations' eq $arg)
    {
        usage() unless @ARGV;
        $iterations = shift(@ARGV);
    }
    else
    {
        usage();
    }
}

if ((! defined $test_dir) && (! defined $test_file))
{
    $test_dir = $default_test_dir;
}
if (! defined $executable)
{
    $executable = $default_executable;
}
if (! defined $workdir)
{
    $workdir = $default_workdir;
}
if (! defined $maxtime)
{
    $maxtime = $default_maxtime;
}
if (! defined $iterations)
{
    $iterations = $default_iterations;
}

my @test_files = ();
my @json_test_files = ();
{ # private scope
    my @tmp = ();
    if (defined $test_file)
    {
        push(@tmp, $test_file);
    }
    else
    {
        opendir(D, $test_dir) or
            die "$whoami: can't open directory $test_dir: $!\n";
        my @entries = readdir(D);
        closedir(D);
        for (sort @entries)
        {
            push(@tmp, "$test_dir/$_") unless (('.' eq $_) || ('..' eq $_));
        }
    }
    foreach my $i (@tmp)
    {
        if ($i =~ m/.json$/)
        {
            push(@json_test_files, $i);
        }
        else
        {
            push(@test_files, $i);
        }
    }
}

run_tests();
print "\n";

sub filter_args
{
    my $args = shift;
    my $help = `$executable --help=all`;
    my $new_args = [];
    foreach my $arg (@$args)
    {
        my $to_check = $arg;
        $to_check =~ s/=.*$//;
        if (index($help, $to_check) == -1)
        {
            my $new_arg = $arg_compat{$arg};
            if (! defined $new_arg)
            {
                return undef;
            }
            if ($new_arg ne '')
            {
                print "  replacing $arg with $new_arg\n";
                push(@$new_args, $new_arg);
            }
        }
        else
        {
            push(@$new_args, $arg);
        }
    }
    $new_args;
}

sub run_tests
{
    my $args = shift;

    chomp(my $commit = `git describe @`);
    print "commit: $commit\n";
    make_path($workdir);
    foreach my $test (@tests)
    {
        my ($name, $args) = @$test;
        print " test: $name\n";
        $args = filter_args($args);
        if (! defined $args)
        {
            print "  skipping (unknown arguments)\n";
            next;
        }
        my $test_files = \@test_files;
        foreach my $arg (@$args)
        {
            if ($arg eq '--json-input')
            {
                $test_files = \@json_test_files;
                last;
            }
        }
        foreach my $file (@$test_files)
        {
            my $time = run_test($file, $args);
            if (defined $time)
            {
                print "  $time  " . basename($file) ."\n";
            }
            else
            {
                print "   $file skipped\n";
            }
        }
    }
}

sub run_test
{
    my ($file, $args) = @_;

    my $outfile = "out.pdf";
    foreach my $arg (@$args)
    {
        if ($arg eq '--json-output')
        {
            $outfile = "out.json";
            last;
        }
    }
    my @cmd = ($executable, @$args, $file, "$workdir/$outfile");
    # Run once and discard to update caches
    system("sync");
    system(@cmd);
    my $i = 0;
    my $total = 0;
    while ($i < $iterations)
    {
        my $start = [gettimeofday];
        my $r = system(@cmd);
        if ($r == 2)
        {
            # interrupt
            exit(2);
        }
        my $end = [gettimeofday];
        if ($r != 0)
        {
            print "  command failed; ignoring results\n";
            return undef;
        }
        my $elapsed = tv_interval($start, $end);
        $total += $elapsed;
        ++$i;
        if (($maxtime > 0) && ($total >= $maxtime) && ($i >= 3))
        {
            # This is taking too long, so take what we have
            last;
        }
    }
    return sprintf("%0.4f", $total / $i);
}