BEGIN {
use
vars
qw( $VERSION $hasWeakRef $seq)
;
(
$VERSION
) =
'$Revisioning: 0.3b49 $'
=~ /\
$Revisioning
:\s+([^\s]+)/;
eval
" use WeakRef; "
;
$hasWeakRef
= $@ ? 0 : 1;
$seq
=
"AA"
;
}
require
5.006;
use
POSIX
qw( ceil floor )
;
sub
new {
my
$class
=
shift
(
@_
);
my
%opt
=
@_
;
my
$self
={};
bless
(
$self
,
$class
);
$self
->{pdf}=PDF::API2::PDF::FileAPI->new();
$self
->{
time
}=
'_'
.pdfkey(
time
());
$self
->{pdf}->{
' version'
} = 4;
$self
->{pages} = PDF::API2::PDF::Pages->new(
$self
->{pdf});
weaken(
$self
->{pages})
if
(
$hasWeakRef
);
$self
->{pages}->proc_set(
qw( PDF Text ImageB ImageC ImageI )
);
$self
->{catalog}=
$self
->{pdf}->{Root};
weaken(
$self
->{catalog})
if
(
$hasWeakRef
);
$self
->{pagestack}=[];
my
$dig
=digest16(digest32(
$class
,
$self
,
%opt
));
$self
->{pdf}->{
'ID'
}=PDFArray(PDFStr(
$dig
),PDFStr(
$dig
));
$self
->{pdf}->{
' id'
}=
$dig
;
$self
->{forcecompress}= ($^O eq
'os390'
) ? 0 : 1;
$self
->preferences(
%opt
);
if
(
$opt
{-file}) {
$self
->{
' filed'
}=
$opt
{-file};
$self
->{pdf}->create_file(
$opt
{-file});
}
return
$self
;
}
sub
preferences {
my
$self
=
shift
@_
;
my
%opt
=
@_
;
if
(
$opt
{-fullscreen}) {
$self
->{catalog}->{PageMode}=PDFName(
'FullScreen'
);
}
elsif
(
$opt
{-thumbs}) {
$self
->{catalog}->{PageMode}=PDFName(
'UseThumbs'
);
}
elsif
(
$opt
{-outlines}) {
$self
->{catalog}->{PageMode}=PDFName(
'UseOutlines'
);
}
else
{
$self
->{catalog}->{PageMode}=PDFName(
'UseNone'
);
}
if
(
$opt
{-singlepage}) {
$self
->{catalog}->{PageLayout}=PDFName(
'SinglePage'
);
}
elsif
(
$opt
{-onecolumn}) {
$self
->{catalog}->{PageLayout}=PDFName(
'OneColumn'
);
}
elsif
(
$opt
{-twocolumnleft}) {
$self
->{catalog}->{PageLayout}=PDFName(
'TwoColumnLeft'
);
}
elsif
(
$opt
{-twocolumnrigth}) {
$self
->{catalog}->{PageLayout}=PDFName(
'TwoColumnRight'
);
}
else
{
$self
->{catalog}->{PageLayout}=PDFName(
'SinglePage'
);
}
$self
->{catalog}->{ViewerPreferences}||=PDFDict();
$self
->{catalog}->{ViewerPreferences}->realise;
if
(
$opt
{-hidetoolbar}) {
$self
->{catalog}->{ViewerPreferences}->{HideToolbar}=PDFBool(1);
}
if
(
$opt
{-hidemenubar}) {
$self
->{catalog}->{ViewerPreferences}->{HideMenubar}=PDFBool(1);
}
if
(
$opt
{-hidewindowui}) {
$self
->{catalog}->{ViewerPreferences}->{HideWindowUI}=PDFBool(1);
}
if
(
$opt
{-fitwindow}) {
$self
->{catalog}->{ViewerPreferences}->{FitWindow}=PDFBool(1);
}
if
(
$opt
{-centerwindow}) {
$self
->{catalog}->{ViewerPreferences}->{CenterWindow}=PDFBool(1);
}
if
(
$opt
{-displaytitle}) {
$self
->{catalog}->{ViewerPreferences}->{DisplayDocTitle}=PDFBool(1);
}
if
(
$opt
{-righttoleft}) {
$self
->{catalog}->{ViewerPreferences}->{Direction}=PDFName(
"R2L"
);
}
if
(
$opt
{-afterfullscreenthumbs}) {
$self
->{catalog}->{ViewerPreferences}->{NonFullScreenPageMode}=PDFName(
'UseThumbs'
);
}
elsif
(
$opt
{-afterfullscreenoutlines}) {
$self
->{catalog}->{ViewerPreferences}->{NonFullScreenPageMode}=PDFName(
'UseOutlines'
);
}
else
{
$self
->{catalog}->{ViewerPreferences}->{NonFullScreenPageMode}=PDFName(
'UseNone'
);
}
if
(
$opt
{-firstpage}) {
my
(
$page
,
%o
)=@{
$opt
{-firstpage}};
$o
{-fit}=1
if
(
scalar
(
keys
%o
)<1);
if
(
defined
$o
{-fit}) {
$self
->{catalog}->{OpenAction}=PDFArray(
$page
,PDFName(
'Fit'
));
}
elsif
(
defined
$o
{-fith}) {
$self
->{catalog}->{OpenAction}=PDFArray(
$page
,PDFName(
'FitH'
),PDFNum(
$o
{-fith}));
}
elsif
(
defined
$o
{-fitb}) {
$self
->{catalog}->{OpenAction}=PDFArray(
$page
,PDFName(
'FitB'
));
}
elsif
(
defined
$o
{-fitbh}) {
$self
->{catalog}->{OpenAction}=PDFArray(
$page
,PDFName(
'FitBH'
),PDFNum(
$o
{-fitbh}));
}
elsif
(
defined
$o
{-fitv}) {
$self
->{catalog}->{OpenAction}=PDFArray(
$page
,PDFName(
'FitV'
),PDFNum(
$o
{-fitv}));
}
elsif
(
defined
$o
{-fitbv}) {
$self
->{catalog}->{OpenAction}=PDFArray(
$page
,PDFName(
'FitBV'
),PDFNum(
$o
{-fitbv}));
}
elsif
(
defined
$o
{-fitr}) {
die
"insufficient parameters to -fitr => [] "
unless
(
scalar
@{
$o
{-fitr}} == 4);
$self
->{catalog}->{OpenAction}=PDFArray(
$page
,PDFName(
'FitR'
),
map
{PDFNum(
$_
)} @{
$o
{-fitr}});
}
elsif
(
defined
$o
{-xyz}) {
die
"insufficient parameters to -xyz => [] "
unless
(
scalar
@{
$o
{-xyz}} == 3);
$self
->{catalog}->{OpenAction}=PDFArray(
$page
,PDFName(
'XYZ'
),
map
{PDFNum(
$_
)} @{
$o
{-xyz}});
}
}
$self
->{pdf}->out_obj(
$self
->{catalog});
return
$self
;
}
sub
proc_pages {
my
(
$pdf
,
$pgs
) =
@_
;
my
(
$pg
,
$pgref
,
@pglist
);
if
(
defined
(
$pgs
->{Resources})) {
eval
{
$pgs
->{Resources}->realise;
};
}
foreach
$pgref
(
$pgs
->{
'Kids'
}->elementsof) {
$pg
=
$pdf
->read_obj(
$pgref
);
if
(
$pg
->{
'Type'
}->val =~ m/^Pages$/o) {
push
(
@pglist
, proc_pages(
$pdf
,
$pg
));
}
else
{
$pgref
->{
' pnum'
} =
$pcount
++;
if
(
defined
(
$pg
->{Resources})) {
eval
{
$pg
->{Resources}->realise;
};
}
weaken(
$pgref
)
if
(
$hasWeakRef
);
push
(
@pglist
,
$pgref
);
}
}
return
(
@pglist
);
}
sub
open
{
my
$class
=
shift
(
@_
);
my
$file
=
shift
(
@_
);
my
%opt
=
@_
;
my
$self
={};
bless
(
$self
,
$class
);
$self
->
default
(
'Compression'
,1);
$self
->
default
(
'subset'
,1);
$self
->
default
(
'update'
,1);
foreach
my
$para
(
keys
(
%opt
)) {
$self
->
default
(
$para
,
$opt
{
$para
});
}
die
"File '$file' does not exist."
unless
(-f
$file
);
my
$fh
=PDF::API2::IOString->new();
$fh
->import_from_file(
$file
);
$self
->{pdf}=PDF::API2::PDF::FileAPI->
open
(
$fh
,1);
$self
->{pdf}->{
' fname'
}=
$file
;
$self
->{pdf}->{
'Root'
}->realise;
$self
->{pages}=
$self
->{pdf}->{
'Root'
}->{
'Pages'
}->realise;
weaken(
$self
->{pages})
if
(
$hasWeakRef
);
$self
->{pdf}->{
' version'
} = 3;
my
@pages
=proc_pages(
$self
->{pdf},
$self
->{pages});
$self
->{pagestack}=[
sort
{
$a
->{
' pnum'
} <=>
$b
->{
' pnum'
}}
@pages
];
$self
->{catalog}=
$self
->{pdf}->{Root};
$self
->{reopened}=1;
$self
->{
time
}=
'_'
.pdfkey(
time
());
my
$dig
=digest16(digest32(
$class
,
$file
,
%opt
));
if
(
defined
$self
->{pdf}->{
'ID'
}){
$self
->{pdf}->{
'ID'
}->realise;
$self
->{pdf}->{
' id'
}=
$self
->{pdf}->{
'ID'
}->val->[0]->val;
$self
->{pdf}->{
'ID'
}=PDFArray(PDFStr(
$self
->{pdf}->{
' id'
}),PDFStr(
$dig
));
}
else
{
$self
->{pdf}->{
'ID'
}=PDFArray(PDFStr(
$dig
),PDFStr(
$dig
));
$self
->{pdf}->{
' id'
}=
$dig
;
}
$self
->{forcecompress}= ($^O eq
'os390'
) ? 0 : 1;
return
$self
;
}
sub
page {
my
$self
=
shift
;
my
$index
=
shift
|| 0;
my
$page
;
if
(
$index
==0) {
$page
=PDF::API2::Page->new(
$self
->{pdf},
$self
->{pages});
}
else
{
$page
=PDF::API2::Page->new(
$self
->{pdf},
$self
->{pages},
$index
);
}
$page
->{
' apipdf'
}=
$self
->{pdf};
weaken(
$page
->{
' apipdf'
})
if
(
$hasWeakRef
);
$page
->{
' api'
}=
$self
;
weaken(
$page
->{
' api'
})
if
(
$hasWeakRef
);
$self
->{pdf}->out_obj(
$page
);
$self
->{pdf}->out_obj(
$self
->{pages});
if
(
$index
==0) {
push
(@{
$self
->{pagestack}},
$page
);
}
elsif
(
$index
<0) {
splice
(@{
$self
->{pagestack}},
$index
,0,
$page
);
}
else
{
splice
(@{
$self
->{pagestack}},
$index
-1,0,
$page
);
}
return
$page
;
}
sub
unfilter {
my
(
$filter
,
$stream
)=
@_
;
if
((
defined
$filter
) ) {
if
(
ref
(
$filter
)!~/Array$/) {
$filter
= PDFArray(
$filter
);
}
my
@filts
;
my
(
$hasflate
) = -1;
my
(
$temp
,
$i
,
$temp1
);
@filts
=(
map
{ (
"PDF::API2::PDF::"
.(
$_
->val))->new }
$filter
->elementsof);
foreach
my
$f
(
@filts
) {
$stream
=
$f
->infilt(
$stream
, 1);
}
}
return
(
$stream
);
}
sub
dofilter {
my
(
$filter
,
$stream
)=
@_
;
if
((
defined
$filter
) ) {
if
(
ref
(
$filter
)!~/Array$/) {
$filter
= PDFArray(
$filter
);
}
my
@filts
;
my
(
$hasflate
) = -1;
my
(
$temp
,
$i
,
$temp1
);
@filts
=(
map
{ (
"PDF::API2::PDF::"
.(
$_
->val))->new }
$filter
->elementsof);
foreach
my
$f
(
@filts
) {
$stream
=
$f
->outfilt(
$stream
, 1);
}
}
return
(
$stream
);
}
sub
openpage {
my
$self
=
shift
@_
;
my
$index
=
shift
@_
||0;
my
$page
;
if
(
$index
==0) {
$page
=
$self
->{pagestack}->[-1];
}
elsif
(
$index
<0) {
$page
=
$self
->{pagestack}->[
$index
];
}
else
{
$page
=
$self
->{pagestack}->[
$index
-1];
}
if
(
ref
(
$page
) ne
'PDF::API2::Page'
) {
$page
=PDF::API2::Page->coerce(
$self
->{pdf},
$page
);
if
(
$index
==0) {
$self
->{pagestack}->[-1]=
$page
;
}
elsif
(
$index
<0) {
$self
->{pagestack}->[
$index
]=
$page
;
}
else
{
$self
->{pagestack}->[
$index
-1]=
$page
;
}
if
(
defined
$page
->{Contents} && (!
defined
(
$page
->{
' fixed'
}) ||
$page
->{
' fixed'
}<1) ) {
$page
->fixcontents;
my
$uncontent
=
$page
->{Contents};
delete
$page
->{Contents};
my
$content
=
$page
->hybrid();
foreach
my
$k
(
$uncontent
->elementsof) {
$k
->realise;
$content
->{
' stream'
}.=
" "
.unfilter(
$k
->{Filter},
$k
->{
' stream'
}).
" "
;
}
if
(
$self
->{forcecompress}>0){
$content
->{
' stream'
}.=
"\n Q \n"
;
$content
->compress;
$content
->{
' stream'
}=dofilter(
$content
->{Filter},
$content
->{
' stream'
});
$content
->{
' nofilt'
}=1;
$content
->{Length}=PDFNum(
length
(
$content
->{
' stream'
}));
}
$page
->{
' fixed'
}=1;
}
}
$page
->{
' api'
}=
$self
;
weaken(
$page
->{
' api'
})
if
(
$hasWeakRef
);
$page
->{
' reopened'
}=1;
return
(
$page
);
}
sub
clonepage {
my
$self
=
shift
@_
;
my
$s_idx
=
shift
@_
||0;
my
$t_idx
=
shift
@_
||0;
$t_idx
=0
if
(
$self
->pages<
$t_idx
);
my
(
$s_page
,
$t_page
);
$s_page
=
$self
->openpage(
$s_idx
);
$t_page
=
$self
->page(
$t_idx
);
$s_page
->copy(
$self
->{pdf},
$t_page
);
if
(
defined
(
$t_page
->{Resources})) {
$t_page
->{Resources}->realise
if
(
$t_page
->{Resources}->is_obj(
$self
->{pdf}));
$t_page
->{Resources}=
$t_page
->{Resources}->copy(
$self
->{pdf});
$t_page
->{Resources}->{
' realised'
}=1;
}
if
(
defined
(
$t_page
->{Contents})) {
$t_page
->fixcontents;
$s_page
->fixcontents;
$t_page
->{Contents}->{
' val'
}=[];
$t_page
->{Contents}->add_elements(
$s_page
->{Contents}->elementsof);
}
delete
$t_page
->{
' reopened'
};
$self
->{pdf}->out_obj(
$t_page
);
$self
->{pdf}->out_obj(
$self
->{pages});
return
(
$t_page
);
}
sub
walk_obj {
my
(
$objs
,
$spdf
,
$tpdf
,
$obj
,
@keys
)=
@_
;
my
$tobj
;
if
(
ref
(
$obj
)=~/Objind$/) {
$obj
->realise;
}
return
(
$objs
->{
scalar
$obj
})
if
(
defined
$objs
->{
scalar
$obj
});
$tobj
=
$obj
->copy;
$tpdf
->new_obj(
$tobj
)
if
(
$obj
->is_obj(
$spdf
));
$objs
->{
scalar
$obj
}=
$tobj
;
if
(
ref
(
$obj
)=~/Array$/) {
$tobj
->{
' val'
}=[];
foreach
my
$k
(
$obj
->elementsof) {
$k
->realise
if
(
ref
(
$k
)=~/Objind$/);
$tobj
->add_elements(walk_obj(
$objs
,
$spdf
,
$tpdf
,
$k
));
}
}
elsif
(
ref
(
$obj
)=~/Dict$/) {
@keys
=
keys
(%{
$tobj
})
if
(
scalar
@keys
<1);
foreach
my
$k
(
@keys
) {
next
if
(
$k
=~/^ /);
next
unless
(
defined
(
$obj
->{
$k
}));
$tobj
->{
$k
}=walk_obj(
$objs
,
$spdf
,
$tpdf
,
$obj
->{
$k
});
}
if
(
$obj
->{
' stream'
}) {
if
(
$tobj
->{Filter}) {
$tobj
->{
' nofilt'
}=1;
}
else
{
delete
$tobj
->{
' nofilt'
};
$tobj
->{Filter}=PDFArray(PDFName(
'FlateDecode'
));
}
$tobj
->{
' stream'
}=
$obj
->{
' stream'
};
}
}
delete
$tobj
->{
' streamloc'
};
delete
$tobj
->{
' streamsrc'
};
return
(
$tobj
);
}
sub
importpage {
my
$self
=
shift
@_
;
my
$s_pdf
=
shift
@_
;
my
$s_idx
=
shift
@_
||0;
my
$t_idx
=
shift
@_
||0;
my
(
$s_page
,
$t_page
);
if
(
ref
(
$s_idx
) eq
'PDF::API2::Page'
) {
$s_page
=
$s_idx
;
}
else
{
$s_page
=
$s_pdf
->openpage(
$s_idx
);
}
if
(
ref
(
$t_idx
) eq
'PDF::API2::Page'
) {
$t_page
=
$t_idx
;
}
else
{
$t_idx
=0
if
(
$self
->pages<
$t_idx
);
$t_page
=
$self
->page(
$t_idx
);
}
$self
->{apiimportcache}=
$self
->{apiimportcache}||{};
$self
->{apiimportcache}->{
$s_pdf
}=
$self
->{apiimportcache}->{
$s_pdf
}||{};
foreach
my
$k
(
qw( MediaBox ArtBox TrimBox BleedBox CropBox Rotate )
) {
next
unless
(
defined
$s_page
->{
$k
});
$t_page
->{
$k
} = walk_obj(
$self
->{apiimportcache}->{
$s_pdf
},
$s_pdf
->{pdf},
$self
->{pdf},
$s_page
->{
$k
});
}
if
(
$t_page
!=
$t_idx
) {
foreach
my
$k
(
qw( B Dur Hid Trans AA PieceInfo LastModified SeparationInfo ID PZ )
) {
next
unless
(
defined
$s_page
->{
$k
});
$t_page
->{
$k
} = walk_obj(
$self
->{apiimportcache}->{
$s_pdf
},
$s_pdf
->{pdf},
$self
->{pdf},
$s_page
->{
$k
});
}
}
my
%resmod
=();
foreach
my
$k
(
qw( Resources )
) {
$s_page
->{
$k
}=
$s_page
->find_prop(
$k
);
next
unless
(
defined
$s_page
->{
$k
});
$s_page
->{
$k
}->realise
if
(
ref
(
$s_page
->{
$k
})=~/Objind$/);
$t_page
->{
$k
}||=PDFDict();
foreach
my
$sk
(
qw( XObject ExtGState Font ProcSet Properties )
) {
next
unless
(
defined
$s_page
->{
$k
}->{
$sk
});
$s_page
->{
$k
}->{
$sk
}->realise
if
(
ref
(
$s_page
->{
$k
}->{
$sk
})=~/Objind$/);
$t_page
->{
$k
}->{
$sk
}||=PDFDict();
foreach
my
$ssk
(
keys
%{
$s_page
->{
$k
}->{
$sk
}}) {
next
if
(
$ssk
=~/^ /);
my
$nssk
=
"$seq+$ssk"
;
$resmod
{
$ssk
}=
$nssk
;
$t_page
->{
$k
}->{
$sk
}->{
$nssk
} = walk_obj(
$self
->{apiimportcache}->{
$s_pdf
},
$s_pdf
->{pdf},
$self
->{pdf},
$s_page
->{
$k
}->{
$sk
}->{
$ssk
});
$seq
++;
}
}
foreach
my
$sk
(
qw( ColorSpace Pattern Shading )
) {
next
unless
(
defined
$s_page
->{
$k
}->{
$sk
});
$s_page
->{
$k
}->{
$sk
}->realise
if
(
ref
(
$s_page
->{
$k
}->{
$sk
})=~/Objind$/);
$t_page
->{
$k
}->{
$sk
}||=PDFDict();
foreach
my
$ssk
(
keys
%{
$s_page
->{
$k
}->{
$sk
}}) {
next
if
(
$ssk
=~/^ /);
$t_page
->{
$k
}->{
$sk
}->{
$ssk
} = walk_obj(
$self
->{apiimportcache}->{
$s_pdf
},
$s_pdf
->{pdf},
$self
->{pdf},
$s_page
->{
$k
}->{
$sk
}->{
$ssk
});
}
}
}
die
"page not processed via openpage ... "
unless
(
$s_page
->{
' fixed'
}==1);
my
$content
=
$t_page
->hybrid();
if
(
defined
$s_page
->{Contents}) {
$s_page
->fixcontents;
$content
->{
' stream'
}=
''
;
my
(
$k
)=
$s_page
->{Contents}->elementsof;
$k
->realise;
if
(
$k
->{
' nofilt'
}) {
$content
->{
' stream'
}=unfilter(
$k
->{Filter},
$k
->{
' stream'
});
}
else
{
$content
->{
' stream'
}=
$k
->{
' stream'
};
}
foreach
my
$r
(
keys
%resmod
) {
$content
->{
' stream'
}=~s/\/
$r
(\x0a|\x0d|\s+)/\/
$resmod
{
$r
}$1/gm;
}
if
(
$k
->{
' nofilt'
} &&
$self
->{forcecompress}>0) {
$content
->compress;
$content
->{
' stream'
}=dofilter(
$content
->{Filter},
$content
->{
' stream'
});
$content
->{
' nofilt'
}=1;
$content
->{Length}=PDFNum(
length
(
$content
->{
' stream'
}));
}
elsif
(
$k
->{
' nofilt'
} &&
$self
->{forcecompress}<1) {
$content
->{
' stream'
}.=
' q '
;
}
else
{
}
}
if
(
$self
->{forcecompress}>0 &&
$content
->{
' nofilt'
}<0){
$content
->compress;
$content
->add(
' Q '
);
$content
->{
' stream'
}=dofilter(
$content
->{Filter},
$content
->{
' stream'
});
$content
->{
' nofilt'
}=1;
$content
->{Length}=PDFNum(
length
(
$content
->{
' stream'
}));
}
if
(
exists
$s_page
->{Annots} and
$s_page
->{Annots}) {
my
$AcroForm
;
if
(
my
$a
=
$s_pdf
->{pdf}->{Root}->realise->{AcroForm}) {
$a
->realise;
$AcroForm
= walk_obj({},
$s_pdf
->{pdf},
$self
->{pdf},
$a
,
qw( NeedAppearances SigFlags CO DR DA Q )
);
}
my
@Fields
= ();
my
@Annots
= ();
foreach
my
$a
(
$s_page
->{Annots}->elementsof) {
$a
->realise;
my
$t_a
= PDFDict;
$self
->{pdf}->new_obj(
$t_a
);
my
@k
= (
qw( Type Subtype Contents P Rect NM M F BS Border
AP AS C CA T Popup A AA StructParent
)
,
qw( Subtype Contents Open Name )
,
qw( Subtype Contents Dest H PA )
,
qw( Subtype Contents DA Q )
,
qw( Subtype Contents L BS LE IC )
,
qw( Subtype Contents BS IC )
,
qw( Subtype Contents QuadPoints )
,
qw( Subtype Contents Name )
,
qw( Subtype Contents InkList BS )
,
qw( Subtype Contents Parent Open )
,
qw( Subtype FS Contents Name )
,
qw( Subtype Sound Contents Name )
,
qw( Subtype Movie Contents A )
,
qw( Subtype Contents H MK )
,
);
push
@k
, (
qw( Subtype FT Parent Kids T TU TM Ff V DV AA )
,
qw( DR DA Q )
,
qw( Opt )
,
qw( Opt )
,
qw( MaxLen )
,
qw( Opt TI I )
,
)
if
$AcroForm
;
my
%ky
=
map
{
$_
=> 1 }
@k
;
delete
$ky
{P};
foreach
my
$k
(
keys
%ky
) {
next
unless
defined
$a
->{
$k
};
$t_a
->{
$k
} = walk_obj({},
$s_pdf
->{pdf},
$self
->{pdf},
$a
->{
$k
});
}
$t_a
->{P} =
$t_page
;
push
@Annots
,
$t_a
;
push
@Fields
,
$t_a
if
(
$AcroForm
and
$t_a
->{Subtype}->val eq
'Widget'
);
}
$t_page
->{Annots} = PDFArray(
@Annots
);
$AcroForm
->{Fields} = PDFArray(
@Fields
)
if
$AcroForm
;
$self
->{pdf}->{Root}->{AcroForm} =
$AcroForm
;
}
$t_page
->{
' imported'
} = 1;
$self
->{pdf}->out_obj(
$t_page
);
$self
->{pdf}->out_obj(
$self
->{pages});
if
(
wantarray
) {
return
(
$content
,
$t_page
);
}
else
{
return
(
$t_page
);
}
}
sub
pages {
my
$self
=
shift
@_
;
return
scalar
@{
$self
->{pagestack}};
}
sub
mediabox {
my
(
$self
,
$x1
,
$y1
,
$x2
,
$y2
) =
@_
;
if
(
defined
$x2
) {
$self
->{pages}->{
'MediaBox'
}=PDFArray(
map
{ PDFNum(float(
$_
)) } (
$x1
,
$y1
,
$x2
,
$y2
)
);
}
else
{
$self
->{pages}->{
'MediaBox'
}=PDFArray(
map
{ PDFNum(float(
$_
)) } (0,0,
$x1
,
$y1
)
);
}
$self
;
}
sub
update {
my
$self
=
shift
@_
;
$self
->saveas(
$self
->{pdf}->{
' fname'
});
}
sub
saveas {
my
(
$self
,
$file
)=
@_
;
if
(
$self
->{reopened}) {
$self
->{pdf}->append_file;
CORE::
open
(OUTF,
">$file"
);
binmode
(OUTF);
print
OUTF ${
$self
->{pdf}->{
' OUTFILE'
}->string_ref};
CORE::
close
(OUTF);
}
elsif
(
$self
->{
' filed'
}) {
$self
->{pdf}->close_file;
}
else
{
$self
->{pdf}->out_file(
$file
);
}
$self
->end;
}
sub
save {
my
(
$self
,
$file
)=
@_
;
if
(
$self
->{reopened}) {
die
"invalid method invokation: use 'saveas' instead."
;
}
elsif
(
$self
->{
' filed'
}) {
$self
->{pdf}->close_file;
}
else
{
die
"invalid method invokation: use 'saveas' instead."
;
}
$self
->end;
}
sub
save_xml {
my
(
$self
,
$file
)=
@_
;
my
$fh
=IO::File->new;
$fh
->
open
(
"> $file"
);
$self
->{pdf}->save_xml(
$fh
);
$fh
->
close
;
$self
->end;
}
sub
stringify {
my
(
$self
)=
@_
;
my
$str
;
if
((
defined
$self
->{reopened}) && (
$self
->{reopened}==1)) {
$self
->{pdf}->append_file;
$str
=${
$self
->{pdf}->{
' OUTFILE'
}->string_ref};
}
else
{
my
$fh
= PDF::API2::IOString->new();
$fh
->
open
();
eval
{
$self
->{pdf}->out_file(
$fh
);
};
$str
=${
$fh
->string_ref};
$fh
->realclose;
}
$self
->end;
return
(
$str
);
}
sub
release {
$_
[0]->end;
return
(
undef
);}
sub
end {
my
$self
=
shift
(
@_
);
$self
->{pdf}->release
if
(
defined
(
$self
->{pdf}));
foreach
my
$key
(
keys
%{
$self
})
{
$self
->{
$key
}=
undef
;
delete
(
$self
->{
$key
});
}
undef
;
}
sub
info {
my
$self
=
shift
@_
;
my
%opt
=
@_
;
if
(!
defined
(
$self
->{pdf}->{
'Info'
})) {
$self
->{pdf}->{
'Info'
}=PDFDict();
$self
->{pdf}->new_obj(
$self
->{
'pdf'
}->{
'Info'
});
}
else
{
$self
->{pdf}->{
'Info'
}->realise;
}
if
(
scalar
@_
) {
map
{
$self
->{pdf}->{
'Info'
}->{
$_
}=PDFStr(
$opt
{
$_
}||
''
)
}
qw( Author CreationDate ModDate Creator Producer Title Subject Keywords )
;
$self
->{pdf}->out_obj(
$self
->{pdf}->{
'Info'
});
}
if
(
defined
$self
->{pdf}->{
'Info'
}) {
%opt
=
map
{
(
$_
,
$self
->{pdf}->{
'Info'
}->{
$_
}->val)
if
(
defined
$self
->{pdf}->{
'Info'
}->{
$_
});
}
qw( Author CreationDate ModDate Creator Producer Title Subject Keywords )
;
}
return
(
%opt
);
}
sub
finishobjects {
my
(
$self
,
@objs
)=
@_
;
if
(
$self
->{reopened}) {
die
"invalid method invokation: no file, use 'saveas' instead."
;
}
elsif
(
$self
->{
' filed'
}) {
$self
->{pdf}->ship_out(
@objs
);
}
else
{
die
"invalid method invokation: no file, use 'saveas' instead."
;
}
}
sub
default
{
my
(
$self
,
$parameter
,
$var
)=
@_
;
$parameter
=~s/[^a-zA-Z\d]//g;
$parameter
=
lc
(
$parameter
);
my
$temp
=
$self
->{
$parameter
};
if
(
defined
$var
) {
$self
->{
$parameter
}=
$var
;
}
return
(
$temp
);
}
sub
corefont {
my
(
$self
,
$name
,
@opts
)=
@_
;
my
$obj
=PDF::API2::CoreFont->new_api(
$self
,
$name
,
@opts
);
my
$key
=
$obj
->{
' apiname'
};
$self
->{pdf}->new_obj(
$obj
)
unless
(
$obj
->is_obj(
$self
->{pdf}));
$self
->resource(
'Font'
,
$key
,
$obj
);
$self
->{pdf}->out_obj(
$self
->{pages});
return
(
$obj
);
}
sub
psfont {
my
(
$self
,
$pfb
,
$afm
,
$encoding
,
@glyphs
)=
@_
;
my
$key
=
'PSx'
.pdfkey((
$pfb
||
'x'
).(
$afm
||
'y'
),
$encoding
);
my
$obj
=PDF::API2::PSFont->new(
$self
->{pdf},
$pfb
,
$afm
,
$key
,
$encoding
,
@glyphs
);
$self
->{pdf}->new_obj(
$obj
)
unless
(
$obj
->is_obj(
$self
->{pdf}));
$obj
->{
' apiname'
}=
$key
;
$obj
->{
' apipdf'
}=
$self
->{pdf};
weaken(
$obj
->{
' apipdf'
})
if
(
$hasWeakRef
);
$obj
->{
' api'
}=
$self
;
weaken(
$obj
->{
' api'
})
if
(
$hasWeakRef
);
$self
->resource(
'Font'
,
$key
,
$obj
,
$self
->{reopened});
$self
->{pdf}->out_obj(
$self
->{pages});
return
(
$obj
);
}
sub
ttfont {
my
(
$self
,
$file
,
@opts
)=
@_
;
my
$obj
=PDF::API2::TrueTypeFont->new_api(
$self
,
$file
,
@opts
);
return
(
$obj
);
}
sub
image {
my
(
$self
,
$file
,
@opts
)=
@_
;
my
$obj
=PDF::API2::Image->new(
$self
->{pdf},
$file
,
$self
->{
time
},
@opts
);
$self
->{pdf}->new_obj(
$obj
)
unless
(
$obj
->is_obj(
$self
->{pdf}));
if
(
$obj
->{SMask}) {
$self
->{pdf}->new_obj(
$obj
->{SMask})
unless
(
$obj
->{SMask}->is_obj(
$self
->{pdf}));
}
$self
->resource(
'XObject'
,
$obj
->{
' apiname'
},
$obj
,1);
$self
->{pdf}->out_obj(
$self
->{pages});
return
(
$obj
);
}
sub
image_jpeg {
my
(
$self
,
$file
,
%opts
)=
@_
;
my
$objname
=
'JPEGx'
.pdfkey(
$file
.
time
());
my
$obj
=PDF::API2::Image->new_jpeg(
$self
->{pdf},
$objname
,
$file
);
$obj
->{
' apiname'
}=
$objname
;
$self
->{pdf}->new_obj(
$obj
)
unless
(
$obj
->is_obj(
$self
->{pdf}));
$self
->resource(
'XObject'
,
$obj
->{
' apiname'
},
$obj
,1);
$self
->{pdf}->out_obj(
$self
->{pages});
return
(
$obj
);
}
sub
image_png {
my
(
$self
,
$file
,
%opts
)=
@_
;
my
$objname
=
'PNGx'
.pdfkey(
$file
.
time
());
my
$obj
=PDF::API2::Image->new_png(
$self
->{pdf},
$objname
,
$file
);
$obj
->{
' apiname'
}=
$objname
;
$self
->{pdf}->new_obj(
$obj
)
unless
(
$obj
->is_obj(
$self
->{pdf}));
$self
->resource(
'XObject'
,
$obj
->{
' apiname'
},
$obj
,1);
$self
->{pdf}->out_obj(
$self
->{pages});
return
(
$obj
);
}
sub
image_tiff {
my
(
$self
,
$file
,
%opts
)=
@_
;
my
$objname
=
'TIFFx'
.pdfkey(
$file
.
time
());
my
$obj
=PDF::API2::Image->new_tiff(
$self
->{pdf},
$objname
,
$file
);
$obj
->{
' apiname'
}=
$objname
;
$self
->{pdf}->new_obj(
$obj
)
unless
(
$obj
->is_obj(
$self
->{pdf}));
$self
->resource(
'XObject'
,
$obj
->{
' apiname'
},
$obj
,1);
$self
->{pdf}->out_obj(
$self
->{pages});
return
(
$obj
);
}
sub
image_pnm {
my
(
$self
,
$file
,
%opts
)=
@_
;
my
$objname
=
'PNMx'
.pdfkey(
$file
.
time
());
my
$obj
=PDF::API2::Image->new_pnm(
$self
->{pdf},
$objname
,
$file
);
$obj
->{
' apiname'
}=
$objname
;
$self
->{pdf}->new_obj(
$obj
)
unless
(
$obj
->is_obj(
$self
->{pdf}));
$self
->resource(
'XObject'
,
$obj
->{
' apiname'
},
$obj
,1);
$self
->{pdf}->out_obj(
$self
->{pages});
return
(
$obj
);
}
sub
pdfimageobj {
my
$self
=
shift
@_
;
my
$s_pdf
=
shift
@_
;
my
$s_idx
=
shift
@_
||0;
my
(
$s_page
,
$t_page
);
$s_page
=
$s_pdf
->openpage(
$s_idx
);
$t_page
=PDF::API2::PdfImage->new();
$self
->{apiimportcache}=
$self
->{apiimportcache}||{};
my
$dict
=
$s_page
->find_prop(
'CropBox'
)||
$s_page
->find_prop(
'MediaBox'
);
if
(
defined
$dict
) {
my
(
$lx
,
$ly
,
$rx
,
$ry
)=
$dict
->elementsof;
$t_page
->{LX}=PDFNum(
$lx
->val);
$t_page
->{
' lx'
}=
$lx
->val;
$t_page
->{LY}=PDFNum(
$ly
->val);
$t_page
->{
' ly'
}=
$ly
->val;
$t_page
->{RX}=PDFNum(
$rx
->val);
$t_page
->{
' rx'
}=
$rx
->val;
$t_page
->{RY}=PDFNum(
$ry
->val);
$t_page
->{
' ry'
}=
$ry
->val;
}
$k
=
'Resources'
;
$s_page
->{
$k
}=
$s_page
->find_prop(
$k
);
if
(
defined
$s_page
->{
$k
}) {
$t_page
->{
$k
}=PDFDict();
foreach
my
$sk
(
qw( ColorSpace XObject ExtGState Font Pattern ProcSet Properties Shading )
) {
next
unless
(
defined
$s_page
->{
$k
}->{
$sk
});
$t_page
->{
$k
}->{
$sk
}=PDFDict();
foreach
my
$ssk
(
keys
%{
$s_page
->{
$k
}->{
$sk
}}) {
next
if
(
$ssk
=~/^ /);
$t_page
->{
$k
}->{
$sk
}->{
$ssk
} = walk_obj(
$self
->{apiimportcache},
$s_pdf
->{pdf},
$self
->{pdf},
$s_page
->{
$k
}->{
$sk
}->{
$ssk
});
}
}
}
if
(
defined
$s_page
->{Contents}) {
$s_page
->fixcontents;
foreach
my
$k
(
$s_page
->{Contents}->elementsof) {
$k
->realise
if
(
ref
(
$k
)=~/Objind$/);
$t_page
->{
' pdfimage'
}.=
" q "
.unfilter(
$k
->{
'Filter'
},
$k
->{
' stream'
}).
" Q "
;
}
}
$self
->{pdf}->new_obj(
$t_page
)
unless
(
$t_page
->is_obj(
$self
->{pdf}));
$self
->{pdf}->out_obj(
$self
->{pages});
return
(
$t_page
);
}
sub
pdfimage {
my
$self
=
shift
@_
;
my
$s_pdf
=
shift
@_
;
my
$s_idx
=
shift
@_
||0;
$s_pdf
=PDF::API2->
open
(
$s_pdf
);
my
$t_page
=
$self
->pdfimageobj(
$s_pdf
,
$s_idx
);
$s_pdf
->end;
return
(
$t_page
);
}
sub
shade {
my
(
$self
,
%opts
)=
@_
;
my
$key
=
'SHx'
.pdfkey(
%opts
||
'shade'
.
localtime
() );
my
$obj
=PDFDict();
$self
->{pdf}->new_obj(
$obj
)
unless
(
$obj
->is_obj(
$self
->{pdf}));
$obj
->{
' apiname'
}=
$key
;
$obj
->{
' apipdf'
}=
$self
->{pdf};
weaken(
$obj
->{
' apipdf'
})
if
(
$hasWeakRef
);
$obj
->{
' api'
}=
$self
;
weaken(
$obj
->{
' api'
})
if
(
$hasWeakRef
);
$self
->resource(
'Shading'
,
$key
,
$obj
,1);
$self
->{pdf}->out_obj(
$self
->{pages});
return
(
$obj
);
}
sub
pattern {
my
(
$self
,
%opts
)=
@_
;
my
$obj
=PDF::API2::Pattern->new();
my
$key
=
$obj
->{
' apiname'
};
$self
->{pdf}->new_obj(
$obj
)
unless
(
$obj
->is_obj(
$self
->{pdf}));
$self
->resource(
'Pattern'
,
$key
,
$obj
,1);
$self
->{pdf}->out_obj(
$self
->{pages});
return
(
$obj
);
}
sub
colorspace {
my
(
$self
,
@opt
)=
@_
;
my
$key
=
'CSx'
.pdfkey(
'colorspace'
,
@opt
);
my
$obj
=PDF::API2::ColorSpace->new(
$self
->{pdf},
$key
,
@opt
);
$self
->{pdf}->new_obj(
$obj
)
unless
(
$obj
->is_obj(
$self
->{pdf}));
$obj
->{
' apiname'
}=
$key
;
$self
->resource(
'ColorSpace'
,
$key
,
$obj
,1);
$self
->{pdf}->out_obj(
$self
->{pages});
return
(
$obj
);
}
sub
businesscolor {
my
$self
=
shift
@_
;
my
@col
;
my
$color
=
shift
@_
||0;
my
$ld
=
shift
@_
||0;
if
(
$color
=~/^[a-z\!\$\%\&\
@col
=namecolor(
$color
);
my
(
$hue
)=RGBtoHSV(
@col
);
@col
=HSLtoRGB(
$hue
,1,0.5+(
$ld
/10));
}
else
{
$color
-=1;
if
(
$color
<0) {
@col
=(0.5+(
$ld
/10),0.5+(
$ld
/10),0.5+(
$ld
/10));
}
else
{
@col
=HSLtoRGB(
$color
*30,1,0.5+(
$ld
/10));
}
}
return
(RGBasCMYK(
@col
));
}
sub
barcode {
my
(
$self
,
%opts
)=
@_
;
my
$key
=
'BCx'
.pdfkey(
'barcode'
.
time
().
rand
(0x7fffff));
my
$obj
=PDF::API2::Barcode->new(
$key
,
%opts
);
$self
->{pdf}->new_obj(
$obj
)
unless
(
$obj
->is_obj(
$self
->{pdf}));
$obj
->{
' apiname'
}=
$key
;
$obj
->{
' apipdf'
}=
$self
->{pdf};
weaken(
$obj
->{
' apipdf'
})
if
(
$hasWeakRef
);
$obj
->{
' api'
}=
$self
;
weaken(
$obj
->{
' api'
})
if
(
$hasWeakRef
);
$self
->resource(
'XObject'
,
$key
,
$obj
,1);
$self
->{pdf}->out_obj(
$self
->{pages});
$obj
->compress()
if
(
$self
->{forcecompress});
return
(
$obj
);
}
sub
extgstate {
my
(
$self
)=
@_
;
my
$key
=
'XTGSx'
.pdfkey(
'extgstate'
.
time
().
rand
(0x7fffff));
my
$obj
=PDF::API2::ExtGState->new(
$self
->{pdf},
$key
);
$self
->{pdf}->new_obj(
$obj
)
unless
(
$obj
->is_obj(
$self
->{pdf}));
$self
->resource(
'ExtGState'
,
$key
,
$obj
,1);
$obj
->{
' api'
}=
$self
;
weaken(
$obj
->{
' api'
})
if
(
$hasWeakRef
);
return
(
$obj
);
}
sub
outlines {
my
(
$self
)=
@_
;
$self
->{pdf}->{Root}->{Outlines}=
$self
->{pdf}->{Root}->{Outlines}
|| PDF::API2::Outlines->new(
$self
);
my
$obj
=
$self
->{pdf}->{Root}->{Outlines};
$self
->{pdf}->new_obj(
$obj
)
if
(!
$obj
->is_obj(
$self
->{pdf}));
return
(
$obj
);
}
sub
resource {
my
(
$self
,
$type
,
$key
,
$obj
,
$force
) =
@_
;
$self
->{pages}->{Resources}=
$self
->{pages}->{Resources} || PDFDict();
my
$dict
=
$self
->{pages}->{Resources};
$dict
->realise
if
(
ref
(
$dict
)=~/Objind$/);
$dict
->{
$type
}=
$dict
->{
$type
} || PDFDict();
$dict
->{
$type
}->realise
if
(
ref
(
$dict
->{
$type
})=~/Objind$/);
if
(
$force
) {
$dict
->{
$type
}->{
$key
}=
$obj
;
}
else
{
$dict
->{
$type
}->{
$key
}=
$dict
->{
$type
}->{
$key
} ||
$obj
;
}
$self
->{pdf}->out_obj(
$dict
)
if
(
$dict
->is_obj(
$self
->{pdf}));
$self
->{pdf}->out_obj(
$dict
->{
$type
})
if
(
$dict
->{
$type
}->is_obj(
$self
->{pdf}));
$self
->{pdf}->out_obj(
$obj
)
if
(
$obj
->is_obj(
$self
->{pdf}));
$self
->{pdf}->out_obj(
$self
->{pages});
return
(
$dict
);
}
1;