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::Logger;
  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;