lib/Stem/Conf.pm

   1 #  File: Stem/Conf.pm
   2
   3 #  This file is part of Stem.
   4 #  Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
   5
   6 #  Stem is free software; you can redistribute it and/or modify
   7 #  it under the terms of the GNU General Public License as published by
   8 #  the Free Software Foundation; either version 2 of the License, or
   9 #  (at your option) any later version.
  10
  11 #  Stem is distributed in the hope that it will be useful,
  12 #  but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 #  GNU General Public License for more details.
  15
  16 #  You should have received a copy of the GNU General Public License
  17 #  along with Stem; if not, write to the Free Software
  18 #  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  19
  20 #  For a license to use the Stem under conditions other than those
  21 #  described here, to purchase support for this software, or to purchase a
  22 #  commercial warranty contract, please contact Stem Systems at:
  23
  24 #       Stem Systems, Inc.              781-643-7504
  25 #       79 Everett St.                  info@stemsystems.com
  26 #       Arlington, MA 02474
  27 #       USA
  28
  29 package Stem::Conf ;
  30
  31 use Data::Dumper ;
  32 use strict ;
  33
  34 use Stem::Vars ;
  35
  36 use Stem::Trace 'log' => 'stem_status', 'sub' => 'TraceStatus' ;
  37 use Stem::Trace 'log' => 'stem_error' , 'sub' => 'TraceError'  ;
  38
  39 Stem::Route::register_class( __PACKAGE__, 'conf' ) ;
  40
  41 my @conf_paths = split ':', $Env{ 'conf_path' } || '' ;
  42 if ( my $add_conf_path = $Env{ 'add_conf_path' } ) {
  43
  44         push @conf_paths, split( ':', $add_conf_path ) ;
  45 }
  46
  47 my $attr_spec = [
  48
  49         {
  50                 'name'          => 'path',
  51                 'required'      => 1,
  52                 'help'          => <<HELP,
  53 This is the full path of the configuration file.
  54 HELP
  55         },
  56
  57         {
  58                 'name'          => 'to_hub',
  59                 'help'          => <<HELP,
  60 This is the Hub that this configuration will be sent to.
  61 HELP
  62         },
  63 ] ;
  64
  65 # this does not construct anything. just loads a conf file locally or remotely
  66
  67 sub new {
  68
  69         my( $class ) = shift ;
  70
  71         my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
  72         return $self unless ref $self ;
  73
  74         if ( my $to_hub = $self->{'to_hub'} ) {
  75
  76                 my $conf_data = load_conf_file( $self->{'path'} ) ;
  77
  78                 return $conf_data unless ref $conf_data ;
  79
  80                 my $msg = Stem::Msg->new(
  81                                 'to_hub'        => $to_hub,
  82                                 'to_cell'       => __PACKAGE__,
  83                                 'from_cell'     => __PACKAGE__,
  84                                 'type'          => 'cmd',
  85                                 'cmd'           => 'remote',
  86                                 'data'          => $conf_data,
  87                 ) ;
  88
  89                 $msg->dispatch() ;
  90
  91                 return ;
  92         }
  93
  94         my $err = load_conf_file( $self->{'path'}, 1 ) ;
  95
  96 TraceError $err if $err ;
  97
  98         return $err if $err ;
  99
 100         return ;
 101 }
 102
 103
 104 sub load_cmd {
 105
 106         my( $self, $msg ) = @_ ;
 107
 108         my $data = $msg->data() ;
 109
 110         my @conf_names ;
 111
 112         push( @conf_names, @{$data} ) if ref $data eq 'ARRAY' ;
 113         push( @conf_names, ${$data} ) if ref $data eq 'SCALAR' ;
 114
 115         my $err = load_confs( @conf_names ) ;
 116
 117 TraceError $err if $err ;
 118
 119         return $err if $err ;
 120
 121         return ;
 122 }
 123
 124 sub remote_cmd {
 125
 126         my( $self, $msg ) = @_ ;
 127
 128         my $err = configure( $msg->data() ) ;
 129
 130 TraceError $err if $err ;
 131
 132         return $err if $err ;
 133
 134         return ;
 135 }
 136
 137 sub load_conf_file {
 138
 139         my( $conf_path, $do_conf ) = @_ ;
 140
 141         -r $conf_path or return "$conf_path can't be read: $!" ;
 142
 143         my $conf_data = Stem::Util::load_file( $conf_path ) ;
 144
 145         return "Stem::Conf load error:\n$conf_data" unless ref $conf_data ;
 146
 147         return $conf_data unless $do_conf ;
 148
 149         my $conf_err = configure( $conf_data ) ;
 150
 151         return <<ERR if $conf_err ;
 152 Configuration error in '$conf_path'
 153 $conf_err
 154 ERR
 155
 156 #       TraceStatus "$conf_path configuration loaded." ;
 157
 158         return ;
 159 }
 160
 161
 162 sub load_confs {
 163
 164         my ( @conf_names ) = @_ ;
 165
 166         NAME:
 167         foreach my $conf_name ( @conf_names ) {
 168
 169                 $conf_name =~ s/\.stem$// ;
 170
 171                 for my $path ( @conf_paths ) {
 172
 173                         my $conf_path = "$path/$conf_name.stem" ;
 174
 175                         next unless -e $conf_path ;
 176
 177                         my $err = load_conf_file( $conf_path, 1 ) ;
 178
 179                         return $err if $err ;
 180
 181                         next NAME ;
 182                 }
 183
 184                 local( $" ) = "\n\t" ;
 185
 186                 return <<ERR ;
 187 Can't find config file '$conf_name.stem' in these directories:
 188         @conf_paths
 189 ERR
 190         }
 191
 192         return ;
 193 }
 194
 195 my $eval_error ;
 196
 197 sub configure {
 198
 199         my ( $conf_list_ref ) = @_ ;
 200
 201         my $class ;
 202         my @notify_done; # list of objects/packages to call config_done on
 203
 204         foreach my $conf_ref ( @{$conf_list_ref} ) {
 205
 206                 my %conf ;
 207
 208                 if ( ref $conf_ref eq 'HASH' ) {
 209
 210                         %conf = %{$conf_ref} ;
 211                 }
 212                 elsif ( ref $conf_ref eq 'ARRAY' ) {
 213
 214                         %conf = @{$conf_ref} ;
 215                 }
 216                 else {
 217                         return "config entry is not an HASH or ARRAY ref\n" .
 218                                         Dumper($conf_ref). "\n" ;
 219                 }
 220
 221                 unless ( $class = $conf{'class'} ) {
 222
 223                         return "Missing class entry in conf\n" .
 224                              Dumper($conf_ref) . "\n" ;
 225                 }
 226
 227 # get the config name for registration
 228
 229                 my $reg_name = $conf{'name'} || '' ;
 230
 231                 no strict 'refs' ;
 232
 233                 unless ( %{"::${class}"} ) {
 234
 235                         my $module = $class ;
 236                         $module =~ s{::}{/}g ;
 237                         $module .= '.pm' ;
 238
 239                         while( 1 ) {
 240
 241                                 my $err = eval { require $module } ;
 242
 243                                 return <<ERR if $err && $err !~ /^1/ ;
 244 Configure error FOO in Cell '$reg_name' from class '$class' FOO
 245 $eval_error
 246 $err
 247 ERR
 248                                 last if $err ;
 249
 250                                 if ( $@ =~ /Can't locate $module/ ) {
 251
 252 # this could be a subclass so try to load the parent class
 253 # is this used?
 254                                         next if $module =~ s{/\w+\.pm$}{.pm} ;
 255
 256                                         die
 257                                  "Conf: can't find module for class $class" ;
 258                                 }
 259
 260                                 return "eval $@\n" if $@ ;
 261                         }
 262
 263                 }
 264
 265 # if arguments, call the method or new to get a possible object
 266
 267                 if ( my $args_ref = $conf{'args'} ) {
 268
 269                         my @args ;
 270
 271                         if ( ref $args_ref eq 'HASH' ) {
 272
 273                                 @args = %{$args_ref} ;
 274                         }
 275                         elsif ( ref $args_ref eq 'ARRAY' ) {
 276
 277                                 @args = @{$args_ref} ;
 278                         }
 279                         else {
 280                                 return
 281                                  "args entry is not an HASH or ARRAY ref\n" .
 282                                         Dumper($args_ref). "\n" ;
 283                         }
 284
 285                         my $method = $conf{'method'} || 'new' ;
 286
 287
 288 # register if we have an object
 289
 290 #print "NAME: $reg_name\n" ;
 291
 292                         if ( my $obj = $class->$method(
 293                                                 'reg_name' => $reg_name,
 294                                                 @args ) ) {
 295
 296                                 return <<ERR unless ref $obj ;
 297 Configure error in Cell '$reg_name' from class '$class'
 298 $obj
 299 ERR
 300
 301 # register the object by the conf name or the class
 302
 303                                 my $err = Stem::Route::register_cell(
 304                                                 $obj,
 305                                                 $reg_name || $class ) ;
 306
 307                                 return $err if $err ;
 308                                 push @notify_done, $obj if $obj->can('config_done');
 309                                 next;
 310                         }
 311
 312                      }
 313 # or else register the class if we have a name
 314
 315                 my $err = Stem::Route::register_class( $class, $reg_name ) ;
 316
 317                 return $err if $err ;
 318                 push @notify_done, $class if $class->can('config_done');
 319         }
 320
 321         foreach my $class (@notify_done) {
 322            $class->config_done();
 323         }
 324
 325         return ;
 326 }
 327
 328 1 ;