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