package CLhist;
#
# Read/write/edit a command line history
# This was originally written to work with ccc-job-string
#
# Larry Solheim May 14,2007
#
# $Id: CLhist.pm 656 2011-12-28 19:51:43Z acrnrls $

use strict;
use vars qw($VERSION @ISA @EXPORT);
BEGIN {
  # Append a dir containing stubs for missing packages to @INC
#  my $MISSING = (getpwnam("acrnrls"))[7]."/pub/perl/missing";
#  if ($MISSING eq "/pub/perl/missing") {
  my $MISSING = "$ENV{CCRNSRC}/cccjob_dir/pub/lib/missing";
  if ($MISSING eq "/cccjob_dir/pub/lib/missing") {
    # acrnrls is not a valid user, possibly because this is a laptop
    # Try a few hard coded locations
    if (-d "/home/rls/pub/perl/missing" ) {
      $MISSING = "/home/rls/pub/perl/missing";
    } elsif (-d "/HOME/rls/pub/perl/missing" ) {
      $MISSING = "/HOME/rls/pub/perl/missing";
    } elsif (-d "/users/tor/acrn/rls/pub/perl/missing" ) {
      $MISSING = "/users/tor/acrn/rls/pub/perl/missing";
    } else {
      # If none of the above then issue a warning
      warn "*** WARNING *** Unable to locate perl/missing.\n";
    }
  }
  # Keep this in case the missing libdb-3.3.a problem returns
  # chomp(my $HOSTNAME = `hostname`);
  # if ( $HOSTNAME =~ /^c1h/ or $HOSTNAME =~ /^c2h/ ) {
  #   # This is hadar or spica
  #   # Use the dummy version of DB_File found in missing dir
  #   unshift @INC, $MISSING;
  # } else {
  #   push @INC, $MISSING;
  # }
  push @INC, $MISSING;
}
use DB_File;
use Cwd;
use Sys::Hostname;
use Term::ReadLine;

require 5.003;
require Exporter;
require AutoLoader;

@ISA = qw(Exporter);
@EXPORT = qw(history);
$VERSION = '1.00';

sub history {
  # Append to the users command line history file, display
  # the contents of the history file on stdout or edit individual
  # commmand lines via readline.
  use strict;

  # Verify that DB_File is available, if not return undef.
  # DB_RECNO is a reference to a hash defined in the DB_File package.
  # A stub for the DB_File package will be loaded if the package
  # is not found on the invoking machine. This stub will define
  # DB_RECNO such that the following test is true.
  my $DB_test = ref $DB_RECNO;
  if ( $DB_test =~ /NOT_AVAILABLE/) {
    print "DB_File is not available on ",hostname(),"\n";
    return wantarray ? () : undef;
  };

  # $curr_cmd is the current command line as a single string
  my $curr_cmd = shift;

  my $OPTS = shift;

  my $verbose = 0;
  if (defined $OPTS->{VERBOSE}) {$verbose = $OPTS->{VERBOSE}};

  # $display_hist flags display of the history database on stdout
  my $display_hist = 0;
  if (defined $OPTS->{DISPLAY_HIST}) {$display_hist = $OPTS->{DISPLAY_HIST}};

  # $edit_hist flags editing previous command lines via readline
  my $edit_hist = 0;
  if (defined $OPTS->{EDIT_HIST}) {$edit_hist = $OPTS->{EDIT_HIST}};

  # $invoked_name is the name of the invoking shell script
  my $invoked_name = 'ccc-job-string';
  $invoked_name=$OPTS->{INVOKED_NAME} if defined $OPTS->{INVOKED_NAME};

  # $dbname is full path name of the data base file to be used
  # If this is not set then a default will be used
  my $dbname = '';
  if (defined $OPTS->{DBNAME}) {$dbname = $OPTS->{DBNAME}};

  if ($dbname) {
    # If this string is passed in then make sure it is
    # a regular file, if it exists.
    # The program will create it if it does not exist.
    if (-e $dbname and not -f $dbname) {
      die "The user specified data base file $dbname must be a regular file\n";
    };
  } else {
    # The command line history file will live in the directory
    # ~/cccjobs/history relative to the invoking users home dir
    my $HIST_DIR = (getpwuid($<))[7]."/cccjobs/history";
    unless (-d $HIST_DIR) {
      # Create the dir if it does not already exist
      my @cmd = ("mkdir", "-p", "$HIST_DIR");
      my $rc = 0xffff & system(@cmd);
      if ($rc != 0) {die "*** ERROR *** @cmd:  $!\n"};
      @cmd = ("chmod", "ug+rx", "$HIST_DIR");
      $rc = 0xffff & system(@cmd);
      if ($rc != 0) {die "*** ERROR *** @cmd:  $!\n"};
    };

    # database file full path name
    $dbname = "$HIST_DIR/clhist.db";
  };

  # the database will be tied to the @CLhist array, referenced as $hdb
  my @CLhist;

  # force big endian io
  # This is only required when the history database is binary.
  $DB_RECNO->{lorder} = 4321;

  if ($display_hist) {
    # display the command line history data base and return
    my $ret = display_history($dbname);
    return $ret;
  };

  if ($edit_hist) {
    # view/edit previously saved command lines via readline
    # and execute the resulting ccc-job-string command
    my $ret = edit_history($dbname,{INVOKED_NAME=>$invoked_name});
    return $ret;
  };

  # Add the current command line to the history database

  # open the history database for writing
  my $hdb = tie(@CLhist, 'DB_File', $dbname, O_RDWR|O_CREAT, 0640, $DB_RECNO)
    or die "Cannot open history file $dbname : $!\n";

  # Get a time stamp
  chomp(my $tstamp = `date '+%Y:%m:%d-%H:%M:%S'`);
  $tstamp .= '!';

  # Define a string containing user and hostname info
  my $host = hostname();
  my $pwd = cwd();
  my $id = (getpwuid($<))[0] . '@' . $host . ':' . $pwd . '!';

  # Append the current entry to the data base
  # The entry will consist of 3 fields separated by the '!' character
  my $entry = $tstamp . $id . $curr_cmd;
  $hdb->push($entry);

  # if there are more than a preset number of records in the database
  # then remove the oldest records until the preset limit is satisfied
  my $maxlen_hist = 5000;
  while ($hdb->length > $maxlen_hist) {
    last unless $hdb->shift;
  };

  # close the database
  undef $hdb;
  untie @CLhist;

  return 1;

};

sub display_history {
  # display the command line history data base and return
  use strict;

  # $dbname is the full pathname to the data base
  # file containing the command line history
  my $dbname = shift;
  unless (-s $dbname) {
    warn "*** WARNING *** Database file $dbname is missing\n";
    return 1;
  };

  my $OPTS = shift;

  my $verbose = 0;
  if (defined $OPTS->{VERBOSE}) {$verbose = $OPTS->{VERBOSE}};

  # the database will be tied to the @CLhist array, referenced as $hdb
  my @CLhist;

  # open an existing history database
  my $hdb = tie(@CLhist, 'DB_File', $dbname, O_RDWR, 0640, $DB_RECNO)
    or die "Cannot open history file $dbname : $!\n";

  # Pipe output through a pager if one is available
  my $prev_output_fh;
  my $pager = "less";
  # It is nessecary to copy stderr to stdout for less -V because
  # certain versions of less (e.g. the version on pollux) direct
  # the output from -V to stderr rather than stdout
  chomp(my $less_v = `less -V 2>&1`);
  unless ($less_v =~ /^\s*less /) {
    # assume that either the program specified by PAGER or
    # the pager more exists on the invoking machine
    unless ($pager = $ENV{PAGER}) {$pager = "more"};
  };
  if ($pager) {
    # only pipe to a pager if one is available
    open(PG_PIPE,"|$pager");
    $prev_output_fh = select;
    select PG_PIPE;
    $| = 1; # set autoflush for PG_PIPE
  };

  foreach my $i (0 .. $hdb->length - 1) {
    my ($ts, $id, $cl) = split('!',$CLhist[$i],3);
    printf "%s %s\n%4d) %s\n\n", $ts, $id, $i+1, $cl;
  };

  close(PG_PIPE);

  # Reset stdout and close history database
  if ($prev_output_fh) {select $prev_output_fh};
  undef $hdb;
  untie @CLhist;

  # return true
  return 1;
};

sub edit_history {
  # view/edit previously saved command lines via readline
  # and execute the resulting ccc-job-string command
  use strict;

  # $dbname is the full pathname to the (ascii) data base
  # file containing the command line history
  my $dbname = shift;

  my $OPTS = shift;

  my $verbose = 0;
  if (defined $OPTS->{VERBOSE}) {$verbose = $OPTS->{VERBOSE}};

  # $invoked_name is the name of the invoking shell script
  my $invoked_name = 'ccc-job-string';
  $invoked_name=$OPTS->{INVOKED_NAME} if defined $OPTS->{INVOKED_NAME};

  my $term = new Term::ReadLine 'CCCJOBS';
  my $OUT  = $term->OUT || \*STDOUT;
  my $IN   = $term->IN  || \*STDIN;

  # determine feature available
  my $rlf = $term->Features;
  # turn off ornamentation of readline prompt
  if (defined $$rlf{ornaments}) {$term->ornaments(0)};
  if (0) {
    foreach (keys %$rlf) {
      print "Feature: $_  $$rlf{$_}\n";
    };
  };
  if (defined $$rlf{attribs}) {
    # determine attributes
    my $rla = $term->Attribs;
    if (0) {
      if (%$rla) {
        foreach (keys %$rla) {
          print "Attribute: $_  ";
          if (defined $$rla{$_}) {
            print "$$rla{$_}\n";
          } else {
            print " undef\n";
          };
        };
      };
    };
  };

  # determine which readline package we have
  my $rlp = $term->ReadLine;
  my $rl_Gnu  = $rlp =~ /::Gnu$/;
  my $rl_Perl = $rlp =~ /::Perl$/;
  my $rl_Stub = $rlp =~ /::Stub$/;
  if ($rl_Stub) {
    die "ReadLine support is not available on ",hostname(),"\n";
  };

  # Read previous command line history into the readline history buffer
  # Keep a local copy in @phist for display upon request
  my @phist;
  if (-s $dbname) {
    open (my $newIN, "cat $dbname|awk -F'!' '{print \$3}' -|");
    open (my $newOUT, ">/dev/null");
    $term->newTTY($newIN,$newOUT);
    while (defined($_ = $term->readline(" ")) ) {
      push @phist,$_;
    };
    close($newIN);
    close($newOUT);
    $term->newTTY($IN,$OUT);
  } else {
    warn "*** WARNING *** Database file $dbname is missing\n";
  };

  # Print a brief explanation of the interface
  print <<EOR;
To edit previous $invoked_name command lines:
 -- Use up and down arrows to navigate through the command line history.
 -- Use emacs style edit commands to modify the line.
 -- Execute the command by hitting ENTER.
 -- View the history by typing "h" possibly followed by an integer or
    a pair of integers separated by a "-". These integers indicate the
    number of recent, or a range of, commands to view.
 -- A limited number of shell commands are also available.
    Simply enter them after the prompt.
 -- The number that appears in the prompt is the number of commands currently
    available in the history database, up to the maximum size of 5000.
 -- You can terminate the session by typing "exit", "quit" or "x".
EOR

  my $line = scalar(@phist);
  my $cmd;
  # define a list of commands that will cause an exit from
  # the readline loop
  my %exit_cmds;
  $exit_cmds{exit}=1;
  $exit_cmds{quit}=1;
  $exit_cmds{x}=1;
  while (defined($cmd = $term->readline("CCCJOB ${line}% ")) ) {
    $cmd =~ s/^\s+|\s+$//g;     # trim leading/trailing whitespace
    next unless $cmd;          # skip blank lines

    # check for one of the exit commands, partial matches allowed
    my $pat = quotemeta ((split(/\s+/, $cmd))[0]);
    my @hits = grep (/^$pat/, keys %exit_cmds);
    if (scalar(@hits) >= 1) {
      # This is an exit command... get out with cmd undefed
      undef $cmd;
      last;
    };

    if ($cmd =~ /^h\s*[0-9]*[-]?[0-9]*\s*$/i) {
      # display previous command lines
      my $i1 = $#phist-9>-1 ? $#phist-9 : 0;
      my $i2 = $#phist;
      my ($h) = $cmd =~ /^h\s*([0-9]*[-]?[0-9]*)/i;
      if ($h =~ /^[0-9]+$/) {
        $i1 = $#phist-$h+1>-1 ? $#phist-$h+1 : 0;
      } elsif ($h =~ /\-/) {
        my ($h1) = $h =~ /([0-9]*)\-/;
        my ($h2) = $h =~ /\-([0-9]*)/;
        if ($h1) {$i1 = $h1-1} else {$i1 = 0};
        if ($h2) {$i2 = $h2-1} else {$i2 = $#phist};
        $i2 = $#phist if $i2 > $#phist;
        $i2 = 0 if $i2 < 0;
        $i1 = 0 if $i1 < 0;
        $i1 = $#phist if $i1 > $#phist;
        if ($i1>$i2) {$i1=$i2};
      };
      for ($i1..$i2) {print 1+$_," % $phist[$_]\n"};
    } elsif ($cmd =~ /^!/) {
      # execute a perl command
      my $pcmd = substr $cmd, 1;
      print "pcmd:: $cmd\n";
      eval qq(
       package perlcmd; no strict; \$save = select(STDOUT);
       \$res = do {$pcmd}; select \$save; \$res
      );
      print $@ if $@;
      print "\n";
    } elsif ($cmd =~ /^$invoked_name/) {
      # When ready to execute the script we terminate readline
      # and exec a replacement process
      undef $term;
      exec $cmd or die "Can't exec $cmd\n $!\n";
    } else {
      # execute a system (shell) command
      my $rc = 0xffff & system $cmd;
      if ($rc != 0) {warn "*** ERROR *** ${cmd}\n"};
    };
  };

  undef $term;
  return wantarray ? () : undef;
};

1;