#!/usr/local/bin/perl -w

# get_oracle_dbms.pl

# Routine opens a remote connection to the specified Oracle
# data server and issues a select command based on the parameters
# specified via the indirect file read in at run-time.

# Passed parameters
#	configuration file path and filename
#	data level being requested
#	selection specification as
#		MCD_ID=32,MSD_ID=12,...

# Required parameters obtained form the indirect file include
#	datafile=data file path and filename
#	login=Oracle SQLplus login required information as
#		Oracle remote node username and password as
#		groman/jgofs@ORC1
#	tables_for_level_n=necessary database tables as
#		cruises, stations for level 1

# Assumptions
# 	The datafile contains fieldnames separated by tabs
# not commas.
#	The last fieldname within each level specifies the SQL
#key fieldname for the next level.
#	We will use the varlist option of defgb in order to create
#extra variables to accommodate date translations.

$version = "November 14, 2006/V1.44";

# November 14, 2006. V1.44.  Add another debug line to STDOUT and via
#	the logging mechanism.  Check for $ in Oracle sign in string
#	and prepend a backslash, '\'.  rcg
# December 19, 2000. V1.43.  Fix Y2K testing.  rcg
# June 28, 2000. V1.42.  Add test for mismatched number of field names and values.
#	Remove leading white space in front of data records before splitting.
# May 26, 2000. V1.41.  Minor change in log entry text when debug switch is set.
#	Remove "sequel" and add "via" when finished and closed.
# May 15, 2000. V1.40.  Add cache_root configuration file option to allow redirecting
#	of cache files.  Default will stay at /tmp/.  Add cache_clean_up option
#	to control whether cache clean up takes place.  Change chmod from 0666 to 0664.
# May 10, 2000. V1.39.  Fix spelling of sequel file name variable.  Fix close
#	statement to add back in handle deleted by accident.
# May 5, 2000.  Enhance log entries to help understand about the
#	caching.  rcg
# April 26, 2000.  V1.36a. Fix another place that had incorrect Y2K
#	year computation.  rcg
# April 24, 2000.  V1.36 Fix log and send message year test for Y2K.  rcg
# July 7, 1999.  V1.35 Fix error string for JGOFS to use &x not %x.  
#	Change order of stdout error message to put error messages first. 
#	Change error logic to get mail AND send to stdout.  rcg
# June 1, 1999.  V1.34 Add test for existence of file to be unlinked before
#	checking for age in case file deleted in interim.  RCG
# March 23, 1999.  Fix location of date/time assignments.  They were
#	not the in correct subroutine.  rcg
# March 22, 1999.  Fix undefined date/time in file cleanup routine.
#	Unify presentation of dates so they all look the same.  rcg
# March 18, 1999.  Add missing simicolon at line 278.  Add username
#	output to log file except if it is nobody.  Add cachefile
#	name to log file.  Put back in logging of file deletions
#	but add file names deleted as well.  rcg
# March 17, 1999.  Change code that deletes old files.  Use WJS's
#	pid_file_cleanup routine as the basis.  rcg
# March 1, 1999.  Change cache purge time from 1.1 days to .9 days in
#	preparation for creating the cached files in the early morning
#	hours via a cron job.  rcg
# January 26, 1999.  Add ability to output incoming parameters at start
#	of program, as comments.  However, these lines are commented out.  rcg
# January 25, 1999.  Read in all the data at once, not in a loop.
#	Change order of file closing so they occur as soon as possible. rcg
# January 22, 1999.  Change cache purge time from .5 days to 1.1 days. 
#	Do not delete zero lenth cache files, at least for now.  
#	Don't write out log record about deletion of file unless
#	it's successful.  rcg
# January 19, 1999.  Add commented out line to use when want to save
#	zero length files.  Change file ownership of these so that they
#	are not deleted during subsequent cache purging.
# January 12, 1999.  Fix test for level 3 counter field containing a date
#	with more flexible handling for missing digits.  rcg
# December 21, 1998. Need to handle counter field containing a date
#	of the form xx/xx/xx in addition to person's initials.  Add
#	new configuration option, replace_{field-name}= to handle
#	the conversion of the date field into calling the to_char
#	function.  Add test for zero length cache file in case
#	data really exists and user aborted before data could be written.
# December 16, 1998. Continue after unsuccessful logging effort.  Log
#	occurances of cache deletions.
# December 4, 1998.  Add where clause options to configuration file.
#	Change test for replacing blanks in last level.
# December 2, 1998.  Add logging capability.  If "logfile" is specified
#	in configuration file.
# December 1, 1998.  Add ability to use cached data.  rcg
# November 25, 1998 Change temp file cleanup from 12 hours to 5 days. Remove
#	trailing ">" when outputting fieldname line.
# November 23, 1998 Add test for "nd_" string in data and replace with "nd".
# Initial version: November 9, 1998

$| = 1;
$error="&x";
$warning="#";

$do_web_sql="/data/pgarrahan/dbaccess/scripts/do_web_sql.csh";

($indirect_file, $data_level, $key_and_value) = @ARGV;

#print STDOUT ("#Program $0 Version: $version\n");
#print STDOUT ("#  indirect_file=$indirect_file\n",
#	"#  data_level=$data_level\n#  key_and_value=$key_and_value\n");
@required = ("login", "tables_for_level_$data_level", "sqlplus",
	"last_level", "sql_script");

#print STDOUT ("#**debug, indirect_file=$indirect_file\n",
#	"\tdata_level=$data_level\n#\tkey_and_value=$key_and_value\n\n");
	
&read_indirect_file($indirect_file);

if (exists $indirect_param{"datafile"} ) {
#	print STDOUT ("#**debug, indirect_param{datafile}=",
#		$indirect_param{"datafile"},"\n");
	&get_field_names($indirect_param{"datafile"}, $data_level)
}
else {
	&sendmessage ($error,
		"No data file specified in indirect file=$indirect_file",
		"Cannot continue.");
	exit;
}

# Output field names

for ($i=0; $i <= $#fieldname; $i++) { print STDOUT ("$fieldname[$i]\t"); }
#unless ($indirect_param{"last_level"} == $data_level ) { print STDOUT (">"); }
print STDOUT ("\n");

$okay="yes";
for ($i=0; $i<=$#required; $i++) {
	unless (exists $indirect_param{"$required[$i]"} ) { 
	   $okay="no"; 
	   &sendmessage ($error,
	     "$required[$i] is missing from configuration file=$indirect_file",
	     " ");
	   &make_log_entry (
	    "$required[$i] is missing from configuration file=$indirect_file");
	}
}
if ( $okay eq "no") { 
	&sendmessage ($error,
		"One or more parameters are missing from the configuration file",
		"Cannot continue.");	
	exit;
}

if ( exists $indirect_param{"debug"} ) {
	$debug = $indirect_param{"debug"};
	if ($debug =~ m/^y/i ) { $debug = 'yes'; }
}
else {
	$debug = 'no';
}
# Test for data at the next level and define $where_name, $where_value
($where_name, $where_value) = split /=/, $key_and_value;
unless ( defined ($where_value) )  { exit; }	#No data at next level.
if ($where_value eq "" or $where_value eq "nd" ) { exit; }
&read_oracle_dbms;

undef $error;
undef $warning;
undef $version;
exit;


#---------------------------------------------
sub read_indirect_file {

# Open and read indirect file specified as first passed parameter $_[0].
# Return the connects of the file as the hash array %indirect_param.
# Lines beginning with "#" are treated as comments.  It is assumed
# that the indirect file contains lines as

#	parameter = value

# and this information is stored as 

#	$indirect_param{"parameter"} = value

my $filename = $_[0];
#print STDOUT ("#**debug, indirect filename=$filename\n");

unless (open INDIRECT, $filename) {
	&sendmessage ($error,
		"Could not open indirect file=$filename",
		"Error code=$!.  Cannot continue.");
	exit;
	}
while (<INDIRECT>) {
	if (m/^#/) { next;}
	($parameter, $value) = split /=/;
	chomp $value;
	$indirect_param{$parameter} = $value;
#	print STDOUT ("#**debug, indirect_param{$parameter}=",
#		$indirect_param{$parameter}, "\n");
}
close INDIRECT;
}
#---------------------------------------------
sub get_field_names {

# Given the full path and file name for the data file as $_[0], open the 
# file and read in and save the field names in @fieldname for the level
# specified as $_[1].  The field name sizes are placed in @fieldname_size.

# Assumes fieldnames are separated by whitespace, not commas.

my ( $i, $length, $level);
#print STDOUT ("#**debug, datafile=$_[0] \n#\tlevel=$_[1]\n");

unless (open DATAFILE, $_[0] ) {
	&sendmessage ($error,
		"Could not open data file=$_[0]",
		"Error code=$!.  Cannot continue.");
	exit;
	}
$level=-1;
while (<DATAFILE>) {
	if (m/^#/ ) { next; }
	$level++;
	if ($level eq $_[1]) {
		chomp;
		@fieldname = split /\s+/;
		$fieldname[0] =~ s/^\s+//;
		unless ($fieldname[0] =~ m/\w*/ ) { shift (@fieldname); }
		last;
	}
}
close DATAFILE;
#print STDOUT ("#**debug, fieldnames=@fieldname\n");

if ($#fieldname < 0 ) {
	&sendmessage ($error,
		"Could not get field names from $_[0]",
		"Please contact the DMO.");
	exit;
}

# Remove width and other parameters set in square brackets
for ($i=0; $i<= $#fieldname; $i++) {
	$fieldname[$i] =~ s/\s+//g;
	$fieldname_size[$i] = $fieldname[$i];
	$fieldname[$i] =~ s/(^.*)\[.*/$1/;
	if ($fieldname_size[$i] =~ m/width=/ ) {
		$fieldname_size[$i] =~ s/^.*\[width=(\d*)\]/$1/;
	}
	else { $fieldname_size[$i] = 0; }
	$length = length ($fieldname[$i]);
	if ($length > $fieldname_size[$i] ) { $fieldname_size[$i]=$length; }
}
if ($fieldname[$#fieldname] =~ m/>/ ) {
	pop @fieldname;
	pop @fieldname_size;
}

return $#fieldname;
}
#---------------------------------------------
sub read_oracle_dbms {

# Routine reads Oracle database specified in $indirect_param{"login"}
# and uses table information from 
#	$indirect_param{"tables_for_level_$data_level"}. 
# Uses @fieldname for the field names (i.e. column names) to retieve.
# Uses $where_name and $where_value defined by calling routine as
# well as several parameters defined in the configuration file.
# See the @required array in the calling program.  Also uses
# $indirect_file to define cache file name to minimize risk that one
# is using the wrong cache file.

# Watch out for:
#   Possible problem has to do with specifying all table names when only
#   one or more are necessary.

my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst);
my ($addr, $array_length, $cacheflag, $cachefile, $columns, 
	$expected, $exists, $filename, 
	$fileroot, $file, @files, $host,
	$id, $id_value, 
	$maxlinesize, $maxpagesize, $maxunderscores, $numb_tables,
	$numb_underscores, $orderby, $record, $sql_script, 
	$sql_input, $tables, $table1, $table2, $temp, $where_clause,
	$where_add_on );

if (exists $indirect_param{"cache_root"} and defined $indirect_param{"cache_root"} ) {
	$fileroot = $indirect_param{"cache_root"} . "/sqlplus";
}
else {
	$fileroot = "/tmp/sqlplus";
}

$temp = $indirect_file;
$temp =~ s!.*/(.*)$!$1!;
$cachefile=$fileroot . "_" . $temp . "_" . $data_level . "_" . 
	$where_name . "_is_" . $where_value . ".cache";
	
$sql_script = $indirect_param{"sql_script"};

($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime(time);
if ($year >= 100 and $year <= 1000) {$year = $year + 1900}
if ($year < 1900) { $year = $year + 2000; }
$mon++;
if ($mon < 10) { $mon = "0" . $mon; }
if ($mday < 10) {$mday = "0" . $mday; }
if ($hour < 10) { $hour = "0" . $hour; }
if ($min < 10) { $min = "0" . $min; }
if ($sec < 10) { $sec = "0" . $sec; }

$maxlinesize = 999;
$maxpagesize = 50000;
$maxunderscores = 120;
$filename = $fileroot . "_level" . $data_level . "_" . $year . $mon . $mday . 
	$hour . $min . $sec . ".sql";
#print STDOUT ("#**debug, filename=$filename\n");	

#Cleanup old sql files xx days/hours old
@files = ($filename);
$pid = $data_level . "_" . $year . $mon . $mday . $hour . $min . $sec;
&pid_file_cleanup($pid,@files);

#Cleanup old cache files if more than xx days/hours old or if zero length
if (exists $indirect_param{"cache_clean_up"} and 
		defined $indirect_param{"cache_clean_up"} ) {
	if ($indirect_param{"cache_clean_up"} =~ m/y/i ) {
		@files = ($cachefile);
		$pid = $temp . "_" . $data_level . "_" . $where_name . "_is_" 
							. $where_value;
		&pid_file_cleanup($pid,@files);
	}
}

# Use cached data if available 
$cacheflag = "not available";
if ( -e $cachefile ) {
	if ($debug eq 'yes' ) {&make_log_entry("Cache available=$cachefile"); }
	$cacheflag = "available";
	unless ( open SQL_INPUT, $cachefile) {
		&sendmessage ($warning,
			"Could not open cache input file=$cachefile",
			"Error code=$!. ");
		&make_log_entry("Could not open cache input file=$cachefile");
		$cacheflag = "not available";
	}
}
unless ( $cacheflag eq "available" ) {
# Create sql command file
if ($debug eq 'yes' ) {&make_log_entry("Cache not available=$cachefile"); }
unless (open SQL, "> $filename" ) {
	&sendmessage ($error,
		"Could not open sql file=$filename",
		"Error code=$!.  Cannot continue.");
	exit;
}

print SQL <<SQL_BEGIN;
-- JGOFS SQL file $filename
-- Created $year/$mon/$mday $hour:$min by $0
set feedback off
set heading off
set pagesize $maxpagesize
set linesize $maxlinesize
set wrap off
SQL_BEGIN

# Determine columns clause
$columns = "";
for ($i=0; $i <= $#fieldname; $i++) {
	$numb_underscores = abs (length ($fieldname[$i]) - $fieldname_size[$i]);
	if ( $numb_underscores > $maxunderscores) { 
		$numb_underscores = $maxunderscores;
	}
#	print STDOUT ("\n**debug, fieldname[$i]=$fieldname[$i]\n");
#	print STDOUT ("**debug, fieldname_size[$i]=$fieldname_size[$i]\n");
#	print STDOUT ("**debug, numb_underscores=$numb_underscores\n");
	if (exists ( $indirect_param{"replace_$fieldname[$i]"} ) ) {
		print SQL ("column ",
			$indirect_param{"replace_$fieldname[$i]"},
			" HEADING Replaced_$fieldname[$i] ",
			" NULL \'nd\' \n");
		$temp = $indirect_param{"replace_$fieldname[$i]"};
	}
	else {
		print SQL ("column $fieldname[$i] HEADING \'", $fieldname[$i],
			"_" x $numb_underscores, "\'",
			" NULL \'nd\' \n");
		$temp = $fieldname[$i];
	}
	$columns = $columns . $temp . ", ";
}
$columns =~ s/, $/ /;  #cannot have trailing comma
#print STDOUT ("\n#**debug, columns=$columns\n");

# Determine "order by" clause
if ( exists $indirect_param{"order_by_level_$data_level"} ) {
	$orderby = "order by " . $indirect_param{"order_by_level_$data_level"};}
else { $orderby = "--No order_by_level_" . $data_level . "specified"; }

# Determine "where" clause
if (exists $indirect_param{"where_clause_added_for_level_$data_level"} ){
	$where_add_on = 
		$indirect_param{"where_clause_added_for_level_$data_level"}
		. " AND ";
}
else {
	$where_add_on = "";
}
$tables = $indirect_param{"tables_for_level_$data_level"};
($table1, $table2, $temp) = split /,/, $tables;
if ($table1 eq $tables) {
	$where_clause =  $indirect_param{"tables_for_level_$data_level"} .
			"." . $key_and_value;
}
elsif ( defined $temp) {
	&sendmessage ($error,
	"Could not define where clause where key_and_value=$key_and_value",
	"and tables=$tables  Cannot continue.");
	exit;
}
else { 
	($table1, $table2) = split /,/, $tables;
	$table1 =~ s/\s//g;
	$table2 =~ s/\s//g;
	$where_clause = $table1 . "." . $where_name . 
			"=" . $table2 . "." . $where_name . " AND " .
			"\n\t" . 
			$table1 . "." . $where_name . "=" . $where_value;
}
	
# Create contents of sql command file
print SQL <<SQL_BODY;
select
$columns
from $indirect_param{"tables_for_level_$data_level"}
where $where_add_on
	$where_clause
$orderby
;
quit
SQL_BODY
close SQL;
chmod 0664, $filename;

$login = $indirect_param{"login"};
$login =~ s/\$/\\\$/g;

$sql_input = $do_web_sql . " " . $indirect_param{"sqlplus"} . " " .
	$login .
	" @" . $filename . "|";
#print STDOUT ("\n#**debug, sql_input=$sql_input\n");

$cacheflag = "new";
if ($debug eq "yes") {&make_log_entry ("Opening sequel input file=$sql_input"); }
unless ( open SQL_INPUT, $sql_input ) {
	$err = $!;
	&sendmessage ($error,
		"Could not open sql input pipe=$sql_input",
		"Error code=$err.  Cannot continue.");
	&make_log_entry("Could not open sql input pipe=$sql_input",
		"Error code=$err");
	exit;
}
}
if ( defined $sql_input ) {
	$sequel_input_file = $sql_input;
}
elsif (defined $cachefile ) {
	$sequel_input_file = $cachefile;
}
else {
	$sequel_input_file = "undefined";
}
if ($debug eq "yes") {
	&make_log_entry ("Reading sequel input file=$sequel_input_file");
}	
#end of cache versus new data loop
@sql_records = <SQL_INPUT>;
if ($debug eq "yes") {&make_log_entry ("Finished input via file=$sequel_input_file")}
close SQL_INPUT;
if ($debug eq "yes") {&make_log_entry ("Close input via file=$sequel_input_file")}
for ($i=0; $i<= $#sql_records; $i++)  {
	$record = $sql_records[$i];
	chomp $record;
	if (length ($record) < 3 ) { next;}
	print STDOUT ("\n***debug, record=$record\n") if $debug eq 'yes';
	&make_log_entry ("***debug, record=$record") if $debug eq 'yes';
	if ($record =~ m/rows will be truncated/ ) { next;}
	if ($record =~ m/Disconnected from/ ) { next;}
	if ($record =~ m!PL/SQL Release ! ) {print STDOUT ("#$record\n"); next;}
	if ($record =~ m/ERROR/ ) {
		$record = $sql_records[$i+1];
		chomp $record;
		&sendmessage ($error,
		"ERROR returned from remote SQL site",
		"Message: $record\n$error\tSee file $filename\n$error\tCannot continue.");
		close SQL_INPUT;
		exit;
	}
# Handle text fields with embedded blanks such as taxon name.  Replace with _
	if ($indirect_param{"last_level"} == $data_level) {
		$record =~ s/([a-zA-Z_&\-\.]+) /$1_/g;
	}
# Handle text field with embedded blank(s) in level 3 - initials followed by
# date
	if ($data_level == 3 ) {
#		print STDOUT ("#**debug, record=$record\n");
		$record =~ s!^(.*\D)\s(\d{1,2}/\d{1,2}/\d{1,4})!$1_$2!
	}
	$record =~ s/\s+/\t/g;
	$record =~ s/nd_/nd/g;
	$record =~ s/_nd/nd/g;
	$record =~ s/^\s+//;
	$id = uc $fieldname[$#fieldname];
	@id_value = split /\s+/, $record;
#	&make_log_entry ("Start of debug for record=$record");
#	foreach $x (@id_value) {
#		&make_log_entry("item=$x");
#	}
#	&make_log_entry ("End of debug");
	$array_length=$#id_value;
	
#	if (exists $indirect_param{"field_names_in_level_" . $data_level} and
#	   defined $indirect_param{"field_names_in_level_" . $data_level} ) {

	$exists = $array_length + 1;
	$expected = $#fieldname + 1;
	unless ( $exists == $expected) {
		&sendmessage ($warning,
			"Miss-matched number of field names ($expected) and values ($exists)",
			"Record=$record -- ignored.");
		&make_log_entry("Miss-matched number of field names=$expected",
			"Number of values=$exists","Level=$data_level",
			"key and value=$key_and_value",
			"Record=$record");
		next;
	}
	
#	print STDOUT ("\n#**debug, array_length=$array_length\n");
	if ( $array_length < 0 ) { next; }
	print STDOUT ("$record"); 
#	print STDOUT ("\n#**debug, indirect_param{last_level}=",
#		$indirect_param{"last_level"},  " data_level=$data_level\n");	
	if ( $data_level < $indirect_param{"last_level"}) {
#		print STDOUT ("\n#**debug, id=$id and ",
#			"id_value[$array_length]=$id_value[$array_length]\n");
		print STDOUT ("\t(", $sql_script, " ", $indirect_file, 
		" ", $data_level+1, " ", $id, "=", 
		$id_value[$array_length], ")\n");
	}
	else {
		print STDOUT ("\n");
	}
}

if ( $cacheflag eq "new" ) { 
	unless ( open CACHE, ">$cachefile") {
		&sendmessage ($warning,
		"Could not open new cache file=$cachefile",
		"Error code=$!.  Cannot continue.");
		$cacheflag = "not available";
	}
	else {
		for ($i=0; $i<= $#sql_records; $i++)  {
			$record = $sql_records[$i];
			chomp $record;
			print CACHE ("$record\n");
		}
		close CACHE; 
		chmod 0664, $cachefile;
		&make_log_entry ("New cache file written=$cachefile");
	}
}

&make_log_entry ("cache=$cacheflag" ,"filename=$cachefile", 
	"data_level=$data_level", "$where_name=$where_value");

return;
}
#---------------------------------------------
sub sendmessage {

#Send a message to the user.
#The message sent will be in the strings $_[0] and $_[1]

my ( @args, $mailfile, $message0, $message1, $prefix, $who);
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst);

$prefix=$_[0];
$message0=$_[1];
$message1=$_[2];
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime(time);
if ($year >= 100 and $year <= 1000) {$year = $year + 1900}
if ($year < 1900) { $year = $year + 2000; }
$mon++;
if ($mon < 10) { $mon = "0" . $mon; }
if ($mday < 10) {$mday = "0" . $mday; }
if ($hour < 10) { $hour = "0" . $hour; }
if ($min < 10) { $min = "0" . $min; }
if ($sec < 10) { $sec = "0" . $sec; }
$mailfile="> /tmp/sendmess" . $year . $yday . $hour . $min . $sec . ".tmp";

if ( open TEMPFILE, $mailfile) {
	print TEMPFILE ("Message from $0\n");
	if ( exists $ENV{'REMOTE_HOST'} ) {$who=$ENV{'REMOTE_HOST'} ; }
	elsif (exists $ENV{'REMOTE_ADDR'} ) {$who=$ENV{'REMOTE_ADDR'} ; }
	else {$who="not available"; }
	print TEMPFILE (" Date of message: $year/$mon/$mday $hour:$min\n");
	print TEMPFILE (" From: $who\n");
	print TEMPFILE (" $message0\n");
	print TEMPFILE (" $message1\n");
	close TEMPFILE;
	`/usr/bin/mail -w dmo\@globec.whoi.edu <$mailfile`;
#	unlink $mailfile;
}

print STDOUT ($prefix," $message0\n");
print STDOUT ($prefix," $message1\n");
print STDOUT ($prefix," Above message from $0\n");
print STDOUT ($prefix," Date of message: $year/$mon/$mday $hour:$min\n");

return 0;
}


#---------------------------------------------

sub make_log_entry {

# Make a log entry with @_ if the log file $indirect_param{"logfile"}
# exists.  Each entry in @_ are separated by tabs.

my ($login, @month, $temp);
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst);

($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime(time);
if ($year >= 100 and $year <= 1000) {$year = $year + 1900}
if ($year < 1900) { $year = $year + 2000; }
$mon++;
if ($mon < 10) { $mon = "0" . $mon; }
if ($mday < 10) {$mday = "0" . $mday; }
if ($hour < 10) { $hour = "0" . $hour; }
if ($min < 10) { $min = "0" . $min; }
if ($sec < 10) { $sec = "0" . $sec; }

if (exists $indirect_param{"logfile"} ) {
	$temp = ">>" . $indirect_param{"logfile"};
	unless ( open LOGFILE, $temp ) {
		&sendmessage ($warning, "Could not open logfile=$temp",
			"Error code=$!");
	}
	else {
		$login = getlogin || (getpwuid($<))[0] || "Intruder!!";
		$login="\tusername=" . $login;
		print LOGFILE ($year, "/" . $mon . "/" . $mday . ":" . $hour . $min . "." . 
			$sec, $login);
		foreach (@_) {
			print LOGFILE ("\t", $_);
		}
		print LOGFILE ("\n");
		close LOGFILE;
	}
}
return;
}

#----------------------------------------------------------------------------

sub pid_file_cleanup
{
  my ($ind,@temp_files) = @_;
#       An implicit argument is environment variable $pid_file_cleanup_debug.
#    If set, this program does not delete any files, but prints the ones it 
#    would have deleted
#	Explicit arguments are:
#	  1) A "temp indicator"; a string whose presence in a file spec
#	     means that the file is to be treated by this routine.
#	     Often a pid.
#	  2) An array of filenames to be considered for cleanup
###
#  Clean up temp files (does not do temp directories)
#	We could just delete the ones in @temp_files, but that would be
#    too easy.  Idea is that we'd like the files to stay around a while
#    in case we want to look at them, but delete them if they aren't looked
#    at.  Rather than trying to save a list of exactly what's eligible for
#    deletion, we apply the following algorithm:
#	1) Only look at files in @temp_files
#	2) Of those, only look at the ones with this proc's PID in them
#	   Assumption is that presence of PID is indicator that file really
#	   is temporary & that a bunch of them might exist.
#	   Further assumption is that PID only appears once (fails safe-
#	   no such files will be deleted unless PIDs have recycled)
#	3) Logically replace PID with *
#	4) Look at those files, and delete the ones that haven't been 
#	   created in 7 days.  Use access date to prolong life of those
#	   that have been looked at after creation... which are probably 
#	   the ones we REALLY want to save!

#  17 March 1999.  Change deletion criteria to be 7 days old rather than
#	7 days since accessed.  rcg
#  13 May 98.  Lots of bug fixes.  Amazed I thought it worked at all.  WJS
  
  local $thisdir = "";

  local @del_files;
#    local DIR;  Investigate how to localize this
  my ($dir,$before_ind,$after_ind,@dir_content);

#  Loop for those files w/PID in them.  Sort so all files in a directory
#  are together.
  foreach (    sort(  grep(/$ind/,@temp_files)  )    )  {

    ($dir) = m"^(.*/)";
    ($before_ind,$after_ind) = /(.*)$ind(.*)/;

#     If we have a directory, be sure that PID is in file spec,
#     not just directory (test is that if whole directory does not
#    appear before PID, do next loop iteration)
    if ($dir eq "") { $dir = "." }
    else { ($before_ind !~ /^$dir/) && next }

    $before_ind =~ s/$dir//;	# remove directory spec

    if ($dir ne $thisdir) {
      &proc_dir;
      undef(@del_files);
      $thisdir = $dir;
      opendir (DIR,$thisdir) || die "Bad opendir : $!\n";
      (@dir_content = readdir(DIR)) || die "Bad readdir : $!\n";
    }
@tmp2=grep(/^$before_ind.*$after_ind$/,@dir_content);
push (  @del_files, @tmp2);
  }

  &proc_dir;
}
sub proc_dir
{
#  23 March 1999.  Fix uninitialized variables.  Define date and time 
#	locally.  rcg
  my $file;
  
  if ($thisdir ne "") {
    closedir (DIR);
#     Didn't want to unlink files w/directory open.  Have no
#     particular knowledge about this...
    foreach $file(@del_files) {
      ($thisdir eq ".") || ($file = $thisdir . $file);
       if (-e $file  and  -M $file  > 7 ) {
		unlink $file;
		&make_log_entry (
			"file=deleted", "filename=$file", 
			"data_level=$data_level", 
			"$where_name=$where_value");		
	}
     }
   }
}
#  Next line needed if you intend to require this file
1;