Template::Plugin::StringTree - Access tree-like groups of strings naturally in code and Templates

  use Template::Plugin::StringTree;

  # Create a StringTree and set some values
  my $Tree = Template::Plugin::StringTree->new;
  $Tree->set('foo', 'one');
  $Tree->set('foo.bar', 'two');
  $Tree->set('you.get.the.point' => 'right?');

  # Get simple hash of these variables for the template
  my $vars = $Tree->variables;

  #######################################################
  # Later that night in a Template

  After the number [% foo %] comes the number [% foo.bar %], [% you.get.the.point %]

  #######################################################
  # Which of course produces

  After the number one comes the number two, right?

  foo: one
  foo.bar: two
  you.get.the.point: right?

  http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Template-Plugin-StringTree

package Template::Plugin::StringTree;

use 5.005;
use strict;
use Template::Plugin::StringTree::Node ();

use vars qw{$VERSION};
BEGIN {
	$VERSION = '0.08';
}





#####################################################################
# Constructor

sub new {
	bless {}, ref($_[0]) || $_[0];
}

sub clone {
	my $self = ref $_[0] ? shift : return undef;
	ref($self)->thaw( $self->freeze );
}





#####################################################################
# Main Methods

sub get {
	my $self = shift;
	my $path = $self->_path($_[0]) or return undef;

	# Walk the tree to find the value
	my $cursor = $self;
	foreach my $branch ( @$path ) {
		return undef unless ref $cursor; # Last branch took us to a normal value
		defined($cursor = $cursor->{$branch}) or return undef;
	}

	# We have arrived at the value we want.
	ref $cursor ? $cursor->__get : $cursor;
}

sub set {
	my $self  = shift;
	my $path  = $self->_path(shift) or return undef;
	my $value = shift;

	# Walk the tree to determine the location to set
	my $cursor = $self;
	my $leaf = pop @$path;
	foreach my $branch ( @$path ) {
		if ( ! defined $cursor->{$branch} ) {
			# Create a new node for the branch
			$cursor->{$branch} = Template::Plugin::StringTree::Node->__new;
		} elsif ( ! ref $cursor->{$branch} ) {
			# Convert the existing leaf into a node
			$cursor->{$branch} = Template::Plugin::StringTree::Node->__new( $cursor->{$branch} );
		}

		# Move down into the node
		$cursor = $cursor->{$branch};		
	}

	# Now set the leaf
	if ( exists $cursor->{$leaf} and ref $cursor->{$leaf} ) {
		# Replace the node's value
		$cursor->{$leaf}->__set($value);
	} else {
		# Create or replace a leaf
		$cursor->{$leaf} = $value;
	}

	1;
}

sub add {
	my $self  = shift;
	my $path  = $self->_path(shift) or return undef;
	my $value = shift;

	# Walk the tree to determine the location to set
	my $cursor = $self;
	my $leaf = pop @$path;
	foreach my $branch ( @$path ) {
		if ( ! defined $cursor->{$branch} ) {
			# Create a new node for the branch
			$cursor->{$branch} = Template::Plugin::StringTree::Node->__new;
		} elsif ( ! ref $cursor->{$branch} ) {
			# Convert the existing leaf into a node
			$cursor->{$branch} = Template::Plugin::StringTree::Node->__new( $cursor->{$branch} );
		}

		# Move down into the node
		$cursor = $cursor->{$branch};		
	}

	# Now set the leaf
	if ( exists $cursor->{$leaf} and ref $cursor->{$leaf} ) {
		# Fail if there is an existing value
		return undef if defined $cursor->{$leaf}->__get($value);

		# Replace the node's value
		$cursor->{$leaf}->__set($value);
	} else {
		# Fail if there is an existing value
		return undef if defined $cursor->{$leaf};

		# Create or replace a leaf
		$cursor->{$leaf} = $value;
	}

	1;
}

sub hash { my $hash = { %{$_[0]} }; $hash }

sub freeze {
	my $self = shift;

	# Handle the special null case
	return 'null' unless keys %$self;

	# Flatten and escape the tree
	my %flat = ();
	my @queue = ( [ '', $self ] );
	while ( my $item = shift @queue ) {
		my $base   = $item->[0];
		my $cursor = $item->[1];

		foreach my $key ( keys %$cursor ) {
			my $path = length $base ? "$base.$key" : $key;
			my $value = (ref $cursor->{$key})
				? $cursor->{$key}->__get
				: $cursor->{$key};
			if ( defined $value ) {
				# Escape and add the value to the output
				$value =~ s/([\\\n])/sprintf('\\%03d', ord($1))/ge;
				$flat{$path} = $value;
			}
			push @queue, [ $path, $cursor->{$key} ] if ref $cursor->{$key};
		}
	}

	# Now convert the flattened tree to a single string
	join '', map { "$_: $flat{$_}\n" } sort keys %flat;
}

sub thaw {
	my $class = ref $_[0] ? ref shift : shift;
	my $string = shift or return undef;
	my $self = $class->new;

	# Handle the special case
	return $self if $string eq 'null';

	foreach ( split /\n/, $string ) {
		return undef unless /^([\w\.]+)\:\s*(.*)$/;
		my $key = $1;
		my $value = $2;

		# Unescape the value
		$value =~ s/\\(\d\d\d)/chr($1)/ge;
		$self->set($key, $value) or return undef;
	}

	$self;
}

sub equal {
	my $self = shift;
	my $left = $self->get(shift);
	my $right = shift;
	defined $left ? (defined($right) and $left eq $right) : ! defined $right;
}





#####################################################################
# Support Methods

sub _path {
	# Check the value before we begin processing it
	my $value = (defined $_[1] and ! ref $_[1]) ? $_[1] : return undef;
	$value =~ /^[^\W\d]\w*(?:\.[^\W\d]\w*)*$/ or return undef;

	# Split the path
	my @path = split /\./, $value;
	if ( grep { $_ eq 'DESTROY' } @path ) {
		# Illegal value, clashes with the Node DESTROY method
		warn "The use of 'DESTROY' as a path node is forbidden";
		return undef;
	}

	\@path;
}

1;