use warnings;
use strict;
my $infile = shift || die "You have to give a pdf-file as an argument, aborts\n";
my $outfile = shift;
my $valFile;
my ($line, @lines, $yes, $xCounter, $yCounter, %xPos, %yPos, $declare,
$stream, $xMin, $yMin, $colors, %color, $xMax, $yMax, $long, @words,
$packName, %extObj, $xObject, $var, %initValues, %seen, $string, @seq);
my $round = 1;
##############################
# Counters for PDF operators
##############################
my %graphOp = (c => 0,
cm => 0,
CS => 0,
cs => 0,
d => 0,
Do => 0,
G => 0,
g => 0,
gs => 0,
i => 0,
j => 0,
J => 0,
k => 0,
K => 0,
l => 0,
m => 0,
M => 0,
re => 0,
rg => 0,
RG => 0,
sc => 0,
SC => 0,
scn => 0,
SCN => 0,
sh => 0,
Tf => 0,
Tm => 0,
Tj => 0,
y => 0,
v => 0,
w => 0);
#####################################
# Descriptions of PDF operators
#####################################
my %descr = (c => 'curv',
cm => 'matrix',
CS => 'strokeColSpace',
cs => 'fillColSpace',
d => 'dash',
Do => 'invoke',
G => 'greyStroke',
g => 'greyFill',
gs => 'graphState',
i => 'flatness',
j => 'join',
J => 'cap',
k => 'fillCMYK',
K => 'strokeCMYK',
l => 'line',
m => 'moveTo',
M => 'miter',
re => 'rectangle',
rg => 'fillRGB',
RG => 'strokeRGB',
sc => 'fillCol',
SC => 'strokeCol',
scn => 'fillICC',
SCN => 'strokeICC',
sh => 'shade',
Tf => 'font',
Tm => 'tMatrix',
Tj => 'text',
Tr => 'textRender',
y => 'curvFrom',
v => 'curvTo',
w => 'lineWidth');
if ($outfile =~ m'(\w+)\.*.*'o)
{ $packName = $1;
$valFile = $1 . '.dat';
}
else
{ if ($infile =~ m'(\w+)\.*.*'o)
{ $packName = $1;
$outfile = $1 . '.pm';
$valFile = $1 . '.dat';
}
else
{ $packName = 'shape';
$outfile = 'shape.pm';
$valFile = 'shape.dat';
}
}
open (infile, "<$infile") || die "Couldn't open $infile, aborts, $!";
open (VALFILE, ">$valFile") || die "Couldn't open $valFile, aborts, $!";
while ($line = <infile>)
{ if ($yes)
{ if ($line =~ m'\bendstream\b'o)
{ last;
}
else
{
$long .= $line;
}
}
elsif ($line =~ m'\bstream\b'o)
{ $yes = 1;
}
}
close infile;
@words = split(/\s+/,$long);
undef $line;
for my $word (@words)
{ if (($word =~ m'^[a-zA-Z\*]+$'o)
|| ($word =~ m'.+\)Tj'o)
|| ($word =~ m'.+\]TJ'o))
{ $line .= $word;
push @lines, $line;
undef $line;
}
else
{ $line .= "$word ";
}
}
######################
# Process the lines
######################
$stream = 'sub init' . "\n" .
'{ my $self = shift;' . "\n" .
' my @array;' . "\n";
for $line (@lines)
{ chomp($line);
my ($x1, $x2, $x3, $y1, $y2, $y3, $extFound, $name, @list);
if ($line =~ m'^([\d\.\-]+)\s+([\d\.\-]+)\s+([ml])\s*$'o)
{ $x1 = examineX($1);
$y1 = examineY($2);
$graphOp{$3}++;
$name = $descr{$3} . $graphOp{$3};
print VALFILE "$name => '$x1 $y1',\n";
$stream .= ' $self->{\'' . $name . '\'} = ' . "'$x1 $y1';\n";
@list = ($name, $3);
}
elsif ($line =~ m'^([\d\.\-]+)\s+([\d\.\-]+)\s+([\d\.\-]+)\s+([\d\.\-]+)\s+([vy])$'o)
{ $x1 = examineX($1);
$y1 = examineY($2);
$x2 = examineX($3);
$y2 = examineY($4);
$graphOp{$5}++;
$name = $descr{$5} . $graphOp{$5};
print VALFILE "$name => '$x1 $y1 $x2 $y2',\n";
$stream .= ' $self->{\'' . $name . '\'} = ' . "'$x1 $y1 $x2 $y2';\n";
@list = ($name, $5);
}
elsif ($line =~ m'^([\d\.\-]+)\s+([\d\.\-]+)\s+([\d\.\-]+)\s+([\d\.\-]+)\s+([\d\.\-]+)\s+([\d\.\-]+)\s+c\s*$'o)
{ $x1 = examineX($1);
$y1 = examineY($2);
$x2 = examineX($3);
$y2 = examineY($4);
$x3 = examineX($5);
$y3 = examineY($6);
$graphOp{'c'}++;
$name = $descr{'c'} . $graphOp{'c'};
print VALFILE "$name => '$x1 $y1 $x2 $y2 $x3 $y3',\n";
$stream .= ' $self->{\'' . $name . '\'} = ' . "'$x1 $y1 $x2 $y2 $x3 $y3';\n";
@list = ($name, 'c');
}
elsif ($line =~ m'^([\d\.\-]+)\s+([\d\.\-]+)\s+([\d\.\-]+)\s+([\d\.\-]+)\s+re$'o)
{ $x1 = examineX($1);
$y1 = examineY($2);
$graphOp{'re'}++;
$name = $descr{'re'} . $graphOp{'re'};
print VALFILE "$name => '$x1 $y1 $3 $4',\n";
$stream .= ' $self->{\'' . $name . '\'} = ' . "'$x1 $y1 $3 $4';\n";
@list = ($name, 're');
}
elsif ($line =~ m'^([\d\.\-]+)\s+([\d\.\-]+)\s+([\d\.\-]+)\s+([\d\.\-]+)\s+([\d\.\-]+)\s+([\d\.\-]+)\s+Tm\s*$'o)
{ $x1 = examineX($5);
$y1 = examineY($6);
$graphOp{'Tm'}++;
$name = $descr{'Tm'} . $graphOp{'Tm'};
print VALFILE "$name => '$1 $2 $3 $4 $x1 $y1',\n";
$stream .= ' $self->{\'' . $name . '\'} = ' . "'$1 $2 $3 $4 $x1 $y1';\n";
@list = ($name, 'Tm');
}
elsif ($line =~ m'\((.*)\)\s*Tj'o)
{ $name = entry($1, 'Tj');
$stream .= ' $self->{\'' . $name . '\'} = ' . "'$1';\n";
@list = ($name, 'Tj');
}
elsif ($line =~ m'^/(.+)\s+(\w+)$'o)
{ if ($2 eq 'ri')
{ @list = ('x', $line);
}
else
{ my $op = $2;
my $obj = $1;
my $num;
if ($obj =~ m'(\w+)\s+(\d+)'o)
{ $obj = $1;
$num = $2;
}
$name = entry($obj, $op);
$extObj{$name} = { oldName => $obj,
file => $infile,
page => 1,
type => $op};
@list = ($name," $num $op");
}
}
else
{ if ($line =~ m'^(.+)\s+(\w+)$'o)
{ if (exists $graphOp{$2})
{ $name = entry($1, $2);
$stream .= ' $self->{\'' . $name . '\'} = ' . "'$1';\n";
@list = ($name, $2);
}
else
{ @list = ('x', $line);
}
}
else
{ @list = ('x', $line);
}
}
push @seq, ["'$list[0]'", "'$list[1]'"];
}
my $i = 0;
for my $rad (@seq)
{ # $stream .= ' $self->{\'sequence\'}->[' . $i . '] = [' . $rad->[0] .
# ',' . $rad->[1] . "];\n";
$stream .= ' push @array, ['. $rad->[0] . ',' . $rad->[1] . "];\n";
print VALFILE "$i => \[$rad->[0], $rad->[1]\],\n";
$i++;
}
$stream .= ' $self->{\'sequence\'} = \\@array;' . "\n" .
' 1;' . "\n" .
'}' . "\n\n";
$declare = "package $packName;\n" .
'require PDF::Reuse;' . "\n" .
'use strict;' . "\n\n";
$xMax -= $xMin;
$yMax -= $yMin;
$declare .= "sub new\n" .
'{ my $class = shift;' . "\n" .
' my $model = shift;' . "\n" .
' my $self = {};' . "\n" .
' bless $self, $class;' . "\n" .
' $self->{\'x\'} = 0;' . "\n" .
' $self->{\'y\'} = 0;' . "\n" .
' $self->{\'rotate\'} = 0;' . "\n" .
' $self->{\'skewX\'} = 0;' . "\n" .
' $self->{\'skewY\'} = 0;' . "\n" .
' $self->{\'minX\'} = 0;' . "\n" .
' $self->{\'minY\'} = 0;' . "\n" .
' $self->{\'maxX\'} = ' . $xMax . ";\n" .
' $self->{\'maxY\'} = ' . $yMax . ";\n" .
' $self->init();' . "\n";
if (scalar %extObj)
{
for my $key (keys %extObj)
{ $declare .= ' $self->{\'' . "$key'}->{'oldName'} = '$extObj{$key}->{'oldName'}';\n" .
' $self->{\'' . "$key'}->{'file'} = '$extObj{$key}->{'file'}';\n" .
' $self->{\'' . "$key'}->{'page'} = $extObj{$key}->{'page'};\n";
}
}
$declare .= ' if (defined $model)' . "\n" .
' { for (keys %$model)' . "\n" .
' { $self->{$_} = $model->{$_};' . "\n" .
' }' . "\n" .
' }' . "\n" .
' return $self;' . "\n" .
'}' . "\n\n";
$declare .= "sub draw\n" .
'{ my $self = shift;' . "\n" .
' my %param = @_;' . "\n" .
' for (keys %param)' . "\n" .
' { if ($_ =~ m/^\d+$/o)' . "\n" .
' { $self->{\'sequence\'}->[$_] = $param{$_}; }' . "\n" .
' else' . "\n" .
' { $self->{$_} = $param{$_}; }' . "\n" .
' }' . "\n" .
' my ($str, $xSize, $ySize);' . "\n" .
' my $x = $self->{\'x\'} - ' . $xMin . ";\n" .
' my $y = $self->{\'y\'} - ' . $yMin . ";\n";
if (scalar %extObj)
{ $declare .= ' $self->resources();' . "\n";
}
$declare .= ' $self->{\'xSize\'} = 1 unless ($self->{\'xSize\'} != 0);' . "\n";
$declare .= ' $self->{\'ySize\'} = 1 unless ($self->{\'ySize\'} != 0);' . "\n";
$declare .= ' $self->{\'size\'} = 1 unless ($self->{\'size\'} != 0);' . "\n";
$declare .= ' $xSize = $self->{\'xSize\'} * $self->{\'size\'};' . "\n";
$declare .= ' $ySize = $self->{\'ySize\'} * $self->{\'size\'};' . "\n";
$declare .= ' $str .= "q\n";' . "\n" .
' $str .= ' . '"$xSize 0 0 $ySize $x $y cm\n";' . "\n";
$declare .= ' if ($self->{\'rotate\'} != 0)' . "\n" .
' { my $radian = sprintf("%.6f", $self->{\'rotate\'} / 57.296);' . "\n" .
' my $Cos = sprintf("%.6f", cos($radian));' . "\n" .
' my $Sin = sprintf("%.6f", sin($radian));' . "\n" .
' my $negSin = $Sin * -1;' . "\n" .
' $str .= "$Cos $Sin $negSin $Cos 0 0 cm\n";' . "\n" .
' }' . "\n";
$declare .= ' if (($self->{\'skewX\'} != 0) || ($self->{\'skewY\'} != 0))' . "\n" .
' { my $tanX = tan($self->{\'skewX\'});' . "\n" .
' my $tanY = tan($self->{\'skewY\'});' . "\n" .
' my $negTanY = $tanY * -1;' . "\n" .
' $str .= ' . '"1 $tanX $negTanY 1 0 0 cm\n";' . "\n" .
' }' . "\n" .
' my @array = @{$self->{\'sequence\'}};' . "\n";
$declare .= ' for my $rad (@array)' . "\n" .
' { if ($rad->[0] eq \'x\')' . "\n" .
' { if ($rad->[1] ne \' \')' . "\n" .
' { $str .= "$rad->[1]\n";' . "\n" .
' }' . "\n" .
' }' . "\n" .
' elsif (defined $rad->[1])' . "\n" .
' { $str .= "$self->{$rad->[0]} $rad->[1]\n"; }' . "\n" .
' }' . "\n" .
' $str .= "Q\n";' . "\n";
$declare .= ' PDF::Reuse::prAdd($str);' . "\n" .
'}' . "\n\n";
open (outfile, ">$outfile") || die "Couldn't open $outfile, aborts $!\n";
syswrite outfile, $declare;
syswrite outfile, $stream;
$stream = "sub resources\n" .
'{ my $self = shift;' . "\n" .
' my $answer;' . "\n";
for my $key (keys %extObj)
{ if ($extObj{$key}->{'type'} eq 'Tf') # A font
{ $stream .= ' if (exists $self->{\'font\'})' . "\n" .
' { $self->{\'' . "$key\'\}->{'newName'} = PDF::Reuse::prFont("
. '$self->{\'' . "font'});\n" .
' }' . "\n" .
' else' . "\n" .
' { $answer = PDF::Reuse::prExtract(' .
'$self->{\'' . "$key\'\}->{'oldName'}," .
'$self->{\'' . "$key\'\}->{'file'}," .
'$self->{\'' . "$key\'\}->{'page'});\n" .
' if ($answer)' . "\n" .
' { $self->{\'' . "$key\'\}->{'newName'} = " . '$answer;' . "\n" .
" }\n" .
" else\n" .
' { $self->{\'font\'} = \'H\';' . "\n" .
' $self->{\'' . "$key\'\}->{'newName'} = PDF::Reuse::prFont('H');\n" .
" }\n" .
" }\n";
}
elsif ($extObj{$key}->{'type'} eq 'gs') # A graphical state dictionary
{ $stream .= ' if ((exists $self->{\'defaultGraphState\'})' . "\n" .
' || ($self->{\'' . "$key\'\}->{'newName'} eq 'Gs0'))\n" .
' { $self->{\'' . "$key\'\}->{'newName'} = 'Gs0';\n" .
' }' . "\n" .
' else' . "\n" .
' { $answer = PDF::Reuse::prExtract(' .
'$self->{\'' . "$key\'\}->{'oldName'}," .
'$self->{\'' . "$key\'\}->{'file'}," .
'$self->{\'' . "$key\'\}->{'page'});\n" .
' if ($answer)' . "\n" .
' { $self->{\'' . "$key\'\}->{'newName'} = " . '$answer;' . "\n" .
" }\n" .
" else\n" .
' { $self->{\'' . "$key\'\}->{'newName'} = 'Gs0';\n" .
" }\n" .
" }\n";
}
else
{ $stream .= ' $answer = PDF::Reuse::prExtract(' .
'$self->{\'' . "$key\'\}->{'oldName'}," .
'$self->{\'' . "$key\'\}->{'file'}," .
'$self->{\'' . "$key\'\}->{'page'});\n" .
' if ($answer)' . "\n" .
' { $self->{\'' . "$key\'\}->{'newName'} = " . '$answer;' . "\n" .
" }\n" .
" else\n" .
' { die "Couldn\'t find $self->{\'' . "$key'}->{'oldName'}," .
'$self->{\'' . "$key'}->{'file'}," .
'$self->{\'' . "$key'}->{'page'}, aborts " . '"' . ";\n" .
" }\n";
}
}
$stream .= '}' . "\n\n";
$stream .= "sub originalDim\n" .
'{ my $self = shift;' . "\n" .
' return ($self->{\'minX\'}, $self->{\'minY\'}, $self->{\'maxX\'}, $self->{\'maxY\'});' . "\n" .
'}' . "\n\n";
$stream .= "sub tan\n" .
'{ my $tal = shift;' . "\n" .
' return (sin($tal) / cos($tal));' . "\n" .
'}' . "\n\n";
$stream .= "sub resourcesFrom\n" .
'{ my $self = shift;' . "\n";
$stream .= ' my $donor = shift;' . "\n" .
' for (keys %$donor)' . "\n" .
' { if ((exists $self->{$_})' . "\n" .
' && (ref($donor->{$_}) eq \'HASH\')' . "\n" .
' && (defined $donor->{$_}->{\'newName\'})' . "\n" .
' && (defined $donor->{$_}->{\'file\'})' . "\n" .
' && (defined $donor->{$_}->{\'page\'}))' . "\n" .
' { $self->{$_} = $donor->{$_};' . "\n" .
' }' . "\n" .
' }' . "\n" .
'}' . "\n1;\n";
syswrite outfile, $stream;
close outfile;
close VALFILE;
sub examineX
{ my $x = shift;
if (($x < $xMin) || (! defined $xMin))
{ $xMin = $x;
}
if ($round)
{ $x = sprintf("%.1f", $x);
}
if ($x > $xMax)
{ $xMax = $x;
}
return $x;
}
sub examineY
{ my $y = shift;
if (($y < $yMin) || (! defined $yMin))
{ $yMin = $y;
}
if ($round)
{ $y = sprintf("%.1f", $y);
}
if ($y > $yMax)
{ $yMax = $y;
}
return $y;
}
sub entry
{ my $value = shift;
my $operator = shift;
my $combination = $operator . $value;
my $name;
if (! exists $seen{$combination})
{ my $name = $descr{$operator} . ++$graphOp{$operator};
$seen{$combination} = $name;
print VALFILE "$name => '$value',\n";
}
return $seen{$combination};
}
__END__
=head1 AUTHOR
Lars Lundberg larslund@cpan.org
Chris Nighswonger cnighs@cpan.org
=head1 COPYRIGHT
Copyright (C) 2003 - 2004 Lars Lundberg, Solidez HB.
Copyright (C) 2005 Karin Lundberg.
Copyright (C) 2006 - 2010 Lars Lundberg, Solidez HB.
Copyright (C) 2010 - 2014 Chris Nighswonger
=head1 LICENSE
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.