File Coverage

blib/lib/Markup/TreeNode.pm

Criterion	Covered	Total	%
statement	18	139	12.9
branch	2	46	4.3
condition	3	17	17.6
subroutine	4	16	25.0
pod	11	13	84.6
total	38	231	16.4

package Markup::TreeNode;
$VERSION = '1.1.6';

####################################################
# This module is protected under the terms of the
# GNU GPL. Please see
# http://www.opensource.org/licenses/gpl-license.php
# for more information.
####################################################

use strict;
use Carp;

require Exporter;

our @ISA = qw(Exporter);
our $empty = '(empty)';

sub new {
	my $invocant = shift();
	my $class = ref($invocant) || $invocant;
	$class = bless {
		element_type	=> 'tag',
		tagname		=> '',
		attr		=> { },
		level		=> 0,
		parent		=> $empty,
		child_num	=> 0,
		children	=> [ ],
		text		=> ''
	}, $class;
	$class->init (@_);
	return $class;
}

sub init {
	my $self = shift();
	my %args = @_;

	foreach (keys %args) {
		# enforce integrity
		if ($_ eq 'parent' && $args{$_} ne $empty) {
			$self->attach_parent($args{$_});
			next;
		}

		# enforce integrity
		if ($_ eq 'children' && scalar(@{$args{$_}})) {
			$self->attach_children($args{$_});
			next;
		}

		if (exists $self->{$_}) {
			$self->{$_} = $args{$_};
		}
		else {
			croak ("unrecognized node option $_");
		}
	}
}

sub attach_parent {
	my ($self, $parent) = @_;

	$self->{'parent'} = $parent;
	# if setting parent, add us to [bottom of] parent children
	my $child_count = scalar(@{$self->{'parent'}->{'children'} || []});
	$self->{'parent'}->{'children'}->[$child_count] = $self;
	$self->{'child_num'} = $child_count;

	return $self;
}

sub attach_child {
	my ($self, $child) = @_;
	my $child_count = scalar(@{ $self->{'children'} });

	$self->{'children'}->[$child_count] = $child;
	# if setting child, add us as parent of child
	$child->{'parent'} = $self;
	$child->{'child_num'} = $child_count;

	return $self;
}

sub attach_child_before {
	my ($self, $child) = @_;
	my $child_count = scalar(@{ $self->{'children'} });

	for (my $i = 0; $i < $child_count; $i++) {
		$self->{'children'}->[($i + 1)] = $self->{'children'}->[$i];
		$self->{'children'}->[($i + 1)]->{'child_num'}++;
	}

	$self->{'children'}->[0] = $child;
	# if setting child, add us as parent of child
	$child->{'parent'} = $self;
	$child->{'child_num'} = 0;

	return $self;
}


sub attach_children {
	my ($self, $childref) = @_;
	my $cnt = 0;

	$self->{'children'} = $childref;
	# if setting children, add us as parent of all children
	foreach (@{ $self->{'children'} }) {
		if (!UNIVERSAL::isa($_, 'Markup::TreeNode')) {
			croak ("$_ is not a recognized child");
		}

		$_->{'parent'} = $self;
		$_->{'child_num'} = $cnt++;
	}

	return $self;
}

sub get_text {
	my $self = shift();

	if ($self->{'element_type'} eq '-->text') { return $self->{'text'}; }

	my $next_node = $self->next_node();

	return (($next_node->{'element_type'} eq '-->text') ? $next_node->{'text'} : undef);
}

sub next_node {
	my $self = shift();

	if (scalar(@{ $self->{'children'} })) {
		return $self->{'children'}->[0];
	}

	my $recurse = sub {
		my ($me, $myself) = @_;
		if ($myself->{'parent'} ne $empty) {
			if ($myself->{'child_num'} < (scalar(@{ $myself->{'parent'}->{'children'} || [] }) - 1)) {
				return ($myself->{'parent'}->{'children'}->[($myself->{'child_num'} + 1)]);
			}

			return ($me->($me, $myself->{'parent'}));
		}

		return undef;
	};

	return ($recurse->($recurse, $self));
}

sub previous_node {
	my $self = shift();

	if ($self->{'parent'} ne $empty) {
		if (($self->{'child_num'} > 0) && (scalar(@{ $self->{'parent'}->{'children'} }) >= 1)) {
			my $ret = $self->{'parent'}->{'children'}->[($self->{'child_num'} - 1)];
			while (scalar(@{$ret->{'children'} || []})) {
				$ret = $ret->{'children'}->[(scalar(@{$ret->{'children'}}) - 1)];
			}
			return ($ret);
		}

		return ($self->{'parent'});
	}

	return undef;
}

sub drop {
	my $self = shift();
	my $parent = $self->{'parent'};

	return ($self) if ($parent eq $empty);

	splice @{ $parent->{'children'} }, $self->{'child_num'}--, 1;

	if ($self->{'child_num'} < (scalar(@{ $parent->{'children'} || [] })) && $self->{'child_num'} > 0) {
		for (my $i = $self->{'child_num'}; $i < scalar(@{ $parent->{'children'} }); $i++) {
			$parent->{'children'}->[$i]->{'child_num'} = $i;
		}
	}

	$self->{'parent'} = $empty;

	return ($self);
}

sub replace {
	my ($self, $node) = @_;

	if (!UNIVERSAL::isa($node, 'Markup::TreeNode')) {
		croak ("Node is not a Markup::TreeNode");
	}

	$self->insert($node, 'after');
	return ($self->drop());
}

sub insert {
	my ($self, $node, $position) = @_;
	$position = 'after' if (!$position);
	my $child_num;

	if (($position ne 'after') && ($position ne 'before')) {
		croak ("Unknown position '$position'");
	}

	if (!UNIVERSAL::isa($node, 'Markup::TreeNode')) {
		croak ("Node is not a Markup::TreeNode");
	}

	$child_num = $self->{'child_num'} + ($position eq 'after'); # yes, I know what that means :)
	$child_num = 0 if ($child_num < 0);

	if ($self->{'parent'} eq $empty) {
		return ($self->attach_child($node));
	}

	for ($self->{'parent'}->{'children'}) {
		my $oglen = scalar(@{ $_ });
		for (my $i = $oglen; $i >= $child_num; $i--) {
			$_->[($i + 1)] = $_->[$i];
			$_->[($i + 1)]->{'child_num'}++;
		}

		splice (@{$_}, ++$oglen);

		$_->[$child_num] = $node;
		$_->[$child_num]->{'parent'} = $self->{'parent'};
		$_->[$child_num]->{'child_num'} = $child_num;
		return ($_->[$child_num]);
	}
}

sub copy_of {
	my $self = shift();
	my ($newbie => %options); # if you don't know you betta' axe somebody!

	foreach (keys %{ $self }) {
		$options{$_} = $self->{$_};
	}

	for ($self->{'children'}) {
		my $a = scalar(@{$_});
		for (my $i = 0; $i < $a; $i++) {
			$options{'children'}->[$i] = $_->[$i]->copy_of();
		}
	}

	return ($self->new(%options));
}

1;

__END__