#!/afs/athena/contrib/perl/perl
#
#    PLOD-- Personal LOgging Device, v1.3
#    Copyright (C), 1993, Hal Pomeranz (pomeranz@nas.nasa.gov)
#    All rights reserved.  No warranty expressed or implied.
#    PLOD is freely distributable under the same terms as Perl.
#    Inspired by Bill Mendyka (mendyka@dg-rtp.dg.com)
#    Suggestions/Bugfixes: 
#       David W Crabb (crabb@phoenix.Princeton.EDU)
#	John Ellis (ellis@rtsg.mot.com)
#	Erik E. Rantapaa (rantapaa@math.umn.edu)
#	James Tizard (james@ringo.ssn.flinders.edu.au)
#
######################### Begin Variable Declarations #########################
#
# All variables have default values which will be superceded by environment
# variables of the same name.  The user's .plodrc is read after all other
# variable assignments, so any assignments there take precedence.
#
# Note that $LOGFILE and $DEADLOG are used as absolute pathnames.  After
# the .plodrc has been evaluated, $LOGDIR or $HOME will be prepended to
# $LOGFILE and $DEADLOG respectively if either of these variables does not
# begin with a '/'.
#
# Set $CRYPTCMD to null if you don't want encryption to be performed.
#
# KEYVAL	key value used by CRYPTCMD
# CRYPTCMD	encryption command, set this to null for no encryption
# TMPFILE	file name to use for temporary holding
# EDITOR	editor called by ~e
# VISUAL	editor called by ~v
# PAGER         used by ~p and ~h when output longer than one page (see LINES)
# LINES		number of lines on the screen
# LOGDIR	directory containing log files
# LOGFILE	absolute path of log file
# HOME		user's home directory
# DEADLOG	place to drop dead.log file on abort or ~q, also used by ~d

# Some variable values use date/time information
#
($ss, $mm, $hh, $DD, $MM, $YY) = localtime($^T); $MM++; 

$KEYVAL = $ENV{'KEYVAL'} || sprintf("pl%d%dod", $YY, $MM);
$CRYPTCMD = defined($ENV{'CRYPTCMD'})? $ENV{'CRYPTCMD'} : "crypt";
$TMPFILE = $ENV{'TMPFILE'} || "/tmp/plodtmp$$";
$HOME = $ENV{'HOME'} || (getpwuid($<))[7];
$EDITOR = $ENV{'EDITOR'} || "emacs";
$VISUAL = $ENV{'VISUAL'} || "emacs";
$PAGER = $ENV{'PAGER'} || "more";
$LINES = $ENV{'LINES'} || 24;
$LOGDIR = $ENV{'LOGDIR'} || "$HOME/.logdir";
$LOGFILE = $ENV{'LOGFILE'} || sprintf("%02d%02d", $YY, $MM);
$DEADLOG = $ENV{'DEADLOG'} || "dead.log";


########################## End Variable Declarations ##########################
######################### Begin Function Declarations #########################


# Printvar (~=): Output the value of one or more variables.
#
sub printvar {
   local($vars) = @_;
   $, = ','; print eval "($vars)"; $, = '';
   print "\n";
   print "(continue composing note)\n";
}
$printvar = "\$var[, ...]\tOutput value of variables";
$funcs{'='} = *printvar;


# Bang (~!): Execute a command in the shell and then return to plod.
#
sub bang {
   local($cmdline) = @_;
   system "$cmdline";
   print "(continue composing note)\n";
}
$bang = "cmdline\tExecute system command and return";
$funcs{'!'} = *bang;


# Redirect (~>): Pipe the output of a command into the current buffer.
#
sub redirect {
   local($cmdline) = @_;
   local($count);
   if (!open(CMD, "$cmdline |")) {
      warn "*** Unable to execute: $cmdline\n";
      return;
   }
   &readit(CMD);
}
$redirect = "cmdline\tAdd output of given command to buffer";
$funcs{'>'} = *redirect;


# Pipetocmd (~|): Pipe the contents of the current buffer through a UNIX
# command line and replace the buffer with the result.
#
sub pipetocmd {
   local($cmdline) = @_;
   local($header);
   if (!open(PIPELN, "| $cmdline >$TMPFILE 2>&1")) {	# output to tmp file
      warn "*** Unable to execute: $cmdline\n";
      return;
   }
   $header = shift @lines;				# don't include stamp
   print PIPELN @lines;
   close(PIPELN);
   if (!open(INP, "<$TMPFILE")) {
      warn "*** Unable to get command output\n";
      unshift(@lines, $header);
      unlink "$TMPFILE";
      return;
   }
   undef @lines;					# replace buffer with
   @lines = <INP>;					# contents of tmp file
   close(INP);
   unlink "$TMPFILE";
   unshift(@lines, $header);
   print "(continue composing note)\n";   
}
$pipetocmd = "cmdline\tPipe contents of buffer through cmdline";
$funcs{'|'} = *pipetocmd;


# Perlit (~X): Execute Perl code.
#
sub perlit {
   local($code) = @_;
   eval "$code";
   warn $@ if $@;
   print "(continue composing note)\n";   
}
$perlit = "code\t\tExecute a line of Perl code";
$funcs{'X'} = *perlit;


# Longperl (~M): Edit then eval a multi-line Perl fragment
#
sub longperl {
   local($bogus) = @_;
   return(&mistake) if ($bogus);
   if (@code) {
      if (!open(TMP, "> $TMPFILE")) {
         warn "*** Unable to create temporary file\n";
         return;
      }
      print TMP @code;
      close(TMP);
   }
   system("$EDITOR $TMPFILE");
   if (!open(TMP, "< $TMPFILE")) {
      warn "*** Unable to read buffer\n";
      return;
   }
   undef @code;
   @code = <TMP>;
   close(TMP);
   system("/bin/rm -f $TMPFILE*");
   eval "@code";
   warn $@ if $@;
   print "(continue composing note)\n";   
}
$longperl = "\t\tInvoke \$EDITOR on command buffer, then execute as Perl code";
$funcs{'M'} = *longperl;


# Appendfl (~a): Append contents of buffer to a file and return to plod.
# To overwrite a file with the contents of the buffer, see &writefl().
#
sub appendfl {
   local($file) = @_;
   if (!open(OUTP, ">> $file")) {
      warn "*** Could not append to file $file\n";
      return;
   }
   print OUTP @lines;
   close(OUTP);
   print "Wrote ", scalar(@lines), " lines to file $file\n";
   print "(continue composing note)\n";
}
$appendfl = "file\t\tAppend contents of buffer to file";
$funcs{'a'} = *appendfl;


# Getdead (~d): Suck contents of DEADLOG file into buffer.
#
sub getdead {
   local($bogus) = @_;
   return(&mistake) if ($bogus);
   if (!open(DEAD, "<$DEADLOG")) {
      warn "*** Unable to open $home/dead.log.\n";
      return;
   }
   &readit(DEAD, "$DEADLOG");
}
$getdead = "\t\tIncorporate contents of \$DEADLOG into buffer";
$funcs{'d'} = *getdead;


# Editbuf (~e) and Visualbuf (~v): Call appropriate editor on buffer.
#
sub editbuf {
   local($bogus) = @_;
   return(&mistake) if ($bogus);
   &calledit($EDITOR);
}
sub visualbuf {
   local($bogus) = @_;
   return(&mistake) if ($bogus);
   &calledit($VISUAL);
}
$editbuf = "\t\tEdit buffer with \$EDITOR";
$visualbuf = "\t\tEdit buffer with \$VISUAL";
$funcs{'e'} = *editbuf;
$funcs{'v'} = *visualbuf;


# Editlog (~E) and Visuallog (~V): Call appropriate editor on LOGFILE.
#
sub editlog {
   local($args) = @_;
   &logedit($EDITOR, $args);
   print "(continue composing note)\n";
}
sub visuallog {
   local($args) = @_;
   &logedit($VISUAL, $args);
   print "(continue composing note)\n";
}
$editlog = "[file [key]]\tEdit LOGFILE [or older log] with \$EDITOR";
$visuallog = "[file [key]]\tEdit LOGFILE [or older log] with \$VISUAL";
$funcs{'E'} = *editlog;
$funcs{'l'} = *editlog;
$funcs{'V'} = *visuallog;


# Helpuser (~h or ~?): Output a list of tilde escapes with associated
# help messages (found in the scalar values of the type globs in %funcs).
# Use the defined PAGER if the output would be more than LINES long.
#
sub helpuser {
   $long = (scalar(keys %funcs) >= $LINES) && open(TMP, ">$TMPFILE");
   for (sort keys %funcs) {
      *info = $funcs{$_};
      if ($long) {
         print TMP "~$_ $info\n";
      }
      else { print "~$_ $info\n"; }
   }
   if ($long) {
      close(TMP);
      system("/bin/cat $TMPFILE | $PAGER");
      unlink "$TMPFILE";
   }
}
$helpuser = "\t\tPrint this message";
$funcs{'h'} = *helpuser;
$funcs{'?'} = *helpuser;


# Printout (~p):  cat back the current buffer for review.  Use PAGER if
# the buffer is longer than LINES.
#
sub printout {
   local($bogus) = @_;
   return(&mistake) if ($bogus);
   if (@lines < $LINES-1 || !open(TMP, ">$TMPFILE")) {
      print "-----\n";
      print @lines;
   }
   else {
      print TMP @lines;
      close(TMP);
      system("/bin/cat $TMPFILE | $PAGER");
      unlink "$TMPFILE";
   }
   print "(continue composing note)\n";
}
$printout = "\t\tView contents of buffer, one page at a time";
$funcs{'p'} = *printout;


# Pagelog (~P): Page contents of LOGFILE.
#
sub pagelog {
   local($args) = @_;
   &pageit($args);
   print "(continue composing note)\n";
}
$pagelog = "[file [key]]\tView contents of LOGFILE [or older log] with PAGER";
$funcs{'P'} = *pagelog;
$funcs{'L'} = *pagelog;


# Quitit (~q): Quit plod and attempt to save buffer in DEADLOG.  Also
# called on SIGINT and SIGQUIT via &trapit().
#
sub quitit {
   local($bogus) = @_;
   return(&mistake) if ($bogus);
   open(DEAD, ">> $DEADLOG") || die "Can't open $DEADLOG\n";
   print DEAD @lines;
   close(DEAD);
   exit;
}
$quitit = "\t\tQuit, attempts to save buffer in \$DEADLOG";
$funcs{'q'} = *quitit;


# Readfile (~r): Append contents of file into buffer.
#
sub readfile {
   local($file) = @_;
   if (!open(INPT, "<$file")) {
      warn "*** Unable to open $file.\n";
      return;
   }
   &readit(INPT, $file);
}
$readfile = "file\t\tRead contents of file into buffer";
$funcs{'r'} = *readfile;


# Writefl (~w): Overwrite file with contents of buffer.  To append to a
# given file, see &appendfl().
#
sub writefl {
   local($file) = @_;
   if (!open(OUTP, "> $file")) {
      warn "*** Could not write to file $file\n";
      return;
   }
   print OUTP @lines;
   close(OUTP);
   print "Wrote ", scalar(@lines), " lines to file $file\n";
   print "(continue composing note)\n";
}
$writefl = "file\t\tOverwrite file with contents of buffer";
$funcs{'w'} = *writefl;


# Exitnow (~x): Exit plod without writing to DEADLOG or LOGFILE.
#
sub exitnow {
   local($bogus) = @_;
   return(&mistake) if ($bogus);
   exit;
}
$exitnow = "\t\tExit without saving buffer";
$funcs{'x'} = *exitnow;


########################## End Function Declarations ##########################
############################# Begin Main Program ##############################


# Check for ~/.plodrc and eval() contents.  Exit with an error message if
# eval() complains for any reason.
#
if (-e "$HOME/.plodrc") {
   eval { do "$HOME/.plodrc"; };
   die "*** Error in $HOME/.plodrc:\n$@" if $@;
}

# Prepend parent directories unless we have explicit pathnames
#
$LOGFILE = "$LOGDIR/$LOGFILE" unless ($LOGFILE =~ /^\//);
$DEADLOG = "$HOME/$DEADLOG" unless ($DEADLOG =~ /^\//);

# Extract dirname from $LOGFILE and make sure it exists
#
($dirname = $LOGFILE) =~ s,/[^/]*$,,;
if (!(-d $dirname)) {
   warn "Attempting to create logging directory, $dirname\n";
   die "Attempt failed!\n" unless (mkdir($dirname, 0700));
}

# Create time/date stamp and make it the first line of the buffer.
#
($ss, $mm, $hh, $DD, $MM, $YY) = localtime($^T); $MM++; 
$stamp = sprintf("%02d/%02d/%02d, %02d:%02d --", $MM, $DD, $YY, $hh, $mm);
push(@lines, "$stamp\n");

# Log entry can appear on the command line, otherwise loop until end of
# STDIN or '.' recognized on a line by itself.
#
if ($ARGV[0] eq "-P") { shift @ARGV; &pageit("@ARGV"); exit; }
elsif ($ARGV[0] eq "-E") { shift @ARGV; &logedit($EDITOR, "@ARGV"); exit; }
elsif ($ARGV[0] eq "-V") { shift @ARGV; &logedit($VISUAL, "@ARGV"); exit; }
elsif (@ARGV) { push(@lines, "@ARGV\n"); }
else {
   if (-t STDIN) {
      print "$stamp\n";
      $SIG{'QUIT'} = trapit;
      $SIG{'INT'} = trapit;
   }
   while (<STDIN>) {
      if (/^~/) {					# escape sequence:
         ($esc, $args) = /^~(\S)\s*(.*)$/;		# 1) parse line
         *glob = $funcs{$esc};				# 2) unpack type glob
         if (!defined(&glob)) {				# 3) check defined()
	    warn "Unrecognized escape sequence: ~$esc\n";
            next;
         }
         &glob($args);					# 4) call func w/ args
      }
      elsif (/^\.\s*$/) {				# lone dot means end 
         print "(eot)\n";				# of log entry
         last;
      }
      else {						# else append line to
         push(@lines, $_);				# log buffer
      }
   }
}
$lines[$#lines] = "$lines[$#lines]\n" unless ($lines[$#lines] =~ /\n$/);

# Completed log entry now in @lines.  If using encryption, call encryption
# command to decrypt previous log entries (if present).  If not encrypting,
# simply open log file to append.
#
if ($CRYPTCMD) {					# encrypting
   if (-e "$LOGFILE") {
      system "$CRYPTCMD $KEYVAL <$LOGFILE >$TMPFILE";
   }
   if (!open(LOGFILE, ">> $TMPFILE")) {
      unlink "$TMPFILE";
      warn "*** Unable to append new log entry\n";
      &quitit();
   }
}
else { 							# not encyrpting
   if (!open(LOGFILE, ">> $LOGFILE")) {
      warn "*** Unable to append new log entry\n";
      &quitit();
   }
}

# Dump contents of buffer into plain text file.
#
print LOGFILE "-----\n";
print LOGFILE @lines;
close(LOGFILE);

# If encrypting, replace old log file with new version.  Unlink plain
# text temporary file when done.
#
if ($CRYPTCMD) {
   unlink "$LOGFILE";
   system "$CRYPTCMD $KEYVAL <$TMPFILE >$LOGFILE";
   chmod 0600, "$LOGFILE";
   unlink "$TMPFILE";
}


############################## End Main Program ###############################
########################### Miscellaneous Functions ###########################


# Append contents of file $fname (associated with file handle $fh) to buffer.
# Assume $fh is a pipe if $fname is null.  This function called by many tilde
# escapes.
#
sub readit {
   local($fh, $fname) = @_;
   push(@lines, <$fh>);
   print STDOUT ($fname) ? "$fname: " : "Added ";
   print STDOUT "$. lines";
   print STDOUT ($fname) ? "\n" : " to buffer.\n";
   print STDOUT "(continue composing note)\n";
   close($fh);
}


# Call the editor $_[0] on the contents of the buffer.  Used by &editbuf()
# and &visualbuf().
#
sub calledit {
   local($edit) = @_;
   if (!open(EDIT, ">$TMPFILE")) {
      warn "*** Unable to create file for editing\n";
      return;
   }
   print EDIT @lines;
   close(EDIT);
   chmod 0600, "$TMPFILE";
   system "$edit $TMPFILE";
   if (!open(EDIT, "<$TMPFILE")) {
      warn "*** Unable to read changes, returning to previous state.\n";
      system "/bin/rm -f $TMPFILE*";
      return;
   }
   undef @lines;
   @lines = <EDIT>;
   close(EDIT);
   system "/bin/rm -f $TMPFILE*";
   print "(continue composing note)\n";
}


# Call the appropriate editor on a log file.  Used by &editlog and &visualedit.
#
sub logedit {
   local($edit, $args) = @_;
   local($file, $key) = split(/\s+/, $args);
   $key = $key || $KEYVAL;
   $file = $file || $LOGFILE;
   $file = "$LOGDIR/$file" unless ($file =~ /^\//);
   if ($CRYPTCMD) {
      if (!(-e "$file")) {
	 warn "*** $file does not exist\n";
	 return;
      }
      system("$CRYPTCMD $key <$file >$TMPFILE");
      chmod 0600, "$TMPFILE";
      system("$edit $TMPFILE");
      if (!(-e "$TMPFILE") || -z _) {
         warn "*** Modified file is empty-- restoring old version\n";
	 unlink "$TMPFILE";
	 return;
      }
      unlink "$file";
      system "$CRYPTCMD $key <$TMPFILE >$file";
      chmod 0600, "$file";
      unlink "$TMPFILE";
   }
   else { system("$edit $file"); }
}


# Page a log file.
#
sub pageit {
   local($args) = @_;
   local($file, $key) = split(/\s+/, $args);
   local($cmd);
   $key = $key || $KEYVAL;
   $file = $file || $LOGFILE;
   $file = "$LOGDIR/$file" unless ($file =~ /^\//);
   $cmd = $CRYPTCMD ? "$CRYPTCMD $key < $file" : "/bin/cat $file";
   system("$cmd | $PAGER");
}


# Generic warning message called by all escapes that do not expect arguments
# when @_ is not empty.
#
sub mistake {
   warn "*** Arguments are not expected for this escape.\n";
}


# Wrapper for &quitit()-- called on SIGINT and SIGQUIT.  Wrapper required
# because signal handlers get the signal as an argument and &quitit() does
# not appreciate arguments.
#
sub trapit {
   &quitit();
}