57 |
|
|
58 |
sub TIEHASH { |
sub TIEHASH { |
59 |
my ($pkg, $libconf, $data_description, $data_mapping) = @_; |
my ($pkg, $libconf, $data_description, $data_mapping) = @_; |
60 |
debug; |
debug(); |
61 |
bless { |
bless { |
62 |
libconf => $libconf, |
libconf => $libconf, |
63 |
_data_description => $data_description, |
_data_description => $data_description, |
67 |
|
|
68 |
sub CLEAR { |
sub CLEAR { |
69 |
my ($obj) = @_; |
my ($obj) = @_; |
70 |
debug; |
debug(); |
71 |
$obj->{libconf}->clear(); |
$obj->{libconf}->clear; |
72 |
} |
} |
73 |
|
|
74 |
sub DELETE { |
sub DELETE { |
75 |
my ($obj, $key) = @_; |
my ($obj, $key) = @_; |
76 |
debug "key: $key"; |
debug("key: $key"); |
77 |
my @pos = $obj->{libconf}->findAtomPos( { type => 'KEY_VALUES', key => $key }); |
my @pos = $obj->{libconf}->findAtomPos( { type => 'KEY_VALUES', key => $key }); |
78 |
foreach (@pos) { |
foreach (@pos) { |
79 |
$obj->{libconf}->deleteAtom($_); |
$obj->{libconf}->deleteAtom($_); |
82 |
|
|
83 |
sub FIRSTKEY { |
sub FIRSTKEY { |
84 |
my ($obj) = @_; |
my ($obj) = @_; |
85 |
debug; |
debug(); |
86 |
my $atom = $obj->{libconf}->getAtom(0); |
my $atom = $obj->{libconf}->getAtom(0); |
87 |
$atom->{key}; |
$atom->{key}; |
88 |
} |
} |
89 |
|
|
90 |
sub EXISTS { |
sub EXISTS { |
91 |
my ($obj, $key) = @_; |
my ($obj, $key) = @_; |
92 |
debug "key : $key"; |
debug("key : $key"); |
93 |
my $pos = $obj->{libconf}->findAtomPos( { type => 'KEY_VALUES', key => $key }); |
my $pos = $obj->{libconf}->findAtomPos( { type => 'KEY_VALUES', key => $key }); |
94 |
defined $pos; |
defined $pos; |
95 |
} |
} |
96 |
|
|
97 |
sub NEXTKEY { |
sub NEXTKEY { |
98 |
my ($obj, $lastkey) = @_; |
my ($obj, $lastkey) = @_; |
99 |
debug "lastkey : $lastkey"; |
debug("lastkey : $lastkey"); |
100 |
my @pos = $obj->{libconf}->findAtomPos( { type => 'KEY_VALUES', key => $lastkey }); #FIXME : double entries should be removed elsewhere |
my @pos = $obj->{libconf}->findAtomPos( { type => 'KEY_VALUES', key => $lastkey }); #FIXME : double entries should be removed elsewhere |
101 |
$pos[-1]+1 >= $obj->{libconf}->size() and return undef; |
$pos[-1]+1 >= $obj->{libconf}->size and return undef; |
102 |
$obj->{libconf}->getAtom($pos[-1]+1)->{key}; |
$obj->{libconf}->getAtom($pos[-1]+1)->{key}; |
103 |
} |
} |
104 |
|
|
105 |
sub STORE { |
sub STORE { |
106 |
my ($obj, $key, $value) = @_; |
my ($obj, $key, $value) = @_; |
107 |
debug "key : $key - value : $value"; |
debug("key : $key - value : $value"); |
108 |
ref $value eq '' or die 'trying to store anything else than a value'; |
ref $value eq '' or die 'trying to store anything else than a value'; |
109 |
my $index; |
my $index; |
110 |
my @pos = $obj->{libconf}->findAtomPos({ type => 'KEY_VALUES', key => $key }); |
my @pos = $obj->{libconf}->findAtomPos({ type => 'KEY_VALUES', key => $key }); |
118 |
|
|
119 |
sub FETCH { |
sub FETCH { |
120 |
my ($obj, $key) = @_; |
my ($obj, $key) = @_; |
121 |
debug "key : $key"; |
debug("key : $key"); |
122 |
$key eq 'libconf' and return $obj->{libconf}; |
$key eq 'libconf' and return $obj->{libconf}; |
123 |
substr($key, 0, 1) eq '_' and return $obj->{$key}; |
substr($key, 0, 1) eq '_' and return $obj->{$key}; |
124 |
my @pos = $obj->{libconf}->findAtomPos({ type => 'KEY_VALUES', key => $key }); |
my @pos = $obj->{libconf}->findAtomPos({ type => 'KEY_VALUES', key => $key }); |