=head1 NAME

CFX5::ParseConfig - Read CFX-5 configuration files

=head1 SYNOPSIS

This file implements a Perl parser for a Bourne shell-like variable
definition syntax.

=head1 DESCRIPTION

This module is used to read the CFX-5 configuration files from the
Perl scripts, on both NT and UNIX.  Rather than using environment
variables, it uses the configuration variable routines as supplied by
L<CFX5::Config>: interpolation of variables can therefore get the
default value for them if they are not set, and variable assignment
will override the default values.

=head1 SYNTAX

The syntax accepted by this parser is as follows:

=head2 THE INTERPOLATOR

The C<shell_interp> function takes the following syntax in a string:

=head3 Tokens

Tokens are space-separated.  Spaces may be included within a token by
delimiting it with either single or double quotes.

=head3 Variable Interpolation

Currently, the only form of variable interpolation supported is the
simplistic
  $VARIABLE
which substitutes the value of the configuration record C<VARIABLE>
into the string at that point.  It is hoped that some of the more
advanced variable interpolations found in the Bourne shell may be
added at some point.

=head3 Single Quotes

Single quotes are used to protect a string from all interpolation.
The string is preserved verbatim up to the next single quote
character.  Backslashes I<do not> protect single-quote characters from
ending the string, for compatibility with the Bourne shell.

=head3 Double Quotes

Double quotes are used to group space-separated strings into a single
token.  

=over

=item Backslash Quoting

Backslashes may be used to protect double quotes and dollar signs,
which are the only magic characters inside double-quoted strings.

I<On UNIX>, backslashes quoting any other character will be removed,
so to insert a literal backslash you need a double backslash.  

I<On Windows NT>, backslashes which quote another character, including
another backslash, I<will not be removed from the string>, allowing
you to define paths such as
  "\\Colossus\cfxdev\tools"
without worrying on NT.  This is a deviation from the standard Bourne
shell syntax.

=item Ending the string

The double-quoted string ends with the first unquoted double quote
character.  You can insert a literal double quote character by
protecting it with a backslash.

=item Variable interpolation

Variable interpolation in a double-quoted string is signalled by a
dollar sign, and is perfomed according to the standard rules for
variable interpolation.  Note that the variable interpolation is
performed before the end of the string is found, and extra parts of
the variable substitution are not parsed as part of the string; this
means that double quotes embedded in a variable substitution do not
end the string.

This appears to correspond roughly to the behaviour of the Bourne
shell, but it will only be an issue if somebody makes a mistake anyway
...

=back

=head3 Variable Naming

Names for variables should consist of characters from the set
"C<A-Za-z0-9_>".

=head2 THE FILE READER

The rest of the syntax is implemented in C<read_file>, which uses
the shell interpolator for various tasks.  Normally, one would call
the file reader rather than the shell interpolator.

=head3 Lines

Each line is considered independently.  This means that backslashes
may not be used as continuation characters, nor may strings span more
than one line.

In addition, semicolons are not accepted as command separators, and
nor is the Bourne shell convention of allowing more than one variable
definition on a line, such as
  NAME="Andy Mortimer" UID=cfdasm

=head3 Variable Assignment

A variable assignment is started by the string "I<VARIABLE>=", where
I<VARIABLE> is the name of the variable to set.  Following the equals
sign there should be a single token, which may be quoted with single
or double quotes, which is taken as the new value for the variable.
Any further non-whitespace characters on the same line will cause an
error.

=head3 Commands

If a line begins with a token not containing an equals sign, that line
is a command.  The rest of the line is taken as arguments to the
command, of which there may be more than one, and is I<not>
interpreted as above unless stated.

=head3 The export Command

The command C<export> takes the names of one or more variables, and
adds them to the environment using L<export_conf>.  It does not
perform any substitutions on its command line, but simply splits its
arguments at whitespace and does them one-by-one.  For this reason, it
is perfectly possible to accidentally export variables called "$HELLO"
or "ba<asd.>", but it will warn about things like this.

=head3 The unset Command

C<unset> takes a list of variables just like C<export>, and explicitly
sets their values to "undef".  This is not often useful; more useful
would be a "reset" command, to remove overridden values.  This does
not yet exist.

=head3 The in_shell and in_perl Commands

Any line beginning C<in_shell> followed by whitespace will be ignored.
Any line beginning C<in_perl> followed by whitespace will have this
stripped from the beginning, and then be parsed as normal.  This
allows lines to be executed depending on whether the file is being
parsed by the shell or by Perl; for example:
  in_shell CFX_TOOLS_ROOT="//E/Tools"
  in_perl  CFX_TOOLS_ROOT="E:\Tools"

=head3 The echo Command

Interpolates the rest of the command line as a set of strings (not
limited to a single token), and then adds it to the C<@messages> array
to be displayed after parsing the file.  For example, I use
  echo Using version $CFXBUILDID
in my F<.cfx5rc> file; you can also do things like
  in_perl echo "This is a Perl script"

=cut

package CFX5::ParseConfig;

use strict;

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

use Exporter;
use vars qw(@ISA @EXPORT_OK %EXPORT_TAGS);
@ISA=qw(Exporter);
@EXPORT_OK=qw(getcurrentenv assert_valid_config);

use CFX5::Output qw(:all);
use CFX5::CurrentConfig qw(:std);

=head2 read_file

  my @messages=read_file('cfx5rc');
  warn join("\n",@messages);

Takes the name of a file, and reads config variables from it, getting
existing variables with getconf and writing new ones with setconf.

The return value is a list of messages generated by this file, which
should be displayed in some way.

=cut

sub read_file {
    my $file=shift;
    internal_error "file not defined" unless defined $file;

    my @messages=();

    open FILE, "$file" or _abort "Cannot open $file";

    _trace "Reading configuration information from $file";

    while (<FILE>) {
	chomp;

	# remove unneeded whitespace
	s/^\s*//;
	s/\s*$//;

        # check for in_perl and in_shell modifiers. Lines beginning with in_shell
        # are skipped, lines beginning with in_perl are parsed as normal.
        next if m/^in_shell\s/;
        s/^in_perl\s+//;

	# skip lines we don't need to parse, eg comments. We do this check here so
	# comments can be embedded in in_perl blocks. Not that I imagine anyone will
	# want to do that, but who knows?
	next if (/^\s*#/ || /^\s*$/);

	# check for things we understand
	if (/^\w+=/) {
	  # variable definition
	  my ($var,$val)=split(/=/,$_,2);
	    
	  # perform some interpolation on $val and store the result
	  my $iv;
	  $iv=shell_interp($val,1);
	  if (defined($iv)) {
	    setconf($var,$iv);
	  } else {
	    push @messages, "syntax error in $file:\n$_\n";
	  }
	} elsif (/^\s*unset\s+/) {
	  my @list=split(/\s+/,$_);
	  shift @list;
	  my $v;
	  for $v (@list) {
	    setconf($v,undef);
	  }
	} elsif (/^\s*echo\s+/) {
	  # allow people to use "echo" in their .cfx5rc files
	  my @list=split(/\s+/,$_);
	  shift @list;
	  my $string=join(" ",@list);
	  $string=shell_interp($string,0);
	  push @messages, $string;
	} elsif (/^\s*export\s+/) {
	  # we do actually want to make export work, I think. But
	  # because I'm lazy, I'm only going to allow the sh "export
	  # variable", and not bash "export variable=value"
	  my @list=split(/\s+/,$_);
	  shift @list;
	  my $v;
	  for $v (@list) {
	    if ($v =~ m/^\$/) {
	      push @messages,"Warning: Variable name $v with a leading \$ in export statement\nin $file. You probably want the plain variable name.";
	    } elsif ($v !~ m/^[A-Za-z0-9_]+$/) {
	      push @messages,"Warning: $v is probably not a valid variable name in $file.";
	    }
	    my $val=getconf($v);
	    $ENV{$v}=$val if defined $val;
	  }
	} else {
	    # nothing we understand
	    push @messages, "Warning: unrecognised line\n$_\n ignored in $file\n";
	}
    }
    
    close FILE;

    return @messages;
}

=head2 shell_interp

Takes a string, and tries to parse the string obeying the normal shell
quoting rules and getting variables via C<getconf>.

If the third argument is true, the string is limited to a single
token; anything else will cause C<undef> to be returned.

=cut

sub shell_interp {
  my $string=shift;
  my $onetoken=shift;
  $onetoken=0 unless defined($onetoken);

  my $first;
  my $retval="";
  while (length($string)>0) {
    $first=substr($string,0,1);
    $string=substr($string,1);
    if ($first eq "\"") {
      # a double-quoted string
      $retval.=shell_interp_double(\$string);
    } elsif ($first eq "\'") {
      #	 a single-quoted string
      $retval.=shell_interp_single(\$string);
    } elsif ($first eq "\$") {
      my $val=shell_interp_var(\$string);
      return undef unless defined $val;
      $retval.=$val;
    } elsif ($first eq "\\") {
      $retval .= substr($string,0,1);
      $string=substr($string,1);
    } elsif ($onetoken and $first =~ /\s/) {
      # we got some whitespace but that's not allowed
      return undef;
    } else {
      $retval	 .= $first;
    }
  }
  
  return $retval;
}
  
sub shell_interp_double {
  my $rstring=shift;
  
  my $first;
  my $retval="";
  while (length($$rstring)>0) {
    $first=substr($$rstring,0,1);
    $$rstring=substr($$rstring,1);
    if ($first eq "\"") {
      # end of string
      return $retval;
    } elsif ($first eq "\$") {
      # a variable expansion
      $retval .= shell_interp_var($rstring);
    } elsif ($first eq "\\") {
      # a backslash-quoted char
      # on NT, we don't chomp backslashes except \"
      if ($^O eq "MSWin32" and substr($$rstring,0,1) ne "\"") {
	$retval .= $first;
      } else {
	$retval .= substr($$rstring,0,1);
	$$rstring=substr($$rstring,1);
      }
    } else {
      $retval	 .= $first;
    }
  }
  
  return $retval;
}
  
sub shell_interp_single {
  my $rstring=shift;
  
  my $first;
  my $retval="";
  while (length($$rstring)>0) {
    $first=substr($$rstring,0,1);
    $$rstring=substr($$rstring,1);
    if ($first eq "\'") {
      # end of string
      return $retval;
    } else {
      $retval	 .= $first;
    }
  }
  
  return $retval;
}
  
sub shell_interp_var {
  my $rstring=shift;

  my $varexp="";
  my $first;
  my $retval="";
  while (length($$rstring)>0) {
    $first=substr($$rstring,0,1);
    $$rstring=substr($$rstring,1);
    if ($first !~ /[A-Za-z0-9_]/) {
      # end of variable
      $$rstring=$first.$$rstring;
      last;
    } else {
      $varexp .= $first;
    }
  }

  return undef unless (defined $varexp and $varexp ne "");

  my $val=getconf($varexp);
  return (defined $val ? $val : "");
}

1;
