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


line stmt bran cond sub pod time code
1             package Tree::Template::Declare;
2 3     3   146906 use strict;
  3         7  
  3         101  
3 3     3   16 use warnings;
  3         4  
  3         78  
4 3     3   1832 use Sub::Exporter;
  3         28783  
  3         14  
5 3     3   2343 use Devel::Caller 'caller_args';
  3         9044  
  3         189  
6 3     3   19 use Carp;
  3         3  
  3         137  
7 3     3   753 use Data::Dumper;
  3         6222  
  3         149  
8 3     3   51 use 5.006;
  3         6  
  3         1601  
9              
10             our $VERSION='0.6';
11              
12             {
13             my $exporter=Sub::Exporter::build_exporter({
14             groups => {
15             default => \&_build_group,
16             },
17             });
18              
19             sub import {
20 3     3   26 my ($pack,@rest)=@_;
21              
22 3 50       29 if (@rest) {
23 3         13 @_=($pack,-default => {@rest});
24             }
25 3         11 goto $exporter;
26             }
27             }
28              
29             our @nodes_stack;
30              
31             sub _build_group {
32 3     3   375 my ($class,$name,$args,$coll)=@_;
33              
34 3         4 my $builder=$args->{builder};
35              
36 3 50       9 if (! ref $builder) {
37 3         3 my $builder_pkg=$builder;
38 3 50       20 if ($builder_pkg=~m{\A [+](\w+) \z}smx) {
39 3         8 $builder_pkg="Tree::Template::Declare::$1";
40             }
41 3 50       174 eval "require $builder_pkg" ## no critic (ProhibitStringyEval)
42             or croak "Can't load $builder_pkg: $@"; ## no critic (ProhibitPunctuationVars)
43              
44 3 50       47 if ($builder_pkg->can('new')) {
45 3         9 $builder=$builder_pkg->new();
46             }
47             else {
48 0           $builder=$builder_pkg;
49             }
50             }
51              
52             my $normal_exports= {
53             tree => sub(&) {
54 0     0     my $tree=$builder->new_tree();
55              
56 0           unshift @nodes_stack,$tree;
57 0           $_[0]->(caller_args(1));
58 0           shift @nodes_stack;
59              
60 0           return $builder->finalize_tree($tree);
61             },
62             node => sub (&) {
63 0     0     my $node=$builder->new_node();
64              
65 0           unshift @nodes_stack, $node;
66 0           $_[0]->(caller_args(1));
67 0           shift @nodes_stack;
68              
69 0   0       my $scalar_context=defined wantarray && !wantarray;
70 0 0 0       if (@nodes_stack && !$scalar_context) {
71 0           $builder->add_child_node($nodes_stack[0],$node);
72             }
73 0           return $node;
74             },
75             attach_nodes => sub {
76 0 0   0     if (@nodes_stack) {
77 0           for my $newnode (@_) {
78 0           $builder->add_child_node($nodes_stack[0],
79             $newnode);
80             }
81             }
82             },
83             name => sub ($) {
84 0     0     $builder->set_node_name($nodes_stack[0],$_[0]);
85 0           return;
86             },
87             attribs => sub {
88 0     0     my %attrs=@_;
89 0           $builder->set_node_attributes($nodes_stack[0],\%attrs);
90 0           return;
91             },
92 0     0     detached => sub($) { return scalar $_[0] },
93 0           };
94 0 0         if ($builder->can('_munge_exports')) {
95 0           return $builder->_munge_exports($normal_exports,\@nodes_stack);
96             }
97             else {
98 0           return $normal_exports;
99             }
100             }
101              
102             1;
103             __END__