package Tree::Template::Declare; use strict; use warnings; use Sub::Exporter; use Devel::Caller 'caller_args'; use Carp; use Data::Dumper; our $VERSION='0.1'; Sub::Exporter::setup_exporter({ exports => [qw(tree node name attribs)], groups => { default => [qw(tree node name attribs)], builder => \&_set_builder_for_package, }, }); { my %builder_for; sub _set_builder_for_package { my ($class,$name,$args)=@_; my $builder_pkg=$args->{import_args}->[0]->[0]; if (!ref($builder_pkg)) { if ($builder_pkg=~m{\A \+(\w+) \z}smx) { $builder_pkg="Tree::Template::Declare::$1"; } eval "require $builder_pkg"; croak "Can't load $builder_pkg: $@" if $@; } $builder_for{$args->{into}}=$builder_pkg; return 1; } sub builder_for { my ($pkg)=@_; if (exists $builder_for{$pkg}) { return $builder_for{$pkg}; } else { return $pkg; } } } our $current_node; sub tree(&) { local $current_node=undef; my ($ret)=$_[0]->(caller_args(1)); #warn "returning @{[ $ret->name ]}\n"; return $ret; } sub node(&) { my $node=builder_for(caller)->new_node(); #warn "new node\n"; { local $current_node=$node; $_[0]->(caller_args(1)); } if ($current_node) { #warn "adding to parent (@{[ $current_node->name ]})\n"; builder_for(caller)->add_child_node($current_node,$node); } return $node; } sub name($) { #warn "setting name ($_[0])\n"; builder_for(caller)->set_node_name($current_node,$_[0]); } sub attribs { my %attrs=@_; #warn "setting attributes\n"; builder_for(caller)->set_node_attributes($current_node,\%attrs); return; } 1;