package Tree::Template::Declare;
use strict;
use warnings;
use Sub::Exporter;
use Devel::Caller 'caller_args';
use Carp;
use Data::Dumper;
use 5.006;
our $VERSION='0.4';
{
my $exporter=Sub::Exporter::build_exporter({
groups => {
default => \&_build_group,
},
});
sub import {
my ($pack,@rest)=@_;
if (@rest) {
@_=($pack,-default => {@rest});
}
goto $exporter;
}
}
our @nodes_stack;
sub _build_group {
my ($class,$name,$args,$coll)=@_;
my $builder=$args->{builder};
if (! ref $builder) {
my $builder_pkg=$builder;
if ($builder_pkg=~m{\A [+](\w+) \z}smx) {
$builder_pkg="Tree::Template::Declare::$1";
}
eval "require $builder_pkg"
or croak "Can't load $builder_pkg: $@";
if ($builder_pkg->can('new')) {
$builder=$builder_pkg->new();
}
else {
$builder=$builder_pkg;
}
}
my $normal_exports= {
tree => sub(&) {
my $tree=$builder->new_tree();
unshift @nodes_stack,$tree;
$_[0]->(caller_args(1));
shift @nodes_stack;
return $builder->finalize_tree($tree);
},
node => sub (&) {
my $node=$builder->new_node();
unshift @nodes_stack, $node;
$_[0]->(caller_args(1));
shift @nodes_stack;
my $scalar_context=defined wantarray && !wantarray;
if (@nodes_stack && !$scalar_context) {
$builder->add_child_node($nodes_stack[0],$node);
}
return $node;
},
attach_nodes => sub {
if (@nodes_stack) {
for my $newnode (@_) {
$builder->add_child_node($nodes_stack[0],
$newnode);
}
}
},
name => sub ($) {
$builder->set_node_name($nodes_stack[0],$_[0]);
return;
},
attribs => sub {
my %attrs=@_;
$builder->set_node_attributes($nodes_stack[0],\%attrs);
return;
},
detached => sub($) { return scalar $_[0] },
};
if ($builder->can('_munge_exports')) {
return $builder->_munge_exports($normal_exports,\@nodes_stack);
}
else {
return $normal_exports;
}
}
1;
__END__