#!/usr/bin/perl
use strict;

###############################################################################
#
#  SCRIPT COMPILER
#
###############################################################################

###############################################################################
#
#  CONFIGURABLE THINGS
#
###############################################################################

###############################################################################
#
#  DON'T CHANGE ANYHING BELOW HERE
#
###############################################################################

#  Important bits
# $Header: /diskb/home/alexis/dev/support/bin/RCS/shpp.shpp,v 1.6 1999/01/06 18:09:51 alexis Exp $
($main::progname = $0) =~ s/^.*\/([^\/]+)/$1/;
$main::modvers{$main::progname} = "MARKER_PATCHLEVEL";

sub usage
{
    print STDERR "Usage: $main::progname [ -D <var>=<val> [ -D ... ] ] [ <file> | - ] [ <file> | - ]\n";
    print STDERR "       $main::progname -V\n";
    exit(1);
}

sub process
{
    my ($infile, $outhandle) = @_;
    my ($inhandle, $lineno, $var);
    local (*IN_HANDLE);

    if ($infile) {
        open(IN_HANDLE, $infile) || return(1);
        $inhandle = \*IN_HANDLE;
    } else {
        $inhandle = \*STDIN;
    }

    $lineno = 0;
    while (<$inhandle>) {
        if (/^\#shpp\s+comment\b.*$/) {
            ;
        } elsif (/^\#shpp\s+include\s+(\S+)\s*\n$/) {
            &process($1, $outhandle) && return(1);
        } else {
            foreach $var (keys %main::valarray) {
                s/$var/$main::valarray{$var}/g;
            }
            print $outhandle "$_";
            next;
        }
    }

    defined($infile) && close $inhandle;
    return(0);
}

sub main
{
    my(@ARGV) = @_;
    my($set_exec_mode, $var, $val, $infile, $outfile, $outhandle);

    $set_exec_mode = 1;
    while (defined($ARGV[0]) && $ARGV[0] =~ /^-/) {
        $_ = shift @ARGV;
        if (/^-d(.*)/) {
            $main::verboselevel = ($1 ? $1 : shift @ARGV);
        } elsif (/^-v$/) {
            $main::verboselevel = 3;
        } elsif (/^-V$/) {
            if ($main::modvers{$main::progname} =~ /^P.*R$/) {
                &warning("this is development version; use 'ident'");
                exit 1;
            } else {
                print "$main::progname version ", $main::modvers{$main::progname}, "\n";
                exit 0;
                                                                                            }
        } elsif (/^-nx$/) {
            $set_exec_mode = 0;
        } elsif (/^-x$/) {
            $set_exec_mode = 1;
        } elsif (/^-$/) {
            last;
        } elsif (/^-D(.*)$/) {
            $_ = ($1 ? $1 : shift @ARGV);
            ($var, $val) = /^([^=]+)=([^=]*)$/;
            $var || &usage;
            $main::valarray{$var} = $val;
        } else {
            &usage;
        }
    }

    #  zero arguments
    if (!$ARGV[0]) {
        $infile = "";
        $outfile = "";

    #  three arguments
    } elsif ($ARGV[2]) {
        &usage;

    #  one argument
    } elsif (!$ARGV[1] && $ARGV[0] eq "-") {
        &usage;
    } elsif (!$ARGV[1] && $ARGV[0] =~ /.*\.shpp$/) {
        $infile=$ARGV[0];
        ($outfile = $infile) =~ s/\.shpp$//;
    } elsif (!$ARGV[1]) {
        &error("$ARGV[0] should be a .shpp file");

    #  two arguments
    } elsif ($ARGV[0] eq "-" && $ARGV[1] eq "-") {
        $infile = "";
        $outfile = "";
    } elsif ($ARGV[0] eq "-" && $ARGV[1] =~ /.*\.shpp$/) {
        &error("$ARGV[1] should not be a .shpp file");
    } elsif ($ARGV[0] eq "-") {
	$infile = "";
	$outfile = $ARGV[1];
    } elsif (!($ARGV[0] =~ /.*\.shpp$/)) {
        &error("$ARGV[0] should be a .shpp file");
    } elsif ($ARGV[1] eq "-") {
	$infile = $ARGV[0];
	$outfile = "";
    } elsif ($ARGV[1] =~ /.*\.shpp$/) {
        &error("$ARGV[1] should not be a .shpp file");
    } else {
        $infile = $ARGV[0];
        $outfile = $ARGV[1];
    }

    if ($outfile) {
        open(OUT_HANDLE, ">$outfile") || &error("can't open $outfile");
        $outhandle = \*OUT_HANDLE;
    } else {
        $outhandle = \*STDOUT;
    }

    if (&process($infile, $outhandle)) {
        defined($outfile) && unlink($outfile);
        &error("couldn't access infile or included file");
        return(1);
    }

    if (defined($outfile)) {
        close(OUT_HANDLE);
        $set_exec_mode && chmod 0777 & ~umask(), $outfile;
    }

    return 0;
}

###############################################################################
#
#  CONFIGURABLE THINGS
#
###############################################################################

###############################################################################
#
#  CONFIGURABLE THINGS END HERE
#
###############################################################################

require Sys::Syslog;

#  GZIP COMMAND
my($gzip_cmd)       = "";
#  GUNZIP COMMAND
my($gunzip_cmd)     = "";
#  COMPRESS COMMAND
my($compress_cmd)   = "";
#  UNCOMPRESS COMMAND
my($uncompress_cmd) = "";
#  LOCK DIRECTORY
my($lock_dir) = "lock_files_should_be_defined_but_are_not_used";
# $Header: /diskb/home/alexis/dev/support/lib/RCS/utils.pl.shpp,v 1.27 1999/01/06 18:19:32 alexis Exp $

###############################################################################
#
#  RESILIANT MESSAGING FUNCTIONS
#
###############################################################################

sub error
{
    #  This is safest in a function because load time checks in other outer-code
    #  may call this function without having run through code in this files's
    #  outer-code.
    defined($main::errors_cause_exits) || ($main::errors_cause_exits = 1);
    defined($main::facility) || ($main::facility = 'local0');
    defined($main::verboselevel) || ($main::verboselevel = 2);
    defined($main::i_am_a_daemon) || ($main::i_am_a_daemon = 0);

    my($text) = @_;
    my($do_exit) = $main::errors_cause_exits;

    if ($main::verboselevel >= 1) {
        if ($main::i_am_a_daemon) {
            if (!defined($main::done_openlog)) {
                Sys::Syslog::setlogsock('unix');
                Sys::Syslog::openlog($main::progname, 'pid', $main::facility);
                $main::done_openlog = 1;
            }
            Sys::Syslog::syslog('err', $text);
        } else {
            print STDERR "$main::progname: ERROR: $text\n";
        }

        if (defined($main::log_file)) {
            open(LOG_HANDLE, ">>$main::log_file") || &internal("can't open logfile");
            print LOG_HANDLE scalar(localtime) . ": ERROR: $text\n";
            close LOG_HANDLE;
        }
    }

    #  return 1 so calls can be incorporated into expressions more easily
    (!$do_exit) && return(1);
    &exitdel();
    exit(1);
}

sub warning
{
    #  This is safest in a function because load time checks in other outer-code
    #  may call this function without having run through code in this files's
    #  outer-code.
    defined($main::facility) || ($main::facility = 'local0');
    defined($main::verboselevel) || ($main::verboselevel = 2);
    defined($main::i_am_a_daemon) || ($main::i_am_a_daemon = 0);

    my($text) = @_;

    if ($main::verboselevel >= 2) {
        if ($main::i_am_a_daemon) {
            if (!defined($main::done_openlog)) {
                Sys::Syslog::setlogsock('unix');
                Sys::Syslog::openlog($main::progname, 'pid', $main::facility);
                $main::done_openlog = 1;
            }
            Sys::Syslog::syslog('warning', $text);
        } else {
            print STDERR "$main::progname: WARNING: $text\n";
        }

        if (defined($main::log_file)) {
            open(LOG_HANDLE, ">>$main::log_file") || &internal("can't open logfile");
            print LOG_HANDLE scalar(localtime) . ": WARNING: $text\n";
            close LOG_HANDLE;
        }
    }
    #  return 1 so calls can be incorporated into expressions more easily
    return(1);
}

sub info
{
    #  This is safest in a function because load time checks in other outer-code
    #  may call this function without having run through code in this files's
    #  outer-code.
    defined($main::verboselevel) || ($main::verboselevel = 2);
    defined($main::i_am_a_daemon) || ($main::i_am_a_daemon = 0);

    my($text) = @_;

    if ($main::verboselevel >= 3) {
        if ($main::i_am_a_daemon) {
            if (!defined($main::done_openlog)) {
                Sys::Syslog::setlogsock('unix');
                Sys::Syslog::openlog($main::progname, 'pid', $main::facility);
                $main::done_openlog = 1;
            }
            Sys::Syslog::syslog('info', $text);
        } else {
            print STDERR "$main::progname: INFO: $text\n";
        }

        if (defined($main::log_file)) {
            open(LOG_HANDLE, ">>$main::log_file") || &internal("can't open logfile");
            print LOG_HANDLE scalar(localtime) . ": INFO: $text\n";
            close LOG_HANDLE;
        }
    }
    #  return 1 so calls can be incorporated into expressions more easily
    return(1);
}

sub internal
{
    #  This is safest in a function because load time checks in other outer-code
    #  may call this function without having run through code in this files's
    #  outer-code.
    defined($main::facility) || ($main::facility = 'local0');
    defined($main::verboselevel) || ($main::verboselevel = 2);

    my($text) = @_;

    print STDERR "$main::progname: INTERNAL ERROR: $text\n";

    if (defined($main::log_file) && open(LOG_HANDLE, ">>$main::log_file")) {
        print LOG_HANDLE scalar(localtime) . ": INTERNAL ERROR: $text\n";
        close LOG_HANDLE;
    }

    if (!defined($main::done_openlog)) {
        Sys::Syslog::setlogsock('unix');
        Sys::Syslog::openlog($main::progname, 'pid', $main::facility);
        $main::done_openlog = 1;
    }
    Sys::Syslog::syslog('alert', $text);

    if (open(CON_HANDLE, ">/dev/console")) {
        print CON_HANDLE scalar(localtime) . "$main::progname: INTERNAL ERROR: $text\n";
        close CON_HANDLE;
    }

    exit(2);
}

sub debug
{
    #  This is safest in a function because load time checks in other outer-code
    #  may call this function without having run through code in this files's
    #  outer-code.
    defined($main::facility) || ($main::facility = 'local0');
    defined($main::verboselevel) || ($main::verboselevel = 2);
    defined($main::i_am_a_daemon) || ($main::i_am_a_daemon = 0);

    my($msglvl, $text) = @_;

    if ($main::verboselevel >= $msglvl) {
        if ($main::i_am_a_daemon) {
            if (!defined($main::done_openlog)) {
                Sys::Syslog::setlogsock('unix');
                Sys::Syslog::openlog($main::progname, 'pid', $main::facility);
                $main::done_openlog = 1;
            }
            Sys::Syslog::syslog('debug', $text);
        } else {
            printf STDERR "$main::progname: DEBUG[%03d]: $text\n", $msglvl;
        }

        if (defined($main::log_file)) {
            open(LOG_HANDLE, ">>$main::log_file") || &internal("can't open logfile");
            printf LOG_HANDLE scalar(localtime) . ": DEBUG[%03d]: $text\n", $msglvl;
            close LOG_HANDLE;
        }
    }
    #  return 1 so calls can be incorporated into expressions more easily
    return(1);
}

###############################################################################
#
#  INTERACTIVE FUNCTIONS
#
###############################################################################

sub question
{
    my($question) = @_;

    print "$main::progname: QUESTION: $question: ";
}

sub do_a_shell
{
    my($ps1) = @_;

    $ENV{'PS1'} = "$main::progname> ";
    $ENV{'SHELL'} = "/bin/sh" if (! $ENV{'SHELL'});

    return(system($ENV{'SHELL'}));
}

###############################################################################
#
#  TEMPORARY FILE MANAGEMENT FUNCTIONS
#
###############################################################################

sub delonexit
{
    foreach (@_) {
        $main::delonexit{$_} = 1;
    }
}

sub dontdelonexit
{
    foreach (@_) {
        delete $main::delonexit{$_};
    }
}

sub exitdel
{
    foreach (keys(%main::delonexit)) {
        unlink $_;
        delete $main::delonexit{$_};
    }
    
}

sub showdelonexit
{
    &debug(10, "showdelonexit: " . join (' ', keys(%main::delonexit)));
}

sub genericsighandler
{
    &info("clearing up ...");
    &exitdel;
    exit 3;
}

###############################################################################
#
#  OTHER SUPPORT FUNCTIONS
#
###############################################################################

sub locatecmd
{
    my($whichcmd_rc, $posscmd);

    foreach $posscmd (@_) {
        ($whichcmd_rc=&whichcmd($posscmd)) && return($whichcmd_rc);
    }
    return(0);
}

sub whichcmd
{
    my ($cmd) = @_;
    my ($dir);

    foreach $dir (split(/:/, $ENV{'PATH'})) {
        (-x "$dir/$cmd") && return("$dir/$cmd");
    }
    return(0);
}

sub dirname
{
    my($file) = @_;

    if ($file =~ /^[^\/]+$/) {
        return(".");
    } elsif ($file =~ /^\/[^\/]+$/) {
        return("/");
    } else {
        $file =~ s/^(.*)\/[^\/]+$/$1/;
        return($file);
    }
}

sub basename 
{
    my($file) = @_;

    $file =~ s/^.*\/([^\/]+)/$1/;
    return($file);
}

sub who_am_i
{
    my($id);

    $id = $ENV{'USER'};
    $id || ($id = $ENV{'LOGNAME'});
    $id || ($id = `id | sed -n 's/^[^(][^(]*(\([^)][^)]*\)).*$/\1/p'`);

    return($id);
}

sub zopenr
{
    my($filename, $handle) = @_;

    if ($filename =~ /^.*\.gz$/) {
        $gunzip_cmd || ($gunzip_cmd = &whichcmd("gunzip"));
        $gunzip_cmd || &error("can't find 'gunzip'");
        (! -x $gunzip_cmd) && &error("can't execute $gunzip_cmd");
        return(open($handle, "$gunzip_cmd < $filename |"));
    } elsif ($filename =~ /^.*\.Z$/) {
        $uncompress_cmd || ($uncompress_cmd = &whichcmd("uncompress"));
        $uncompress_cmd || &error("can't find 'uncompress'");
        (! -x $uncompress_cmd) && &error("can't execute $uncompress_cmd");
        return(open($handle, "$uncompress_cmd < $filename |"));
    } else {
        return(open($handle, $filename));
    }
}

sub zopenw
{
    my($filename, $handle) = @_;

    if ($filename =~ /^.*\.gz$/) {
        $gzip_cmd || ($gzip_cmd = &whichcmd("gzip"));
        $gzip_cmd || &error("can't find 'gzip'");
        (! -x $gzip_cmd) && &error("can't execute $gzip_cmd");
        return(open($handle, "| $gzip_cmd > $filename"));
    } elsif ($filename =~ /^.*\.Z$/) {
        $compress_cmd || ($compress_cmd = &whichcmd("compress"));
        $compress_cmd || &error("can't find 'compress'");
        (! -x $compress_cmd) && &error("can't execute $compress_cmd");
        return(open($handle, "| $compress_cmd > $filename"));
    } else {
        return(open($handle, ">$filename"));
    }
}

sub getline 
{
    my($handle, $linenum) = @_;
    my($GL_STATE_START)  = 0;
    my($GL_STATE_INPROG) = 1;

    my($state) = $GL_STATE_START;
    my($line)  = "";

    while (1) {
        if (eof($handle) && $state == $GL_STATE_START) {
            return(0,$linenum);
        } elsif (eof($handle)) {
            return(undef,$linenum);
        } 

        $line = $line . <$handle>;
        $linenum++;
        if ($line =~ s/\\\n$//) {
            $state = $GL_STATE_INPROG;
        } else {
            return($line,$linenum);
        }
    }
}

sub lock
{
    &debug(5, "lock: sof");

    my($lock_file, $tmp_lock_file);

    $lock_file = "$lock_dir/$main::progname.pid";
    $tmp_lock_file = "$lock_dir/$main::progname.pid.$$";

    #  create key
    unlink $tmp_lock_file;
    open(TMP_LOCK_HANDLE, ">$tmp_lock_file") || return(-1);
    print TMP_LOCK_HANDLE "$$\n";
    close TMP_LOCK_HANDLE;

    #  slide key into lock 
    if (link($tmp_lock_file, $lock_file) == 0) {
        unlink $tmp_lock_file;
        return(0);
    }

    &internal("the locking code needs to be rewritten", "", "");

###     #  if blocked examine the existing lock
###     if ((fp=fopen(lock_file, "r")) == (FILE *) NULL) {
###         unlink(tmp_lock_file);
###         return(-1);
###     }
### 
###     #  read locking pid
###     if (fscanf(fp, "%d", &locking_pid) != 1) {
###         fclose(fp);
###         unlink(tmp_lock_file);
###         return(-1);
###     }
###     fclose(fp);
### 
###     #  check if that pid is still running
###     sprintf(procbuf, "/proc/%d", locking_pid);
###     if (stat(procbuf, &statbuf) == 0) {
###         unlink(tmp_lock_file);
###         return(locking_pid);
###     }
### 
###     #  it must be stale if we didn't return in the last paragraph
###     info("stale lock %s removed (pid=%d)", lock_file, locking_pid);
###     unlink(lock_file);
### 
###     #  slide lock into place
###     if (link(tmp_lock_file, lock_file) == 0) {
###         unlink(tmp_lock_file);
###         return(0);
###     }
### 
###     unlink(tmp_lock_file);
###     return(-1);
}

sub unlock
{
    unlink "$lock_dir/$main::progname.pid";
}

#############################################################################
#
#  LOAD-TIME DEFINITIONS
#
#############################################################################

$ENV{'GZIP_CMD'} && ($gzip_cmd = $ENV{'GZIP_CMD'});
($gzip_cmd) || ($gzip_cmd = &locatecmd('gzip'));

$ENV{'GUNZIP_CMD'} && ($gunzip_cmd = $ENV{'GUNZIP_CMD'});
($gunzip_cmd) || ($gunzip_cmd = &locatecmd('gunzip'));

$ENV{'COMPRESS_CMD'} && ($compress_cmd = $ENV{'COMPRESS_CMD'});
($compress_cmd) || ($compress_cmd = &locatecmd('compress'));

$ENV{'UNCOMPRESS_CMD'} && ($uncompress_cmd = $ENV{'UNCOMPRESS_CMD'});
($uncompress_cmd) || ($uncompress_cmd = &locatecmd('uncompress'));

#############################################################################
#
#  LOAD-TIME CHECKS
#
#############################################################################

#  Checks for gzip/gunzip/compress/uncompress access were here, but these
#  have now been moved to run time testing. This means that the 'maker' 
#  doesn't need to define paths for things that users don't have access to
#  anyway.

###############################################################################
#
#  GENERIC ENTRY POINT
#
###############################################################################

$main::umask && umask $main::umask;
exit(&main(@ARGV));
