lib/Tree/Template/Declare.pm


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
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140

package Tree::Template::Declare; 
use strict;
use warnings;
use Sub::Exporter;
use Devel::Caller 'caller_args';
use Carp;
use Data::Dumper;
use v5.8;
 
our $VERSION='0.1';
 
{
my $exporter=Sub::Exporter::build_exporter({
    groups => {
        default => \&_build_group,
    },
});
 
sub import {
    my ($pack,@rest)=@_;
 
    if (@rest) {
        @_=($pack,-default => {@rest});
    }
    goto $exporter;
}
}
 
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";
        croak "Can't load $builder_pkg: $@" if $@;
 
        if ($builder_pkg->can('new')) {
            $builder=$builder_pkg->new();
        }
        else {
            $builder=$builder_pkg;
        }
    }
 
    my $additional_exports={};
    if ($builder->can('_additional_exports')) {
        $additional_exports=$builder->_additional_exports();
    }
 
    my @current_node=(undef);
 
    return {
        tree => sub(&) {
            my $tree=$builder->new_tree();
            {
                local $current_node[0]=$tree;
                $_[0]->(caller_args(1));
            }
            return $builder->finalize_tree($tree);
        },
        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;
        },
        %$additional_exports,
    };
}
 
1;
__END__
 
=head1 NAME
 
Tree::Template::Declare - easily build tree structures
 
=head1 SYNOPSIS
 
 use Tree::Template::Declare builder => '+DAG_Node';
 
 my $tree=tree {
     node {
         name 'root';
         attribs name => 'none';
         node {
             name 'first';
             attribs name => 'number_1';
             attribs other => 'some';
         };
         node {
             name 'second';
         };
     };
 };
 
=head1 IMPORTING
 
This module uses L<Sub::Exporter>, although it munges the C<use> list
before passing it to L<Sub::Exporter>. A line like:
 
 use Tree::Template::Declare @something;
 
becomes a call to L<Sub::Exporter>'s export sub like:
 
 $export->('Tree::Template::Declare',-default => {@something});
 
See L<Sub::Exporter>'s documentation for things like renaming the
imports.
 
You can C<use> this module more than once, with different builders and
different names for the imports:
 
 use Tree::Template::Declare -prefix=> 'x', builder => '+LibXML';
 use Tree::Template::Declare -prefix=> 'd', builder => '+DAG_Node';
 
=head1 AUTHOR
 
Gianni Ceccarelli <dakkar@thenautilus.net>
 
=cut