27 |
use Libconf::Libconf; |
use Libconf::Libconf; |
28 |
@ISA = qw(Libconf); |
@ISA = qw(Libconf); |
29 |
|
|
|
my @synopsis = ( |
|
|
{ |
|
|
type => 'KEY_VALUE', |
|
|
key => 'USER', |
|
|
rules => [ '/\S+/' ], |
|
|
}, |
|
|
{ |
|
|
type => 'KEY_VALUE', |
|
|
key => 'AUTOLOGIN', |
|
|
value => 'BOOLEAN', |
|
|
rules => [ '/yes|no/i' ], |
|
|
}, |
|
|
{ |
|
|
name => 'EXEC', |
|
|
rules => [ \&isPath ], |
|
|
} |
|
|
); |
|
|
|
|
30 |
sub new { |
sub new { |
31 |
my ($pkg, $filename) = @_; |
my ($pkg, $filename) = @_; |
32 |
my $self = $pkg->Libconf::new($filename, 'shell', ''); |
my $libconf = $pkg->Libconf::new($filename, 'shell', ''); |
33 |
eval Libconf::Glueconf::generateFunctions(@synopsis); |
tie my %wrapper, 'Libconf::Glueconf::Autologin::Wrapper', $libconf; |
34 |
$self; |
\%wrapper; |
35 |
|
} |
36 |
|
|
37 |
|
package Libconf::Glueconf::Autologin::Wrapper; |
38 |
|
|
39 |
|
sub debug { $ENV{DEBUG} and print @_ } |
40 |
|
|
41 |
|
sub TIEHASH { |
42 |
|
my ($pkg, $libconf) = @_; |
43 |
|
debug "Wrapper - TIEHASH\n"; |
44 |
|
bless { libconf => $libconf }, $pkg; |
45 |
|
} |
46 |
|
|
47 |
|
sub CLEAR { |
48 |
|
my ($obj) = @_; |
49 |
|
debug "Wrapper - CLEAR\n"; |
50 |
|
$obj->{libconf}->clear(); |
51 |
|
} |
52 |
|
|
53 |
|
sub DELETE { |
54 |
|
my ($obj, $key) = @_; |
55 |
|
debug "Wrapper - DELETE - key: $key\n"; |
56 |
|
my @pos = $obj->{libconf}->findAtomPos( { type => 'KEY_VALUE', key => $key }); |
57 |
|
foreach (@pos) { |
58 |
|
$obj->{libconf}->deleteAtom($_); |
59 |
|
} |
60 |
|
} |
61 |
|
|
62 |
|
sub FIRSTKEY { |
63 |
|
my ($obj) = @_; |
64 |
|
debug "Wrapper - FIRSTKEY\n"; |
65 |
|
my $atom = $obj->{libconf}->getAtom(0); |
66 |
|
$atom->{key}; |
67 |
|
} |
68 |
|
|
69 |
|
sub EXISTS { |
70 |
|
my ($obj, $key) = @_; |
71 |
|
debug "Wrapper - EXISTS - key : $key\n"; |
72 |
|
my $pos = $obj->{libconf}->findAtomPos( { type => 'KEY_VALUE', key => $key }); |
73 |
|
defined $pos; |
74 |
|
} |
75 |
|
|
76 |
|
sub NEXTKEY { |
77 |
|
my ($obj, $lastkey) = @_; |
78 |
|
debug "Wrapper - NEXTKEY - lastkey : $lastkey\n"; |
79 |
|
my @pos = $obj->{libconf}->findAtomPos( { type => 'KEY_VALUE', key => $lastkey }); #FIXME : double entries should be removed elsewhere |
80 |
|
$pos[-1]+1 >= $obj->{libconf}->size() and return undef; |
81 |
|
$obj->{libconf}->getAtom($pos[-1]+1)->{key}; |
82 |
|
} |
83 |
|
|
84 |
|
sub STORE { |
85 |
|
my ($obj, $key, $value) = @_; |
86 |
|
debug "Wrapper - STORE - key : $key - value : $value\n"; |
87 |
|
ref $value eq '' or die 'trying to store anything else than a value'; |
88 |
|
my $index; |
89 |
|
my @pos = $obj->{libconf}->findAtomPos({ type => 'KEY_VALUE', key => $key }); |
90 |
|
if (@pos == 0) { |
91 |
|
$index = $obj->{libconf}->appendAtom({ type => 'KEY_VALUE', key => $key }); |
92 |
|
} else { |
93 |
|
$index = $pos[-1]; |
94 |
|
} |
95 |
|
$obj->{libconf}->editAtom($index, { type => 'KEY_VALUE', key => $key, value => $value }); |
96 |
|
} |
97 |
|
|
98 |
|
sub FETCH { |
99 |
|
my ($obj, $key) = @_; |
100 |
|
debug "Wrapper - FETCH - key : $key\n"; |
101 |
|
$key eq 'libconf' and return $obj->{libconf}; |
102 |
|
my @pos = $obj->{libconf}->findAtomPos({ type => 'KEY_VALUE', key => $key }); |
103 |
|
$obj->{libconf}->getAtom($pos[-1])->{value}; |
104 |
} |
} |
105 |
|
|
106 |
1; |
1; |