summaryrefslogtreecommitdiff
path: root/Build/tests/checkpdf.pl
blob: 6096667dcda1879812748ed8d17301aa0009ee46 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
#!/usr/local/bin/perl
# pdfcheck -- PDF autotest helper.
# $Id: //depot/Master/support/tests/checkpdf.pl#2 $
# 
# Public domain.  Originaly written 2004, Karl Berry.
# 
# (Although it's much simpler and more functional in sh, Perl makes it
# possible to run on Windows, for TeX Live, etc.  I hope someone cares
# some day.)

exit (&main ());

sub main
{
  if (@ARGV != 2) {
    print <<END_USAGE;
Usage: $0 PPZ_KNOWN_GOOD PDF_TO_CHECK

Run pdftoppm on PDF_TO_CHECK, and compare against PPZ_KNOWN_GOOD
(after uncompressing).  For autotesting.

PPZ_KNOWN_GOOD should be created with pdftoppm | gzip -1.
See tests/common.mak.
END_USAGE
    return 1;
  }

  my $good_type = $ARGV[0];
  my $check_pdf = $ARGV[1];

  die "No PDF file $check_pdf" if ! -s $check_pdf;
  die "No good PPZ file $good_type" if ! -s $good_type;

  # get image of the PDF file.  We can't compare PDF files directly,
  # they can vary from run to run.  There is no simple pdftype program,
  # and it seems a better test to look at the actual output image than
  # just to run pdftotext.
  # 
  # this creates checkpdf-000001.ppm (for a one page file).
  my $check = system ("pdftoppm", $check_pdf, "checkpdf");
  die "pdftoppm($check_pdf) failed, status $check"
    if $check;
  
  # compare page images, they should be exactly the same.
  my $different = system ("zcat $good_type | cmp -s checkpdf-000001.ppm");
  $different /= 8;
  if ($different) {
    warn "$0: ${check_pdf} different from $good_type.\n";
  }
  
  return $different;
}


# 
# Run PROGRAM on ARGS, running output with clean_dvitype and returning as
# a string.
# 
sub snarf_output
{
  my ($program,@args) = @_;

  # use safe (more or less) form of open.
  local *PROG;
  open (PROG, "-|", $program, @args) ||die "open($program @args |) failed: $!";
  my @lines = <PROG>;
#warn "read lines from $program @args:\n@lines";
  close (PROG) || warn "close($program @args |) failed: $!";
  
  return &clean_dvitype (@lines);
}