Initial revision
[OpenSRF.git] / src / perlmods / OpenSRF / Utils / Config.pm
1 package OpenSRF::Utils::Config::Section;
2
3 no strict 'refs';
4
5 use vars qw/@ISA $AUTOLOAD $VERSION/;
6 push @ISA, qw/OpenSRF::Utils/;
7
8 use OpenSRF::Utils (':common');
9
10 $VERSION = do { my @r=(q$Revision$=~/\d+/g); sprintf "%d."."%02d"x$#r,@r };
11
12 my %SECTIONCACHE;
13 my %SUBSECTION_FIXUP;
14
15 #use overload '""' => \&OpenSRF::Utils::Config::dump_ini;
16
17 sub SECTION {
18         my $sec = shift;
19         return $sec->__id(@_);
20 }
21
22 sub new {
23         my $self = shift;
24         my $class = ref($self) || $self;
25
26         $self = bless {}, $class;
27
28         my $lines = shift;
29
30         for my $line (@$lines) {
31
32                 #($line) = split(/\s+\/\//, $line);
33                 #($line) = split(/\s+#/, $line);
34
35                 if ($line =~ /^\s*\[([^\[\]]+)\]/) {
36                         $self->_sub_builder('__id');
37                         $self->__id( $1 );
38                         next;
39                 }
40
41                 my ($protokey,$value,$keytype,$key);
42                 if ($line =~ /^([^=\s]+)\s*=\s*(.*)/s) {
43                         ($protokey,$value) = ($1,$2);
44                         ($keytype,$key) = split(/:/,$protokey);
45                 }
46
47                 $key = $protokey unless ($key);
48
49                 if ($keytype ne $key) {
50                         $keytype = lc $keytype;
51                         if ($keytype eq 'list') {
52                                 $value = [split /\s*,\s*/, $value];
53                         } elsif ($keytype eq 'bool') {
54                                 $value = do{ $value =~ /^t|y|1/i ? 1 : 0; };
55                         } elsif ($keytype eq 'interval') {
56                                 $value = interval_to_seconds($value);
57                         } elsif ($keytype eq 'subsection') {
58                                 if (exists $SECTIONCACHE{$value}) {
59                                         $value = $SECTIONCACHE{$value};
60                                 } else {
61                                         $SUBSECTION_FIXUP{$value}{$self->SECTION} = $key ;
62                                         next;
63                                 }
64                         }
65                 }
66
67                 $self->_sub_builder($key);
68                 $self->$key($value);
69         }
70
71         no warnings;
72         if (my $parent_def = $SUBSECTION_FIXUP{$self->SECTION}) {
73                 my ($parent_section, $parent_key) = each %$parent_def;
74                 $SECTIONCACHE{$parent_section}->{$parent_key} = $self;
75                 delete $SUBSECTION_FIXUP{$self->SECTION};
76         }
77
78         $SECTIONCACHE{$self->SECTION} = $self;
79
80         return $self;
81 }
82
83 package OpenSRF::Utils::Config;
84
85 use vars qw/@ISA $AUTOLOAD $VERSION $OpenSRF::Utils::ConfigCache/;
86 push @ISA, qw/OpenSRF::Utils/;
87
88 use FileHandle;
89 use OpenSRF::Utils (':common');  
90 use OpenSRF::Utils::Log (':levels');
91
92 #use overload '""' => \&OpenSRF::Utils::Config::dump_ini;
93
94 sub import {
95         my $class = shift;
96         my $config_file = shift;
97
98         return unless $config_file;
99
100         $class->load( config_file => $config_file);
101 }
102
103 sub dump_ini {
104         no warnings;
105         my $self = shift;
106         my $string;
107         my $included = 0;
108         if ($self->isa('OpenSRF::Utils::Config')) {
109                 if (UNIVERSAL::isa(scalar(caller()), 'OpenSRF::Utils::Config' )) {
110                         $included = 1;
111                 } else {
112                         $string = "# Main File:  " . $self->FILE . "\n\n" . $string;
113                 }
114         }
115         for my $section ( ('__id', grep { $_ ne '__id' } sort keys %$self) ) {
116                 next if ($section eq 'env' && $self->isa('OpenSRF::Utils::Config'));
117                 if ($section eq '__id') {
118                         $string .= '['.$self->SECTION."]\n" if ($self->isa('OpenSRF::Utils::Config::Section'));
119                 } elsif (ref($self->$section)) {
120                         if (ref($self->$section) =~ /ARRAY/o) {
121                                 $string .= "list:$section = ". join(', ', @{$self->$section}) . "\n";
122                         } elsif (UNIVERSAL::isa($self->$section,'OpenSRF::Utils::Config::Section')) {
123                                 if ($self->isa('OpenSRF::Utils::Config::Section')) {
124                                         $string .= "subsection:$section = " . $self->$section->SECTION . "\n";
125                                         next;
126                                 } else {
127                                         next if ($self->$section->{__sub} && !$included);
128                                         $string .= $self->$section . "\n";
129                                 }
130                         } elsif (UNIVERSAL::isa($self->$section,'OpenSRF::Utils::Config')) {
131                                 $string .= $self->$section . "\n";
132                         }
133                 } else {
134                         next if $section eq '__sub';
135                         $string .= "$section = " . $self->$section . "\n";
136                 }
137         }
138         if ($included) {
139                 $string =~ s/^/## /gm;
140                 $string = "# Subfile:  " . $self->FILE . "\n#" . '-'x79 . "\n".'#include "'.$self->FILE."\"\n". $string;
141         }
142
143         return $string;
144 }
145
146 =head1 NAME
147  
148 OpenSRF::Utils::Config
149  
150
151 =head1 SYNOPSIS
152
153  
154   use OpenSRF::Utils::Config;
155
156   my $config_obj = OpenSRF::Utils::Config->load( config_file   => '/config/file.cnf' );
157
158   my $attrs_href = $config_obj->attributes();
159
160   $config_obj->attributes->no_db(0);
161
162   open FH, '>'.$config_obj->FILE() . '.new';
163   print FH $config_obj;
164   close FH;
165
166  
167
168 =head1 DESCRIPTION
169
170  
171 This module is mainly used by other modules to load a configuration file.
172  
173
174 =head1 NOTES
175
176  
177 Hashrefs of sections can be returned by calling a method of the object of the same name as the section.
178 They can be set by passing a hashref back to the same method.  Sections will B<NOT> be autovivicated, though.
179
180 Here be a config file example, HAR!:
181
182  [datasource]
183  # backend=XMLRPC
184  backend=DBI
185  subsection:definition=devel_db
186
187  [devel_db]
188  dsn=dbi:Pg(RaiseError => 0, AutoCommit => 1):dbname=dcl;host=nsite-dev
189  user=postgres
190  pw=postgres
191  #readonly=1
192  
193  [live_db]
194  dsn=dbi:Pg(RaiseError => 0, AutoCommit => 1):dbname=dcl
195  user=n2dcl
196  pw=dclserver
197  #readonly=1
198
199  [devel_xmlrpc]
200  subsection:definition=devel_rpc
201  
202  [logs]
203  base=/var/log/nsite
204  debug=debug.log
205  error=error.log
206  
207  [debug]
208  enabled=1
209  level=ALL
210  
211  [devel_rpc]
212  url=https://localhost:9000/
213  proto=SSL
214  SSL_cipher_list=ALL
215  SSL_verify_mode=5
216  SSL_use_cert=1
217  SSL_key_file=client-key.pem
218  SSL_cert_file=client-cert.pem
219  SSL_ca_file=cacert.pem
220  log_level=4
221  
222  [dirs]
223  base_dir=/home/miker/cvs/NOC/monitor_core/
224  cert_dir=certs/
225  
226
227 =head1 METHODS
228
229
230 =cut
231
232
233 $VERSION = do { my @r=(q$Revision$=~/\d+/g); sprintf "%d."."%02d"x$#r,@r };
234
235
236 =head2 OpenSRF::Utils::Config->load( config_file => '/some/config/file.cnf' )
237
238 Returns a OpenSRF::Utils::Config object representing the config file that was loaded.
239 The most recently loaded config file (hopefully the only one per app)
240 is stored at $OpenSRF::Utils::ConfigCache. Use OpenSRF::Utils::Config::current() to get at it.
241
242
243 =cut
244
245 sub load {
246         my $pkg = shift;
247         $pkg = ref($pkg) || $pkg;
248
249         my %args = @_;
250
251         (my $new_pkg = $args{config_file}) =~ s/\W+/_/g;
252         $new_pkg .= "::$pkg";
253         $new_section_pkg .= "${new_pkg}::Section";
254
255         {       eval <<"                PERL";
256
257                         package $new_pkg;
258                         use base $pkg;
259                         sub section_pkg { return '$new_section_pkg'; }
260
261                         package $new_section_pkg;
262                         use base "${pkg}::Section";
263         
264                 PERL
265         }
266
267         return $new_pkg->_load( %args );
268 }
269
270 sub _load {
271         my $pkg = shift;
272         $pkg = ref($pkg) || $pkg;
273         my $self = {@_};
274         bless $self, $pkg;
275
276         no warnings;
277         if ((exists $$self{config_file} and OpenSRF::Utils::Config->current) and (OpenSRF::Utils::Config->current->FILE eq $$self{config_file}) and (!$self->{force})) {
278                 delete $$self{force};
279                 return OpenSRF::Utils::Config->current();
280         }
281
282         $self->_sub_builder('__id');
283         $self->FILE($$self{config_file});
284         delete $$self{config_file};
285         return undef unless ($self->FILE);
286
287         $self->load_config();
288         $self->load_env();
289         $self->mangle_dirs();
290         $self->mangle_logs();
291
292         $OpenSRF::Utils::ConfigCache = $self unless $self->nocache;
293         delete $$self{nocache};
294         delete $$self{force};
295         return $self;
296 }
297
298 sub sections {
299         my $self = shift;
300         my %filters = @_;
301
302         my @parts = (grep { UNIVERSAL::isa($_,'OpenSRF::Utils::Config::Section') } values %$self);
303         if (keys %filters) {
304                 my $must_match = scalar(keys %filters);
305                 my @ok_parts;
306                 foreach my $part (@parts) {
307                         my $part_count = 0;
308                         for my $fkey (keys %filters) {
309                                 $part_count++ if ($part->$key eq $filters{$key});
310                         }
311                         push @ok_parts, $part if ($part_count == $must_match);
312                 }
313                 return @ok_parts;
314         }
315         return @parts;
316 }
317
318 sub current {
319         return $OpenSRF::Utils::ConfigCache;
320 }
321
322 sub FILE {
323         return shift()->__id(@_);
324 }
325
326 sub load_env {
327         my $self = shift;
328         my $host = `hostname -f`  || `uname -n`;
329         chomp $host;
330         $$self{env} = $self->section_pkg->new;
331         $$self{env}{hostname} = $host;
332 }
333
334 sub mangle_logs {
335         my $self = shift;
336         return unless ($self->logs && $self->dirs && $self->dirs->log_dir);
337         for my $i ( keys %{$self->logs} ) {
338                 next if ($self->logs->$i =~ /^\//);
339                 $self->logs->$i($self->dirs->log_dir."/".$self->logs->$i);
340         }
341 }
342
343 sub mangle_dirs {
344         my $self = shift;
345         return unless ($self->dirs && $self->dirs->base_dir);
346         for my $i ( keys %{$self->dirs} ) {
347                 if ( $i ne 'base_dir' ) {
348                         next if ($self->dirs->$i =~ /^\//);
349                         my $dir_tmp = $self->dirs->base_dir."/".$self->dirs->$i;
350                         $dir_tmp =~ s#//#/#go;
351                         $dir_tmp =~ s#/$##go;
352                         $self->dirs->$i($dir_tmp);
353                 }
354         }
355 }
356
357 sub load_config {
358         my $self = shift;
359         my $config = new FileHandle $self->FILE, 'r';
360         unless ($config) {
361                 OpenSRF::Utils::Log->error("Could not open ".$self->FILE.": $!\n");
362                 die "Could not open ".$self->FILE.": $!\n";
363         }
364         my @stripped_config = $self->__strip_comments($config) if (defined $config);
365
366         my $chunk = [];
367         for my $line (@stripped_config) {
368                 no warnings;
369                 next unless ($line);
370
371                 if ($line =~ /^\s*\[/ and @$chunk) {
372                         my $section = $self->section_pkg->new($chunk);
373
374                         my $sub_name = $section->SECTION;
375                         $self->_sub_builder($sub_name);
376                         $self->$sub_name($section);
377
378                         #$self->{$section->SECTION} = $section;
379
380                         $chunk = [];
381                         push @$chunk,$line;
382                         next;
383                 } 
384                 if ($line =~ /^#\s*include\s+"(\S+)"\s*$/o) {
385                         my $included_file = $1;
386                         my $section = OpenSRF::Utils::Config->load(config_file => $included_file, nocache => 1);
387
388                         my $sub_name = $section->FILE;
389                         $self->_sub_builder($sub_name);
390                         $self->$sub_name($section);
391
392                         for my $subsect (keys %$section) {
393                                 next if ($subsect eq '__id');
394
395                                 $self->_sub_builder($subsect);
396                                 $self->$subsect($$section{$subsect});
397
398                                 #$self->$subsect($section->$subsect);
399                                 $self->$subsect->{__sub} = 1;
400                         }
401                         next;
402                 }
403
404                 push @$chunk,$line;
405         }
406         my $section = $self->section_pkg->new($chunk) if (@$chunk);
407         my $sub_name = $section->SECTION;
408         $self->_sub_builder($sub_name);
409         $self->$sub_name($section);
410
411 }
412
413
414 #------------------------------------------------------------------------------------------------------------------------------------
415
416 =head1 SEE ALSO
417
418         OpenSRF::Utils
419
420 =head1 BUGS
421
422 No know bugs, but report any to miker@purplefrog.com.
423
424 =head1 COPYRIGHT AND LICENSING
425
426 Mike Rylander, Copyright 2000-2004
427
428 The OpenSRF::Utils::Config module is free software. You may distribute under the terms
429 of the GNU General Public License version 2 or greater.
430
431 =cut
432
433
434 1;