45 |
|
|
46 |
sub readConf { |
sub readConf { |
47 |
my ($obj) = @_; |
my ($obj) = @_; |
48 |
$obj->{libconf}->readConf(); |
$obj->{libconf}->readConf; |
49 |
} |
} |
50 |
|
|
51 |
sub writeConf { |
sub writeConf { |
52 |
my ($obj) = @_; |
my ($obj) = @_; |
53 |
$obj->{libconf}->writeConf(); |
$obj->{libconf}->writeConf; |
54 |
} |
} |
55 |
|
|
56 |
|
|
60 |
|
|
61 |
sub TIEHASH { |
sub TIEHASH { |
62 |
my ($pkg, $libconf, $data_description, $data_mapping) = @_; |
my ($pkg, $libconf, $data_description, $data_mapping) = @_; |
63 |
debug; |
debug(); |
64 |
bless { |
bless { |
65 |
libconf => $libconf, |
libconf => $libconf, |
66 |
_data_description => $data_description, |
_data_description => $data_description, |
70 |
|
|
71 |
sub CLEAR { |
sub CLEAR { |
72 |
my ($obj) = @_; |
my ($obj) = @_; |
73 |
debug; |
debug(); |
74 |
$obj->{libconf}->clear(); |
$obj->{libconf}->clear; |
75 |
} |
} |
76 |
|
|
77 |
#sub DESTROY { |
#sub DESTROY { |
79 |
|
|
80 |
sub DELETE { |
sub DELETE { |
81 |
my ($obj, $key) = @_; |
my ($obj, $key) = @_; |
82 |
debug "key: $key"; |
debug("key: $key"); |
83 |
my @pos = $obj->{libconf}->findAtomPos( { type => 'SECTION', sections => [], section_name => $key }); |
my @pos = $obj->{libconf}->findAtomPos( { type => 'SECTION', sections => [], section_name => $key }); |
84 |
foreach (@pos) { |
foreach (@pos) { |
85 |
$obj->{libconf}->deleteSection($_, 1); |
$obj->{libconf}->deleteSection($_, 1); |
88 |
|
|
89 |
sub FIRSTKEY { |
sub FIRSTKEY { |
90 |
my ($obj) = @_; |
my ($obj) = @_; |
91 |
debug; |
debug(); |
92 |
my $atom = $obj->{libconf}->getAtom(0); |
my $atom = $obj->{libconf}->getAtom(0); |
93 |
if (defined $atom){ |
if (defined $atom){ |
94 |
$atom->{type} eq 'SECTION' or die "atom n° 0 is not a section"; |
$atom->{type} eq 'SECTION' or die "atom n° 0 is not a section"; |
98 |
|
|
99 |
sub EXISTS { |
sub EXISTS { |
100 |
my ($obj, $key) = @_; |
my ($obj, $key) = @_; |
101 |
debug "key : $key"; |
debug("key : $key"); |
102 |
my $pos = $obj->{libconf}->findAtomPos( { type => 'SECTION', sections => [], section_name => $key }); |
my $pos = $obj->{libconf}->findAtomPos( { type => 'SECTION', sections => [], section_name => $key }); |
103 |
defined $pos; |
defined $pos; |
104 |
} |
} |
105 |
|
|
106 |
sub NEXTKEY { |
sub NEXTKEY { |
107 |
my ($obj, $lastkey) = @_; |
my ($obj, $lastkey) = @_; |
108 |
debug "lastkey : $lastkey"; |
debug("lastkey : $lastkey"); |
109 |
my @pos = $obj->{libconf}->findAtomPos( { type => 'SECTION', sections => [] }); |
my @pos = $obj->{libconf}->findAtomPos( { type => 'SECTION', sections => [] }); |
110 |
my $i = 0; |
my $i = 0; |
111 |
my $index; |
my $index; |
121 |
|
|
122 |
sub STORE { |
sub STORE { |
123 |
my ($obj, $key, $value) = @_; |
my ($obj, $key, $value) = @_; |
124 |
debug "key : $key - value : $value"; |
debug("key : $key - value : $value"); |
125 |
ref $value eq 'HASH' or die 'trying to store something else than hash ref'; |
ref $value eq 'HASH' or die 'trying to store something else than hash ref'; |
126 |
my $index; |
my $index; |
127 |
my $pos = $obj->{libconf}->findAtomPos({ type => 'SECTION', section_name => $key, sections => [] }); |
my $pos = $obj->{libconf}->findAtomPos({ type => 'SECTION', section_name => $key, sections => [] }); |
133 |
|
|
134 |
sub FETCH { |
sub FETCH { |
135 |
my ($obj, $key) = @_; |
my ($obj, $key) = @_; |
136 |
debug "key : $key"; |
debug("key : $key"); |
137 |
$key eq 'libconf' and return $obj->{libconf}; |
$key eq 'libconf' and return $obj->{libconf}; |
138 |
substr($key, 0, 1) eq '_' and return $obj->{$key}; |
substr($key, 0, 1) eq '_' and return $obj->{$key}; |
139 |
my $section_position = $obj->{libconf}->findAtomPos( { type => 'SECTION', section_name => $key, sections => [ ] }); |
my $section_position = $obj->{libconf}->findAtomPos( { type => 'SECTION', section_name => $key, sections => [ ] }); |
149 |
|
|
150 |
sub TIEHASH { |
sub TIEHASH { |
151 |
my ($pkg, $libconf, $beginning) = @_; |
my ($pkg, $libconf, $beginning) = @_; |
152 |
debug "beginning : $beginning"; |
debug("beginning : $beginning"); |
153 |
my $atom = $libconf->getAtom($beginning); |
my $atom = $libconf->getAtom($beginning); |
154 |
my @depth = @{$atom->{sections}}; |
my @depth = @{$atom->{sections}}; |
155 |
scalar(keys %{$depth[0]}) == 0 and shift @depth; |
scalar(keys %{$depth[0]}) == 0 and shift @depth; |
156 |
push @depth, { name => $atom->{section_name} }; |
push @depth, { name => $atom->{section_name} }; |
157 |
|
|
158 |
my $key = $beginning+1; |
my $key = $beginning+1; |
159 |
foreach ($beginning+1..$libconf->size()-1) { |
foreach ($beginning+1..$libconf->size-1) { |
160 |
my $atom = $libconf->getAtom($_); |
my $atom = $libconf->getAtom($_); |
161 |
@{$atom->{sections}} > @depth and next; |
@{$atom->{sections}} > @depth and next; |
162 |
Libconf::compare_depth($atom->{sections}, \@depth) or last; |
Libconf::compare_depth($atom->{sections}, \@depth) or last; |
169 |
sections => \@depth, |
sections => \@depth, |
170 |
lastatom => $key, |
lastatom => $key, |
171 |
); |
); |
172 |
debug "firstatom : $hash{firstatom} - lastatom : $hash{lastatom}"; |
debug("firstatom : $hash{firstatom} - lastatom : $hash{lastatom}"); |
173 |
return bless \%hash, $pkg; |
return bless \%hash, $pkg; |
174 |
} |
} |
175 |
|
|
176 |
sub CLEAR { |
sub CLEAR { |
177 |
my ($obj) = @_; |
my ($obj) = @_; |
178 |
debug; |
debug(); |
179 |
$obj->{lastatom} -= $obj->{libconf}->clearSection($obj->{firstatom}, 1); |
$obj->{lastatom} -= $obj->{libconf}->clearSection($obj->{firstatom}, 1); |
180 |
$obj->{lastatom} == $obj->{firstatom} or die "removed atoms number is wrong"; |
$obj->{lastatom} == $obj->{firstatom} or die "removed atoms number is wrong"; |
181 |
} |
} |
182 |
|
|
183 |
sub DELETE { |
sub DELETE { |
184 |
my ($obj, $key) = @_; |
my ($obj, $key) = @_; |
185 |
debug "key : $key"; |
debug("key : $key"); |
186 |
my @pos = $obj->{libconf}->findAtomPos( {type => 'KEY_VALUE', key => $key }, |
my @pos = $obj->{libconf}->findAtomPos( {type => 'KEY_VALUE', key => $key }, |
187 |
$obj->{firstatom}+1, $obj->{lastatom}-1 |
$obj->{firstatom}+1, $obj->{lastatom}-1 |
188 |
); |
); |
194 |
|
|
195 |
sub FIRSTKEY { |
sub FIRSTKEY { |
196 |
my ($obj) = @_; |
my ($obj) = @_; |
197 |
debug; |
debug(); |
198 |
$obj->{firstatom} + 1 == $obj->{lastatom} and return undef; |
$obj->{firstatom} + 1 == $obj->{lastatom} and return undef; |
199 |
my $atom = $obj->{libconf}->getAtom($obj->{firstatom}+1); |
my $atom = $obj->{libconf}->getAtom($obj->{firstatom}+1); |
200 |
$atom->{type} eq 'KEY_VALUE' and return $atom->{key}; |
$atom->{type} eq 'KEY_VALUE' and return $atom->{key}; |
203 |
|
|
204 |
sub EXISTS { |
sub EXISTS { |
205 |
my ($obj, $key) = @_; |
my ($obj, $key) = @_; |
206 |
debug "key : $key"; |
debug("key : $key"); |
207 |
my $pos = $obj->{libconf}->findAtomPos( {type => 'KEY_VALUE', key => $key }, |
my $pos = $obj->{libconf}->findAtomPos( {type => 'KEY_VALUE', key => $key }, |
208 |
$obj->{firstatom}+1, $obj->{lastatom}-1 |
$obj->{firstatom}+1, $obj->{lastatom}-1 |
209 |
); |
); |
212 |
|
|
213 |
sub NEXTKEY { |
sub NEXTKEY { |
214 |
my ($obj, $lastkey) = @_; |
my ($obj, $lastkey) = @_; |
215 |
debug "SectionWrapper - NEXTKEY - lastkey : $lastkey"; |
debug("SectionWrapper - NEXTKEY - lastkey : $lastkey"); |
216 |
debug "coin : " . ($obj->{firstatom}+1) . " --- " . ($obj->{lastatom}-1); |
debug "coin : " . ($obj->{firstatom}+1) . " --- " . ($obj->{lastatom}-1); |
217 |
my $pos = $obj->{libconf}->findAtomPos( {type => 'KEY_VALUE', key => $lastkey }, |
my $pos = $obj->{libconf}->findAtomPos( {type => 'KEY_VALUE', key => $lastkey }, |
218 |
$obj->{firstatom}+1, $obj->{lastatom}-1 |
$obj->{firstatom}+1, $obj->{lastatom}-1 |
223 |
|
|
224 |
sub STORE { |
sub STORE { |
225 |
my ($obj, $key, $value) = @_; |
my ($obj, $key, $value) = @_; |
226 |
debug "key : $key - value : $value"; |
debug("key : $key - value : $value"); |
227 |
#ref $value eq 'HASH' or die 'trying to store anything else than hash ref'; |
#ref $value eq 'HASH' or die 'trying to store anything else than hash ref'; |
228 |
ref $value eq '' or die "try to store a hash in a kery_value atom"; |
ref $value eq '' or die "try to store a hash in a kery_value atom"; |
229 |
my $pos = $obj->{libconf}->findAtomPos( {type => 'KEY_VALUE', key => $key }, |
my $pos = $obj->{libconf}->findAtomPos( {type => 'KEY_VALUE', key => $key }, |
241 |
|
|
242 |
sub FETCH { |
sub FETCH { |
243 |
my ($obj, $key) = @_; |
my ($obj, $key) = @_; |
244 |
debug "key : $key\n"; |
debug("key : $key\n"); |
245 |
my $pos = $obj->{libconf}->findAtomPos( {type => 'KEY_VALUE', key => $key }, |
my $pos = $obj->{libconf}->findAtomPos( {type => 'KEY_VALUE', key => $key }, |
246 |
$obj->{firstatom}+1, $obj->{lastatom}-1 |
$obj->{firstatom}+1, $obj->{lastatom}-1 |
247 |
); |
); |