#----------------------------------------------------------------------
} elsif ($tag eq 'frameset') {
if(
!($self->{'_frameset_seen'}++) # first frameset seen
and !$self->{'_noframes_seen'}
# otherwise it'll be under the noframes already
and !$self->is_inside('body')
) {
# The following is a bit of a hack. We don't use the normal
# insert_element because 1) we don't want it as _pos, but instead
# right under $self, and 2), more importantly, that we don't want
# this inserted at the /end/ of $self's content_list, but instead
# in the middle of it, specifiaclly right before the body element.
#
my $c = $self->{'_content'} || die "Contentless root?";
my $body = $self->{'_body'} || die "Where'd my BODY go?";
for(my $i = 0; $i < @$c; ++$i) {
if($c->[$i] eq $body) {
splice(@$c, $i, 0, $self->{'_pos'} = $pos = $e);
$e->{'_parent'} = $self;
$already_inserted = 1;
print $indent, " * inserting 'frameset' right before BODY.\n"
if DEBUG > 1;
last;
}
}
die "BODY not found in children of root?" unless $already_inserted;
}
} elsif ($tag eq 'frame') {
# Okay, fine, pass thru.
# Should probably enforce that these should be under a frameset.
# But hey. Ditto for enforcing that 'noframes' should be under
# a 'frameset', as the DTDs say.
} elsif ($tag eq 'noframes') {
# This basically assumes there'll be exactly one 'noframes' element
# per document. At least, only the first one gets to have the
# body under it. And if there are no noframes elements, then
# the body pretty much stays where it is. Is that ever a problem?
if($self->{'_noframes_seen'}++) {
print $indent, " * ANOTHER noframes element?\n" if DEBUG;
} else {
if($pos->is_inside('body')) {
print $indent, " * 'noframes' inside 'body'. Odd!\n" if DEBUG;
# In that odd case, we /can't/ make body a child of 'noframes',
# because it's an ancestor of the 'noframes'!
} else {
$e->push_content( $self->{'_body'} || die "Where'd my body go?" );
print $indent, " * Moving body to be under noframes.\n" if DEBUG;
}
}
#----------------------------------------------------------------------
} else {
# unknown tag
if ($self->{'_ignore_unknown'}) {
print $indent, " * Ignoring unknown tag \U$tag\E\n" if DEBUG;
$self->warning("Skipping unknown tag $tag");
return;
} else {
print $indent, " * Accepting unknown tag \U$tag\E\n"
if DEBUG;
}
}
#----------------------------------------------------------------------
# End of mumbo-jumbo
print
$indent, "(Attaching ", $e->{'_tag'}, " under ",
($self->{'_pos'} || $self)->{'_tag'}, ")\n"
# because if _pos isn't defined, it goes under self
if DEBUG;
# The following if-clause is to delete /some/ ignorable whitespace
# nodes, as we're making the tree.
# This'd be a node we'd catch later anyway, but we might as well
# nip it in the bud now.
# This doesn't catch /all/ deletable WS-nodes, so we do have to call
# the tightener later to catch the rest.
if($self->{'_tighten'} and !$self->{'_ignore_text'}) { # if tightenable
my($sibs, $par);
if(
($sibs = ( $par = $self->{'_pos'} || $self )->{'_content'})
and @$sibs # parent already has content
and !ref($sibs->[-1]) # and the last one there is a text node
and $sibs->[-1] !~ m<[^\n\r\f\t ]>s # and it's all whitespace
and ( # one of these has to be eligible...
$HTML::TreeBuilder::canTighten{$tag}
or
(
(@$sibs == 1)
? # WS is leftmost -- so parent matters
$HTML::TreeBuilder::canTighten{$par->{'_tag'}}
: # WS is after another node -- it matters
(ref $sibs->[-2]
=7= |
