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