File Coverage

blib/lib/Tree/Persist/Base.pm
Criterion Covered Total %
statement 67 76 88.1
branch 11 20 55.0
condition 4 8 50.0
subroutine 17 18 94.4
pod 5 5 100.0
total 104 127 81.8


line stmt bran cond sub pod time code
1             package Tree::Persist::Base;
2              
3 5     5   2912 use strict;
  5         6  
  5         119  
4 5     5   16 use warnings;
  5         5  
  5         137  
5              
6 5     5   22 use Scalar::Util qw( blessed );
  5         6  
  5         3313  
7              
8             our $VERSION = '1.11';
9              
10             # ----------------------------------------------
11              
12             sub new
13             {
14 10     10 1 195 my($class) = shift;
15 10         20 my($self) = bless {}, $class;
16              
17 10         25 $self -> _init( @_ );
18              
19 10         21 return $self;
20              
21             } # End of new.
22              
23             # ----------------------------------------------
24              
25             sub _init
26             {
27 10     10   21 my($self) = shift;
28 10         11 my($opts) = @_;
29              
30 10         25 $self->{_tree} = undef;
31 10 50       26 $self->{_autocommit} = (exists $opts->{autocommit} ? $opts->{autocommit} : 1);
32 10         13 $self->{_changes} = [];
33              
34 10 50       16 if ( exists $opts->{class} )
35             {
36 0         0 $self->{_class} = $opts->{class};
37             }
38             else
39             {
40 10         13 $self->{_class} = 'Tree';
41             }
42              
43 10 100       24 if ( exists $opts->{tree} )
44             {
45 4         10 $self -> _set_tree( $opts->{tree} );
46             }
47              
48 10         18 return $self;
49              
50             } # End of _init.
51              
52             # ----------------------------------------------
53              
54             sub autocommit
55             {
56 7     7 1 7 my($self) = shift;
57              
58 7 50       11 if ( @_ )
59             {
60 0   0     0 (my $old, $self->{_autocommit}) = ($self->{_autocommit}, (shift && 1) );
61              
62 0         0 return $old;
63             }
64             else
65             {
66 7         28 return $self->{_autocommit};
67             }
68              
69             } # End of autocommit.
70              
71             # ----------------------------------------------
72              
73             sub rollback
74             {
75 0     0 1 0 my($self) = shift;
76              
77 0 0       0 if ( @{$self->{_changes} } )
  0         0  
78             {
79 0         0 $self -> _reload;
80              
81 0         0 $self->{_changes} = [];
82             }
83              
84 0         0 return $self;
85              
86             } # End of rollback.
87              
88             # ----------------------------------------------
89              
90             sub commit
91             {
92 7     7 1 7 my($self) = shift;
93              
94 7 50       5 if ( @{$self->{_changes} } )
  7         18  
95             {
96 7         16 $self -> _commit;
97              
98 7         15 $self->{_changes} = [];
99             }
100              
101 7         26 return $self;
102              
103             } # End of commit.
104              
105             # ----------------------------------------------
106              
107             sub tree
108             {
109 12     12 1 1328 my($self) = shift;
110              
111 12         22 return $self->{_tree};
112              
113             } # End of tree.
114              
115             # ----------------------------------------------
116              
117             sub _set_tree
118             {
119 10     10   11 my($self) = shift;
120 10         9 my($value) = @_;
121              
122 10         12 $self->{_tree} = $value;
123              
124 10         22 $self->_install_handlers;
125              
126 10         10 return $self;
127              
128             } # End of _set_tree.
129              
130             # ----------------------------------------------
131              
132             sub _install_handlers
133             {
134 10     10   6 my($self) = shift;
135              
136             $self->{_tree} -> add_event_handler
137             ({
138 10         23 add_child => $self -> _add_child_handler,
139             remove_child => $self -> _remove_child_handler,
140             value => $self -> _value_handler,
141             });
142              
143 10         132 return $self;
144              
145             } # End of _install_handlers.
146              
147             # ----------------------------------------------
148              
149             sub _strip_options
150             {
151 5     5   4 my($self) = shift;
152 5         7 my($params) = @_;
153              
154 5 100 66     44 if ( @$params && ! blessed($params->[0]) && ref($params->[0]) eq 'HASH' )
      66        
155             {
156 1         3 return shift @$params;
157             }
158             else
159             {
160 4         6 return {};
161             }
162              
163             } # End of _strip_options.
164              
165             # ----------------------------------------------
166              
167             sub _add_child_handler
168             {
169 10     10   10 my($self) = shift;
170              
171             return sub
172             {
173 4     4   3579 my($parent, @children) = @_;
174 4         19 my($options) = $self -> _strip_options( \@children );
175              
176 4         5 push @{$self->{_changes} },
  4         15  
177             {
178             action => 'add_child',
179             children => [ @children ],
180             options => $options,
181             parent => $parent,
182             };
183              
184 4 50       15 $self -> commit if ($self -> autocommit);
185 10         57 };
186              
187             } # End of _add_child_handler.
188              
189             # ----------------------------------------------
190              
191             sub _remove_child_handler
192             {
193 10     10   10 my($self) = shift;
194              
195             return sub
196             {
197 1     1   897 my($parent, @children) = @_;
198 1         3 my($options) = $self -> _strip_options( \@children );
199              
200 1         1 push @{$self->{_changes} },
  1         5  
201             {
202             action => 'remove_child',
203             children => [ @children ],
204             options => $options,
205             parent => $parent,
206             };
207              
208 1 50       2 $self -> commit if ($self -> autocommit);
209 10         42 };
210              
211             } # End of _remove_child_handler.
212              
213             # ----------------------------------------------
214              
215             sub _value_handler
216             {
217 10     10   11 my($self) = shift;
218              
219             return sub
220             {
221 2     2   2642 my($node, $old, $new) = @_;
222              
223 2         2 push @{$self->{_changes} },
  2         5  
224             {
225             action => 'change_value',
226             new_value => $node->value,
227             node => $node,
228             old_value => $old,
229             };
230              
231 2 50       15 $self -> commit if ($self -> autocommit);
232 10         52 };
233              
234             } # End of _value_handler.
235              
236             # ----------------------------------------------
237              
238             1;
239              
240             __END__