/[libconf]/libconf/perl-Libconf/System/DirectoryWrapper.pm
ViewVC logotype

Diff of /libconf/perl-Libconf/System/DirectoryWrapper.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by dams, Thu May 1 21:37:49 2003 UTC revision 1.2 by dams, Sat May 24 22:54:48 2003 UTC
# Line 22  sub deglobize { Line 22  sub deglobize {
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;
# Line 30  sub TIEHASH { Line 42  sub TIEHASH {
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 {
# Line 45  sub CLEAR { Line 59  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;

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26