########################################################################
#
# TITLE:
#	act_util.pl
#
# AUTHOR:
#	Scott Maxwell
#
# DESCRIPTION:
#
#	Useful utility routines for ACT's scripts.
#
#				CHANGE HISTORY
#
# $Log: act_util.pl,v $
# Revision 1.1  1996/12/03  16:51:33  maxwell
# Initial revision
#
########################################################################
#
# WARNINGS:
#
# EXTERNAL CALLABLE COMPONENTS (PUBLIC):
#
# GLOBALS:
#
# WAIVERS:
#
# NOTES:  
#
# MANPAGE:
#
########################################################################

require 5.000;

$[ = 0;				# Set array base to 0.
$\ = "\n";			# Set output record separator.
select(STDERR); $| = 1;		# Flush output buffer (STDERR).
select(STDOUT); $| = 1;		# Flush output buffer (STDOUT).

package main;




################################################################
#
# Shift an argument from @ARGV, if there is one.  If there isn't,
# complain and issue a usage message.  The supplied argument, $opt, is
# the option for which we're seeking an argument.
#
################################################################

sub SafeShift {
    my $opt = shift(@_);

    return shift(@ARGV)  if ($#ARGV >= $[);

    # Would like to check whether Usage() exists and call Fatal() instead
    # if it doesn't.
    &Usage("Option '$opt' requires an argument.");
}




################################################################
#
# Issue a fatal error message and exit.
#
################################################################

sub Fatal {
    my $msg = shift(@_);
    my $code = ($#_ >= $[)  ?  shift(@_)  :  1;

    print STDERR "$msg";
    exit($code);
}




################################################################
#
# Issue a warning or tracing message.
#
################################################################

sub Warn {
    print STDERR "$_[0]";
}




################################################################
#
# Attempt to execute the supplied command, exiting fatally if it exits
# with nonzero.
#
################################################################

sub SafeRun {
    my $cmd = shift(@_);
    my $okay = ($#_ >= $[)  ?  shift(@_)  :  0;
    my $silently = ($#_ >= $[)  ?  shift(@_)  :  0;

    print STDERR "$cmd"  unless($silently);
    my $rval = system($cmd);

    &Fatal("Command '$cmd' returned $rval; exiting.")  if ($rval != $okay);
}




################################################################
#
# Attempt to change directory to the supplied location, exiting
# fatally if we cannot.
#
################################################################

sub SafeChdir {
    my($dir) = shift(@_);

    if (!chdir($dir)) {
	&Fatal("Cannot change dir to '$dir'; exiting.");
    }
}




################################################################
#
# Open the supplied filehandle or die trying.  This sub tries to be
# fairly clever about the error message it gives, but I'd like it to
# know (and say) whether it was trying to read/write/append to a file.
#
################################################################

sub SafeOpen {
    my($fh) = shift(@_);

    if (open($fh, $fh)) {
	return;
    }

    # If file-handle starts or ends with a '|', it's a pipe; else it's a file.
    my($desc) = (($fh =~ /^\s*\|/) || ($fh =~ /\|\s*$/))  ?  'pipe'  :  'file';
    if ($#_ >= $[) {		# $desc may be supplied by the caller instead.
	$desc = shift(@_);
    }

    &Fatal("Can't open $desc '$fh': $!.");
}




################################################################
#
# Open a directory handle or die trying.
#
################################################################

sub SafeOpenDir {
    my($dh) = shift(@_);

    unless (opendir($dh, $dh)) {
	&Fatal("Can't read directory '$dh': $!.");
    }
}




################################################################
#
# Give a message that allows users running the script under emacs (as
# a compilation subprocess) to jump to the line of the file through
# next-error.
#
################################################################

sub EmacsReport {
    my($file, $line, $msg) = @_;
    print join(':', $file, $line, $msg);
}




################################################################
#
# If the named environment variable exists, return its value, else
# return the supplied default value (the "default default" is undef).
#
################################################################

sub GetEnv {
    my($var, $default) = (@_, undef);
    my($val) = $ENV{$var};

    return defined($val)  ?  $val  :  $default;
}




################################################################
#
# Return the value of the named environment variable or die trying.
#
################################################################

sub SafeGetEnv {
    my($var) = @_;
    my($val) = &GetEnv($var, undef);
    if (!defined($val)) {
	&Fatal("Environment variable '$var' is not set.");
    }
    return $val;
}




1;