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