XHTML results from the CPAN

Markup-Tree
view release on metacpan or search on metacpan
sub foreach_node {
	my ($self, $start_callback, $end_callback, $start_from) = @_;
	my $walk_tree;

	if (!$start_from) {
		if ($end_callback && UNIVERSAL::isa($end_callback, 'Markup::TreeNode')) {
			$start_from = $end_callback;
			$end_callback = undef;
		}
		else {
			$start_from = $self->{'_tree'};
		}
	}

	if (!($start_callback || (ref($start_callback) ne 'CODE'))) {
		Carp::croak ("parameter 0 is not a CODE reference");
	}

	$walk_tree = sub {
		my $tree = shift();

		if (ref($tree) eq 'ARRAY') {
			for (my $i = 0; $i < scalar(@{ $tree }); $i++) {
				$walk_tree->($tree->[$i]);
			}
		}
		elsif ($tree->isa('Markup::TreeNode')) {
			if ($tree->{'element_type'} eq '-->ignore') {
				$walk_tree->($tree->{'children'});
				return;
			}
			return if (!$start_callback->($tree));
			$walk_tree->($tree->{'children'});
			if ($end_callback && ref($end_callback) eq 'CODE') {
				return if (!$end_callback->($tree));
			}
		}
	};

	$walk_tree->($start_from);
}

sub save_as {
	my ($self, $file, $file_type) = @_;

	if (!$file_type) {
		if ($file =~ m/\.xml$/i) {
			$file_type = 'xml';
		}
		else {
			$file_type = 'html';
		}
	}

	$file_type = lc $file_type;

	$file = _mk_filehandle_write($file);

	print $file '<?xml version = "1.0" encoding = "iso-8859-1"?>'."\n";
	if ($file_type =~ '(?:x)?html') {
		print $file '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" ';
		print $file '"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n";
	}

	$self->foreach_node(
		sub {
			my $node = shift();

			return 1 if ($node->{'element_type'} eq '-->root');
			return 1 if ($node->{'element_type'} eq '-->declaration');

			print $file '<!-- '.$node->{'text'}." -->\n" and return 1
				if ($node->{'element_type'} eq '-->comment');

			print $file $self->_rindent($node);
			unless ($node->{'element_type'} eq '-->text') {
				print $file "<".$node->{'tagname'};
				foreach (keys %{ $node->{'attr'} }) {
					print $file " $_ = \"".$node->{'attr'}->{$_}."\"";
				}
				if (!scalar(@{$node->{'children'} || []})) {
					print $file ' /';
				}
			}
			print $file (($node->{'element_type'} eq '-->text') ? $node->{'text'} : ">")."\n";
			return 1;
		},
		sub {
			my $node = shift();

			return 1 if ($node->{'element_type'} eq '-->root');
			return 1 if ($node->{'element_type'} eq '-->declaration');
			return 1 if (!scalar(@{$node->{'children'} || []}));
			return 1 if ($node->{'element_type'} eq '-->text');

			print $file $self->_rindent($node);
			print $file '</'.$node->{'tagname'}.">\n";

			return 1;
		}
	);

	close ($file) or Carp::croak ("Could not close file - $!");
}

sub _rindent {
	my ($self, $node) = @_;
	my $ident = $node->{'level'};
	my $buf = "";

	if ($self->{'no_indent'}) {
		return if (ref($self->{'no_indent'}) ne 'ARRAY');
		my $indent = 1;
		foreach (@{ $self->{'no_indent'} }) {
			if ($_ eq $node->{'tagname'}) { $indent = 0; last; }
		}

		return if (!$indent);
	}

	while ($ident--) {
( run in 1.427 second using v1.01-cache-2.11-cpan-600a1bdf6e4 )