File Coverage

blib/lib/Tree/Persist/File/XMLWithSingleQuotes.pm

Criterion	Covered	Total	%
statement	16	18	88.8
branch			n/a
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	22	24	91.6

package Tree::Persist::File::XMLWithSingleQuotes;

use strict;
use warnings;

use base qw( Tree::Persist::File );

use Module::Runtime;

use Scalar::Util qw( blessed refaddr );

use XML::Parser;

our $VERSION = '1.11';

# ----------------------------------------------

sub _reload
{
	my($self)    = shift;
	my($linenum) = 0;

	my @stack;
	my $tree;

	my $parser = XML::Parser -> new
	(
		Handlers =>
		{
			Start => sub
			{
				my($dummy, $name, %args) = @_;
				my($class)               = $args{class} ? $args{class} : $self->{_class};
				my($node)                = Module::Runtime::use_module($class)->new( $args{value} );

				if ( @stack )
				{
					$stack[-1] -> add_child( $node );
				}
				else
				{
					$tree = $node;
				}

				push @stack, $node;
			},
			End => sub
			{
				$linenum++;

				pop @stack;
			},
		},
	);

	$parser -> parsefile( $self->{_filename} );

	$self -> _set_tree( $tree );

	return $self;

} # End of _reload.

# ----------------------------------------------

my $pad = ' ' x 4;

# ----------------------------------------------

sub _build_string
{
	my($self)       = shift;
	my($tree)       = @_;
	my(%encode)     = ('<' => '<', '>' => '>', '&' => '&', "'" => ''', '"' => '"');
	my($str)        = '';
	my($curr_depth) = $tree->depth;

	my(@char, @closer);
	my($new_depth);

	for my $node ( $tree->traverse )
	{
		$new_depth  = $node->depth;
		$str        .= pop(@closer) while @closer && $curr_depth-- >= $new_depth;
		$curr_depth = $new_depth;
		@char       = map{$encode{$_} ? $encode{$_} : $_} split(//, $node -> value);
		$str        .= ($pad x $curr_depth)
					. "
					. "'>" . $/;

		push @closer, ($pad x $curr_depth) . "\n";
	}

	$str .= pop(@closer) while @closer;

	return $str;

} # End of _build_string.

# ----------------------------------------------

1;

__END__