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);
use IPC::Open3;
use IO::Pipe;

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,
    '--report-memory-usage' => '',
    );

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
{
    warn "
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)
  --test regexp       run only tests that match specified pattern

Populate $test_dir with files you want to use for performance
benchmarking. PDF files and qpdf JSON files are allowed. The qpdf
release process uses a clone of
https://github.com/qpdf/performance-test-files for this purpose.

Tests:
";
    foreach my $t (@tests)
    {
        warn "  $t->[0]\n";
    }
    exit 2;
}

my $test_re = undef;
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);
    }
    elsif ('--test' eq $arg)
    {
        usage() unless @ARGV;
        $test_re = 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 test directory: $!

Configured test directory: $test_dir

Populate $test_dir with a clone of the
qpdf/performance-test-files github repository.
Run $whoami --help for details.

Repository URL: https://github.com/qpdf/performance-test-files

";
        my @entries = readdir(D);
        closedir(D);
        for (sort @entries)
        {
            my $file = "$test_dir/$_";
            if (-f $file && $file =~ m/.(pdf|json)$/i)
            {
                push(@tmp, $file);
            }
        }
    }
    foreach my $i (@tmp)
    {
        if ($i =~ m/.json$/)
        {
            push(@json_test_files, $i);
        }
        else
        {
            push(@test_files, $i);
        }
    }
}

my $report_mem = filter_args(["--report-memory-usage"]);
{
    my ($r, $mem) = run_cmd($executable, @$report_mem,
                            "--empty", File::Spec->devnull());
    if ($r != 0)
    {
        die "$whoami: $executable doesn't seem to work\n";
    }
    if ($mem == 0)
    {
        print "** Note: memory information is not available **\n";
    }
}

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";
    print "Format: time-in-seconds  RAM-in-MiB  filename\n";
    make_path($workdir);
    foreach my $test (@tests)
    {
        my ($name, $args) = @$test;
        if ((defined $test_re) && $name !~ m/$test_re/)
        {
            print " skipping test $name\n";
            next;
        }
        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, @$report_mem, $file, "$workdir/$outfile");
    # Run once and discard to update caches
    system("sync");
    run_cmd(@cmd);
    my $i = 0;
    my $total = 0;
    my $max_mem = 0;
    while ($i < $iterations)
    {
        my $start = [gettimeofday];
        my ($r, $mem) = run_cmd(@cmd);
        if ($r == 2)
        {
            # interrupt
            exit(2);
        }
        my $end = [gettimeofday];
        if ($r != 0)
        {
            print "  command failed; ignoring results\n";
            return undef;
        }
        $max_mem = $mem > $max_mem ? $mem : $max_mem;
        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("%8.4f  %8.4f", $total / $i, $max_mem / 1048576);
}

sub run_cmd
{
    my @cmd = @_;
    my $pipe = IO::Pipe->new();
    my $pid = open3(my $child_in, '>&STDOUT', $pipe->writer(), @cmd);
    $child_in->close();
    waitpid($pid, 0);
    my $r = $?;
    my $mem = 0;
    while (<$pipe>)
    {
        if (m/qpdf-max-memory-usage (\d+)/)
        {
            $mem = $1;
        }
        else
        {
            warn $_;
        }
    }
    ($r, $mem);
}