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 { |
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; |
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; |
|
|
|