view release on metacpan or  search on metacpan

lib/Pod/Tree/Node.pm  view on Meta::CPAN

		Pod::Tree::Node->_warn("Missing '>' delimiter in\n@text");
	}

	\@stack;
}

sub _pop_sequence {
	my ( $stack, $width ) = @_;
	my ( $node, @interior );

	while (@$stack) {
		$node = pop @$stack;
		$node->is_letter
			and $node->{width} == $width
			and return ( $node, \@interior );
		unshift @interior, $node;
	}

	my @text = map { $_->get_deep_text } @interior;
	$node->_warn("Mismatched sequence delimiters around\n@text");

	$node = Pod::Tree::Node->letter(' ');
	$node, \@interior;
}

sub parse_links {
	my $node = shift;

	$node->is_link and $node->_parse_link;

	my $children = $node->{children};
	for my $child (@$children) {
		$child->parse_links;
	}
}

sub _parse_link {
	my $node = shift;

	$node->{raw_kids} = $node->clone->{children};

	my $children = $node->{children};
	my ( $text_kids, $target_kids ) = SplitBar($children);

	$node->{children} = $text_kids;
	$node->{'target'} = Pod::Tree::Node->target($target_kids);
}

sub SplitBar {
	my $children = shift;
	my ( @text, @link );

	while (@$children) {
		my $child = shift @$children;

		$child->is_text or do {
			push @text, $child;
			next;
		};

		my ( $text, $link ) = split m(\|), $child->{'text'}, 2;
		$link and do {
			push @text, Pod::Tree::Node->text($text) if $text;
			push @link, Pod::Tree::Node->text($link), @$children;
			return ( \@text, \@link );
		};

		push @text, $child;
	}

	( \@text, \@text );
}

sub unescape {
	my $node = shift;

	my $children = $node->{children};
	for my $child (@$children) {
		$child->unescape;
	}

	$node->is_sequence and $node->_unescape_sequence;
}

sub _unescape_sequence {
	my $node = shift;

	for ( $node->{'letter'} ) {
		/Z/ and $node->force_text(''), last;
		/E/ and do {
			my $child = $node->{children}[0];
			$child or last;
			my $text = $child->_unescape_text;
			$text and $node->force_text($text);
			last;
		};
	}
}

sub _unescape_text {
	my $node = shift;
	my $text = $node->{'text'};

	defined $text ? Pod::Escapes::e2char($text) : "E<UNDEF?!>";
}

sub consolidate {
	my $node = shift;
	my $old  = $node->{children};
	$old and @$old or return;

	my $new = [];

	push @$new, shift @$old;

	while (@$old) {
		if (   $new->[-1]->is_text and $old->[0]->is_text
			or $new->[-1]->is_verbatim and $old->[0]->is_verbatim
			or $new->[-1]->is_code and $old->[0]->is_code )
		{
			$new->[-1]{'text'} .= $old->[0]{'text'};