eval 'exec perl -x $0 ${1+"$@"}' # -*-perl-*-
  if 0;
#!perl -w
#
# ======================================================================
# This file is Copyright 1998,1999 by the Purdue Research Foundation and
# may only be used under license.  For terms of the license, see the
# file named COPYRIGHT included with this software release.
# AAFID is a trademark of the Purdue Research Foundation.
# All rights reserved.
# ======================================================================
#
# AAFID::Config package
#
# AAFID project, COAST Laboratory, CERIAS, 1998-1999.
# 
# Diego Zamboni, Jun 24, 1998.
#
# NOTE: This file is in Perl's POD format. For more information, see the 
#       manual page for perlpod(1).
#

package AAFID::Config;

# The following keeps up with the RCS version number. The self-assignment
# keeps the -w switch from complaining (because $VERSION may not be used
# anywhere else in this file).
$VERSION = do { my @r = (q$Revision: 1.10 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; $VERSION = $VERSION;

use strict;
use Resources;
use File::Basename;
use AAFID::System;
use vars qw(
	    $VERSION
	    %Resources
	    $configdir
	    %_visitedClasses
	   );

=pod

This class handles the reading, inheritance and assignment of configuration
information for entities and programs. It figures out where the configuration
files are, and reads the appropriate ones in the appropriate order, 
assigning the resources as it goes along.

The central element of this package is the C<configure> method. This
method can be called both as an instance method and as a class
method. Entities should declare themselves as subclasses of
B<AAFID::Config> and call C<configure> as an instance method
(C<$self->configure()>) in order for it to be able to follow the
inheritance chain correctly. Stand alone programs should call
C<configure> as a class method (C<AAFID::Config::configure()>), and it
will only set the global parameters.

The C<configure> method may be passed one of the following arguments:

=over 4

=item *

A pre-initialized C<Resources> object, which contains initial parameter
values.

=item *

A hash which contains C<Parameter =E<gt> Value> pairs that specify
initial parameters.

=back 4

If any of the initial parameters passed specified a directory from which
C<configure> can get the location of the configuration files (such as
B<BaseDir> or B<ConfigDir>), that directory is used. Otherwise, 
C<configure> deducts the directory from which the B<AAFID::Config> package
was loaded, and according to the standard AAFID2 directory structure,
uses C<../../config> (respective to that directory) to access the config
files.

The C<configure> method returns a true value if all the parameters are
set and read successfully, and C<undef> if something fails.

If it is called as an instance method, the corresponding parameters are
set into the object, and the object itself is returned. If it is called
as a class method, a hash is returned that contains all the parameters
in C<param =E<gt> value> format.

If it is called as an instance method, C<configure> should be called 
B<after> the object has been assigned its ID, because it is necessary
to locate per-entity configuration files.

=head1 Resource assignment order

Values read later override earlier values.

=over 4

=item 1

Hard-coded parameter values that the class may have.

=item 2

Parameters from the global config file "AAFID" in the main configuration
directory.

=item 3

Parameters from all applicable class-specific files in the main
configuration directory.

=item 4

Steps 1-3 are repeated in all the applicable architecture-specific
directories that exist.

Architecture directories are looked for in the following order:

=over 4

=item 1

"os" (as produced by 'uname -s')

=item 2

"os-release" (as produced by 'uname -s' and 'uname -r')

=item 3

"os-release-processor" (as produced by 'uname -s', 'uname -r' and 'uname -p')

=back 4

=item 5

Steps 1-3 are repeated in the corresponding host-specific directory, if
it exists.

=back 4

=cut

sub configure {
  my $im=0;
  my $self;
  my $rsc;
  my %rscs;
  my $class;
  # Determine if we are being called as an instance method.
  if (ref($_[0]) && ref($_[0]) ne "Resources") {
    $im=1;
    $self=shift;
    $class=ref($self);
    _log("configure called as instance method by object of class $class\n");
  }
  else {
    _log("configure called as class method\n");
    $class=(caller)[0];
  }
  # Determine if we are being passed an argument, and if so, what type
  # of argument (a Resources object or a hash)
  if (defined($_[0])) {  # If there is an argument
    if (ref($_[0])) {    # and it is a reference
      if (ref($_[0]) eq "Resources") {  # and it is a ref to a Resources object
	$rsc=shift;   # then take it
	_log("Got Resources object as argument\n");
      }
      else {  # if it is a ref, but to something else...
	# Unknown object type passed.
	return undef;
      }
    }
    else {   # if the argument is not a reference
      %rscs=@_;  # take it as a hash.
      _log("Got hash as argument\n");
    }
  }
  # Now we have processed all our arguments, so lets rock.
  # First, create the base Resources object where we'll accumulate everything.
  if (!$rsc) {
#    $rsc=Resources->new('_RES_NODEFAULTS');
    $rsc=Resources->new;
    $rsc->put('resources.mergeclass', 0);
    _log("Created new Resources object\n");
    if (%rscs) {
      # Put each passed parameter into the resources object.
      foreach (keys %rscs) {
	$rsc->put($_, $rscs{$_});
      }
    }
  }
#  if ($im) {
#    $rsc->merge($class);
#  }
  # Now we should have in $rsc a Resources object that contains the default
  # resources (if any) passed as arguments. Now we try to figure out
  # where the config directory is.
  # First try to see if we have the ConfigDir parameter directly.
  if ($im) {
    $configdir=$rsc->valbyclass($self, "ConfigDir");
  }
  else {
    $configdir=$rsc->valbyname("ConfigDir");
  }
  if (!$configdir) {
    # If not, try to see if we have the BaseDir parameter.
    _log("Did not get ConfigDir, trying BaseDir...\n");
    my $basedir;
    if ($im) {
      $basedir=$rsc->valbyclass($self, "BaseDir");
    }
    else {
      $basedir=$rsc->valbyname("BaseDir");
    }
    if ((!$basedir) || (! -d "$basedir/config")) {
      _log("Did not get BaseDir, trying load directory\n");
      # If no base dir, or BaseDir/config does not exist, try to 
      # figure out where we were loaded from, and deduct from there.
      my $myloaddir=dirname($INC{'AAFID/Config.pm'});
      _log("I was loaded from $myloaddir\n");
      # $myloaddir should contain something terminating in '/AAFID'
      if (!$myloaddir) {
	# Something weird is going on here.
	return undef;
      }
      # Remove two components to get the base name.
      $basedir=dirname(dirname($myloaddir));
      # Get the config dir from there.
      $configdir="$basedir/config";
      # If we do not find the configuration directory no matter how
      # hard we look, we don't want just to fail. Instead, we get
      # the default parameters and return.
      if (! -d $configdir) {
	if (!$im) {
	   return _putParamsInHash($rsc);
	}
	else {
           $self->setParameters(_putParamsInHash($rsc, $self));
	   return $self;
	}
      }
    }
    else {
      $configdir="$basedir/config";
    }
  }
  else {
    # nothing
  }

  # First, load the global resources.
  _log("Using ConfigDir=$configdir\n");
  if (-f "$configdir/AAFID") {
    $rsc->load("$configdir/AAFID");
    _log("Global configuration.... loaded\n");
  }
  else {
    _log("Global configuration... not present\n");
  }
  # Recursively load the files corresponding to the inheritance chain.
  %_visitedClasses=();
  _load($configdir, $class, $rsc);
  # If we were called as class method, this is all we do.
  if (!$im) {
    return _putParamsInHash($rsc);
  }
  # Now we see if there's a directory that matches our host name.
  my $host=$self->breakID->{Host};
  my $hconfigdir="$configdir/$host";
  if (-d $hconfigdir) {
    _log("Using ConfigDir=$hconfigdir\n");
    if (-f "$hconfigdir/AAFID") {
      $rsc->load("$hconfigdir/AAFID");
      _log("Global host configuration... loaded\n");
    }
    else {
      _log("Global host configuration... not present\n");
    }
    %_visitedClasses=();
    _load($hconfigdir, $class, $rsc);
  }
  # Now we load the files matching our entity ID.
#  _load_per_entity($self->ID, $configdir, $rsc);
  # Now, we put all the resources, except those of the Resources class
  # itself, in the object as parameters. We do not need to check $im
  # here anymore, because non-instance calls exited a few lines above
  # this point.
  $self->setParameters(_putParamsInHash($rsc, $self));
  # Return myself
  return $self;
}

=pod

To load the corresponding configuration files in the appropriate
order, the C<@ISA> array is followed. The C<@ISA> graph is followed in
a depth-first-left-to-right fashion (where left-to-right means that
the tree for the first element of each C<@ISA> array is visited
first), loading the corresponding configuration file for each class. The
algorithm is as follows:

  load(classname) {
    for each $class in @classname::ISA {
      load($class)
    }
    load configuration file for $class
  }

A cache is kept of classes that have been already visited  to
avoid loading their configuration information again if they
appear more than once in the inheritance graph.

=cut

sub _load {
  no strict 'refs';
  my ($configdir, $classname, $rsc)=@_;
  my $class;
  foreach $class (@{"${classname}::ISA"}) {
    _load($configdir, $class, $rsc);
  }
  # Eliminate the bla::blu:: parts, if any.
  $classname =~ s/^.*:://;
  if (!exists($_visitedClasses{$classname})) {
    if (-f "$configdir/$classname") {
      $rsc->load("$configdir/$classname");
      _log("Configuration for $classname... loaded\n");
    }
    else {
      _log("Configuration for $classname... not present\n");
    }
    $_visitedClasses{$classname}=1;
  }
}

=pod

To load the per-entity configuration files, we read all the files in
the current directory, sort them by length, and load all the ones that
match a suffix of our entity ID. Files that have been already loaded
(stored in C<%_visitedClasses>) are not loaded again. The reason that
they are processed in order of length is that shorter names would
correspond to more general specifications (for example, all the entities
in a certain host), whereas longer names are more specific specifications
(for example, host name plus entity class).

=cut

sub _load_per_entity {
  my $id=shift;
  my $configdir=shift;
  my $rsc=shift;
  opendir CONFIGDIR, $configdir
    or return;
  my @files=grep !/^\./, readdir CONFIGDIR;
  @files=sort { length($a) <=> length($b) } @files;
  foreach (@files) {
    if ($id =~ /^$_/) {
      $rsc->load("$configdir/$_");
      _log("Configuration file $_... loaded\n");
    }
  }
}

=pod 

We use a small auxiliary routine to put all the parameters of a Resource
object (except for those corresponding to the Resources class itself)
in a hash. If the second parameter is given, it must be an object reference,
and it will be used to get only the parameters that correspond to that
object according to its inheritance chain.

Before returning the hash, the default global parameters are checked
to see that they have appropriate default values.

=cut

sub _putParamsInHash {
  my $rsc=shift;
  my $obj=shift;
  my ($key, $ref);
  my %result;
  while (($key, $ref)=$rsc->each) {
    next if $key =~ /^resources\./;
    # Remove the trailing parts of the name.
    $key =~ s/.*\.//;
    $result{$key}=$ref->[0];
  }
  _checkDefaultValues(\%result);
  _log("Returning: ".join(",", %result)."\n");
  return %result;
}

=pod

The C<_checkDefaultValues> subroutine verifies that all the default
parameters have appropriate values.

=cut

sub _checkDefaultValues {
  my $hash=shift;
  my $myloaddir=dirname($INC{'AAFID/Config.pm'});
  # First get or deduct the directories.
  if (!exists($hash->{classdir})) {
    # By default, ClassDir is from where we were loaded.
    $hash->{classdir}=dirname($myloaddir);
  }
  if (!exists($hash->{basedir})) {
    # By default, BaseDir is the parent of ConfigDir
    if ($configdir) {
       $hash->{basedir}=dirname($configdir);
    }
    else {
       $hash->{basedir}=dirname($hash->{classdir});
    }
  }
  if (!exists($hash->{agentsdir})) {
    # By default, AgentsDir is ClassDir/Agents
    $hash->{agentsdir}= $hash->{classdir} . "/Agents";
    if (! -d $hash->{agentsdir}) {
       $hash->{agentsdir} = "$myloaddir/Agents";
    }
  }
  # Store the ConfigDir.
  $hash->{configdir}=$configdir;
  
  # Now other parameters.
  if (!exists($hash->{listenport})) {
    $hash->{listenport}=44777;
  }
  if (!exists($hash->{logfile})) {
    $hash->{logfile}="AAFID.log";
  }
  if (!exists($hash->{logcategories})) {
    $hash->{logcategories}=['messages', 'errors'];
  }

  # Temporary directory
  if (!exists($hash->{tmpdir})) {
    # Check all the common environment variables, or default to a
    # OS-specific default directory or, as a last resort, '/tmp' if
    # it exists.
    $hash->{tmpdir}=$ENV{TMP} || 
                    $ENV{TMPDIR} ||
		    $ENV{TEMP} ||
		    $ENV{TEMPDIR} ||
		    AAFID::System::tmpdir() ||
		    (-d '/tmp' && '/tmp') ||
		    die "Could not find an existing temporary directory\n";
  }
}

=pod

Auxiliary routine that generates a log message. In production mode this
will be disabled.

=cut

sub _log {
#  my $msg=shift;
#  print STDERR "AAFID::Config: $msg";
}

1;

#
# $Id: Config.pm,v 1.10 1999/09/03 17:08:52 zamboni Exp $
# $Log: Config.pm,v $
# Revision 1.10  1999/09/03 17:08:52  zamboni
# Changed the start line to something that is path-independent, and
# updated the copyright notice.
#
# Revision 1.9  1999/08/08 00:18:12  zamboni
# - Moved log tag to end of file.
# - Added description of order in which the parameter values are assigned.
#
# Revision 1.8  1999/06/28 21:22:02  zamboni
# Merged with a07-port-to-linux
#
# Revision 1.7.2.1  1999/06/28 18:24:09  zamboni
# Added a missing "use AAFID::System"
#
# Revision 1.7  1999/06/11 21:50:23  zamboni
# - Added code to set the default parameter TmpDir.
#
# Revision 1.6  1998/06/29 20:11:23  zamboni
# Added copyright message
#
# Revision 1.5  1998/06/27 05:01:19  zamboni
# Removed 'params' from the default list of log categories active.
#
# Revision 1.4  1998/06/27 04:24:27  zamboni
# Made it that when no configuration directory is found, a best attempt
# is made anyway to get the configuration parameters and a hash is
# returned, instead of undef as before.
#
# Revision 1.3  1998/06/27 03:47:52  zamboni
# Reenabled log messages.
#
# Revision 1.2  1998/06/26 21:22:47  zamboni
# - Made it follow the inheritance chain of the caller package even if
#   it is called as a Class method.
# - Removed many of the log messages, and made the remaining more consistent.
# - Added the visiting of a directory with the same name as the local
#   host, using the same file names in that directory to read per-host
#   configuration parameters.
# - Wrote proto-code for reading configuration parameters per entity
#   identifier, but it does not work yet, so it is not being used.
# - Added deafult values for all the standard global parameters, in
#   the subroutine _checkDefaultValues.
# - Disabled log messages (which were printed to STDERR).
#
# Revision 1.1  1998/06/25 21:36:47  zamboni
# Initial revision
#
