File Coverage

blib/lib/Tree/Template/Declare.pm

Criterion	Covered	Total	%
statement	34	61	55.7
branch	5	16	31.2
condition	0	6	0.0
subroutine	9	15	60.0
pod			n/a
total	48	98	48.9

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.6';

{
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" ## no critic (ProhibitStringyEval)
            or croak "Can't load $builder_pkg: $@"; ## no critic (ProhibitPunctuationVars)

        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__