22 |
$filename; |
$filename; |
23 |
} |
} |
24 |
|
|
25 |
|
sub readConf { |
26 |
|
my ($self) = @_; |
27 |
|
$self->{hash} = {}; |
28 |
|
foreach (glob($self->{directory} . '/' . $self->{glob})) { |
29 |
|
my $struct = eval q(require Libconf::Glueconf::) . ucfirst($self->{template}) . |
30 |
|
q(; new Libconf::Glueconf::) . ucfirst($self->{template}) . "('" . $_ . "');"; |
31 |
|
$@ and die "---- $@"; |
32 |
|
$self->{hash}{deglobize($self, $_)} = $struct; |
33 |
|
} |
34 |
|
} |
35 |
|
|
36 |
|
|
37 |
sub TIEHASH { |
sub TIEHASH { |
38 |
my ($pkg, $directory, $glob, $template) = @_; |
my ($pkg, $directory, $glob, $template) = @_; |
39 |
debug; |
debug; |
42 |
} else { |
} else { |
43 |
mkdir $directory; |
mkdir $directory; |
44 |
} |
} |
45 |
bless { directory => $directory, |
my $self = { directory => $directory, |
46 |
glob => $glob, |
glob => $glob, |
47 |
template => $template, |
template => $template, |
48 |
}, $pkg; |
}; |
49 |
|
readConf($self); |
50 |
|
bless $self, $pkg; |
51 |
} |
} |
52 |
|
|
53 |
sub CLEAR { |
sub CLEAR { |
59 |
sub DELETE { |
sub DELETE { |
60 |
my ($obj, $key) = @_; |
my ($obj, $key) = @_; |
61 |
debug "key: $key"; |
debug "key: $key"; |
62 |
unlink($obj->{directory} . '/' . globize($obj, $key)); |
delete $obj->{hash}{$key}; |
63 |
|
# unlink($obj->{directory} . '/' . globize($obj, $key)); |
64 |
} |
} |
65 |
|
|
66 |
sub FIRSTKEY { |
sub FIRSTKEY { |
67 |
my ($obj) = @_; |
my ($obj) = @_; |
68 |
debug; |
debug; |
69 |
deglobize($obj, (glob($obj->{directory} . '/' . $obj->{glob}))[0]); |
my $a = keys %{$obj->{hash}}; |
70 |
|
scalar each %{$obj->{hash}}; |
71 |
|
# deglobize($obj, (glob($obj->{directory} . '/' . $obj->{glob}))[0]); |
72 |
} |
} |
73 |
|
|
74 |
sub EXISTS { |
sub EXISTS { |
75 |
my ($obj, $key) = @_; |
my ($obj, $key) = @_; |
76 |
debug "key : $key"; |
debug "key : $key"; |
77 |
-f $obj->{directory} . "/" . globize($obj, $key); |
exists $obj->{hash}{$key}; |
78 |
|
# -f $obj->{directory} . "/" . globize($obj, $key); |
79 |
} |
} |
80 |
|
|
81 |
sub NEXTKEY { |
sub NEXTKEY { |
82 |
my ($obj, $lastkey) = @_; |
my ($obj, $lastkey) = @_; |
83 |
debug "lastkey : $lastkey"; |
debug "lastkey : $lastkey"; |
84 |
my ($directory, $glob) = ($obj->{directory}, $obj->{glob}); |
scalar each %{$obj->{hash}}; |
85 |
my @files = glob($directory . '/' . $glob); |
# my ($directory, $glob) = ($obj->{directory}, $obj->{glob}); |
86 |
$lastkey = globize($obj, $lastkey); |
# my @files = glob($directory . '/' . $glob); |
87 |
foreach (0..@files-1) { |
# $lastkey = globize($obj, $lastkey); |
88 |
if ($files[$_] eq $lastkey) { |
# foreach (0..@files-1) { |
89 |
return deglobize($obj, $files[$_+1]); |
# if ($files[$_] eq $lastkey) { |
90 |
} |
# return deglobize($obj, $files[$_+1]); |
91 |
} |
# } |
92 |
undef; |
# } |
93 |
|
# undef; |
94 |
} |
} |
95 |
|
|
96 |
sub STORE { |
sub STORE { |
97 |
my ($obj, $key, $value) = @_; |
my ($obj, $key, $value) = @_; |
98 |
debug "key : $key - value : $value"; |
debug "key : $key - value : $value"; |
99 |
my ($directory, $glob) = ($obj->{directory}, $obj->{glob}); |
# my ($directory, $glob) = ($obj->{directory}, $obj->{glob}); |
100 |
ref($value) eq 'HASH' or die "trying to store a non hash in $key"; |
# ref($value) eq 'HASH' or die "trying to store a non hash in $key"; |
101 |
my $filename = $directory . '/' . globize($obj, $key); |
# my $filename = $directory . '/' . globize($obj, $key); |
102 |
-e $filename or utime undef, undef, $filename; #touch replacement |
# if (!-e $filename) { |
103 |
my $struct = eval 'require Libconf::Glueconf::' . ucfirst($obj->{template}) . |
if (!exists $obj->{hash}{$key}) { |
104 |
'.pm; new Libconf::Glueconf::Shell(' . $filename . ');'; |
# utime undef, undef, $filename; #touch replacement |
105 |
$@ and die $@; |
my $struct = eval q(require Libconf::Glueconf::) . ucfirst($obj->{template}) . |
106 |
%$struct = %$value; |
q(; new Libconf::Glueconf::) . ucfirst($obj->{template}) . "('" . $filename . "');"; |
107 |
$struct->{libconf}->writeConf($filename); #FIXME, when should we write to the file? |
$@ and die $@; |
108 |
|
$obj->{hash}{$key} = $struct; |
109 |
|
} |
110 |
|
$obj->{hash}{$key} = $value; |
111 |
|
# %$struct = %$value; |
112 |
|
# $struct->{libconf}->writeConf($filename); #FIXME, when should we write to the file? |
113 |
} |
} |
114 |
|
|
115 |
sub FETCH { |
sub FETCH { |
116 |
my ($obj, $key) = @_; |
my ($obj, $key) = @_; |
117 |
debug "key : $key"; |
debug "key : $key"; |
118 |
my ($directory, $glob) = ($obj->{directory}, $obj->{glob}); |
$obj->{hash}{$key}; |
119 |
my $filename = $directory . '/' . globize($obj, $key); |
# my ($directory, $glob) = ($obj->{directory}, $obj->{glob}); |
120 |
new Libconf::Glueconf::Shell($filename); |
# my $filename = $directory . '/' . globize($obj, $key); |
121 |
|
# new Libconf::Glueconf::Shell($filename); |
122 |
} |
} |
123 |
|
|
124 |
1; |
1; |