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

Diff of /libconf/perl-Libconf/System/MDK/Network.pm

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

revision 1.1 by dams, Sat Apr 12 12:56:11 2003 UTC revision 1.2 by dams, Sun Apr 13 22:59:45 2003 UTC
# Line 25  use strict; Line 25  use strict;
25  use vars qw(@ISA);  use vars qw(@ISA);
26  use Libconf::Glueconf;  use Libconf::Glueconf;
27  use Libconf::Libconf;  use Libconf::Libconf;
28    use Libconf::Glueconf::Shell;
29  #use Libconf::Glueconf::XF86Config::Wrapper;  #use Libconf::Glueconf::XF86Config::Wrapper;
30  @ISA = qw(Libconf);  @ISA = qw(Libconf);
31    
32  sub new {  sub new {
33      my ($pkg) = @_;      my ($pkg) = @_;
34      tie my %h_interfaces, 'Libconf::System::MDK::Network::InterfacesWrapper', '/etc/sysconfig/network-scripts', 'ifcfg-*', 'shell';      tie my %h_interfaces, 'Libconf::System::DirectoryWrapper', '/etc/sysconfig/network-scripts', 'ifcfg-*', 'shell';
35      bless {      bless {
36             general => new Libconf::Glueconf::Shell('/etc/sysconfig/network'),             general => new Libconf::Glueconf::Shell('/etc/sysconfig/network'),
37             interfaces => \%h_interfaces,             interfaces => \%h_interfaces,
38            }, $pkg;            }, $pkg;
39  }  }
40    
41  package Libconf::Glueconf::Shell::DirectoryWrapper;  package Libconf::System::DirectoryWrapper;
42    
43  sub debug { $ENV{DEBUG} and print @_ }  sub debug {
44        $ENV{DEBUG} or return;
45        print "\033[34m";
46        print @_;
47        print "\033[0m";
48    }
49    
50  sub deglob {  sub globize {
51      my ($obj, $key) = @_;      my ($obj, $key) = @_;
52        debug "globize - glob : $obj->{glob}, key : $key\n";
53      my $name = $obj->{glob};      my $name = $obj->{glob};
54      $name =~ s/\*/$key/g;      $name =~ s/\*/$key/g;
55        debug "globize - returning $name\n";
56      $name;      $name;
57  }  }
58    
59    sub deglobize {
60        my ($obj, $filename) = @_;
61        my ($glob, $directory) = ($obj->{glob}, $obj->{directory});
62        debug "deglobize - glob : $glob, directory : $directory, filename : $filename\n";
63        $filename =~ s/^$directory\///;
64        $glob =~ s/\*/(.*)?/g;
65        $filename =~ s/$glob/$1/;
66        debug "deglobize - returning $filename\n";
67        $filename;
68    }
69    
70  sub TIEHASH {  sub TIEHASH {
71      my ($pkg, $directory, $glob, $template) = @_;      my ($pkg, $directory, $glob, $template) = @_;
72      debug "Wrapper - TIEHASH\n";      debug "Directory Wrapper - TIEHASH\n";
73      if (-e $directory) {      if (-e $directory) {
74          -d $directory or die "$directory is not a directory";          -d $directory or die "$directory is not a directory";
75      } else {      } else {
# Line 64  sub TIEHASH { Line 83  sub TIEHASH {
83    
84  sub CLEAR {  sub CLEAR {
85      my ($obj) = @_;      my ($obj) = @_;
86      debug "Wrapper - CLEAR\n";      debug "Directory Wrapper - CLEAR\n";
87      unlink(glob($obj->{directory} . '/' . $obj->{glob}));      unlink(glob($obj->{directory} . '/' . $obj->{glob}));
88  }  }
89    
90  sub DELETE {  sub DELETE {
91      my ($obj, $key) = @_;      my ($obj, $key) = @_;
92      debug "Wrapper - DELETE - key: $key\n";      debug "Directory Wrapper - DELETE - key: $key\n";
93      unlink($obj->{directory} . '/' . deglob($obj, $key));      unlink($obj->{directory} . '/' . globize($obj, $key));
94  }  }
95    
96  sub FIRSTKEY {  sub FIRSTKEY {
97      my ($obj) = @_;      my ($obj) = @_;
98      debug "Wrapper - FIRSTKEY\n";      debug "Directory Wrapper - FIRSTKEY\n";
99      (glob($obj->{directory} . '/' . $obj->{glob}))[0]      deglobize($obj, (glob($obj->{directory} . '/' . $obj->{glob}))[0]);
100  }  }
101    
102  sub EXISTS {  sub EXISTS {
103      my ($obj, $key) = @_;      my ($obj, $key) = @_;
104      debug "Wrapper - EXISTS - key : $key\n";      debug "Directory Wrapper - EXISTS - key : $key\n";
105      -f $obj->{directory} . "/" . deglob($obj, $key);      -f $obj->{directory} . "/" . globize($obj, $key);
106  }  }
107    
108  sub NEXTKEY {  sub NEXTKEY {
109      my ($obj, $lastkey) = @_;      my ($obj, $lastkey) = @_;
110      my ($directory, $glob) = ($obj->{glob}, $obj->{directory});      debug "Directory Wrapper - NEXTKEY - lastkey : $lastkey\n";
111        my ($directory, $glob) = ($obj->{directory}, $obj->{glob});
112      my @files = glob($directory . '/' . $glob);      my @files = glob($directory . '/' . $glob);
113      $lastkey = deglob($obj, $key);      $lastkey = globize($obj, $lastkey);
114      foreach (0..@files-1) {      foreach (0..@files-1) {
115          if ($files[$_] eq $lastkey) {          if ($files[$_] eq $lastkey) {
116              $files[$_+1] =~ s/^$directory\///;              return deglobize($obj, $files[$_+1]);
             $glob =~ s/\*/(.*)?/;  
             $files[$_+1] =~ /$glob/;  
             return $&;  
117          }          }
118      }      }
119      undef;      undef;
# Line 104  sub NEXTKEY { Line 121  sub NEXTKEY {
121    
122  sub STORE {  sub STORE {
123      my ($obj, $key, $value) = @_;      my ($obj, $key, $value) = @_;
124      debug "Wrapper - STORE - key : $key - value : $value\n";      debug "Directory Wrapper - STORE - key : $key - value : $value\n";
125      my ($directory, $glob) = ($obj->{glob}, $obj->{directory});      my ($directory, $glob) = ($obj->{directory}, $obj->{glob});
126      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";
127      my $filename = $directory . '/' . deglob($obj, $key);      my $filename = $directory . '/' . globize($obj, $key);
128      -e $filename or utime undef, undef, $filename; #touch replacement      -e $filename or utime undef, undef, $filename; #touch replacement
129      my $struct = new Libconf::Glueconf::Shell($filename);      my $struct = eval 'require Libconf::Glueconf::' . ucfirst($obj->{template}) .
130          '.pm; new Libconf::Glueconf::Shell(' . $filename . ');';
131        $@ and die $@;
132      %$struct = %$value;      %$struct = %$value;
133      $struct->{libconf}->writeConf($filename); #FIXME, when should we write to the file?      $struct->{libconf}->writeConf($filename); #FIXME, when should we write to the file?
134  }  }
135    
136  sub FETCH {  sub FETCH {
137      my ($obj, $key) = @_;      my ($obj, $key) = @_;
138      my ($directory, $glob) = ($obj->{glob}, $obj->{directory});      debug "Directory Wrapper - FETCH - key : $key\n";
139      my $filename = $directory . '/' . deglob($obj, $key);      my ($directory, $glob) = ($obj->{directory}, $obj->{glob});
140        my $filename = $directory . '/' . globize($obj, $key);
141      new Libconf::Glueconf::Shell($filename);      new Libconf::Glueconf::Shell($filename);
142  }  }
143    
144  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