Version 10 of Parsing PDF

Updated 2008-06-01 15:31:25 by jscottb

Keith Vetter 2007-10-20 : I've been playing with PDF and generating it on the fly. My first effort resulted in Text2PDF, but I needed more formatting control so the next step was to delve into the file format [L1 ]. PDF can be a VERY complex format with support for incremental updates and generations. I find that the only way for me to understand a new technology is to get my hands dirty, so I decided to write a parser to pull apart a PDF file.

So here is code to parse a PDF file. It understands the lexemes comprising the file, and it understands the document structure and the page tree data structure. It lets you see, but does NOT understand, the low-level stuff which makes up pages or defines fonts, etc.

If anybody else wants to delve into the PDF deeper, this code would make a good starting point.

The code here contains both the PDF parsing code plus two different ways to run it, both a command line interface and a GUI interface. In either case, it displays a PDF's catalog and root of the page layout tree, plus the meta-data for a specified page.


Andreas otto 2007-10-21 : other software solution pdflib

KPV: Note, pdflib is a commercial, non-TCL (ANSI C) product


EE 2008-03-05: NOTE that the above URL pointing at the PDF specification points into a subscriber-only area on the Adobe website. The PDF spec is publicly available at http://www.adobe.com/devnet/pdf/pdf_reference.html


##+##########################################################################
#
# Parsing PDF -- decodes PDF document
# by Keith Vetter. October 2007
#
# http://partners.adobe.com/asn/tech/pdf/specifications.jsp
# http://www.adobe.com/devnet/pdf/pdfs/PDFReference13.pdf

proc ParsePDF {} {
   global D CATALOG PAGES PAGE CONTENT INFO

   unset -nocomplain D
   unset -nocomplain CATALOG
   unset -nocomplain PAGES
   unset -nocomplain PAGE
   unset -nocomplain CONTENT
   unset -nocomplain INFO

   CheckValidPDF
   GetTrailer
   ReadXREF
   ReadObject $D(root) CATALOG
   ReadObject $CATALOG(/Pages) PAGES
   
   if {[info exists D(info)]} { ReadObject $D(info) INFO }
}

proc ParsePDF.File {fname} {
   set fin [open $fname r]
   fconfigure $fin -translation binary
   SetText [read $fin]
   close $fin

   ParsePDF
}
##+##########################################################################
#
# CheckValidPDF -- does some simple sanity checks then reads in the
# cross-reference location.
#
proc CheckValidPDF {} {
   global data D

   if {[string range $data 0 4] ne "%PDF-"} { error "Mal-formed PDF 1" }
   set tail [string range $data end-1024 end] ; list
   if {! [regexp {%%EOF[\r\n]*$} $tail]} { error "Mal-formed PDF 2" }
   set n [regexp {[\n\r]+startxref[\n\r]+(\d+)} $tail => fpos]
   if {! $n} { error "Mal-formed PDF 3" }
   set D(xref,fpos) $fpos
}
##+##########################################################################
#
# GetTrailer -- reads key info out of the trailer section.
# Not sure this is correct with incrementally updated pdf files.
#
proc GetTrailer {} {
   global data D

   # Is this the best way to locate the trailer??? especially with
   # multiple trailers with incremental updates
   set offset [string first trailer $data $D(xref,fpos)]
   SetPosition $offset

   set token [GetToken]			;# Trailer keyword
   set token [GetToken]			;# Start of dict
   set dict [ReadDict]
   unset -nocomplain tmp
   array set tmp $dict

   if {! [info exists tmp(/Size)]} { error "trailer missing /Size" }
   if {! [info exists tmp(/Root)]} { error "trailer missing /Root" }
   set D(xref,cnt) $tmp(/Size)
   set D(root) $tmp(/Root)
   if {[info exists tmp(/Prev)]} { set D(prev) $tmp(/Prev) }
   if {[info exists tmp(/Info)]} { set D(info) $tmp(/Info) }
}
##+##########################################################################
#
# ReadXREF -- reads in the main and possibly prev XREF section.
# NB. can there be more than 2?
#
proc ReadXREF {} {
   global D

   set offsets $D(xref,fpos)
   if {[info exists D(prev)]} { lappend offsets $D(prev) }
   foreach offset $offsets {
       SetPosition $offset
       GetToken
       set token [GetToken]
       foreach {start cnt} [split $token " "] break

       for {set i 0} {$i < $cnt} {incr i} {
	   set id [expr {$start + $i}]
	   set token [GetToken]
	   scan $token "%ld %d %s" offset generation inuse
	   if {$inuse eq "f"} continue
	   set D(xref,$id,offset) $offset
       }
   }
}
##+##########################################################################
#
# ReadObject -- assumes an object is just a dictionary, stores the
# dictionary into specified array
#
proc ReadObject {objID arrName} {
   upvar 1 $arrName arr
   unset -nocomplain arr

   PositionAtObject $objID
   set token [GetToken]
   if {$token ne "<<"} { error "Object $objID not a dictionary" }
   set dict [ReadDict]
   array set arr $dict
}
proc ShowObject {id title} {
   ReadObject $id tmp
   myParray tmp $title
}
##+##########################################################################
#
# GetPage -- Searches and extracts a given document page
#
proc GetPage {num} {
   global PAGE CONTENT

   set id [FindPage $num]
   if {$id eq ""} {return ""}		  ;# No page
   ReadObject $id PAGE

   # Content can be quite complex, just try for the simple case
   if {[catch {ReadObject $PAGE(/Contents) CONTENT}]} {return $id}
   if {! [string is integer -strict $CONTENT(/Length)]} { ;# Deref length
       PositionAtObject $CONTENT(/Length)
       set len [GetToken]
       append CONTENT(/Length) " => $len"
   }
   return $id
}
##+##########################################################################
#
# FindPage -- walks the page tree to find a given page
#
proc FindPage {pageNum} {
   global PAGES

   if {$pageNum < 1 || $pageNum > $PAGES(/Count)} {
       return ""
       error "Page number too big"
   }

   set thisPage 1
   set kids [eval concat $PAGES(/Kids)]
   while {1} {
       foreach {id gen R} $kids {
	   ReadObject $id child
	   if {$child(/Type) eq "/Page"} {
	       if {$thisPage == $pageNum} { return $id }
	       incr thisPage
	       continue
	   }

	   set lastPage [expr {$thisPage + $child(/Count)}]
	   if {$pageNum < $lastPage} {	 ;# Go down a level
	       set kids [eval concat $child(/Kids)]
	       break
	   } else {
	       set thisPage $lastPage
	   }
       }
   }
}
##+##########################################################################
#
# PositionAtObject -- "seeks" to position of a direct or indirect reference
#
proc PositionAtObject {ref} {
   set id [lindex $ref 0]
   SetPosition $::D(xref,$id,offset)
   set token [GetToken]			;# Object define
}
##+##########################################################################
#
# myParray -- specialized version of parray pretty printing an array
#
proc myParray {arrName {title ""} {pattern *}} {
   upvar 1 $arrName arr

   if {$title eq ""} { set title $arrName }
   puts $title

   set max 0
   foreach name [array names arr $pattern] {
       if {[string length $name] > $max} {
	   set max [string length $name]
       }
   }
   incr max 1
   if {[info exists arr(/Type)]} {
       puts [format "  %-*s = %s" $max /Type $arr(/Type)]
   }

   foreach name [lsort -dictionary [array names arr $pattern]] {
       if {$name eq "/Type"} continue
       puts [format "  %-*s = %s" $max $name $arr($name)]
   }
   puts ""
}
##+##########################################################################
#
# ReadArray -- returns a list of everything up to
# the matching closing array character.
#
# NB. can be nested w/ arrays and dictionaries
#
proc ReadArray {} {
   set arr {}
   while {1} {
       set token [GetToken]
       if {$token eq "]"} break
       if {$token eq "\["} {
	   set token [ReadArray]
       } elseif {$token eq "<<"} {
	   set token [ReadDict]
       }
       lappend arr $token
   }
   return $arr
}
##+##########################################################################
#
# ReadDict -- returns a list of everything up to
# the matching closing dictionary character.
#
# NB. can be nested w/ arrays and dictionaries
#
proc ReadDict {} {
   set dict {}
   while {1} {
       set name [GetToken]
       if {$name eq ">>"} break

       set value [GetToken]
       if {$value eq "<<"} {
	   set value [ReadDict]
       } elseif {$value eq "\["} {
	   set value [ReadArray]
       }
       lappend dict $name $value
   }
   return $dict
}
##+##########################################################################
#
# GetToken -- breaks input stream into PDF tokens, worrying about
# strings, boolean, hex sequences, names, arrays, dictionaries and
# atoms.
#
proc GetToken {} {
   set eotoken "()<>\[]{}/%"

   # Past white space and comments
   set inComment false
   while {1} {
       set ch [GetChar]
       if {$inComment} {
	   if {$ch eq "\n" || $ch eq "\r"} {
	       set inComment false
	   }
       } elseif {$ch eq "%"} {
	   set inComment true
       } elseif {! [string is space $ch]} break
   }

   set start $::D(pos)
   while {1} {
       if {$ch eq "(" || $ch eq "\{"} {	;# In a string or boolean
	   set backslash false
	   set match [expr {$ch eq "(" ? ")" : "\}"}]
	   while {1} {
	       set ch [GetChar]
	       if {$ch eq "\\"} {
		   set backslash true
	       } elseif {! $backslash && $ch eq $match} {
		   break
	       } else {
		   set backslash false
	       }
	   }
	   break
       }
       if {$ch eq "\[" || $ch eq "]"} break
       if {$ch eq "<"} {		       ;# Hex or dictionary
	   set ch [GetChar]
	   if {$ch eq "<"} break	       ;# Dictionary
	   while {1} {
	       set ch [GetChar]
	       if {$ch eq ">"} break
	   }
	   break
       }
       if {$ch eq ">"} {
	   GetChar
	   break
       }

       set name [expr {$ch eq "/"}]
       while {1} {
	   set ch [GetChar]
	   if {$ch eq "\n" || $ch eq "\r"} break
	   if {$name && [string is space $ch]} break
	   if {[string first $ch $eotoken] != -1} break
       }
       UnGetChar
       break
   }
   set ::D(token,start) $start
   set ::D(token,end) $::D(pos)
   set token [string range $::data $start $::D(pos)]
   if {[regexp {\((.[^\)]*)\)} $token -> string]} {
    set token $string
   } elseif {[regexp {^<([^<][^>]*)>[^>]?$} $token -> hexstring]} {
     set token [decodeHexstring $hexstring]
   }
   return $token
}
proc GetChar {} {
   set ch [string index $::data [incr ::D(pos)]]
   return $ch
}
proc UnGetChar {} {
   incr ::D(pos) -1
}
proc SetPosition {pos} {
   set ::D(pos) [expr {$pos-1}]
}
proc SetText {txt} {
   set ::data $txt
   set ::D(pos) -1
}
proc decodeHexstring {hexstring} {
  if {[string tolower [string range $hexstring 0 3]] eq "feff"} {
    set string [string range $hexstring 4 end]
    set result {}
    for {set i 0} {$i < [string length $string]} {incr i 4} {
      set hex [string range $string $i [expr $i + 3]]
      append result [encoding convertfrom unicode [binary format s 0x$hex]]
    }
    return $result
  } else {
    # don't know what to do
    return $hexstring
  }
}
################################################################
#
# DEMO CODE
#

proc NoGUI {} {
   global argc argv
   global CATALOG PAGES PAGE CONTENT INFO

   if {$argc == 0 || $argc > 2} {
       puts stderr "usage: parsePDF <pdf file> ?page number?"
       exit
   } elseif {$argc == 1} {
       lappend argv 1
   }
   foreach {fname pageNum} $argv break

   puts "Parsing [file tail $fname]\n"
   ParsePDF.File $fname

   myParray CATALOG Catalog
   myParray PAGES "Page Tree"
   GetPage $pageNum
   myParray PAGE "Page $pageNum Metadata"
   myParray CONTENT "Page $pageNum Contents"
   
   myParray INFO "Info"
}

if {[lindex $argv 0] eq "-gui"} {
  catch {package require Tk}
  set argv [lrange $argv 1 end]
}
if {! [info exists tk_version]} {
   NoGUI
   exit
}

################################################################
#
# GUI DEMO CODE
#

if {! [catch {package require tile}]} {
   namespace import -force ::ttk::button
}

set S(pageNum) 1
set S(havePDF) 0
set S(fname) ""

proc DoDisplay {} {
   global S argc argv

  set S(fname) ""
  if {$argc > 0} {
    set S(fname) [lindex $argv 0]
  }
  
   wm title . "Parsing PDF"
   image create photo ::img::question -data {
       R0lGODlhCQAMALMAAODf49PS1oeHiURDRQAAAJOSlVtbXG1sbre2uczLz3t7fa6usf//////////
       /////yH5BAEAAAAALAAAAAAJAAwAAwQmEAQxyCggGxwKwcAxZABBkChhoBlCIGwywKyysNmJ79lx
       7D4eKwIAOw==
   }
   image create bitmap ::img::dots -data {
       #define dots_width 16
       #define dots_height 9
       static char dots_bits = {
	   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
	   0x00, 0x00, 0x00, 0x84, 0x10, 0xce, 0x39, 0x84, 0x10}}
   image create bitmap ::img::star -data {
       #define plus_width  11
       #define plus_height 9
       static char plus_bits[] = {
	   0x00,0x00, 0x24,0x01, 0xa8,0x00, 0x70,0x00, 0xfc,0x01,
	   0x70,0x00, 0xa8,0x00, 0x24,0x01, 0x00,0x00 }}

   frame .file -bd 2 -relief ridge
   frame .finfo -bd 2 -relief ridge
   frame .fcat -bd 2 -relief ridge
   frame .fpages -bd 2 -relief ridge
   frame .fpage -bd 2 -relief ridge

   # File area
   label .file.l -text "PDF File"
   entry .file.fname -textvariable S(fname)
   button .file.choose -image ::img::dots -command ChooseFile
   button .file.go -text Parse -command Go
   button .file.about -image ::img::question -command About

   grid .file.l .file.fname .file.choose -sticky ns -pady 5
   grid .file.fname -sticky nswe
   grid .file.go - - -pady 5
   grid columnconfigure .file 1 -weight 1
   place .file.about -anchor se -relx 1 -rely 1 -x -5 -y -5

   # Info area
   label .finfo.title -text "Info"
   scrollbar .finfo.sb -orient vertical -command {.finfo.info yview}
   listbox .finfo.info -width 40 -listvariable S(info) -yscroll {.finfo.sb set}

   # Catalog and data area
   label .fcat.title -text "Catalog"
   scrollbar .fcat.sb -orient vertical -command {.fcat.catalog yview}
   listbox .fcat.catalog -listvariable S(catalog) -yscroll {.fcat.sb set}
   label .fpages.title -text "Page Tree Root"
   scrollbar .fpages.sb -orient vertical -command {.fpages.pages yview}
   listbox .fpages.pages -listvariable S(pages) -yscroll {.fpages.sb set}

   frame .fpage.btns
   label .fpage.l -text "Page"
   entry .fpage.num -width 3 -textvariable S(pageNum) -justify center \
       -validate key -vcmd {string is integer -strict %P}
   button .fpage.go -image ::img::star -state disabled -command GoPage
   scrollbar .fpage.sb -orient vertical -command {.fpage.page yview}
   listbox .fpage.page -listvariable S(page) -yscroll {.fpage.sb set}

   grid .file - - - -sticky ew
   grid .finfo .fcat .fpages .fpage -sticky news
   grid columnconfigure . {1 2 3} -weight 1
   grid columnconfigure . 0 -weight 2
   grid rowconfigure . {1} -weight 1

   pack .finfo.title -side top -fill x
   pack .finfo.sb -side right -fill y
   pack .finfo.info -side top -fill both -expand 1
   pack .fcat.title -side top -fill x
   pack .fcat.sb -side right -fill y
   pack .fcat.catalog -side top -fill both -expand 1
   pack .fpages.title -side top -fill x
   pack .fpages.sb -side right -fill y
   pack .fpages.pages -side top -fill both -expand 1

   pack .fpage.btns -side top
   pack .fpage.l .fpage.num .fpage.go -in .fpage.btns -side left
   pack .fpage.sb -side right -fill y
   pack .fpage.page -side top -fill both -expand 1
   #grid x .fpage.l .fpage.num .fpage.go x
   #grid configure .fpage.go -padx 5 -sticky ns
   #grid .fpage.page - - - - .fpage.sb -sticky news
   #grid columnconfigure .fpage {0 4} -weight 1
   #grid rowconfigure .fpage {1} -weight 1

   foreach var {fname pageNum havePDF} {
       foreach t [trace info variable S($var)] {
	   eval trace remove variable S($var) $t
       }
       trace variable S($var) w Tracer
   }
   set pdfs [glob -nocomplain *.pdf]
   if {$S(fname) eq "" && [llength $pdfs] > 0} {
	set S(fname) [lindex $pdfs [expr {int(rand()*[llength $pdfs])}]]
   }
   if {$S(fname) ne ""} {
	Go
   }
}
proc Tracer {var1 var2 op} {
   global S

   if {$var1 ne "S"} return
   if {$var2 eq "fname"} {
       .file.go config -state \
	   [expr {[file isfile $S(fname)] ? "normal" : "disabled"}]
   } elseif {$var2 eq "pageNum" || $var2 eq "havePDF"} {
       set how disabled
       if {$S(havePDF) && [string is integer -strict $S(pageNum)]} {
	   set how normal
       }
       .fpage.go config -state $how
   }
}
proc ChooseFile {} {
   global S

   set fname [tk_getOpenFile -parent . -defaultextension ".pdf" \
		  -initialfile $S(fname) -filetypes {{{PDF Files} .pdf}} \
		  -title "PDF Parser Open File"]
   if {$fname eq ""} return
   set S(fname) $fname
}
proc ArrayToListBox {arrName var} {
   global S
   upvar 1 $arrName arr

   set S($var) {}
   set max 0
   foreach name [array names arr] {
       if {[string length $name] > $max} {
	   set max [string length $name]
       }
   }
   incr max 1
   if {[info exists arr(/Type)]} {
       lappend S($var) [format "  %-*s = %s" $max /Type $arr(/Type)]
   }

   foreach name [lsort -dictionary [array names arr]] {
       if {$name eq "/Type"} continue
       lappend S($var) [format "  %-*s = %s" $max $name $arr($name)]
   }
}
proc Go {} {
   global S CATALOG PAGES INFO

   set S(catalog) [set S(pages) [set S(page) {}]]
   if {! [file isfile $S(fname)]} return

   ParsePDF.File $S(fname)
   ArrayToListBox INFO info
   ArrayToListBox CATALOG catalog
   ArrayToListBox PAGES pages
   set S(havePDF) 1
   GoPage
}
proc About {} {
   set txt "Parsing PDF\nby Keith Vetter, Oct 2007\n\n"
   append txt "This program demos code that can parse PDF files. The\n"
   append txt "code displays a pdf's document structure including its\n"
   append txt "catalog and the root of its page tree. It will also show\n"
   append txt "the page object for any page.\n\n"

   append txt "For more info on PDF format see\n"
   append txt "http://partners.adobe.com/asn/tech/pdf/specifications.jsp"

   tk_messageBox -message $txt
}
proc GoPage {} {
   global S PAGES PAGE

   if {! $S(havePDF)} return
   if {! [string is integer -strict $S(pageNum)]} return
   if {$S(pageNum) < 1} {
       set S(page) {{Page number too small}}
       return
   } elseif {$S(pageNum) > $PAGES(/Count)} {
       set a [expr {$PAGES(/Count) == 1 ? "page" : "pages"}]
       set S(page) [list [list Only $PAGES(/Count) $a]]
       return
   }

   set id [GetPage $S(pageNum)]
   if {$id eq ""} {
       set S(page) "{bad page number}"
   } else {
       ArrayToListBox PAGE page
       set S(page) [concat [list "Object id: $id"] {---------} $S(page)]
   }

}
DoDisplay
return

UKo 2008-05-31: I have added some code to get the info block from the pdf-file and cleaned up the code a bit, so that it can be started with a recent tclkit (tested tclkit 8.4 and kbskit 8.5). Also the strings from the info block can be decoded.

Invocation: parsePDF.tcl ?-gui? ?file.pdf?

Without the -gui option the information will be displayed on the commandline. With -gui a given pdf-file will be analysed, without a file a random file from the current directory will be chosen.


Scott Beasley 2008-06-01: I started on a PDF Page splitter in tcl, but dropped it in favor of the iText Java Class library [L2 ] and TclBlend. The iText code does so much and has worked so well, it was hard to pass up. I know in the long run for many people though, a tcl only solution would be the best for them.