sub
new {
my
(
$class
,
%options
) =
@_
;
my
$self
=
$class
->SUPER::new(
%options
);
$$self
{split_xpath} =
$options
{split_xpath};
$$self
{splitnaming} =
$options
{splitnaming};
$$self
{no_navigation} =
$options
{no_navigation};
return
$self
; }
sub
process {
my
(
$self
,
$doc
,
$root
) =
@_
;
$root
->setAttribute(
'xml:id'
=>
'TEMPORARY_DOCUMENT_ID'
)
unless
$root
->hasAttribute(
'xml:id'
);
my
@docs
= (
$doc
);
my
@pages
=
$self
->getPages(
$doc
);
@pages
=
grep
{
$_
->parentNode->parentNode }
@pages
;
if
(
@pages
) {
my
@nav
=
$doc
->findnodes(
"descendant::ltx:navigation"
);
$doc
->removeNodes(
@nav
)
if
@nav
;
my
$tree
= {
node
=>
$root
,
document
=>
$doc
,
id
=>
$root
->getAttribute(
'xml:id'
),
name
=>
$doc
->getDestination,
children
=> [] };
my
$haschildren
= {};
presortPages(
$tree
,
$haschildren
,
@pages
);
$self
->prenamePages(
$doc
,
$tree
,
$haschildren
);
push
(
@docs
,
$self
->processPages(
$doc
, @{
$$tree
{children} }));
$self
->addNavigation(
$tree
,
@nav
)
if
@nav
;
}
my
$n
=
scalar
(
@docs
);
NoteLog((
$n
> 1 ?
" [Split into in $n TOCs]"
:
"[not split]"
));
return
@docs
; }
sub
getPages {
my
(
$self
,
$doc
) =
@_
;
return
$doc
->findnodes(
$$self
{split_xpath}); }
sub
presortPages {
my
(
$tree
,
$haschildren
,
@pages
) =
@_
;
my
$nextlevel
;
foreach
my
$page
(
@pages
) {
while
(
$$tree
{parent} && !isChild(
$page
,
$$tree
{node})) {
$tree
=
$$tree
{parent}; }
my
$entry
= {
node
=>
$page
,
upid
=>
$$tree
{id},
id
=>
$page
->getAttribute(
'xml:id'
),
parent
=>
$tree
,
children
=> [] };
$$haschildren
{
$$tree
{node}->localname } = 1;
push
(@{
$$tree
{children} },
$entry
);
$tree
=
$entry
; }
return
; }
sub
prenamePages {
my
(
$self
,
$doc
,
$tree
,
$haschildren
) =
@_
;
foreach
my
$entry
(@{
$$tree
{children} }) {
$$entry
{name} =
$self
->getPageName(
$doc
,
$$entry
{node},
$$tree
{node},
$$tree
{name},
$$haschildren
{
$$entry
{node}->localname });
$self
->prenamePages(
$doc
,
$entry
,
$haschildren
); }
return
; }
sub
processPages {
my
(
$self
,
$doc
,
@entries
) =
@_
;
my
$rootid
=
$doc
->getDocumentElement->getAttribute(
'xml:id'
);
my
$intoc
= 0;
foreach
my
$entry
(
@entries
) {
my
$node
=
$$entry
{node};
$intoc
||= (
$node
->getAttribute(
'inlist'
) ||
''
) =~ /\btoc\b/;
foreach
my
$attr
(
qw(xml:lang backgroundcolor)
) {
if
(
my
$anc
=
$doc
->findnode(
'ancestor-or-self::*[@'
.
$attr
.
'][1]'
,
$node
)) {
$node
->setAttribute(
$attr
=>
$anc
->getAttribute(
$attr
)); } } }
my
@docs
= ();
while
(
@entries
) {
my
$parent
=
$entries
[0]->{node}->parentNode;
my
@removed
= ();
while
(
my
$sib
=
$parent
->lastChild) {
$parent
->removeChild(
$sib
);
unshift
(
@removed
,
$sib
);
last
if
$sib
->isSameNode(
$entries
[0]->{node}); }
my
@toc
= ();
while
(
@entries
&&
@removed
&&
$entries
[0]->{node}->isSameNode(
$removed
[0])) {
my
$entry
=
shift
(
@entries
);
my
$page
=
$$entry
{node};
$page
->setAttribute(
inlist
=>
'toc'
)
if
$intoc
&& !
$page
->hasAttribute(
'inlist'
);
$doc
->removeNodes(
shift
(
@removed
));
my
$id
=
$page
->getAttribute(
'xml:id'
);
my
$tocentry
= [
'ltx:tocentry'
, {},
[
'ltx:ref'
, {
idref
=>
$id
,
show
=>
'toctitle'
}]];
push
(
@toc
,
$tocentry
);
my
@childdocs
=
$self
->processPages(
$doc
, @{
$$entry
{children} });
my
$subdoc
=
$doc
->newDocument(
$page
,
destination
=>
$$entry
{name},
parentDocument
=>
$doc
,
parent_id
=>
$$entry
{upid});
$$entry
{document} =
$subdoc
;
push
(
@docs
,
$subdoc
,
@childdocs
); }
my
$type
=
$parent
->localname;
$doc
->addNodes(
$parent
, [
'ltx:TOC'
, {}, [
'ltx:toclist'
, {
class
=>
'ltx_toclist_'
.
$type
},
@toc
]])
if
@toc
&& !
$doc
->findnodes(
"descendant::ltx:TOC[\@lists='toc']"
,
$parent
);
map
{
$parent
->addChild(
$_
) }
@removed
; }
return
@docs
; }
sub
addNavigation {
my
(
$self
,
$entry
,
@nav
) =
@_
;
my
$doc
=
$$entry
{document};
$doc
->addNodes(
$doc
->getDocumentElement,
@nav
);
foreach
my
$child
(@{
$$entry
{children} }) {
my
$childdoc
=
$$child
{document};
$self
->addNavigation(
$child
,
@nav
); }
return
; }
sub
generateUnnamedPageName {
my
(
$self
) =
@_
;
my
$ctr
= ++
$$self
{unnamed_page_counter};
return
"FOO"
.
$ctr
; }
sub
getPageName {
my
(
$self
,
$doc
,
$page
,
$parent
,
$parentpath
,
$recursive
) =
@_
;
my
$asdir
;
my
$naming
=
$$self
{splitnaming};
my
$attr
= (
$naming
=~ /^id/ ?
'xml:id'
: (
$naming
=~ /^label/ ?
'labels'
:
undef
));
my
$name
=
$page
->getAttribute(
$attr
);
$name
=~ s/\s+.*//
if
$name
;
if
(!
$name
) {
if
((
$attr
eq
'labels'
) && (
$name
=
$page
->getAttribute(
'xml:id'
))) {
Info(
'expected'
,
$attr
,
$doc
->getQName(
$page
),
"Using '$name' to create page pathname, instead of missing '$attr'"
);
$attr
=
'xml:id'
; }
else
{
$name
=
$self
->generateUnnamedPageName;
Info(
'expected'
,
$attr
,
$doc
->getQName(
$page
),
"Using '$name' to create page pathname, instead of missing '$attr'"
); } }
if
(
$naming
=~ /relative$/) {
my
$pname
=
$parent
->getAttribute(
$attr
);
$pname
=~ s/\s+.*//
if
$pname
;
if
(
$pname
&&
$name
=~ /^\Q
$pname
\E(\.|_|:)+(.*)$/) {
$name
= $2; }
$asdir
=
$recursive
; }
$name
=~ s/:+/_/g;
if
(
$asdir
) {
return
pathname_make(
dir
=> pathname_concat(pathname_directory(
$parentpath
),
$name
),
name
=>
'index'
,
type
=>
$doc
->getDestinationExtension); }
else
{
return
pathname_make(
dir
=> pathname_directory(
$parentpath
),
name
=>
$name
,
type
=>
$doc
->getDestinationExtension); } }
1;