package Libconf::System::DirectoryWrapper; sub debug { Libconf::debug(@_) } sub globize { my ($obj, $key) = @_; debug "glob : $obj->{glob}, key : $key"; my $name = $obj->{glob}; $name =~ s/\*/$key/g; debug "returning $name"; $name; } sub deglobize { my ($obj, $filename) = @_; my ($glob, $directory) = ($obj->{glob}, $obj->{directory}); debug "glob : $glob, directory : $directory, filename : $filename"; $filename =~ s/^$directory\///; $glob =~ s/\*/(.*)?/g; $filename =~ s/$glob/$1/; debug "returning $filename"; $filename; } sub TIEHASH { my ($pkg, $directory, $glob, $template) = @_; debug; if (-e $directory) { -d $directory or die "$directory is not a directory"; } else { mkdir $directory; } bless { directory => $directory, glob => $glob, template => $template, }, $pkg; } sub CLEAR { my ($obj) = @_; debug; unlink(glob($obj->{directory} . '/' . $obj->{glob})); } sub DELETE { my ($obj, $key) = @_; debug "key: $key"; unlink($obj->{directory} . '/' . globize($obj, $key)); } sub FIRSTKEY { my ($obj) = @_; debug; deglobize($obj, (glob($obj->{directory} . '/' . $obj->{glob}))[0]); } sub EXISTS { my ($obj, $key) = @_; debug "key : $key"; -f $obj->{directory} . "/" . globize($obj, $key); } sub NEXTKEY { my ($obj, $lastkey) = @_; debug "lastkey : $lastkey"; my ($directory, $glob) = ($obj->{directory}, $obj->{glob}); my @files = glob($directory . '/' . $glob); $lastkey = globize($obj, $lastkey); foreach (0..@files-1) { if ($files[$_] eq $lastkey) { return deglobize($obj, $files[$_+1]); } } undef; } sub STORE { my ($obj, $key, $value) = @_; debug "key : $key - value : $value"; my ($directory, $glob) = ($obj->{directory}, $obj->{glob}); ref($value) eq 'HASH' or die "trying to store a non hash in $key"; my $filename = $directory . '/' . globize($obj, $key); -e $filename or utime undef, undef, $filename; #touch replacement my $struct = eval 'require Libconf::Glueconf::' . ucfirst($obj->{template}) . '.pm; new Libconf::Glueconf::Shell(' . $filename . ');'; $@ and die $@; %$struct = %$value; $struct->{libconf}->writeConf($filename); #FIXME, when should we write to the file? } sub FETCH { my ($obj, $key) = @_; debug "key : $key"; my ($directory, $glob) = ($obj->{directory}, $obj->{glob}); my $filename = $directory . '/' . globize($obj, $key); new Libconf::Glueconf::Shell($filename); } 1;