File Coverage

blib/lib/Forest/Tree/Constructor.pm
Criterion Covered Total %
statement 19 21 90.4
branch 7 10 70.0
condition 4 6 66.6
subroutine 3 3 100.0
pod 0 1 0.0
total 33 41 80.4


line stmt bran cond sub pod time code
1             package Forest::Tree::Constructor;
2 12     12   12235 use Moose::Role;
  12         28  
  12         102  
3              
4             our $VERSION = '0.10';
5             our $AUTHORITY = 'cpan:STEVAN';
6              
7             requires "tree_class";
8              
9             sub create_new_subtree {
10 86     86 0 252 my ($self, %options) = @_;
11 86         145 my $node = $options{node};
12              
13 86 100 66     658 if (blessed($node) && $node->isa('Forest::Tree::Pure')) {
14             # when node is an tree object we assume that it's a prototype of a tree
15             # node to be filled in
16              
17             # remove meaningless keys
18 5         12 delete $options{node};
19 5 50 66     21 delete $options{children} if exists $options{children} and not @{ $options{children} };
  2         11  
20              
21             # nothing left to be done if the option cleanup deleted all keys
22 5 100       44 return $node unless keys %options;
23              
24 2 50       104 if ( $node->child_count == 0 ) {
25 2 50       12 if ( $node->isa("Forest::Tree") ) {
26             # mutable trees get modified
27              
28 2         6 foreach my $key ( keys %options ) {
29 2         83 $node->$key( $options{$key} );
30             }
31              
32 2         71 return $node;
33             }
34             else {
35             # pure trees get cloned
36 0         0 return $node->clone(%options);
37             }
38             }
39             else {
40             # i suppose $options{children} could be appended to $node->children
41             # if there are any, but that doesn't really make sense IMHO, might
42             # as well write your own builder at that point instead of kludging
43             # it with the parser callback for the simple text loader or something
44 0         0 confess("Can't override children from proto node");
45             }
46             }
47             else {
48 81         298 return $self->tree_class->new(%options);
49             }
50             }
51              
52              
53             # ex: set sw=4 et
54              
55 12     12   123254 no Moose::Role; 1;
  12         58  
  12         83  
56              
57             __END__
58              
59             =head1 NAME
60              
61             Forest::Tree::Constructor - An abstract role for tree factories
62              
63             =head1 SYNOPSIS
64              
65             with qw(Forest::Tree::Constructor);
66              
67             sub tree_class { ... }
68              
69             sub foo {
70             $self->create_new_subtree( ... )
71             }
72              
73             =head1 DESCRIPTION
74              
75             This role provides the C<create_new_subtree> method as required by
76             L<Forest::Tree::Builder> and L<Forest::Tree::Loader>/L<Forest::Tree::Reader>.
77              
78             See L<Forest::Tree::Builder> for the reccomended usage.
79              
80             =head1 BUGS
81              
82             All complex software has bugs lurking in it, and this module is no
83             exception. If you find a bug please either email me, or add the bug
84             to cpan-RT.
85              
86             =head1 AUTHOR
87              
88             Yuval Kogman
89              
90             =head1 COPYRIGHT AND LICENSE
91              
92             Copyright 2008-2014 Infinity Interactive, Inc.
93              
94             L<http://www.iinteractive.com>
95              
96             This library is free software; you can redistribute it and/or modify
97             it under the same terms as Perl itself.
98              
99             =cut