"Fossies" - the Fresh Open Source Software Archive 
Member "dirvish-1.2.1/loadconfig.pl" (19 Feb 2005, 5038 Bytes) of package /linux/privat/old/dirvish-1.2.1.tgz:
As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style:
standard) with prefixed line numbers and
code folding option.
Alternatively you can here
view or
download the uninterpreted source code file.
For more information about "loadconfig.pl" see the
Fossies "Dox" file reference documentation.
1 # Get patch level of loadconfig.pl in case exit codes
2 # are needed.
3 # $Id: loadconfig.pl,v 12.0 2004/02/25 02:42:15 jw Exp $
4
5
6 #########################################################################
7 # #
8 # Copyright 2002 and $Date: 2004/02/25 02:42:15 $
9 # Pegasystems Technologies and J.W. Schultz #
10 # #
11 # Licensed under the Open Software License version 2.0 #
12 # #
13 #########################################################################
14
15 sub seppuku # Exit with code and message.
16 {
17 my ($status, $message) = @_;
18
19 chomp $message;
20 if ($message)
21 {
22 $seppuku_prefix and print STDERR $seppuku_prefix, ': ';
23 print STDERR $message, "\n";
24 }
25 exit $status;
26 }
27
28 sub slurplist
29 {
30 my ($key, $filename, $Options) = @_;
31 my $f;
32 my $array;
33
34 $filename =~ m(^/) and $f = $filename;
35 if (!$f && ref($$Options{vault}) ne 'CODE')
36 {
37 $f = join('/', $$Options{Bank}, $$Options{vault},
38 'dirvish', $filename);
39 -f $f or $f = undef;
40 }
41 $f or $f = "$CONFDIR/$filename";
42 open(PATFILE, "<$f") or seppuku 229, "cannot open $filename for $key list";
43 $array = $$Options{$key};
44 while(<PATFILE>)
45 {
46 chomp;
47 length or next;
48 push @{$array}, $_;
49 }
50 close PATFILE;
51 }
52
53 # loadconfig -- load configuration file
54 # SYNOPSYS
55 # loadconfig($opts, $filename, \%data)
56 #
57 # DESCRIPTION
58 # load and parse a configuration file into the data
59 # hash. If the filename does not contain / it will be
60 # looked for in the vault if defined. If the filename
61 # does not exist but filename.conf does that will
62 # be read.
63 #
64 # OPTIONS
65 # Options are case sensitive, upper case has the
66 # opposite effect of lower case. If conflicting
67 # options are given only the last will have effect.
68 #
69 # f Ignore fields in config file that are
70 # capitalized.
71 #
72 # o Config file is optional, return undef if missing.
73 #
74 # R Do not allow recoursion.
75 #
76 # g Only load from global directory.
77 #
78 #
79 #
80 # LIMITATIONS
81 # Only way to tell whether an option should be a list
82 # or scalar is by the formatting in the config file.
83 #
84 # Options reqiring special handling have to have that
85 # hardcoded in the function.
86 #
87
88 sub loadconfig
89 {
90 my ($mode, $configfile, $Options) = @_;
91 my $confile = undef;
92 my ($key, $val);
93 my $CONFIG;
94 ref($Options) or $Options = {};
95 my %modes;
96 my ($conf, $bank, $k);
97
98 $modes{r} = 1;
99 for $_ (split(//, $mode))
100 {
101 if (/[A-Z]/)
102 {
103 $_ =~ tr/A-Z/a-z/;
104 $modes{$_} = 0;
105 } else {
106 $modes{$_} = 1;
107 }
108 }
109
110
111 $CONFIG = 'CFILE' . scalar(@{$$Options{Configfiles}});
112
113 $configfile =~ s/^.*\@//;
114
115 if($configfile =~ m[/])
116 {
117 $confile = $configfile;
118 }
119 elsif($configfile ne '-')
120 {
121 if(!$modes{g} && $$Options{vault} && $$Options{vault} ne 'CODE')
122 {
123 if(!$$Options{Bank})
124 {
125 my $bank;
126 for $bank (@{$$Options{bank}})
127 {
128 if (-d "$bank/$$Options{vault}")
129 {
130 $$Options{Bank} = $bank;
131 last;
132 }
133 }
134 }
135 if ($$Options{Bank})
136 {
137 $confile = join('/', $$Options{Bank},
138 $$Options{vault}, 'dirvish',
139 $configfile);
140 -f $confile || -f "$confile.conf"
141 or $confile = undef;
142 }
143 }
144 $confile ||= "$CONFDIR/$configfile";
145 }
146
147 if($configfile eq '-')
148 {
149 open($CONFIG, $configfile) or seppuku 221, "cannot open STDIN";
150 } else {
151 ! -f $confile && -f "$confile.conf" and $confile .= '.conf';
152
153 if (! -f "$confile")
154 {
155 $modes{o} and return undef;
156 seppuku 222, "cannot open config file: $configfile";
157 }
158
159 grep(/^$confile$/, @{$$Options{Configfiles}})
160 and seppuku 224, "ERROR: config file looping on $confile";
161
162 open($CONFIG, $confile)
163 or seppuku 225, "cannot open config file: $configfile";
164 }
165 push(@{$$Options{Configfiles}}, $confile);
166
167 while(<$CONFIG>)
168 {
169 chomp;
170 s/\s*#.*$//;
171 s/\s+$//;
172 /\S/ or next;
173
174 if(/^\s/ && $key)
175 {
176 s/^\s*//;
177 push @{$$Options{$key}}, $_;
178 }
179 elsif(/^SET\s+/)
180 {
181 s/^SET\s+//;
182 for $k (split(/\s+/))
183 {
184 $$Options{$k} = 1;
185 }
186 }
187 elsif(/^UNSET\s+/)
188 {
189 s/^UNSET\s+//;
190 for $k (split(/\s+/))
191 {
192 $$Options{$k} = undef;
193 }
194 }
195 elsif(/^RESET\s+/)
196 {
197 ($key = $_) =~ s/^RESET\s+//;
198 $$Options{$key} = [ ];
199 }
200 elsif(/^[A-Z]/ && $modes{f})
201 {
202 $key = undef;
203 }
204 elsif(/^\S+:/)
205 {
206 ($key, $val) = split(/:\s*/, $_, 2);
207 length($val) or next;
208 $k = $key; $key = undef;
209
210 if ($k eq 'config')
211 {
212 $modes{r} and loadconfig($mode . 'O', $val, $Options);
213 next;
214 }
215 if ($k eq 'client')
216 {
217 if ($modes{r} && ref ($$Options{$k}) eq 'CODE')
218 {
219 loadconfig($mode . 'og', "$CONFDIR/$val", $Options);
220 }
221 $$Options{$k} = $val;
222 next;
223 }
224 if ($k eq 'file-exclude')
225 {
226 $modes{r} or next;
227
228 slurplist('exclude', $val, $Options);
229 next;
230 }
231 if (ref ($$Options{$k}) eq 'ARRAY')
232 {
233 push @{$$Options{$k}}, $_;
234 } else {
235 $$Options{$k} = $val;
236 }
237 }
238 }
239 close $CONFIG;
240 return $Options;
241 }