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;