#! perl -w

##
## Name
##
## cfx5perl
##
## Purpose
##
## Run a Perl interpreter with the context of a CFX-5 installation
##
## Synopsis
##
#S cfx5perl <script-name> [...]
##
## []  denotes an optional argument. 
## |   separates mutually exclusive arguments. 
## ... following an argument indicates that it may be repeated.
## <>  denotes that substitution of a suitable value is required. All other
##     arguments are keywords, some of which may have a short form.
##
## Arguments:
##
#U ****************************************************************************
#U *                                                                          *
#U *     The following features are supported only within CFX and are not     *
#U *     shown by the -help option when the command is run elsewhere.         *
#U *                                                                          *
#U ****************************************************************************
#U

# get the standard CFX-5 library directory
BEGIN {
  if ($0 =~ m!^([a-z]:)?[\\/]!i) {
    # it's an absolute path, use it as-is
    (my $nd=$0) =~ s!(perllib[\\/])?[^\\/]*$!!i;
    unshift @INC, "$nd/perllib";
  } else {
    # wrap this in an eval, and if it fails, pray ... for example,
    # this can fail on Windows if we're running off a share.
    eval {
      require FindBin;
      FindBin->import();
      (my $dir=$FindBin::Bin) =~ s![\\/]perllib!!g;
      unshift @INC, "$dir/perllib";
      my $dummy=$FindBin::Bin; # kill used only once warning
    };
    warn $@ if $@;
  }
  if (defined $ENV{CFX_LOCAL_PERLLIB}) {
     unshift @INC, $ENV{CFX_LOCAL_PERLLIB};
  }

}

use vars qw($CVSVersion);
$CVSVersion='@(#) $Id$\n';

use strict;

use CFX5::Init;
CFX5::Init::init();

while (@ARGV) {
  my $arg=shift @ARGV;
  if ($arg =~ m!^-!) {
    # it's an argument.  We mock up some of the common Perl ones.
    if ($arg eq '-w') {
      $^W=1;
    } else {
      die "Unsupported Perl argument $arg\n";
    }
  } else {
    # not an argument, it must be the script.  We do it, and then exit.
    my $rv=do $arg;
    if (not defined $rv) {
      if ($@) {
        die "$0: $arg: $@\n";
      } elsif ($!) {
        die "$0: $arg: $!\n";
      } else {
        die "$0: $arg: unknown error\n";
      }
    } else {
      # $rv is the value of the last expression evaluated ... which we
      # can ignore, I think.  If the user hasn't exited already, which
      # they may well have done, return success.
      exit(0);
    }
  }
}

# if we get here, we ran out of arguments
die "Usage: $0 <script> [<args>]\n";

