#!/usr/bin/perl
# 
# Copyright 2005,2006,2009 Michel Messerschmidt
# 
# This program is free software: you can redistribute it and/or modify 
# it under the terms of the GNU General Public License as published by 
# the Free Software Foundation, either version 3 of the License, or (at 
# your option) any later version.
# 
# This program is distributed in the hope that it will be useful, but 
# WITHOUT ANY WARRANTY; without even the implied warranty of 
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 
# See the GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License 
# along with this program in the file LICENSE. 
# If not, see http://www.gnu.org/licenses/

use strict; 
use warnings;

sub print_info();
sub print_structure();
sub check_header($);
sub find_objs_in_file($);
sub parse_xrefs($);
sub parse_xref_content($$);
sub parse_objects();
sub parse_page_tree($$);
sub parse_tokens($);

$::PROG = "pdf_obj_check";
$::VERSION = "3.99";
my $verbose = 0;

while (defined $ARGV[0] and $ARGV[0] =~ s/^-//) {
    if ($ARGV[0] =~ /^(V|-version)$/) {
        print("$::PROG $::VERSION created by Michel Messerschmidt, 2005,2006,2009\n");
        exit 0;
    } elsif ($ARGV[0] =~ /^(h|-help|\?)$/) {
        print("$::PROG $::VERSION created by Michel Messerschmidt, 2005,2006,2009\n");
	main::HELP_MESSAGE();
        exit 0;
    } elsif ($ARGV[0] =~ /^(v+)$/) {
        $verbose += length($1);
        shift;
    } elsif ($ARGV[0] =~ /^-verbose$/) {
        $verbose++;
        shift;
    } elsif ($ARGV[0] =~ /^(e|-errors)$/) {
        $verbose = 1 unless ($verbose > 1);
        shift;
    } elsif ($ARGV[0] =~ /^(o|-objects)$/) {
        $verbose = 2 unless ($verbose > 2);
        shift;
    } else {
        print "ERROR: unknown option $ARGV[0]\n\n";
        print "Type '$::PROG --help' for more information\n\n";
	exit 1;
    }
}
unless (defined $::ARGV[0]) {
    print "ERROR: missing filename\n\n";
    main::HELP_MESSAGE();
    exit 1;
}


# contains various basic information about the pdf file
%::info = ();

# regex expressions for pdf parsing
# according to the PDF spc (ISO 32000), NUL is another valid whitespace char
$::ws = "\x09\x0a\x0c\x0d\x20";
# delimiter chars in DPF are ()<>[]{}/%
# comments are excluded here, because they are handled differently
# parsing of delimiter can not be char-based, because of << and >>
#$::dl = "\x28\x29\x3c\x3e\x5b\x5d\x7b\x7d\x2f\x25";
#$::dl = "(\/|\<\<|\>\>|\[|\]|\<|\>|\(|\)|\{|\})";


# store all objects information indexed by file ofset (the only unique value 
# for objects). This may contain outdated objects, that are not referenced anymore.
%::file_offsets = ();

# enumerate objects by number and generation (key: $number_$generation). 
# Value is just the file offset to allwow access to the offsets array. 
# This contains only the latest offset for each object to allow 
# iterating through all valid objects.
%::objs_file = ();

# contains all parsed xref contents
%::xrefs = ();
# contains collected xref statistics
%::xref_stats = ();

# flag to signal that any error was found
$::found_ref_error = 0;


print("\nDEBUG: Analyzing file ", $ARGV[0],"\n") if ($verbose > 2);
# read file
if (not -r $::ARGV[0] or -d $ARGV[0]) {
    print "Error: can't read input file\n";
    exit 2;
}
open(FI, "< ".$::ARGV[0]) or die "Error opening input file";
binmode(FI);
$::info{"file_lines"} = 0;
$::info{"file_bytes"} = 0;
my $file = "";
my $in;
while (defined($in = <FI>)) {
    $::info{"file_lines"}++;
    $::info{"file_bytes"} += length($in);
    $file .= $in;
}
close(FI);

# extract and check version from file header
($::info{"version_check"}, $::info{"version"}, $::info{"version_msg"}) = 
    check_header(\$file);

# determine if file is linearized or not
my $head = substr($file, 0, 1024);
if ($head =~ m-/Linearized-s) {
    $::info{"linearized"} = 1;
    print("DEBUG: PDF is linearized. Using first root entry.\n") if ($verbose > 2);
} else {
    $::info{"linearized"} = 0;
}

# parse file
my ($root_obj, $root_gen) = find_objs_in_file(\$file);

# find and parse all xref tables
parse_xrefs(\$file);

# parse object dictionaries for object types and interesting stuff
parse_objects();

# analyze page tree
my ($page_count, $pages_found) = parse_page_tree($root_obj, $root_gen);

# print results
print_info();
print_structure();

print("  ----- Consistency checks -----\n");
# compare objects found in file with all objects in xref tables
# possible outcomes:
#  ok: file no == xref no, file gen == xref gen, file offset == xref offset
# nok: file no != xref no, file gen == xref gen, file offset == xref offset
# nok: file no == xref no, file gen != xref gen, file offset == xref offset
# nok: file no != xref no, file gen != xref gen, file offset == xref offset
# nok: file no == xref no, file gen == xref gen, file offset != xref offset
#  ok: file no != xref no, file gen == xref gen, file offset != xref offset
#  ok: file no == xref no, file gen != xref gen, file offset != xref offset
#  ok: file no != xref no, file gen != xref gen, file offset != xref offset
print("  Checking xref entries...\n") if ($verbose > 0);
my %cmp_objs = ();
#foreach my $o (sort keys %::file_offsets) {
foreach my $o (sort {$a <=> $b} keys %::file_offsets) {
    my $nr = $::file_offsets{$o}{"obj"};
    if (exists $::xref_offsets{$o}) {
        # obj at file offset referenced in xref 
	$cmp_objs{$o}->{"found"} = 1;
        if ($::file_offsets{$o}{"obj"} == $::xref_offsets{$o}{"obj"}) {
            # obj has the same number in file and  xref 
            if ($::file_offsets{$o}{"gen"} == $::xref_offsets{$o}{"gen"}) {
                # obj has the same generation in file and xref 
		$cmp_objs{$o}->{"ok"} = 1;
		if ($verbose > 2) {
		    printf("  OK: object %5d found in xref %2d, part %2d\n", 
                           $nr, $::xref_offsets{$o}{"xref"}, 
                           $::xref_offsets{$o}{"part"});
		}
            } else {
	        # different generation but same offset and number
		$cmp_objs{$o}->{"gen_diff"} = "entry for object $nr has " .
		    "same offset but different generation number in xref " .
		    $::xref_offsets{$o}{"xref"} . ", part " . 
                    $::xref_offsets{$o}{"part"} . "\n";
	    }
        } else {
            # obj has a different number in file and xref 
	    $cmp_objs{$o}->{"obj_diff"} = "different object " .
               $::file_offsets{$o}{"obj"} ." ". $::file_offsets{$o}{"gen"} .
               " found at offset for xref entry " .
	       $::xref_offsets{$o}{"obj"} ." ". $::xref_offsets{$o}{"gen"} ."\n";
        }
    } else {
        # obj found at file offset but offset not referenced in xref
        $cmp_objs{$o}->{"found"} = 0;
    }
}

foreach my $xo (sort keys %::xref_offsets) {
    # only look for the xref entries not found in the file
    next if (exists($cmp_objs{$xo}));
    my $xn = $::xref_offsets{$xo}{"obj"};
    my $xv = $::xref_offsets{$xo}{"gen"};
    my $found = 0;
    foreach my $fo (keys %::file_offsets) {
        if ($xn == $::file_offsets{$fo}{"obj"} and $xv == $::file_offsets{$fo}{"gen"}) {
	    $cmp_objs{$xo}{"found"} = 1;
	    $cmp_objs{$xo}{"off_diff"} = "object ". $xn ." ". $xv .
                " has a wrong offset in the xref entry (" . $xo . 
		    ", found in file at " . $fo . ")\n";
            $found = 1;
            last;
        }
    }
    if ($found == 0 and not exists($::xref_offsets{$xo}{"unused"})) {
	$cmp_objs{$xo}->{"unknown"} = "ERROR: object ". $xn ." ". $xv .
            " not found in file but in xref \n";
    }
}

foreach my $o (sort {$a <=> $b} keys %cmp_objs) {
    if ($cmp_objs{$o}->{"found"} == 0) {
	print("  ERROR: found no xref entry for object at offset", $o, "\n") if ($verbose > 0);
	$::found_ref_error = 1;
    } else {
	if (exists($cmp_objs{$o}->{"ok"})) {
	    if (exists($cmp_objs{$o}->{"off_diff"})) {
		if ($verbose > 1) {
		    my $tmp = $cmp_objs{$o}->{"off_diff"};
		    $tmp =~ s/^.*(in xref +\d+, part +\d+.*)$/$1/;
		    print("  OK: found obsolete entry for object at offset $o ", $tmp) if ($verbose > 0);
		}
	    }
	    if (exists($cmp_objs{$o}->{"gen_diff"})) {
		printf("  WARNING: found duplicate entry: %s\n",
		      $cmp_objs{$o}->{"gen_diff"}) if ($verbose > 0);
		$::found_ref_error = 1;
	    }
	} else {
	    if (exists($cmp_objs{$o}->{"off_diff"})) {
		print("  ERROR: ", $cmp_objs{$o}->{"off_diff"}) if ($verbose > 0);
		$::found_ref_error = 1;
	    }
	    if (exists($cmp_objs{$o}->{"obj_diff"})) {
		print("  ERROR: ", $cmp_objs{$o}->{"obj_diff"}) if ($verbose > 0);
		$::found_ref_error = 1;
	    }
	    if (exists($cmp_objs{$o}->{"gen_diff"})) {
		print("  ERROR: ", $cmp_objs{$o}->{"gen_diff"}) if ($verbose > 0);
		$::found_ref_error = 1;
	    }
	    if (exists($cmp_objs{$o}->{"unknown"})) {
		print("  ERROR: ", $cmp_objs{$o}->{"unknown"}) if ($verbose > 0);
		$::found_ref_error = 1;
	    }
	}
    }
}
print("  ...done.\n") if ($verbose > 0);

# print reference check result
print("Object reference check................: ");
($::found_ref_error == 0) ?
    print("OK\n")
    :
    print("FAILED\n");

# print page check result
print("Page check............................: ");
if ($page_count == -1) {
    # in this special case, the second return value is the error 
    # message not a page number
    print("FAILED (",$pages_found,")\n");
} elsif ($page_count == $pages_found) {
    print("OK\n");
    printf("Page count............................: %d\n", $page_count);
} else {
    print("FAILED (PDF file contains hidden pages)\n");
    printf("Page count............................: %d (found in file) != ".
           "%d (page count in object directory)\n", 
           $pages_found, $page_count);
}



sub print_info() {
    print("  ----- PDF information -----\n");
    print("PDF version...........................: ", 
          $::info{"version_check"} == 1 ? $::info{"version"} : "invalid");
    print ", ". $::info{"version_msg"} unless (length($::info{"version_msg"}) == 0);
    print("\n");
    print("PDF is linearized.....................: ", 
          $::info{"linearized"} == 0 ? "no" : "yes", "\n");
    print("PDF contains auto-open scripts........: ", 
          exists($::info{"openaction"}) ? "yes" : "no", "\n");
    print("PDF contains event-triggered scripts..: ", 
          exists($::info{"addaction"}) ? "yes" : "no", "\n");
    print("PDF contains interactive forms........: ", 
          exists($::info{"form"}) ? "yes" : "no", "\n");
    print("PDF contains xml metadata.............: ", 
          exists($::info{"metaxml"}) ? "yes" : "no", "\n");
    print("PDF language..........................: ", 
          exists($::info{"language"}) ? $::info{"language"} : "(not specified)", "\n");
    print("PDF contains xref streams.............: ", 
          exists($::info{"xrefstream"}) ? "yes" : "no", "\n");
    print("PDF contains object streams...........: ", 
          exists($::info{"objstream"}) ? "yes" : "no", "\n");
    print("PDF contains extensions to ISO 32000..: ", 
          exists($::info{"extensions"}) ? $::info{"extensions"} : "no", "\n");
}


sub print_structure() {
    print("  ----- PDF structure -----\n");
    # list objects found in file
    my $objs_count = keys %::file_offsets;
    printf("Bytes in file..........................: %d\n", $::info{"file_bytes"});
    printf("Lines in file..........................: %d\n", $::info{"file_lines"});
    printf("Objects found in file..................: %d\n", $objs_count);
    if ($verbose > 1) {
        print("  object    0 is unused  (this is a pdf requirement)\n");
        foreach my $o (sort {$a <=> $b} keys %::file_offsets) {
	    printf("  object %4d (generation %d) at address %8u\n",
	           $::file_offsets{$o}{"obj"}, $::file_offsets{$o}{"gen"},
                   $::file_offsets{$o}{"offset"});
        }
#        print("\n");
    }

    # print xref summary
    printf("Object directories (xref) found........: %d\n", $::xref_stats{"count"});
    printf("Objects referenced in xref.............: %d\n", $::xref_stats{"objcount"});
    printf("Used objects referenced in xref........: %d\n", $::xref_stats{"used"});
    printf("Unused objects referenced in xref......: %d\n", $::xref_stats{"unused"});
    # list xref parts
    if ($verbose > 0) {
	foreach my $x (sort keys %::xrefs) {
            printf("  xref %d at address %8u contains %4d entries:\n", $x, 
                   $::xrefs{$x}->{"pos"}, $::xrefs{$x}->{"entries"});
            foreach my $p (sort keys %{$::xrefs{$x}->{"parts"}}) {
	        printf("    part %2d contains %4d entries starting " . 
	               "with %4d\n", $p, $::xrefs{$x}->{"parts"}->{$p}->{"entries"}, 
	               $::xrefs{$x}->{"parts"}->{$p}->{"first"});
            }
#            print("\n");
        }
    }
    # list entries in all xref parts
    if ($verbose > 1) {
        foreach my $x (sort keys %::xrefs) {
	    foreach my $p (sort keys %{$::xrefs{$x}->{"parts"}}) {
	        print("  List of indirect objects referenced in part ",$p,
		      " of xref ",$x,":\n");
	        foreach my $o (sort {$a <=> $b} keys 
		               %{$::xrefs{$x}->{"parts"}->{$p}->{"objs"}}) {
		    my @obj = @{$::xrefs{$x}->{"parts"}->{$p}->{"objs"}->{$o}};
		    ($obj[2] == -1) ? 
		        printf("    object %4d is unused\n", $o)
		        : 
		        printf("    object %4d at address %8u (generation %d)\n",
			       $obj[0], $obj[1], $obj[2]);
	        }
#	        print("\n");
	    }
        }
    }
}


sub check_header($) {
    my $file = ${$_[0]};
    my $magic = substr($file, 0, 5);
    # use a arbitrary chosen limit of 100 bytes to examine for the 
    # version number (that is expected to have exactly 3 characters)
    my $version = substr($file, 5, 100);
    $version =~ m/^([0-9\.]+)/;
    $version = $1;
    my $retcode = 1;
    my $retmsg = "";

    if ($magic ne "%PDF-") {
        $retmsg .= "invalid PDF header '". $magic ."'";
#        $retcode = 0;
    }
    my ($retcode_v, $retmsg_v) = check_version($version);
    if ($retcode_v != 1) {
        $retmsg .= ", " unless ($retmsg eq "");
        $retmsg .= $retmsg_v;
        $retcode = 0;
    }
    return ($retcode, $version, $retmsg);
}


sub check_version($) {
    my $ver = $_[0];
    if (not defined($ver)) {
        # version is invalid
        return (0, "found no version");
    } elsif ($ver !~ /^1\.[01234567]$/) {
        # version is invalid
        return (0, "found version '". $ver ."'");
    }
    return (1, "");
}


# find all objects and store obj number, obj offset in the file and obj generation
sub find_objs_in_file($) {
	my $file = ${$_[0]};
	while ($file =~ /(\d+) (\d+) obj/gs) {
	    my $nr = $1;
	    my $gen = $2;
	    my $offs = pos($file) - length($nr) - length($gen) - 5;
	    my $key = $nr . "_" . $gen;
	    if (exists($::objs_file{$key}) and $verbose > 0) {
	        print("INFO: update for object ",$nr," ",$gen,
	              " detected. Discarding previous offset ",$::objs_file{$key},"\n");
	    }
	    if ($offs !~ /^\d+$/ and $verbose > 0) {
	        print("ERROR: found invalid offset ",$offs," for object ",$nr,"_",$gen,"\n");
	    }
	    print("DEBUG: adding object ",$nr,"_",$gen," at offset ",$offs,"\n") if ($verbose > 4);
	    # This might overwrite previous entries with the same object number and 
	    # generation. It is accepted with the assumption that the file is searched from.
	    # start to end. Because regular PDF updates only append objects at the end, the 
	    # latest object update is processed last and stored in the objs_file array. 
	    # Note that the updated and prvious objects are stored in the file_offsets array.
	    $::objs_file{$key} = $offs;
	    $::file_offsets{$offs}{"obj"} = $nr;
	    $::file_offsets{$offs}{"gen"} = $gen;
	    $::file_offsets{$offs}{"offset"} = $offs;
	}

	# find root object
	my $robj;
	my $rgen;
	if ($::info{"linearized"} == 1) {
	    # find the first match
	    $file =~ m-/Root (\d+) (\d+) R-s;
	    $robj = $1;
	    $rgen = $2;
#	    # correct the offset of the root entry in the objects array, in case 
#	    # there was an root object update thast kept the number and generation,
#	    # Note that this should not happen for linearized files
#	    foreach my $o (sort keys %::file_offsets) {
#	        if ($::file_offsets{$o}{"obj"} == $robj and 
#	            $::file_offsets{$o}{"gen"} == $rgen) {
#	            $::objs_file{$robj} = $o;
#	            last;
#	    }
	} else {
	    # find the last match
	    while ($file =~ m-/Root (\d+) (\d+) R-gs) {
	        print("DEBUG: found possible root object: $1 $2 obj\n") if ($verbose > 3);
	        $robj = $1;
	        $rgen = $2;
	    }
	}
	if (not defined($robj) or not defined($rgen)) {
	    print("ERROR: found no root object reference in file\n");
            $robj = -1;
            $rgen = -1;
        } else {
            print ("DEBUG: found root object: $robj $rgen obj\n") if ($verbose > 3);
        }

	if (not exists($::objs_file{$robj."_".$rgen})) {
	    print("WARNING: root object not found in object list\n");
	} else {
	   print("DEBUG: root object ",$robj," (generation ",$rgen,
                 ") identified in object list\n") if ($verbose > 4);
	}

	return ($robj, $rgen);
}


# find and parse all xrefs structures in the file
sub parse_xrefs($) {
	my $file = ${$_[0]};
        $::xref_stats{"objcount"} = 0;
        $::xref_stats{"used"} = 0;
        $::xref_stats{"unused"} = 0;
	my $xnr = 0;
	while ($file =~ /[$::ws]xref([\x0a\x0d]+)(\d+) (\d+)[$::ws]/gs) {
	    $xnr++;
	    $::xrefs{$xnr}{"first"} = $2;
	    $::xrefs{$xnr}{"entries"} = $3;
	    $::xrefs{$xnr}{"pos"} = pos($file) - length($1) - length($2) - 
		length($3) - 6;    
	}
	$::xref_stats{"count"} = $xnr;

	# parse all xrefs and print content summary
	foreach my $x (sort keys %::xrefs) {
	    $::xrefs{$x}->{"endpos"} = index($file, "trailer", $::xrefs{$x}->{"pos"});
	    my $stream = substr($file, $::xrefs{$x}->{"pos"}, 
				$::xrefs{$x}->{"endpos"} - $::xrefs{$x}->{"pos"});
	    parse_xref_content($x, $stream);
	}
}


# parse lines in xref to get a list of of unused and used objects 
# with their file offsets
sub parse_xref_content($$) {
    my $x = $_[0];
    my $stream = $_[1];
    # split into lines at any line break char. This may results in 
    # additional empty lines, that can be ignored here.
    my @lines = split(/[\x0a\x0d]/, $stream);
    my $linelimit = $#lines + 1;
    my $part = 1;
    if ($verbose > 4) { print("DEBUG: max. line no.  = ",$linelimit,"\n"); } 

    my $l = 0;
    while ($l < $linelimit) {
	if ($verbose > 4) { print("DEBUG: line $l = '",$lines[$l],"'\n"); } 
	if ($lines[$l] =~ /^(\d+) (\d+)[$::ws]*$/) {
	    my $begin = $1;
	    my $total = $2;
	    if ($verbose > 4) { 
		print("DEBUG: found xref header in line ",$l,
		      ": first object=",$begin,", entries=",$total,"\n"); } 
	    $::xrefs{$x}->{"parts"}->{$part}->{"first"} = $begin;
	    $::xrefs{$x}->{"parts"}->{$part}->{"entries"} = $total;
	    my $end = $begin + $total -1;
	    my $nr = $begin;
	    $l++;
	    while (($l < $linelimit) and ($lines[$l] !~ /^(\d+) (\d+)$/)) {
		if ($verbose > 4) { print("DEBUG: line $l = '",$lines[$l],"'\n"); } 
 		if ($lines[$l] =~ /^(\d{10}) (\d{5}) ([nf]) ?$/) {
		    my $offset = int($1);
		    my $generation = int($2);
		    my $obj_free = $3;
                    $::xref_stats{"objcount"}++;
		    if ($verbose > 3) { 
			print("DEBUG: found entry ",$nr," at line ",$l,
			      ": offset=",$offset,"  -  generation=",
			      $generation,"  -  type=",$obj_free,"\n"); } 
		    if ($obj_free eq "f") {
			$generation = -1;
                        $::xref_offsets{$offset}{"unused"} = $obj_free;
                        $::xref_stats{"unused"}++;
		    } else {
                        $::xref_stats{"used"}++;
                    }
		    my $t = {"offset" => $offset,
			     "generation" => $generation,
			     "xref" => $x,
			     "part" => $part,
			 };
		    @{$::xrefs{$x}->{"parts"}->{$part}->{"objs"}->{$nr}} = 
			($nr, $offset, $generation);
                    $::xref_offsets{$offset}{"obj"} = $nr;
                    $::xref_offsets{$offset}{"gen"} = $generation;
                    $::xref_offsets{$offset}{"xref"} = $x;
                    $::xref_offsets{$offset}{"part"} = $part;
		    if ($verbose > 2) { 
			print("DEBUG: added obj $nr to xref $x, part $part\n"); 
		    } 
		    $nr++;
		}
		if ($nr > $end + 1) {
		    printf("  ERROR: xref contains more entries (%d) than set " .
			   "in header (%d)\n", $nr - $begin, $total);
		    $::found_ref_error = 1;
		}
		$l++;
	    }
	    $part++;
	    # don't increment the current line twice
	    next;
	}
	$l++;
    }
}



# parse object dictionaries
sub parse_objects() {
    #foreach my $o (sort keys %::file_offsets) {
    foreach my $o (sort {$a <=> $b} keys %::file_offsets) {
        my @tokens = parse_tokens($o);
        for (my $t=0; $t<$#tokens; $t++) {
#            print("         ",$tokens[$t],"\n") if ($verbose > 5);
            if ($tokens[$t] eq "/Type") {
                $::file_offsets{$o}{"type"} = substr($tokens[$t+1], 1);
                if ($::file_offsets{$o}{"type"} eq "XRef") {
                    $::info{"xrefstream"} = "yes";
                }
                if ($::file_offsets{$o}{"type"} eq "ObjStm") {
                    $::info{"objstream"} = "yes";
                }
                print("DEBUG:     found object type: ",
                       $::file_offsets{$o}{"type"},"\n") if ($verbose > 3);
            }
#TODO: extract js, actions, ...
#TODO: detect encoded names (hex, #)
        }        
    }
}


# parse root object and re-contruct pages tree
sub parse_page_tree($$) {
    my ($root_obj, $root_gen) = @_;

    print("DEBUG: parsing root object: $root_obj\n") if ($verbose > 3);
    if (not exists $::objs_file{$root_obj."_".$root_gen}) {
        return (-1, "Root object not found in file. Disclaimer: ".
                "Object streams are not yet parsed");
    }
    my $pages_obj = 0;
    my $pages_gen = 0;
    my @rtokens = parse_tokens($::objs_file{$root_obj."_".$root_gen});
    for (my $t=0; $t<$#rtokens; $t++) {
        print("         ",$rtokens[$t],"\n") if ($verbose > 5);
        if ($rtokens[$t] eq "/Pages") {
            $pages_obj = $rtokens[$t+1];
            $pages_gen = $rtokens[$t+2];
        }
        elsif ($rtokens[$t] eq "/Version") {
            my $version = substr($rtokens[$t+1], 1);
            my ($check, $msg) = check_version($version);
            if ($check != 1) {
                $::info{"version_msg"} .= $msg . ", ";
                $::info{"version_check"} = $check;
            }
            $::info{"version_msg"} .= "upgraded from '". $::info{"version"} ."'";
            $::info{"version"} = $version;
        }
        elsif ($rtokens[$t] eq "/OpenAction") {
            $::info{"openaction"} = "yes";
        }
        elsif ($rtokens[$t] eq "/AA") {
            $::info{"addaction"} = "yes";
        }
        elsif ($rtokens[$t] eq "/AcroForm") {
            $::info{"form"} = "yes";
        }
        elsif ($rtokens[$t] eq "/Metadata") {
            $::info{"metaxml"} = "yes";
        }
        elsif ($rtokens[$t] eq "/Lang") {
            $::info{"language"} = $rtokens[$t+1];
        }
        elsif ($rtokens[$t] eq "/Extensions") {
            $::info{"extensions"} = "yes (". $rtokens[$t+1] .")";
        }
    }
    if ($pages_obj == 0) {
        return (-1, "/Pages reference not found in root object");
    } else {
        print("DEBUG: found top pages object: ",$pages_obj," ",
              $pages_gen," obj\n") if ($verbose > 3);
    }

    print("DEBUG: parsing top pages object: $pages_obj\n") if ($verbose > 3);
    my $count = -1;
    my @kids = ();

    if (not exists $::objs_file{$pages_obj."_".$pages_gen}) {
        return (-1, "top /Pages object not found in file. Disclaimer: ".
                "Object streams are not yet parsed");
    }
    my @ptokens = parse_tokens($::objs_file{$pages_obj."_".$pages_gen});
    for (my $t=0; $t<$#ptokens; $t++) {
        print("         ",$ptokens[$t],"\n") if ($verbose > 5);
        if ($ptokens[$t] eq "/Count") {
            $count = $ptokens[$t+1];
        }
        elsif ($ptokens[$t] eq "/Parent") {
            return (-1, "ERROR: top /Pages object not found in file ".
                    "(this is a child /Pages object)");
        }
        elsif ($ptokens[$t] eq "/Kids") {
#TODO: find and count all page references in /Pages objects, basically the childs of all /Kids
            my $k = $t + 1;
            push @kids, $ptokens[$k];
        }
    }

    if ($#kids > -1) {
        print("DEBUG: found child pages objects: ",$#kids,"\n") if ($verbose > 3);
    } else {
        print("WARNING: could not locate /Kids array in /Pages object\n");
    }

    my $found = 0;
    foreach my $k (keys %::file_offsets) {
        if (exists($::file_offsets{$k}{"type"}) and $::file_offsets{$k}{"type"} eq "Page") {
            $found++;
        }
    }

    return ($count, $found);
}


# parse object dictionaries
# input: object offset in file
sub parse_tokens($) {
    my $o = $_[0];
    print("DEBUG: parsing object at offset ",$o," (number ",
          $::file_offsets{$o}{"obj"},", generation ",
          $::file_offsets{$o}{"gen"},")\n") if ($verbose > 3);
    # get start of object excluding the obj tag itself
    my $obj_start = index($file, "obj", $::file_offsets{$o}{"offset"}) + 3;
    pos($file) = $obj_start;
    my $obj_end = index($file, "endobj", $obj_start);
    # avoid copying whole objects, but omit content stream if possible
    # (according to ISO 32000-1 streams are always at the end of the object
    my $find_stream = index($file, "stream", $obj_start);
    if ($find_stream >= $obj_start and $find_stream < $obj_end) {
        $obj_end = $find_stream;
    }
    my $obj = substr($file, $obj_start, $obj_end - $obj_start);
    print("DEBUG:     obj: ",$obj,"\n") if ($verbose > 5);
    # replace comment lines with whitespace (as defined in ISO 32000-1)
    while ($obj =~ s/(%[^\x0a\x0d]*)([\x0a\x0d])/ $2/gs) {
        print("DEBUG:  replaced comment '",$1,"' with whitespace\n") if ($verbose > 5);
    }
    my @tokens = split(/[$::ws]+/s, $obj);
        print("DEBUG: obj tokens (",$#tokens+1,"):\n") if ($verbose > 5);
        foreach my $td (@tokens) {
            print("DEBUG:             ",$td,"\n") if ($verbose > 5);
        }
    # separate tokens that have no whitespace in between 
    # (any token must start with whitespace or a delimiter)
    my $tc = 0;
    while ($tc <= $#tokens) {
        print("DEBUG:    parsing token ",$tc,"/",$#tokens,": ",$tokens[$tc],"\n") if ($verbose > 5);
        if ($tokens[$tc] eq "") {
            # remove empty tokens
            splice(@tokens, $tc, 1);
            print("DEBUG:    discarded empty token ",$tc,"\n") if ($verbose > 5);
            next;
        }
        my $startpos = 0;
        my @addtokens = ();
        my @subtokens = split(/(\/|\<\<|\>\>|\[|\]|\<|\>|\(|\)|\{|\})/, $tokens[$tc]);
        my $subnr = 1;
            print("DEBUG:    subtokens = @subtokens\n") if ($verbose > 5);
        my $st = 0;
        while ($st <= $#subtokens) {
            print("DEBUG:    extracted subtoken: ",$subtokens[$st],"\n") if ($verbose > 5);
            if ($subtokens[$st] eq "") {
                # remove empty extracts
                splice(@subtokens, $st, 1);
                print("DEBUG:    discarded empty subtoken\n") if ($verbose > 5);
                next;
            }
            if ($subtokens[$st] =~ /^\/$/ and ($st < $#subtokens)) {
                my $next = $subtokens[$st+1];
                splice(@subtokens, $st, 2, $subtokens[$st] . $next);
                print("DEBUG:    merged with next subtoken ",$next,
                      " to one subtoken: ",$subtokens[$st],"\n") if ($verbose > 5);
            }
            $st++;
        }
        if ($#subtokens > -1) {
            $subnr += $#subtokens;
            splice(@tokens, $tc, 1, @subtokens);

        }
        # advance loop iterator by the number of inserted tokens to avoid 
        # repeated parsing of the same content
        $tc += $subnr;
    }
    print("DEBUG: final obj tokens (",$#tokens+1,"):\n") if ($verbose > 5);
    foreach my $td (@tokens) {
        print("DEBUG:             ",$td,"\n") if ($verbose > 5);
    }

    # rebuild token structure in a hash array
    my %tt = ();
    my @stack = ();
    my $acount = 1;
    my $bcount = 1;
    my $dcount = 1;
    my $hcount = 1;
    my $lcount = 1;
    my $i = 0;
#TODO: add null object
##
## <</MediaBox[0 0 595.22 842]/Count 10/Type/Pages/Kids[1 0 R 7 0 R 10 0 R 25 0 R 28 0 R 31 0 R]>>
##
## << -> dict -> >>                 -> >>
##            -> other=key -> value -> key -> value
## [ -> array -> ]     -> ]
##            -> entry -> entry
## / -> named_key -> named_value
##
##
    while ($i <= $#tokens) {
        print("DEBUG:     parsing token ",$i,"/",$#tokens,"\n") if ($verbose > 5);
        #create_token_tree($i, \@tokens, \%tt);
        $i++;
    }

    print("DEBUG: tokenized object structure:\n") if ($verbose > 5);
    foreach my $k (keys %tt) {
        print("DEBUG:     ",$k," = '",$tt{"$k"},"'\n") if ($verbose > 5);
    }

    return @tokens;
#    return %tt;
}

sub create_token_tree() {
    my ($i, $tref, $ttref) = @_;
    my @tokens = @{$tref};
    my %tt = %{$ttref};
        print("DEBUG:     parsing token ",$i,"/",$#tokens,"\n") if ($verbose > 5);
        my $t = $tokens[$i];
        if ($t eq "true" or $t eq "false") {
            # booleans
            print("DEBUG: ERROR at token ",$i,": no key for boolean value ",$t,"\n") if ($verbose > 5);
        } elsif ($t =~ /^[0-9.+-]+$/s) {
            # numbers (integer and real)
            print("DEBUG: ERROR at token ",$i,": no key for numeric value ",$t,"\n") if ($verbose > 5);
        } elsif ($t =~ /^\/[^$::ws]+$/so) {
            # named objects
                $tt{"$t"} = $tokens[$i+1];
        } elsif ($t =~ /^[0-9A-Fa-f]+$/s) {
            # hexadecimal strings
        } elsif ($t =~ /^[^\(\)]+$/s) {
            # literal strings
        } elsif ($t eq "<<") {
            #call ("dict", $dcount++);
        } elsif ($t eq "<") {
            #call ("hexstring", $hcount++);
        } elsif ($t eq "(") {
            #call ("literalstring", $lcount++);
        } elsif ($t eq "{") {
            #call ("braces", $bcount++);
        } elsif ($t eq "[") {
            #call ("array", $acount++);
        } elsif ($t eq ">>") {
            my @d = ();
            my ($type, $k);
            $tt{"$type.$k"} = @d;
        } elsif ($t eq ">") {
        } elsif ($t eq ")") {
        } elsif ($t eq "}") {
        } elsif ($t eq "]") {
        }
        $i++;
}

# set global strings for getopt
sub main::HELP_MESSAGE {
    print "Usage: $::PROG [options] <filename>\n".
	  "Options:\n".
	  "   -e   --errors      list all errors found\n".
	  "   -o   --objects     list all indirect objects found in file and xref\n".
	  "   -v   --verbose     be more verbose (use multiple times for more details)\n".
	  "   -V   --version     show program version\n".
	  "   -h   --help        show this help\n\n".
	  "This program is licensed under the GPL (version 3 or later)\n\n";
}