=head1 NAME

CFX5::CurrentConfig - Low-level access to configuration records

=head1 SYNOPSIS

This package provides the two functions, C<getconf> and C<setconf>,
which manipulate the current configuration, and stores it
internally. It should not be C<use>d directly if possible, but
accessed via the L<CFX5::Config> module; the only exception to this is
modules which are in turn required by L<CFX5::Config>.

The functions are defined in here rather than directly in
C<CFX5::Config> in order to keep the list of what uses what an acyclic
graph. 

=cut

package CFX5::CurrentConfig;

use strict;

use vars qw($CVSVersion);
$CVSVersion='$Id$ ';

use Exporter;
use vars qw(@ISA @EXPORT_OK %EXPORT_TAGS);
@ISA=qw(Exporter);
@EXPORT_OK=qw(getconf getconf_default setconf query_conf unsetconf
	      %Config %config %CFX5Config);
%EXPORT_TAGS=('all' => [@EXPORT_OK],
	      'std' => [qw(getconf setconf)],
	      'hash' => [qw(%Config)],
	     );

use Tie::Hash;
push @ISA, qw(Tie::StdHash);

use CFX5::Output qw(:int);

use CFX5::PkgLoader qw(cfx5_require);

# even though we use the standard debug handling, this code is called
# so many times it's worth disabling all calls unless required.
use constant;
BEGIN {
  if ($ENV{CFX_DEBUG_CONF}) {
    constant->import(DEBUG => 1);
  } else {
    constant->import(DEBUG => 0);
  }
}
sub _debug_conf {
  warn(@_,"\n") if $ENV{CFX_DEBUG_CONF} > 1;
}
#BEGIN {
#  # override _debug
#  local $^W=0;
#  *_debug=\&_debug_conf;
#}

# the %currconf hash is used to hold the current version of the
# configuration, ie including any variables which have been
# calculated. This allows quick lookup and setting from other
# places. The @wantedconf list includes all configuration variables
# which have been queried.
use vars qw(%currconf @wantedconf);

# the list @Sources in CFX5::Config::source keeps a list of the
# packages which should be used to resolve requests for configuration
# variables.  We initialise it here so we can use it -- empty --
# without worrying about whether another module has loaded
# CFX5::Config::source.
BEGIN { @CFX5::Config::source::Sources=(); }

use vars qw(%recursionprotect);

use vars qw(%Config %config %CFX5Config);
tie %Config, __PACKAGE__;
tie %config, __PACKAGE__;
tie %CFX5Config, __PACKAGE__;

=head2 $CFX5::CurrentConfig::IgnoreEnvironment

If set to a TRUE value, this variable will cause the config handling
code to ignore environment variables when looking for a value for a
configuration record, unless it has no built-in way to calculate it,
in a reversal of the normal behaviour.  This can be used when running
one product from within another, for example.

=cut

use vars qw($IgnoreEnvironment);

=head2 getconf

  $value=getconf("RECORD");

Fetch the named configuration record S<RECORD> (most of which are
named after the environment variables in F<cfx5rc>), calculating it if
it is not already known.  See L<CFX5::DefaultConfig>,
L<CFX5::Config::def> and L<CFX5::Config::source> for information about
defining defaults for configuration records.

=cut

sub getconf {
  #
  # THIS IS HOT CODE!  Be careful!
  #

  my $record=shift;

  unless (defined $record) {
    internal_error("Attempt to look up an undefined record name!");
  }
  
  #_debug "Getting config variable $record";

  # if we've already got this, it's easy.  Note that we use "defined"
  # rather than "Exists": although unset is a valid value for a
  # configuration variable, if there's no currect value we have
  # another go at calculating it. TODO: This should possibly be
  # changed.
  if (defined $currconf{$record}) {
    _debug_conf("CONF: $record is $currconf{$record}") if DEBUG;
    return $currconf{$record};
  }

  my $newv;

  _debug_conf "CONF: $record not already known." if DEBUG;

  # we need to figure out if we're allowed to use the environment
  # before the commandline is parsed, so check here.
  unless (defined $IgnoreEnvironment) {
    $IgnoreEnvironment=0;
    for my $a (@main::ARGV) {
      $IgnoreEnvironment=1 if $a eq '-no-inherit';
    }
  }

  # is it set in the environment?
  if (!$IgnoreEnvironment and exists $ENV{$record}) {
    $newv=$ENV{$record};
    _debug "Got $record=$newv from environment" if DEBUG;
  } else {
    my $func=($CFX5::DefaultConfig::calcfunction{$record} 
	      ? $CFX5::DefaultConfig::calcfunction{$record} 
	      : $record);

    cfx5_require('CFX5::DefaultConfig');

    if (exists $recursionprotect{$record}
	or exists $recursionprotect{$func}) {
      # don't abort, this isn't necessarily an error; it just means
      # that it's a function which sets and queries more than one
      # variable.
      _debug "Not recursing on calculation of $record" if DEBUG;
    } else {
      # oh, well. We use the functions DefaultConfig::<var> to calculate
      # the config variables, to allow easy dynamic adding of new
      # ones.
      #
      # note: avoid eval "string", as the perlcc doesn't like it. :-(
      # Plus it's stupid -- ASM, later!
      #_debug "  Will try to find $record via $func";
      $recursionprotect{$record}=1;
      $recursionprotect{$func}=1;
      $@ = '';
      for my $pkg ('CFX5::Config::def::_config',
		   @CFX5::Config::source::Sources,
		   'CFX5::DefaultConfig') {
	#_debug("Trying to find $func in $pkg");
        my $f="${pkg}::$func";
        if (exists &$f) {
          $newv=eval {
            no strict 'refs';
            &{"$f"}($record);
          };
          if ($@ =~ m/\QUndefined subroutine &${pkg}::${func}/
              or $@ =~ m!\QCan't locate auto/!) {
            # we found the function ... but then it didn't exist after
            # all.
            internal_error("Expected function $f missing");
          }
        }
      }
      delete $recursionprotect{$record};
      delete $recursionprotect{$func};

      # check the error in $@
      if (defined $@ and $@ ne "") {
	# we have an error; what is it?
	#if ($@ =~ m/^\QUndefined subroutine &\E[^\s]*\Q::$func/) {
	#  # this is not a standard variable
	#  _debug "$record has no default function";
        #} elsif ($@ =~ m/^\QCan't locate auto\//) {
        #  # error from the autoloader, assume we don't have it
	#  _debug "Error $@ from autoloader, assuming kosher";
	#} else {
	  # erm ... help?
	  internal_error("Unexpected error\n  $@while working out $record");
	  unset $newv;
	#}
      }
      if (defined $newv) {
	_debug "Calculated $record=$newv" if DEBUG;
      } else {
	_debug "Failed to calculate $record" if DEBUG;
        # fall-back: look in the environment now
        if ($IgnoreEnvironment and exists $ENV{$record}) {
          $newv=$ENV{$record};
          _debug "Got $record=$newv from environment" if DEBUG;
        }
      }
    }
  }

  if (defined $newv) {
    $currconf{$record}=$newv;
  } else {
    # the functions which calculate multiple config variables return
    # undef, but use setconf to set the variable anyway; check for
    # this too
    $newv=$currconf{$record} if exists $currconf{$record};
  }

  push @wantedconf, $record;

  return $newv;
}

=head2 getconf_default

  my $defval=getconf_default("RECORD");

This function tries to return a sensible value for the "default" value
for a configuration record, which is an unfortunately ill-defined
concept.  The best way of explaining exactly what it returned is to
set out the steps it takes:

=over

=item 1.

First of all, it temporarily removes this value from the hash of
cached config parameters, so any explicit assignments -- including
those from configuration files -- will not be picked up.

=item 2.

Next, it temporarily removes it from the environment, so it cannot be
overridden from there either.

=item 3.

Some of the temporary internal variables -- such as the recursion
protection -- are replaced altogether.  So be careful about when you
use this!

=item 4.

Now it calls C<getconf> to get a value for the variable.

=back

So any other assignments which have been explicitly made will be
honoured, which may not always be what you expect.  For example, let
us assume that the user has set C<CFX5EXECDIR> in her F<cfx5rc> file,
but not C<CFX_SOLVER_EXEC>.  If we were to use this function to ask
whether the solver which was being run is the expected one, it would
use the overridden value of C<CFX5EXECDIR> to calculate
C<CFX_SOLVER_EXEC>.  This would give the same value as was set
already, so a naive comparison would indicate that she was indeed
running the standard solver.

If additional arguments are specified after the record to get, they
are also unset before attempting to calculate the value, and also
restored afterwards.

=cut

sub getconf_default {
  my $record=shift;
  _debug_conf("Temporarily removing configuration information for ", join(" ",$record,@_), " ...") if DEBUG;
  local %currconf=%currconf;
  #for my $k (keys %ENV) {
  #  if (not defined $k) {
  #    internal_error("Undefined key in environment");
  #  }
  #  unless (defined $ENV{$k}) {
  #    internal_error("Undefined value for env var $k");
  #  }
  #}
  local %ENV=%ENV;
  for my $r ($record, @_) {
    delete $currconf{$r};
    delete $ENV{$r};
  }
  local %recursionprotect;
  my $rv=getconf($record);
  _debug_conf "... restoring configuration information for $record et al." if DEBUG;
  return $rv;
}

=head2 setconf

  setconf("RECORD","value");

Set the configuration record S<RECORD> to C<"value">, for later
retrieval by L<"getconf">. This value is also used to calculate any
other variables depending on it, I<as long as they have not already
been calculated> by a call to C<getconf>.

If a variable by this name already exists in the environment, its
value is updated too. If no such variable exists none is created.

=cut

sub setconf {
  my $record=shift;
  my $val=shift;

  _debug "Setting $record = ", (defined $val ? $val : '(undef)') if DEBUG;

  # even if it's undefined
  $currconf{$record}=$val;

  if (exists $ENV{$record}) {
    if (defined $val) {
      $ENV{$record}=$val
    } else {
      delete $ENV{$record};
    }
  }

  push @wantedconf, $record;
}

=head2 query_conf

  query_conf("RECORD");

Checks whether or not the named record has been set as a configuration
variable, and if so returns its value, but otherwise refrains from
setting it. This is mainly useful for the printing routines.

This routine does, however, check for environment variables as well as
configuration records, in order to give a truer picture of what the
current status is; if it finds a configuration variable set in the
environment, it will set it explicitly.

=cut

sub query_conf {
  my $record=shift;

  _debug_conf "Checking for $record" if DEBUG;
  
  push @wantedconf, $record;

  return $currconf{$record} if defined $currconf{$record};

  # is it set in the environment?
  if (exists $ENV{$record}) {
    # if so, we call getconf() to make sure it gets set, since getconf
    # will pick up the environment variable.
    return getconf($record);
  }

  return undef;
}

=head2 unsetconf

  unsetconf('internal_conf_record');

Removes any setting of the named configuration variable(s), returning
them to their default state I<which is not necessarily C<undef>>.
This does not imply C<unexport_conf>.

=cut

sub unsetconf {
  for my $v (@_) {
    delete $currconf{$v};
  }
  push @wantedconf, @_;
}

=head2 %Config

The C<CurrentConfig> module can also be used as a tied hash, where
reading a value calls C<getconf>, and writing to a value calls
C<setconf>. Deleting a value is not allowed. C<%Config> is the
suggested name for the hash, but it is also importable under the names
C<%config> and C<%CFX5Config> to avoid clashing with the Perl
L<Config> module.

  use CFX5::Config qw(%Config);

  print $Config{CFX5ARCH},"\n";
  $Config{CFX5ARCH}="unknown";

=head2 %config

Alternative name for C<%Config>, for use if the Perl L<Config> module
is included.

=head2 %CFX5Config

Alternative name for C<%Config>, for use if the Perl L<Config> module
is included.

=cut

sub STORE {
  #_debug_conf "hash write to $_[1]";
  setconf($_[1],$_[2]);
}

sub FETCH {
  #_debug_conf "hash lookup of $_[1]";
  getconf($_[1]);
}

sub DELETE {
  #_debug_conf "hash delete of $_[1]";
  unsetconf($_[1]);
}

sub CLEAR {
  internal_error("Cannot clear the configuration");
}

sub check_ties {
  # check the tiedness of the different variables
  tie %Config, 'CFX5::CurrentConfig';
  tie %config, 'CFX5::CurrentConfig';
  tie %CFX5Config, 'CFX5::CurrentConfig';
  _debug_conf tied(%Config), " ", tied(%config), " ", tied(%CFX5Config) if DEBUG;
}

1;
