summaryrefslogtreecommitdiff
path: root/lib/Tree/Template/Declare.pm
blob: 0cff864b4bfe7b7325cbc6b2db9e9291b8346d50 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
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({
    groups => {
        default => \&_build_group,
    },
    collectors => [ INIT => \&_init_args, 'options' ],
});
 
sub _init_args {
    my (undef,$args)=@_;
 
    @{$args->{import_args}}=( [ -default => undef] )
        unless @{$args->{import_args}};
 
    return 1;
}
 
sub _build_group {
    my ($class,$name,$args,$coll)=@_;
 
    my $builder=$args->{builder} || $coll->{options}{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";
        croak "Can't load $builder_pkg$@" if $@;
 
        if ($builder_pkg->can('new')) {
            $builder=$builder_pkg->new();
        }
        else {
            $builder=$builder_pkg;
        }
    }
 
    my @current_node=(undef);
 
    return {
        tree => sub(&) {
            local $current_node[0]=undef;
            my ($ret)=$_[0]->(caller_args(1));
            return $ret;
        },
        node => sub (&) {
            my $node=$builder->new_node();
            {
                local $current_node[0]=$node;
                $_[0]->(caller_args(1));
            }
            if ($current_node[0]) {
                $builder->add_child_node($current_node[0],$node);
            }
            return $node;
        },
        name => sub ($) {
            $builder->set_node_name($current_node[0],$_[0]);
            return;
        },
        attribs => sub {
            my %attrs=@_;
            $builder->set_node_attributes($current_node[0],\%attrs);
            return;
        },
    };
}
 
1;