# NF::DBI::Repl.pm -- read/eval/print loop for interacting with RDBMs
# Author: Noah Friedman <friedman@splode.com>
# Created: 1999-11-17
# Public domain.

# $Id: Repl.pm,v 1.4 2000/03/01 09:59:47 friedman Exp $

# Commentary:
# Code:

package NF::DBI::Repl;

use NF::DBI::Format;
use Symbol;
use strict;

use Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
$VERSION     = 1.00;
@ISA         = qw(Exporter);
@EXPORT      = qw(repl);
@EXPORT_OK   = qw(repl_eval_print
                  repl_read
                  repl_eval
                  repl_print
                  repl_print_rows
                  repl_open_history_log
                  repl_write_history_entry
                  repl_enable_input_line_number_tracking
                  repl_disable_input_line_number_tracking
                  repl_reset_input_line_number_tracking);


# Forward-declarations for prototyping.
sub repl_eval_print ($$);
sub repl_read (;$$);
sub repl_eval ($$);
sub repl_print ($);
sub repl_print_error ($);
sub repl_print_rows ($;$);
sub repl_open_history_log (;$);
sub repl_write_history_entry ($$;$);
sub repl_enable_input_line_number_tracking ();
sub repl_reset_input_line_number_tracking ();


# Disabled by default.
my $repl_input_line_number = undef;

use vars qw($repl_interactive_history_log
            $repl_interactive_history_log_filter_repeated_input
            $repl_interactive_history_log_concatenate_multilines);
$repl_interactive_history_log = undef;
$repl_interactive_history_log_filter_repeated_input = 1;
$repl_interactive_history_log_concatenate_multilines = 1;


sub repl ($;$$$)
{
  my ($dbh, $prompt, $batch_echo_p, $histfile) = @_;
  my $hfh;

  if (-t 0)
    {
      $SIG{INT} = sub { die "SIGINT"; };
      $hfh = repl_open_history_log ($histfile);
    }
  else
    {
      repl_enable_input_line_number_tracking ();
    }

  my $lastinput;
  while (1)
    {
      my $result =
        eval
          {
            my $input = repl_read ($prompt, $batch_echo_p);
            return undef if (!defined $input);
            $lastinput = repl_write_history_entry ($hfh, $input, $lastinput);
            repl_eval_print ($dbh, $input);
          };
      last if (!defined $result && (!defined $@ || $@ eq ''));
      next unless (defined $@ && $@ ne '');
      if ($@ =~ /^SIGINT /o)
        {
          print "\n-- [interrupted] --\n";
        }
      else
        {
          print STDERR $@;
          last;
        }
    }
  close ($hfh) if (defined $hfh);
}


sub repl_eval_print ($$)
{
  my ($dbh, $input) = @_;
  my $sth = repl_eval ($dbh, $input);
  repl_print ($sth);
  $sth->finish;
}


sub repl_read (;$$)
{
  my ($prompt, $batch_echo_p) = @_;
  my $interactivep       = 1 if (-t 0);
  my $batch_echo_input_p = 1 if ($batch_echo_p && !$interactivep);
  my $promptp            = 1 if ($batch_echo_p || $interactivep);
  my $input;
  my ($readmore) = 1;

  $prompt = "repl> "
    if ($promptp && ! $prompt);

  while ($readmore)
    {
      print $prompt if ($interactivep);

      $_ = <STDIN>;
      last if (!defined $_);

      $repl_input_line_number++
        if (defined $repl_input_line_number);

      chop;
      s/--.*//o;       # strip comments
      s/[ \t\f]+$//o;  # strip trailing whitespace and form feeds

      next if ($_ eq '' && !defined $input);

      print $prompt if (!$interactivep && $batch_echo_p);
      print $_, "\n"  if $batch_echo_input_p;

      $input .= "\n" if (defined $input);
      $input .= "$_";
      $readmore = 0 if (/;/o);

      $prompt = sprintf ("%" . length ($prompt) . "s",
                         $interactivep? "-> " : "   ")
        if ($prompt && $readmore);
    }
  print "\n"
    if (! defined ($_) && $promptp);
  return $input;
}

sub repl_eval ($$)
{
  my ($dbh, $input) = @_;
  my $sth = $dbh->prepare ($input);
  $sth->execute;
  return $sth;
}

sub repl_print ($)
{
  my ($sth) = @_;

  return repl_print_error ($sth) if ($sth->err);
  repl_print_rows ($sth);
}


sub repl_print_error ($)
{
  my ($sth) = @_;
  my $err    = $sth->err;
  my $errstr = $sth->errstr;
  my $lineno = $repl_input_line_number
    if (defined $repl_input_line_number);
  my $msg;

  $errstr =~ s/\\/\\\\/go;
  $errstr =~ s/\n/\\n/go;

  if ($errstr =~ / at line [0-9]+$/o)
    {
      $lineno = $errstr;
      $lineno =~ s/.*at line ([0-9]+)$/$1/o;
      $errstr =~ s/ at line [0-9]+$//o;

      if (defined $repl_input_line_number)
        {
          my $input = $sth->{Statement};
          my $input_linecount = 1;
          my $pos = -1;

          $input_linecount++
            while (($pos = index ($input, "\n", $pos+1)) != -1);

          $lineno = $repl_input_line_number - $input_linecount + $lineno;
        }
    }

  $msg = sprintf ("error(%d):line %d", $err, $lineno) if (defined $lineno);
  $msg = sprintf ("error(%d)", $err) unless (defined $msg);
  printf (STDERR "-- %s: %s.\n", $msg, $errstr);
  return;
}

sub repl_print_rows ($;$)
{
  my ($sth, $fh) = @_;

  if (! defined ($sth->{NAME}))
    {
      # sth was not a select statement
      $fh ||= *STDOUT{IO};
      print $fh $sth->rows, " rows affected.\n" if (-t 0);
    }
  elsif ($sth->rows > 0)
    {
      my $r = NF::DBI::Format->new;
      my $ref;

      $r->header ($sth, $fh);
      $r->row ($ref) while ($ref = $sth->fetchrow_arrayref);
      $r->trailer ();
    }
  else
    {
      $fh ||= *STDOUT{IO};
      print $fh "0 rows selected.\n" if (-t 0);
    }
}


sub repl_disable_stdio_buffering
{
  for my $handle (@_)
    {
      my $orig_handle = select ($handle);
      $| = 1;
      select ($orig_handle);
    }
}

sub repl_open_history_log (;$)
{
  my $file = $_[0] || $repl_interactive_history_log;
  return unless (defined $file && $file ne '');
  my $fh = gensym;
  if (open ($fh, ">>$file"))
    {
      repl_disable_stdio_buffering ($fh);
      return $fh;
    }
  return undef;
}

sub repl_write_history_entry ($$;$)
{
  my $fh = $_[0];

  if (defined $fh)
    {
      my $line      = $_[1];
      my $lastinput = $_[2];

      $line =~ s/\n/ /go
        if ($repl_interactive_history_log_concatenate_multilines);

      print $fh $line, "\n"
        unless ($repl_interactive_history_log_filter_repeated_input
                && defined $lastinput
                && $line eq $lastinput);
      return $line;
    }
  return undef;
}


# This will enable line number tracking but will not reset the count if it
# was already enabled.
sub repl_enable_input_line_number_tracking ()
{
  $repl_input_line_number = 0 unless (defined $repl_input_line_number);
}

# This resets the count but only if already enabled.
sub repl_reset_input_line_number_tracking ()
{
  $repl_input_line_number = 0 if (defined $repl_input_line_number);
}

sub repl_disable_input_line_number_tracking ()
{
  undef $repl_input_line_number;
}

1;