sub pid_file_cleanup
{
#   Call new pid_file_cleanup routine w/7 day expiration (hard coded into
#   old routine...).  Could emulate old return status, too, if I remembered
#   how it actually returned!  No return status was documented - now
#   returns new status string.
  &pid_file_cleanup2(shift(@_),7,@_);
}
sub pid_file_cleanup2
{
#       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.  If a null string, no wildcarding (see below)
#	     is done.  Only the files in the array in arg 3 are considered
#	     for cleanup.
#	  2) The minimum number of days the files should live.  Fractions of
#	     days are allowed.
#	  3) An array of filenames to be considered for cleanup
#	Returns a string.
#	    The last "word" (blank-separated) of the return string is
#	  3 numbers separated by 2 slashes.  The first number is
#	  the number of files considered for deletion.  The second number is
#	  the number of files deleted.  The third number is the number of
#	  attempts at deletion which failed.
#	    The return string may begin with 3 consecutive asterisks, indicating
#	  a problem.  The string between the asterisks and the count triple
#	  described above defines the problem.  In case of failures to
#	  delete files, the reason for the last such failure is returned.
###
#  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 
#	   accessed in the minimum number of 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!
  
#	Modification history not clear.  There were substantial modifications
#  13 May 98, but this version seems better.  There was a "parallel" mod
#  24 Feb 98 to return if no temp files were passed in.

#  23 Nov 08.  Version 2.0c  WJS
#	One invokation of proc_dir did not have an arg.  Probably been that
#    way since pid_file_cleanup_2 in Apr 99.  Guess most times that code
#    path wasn't taken!
#		[Begin v 2.0c]
#  16 Nov 07.  Version 2.0b  WJS
#	perl warning that defined(@array) is deprecated.  Switch to
#    defined($array[0]), empirically determined.  Tests on VAX showed that
#    @array = ();  statement made no difference w/regard to "defined" state
#    of array.  Also, use of @array w/o above statement did not get
#    "only one use" diagnostic
#		[Begin v 2.0b]
#  16 Mar 05.  Version 2.0a  WJS
#	valid_number.pl now in wjs_web_perl_utilities.pl
#		[Begin v 2.0a]
#  30 Jul 99.  Version 2.0  WJS
#	Bug fix - procdir was using $_ instead of $file
#  23 Apr 99.  Version 2.0  WJS
#	Remove expiration date part of expiration arg - bad idea.  Expiration
#    date is a delete/nodelete flag that caller can determine.  If delete,
#    call this routine w/ 0 days expiration.  If no delete, don't call!
#	Handle illegal expiration length and null temp file indicator with
#    more intelligence.  The former would have resulted in a "all files
#    expired" condition.  The latter would have caused all files to be be
#    considered for deletion.
#	Return some info.
#		[Changes remove need for DateTime::Precise.pm]
#  17 Apr 99.  Version 2.0  WJS
#	Add entry pid_file_cleanup2 to handle exp arg.
#  14 Apr 99.  Version 2.0  WJS
#	Add expiration args.
#	Hardcode DateTime::Precise location w/ use lib
#		[Needs valid_number.pl]
#		[Begin v 2.0]
#  13 Apr 99.  Version 1.5  WJS
#	Incorporate 24 Feb 98 mod into post-13-May-98 version

  require "wjs_web_perl_utilities.pl";

  local $thisdir = "";
  local $debug = $ENV{"PID_FILE_CLEANUP_DEBUG"};
  local @del_files;
  local *DIR;
  local *DEBUG;
  local $n_files_deleted = 0;
  local $n_files_considered = 0;
  local $n_deletion_problems = 0;
  local $problem;
  my ($start_dir_pos);
  my ($dir,$file_before_ind,$before_ind,$after_ind,$delete_time);

  my ($ind,$exp,@temp_files) = @_;
 
  defined($temp_files[0]) || (return "0/0/0");	# Don't think this is possible
  (@temp_files == 0) && (return "0/0/0");

  if ($debug) { 
    open(DEBUG,">$debug") ||
		die "pid_file_cleanup: cannot open/write $debug: $!\n";
    print DEBUG "... indicator string=$ind\n... expiration string=$exp\n";
  }

#  Next line is crude test for valid number.  If invalid, $exp++ should
#  end up as the null string
  (&valid_number($exp))
		|| (return "*** Problem: Invalid expiration $exp 0/0/0");
  ($exp >= 0) || (return "*** Problem: Invalid expiration $exp 0/0/0");

  $n_files_deleted = 0;
  $n_files_considered = 0;
  $n_deletion_problems = 0;

#   If no wildcarding, just examine the files in @temp_files
  if ($ind eq "") {
    foreach (@temp_files) {
      $debug && print DEBUG " .. del_file candidate $_\n";
      $n_files_considered++;
      if ( (-A $_) > $exp) {
	if ($debug) { print DEBUG " ... would unlink $_\n" }
	else {
	  if (unlink $_) { $n_files_deleted++ }
	  else {
	    $n_deletion_problems++;
	    $problem = $!;
	  }
	}
      }
    }
    return &status_string;
  }

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

    $debug && print DEBUG "temp file ... $_\n";
#      ?=/ means don't include the last /
    ($dir) = m"(.*(?=/))";
    ($before_ind,$after_ind) = /(.*)$ind(.*)/;
    $debug && 
	print DEBUG "dir = $dir; before = $before_ind; aft = $after_ind\n";

    if (defined($dir)) {
#	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).  While we're at it, save the file spec portion
#	(stuff after directory)
      (  ($file_before_ind) = ($before_ind =~ m"$dir/(.*)")  ) || next;
    } else {
      $dir = ".";
      $file_before_ind = $before_ind;
    }
    
#	Conceptually, following logic is
#	  opendir
#	  find files matching
#	  proc_dir those files
#	  closedir
#	Actual logic attempts to avoid extra opens and closes since we
#	expect many files in each directory
    if ($dir ne $thisdir) {
      $debug && (print DEBUG " ... New dir $dir\n");
      &proc_dir($exp);
      undef(@del_files);
      $thisdir = $dir;
      opendir (DIR,$thisdir) || (die "Bad opendir : $!\n");
      $start_dir_pos = telldir(DIR);
    }

#     "Rewind" directory file
    seekdir (DIR,$start_dir_pos);
    push (  @del_files, grep(/^$file_before_ind.+$after_ind$/,readdir(DIR))  );
  }
  &proc_dir($exp);
  $debug && close DEBUG;

  return &status_string;
}

sub proc_dir
{
  my ($exp) = $_[0];
  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) {
      $file = "$thisdir/$file";
      $n_files_considered++;
      $debug && print DEBUG " .. del_file candidate $file\n";
      if ( (-A $file) > $exp) {
	if ($debug) { print DEBUG " ... would unlink $file\n" }
	else {
	  if (unlink $file) { $n_files_deleted++ }
	  else {
	    $n_deletion_problems++;
	    $problem = $!;
	  }
	}
      }
    }
  }
}

sub status_string
{
  my ($string);
  $string = ($n_deletion_problems == 0) ? "" : "*** Problem $problem:";
  return "$string $n_files_considered/$n_files_deleted/$n_deletion_problems";
}

#  Next line needed if you intend to require this file
1;