view release on metacpan or  search on metacpan

lib/HTML/ListToTree.pm  view on Meta::CPAN

			}
			elsif ($onUnlink eq 'ignore') {
				splice @tree, $i, 1;
				next;
			}
		}
		splice @tree, $i, 1, @{$tree[$i]{_children}}
			unless $tree[$i]{_text};
	}
	return \@tree;
}

sub _pure_text {
	my $node = shift;
	my $out = '';
	$out .= (ref $_) ? ($_->content())[0] : $_
		foreach ($node->content_list);
#	print STDERR "*** $out\n";
	return $out;
}

sub _proc_tree {
	my $node = shift;

	my $elem;
	foreach ($node->content_list) {
#
#	intermediate nodes may not be links
#
		$elem = HTML::ListToTree->new(Text => $_, Link => ''),
		next
			unless (ref $_);

		if ($_->tag eq 'a') {
			$elem = HTML::ListToTree->new(Text => _pure_text($_), Link => $_->attr('href'));
		}
		elsif (($_->tag eq 'ul') || ($_->tag eq 'ol')) {
#
#	assumes prior entry was a link/header; if not, create dummy entry
#
			$elem = HTML::ListToTree->new(Text => '', Link => '')
				unless $elem;

			$elem->addChildren(_proc_ul($_));
		}
		else {
			die "UNEXPECTED LIST TAG " . $_->tag . "\n";
#				unless ($_->tag eq 'br');
		}
	}
	return $elem;
}

sub _sort_tree {
	my ($level, $levels) = @_;

	my @nextlevel = ();
	my $entry = 0;
	my $node;
#
#	cascade the root document to all children that don't have a root
#
	foreach my $i (0..$#$level) {
		$node = $level->[$i];
		die "UNEXPECTED ARRAY"
			if (ref $node eq 'ARRAY');
		my $root = ($node->{_link} && ($node->{_link}=~/^([^\#]+)/)) ? $1 : '';
		$level->[$i]->{_node} = $i + 1;
		if (exists $node->{_children}) {
			foreach (@{$node->{_children}}) {
				$_->{_parent} = $node->{_node} - 1;
				$_->{_link} = $root . $_->{_link}
					if (substr($_->{_link}, 0, 1) eq '#');
				push @nextlevel, $_;
			}
		}
	}
	push(@$levels, \@nextlevel),
	_sort_tree(\@nextlevel, $levels)
		if scalar @nextlevel;
}

=pod

=begin classdoc

Return the current widget's Javascript.

@return	the Javascript as a string.

=end classdoc

=cut

sub getJavascript { return $_[0]->{_widget}->getJavascript(); }

=pod

=begin classdoc

Return the current widget's CSS stylesheet.

@return	the CSS stylesheet as a string.

=end classdoc

=cut

sub getCSS { return $_[0]->{_widget}->getCSS(); }

=pod

=begin classdoc

Return the specified icon image data for the current widget.

@return	the widget icon image data.

=end classdoc

=cut