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         $self->_sub_builder('__id');
  30         # Hard-code this to match old bootstrap.conf section name
  31         $self->__id('bootstrap');
  32
  33         my $bootstrap = shift;
  34
  35         foreach my $key (sort keys %$bootstrap) {
  36                 $self->_sub_builder($key);
  37                 $self->$key($bootstrap->{$key});
  38         }
  39
  40         return $self;
  41 }
  42
  43 package OpenSRF::Utils::Config;
  44
  45 use vars qw/@ISA $AUTOLOAD $VERSION $OpenSRF::Utils::ConfigCache/;
  46 push @ISA, qw/OpenSRF::Utils/;
  47
  48 use FileHandle;
  49 use XML::LibXML;
  50 use OpenSRF::Utils (':common');
  51 use OpenSRF::Utils::Logger;
  52 use Net::Domain qw/hostfqdn/;
  53
  54 #use overload '""' => \&OpenSRF::Utils::Config::dump_ini;
  55
  56 sub import {
  57         my $class = shift;
  58         my $config_file = shift;
  59
  60         return unless $config_file;
  61
  62         $class->load( config_file => $config_file);
  63 }
  64
  65 sub dump_ini {
  66         no warnings;
  67         my $self = shift;
  68         my $string;
  69         my $included = 0;
  70         if ($self->isa('OpenSRF::Utils::Config')) {
  71                 if (UNIVERSAL::isa(scalar(caller()), 'OpenSRF::Utils::Config' )) {
  72                         $included = 1;
  73                 } else {
  74                         $string = "# Main File:  " . $self->FILE . "\n\n" . $string;
  75                 }
  76         }
  77         for my $section ( ('__id', grep { $_ ne '__id' } sort keys %$self) ) {
  78                 next if ($section eq 'env' && $self->isa('OpenSRF::Utils::Config'));
  79                 if ($section eq '__id') {
  80                         $string .= '['.$self->SECTION."]\n" if ($self->isa('OpenSRF::Utils::Config::Section'));
  81                 } elsif (ref($self->$section)) {
  82                         if (ref($self->$section) =~ /ARRAY/o) {
  83                                 $string .= "list:$section = ". join(', ', @{$self->$section}) . "\n";
  84                         } elsif (UNIVERSAL::isa($self->$section,'OpenSRF::Utils::Config::Section')) {
  85                                 if ($self->isa('OpenSRF::Utils::Config::Section')) {
  86                                         $string .= "subsection:$section = " . $self->$section->SECTION . "\n";
  87                                         next;
  88                                 } else {
  89                                         next if ($self->$section->{__sub} && !$included);
  90                                         $string .= $self->$section . "\n";
  91                                 }
  92                         } elsif (UNIVERSAL::isa($self->$section,'OpenSRF::Utils::Config')) {
  93                                 $string .= $self->$section . "\n";
  94                         }
  95                 } else {
  96                         next if $section eq '__sub';
  97                         $string .= "$section = " . $self->$section . "\n";
  98                 }
  99         }
 100         if ($included) {
 101                 $string =~ s/^/## /gm;
 102                 $string = "# Subfile:  " . $self->FILE . "\n#" . '-'x79 . "\n".'#include "'.$self->FILE."\"\n". $string;
 103         }
 104
 105         return $string;
 106 }
 107
 108 =head1 NAME
 109
 110 OpenSRF::Utils::Config
 111
 112
 113 =head1 SYNOPSIS
 114
 115
 116   use OpenSRF::Utils::Config;
 117
 118   my $config_obj = OpenSRF::Utils::Config->load( config_file   => '/config/file.cnf' );
 119
 120   my $attrs_href = $config_obj->bootstrap();
 121
 122   $config_obj->bootstrap->loglevel(0);
 123
 124   open FH, '>'.$config_obj->FILE() . '.new';
 125   print FH $config_obj;
 126   close FH;
 127
 128
 129
 130 =head1 DESCRIPTION
 131
 132
 133 This module is mainly used by other OpenSRF modules to load an OpenSRF configuration file.
 134 OpenSRF configuration files are XML files that contain a C<< <config> >> root element and an C<< <opensrf> >>
 135 child element (in XPath notation, C</config/opensrf/>). Each child element is converted into a
 136 hash key=>value pair. Elements that contain other XML elements are pushed into arrays and added
 137 as an array reference to the hash. Scalar values have whitespace trimmed from the left and right
 138 sides.
 139
 140 Child elements of C<< <config> >> other than C<< <opensrf> >> are currently ignored by this module.
 141
 142 =head1 EXAMPLE
 143
 144 Given an OpenSRF configuration file named F<opensrf_core.xml> with the following content:
 145
 146   <?xml version='1.0'?>
 147   <config>
 148     <opensrf>
 149       <router_name>router</router_name>
 150
 151       <routers>
 152         <router>localhost</router>
 153         <router>otherhost</router>
 154       </routers>
 155
 156       <logfile>/openils/var/log/osrfsys.log</logfile>
 157     </opensrf>
 158   </config>
 159
 160 ... calling C<< OpenSRF::Utils::Config->load(config_file => 'opensrf_core.xml') >> will create a hash
 161 with the following structure:
 162
 163   {
 164     router_name => 'router',
 165     routers => ['localhost', 'otherhost'],
 166     logfile => '/openils/var/log/osrfsys.log'
 167   }
 168
 169 You can retrieve any of these values by name from the bootstrap section of C<$config_obj>; for example:
 170
 171   $config_obj->bootstrap->router_name
 172
 173 =head1 NOTES
 174
 175 For compatibility with a previous version of OpenSRF configuration files, the F</config/opensrf/> section
 176 has a hardcoded name of B<bootstrap>. However, future iterations of this module may extend the ability
 177 of the module to parse the entire OpenSRF configuration file and provide sections named after the sibling
 178 elements of C</config/opensrf>.
 179
 180 Hashrefs of sections can be returned by calling a method of the object of the same name as the section.
 181 They can be set by passing a hashref back to the same method.  Sections will B<NOT> be autovivicated, though.
 182
 183
 184 =head1 METHODS
 185
 186
 187 =cut
 188
 189
 190 $VERSION = do { my @r=(q$Revision$=~/\d+/g); sprintf "%d."."%02d"x$#r,@r };
 191
 192
 193 =head2 OpenSRF::Utils::Config->load( config_file => '/some/config/file.cnf' )
 194
 195 Returns a OpenSRF::Utils::Config object representing the config file that was loaded.
 196 The most recently loaded config file (hopefully the only one per app)
 197 is stored at $OpenSRF::Utils::ConfigCache. Use OpenSRF::Utils::Config::current() to get at it.
 198
 199
 200 =cut
 201
 202 sub load {
 203         my $pkg = shift;
 204         $pkg = ref($pkg) || $pkg;
 205
 206         my %args = @_;
 207
 208         (my $new_pkg = $args{config_file}) =~ s/\W+/_/g;
 209         $new_pkg .= "::$pkg";
 210         $new_section_pkg .= "${new_pkg}::Section";
 211
 212         {       eval <<"                PERL";
 213
 214                         package $new_pkg;
 215                         use base $pkg;
 216                         sub section_pkg { return '$new_section_pkg'; }
 217
 218                         package $new_section_pkg;
 219                         use base "${pkg}::Section";
 220
 221                 PERL
 222         }
 223
 224         return $new_pkg->_load( %args );
 225 }
 226
 227 sub _load {
 228         my $pkg = shift;
 229         $pkg = ref($pkg) || $pkg;
 230         my $self = {@_};
 231         bless $self, $pkg;
 232
 233         no warnings;
 234         if ((exists $$self{config_file} and OpenSRF::Utils::Config->current) and (OpenSRF::Utils::Config->current->FILE eq $$self{config_file}) and (!$self->{force})) {
 235                 delete $$self{force};
 236                 return OpenSRF::Utils::Config->current();
 237         }
 238
 239         $self->_sub_builder('__id');
 240         $self->FILE($$self{config_file});
 241         delete $$self{config_file};
 242         return undef unless ($self->FILE);
 243
 244         $self->load_config();
 245         $self->load_env();
 246         $self->mangle_dirs();
 247         $self->mangle_logs();
 248
 249         $OpenSRF::Utils::ConfigCache = $self unless $self->nocache;
 250         delete $$self{nocache};
 251         delete $$self{force};
 252         return $self;
 253 }
 254
 255 sub sections {
 256         my $self = shift;
 257         my %filters = @_;
 258
 259         my @parts = (grep { UNIVERSAL::isa($_,'OpenSRF::Utils::Config::Section') } values %$self);
 260         if (keys %filters) {
 261                 my $must_match = scalar(keys %filters);
 262                 my @ok_parts;
 263                 foreach my $part (@parts) {
 264                         my $part_count = 0;
 265                         for my $fkey (keys %filters) {
 266                                 $part_count++ if ($part->$key eq $filters{$key});
 267                         }
 268                         push @ok_parts, $part if ($part_count == $must_match);
 269                 }
 270                 return @ok_parts;
 271         }
 272         return @parts;
 273 }
 274
 275 sub current {
 276         return $OpenSRF::Utils::ConfigCache;
 277 }
 278
 279 sub FILE {
 280         return shift()->__id(@_);
 281 }
 282
 283 sub load_env {
 284         my $self = shift;
 285         my $host = $ENV{'OSRF_HOSTNAME'} || hostfqdn();
 286         chomp $host;
 287         $$self{env} = $self->section_pkg->new;
 288         $$self{env}{hostname} = $host;
 289 }
 290
 291 sub mangle_logs {
 292         my $self = shift;
 293         return unless ($self->logs && $self->dirs && $self->dirs->log_dir);
 294         for my $i ( keys %{$self->logs} ) {
 295                 next if ($self->logs->$i =~ /^\//);
 296                 $self->logs->$i($self->dirs->log_dir."/".$self->logs->$i);
 297         }
 298 }
 299
 300 sub mangle_dirs {
 301         my $self = shift;
 302         return unless ($self->dirs && $self->dirs->base_dir);
 303         for my $i ( keys %{$self->dirs} ) {
 304                 if ( $i ne 'base_dir' ) {
 305                         next if ($self->dirs->$i =~ /^\//);
 306                         my $dir_tmp = $self->dirs->base_dir."/".$self->dirs->$i;
 307                         $dir_tmp =~ s#//#/#go;
 308                         $dir_tmp =~ s#/$##go;
 309                         $self->dirs->$i($dir_tmp);
 310                 }
 311         }
 312 }
 313
 314 sub load_config {
 315         my $self = shift;
 316         my $parser = XML::LibXML->new();
 317
 318         # Hash of config values
 319         my %bootstrap;
 320
 321         # Return an XML::LibXML::Document object
 322         my $config = $parser->parse_file($self->FILE);
 323
 324         unless ($config) {
 325                 OpenSRF::Utils::Logger->error("Could not open ".$self->FILE.": $!\n");
 326                 die "Could not open ".$self->FILE.": $!\n";
 327         }
 328
 329         # Return an XML::LibXML::NodeList object matching all child elements
 330         # of <config><opensrf>...
 331         my $osrf_cfg = $config->findnodes('/config/opensrf/child::*');
 332
 333         # Iterate through the nodes to pull out key=>value pairs of config settings
 334         foreach my $node ($osrf_cfg->get_nodelist()) {
 335                 my $child_state = 0;
 336
 337                 # This will be overwritten if it's a scalar setting
 338                 $bootstrap{$node->nodeName()} = [];
 339
 340                 foreach my $child_node ($node->childNodes) {
 341                         # from libxml/tree.h: nodeType 1 = ELEMENT_NODE
 342                         next if $child_node->nodeType() != 1;
 343
 344                         # If the child node is an element, this element may
 345                         # have multiple values; therefore, push it into an array
 346                         push @{$bootstrap{$node->nodeName()}}, OpenSRF::Utils::Config::extract_text($child_node->textContent);
 347                         $child_state = 1;
 348                 }
 349                 if (!$child_state) {
 350                         $bootstrap{$node->nodeName()} = OpenSRF::Utils::Config::extract_text($node->textContent);
 351                 }
 352         }
 353
 354         my $section = $self->section_pkg->new(\%bootstrap);
 355         my $sub_name = $section->SECTION;
 356         $self->_sub_builder($sub_name);
 357         $self->$sub_name($section);
 358
 359 }
 360
 361 sub extract_text {
 362         my $self = shift;
 363         $self =~ s/^\s*([.*?])\s*$//m;
 364         return $self;
 365 }
 366
 367 #------------------------------------------------------------------------------------------------------------------------------------
 368
 369 =head1 SEE ALSO
 370
 371         OpenSRF::Utils
 372
 373 =head1 LIMITATIONS
 374
 375 Elements containing heterogeneous child elements are treated as though they have the same element name;
 376 for example:
 377   <routers>
 378     <router>localhost</router>
 379     <furniture>chair</furniture>
 380   </routers>
 381
 382 ... will simply generate a key=>value pair of C<< routers => ['localhost', 'chair'] >>.
 383
 384 =head1 BUGS
 385
 386 No known bugs, but report any to open-ils-dev@list.georgialibraries.org or mrylander@gmail.com.
 387
 388 =head1 COPYRIGHT AND LICENSING
 389
 390 Copyright (C) 2000-2007, Mike Rylander
 391 Copyright (C) 2007, Laurentian University, Dan Scott <dscott@laurentian.ca>
 392
 393 The OpenSRF::Utils::Config module is free software. You may distribute under the terms
 394 of the GNU General Public License version 2 or greater.
 395
 396 =cut
 397
 398
 399 1;