CAM-PDF
view release on metacpan or search on metacpan
lib/CAM/PDF.pm view on Meta::CPAN
{
my $objnum = $self->getPageObjnum($pagenum);
if (exists $page->{Resources})
{
my $r = $self->getValue($page->{Resources});
for my $key ('XObject', 'Font')
{
if (exists $r->{$key})
{
my $x = $self->getValue($r->{$key});
if ((ref $x) eq 'HASH')
{
%n = (%{$x}, %n);
}
}
}
}
# Inherit from parent
$page = $page->{Parent};
if ($page)
{
$page = $self->getValue($page);
}
}
$self->{Names}->{$pagenum} = {%n};
return;
}
=item $doc->getRootDict()
Returns the Root dictionary for the PDF.
=cut
sub getRootDict
{
my $self = shift;
return $self->getValue($self->{trailer}->{Root});
}
=item $doc->getPagesDict()
Returns the root Pages dictionary for the PDF.
=cut
sub getPagesDict
{
my $self = shift;
return $self->getValue($self->getRootDict()->{Pages});
}
=item $doc->parseObj($string)
Use parseAny() instead of this, if possible.
Given a fragment of PDF page content, parse it and return an object
Node. This can be called as a class method in most circumstances, but
is intended as an instance method.
=cut
sub parseObj
{
my $self = shift;
my $c = shift;
if (${$c} !~ m/ \G\s*(\d+)\s+(\d+)\s+obj\s* /cgxms) ##no critic(ProhibitUnusedCapture)
{
die "Expected object open tag\n" . $self->trimstr(${$c});
}
# need to implement like this with explicit capture vars for 5.6.1
# compatibility
my ($objnum, $gennum) = ($1, $2); ##no critic(ProhibitCaptureWithoutTest)
$objnum = int $objnum;
$gennum = int $gennum;
my $objnode;
if (${$c} =~ m/ \G(.*?)endobj\s* /cgxms)
{
my $string = $1;
$objnode = $self->parseAny(\$string, $objnum, $gennum);
if ($string =~ m/ \Gstream /xms)
{
if ($objnode->{type} ne 'dictionary')
{
die "Found an object stream without a preceding dictionary\n" . $self->trimstr(${$c});
}
$objnode->{value}->{StreamData} = $self->parseStream(\$string, $objnum, $gennum, $objnode->{value});
}
}
else
{
die "Expected endobj\n" . $self->trimstr(${$c});
}
return CAM::PDF::Node->new('object', $objnode, $objnum, $gennum);
}
=item $doc->parseInlineImage($string)
=item $doc->parseInlineImage($string, $objnum)
=item $doc->parseInlineImage($string, $objnum, $gennum)
Given a fragment of PDF page content, parse it and return an object
Node. This can be called as a class method in some cases, but
is intended as an instance method.
=cut
sub parseInlineImage
{
my $self = shift;
my $c = shift;
my $objnum = shift;
my $gennum = shift;
if (${$c} !~ m/ \GBI\b /xms)
{
die "Expected inline image open tag\n" . $self->trimstr(${$c});
}
my $dict = $self->parseDict($c, $objnum, $gennum, 'BI\\b\\s*', 'ID\\b');
$self->unabbrevInlineImage($dict);
$dict->{value}->{Type} = CAM::PDF::Node->new('label', 'XObject', $objnum, $gennum);
$dict->{value}->{Subtype} = CAM::PDF::Node->new('label', 'Image', $objnum, $gennum);
$dict->{value}->{StreamData} = $self->parseStream($c, $objnum, $gennum, $dict->{value},
qr/ \s* /xms, qr/ \s*EI(?!\S) /xms);
${$c} =~ m/ \G\s+ /cgxms;
return CAM::PDF::Node->new('object', $dict, $objnum, $gennum);
}
=item $doc->writeInlineImage($objectnode)
This is the inverse of parseInlineImage(), intended for use only in
the CAM::PDF::Content class.
=cut
sub writeInlineImage
{
my $self = shift;
my $objnode = shift;
# Make a copy since we are going to trash the image
my $dictobj = $self->copyObject($objnode)->{value};
my $dict = $dictobj->{value};
delete $dict->{Type};
delete $dict->{Subtype};
my $stream = $dict->{StreamData}->{value};
delete $dict->{StreamData};
$self->abbrevInlineImage($dictobj);
my $str = $self->writeAny($dictobj);
$str =~ s/ \A << /BI /xms;
$str =~ s/ >> \z / ID/xms;
$str .= "\n" . $stream . "\nEI";
return $str;
}
=item $doc->parseStream($string, $objnum, $gennum, $dictnode)
This should only be used by parseObj(), or other specialized cases.
Given a fragment of PDF page content, parse it and return a stream
Node. This can be called as a class method in most circumstances, but
is intended as an instance method.
The dictionary Node argument is typically the body of the object Node
that precedes this stream.
=cut
sub parseStream
{
my $self = shift;
my $c = shift;
my $objnum = shift;
my $gennum = shift;
my $dict = shift;
my $begin = shift || qr/ stream[ \t]*\r?\n /xms;
my $end = shift || qr/ \s*endstream\s* /xms;
if (${$c} !~ m/ \G$begin /cgxms)
{
die "Expected stream open tag\n" . $self->trimstr(${$c});
}
my $stream;
my $l = $dict->{Length} || $dict->{L};
if (!defined $l)
{
if ($begin =~ m/ \Gstream /xms)
{
die "Missing stream length\n" . $self->trimstr(${$c});
}
if (${$c} =~ m/ \G$begin(.*?)$end /cgxms)
{
$stream = $1;
my $len = length $stream;
$dict->{Length} = CAM::PDF::Node->new('number', $len, $objnum, $gennum);
}
else
{
die "Missing stream begin/end\n" . $self->trimstr(${$c});
}
}
else
{
my $length = $self->getValue($l);
my $pos = pos ${$c};
$stream = substr ${$c}, $pos, $length;
pos(${$c}) += $length; ## no critic(CodeLayout::ProhibitParensWithBuiltins)
if (${$c} !~ m/ \G$end /cgxms)
{
die "Expected endstream\n" . $self->trimstr(${$c});
}
}
if (ref $self)
{
# in the rare case of CAM::PDF::Content::_parseInlineImage, this
# may be called as a class method, thus making the above test
# necessary
if ($self->{crypt})
{
$stream = $self->{crypt}->decrypt($self, $stream, $objnum, $gennum);
}
}
return CAM::PDF::Node->new('stream', $stream, $objnum, $gennum);
}
=item $doc->parseDict($string)
=item $doc->parseDict($string, $objnum)
=item $doc->parseDict($string, $objnum, $gennum)
Use parseAny() instead of this, if possible.
Given a fragment of PDF page content, parse it and return an dictionary
Node. This can be called as a class method in most circumstances, but
is intended as an instance method.
=cut
sub parseDict
{
my $pkg_or_doc = shift;
my $c = shift;
my $objnum = shift;
my $gennum = shift;
my $begin = shift || '<<\\s*';
my $end = shift || '>>\\s*';
my $dict = {};
if (${$c} =~ m/ \G$begin /cgxms)
{
while (${$c} !~ m/ \G$end /cgxms)
{
#warn "looking for label:\n" . $pkg_or_doc->trimstr(${$c});
my $keyref = $pkg_or_doc->parseLabel($c, $objnum, $gennum);
my $key = $keyref->{value};
#warn "looking for value:\n" . $pkg_or_doc->trimstr(${$c});
my $value = $pkg_or_doc->parseAny($c, $objnum, $gennum);
$dict->{$key} = $value;
}
}
return CAM::PDF::Node->new('dictionary', $dict, $objnum, $gennum);
}
=item $doc->parseArray($string)
=item $doc->parseArray($string, $objnum)
=item $doc->parseArray($string, $objnum, $gennum)
Use parseAny() instead of this, if possible.
Given a fragment of PDF page content, parse it and return an array
Node. This can be called as a class or instance method.
=cut
sub parseArray
{
my $pkg_or_doc = shift;
my $c = shift;
my $objnum = shift;
my $gennum = shift;
my $array = [];
if (${$c} =~ m/ \G\[\s* /cgxms)
{
while (${$c} !~ m/ \G\]\s* /cgxms)
{
#warn "looking for array value:\n" . $pkg_or_doc->trimstr(${$c});
push @{$array}, $pkg_or_doc->parseAny($c, $objnum, $gennum);
}
}
return CAM::PDF::Node->new('array', $array, $objnum, $gennum);
}
=item $doc->parseLabel($string)
=item $doc->parseLabel($string, $objnum)
=item $doc->parseLabel($string, $objnum, $gennum)
Use parseAny() instead of this, if possible.
Given a fragment of PDF page content, parse it and return a label
Node. This can be called as a class or instance method.
=cut
sub parseLabel
{
my $pkg_or_doc = shift;
my $c = shift;
my $objnum = shift;
my $gennum = shift;
my $label;
if (${$c} =~ m{ \G/([^\s<>/\[\]()]+)\s* }cgxms)
{
$label = $1;
}
else
{
die "Expected identifier label:\n" . $pkg_or_doc->trimstr(${$c});
}
return CAM::PDF::Node->new('label', $label, $objnum, $gennum);
}
=item $doc->parseRef($string)
=item $doc->parseRef($string, $objnum)
=item $doc->parseRef($string, $objnum, $gennum)
Use parseAny() instead of this, if possible.
Given a fragment of PDF page content, parse it and return a reference
Node. This can be called as a class or instance method.
=cut
sub parseRef
{
my $pkg_or_doc = shift;
my $c = shift;
my $objnum = shift;
my $gennum = shift;
my $newobjnum;
if (${$c} =~ m/ \G(\d+)\s+\d+\s+R\s* /cgxms)
{
$newobjnum = int $1;
}
else
{
die "Expected object reference\n" . $pkg_or_doc->trimstr(${$c});
}
return CAM::PDF::Node->new('reference', $newobjnum, $objnum, $gennum);
}
=item $doc->parseNum($string)
=item $doc->parseNum($string, $objnum)
=item $doc->parseNum($string, $objnum, $gennum)
Use parseAny() instead of this, if possible.
Given a fragment of PDF page content, parse it and return a number
Node. This can be called as a class or instance method.
=cut
sub parseNum
{
my $pkg_or_doc = shift;
my $c = shift;
my $objnum = shift;
my $gennum = shift;
my $value;
if (${$c} =~ m/ \G([\d.+-]+)\s* /cgxms)
{
$value = $1;
}
else
{
die "Expected numerical constant\n" . $pkg_or_doc->trimstr(${$c});
}
return CAM::PDF::Node->new('number', $value, $objnum, $gennum);
}
=item $doc->parseString($string)
=item $doc->parseString($string, $objnum)
=item $doc->parseString($string, $objnum, $gennum)
Use parseAny() instead of this, if possible.
Given a fragment of PDF page content, parse it and return a string
Node. This can be called as a class or instance method.
=cut
sub parseString
{
my $pkg_or_doc = shift;
my $c = shift;
my $objnum = shift;
my $gennum = shift;
my $value = q{};
if (${$c} =~ m/ \G [(] /cgxms)
{
# TODO: use Text::Balanced or Regexp::Common from CPAN??
my $depth = 1;
while ($depth > 0)
{
if (${$c} =~ m/ \G ([^()]*) ([()]) /cgxms)
{
my $string = $1;
my $delim = $2;
$value .= $string;
# Make sure this is not an escaped paren, OR an real paren
# preceded by an escaped backslash!
if ($string =~ m/ (\\+) \z/xms && 1 == (length $1) % 2)
{
$value .= $delim;
}
elsif ($delim eq '(')
{
$value .= $delim;
$depth++;
}
elsif(--$depth > 0)
{
$value .= $delim;
}
}
else
{
die "Expected string closing\n" . $pkg_or_doc->trimstr(${$c});
}
}
${$c} =~ m/ \G\s* /cgxms;
}
else
{
die "Expected string opener\n" . $pkg_or_doc->trimstr(${$c});
}
# Unescape slash-escaped characters. Treat \\ specially.
my @parts = split /\\\\|\\134/xms, $value, -1;
for (@parts)
{
# concatenate continued lines
s/ \\\r?\n //gxms;
s/ \\\r //gxms;
# special characters
s/ \\n /\n/gxms;
s/ \\r /\r/gxms;
s/ \\t /\t/gxms;
s/ \\f /\f/gxms;
s/ \\b /\x{8}/gxms;
# octal numbers
s/ \\(\d{1,3}) /chr oct $1/gexms;
# Ignore all other slashes (i.e. following characters are treated literally)
s/ \\ //gxms;
}
$value = join q{\\}, @parts;
if (ref $pkg_or_doc)
{
my $self = $pkg_or_doc;
if ($self->{crypt})
{
$value = $self->{crypt}->decrypt($self, $value, $objnum, $gennum);
}
}
return CAM::PDF::Node->new('string', $value, $objnum, $gennum);
}
=item $doc->parseHexString($string)
=item $doc->parseHexString($string, $objnum)
=item $doc->parseHexString($string, $objnum, $gennum)
Use parseAny() instead of this, if possible.
Given a fragment of PDF page content, parse it and return a hex string
Node. This can be called as a class or instance method.
=cut
sub parseHexString
{
my $pkg_or_doc = shift;
my $c = shift;
my $objnum = shift;
my $gennum = shift;
my $str = q{};
if (${$c} =~ m/ \G<([\da-fA-F\s]*)>\s* /cgxms)
{
$str = $1;
$str =~ s/\s+//gxms;
my $len = length $str;
if ($len % 2 == 1)
{
$str .= '0';
}
$str = pack 'H*', $str;
}
else
{
die "Expected hex string\n" . $pkg_or_doc->trimstr(${$c});
}
if (ref $pkg_or_doc)
{
my $self = $pkg_or_doc;
if ($self->{crypt})
{
$str = $self->{crypt}->decrypt($self, $str, $objnum, $gennum);
}
}
return CAM::PDF::Node->new('hexstring', $str, $objnum, $gennum);
}
=item $doc->parseBoolean($string)
=item $doc->parseBoolean($string, $objnum)
=item $doc->parseBoolean($string, $objnum, $gennum)
Use parseAny() instead of this, if possible.
Given a fragment of PDF page content, parse it and return a boolean
Node. This can be called as a class or instance method.
=cut
sub parseBoolean
{
my $pkg_or_doc = shift;
my $c = shift;
my $objnum = shift;
my $gennum = shift;
my $val = q{};
if (${$c} =~ m/ \G(true|false)\s* /cgxmsi)
{
$val = lc $1;
}
else
{
die "Expected boolean true or false keyword\n" . $pkg_or_doc->trimstr(${$c});
}
return CAM::PDF::Node->new('boolean', $val, $objnum, $gennum);
}
=item $doc->parseNull($string)
=item $doc->parseNull($string, $objnum)
=item $doc->parseNull($string, $objnum, $gennum)
Use parseAny() instead of this, if possible.
Given a fragment of PDF page content, parse it and return a null
Node. This can be called as a class or instance method.
=cut
sub parseNull
{
my $pkg_or_doc = shift;
my $c = shift;
my $objnum = shift;
my $gennum = shift;
my $val = q{};
if (${$c} =~ m/ \Gnull\s* /cgxmsi)
{
$val = undef;
}
else
{
die "Expected null keyword\n" . $pkg_or_doc->trimstr(${$c});
}
return CAM::PDF::Node->new('null', $val, $objnum, $gennum);
}
=item $doc->parseAny($string)
=item $doc->parseAny($string, $objnum)
=item $doc->parseAny($string, $objnum, $gennum)
Given a fragment of PDF page content, parse it and return a Node of
the appropriate type. This can be called as a class or instance
method.
=cut
sub parseAny
{
my $p = shift; # pkg or doc
my $c = shift;
my $objnum = shift;
my $gennum = shift;
return ${$c} =~ m/ \G \d+\s+\d+\s+R\b /xms ? $p->parseRef( $c, $objnum, $gennum)
: ${$c} =~ m{ \G / }xms ? $p->parseLabel( $c, $objnum, $gennum)
: ${$c} =~ m/ \G << /xms ? $p->parseDict( $c, $objnum, $gennum)
: ${$c} =~ m/ \G \[ /xms ? $p->parseArray( $c, $objnum, $gennum)
: ${$c} =~ m/ \G [(] /xms ? $p->parseString( $c, $objnum, $gennum)
: ${$c} =~ m/ \G < /xms ? $p->parseHexString($c, $objnum, $gennum)
: ${$c} =~ m/ \G [\d.+-]+ /xms ? $p->parseNum( $c, $objnum, $gennum)
: ${$c} =~ m/ \G (true|false) /ixms ? $p->parseBoolean( $c, $objnum, $gennum)
: ${$c} =~ m/ \G null /ixms ? $p->parseNull( $c, $objnum, $gennum)
: die "Unrecognized type in parseAny:\n" . $p->trimstr(${$c});
}
################################################################################
=back
=head2 Data Accessors
=over
=item $doc->getValue($object)
I<For INTERNAL use>
Dereference a data object, return a value. Given an node object
of any kind, returns raw scalar object: hashref, arrayref, string,
number. This function follows all references, and descends into all
objects.
=cut
sub getValue
{
my $self = shift;
my $objnode = shift;
return if (! ref $objnode);
while ($objnode->{type} eq 'reference' || $objnode->{type} eq 'object')
{
if ($objnode->{type} eq 'reference')
{
my $objnum = $objnode->{value};
$objnode = $self->dereference($objnum);
}
elsif ($objnode->{type} eq 'object')
{
$objnode = $objnode->{value};
lib/CAM/PDF.pm view on Meta::CPAN
getValue() function, but used when all you know is the object number.
=cut
sub getObjValue
{
my $self = shift;
my $objnum = shift;
return $self->getValue(CAM::PDF::Node->new('reference', $objnum));
}
=item $doc->dereference($objectnum)
=item $doc->dereference($name, $pagenum)
I<For INTERNAL use>
Dereference a data object, return a PDF object as a node. This
function makes heavy use of the internal object cache. Most (if not
all) object requests should go through this function.
C<$name> should look something like '/R12'.
=cut
sub dereference
{
my $self = shift;
my $key = shift;
my $pagenum = shift; # only used if $key is a named resource
if ($key =~ s/ \A\/ //xms) # strip off the leading slash while testing
{
# This is a request for a named object
$self->_buildNameTable($pagenum);
$key = $self->{Names}->{$pagenum}->{$key};
return if (!defined $key);
# $key should now point to a 'reference' object
if ((ref $key) ne 'CAM::PDF::Node')
{
die "Assertion failed: key is a reference object in dereference\n";
}
$key = $key->{value};
}
$key = int $key;
if (!exists $self->{objcache}->{$key})
{
#print "Filling cache for obj \#$key...\n";
my $pos = $self->{xref}->{$key};
if (!$pos)
{
warn "Bad request for object $key at position 0 in the file\n";
return;
}
my $content_fragment;
if (ref $pos)
{
$content_fragment = substr $pos->{objstream}->{stream}, $pos->{start}, $pos->{end};
$content_fragment = "$key 0 obj\n$content_fragment\nendobj\n";
}
else
{
# This is fastest and safest
if (!exists $self->{endxref})
{
$self->_buildendxref();
}
my $endpos = $self->{endxref}->{$key};
if (!defined $endpos || $endpos < $pos)
{
# really slow, but a totally safe fallback
$endpos = $self->{contentlength};
}
$content_fragment = substr $self->{content}, $pos, $endpos - $pos;
}
$self->{objcache}->{$key} = $self->parseObj(\$content_fragment, $key);
}
return $self->{objcache}->{$key};
}
=item $doc->getPropertyNames($pagenum)
=item $doc->getProperty($pagenum, $propertyname)
Each PDF page contains a list of resources that it uses (images,
fonts, etc). getPropertyNames() returns an array of the names of
those resources. getProperty() returns a node representing a
named property (most likely a reference node).
=cut
sub getPropertyNames
{
my $self = shift;
my $pagenum = shift;
$self->_buildNameTable($pagenum);
my $props = $self->{Names}->{$pagenum};
return if (!defined $props);
return keys %{$props};
}
sub getProperty
{
my $self = shift;
my $pagenum = shift;
my $name = shift;
$self->_buildNameTable($pagenum);
my $props = $self->{Names}->{$pagenum};
return if (!defined $props);
return if (!defined $name);
return $props->{$name};
}
=item $doc->getFont($pagenum, $fontname)
I<For INTERNAL use>
Returns a dictionary for a given font identified by its label,
referenced by page.
=cut
sub getFont
{
my $self = shift;
my $pagenum = shift;
my $fontname = shift;
$fontname =~ s/ \A\/? /\//xms; # add leading slash if needed
my $objnode = $self->dereference($fontname, $pagenum);
return if (!$objnode);
my $dict = $self->getValue($objnode);
lib/CAM/PDF.pm view on Meta::CPAN
else
{
open my $fh, '>', $file or die "Failed to write file $file\n";
binmode $fh or die "Failed to set binmode for file $file\n";
print {$fh} $self->{content};
close $fh or die "Failed to write file $file\n";
}
return $self;
}
=item $doc->cleanoutput($file)
=item $doc->cleanoutput()
Call the clean() function, then call the output() function to write a
fresh copy of the document to a file.
=cut
sub cleanoutput
{
my $self = shift;
my $file = shift;
$self->clean();
return $self->output($file);
}
=item $doc->writeObject($objnum)
Return the serialization of the specified object.
=cut
sub writeObject
{
my $self = shift;
my $objnum = shift;
return "$objnum 0 " . $self->writeAny($self->dereference($objnum));
}
=item $doc->writeString($string)
Return the serialization of the specified string. Works on normal or
hex strings. If encryption is desired, the string should be encrypted
before being passed here.
=cut
sub writeString
{
my $pkg_or_doc = shift;
my $string = shift;
# Divide the string into manageable pieces, which will be
# re-concatenated with "\" continuation characters at the end of
# their lines
# -- This code used to do concatenation by juxtaposing multiple
# -- "(<fragment>)" compenents, but this breaks many PDF
# -- implementations (incl Acrobat5 and XPDF)
# Break the string into pieces of length $maxstr. Note that an
# artifact of this usage of split returns empty strings between
# the fragments, so grep them out
my $maxstr = (ref $pkg_or_doc) ? $pkg_or_doc->{maxstr} : $CAM::PDF::MAX_STRING;
my @strs = grep {$_ ne q{}} split /(.{$maxstr}})/xms, $string;
for (@strs)
{
s/ \\ /\\\\/gxms; # escape escapes -- this line must come first!
s/ ([()]) /\\$1/gxms; # escape parens
s/ \n /\\n/gxms;
s/ \r /\\r/gxms;
s/ \t /\\t/gxms;
s/ \f /\\f/gxms;
# TODO: handle backspace char
#s/ ??? /\\b/gxms;
}
return '(' . (join "\\\n", @strs) . ')';
}
=item $doc->writeAny($node)
Returns the serialization of the specified node. This handles all
Node types, including object Nodes.
=cut
sub writeAny
{
my $self = shift;
my $objnode = shift;
if (! ref $objnode)
{
die 'Not a ref';
}
my $key = $objnode->{type};
my $val = $objnode->{value};
my $objnum = $objnode->{objnum};
my $gennum = $objnode->{gennum};
return $key eq 'string' ? $self->writeString($self->{crypt}->encrypt($self, $val, $objnum, $gennum))
: $key eq 'hexstring' ? '<' . (unpack 'H*', $self->{crypt}->encrypt($self, $val, $objnum, $gennum)) . '>'
: $key eq 'number' ? "$val"
: $key eq 'reference' ? "$val 0 R" # TODO: lookup the gennum and use it instead of 0 (?)
: $key eq 'boolean' ? $val
: $key eq 'null' ? 'null'
: $key eq 'label' ? "/$val"
: $key eq 'array' ? $self->_writeArray($objnode)
: $key eq 'dictionary' ? $self->_writeDictionary($objnode)
: $key eq 'object' ? $self->_writeObject($objnode)
: die "Unknown key '$key' in writeAny (objnum ".($objnum||'<none>').")\n";
}
sub _writeArray
{
my $self = shift;
my $objnode = shift;
my $val = $objnode->{value};
if (@{$val} == 0)
( run in 1.195 second using v1.01-cache-2.11-cpan-364913b4093 )