package Template::Plugin::StringTree; =pod =head1 NAME Template::Plugin::StringTree - Access tree-like groups of strings naturally in code and Templates =head1 SYNOPSIS 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? =head1 DESCRIPTION For a couple of months, I had found it really annoying that when I wanted to put a bunch of configuration options into a template, that I couldn't use a natural [% IF show.pictures %][% IF show.pictures.dropshadow %] ...etc... type of notation. Simply, to get "dot" formatting in template, you need hashes. Which means stupid notation like [% show.pictures.at_all %]. ugh... As the size of the config tree I wanted to use grew and grew, it finally started getting totally out of control, so I've created Template::Plugin::StringTree, which lets you build tree structures in which every node can have a value. And you can get at these naturally in templates. =head1 METHODS =cut use 5.005; use strict; use Template::Plugin::StringTree::Node (); use vars qw{$VERSION}; BEGIN { $VERSION = '0.08'; } ##################################################################### # Constructor =pod =head2 new The C constructor simply creates a new ::StringTree object and returns it. =cut sub new { bless {}, ref($_[0]) || $_[0]; } sub clone { my $self = ref $_[0] ? shift : return undef; ref($self)->thaw( $self->freeze ); } ##################################################################### # Main Methods =pod =head2 get $path Taking a single "this.is.a.path" argument, the C method returns the value associated with the path, if there is one. Returns the value for the path, if one exists. Returns C if no value exists at that path. =cut 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; } =pod =head2 set $path, $value The C method takes a "this.is.a.path" style path and a value for that path. C is valid as a value, erasing a single value at the node for the path. ( It does not remove children of that node ). Returns true if the value is set correctly, or C on error. =cut 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; } =pod The C method is nearly identical to the normal C method, except that the it expects there B to be an existing value in place. Rather than overwrite an existing value, this method will return an error. Returns true if there is no existing value, and it is successfully set, or C if there is an existing value, or an error while setting. =cut 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; } =pod =head2 hash The C method produces a flat hash equivalent to the Template::Plugin::StringTree object, which can be passed to the template parser. You can manually add additional elements to the hash after it has been produced, but you should not attempt to add anything to a hash key the same as the first element in a path already added via the C method earlier. Returns a reference to a HASH containing the tree of strings. =cut sub hash { my $hash = { %{$_[0]} }; $hash } =pod =head2 freeze Ever good structure can be serialized and deserialized, and this one is no exception. The C method takes a ::StringTree object and converts it into a string, which just so happens to be highly useful as a config file format! foo: one foo.bar: two you.get.the.point: right? So terribly simple. To make life just a LITTLE more complicated though, Template::Plugin::StringTree does a little bit of escaping if there's a newline in the string. But since you'll probably never DO that, it won't be a problem will it? :) =cut 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; } =pod =head2 thaw $string The C method is the reverse of the C method, taking the same format string turning it back into a Template::Plugin::StringTree object. THIS is where using this module as a config file -> template mechanism really comes into it's own. Each entry is the config file is available using the same path in Template Toolkit templates. Template::Plugin::StringTree takes care of all the details or making it work across the different models transparently. If the string is formatted correctly, returns a new Template::Plugin::StringTree object. Returns C on error, probably because the string wasn't formatted correctly. =cut 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; } =pod =head2 equal $path, $value The C method provides a quick and convenient bit of shorthand to let you see if a particular path equals a particular value. And the method is totally undef-safe. You can test for a value of C, and test a value against a path which returns C quite safely. Returns true if the value matches the path, or false otherwise. =cut 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; =pod =head1 SUPPORT Bugs should be submitted via the CPAN bug tracker, located at http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Template-Plugin-StringTree For other issues, contact the author =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2004, 2008 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut