29 |
|
|
30 |
sub new { |
sub new { |
31 |
my ($pkg, $filename) = @_; |
my ($pkg, $filename) = @_; |
32 |
my $libconf = $pkg->Libconf::new($filename, 'shell', ''); |
my $libconf = Libconf::new('Libconf', $filename, 'shell', ''); |
33 |
tie my %wrapper, 'Libconf::Glueconf::Shell::Wrapper', $libconf; |
tie my %wrapper, 'Libconf::Glueconf::Shell::Wrapper', $libconf; |
34 |
bless \%wrapper, $pkg; |
bless \%wrapper, $pkg; |
35 |
} |
} |
46 |
|
|
47 |
package Libconf::Glueconf::Shell::Wrapper; |
package Libconf::Glueconf::Shell::Wrapper; |
48 |
|
|
49 |
sub debug { |
sub debug { Libconf::debug(@_) } |
|
$ENV{DEBUG} or return; |
|
|
print "\033[34m"; |
|
|
print @_; |
|
|
print "\033[0m\n"; |
|
|
} |
|
50 |
|
|
51 |
sub TIEHASH { |
sub TIEHASH { |
52 |
my ($pkg, $libconf) = @_; |
my ($pkg, $libconf) = @_; |
53 |
debug "Shell Wrapper - TIEHASH\n"; |
debug; |
54 |
bless { libconf => $libconf }, $pkg; |
bless { libconf => $libconf }, $pkg; |
55 |
} |
} |
56 |
|
|
57 |
sub CLEAR { |
sub CLEAR { |
58 |
my ($obj) = @_; |
my ($obj) = @_; |
59 |
debug "Shell Wrapper - CLEAR\n"; |
debug; |
60 |
$obj->{libconf}->clear(); |
$obj->{libconf}->clear(); |
61 |
} |
} |
62 |
|
|
63 |
sub DELETE { |
sub DELETE { |
64 |
my ($obj, $key) = @_; |
my ($obj, $key) = @_; |
65 |
debug "Shell Wrapper - DELETE - key: $key\n"; |
debug "key: $key"; |
66 |
my @pos = $obj->{libconf}->findAtomPos( { type => 'KEY_VALUE', key => $key }); |
my @pos = $obj->{libconf}->findAtomPos( { type => 'KEY_VALUE', key => $key }); |
67 |
foreach (@pos) { |
foreach (@pos) { |
68 |
$obj->{libconf}->deleteAtom($_); |
$obj->{libconf}->deleteAtom($_); |
71 |
|
|
72 |
sub FIRSTKEY { |
sub FIRSTKEY { |
73 |
my ($obj) = @_; |
my ($obj) = @_; |
74 |
debug "Shell Wrapper - FIRSTKEY\n"; |
debug; |
75 |
my $atom = $obj->{libconf}->getAtom(0); |
my $atom = $obj->{libconf}->getAtom(0); |
76 |
$atom->{key}; |
$atom->{key}; |
77 |
} |
} |
78 |
|
|
79 |
sub EXISTS { |
sub EXISTS { |
80 |
my ($obj, $key) = @_; |
my ($obj, $key) = @_; |
81 |
debug "Shell Wrapper - EXISTS - key : $key\n"; |
debug "key : $key"; |
82 |
my $pos = $obj->{libconf}->findAtomPos( { type => 'KEY_VALUE', key => $key }); |
my $pos = $obj->{libconf}->findAtomPos( { type => 'KEY_VALUE', key => $key }); |
83 |
defined $pos; |
defined $pos; |
84 |
} |
} |
85 |
|
|
86 |
sub NEXTKEY { |
sub NEXTKEY { |
87 |
my ($obj, $lastkey) = @_; |
my ($obj, $lastkey) = @_; |
88 |
debug "Shell Wrapper - NEXTKEY - lastkey : $lastkey\n"; |
debug "lastkey : $lastkey"; |
89 |
my @pos = $obj->{libconf}->findAtomPos( { type => 'KEY_VALUE', key => $lastkey }); #FIXME : double entries should be removed elsewhere |
my @pos = $obj->{libconf}->findAtomPos( { type => 'KEY_VALUE', key => $lastkey }); #FIXME : double entries should be removed elsewhere |
90 |
$pos[-1]+1 >= $obj->{libconf}->size() and return undef; |
$pos[-1]+1 >= $obj->{libconf}->size() and return undef; |
91 |
$obj->{libconf}->getAtom($pos[-1]+1)->{key}; |
$obj->{libconf}->getAtom($pos[-1]+1)->{key}; |
93 |
|
|
94 |
sub STORE { |
sub STORE { |
95 |
my ($obj, $key, $value) = @_; |
my ($obj, $key, $value) = @_; |
96 |
debug "Shell Wrapper - STORE - key : $key - value : $value\n"; |
debug "key : $key - value : $value"; |
97 |
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'; |
98 |
my $index; |
my $index; |
99 |
my @pos = $obj->{libconf}->findAtomPos({ type => 'KEY_VALUE', key => $key }); |
my @pos = $obj->{libconf}->findAtomPos({ type => 'KEY_VALUE', key => $key }); |
107 |
|
|
108 |
sub FETCH { |
sub FETCH { |
109 |
my ($obj, $key) = @_; |
my ($obj, $key) = @_; |
110 |
debug "Shell Wrapper - FETCH - key : $key\n"; |
debug "key : $key"; |
111 |
$key eq 'libconf' and return $obj->{libconf}; |
$key eq 'libconf' and return $obj->{libconf}; |
112 |
my @pos = $obj->{libconf}->findAtomPos({ type => 'KEY_VALUE', key => $key }); |
my @pos = $obj->{libconf}->findAtomPos({ type => 'KEY_VALUE', key => $key }); |
113 |
$obj->{libconf}->getAtom($pos[-1])->{value}; |
$obj->{libconf}->getAtom($pos[-1])->{value}; |