package DBIShell;

#  dbishell: A generic database shell based on the Perl DBI layer
#  Copyright (C) 2000  Vivek Dasmohapatra (vivek@etla.org)

#  This program is free software; you can redistribute it and/or
#  modify it under the terms of the GNU General Public License
#  as published by the Free Software Foundation; either version 2
#  of the License, or (at your option) any later version.

#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.

#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

use integer;

#::use lib '<%LDIR%>';

use 5.004;
use strict;
use Fcntl qw(:DEFAULT :flock);
use DBIShell::UTIL qw(:DEFAULT :pwent :readmode :stat :context unslash);
use DBIShell::Help;
use DBIShell::Term_CTL ();
use Exporter       ();
use Getopt::Long   ();
use DBIShell::Readline ();
use DBIShell::Fixup;

use IO::Seekable;

use vars qw($VERSION @EXPORT @EXPORT_OK %EXPORT_TAGS @ISA);
use vars qw(@const *FH *SFH *PAGER $CUR_EOL);

use subs qw|connect readline($;$)|;

use constant WINDOWING => (($ENV{TERM} =~ /xterm|rxvt/i) && -t(*STDERR));

use constant TMPDIR  => 'draft';
use constant HISTORY => 'history';
use constant RCFILE  => 'rc';

use constant HOOK_ANTE => 0;
use constant HOOK_POST => 1;

use constant DBIOPT_NAME  => 0;
use constant DBIOPT_PRMT  => 1;
use constant DBIOPT_MODE  => 2;
use constant DBI_OPT_SPEC =>
  (
   [ driver => "DBI Driver: (eg Oracle): ",       READMODE_NORMAL ],
   [ dsn    => "DSN String: (see dbishell -h): ", READMODE_NORMAL ],
   [ user   => "User Name: ",                     READMODE_NORMAL ],
   [ pass   => "Password: ",                      READMODE_NOECHO ],
  );

use constant GETOPT_OPTS =>
  qw(auto_abbrev no_getopt_compat require_order bundling);

use constant GETOPT_SPEC =>
  ('driver=s' ,                # DBIShell driver
   'dsn:s',                    # dsn [The bit after 'dbi:<DRIVER>:' ]
   'user|u:s' ,                # database user name
   'pass|passwd|password|p:s', # database password
   'noconn|x' ,                # don't connect to start with [broken?]
   'help|h'   ,                # print the help and exit
   'shell-driver=s',           # DBIShell driver to use if using driver=Proxy
                               # or driver=ODBC
   'intp|interpolate|interpolation!',
   'escp|escape|escaping!',
   'dotdir=s'
  );

SEQUENCE:
{
    my $seqno = 0;
    sub seqno () { $seqno++ }
}

DBIShell::Fixup::patch( 'Getopt::Long' );
Getopt::Long::Configure( GETOPT_OPTS );

@const =
  qw(
     DBIOPT_NAME
     DBIOPT_PRMT
     DBIOPT_MODE
     DBI_OPT_SPEC
     GETOPT_OPTS
     GETOPT_SPEC
    );

$VERSION     = 0.01_59;
@EXPORT      = ();
@EXPORT_OK   = (@const);
%EXPORT_TAGS = (const   => \ @const);
@ISA         = qw(Exporter);

sub error ($) { $_[0]->{ERROR} }
sub errno ($) { $_[0]->{ERRNO} }

sub readline ($;$)
{
    my $sh    = shift(@_);
    my $line  = $sh->{TERM}->readline($_[0]);
    foreach my $k (keys(%{$sh->{SPOOL}{IN}}))
    {
	my $fh = $sh->{SPOOL}{IN}{$k};
	print($fh $line,$/);
    }
    #warn("returning \$line\n");
    return $line;
}

sub outputf ($$;@)
{
    my $sh = shift(@_);
    my $ct = shift(@_); # unused context parameter

    printf({ $sh->{OUTFH} } @_);
    foreach my $k (keys(%{$sh->{SPOOL}{OUT}}))
    {
	my $fh = $sh->{SPOOL}{OUT}{$k};
	printf($fh @_);
    }
}

sub errputf ($$;@)
{
    my $sh = shift(@_);
    my $ct = shift(@_); # unused context parameter

    printf({ $sh->{ERRFH} } @_);
    foreach my $k (keys(%{$sh->{SPOOL}{ERR}}))
    {
	my $fh = $sh->{SPOOL}{ERR}{$k};
	printf($fh @_);
    }
}

# sub _strip_eol_from_history ($)
# {
#     my $sh   = $_[0];
#     my $ceol = $sh->getvar( EOL => '/' );
#     my $trlo = $sh->{TERM};
#
#     my @hist = $trlo->get_history();
#
#     if( $ceol ne '/' )
#     {
# 	foreach ( @hist )
# 	{
#  	    my $ep = -1;
#  	    s/\s*$//;
#  	    $ep = rindex( $_, $CUR_EOL );
#  	    if( ($ep > -1) && (substr($_, -length($CUR_EOL)) eq $CUR_EOL) )
#  	    {
#  		substr( $_, $ep, length($CUR_EOL), '' );
#  	    }
#  	}
#     }
#     else
#     {
#  	foreach ( @hist )
#  	{
#  	    s|^/\s*$||;
#  	    s|([^*\\])/\s*$|$1|;
#  	}
#     }
#
#     $trlo->set_history( @hist );
# }

# sub _setv_eol_hook_ante ($$$)
# {
#     my $sh   = $_[0];
#     my $name = $_[1];
#     my $neol = $_[2];
#
#     $sh->_strip_eol_from_history();
# }

sub _setv_eol_hook_post ($$$)
{
    my $sh   = $_[0];
    my $name = $_[1];
    my $ceol = $_[2];

    $CUR_EOL = defined($ceol) ? $ceol : DEOL;
}

sub _obj_struct (;$)
{
    return
    {
     TMPQ   => 0,              # skip the next output?
     VAR    => {
		'^parameters'  => [],
		'^param_names' => [],
		'^param_io'    => []
	       }, # SQL parameter stack
     ERRNO  => 0,              # errno
     ERROR  => '',             # errstr (cf. strerror)
     OPT    => {
		intp => 1,
		escp => 1
	       },              # getopt storage
     ACMT   => [],             # command line accumulator
     TERM   => undef(), # readline object;
     OUTFH  => undef(),
     ERRFH  => undef(),
     INFH   => undef(),
     SPOOL  => {               #\
		OUT => {},     # |
		ERR => {},     # |) i/o/e stream map for spool functionality
		IN  => {}      # |
	       },              #/
     ENGINE => undef(),        # the thing that actually knows about the DB
     PAGER  => 0,              # is the pager active right now?
     CMDBUF => [],
     CMDLIM => 100,
     IN_SCRIPT    => 0,        # number of calls to exec_script in progress
     ADDHISTORY   => undef(),  # function to call to get lines into history
     LAST_QUERY   => undef(),
     DFLT_SIGPIPE => $SIG{PIPE},
     LAST_TITLE   => undef(),
     ORIG_TITLE   => undef(),
     ORIG_ITITLE  => undef(),
     SETV_HOOKS   => {},
     QUIT         => 0,
    };
}

sub new ($)
{
    my $sh;
    my $package = ref($_[0]) ? ref(shift(@_)) : $_[0];

    $sh         = _obj_struct();
    $sh->{TERM} = DBIShell::Readline->new('dbishell'); # readline object;

    $sh->{OUTFH} = $sh->{TERM}->OUT() || *STDOUT;
    $sh->{ERRFH} = *STDERR;
    $sh->{INFH}  = $sh->{TERM}->IN()  || *STDIN;

    $sh->{SETV_HOOKS}{EOL} ||= [];
    #$sh->{SETV_HOOKS}{EOL}[ HOOK_ANTE ] = \&_setv_eol_hook_ante;
    $sh->{SETV_HOOKS}{EOL}[ HOOK_POST ] = \&_setv_eol_hook_post;

    # unbuffer the output handles:
    select((select($sh->{OUTFH}),$|=1)[0]);
    select((select($sh->{ERRFH}),$|=1)[0]);

    bless($sh, $package);

    $sh->set_dotdir();

    # set up some of the more important variables so that
    # tab completion can find them.
    $sh->setvar("CASE_SENSITIVE=0");
    $sh->setvar("PRESCAN_ROWS=0");
    $sh->setvar("TRUNCATE_COLUMN_NAMES=0");
    $sh->setvar("PAGING=1");
    $sh->setvar("PAGE_SIZE=0");
    $sh->setvar("FIELD_SEPARATOR=|");

    # some other initialisation:
    $sh->init_rl_package();

    return $sh;
}

sub init_rl_package ($)
{
    my $sh  = shift(@_);

    # we can capture multiline commands neatly with GRL, as well as
    # filtering out duplicate queries - but in order to do so, we should
    # turn ordinary auto-history off:
    if ( defined($sh->{TERM}->auto_history(FALSE)) )
    {
	$sh->{ADDHISTORY} =
	  sub
	  {
	      my $q;
	      ( $q = $_[0] ) =~ s([\r\n]+)[\\n]g;
	      if ( $q ne $sh->{LAST_QUERY} )
	      {
		  $sh->{TERM}->add_history( $sh->{LAST_QUERY} = $q );
	      }
	  };
    }
    else
    {
	$sh->{ADDHISTORY} = undef();
    }

    eval
    {
	my $fn;
	my $fcw;
	my $rl = $sh->{TERM};
	# set up the tab completion function:
	# WARNING: we have to use a closure here, because readline
	# uses callbacks to let you customise tab completion,
	# and we need to pass in extra state:
	$fn = sub { $sh->complete($_[0],$_[1],$_[2]) };
	$rl->set_completion_function( $fn );
	$rl->set_signal_handlers();
	$fcw =
	  sprintf('FUSSY_COMPLETION_WORKAROUND=%d', $rl->fussy_completion());
	$sh->setvar( $fcw );
    };

    if( $@ ) { $sh->errputf(CONTEXT_NIL, '%s', $@) }
}

sub add_command ($$)
{
    my $sh  = $_[0];
    my $cmd = $_[1];

    # edit itself shouldn't make it into the command buffer, as it is a meta
    # command.
    $cmd =~ /^\s*edit\b/ && return;

    my $buf = $sh->{CMDBUF};
    my $lim = $sh->{CMDLIM};

    if(@{$buf} >= $lim) { shift(@{$buf}); push(@{$buf}, $cmd) }
    else                { push(@{$buf}, $cmd)                 }
}

sub command ($$)
{
    my $sh = $_[0];
    my $n  = abs(int($_[1]));

    my $buf = $sh->{CMDBUF};
    my $pos = $#{$buf} - $n;

    if($pos >= 0){ return $buf->[$pos]                   }
    else         { return "/* command [$pos] empty */\n" }
}

sub paging ($$)
{
    my $sh   = $_[0];
    my $rows = int(($_[1] > 0) ? $_[1] : 0);
    my $size =
      $sh->getvar('PAGE_SIZE') || (DBIShell::UTIL::term_size())[1];

#    warn("PAGE_SIZE   = $size\n");
#    warn("DATA_LENGTH = $rows\n");

    return ($sh->getvar('PAGING', 0) && (($rows > $size) || !$rows)) ? 1 : 0;
}

#sub outfh ($) { (@_ > 1) ? $_[0]->{OUTFH} = $_[1] : $_[0]->{OUTFH} }
#sub errfh ($) { (@_ > 1) ? $_[0]->{ERRFH} = $_[1] : $_[0]->{ERRFH} }
#sub infh  ($) { (@_ > 1) ? $_[0]->{INFH}  = $_[1] : $_[0]->{INFH}  }

sub start_pager ($$)
{
    local(*PAGER);
    my $sh = $_[0];
    my $n  = $_[1];

    $sh->paging($n) || return; #if paging is not required, do nothing
    $sh->{PAGER}    && return; #if paging has been started, do nothing.

    my $pager = $sh->getvar('PAGER',undef()) || $ENV{PAGER} || 'less -S';

    if(open(*PAGER, "|$pager"))
    {
	$sh->{DFLT_SIGPIPE} = $SIG{PIPE};
	$SIG{PIPE} = 'IGNORE';
	select((select(*PAGER),$|=1)[0]);
	$sh->{PAGER} = 1;
	$sh->{OUTFH} = *PAGER;
	$sh->{ERRFH} = *PAGER;
    }
}

sub stop_pager ($)
{
    my $sh = $_[0];

    if($sh->{PAGER})
    {
	local(*PAGER);
	*PAGER = $sh->{OUTFH};
	$sh->{OUTFH} = $sh->{TERM}->OUT() || *STDOUT;
	$sh->{PAGER} = 0;
	$sh->{ERRFH} = *STDERR;
	close(*PAGER);
	$SIG{PIPE}   = $sh->{DFLT_SIGPIPE};
    }
}

sub set_dotdir ($)
{
    my $sh  = shift(@_);
    my $opt = $sh->{OPT};
    my $tmpdir;

    unless($opt->{dotdir})
    {
	my $uid = $<;
	$opt->{dotdir} =
	  join('/',(getpwuid($uid))[PWENT_DIR],'.dbishell');
    }

    $tmpdir = join('/',$opt->{dotdir}, TMPDIR);

    unless(-d($tmpdir))
    {
	unless(-d($opt->{dotdir}))
	{
	    unless(mkdir($opt->{dotdir}, 0700))
	    {
		$sh->{ERRNO} = $!;
		$sh->{ERROR} = "Failed to create dotdir $opt->{dotdir}";
		return undef();
	    }
	}

	unless(mkdir($tmpdir, 0700))
	{
	    $sh->{ERRNO} = $!;
	    $sh->{ERROR} = "Failed to create tmpdir $tmpdir";
	    return undef();
	}
    }
}

# read in the command line options:
sub getopts ($;@)
{
    my $sh = shift(@_);
    grep { s/^--?no-/--no/ } @ARGV;
    Getopt::Long::GetOptions($sh->{OPT}, GETOPT_SPEC);
}

sub disconnect ($)
{
    my $sh  = shift(@_);

    if($sh->{ENGINE}) { $sh->{ENGINE}->disconnect() }

    $sh->set_dot_history();          # flush history to a dot file
    $sh->{ENGINE} = undef();         # kill any old objects
    $sh->set_dbi_nullp_parameters(); # zap the connect parameters
    $sh->connect()                   # connect to the NullP driver
      || $sh->errputf(CONTEXT_NIL, "%s\n",$sh->error);
}

sub reconnect ($;@)
{
    my $sh = shift(@_);
    my @new_conn_args = @_;
    
    $sh->set_dot_history();
    if($sh->{ENGINE}) { $sh->{ENGINE}->disconnect() }
    $sh->{ENGINE} = undef();

    foreach my $thing (DBI_OPT_SPEC)
    {
	my $key = $thing->[DBIOPT_NAME];
	$sh->{OPT}{$key} = shift(@new_conn_args);
    }

    $sh->connect()
      || $sh->errputf(CONTEXT_NIL, "%s\n",$sh->error);
}

sub spool ($$)
{
    my @stream;
    my $sh= shift(@_);
    my($stream,$target,$on)  = split(/\s+/,$_[0]);

    #warn('($stream,$target,$on) == ',"($stream,$target,$on)\n");

    unless(length($on)) { $on = 1            }
    else                { $on = IS_TRUE($on) }

    #warn('($stream,$target,$on) == ',"($stream,$target,$on)\n");

    $stream =~ /\b(?:i|(?:std)?in|input)\b/i   && push(@stream, 'IN');
    $stream =~ /\b(?:o|(?:std)?out|output)\b/i && push(@stream, 'OUT');
    $stream =~ /\b(?:e|(?:std)?err|error)\b/i  && push(@stream, 'ERR');

    eval
    {
	unless (@stream)
	{
	    die("spool error: no valid streams specified [$stream]\n");
	}

	if ($on)
	{
	    my $sfh = local(*SFH);
	    sysopen($sfh, $target, O_WRONLY|O_CREAT|O_APPEND, 0640)
	      || die("spool error on sysopen: $!\n");
	    select((select($sfh),$|=1)[0]);
	    foreach my $S (@stream)
	    {
		$sh->{SPOOL}{$S}{$target} ||= $sfh
	    }
	}
	else
	{
	    foreach my $S (@stream)
	    {
		if    (lc($target) eq 'off') { %{$sh->{SPOOL}{$S}} = () }
		elsif (exists($sh->{SPOOL}{$S}{$target}))
		{
		    delete($sh->{SPOOL}{$S}{$target});
		    $sh->errputf(CONTEXT_NIL,
				 "Removed %s from %s spool\n",
				 $target,
				 $S
				);
		}
	    }
	}
    };

    if($@)
    {
	$sh->{ERRNO}       = -1;
	chomp($sh->{ERROR} = $@);
	return 0;
    }

    return 1;
}

sub exec_command ($)
{
    my $i;
    my $q;
    my $eol;
    my $sh = shift(@_);

    # trim eol character(s) from the accumulator:
    if( defined( $eol = $sh->getvar('EOL', undef()) ) )
    {
	my $l = length( $eol );
	$sh->{ACMT}[ $#{$sh->{ACMT}} ] =~ s/\s*$//;
	if( substr( $sh->{ACMT}[ $#{$sh->{ACMT}} ], -$l ) eq $eol )
	{
	    substr( $sh->{ACMT}[ $#{$sh->{ACMT}} ], -$l, $l, '' );
	}
    }
    else
    {
	$sh->{ACMT}[ $#{$sh->{ACMT}} ] =~ s/\/\s*$//;
    }

    #construct+store query 
    $q = join($/, @{ $sh->{ACMT} });

    #empty accumulator
    @{ $sh->{ACMT} } = ();

    # nothing to see here, move along:
    $q =~ /\S/ || return 1;

    # store the command in the edit stack:
    $sh->add_command($q);

    # if we are NOT in a script, and we have a history filter,
    # put the filtered command into the history.
    # Note that autohistory should be disabled, or at least sidestepped
    # if the filter is in effect (currently we use MinLine to do this).
    # (always put the default EOL seq into the history)
    if ( !$sh->{IN_SCRIPT} && $sh->{ADDHISTORY} )
    {
	$sh->{ADDHISTORY}->( $q . DEOL );
    }

    # special case:
    if($q =~ /^\s*quit\b/si) { return $sh->{QUIT} = 1 }

    if ( !defined($i) ) { $i = $sh->pre_interpret($q)  }
    if ( !defined($i) ) { $i = $sh->interpret($q)      }
    if ( !defined($i) ) { $i = $sh->post_interpret($q) }

    # if we asked for temporary silence, unset the silence flag,
    # then bail out of this iteration
    if ($sh->{TMPQ}) { $sh->{TMPQ} = 0; return $i }

    if ( $i ) { $sh->errputf(CONTEXT_NIL, "\n%s : success\n", $q) }
    else
    {
	$sh->errputf(CONTEXT_NIL, "\n%s : error: <%s>\n", $q, $sh->error());
    }

    return $i;
}

# remember to increment the in script counter on entry,
# and decrement it at each exit point:
sub exec_script ($$)
{
    local(*SFH);
    my $sh   = shift(@_);
    my $file = shift(@_);
    my $nocl = 0;
    my $sfh;

    if(ref(\$file) eq 'GLOB')
    {
	eval
	{
	    stat($file)    || die("$!\n");
	    -r(_)          || die("Not Readable\n");

	    $nocl = 1;
	    $sfh  = $file;
	};
    }
    else
    {
	eval
	{
	    stat($file)    || die("$!\n");
	    -r(_)          || die("Not Readable\n");
	    -p(_) || -T(_) || die("Not a pipe or text file\n");

	    sysopen(*SFH, $file, O_RDONLY)
	      || die("open failed: $!\n");

	    $nocl = 0;
	    $sfh  = *SFH;
	};
    }

    if ($@) { chomp($sh->{ERROR} = $@); return 0 }

    if($sfh)
    {
	my $I = 1;
	my($eol);
	my($q,$i);

	$sh->{IN_SCRIPT}++;

      SCRIPT_LINE:
	while(defined($q = CORE::readline($sfh)))
	{
	    chomp($q);

	    # ignore leading blank lines only:
	    (scalar(@{$sh->{ACMT}}) == 0)
	      && ($q !~ /\S/)
		&& next SCRIPT_LINE;

	    # store the line
	    push(@{$sh->{ACMT}}, $q);

	    # did we terminate the command?
	    $sh->is_terminated($q) || next SCRIPT_LINE;

	    $i = $sh->exec_command();

	    if ( $sh->{QUIT} ) { $sh->{IN_SCRIPT}--; return $sh->{QUIT} }

	    if ( $sh->{TMPQ} ) { $sh->{TMPQ} = 0; next SCRIPT_LINE }

	    $I = $i ? 1 :  0;
	}

	# allow the last line to be unterminated:
	if( @{$sh->{ACMT}} )
	{
	    $i = $sh->exec_command();

	    if ( $sh->{QUIT} ) { $sh->{IN_SCRIPT}--; return $sh->{QUIT} }

	    if ( $sh->{TMPQ} ) { $sh->{TMPQ} = 0; next SCRIPT_LINE }

	    $I = $i ? 1 : 0;
	}

	$nocl || close($sfh);
	$sh->{IN_SCRIPT}--;

	return $I;
    }
}

sub read_rc_script ($)
{
    local(*FH);

    my $sh     = shift(@_);
    my $dotdir = $sh->{OPT}{dotdir};
    my $rcfile = $sh->dotfile(RCFILE);

    unless(-f($rcfile))
    {
	my $sd_cache = $sh->{OPT}{'shell-driver'};
	$sh->{OPT}{'shell-driver'} = 'DEFAULT';
	$rcfile = $sh->dotfile(RCFILE);
	$sh->{OPT}{'shell-driver'} = $sd_cache;
    }

    if (-f($rcfile))
    {
	if(sysopen(*FH, $rcfile, O_RDONLY))
	{
	    eval
	    {
		my $uid;
		my $perm;
		my @rcstat;

		@rcstat = stat(*FH);

		$perm = $rcstat[STAT_MODE] & STAT_PERM_MASK;
		$uid  = $rcstat[STAT_UID];

		# uid must be correct.
		($uid  != $> ) && die("rc file not owned by current UID\n");
		# g+w and o+rw perms not allowed
		($perm & 0026) && die("rc file has lax permissions\n");
	    };


	    if($@)
	    {
		chomp($sh->{ERROR} = $@);
		return 0;
	    }

	    return $sh->exec_script(*FH);
	}
	else
	{
	    $sh->{ERROR} = "$!";
	    $sh->{ERRNO} = int($!);
	    return 0;
	}
    }
    else
    {
	return 1;
    }
}

sub set_show_var ($$)
{
    my $sh = shift(@_);
    my $d  = shift(@_);

    my($k, $rv) = $sh->setvar($d);

    if (!$@ && $k)
    {
	$sh->outputf(CONTEXT_NIL, "%s=%s\n", $k, $rv);
	return $sh->{TMPQ} = 1;
    }

    return 0;
}

sub setvar ($$$)
{
    use constant DBI_ATTR_EEK => <<DbiAttrEek;

You can't just waltz in and delete dbi handle attributes:
All sorts of horrible things could happen!

FNORD!

DbiAttrEek

    use constant GRL_ATTR_EEK => <<GRLEEK;

Deletion of GRL Attributes disallowed.

GRLEEK

    my $k;
    my $rv;
    my $hook;
    my $sh = shift(@_);
    my $d  = shift(@_);
    my $nv = shift(@_);
    my $v  = $sh->{VAR};

    # this method gets called during the instantiation of a
    # new DBIShell::dr::DEFAULT object, so there may not be
    # a $sh->{ENGINE} here yet:
    my $h  = eval { $sh->{ENGINE}->dbh() };

    if ($d =~ /^(?:env:|grl:|dbi:)?\w+\s*=(.*)/ix)
    {
	$nv = $sh->interpolate($1, undef());
	#warn("interpolate($1,undef)\n");
    }

    if( $hook = $sh->{SETV_HOOKS}{ $k }[ HOOK_ANTE ] )
    {
	$hook->( $sh, $k, $nv );
    }

    eval
    {
	local($_) = $d;
	# environment variables:
	if    (/^!env:(\w+)      /ix) { $k = $1; delete($ENV{$1})     }
	elsif (/^ env:(\w+)\s*=.*/ix) { $k = $1; $rv = $ENV{$1} = $nv }
	elsif (/^ env:(\w+)      /ix) { $k = $1; $rv = $ENV{$1}       }
	# dbi attributes:
	elsif (/^!dbi:(\w+)      /ix) { $k = $1; die(DBI_ATTR_EEK)    }
	elsif (/^ dbi:(\w+)\s*=.*/ix) { $k = $1; $rv = $h->{$1} = $nv }
	elsif (/^ dbi:(\w+)      /ix) { $k = $1; $rv = $h->{$1}       }
	# grl variables:
	elsif (/^!grl:(\w+)      /ix) { $k = $1; die(GRL_ATTR_EEK)    }
	elsif (/^grl:            /ix)
	{
	    my $g = $sh->{TERM}->attr();
	    if (/^grl:(\w+)(\s*=.*)?/ix)
	    {
		if ($2) { $k = $1; $rv = $g->{$1} = $nv }
		else    { $k = $1; $rv = $g->{$1}       }
	    }
	}
	# dbishell variables:
	elsif (/^!(\w+)      /x)      { $k = $1; delete($v->{$1})     }
	elsif (/^ (\w+)\s*=.*/x)      { $k = $1; $rv = $v->{$1} = $nv }
	elsif (/^ (\w+)      /x)      { $k = $1; $rv = $v->{$1};      }
	else
	{
	    $sh->{ERRNO} = -1;
	    $sh->{ERROR} = "Unable to find a valid variable name";
	    return $sh->{TMPQ} = 0;
	}
    };

    if ($@) { $sh->{ERROR} = sprintf("Error %s while setting %s", $@, $k) }

    if( $hook = $sh->{SETV_HOOKS}{ $k }[ HOOK_POST ] )
    {
	$hook->( $sh, $k, $rv );
    }

    return ($k,$rv);
}

sub subshell ($$)
{
    my $sh  = $_[0];
    my $cmd = $_[1];

    $cmd =
      ($cmd =~ /\S/)    ? $cmd        :
	-x($ENV{SHELL}) ? $ENV{SHELL} :
	  '/bin/sh';

    $sh->errputf(CONTEXT_NIL, "system('%s')\n",$cmd);
    system($cmd);

    unless($? >> 8)
    {
	$sh->{ERRNO} = $?;
	$sh->{ERROR} = "Subshell command failed";
    }

    return !($? >> 8);
}

sub getvar ($$$)
{
    my $sh    = shift(@_);
    local($_) = shift(@_);
    my $nrep  = shift(@_);
    my $v     = undef();

    if   (/^env:(\w+)/i){ $v = defined($ENV{$1}) ? $ENV{$1}           : $nrep }
    elsif(/^dbi:(\w+)/i){ $v = eval { $sh->{ENGINE}->dbh()->{$1} }   || $nrep }
    elsif(/^grl:(\w+)/i)
    {
	my $g = $sh->{TERM}->attr();
	$v = defined($g->{$1}) ? $g->{$1} : $nrep;
    }
    elsif(/^(\w+)$/)    { $v = defined($sh->{VAR}{$1})? $sh->{VAR}{$1}: $nrep }
    else
    {
	$sh->{ERRNO} = -1;
	$sh->{ERROR} = "Unable to find valid variable name";
	$sh->errputf(CONTEXT_NIL, "%s: %s\n", $sh->{ERROR}, $_);
    }

    if ($@) { $sh->errputf(CONTEXT_NIL, "%s: %s\n", ($sh->{ERROR} = $@), $_); }

    return $v;
}

sub getvar_ref ($$$)
{
    my $sh    = shift(@_);
    local($_) = shift(@_);
    my $nrep  = shift(@_);
    my $vs    = $sh->{VAR};
    my $v     = undef();

    if(/^dbi:/i)
    {
	warn(<<EEKWarning);
 Sorry, I can't let you bind DBI attributes as parameters,
 all sorts of hideous things might happen:
 Great Cthulhu might rise.
 The Ghost of Tim Bunce(tm) might mystically appear and assault me with
 freeze dried socks. Who knows?
EEKWarning
	return ();
    }
    if(/^grl:/i)
    {
	warn(<<EEKWarning);
 Sorry - disallowing binding of GRL attributes as parameters. Nih!
EEKWarning
	return ();
    }
    # make sure we force them into existence if they don't exist:
    if   (/^env:(\w+)/){ $v= exists($ENV{$1})? \$ENV{$1} :\($ENV{$1}=undef()) }
    elsif(/^(\w+)$/)   { $v= exists($$vs{$1})? \$$vs{$1} :\($$vs{$1}=undef()) }
    else
    {
	$sh->{ERRNO} = -1;
	$sh->{ERROR} = "Unable to find valid variable name";
	$sh->errputf(CONTEXT_NIL, "%s: %s\n", $sh->{ERROR}, $_);
    }

    return $v;
}

sub put_parameter ($$)
{
    my $sh = shift(@_);
    my $pa = shift(@_);
    my $io = shift(@_);

    push(@{ $sh->{VAR}{'^parameters'} }, $sh->getvar_ref($pa));
    push(@{ $sh->{VAR}{'^param_names'}}, $pa);
    push(@{ $sh->{VAR}{'^param_io'}   }, $io);
}

sub clear_parameters ($)
{
    @{ $_[0]->{VAR}{'^parameters'}  } = ();
    @{ $_[0]->{VAR}{'^param_names'} } = ();
    @{ $_[0]->{VAR}{'^param_io'}    } = ();
}

sub get_parameter      ($) { $_[0]->{VAR}{'^parameters'}[$_[1]]  }
sub get_parameter_name ($) { $_[0]->{VAR}{'^param_names'}[$_[1]] }
sub get_parameter_io   ($) { $_[0]->{VAR}{'^param_io'}[$_[1]]    }

sub interpolation ($$) { $_[0]->{OPT}{intp} = $_[1]; $_[0]->{TMPQ} = 1 }
sub escaping      ($$) { $_[0]->{OPT}{escp} = $_[1]; $_[0]->{TMPQ} = 1 }

sub show_license   ($)
{
    if($ENV{PAGER} && open(PAGER, "|$ENV{PAGER}"))
    {
	syswrite(PAGER,
		 DBIShell::UTIL::GPL_LICENSE,
		 length(DBIShell::UTIL::GPL_LICENSE)
		);
	close(PAGER);
    }
    else
    {
	$_[0]->outputf(CONTEXT_NIL, '%s',DBIShell::UTIL::GPL_LICENSE);
    }

    1;
}

sub pre_interpret  ($$)
{
    # this method is in charge of catching the stuff we don't want the
    # DB specific engine to see [ever]
    # quit, spool etc spring to mind:

    my $sh    = shift(@_);
    local($_) = shift(@_);

    #warn("PRE: $_\n");

    if ($_)
    {
	m/^\s*_dump\((.*)\)/si             && return $sh->_dump($1);
	m/^\s*cd\b\s*(.*)/si               && return chdir($1);
	m/^\s*edit(?:\s+[+-]?(\d+))?/si    && return $sh->edit(int($1));
	m/^\s*spool\s+(.*)/si              && return $sh->spool($1);
	m/^\s*disconnect/si                && return $sh->disconnect();
	m/^!(.*)/s                         && return $sh->subshell($1);
	m/^\s*escap(?:e|ing)\s+on/si       && return $sh->escaping(1);
	m/^\s*escap(?:e|ing)\s+off/si      && return $sh->escaping(0);
	m/^\s*interpolat(?:e|ion)\s+on/si  && return $sh->interpolation(1);
	m/^\s*interpolat(?:e|ion)\s+off/si && return $sh->interpolation(0);
	m/^\s*read\s+(.*)/si               && return $sh->exec_script($1);
	m/^\$(.*)/                         && return $sh->set_show_var($1);
	m/^\s*license/                     && return $sh->show_license();
	m/^\s*connect(?:\s+(.*))?/si
	                         && return $sh->reconnect(split(/\s+/,$1));

	return undef();
    }

    return 1;
}

sub _dump ($$)
{
    my $obj;
    my $txt;
    my $sh  = $_[0];
    my @key = map { s/^\s+|\s+$//g; $_ } split(/,/,$_[1]);

    my $pkg = DBIShell::UTIL::dynaload('Data::Dumper');

    eval
    {
	$obj = $sh;
	foreach (@key)
	{
	    $obj =
	      exists($obj->{$_}) ?
		$obj->{$_} :
		  die("Member $_ not found\n");
	}
    };

    if ($@) { $sh->{ERROR} = $@; return 0 }

    if($pkg)
    {
	my $lines;
	my $ref = ref($sh);

	$txt = $pkg->Dump([$obj],[join('->',$ref,@key)]);

	$lines = ($txt =~ tr/\n/\n/);
	$sh->start_pager($lines);
	$sh->outputf(CONTEXT_NIL, "%s\n", $txt);
	$sh->stop_pager();
    }

    return 1;
}

sub interpret ($$)
{
    my $sh = shift(@_);
    my $q  = $sh->interpolate( shift(@_) );

    my $i   = $sh->{ENGINE}->interpret($sh, $q);
    if(!$i)
    {
	$sh->{ERRNO} = $sh->{ENGINE}->errno();
	$sh->{ERROR} = $sh->{ENGINE}->error();
    }

    return $i;
}

sub post_interpret ($$)
{
    # if the DB specifc engine failed to interpret this, have another shot:
    # mostly a catcher for when the db engine doesn't implement something.

    my $sh    = shift(@_);
    local($_) = shift(@_);

    # we don't actually catch any thing, but if we did,
    # here is where we would catch it
    return 1;
}


sub edit ($$)
{
    my $retval;
    my $sh     = $_[0];
    my $n      = abs(int($_[1])); 
    my $cmd    = $sh->command($n);
    my $editor = $sh->getvar('EDITOR','') || $ENV{EDITOR} || 'ed';
    my $file   =
      $sh->tmpfile(sprintf('%s.%s',
			   $sh->{OPT}{'shell-driver'} || $sh->{OPT}{driver},
			   'edit'
			  )
		  );

    eval
    {
	local(*FH);
	# race condition? I can't see how not to make it a race cond, though:
	sysopen(*FH, $file, O_WRONLY|O_CREAT|O_EXCL, 0600) || die("a:$!\n");
	sysseek(*FH, 0, SEEK_SET)                          || die("d:$!\n");
	defined(syswrite(*FH, $cmd, length($cmd)))         || die("b:$!\n");
	close(*FH);

	system("$editor $file")
	  && die("'$editor $file'",$?>>8,":",$?&127,"\n");

	sysopen(*FH, $file, O_RDONLY, 0600)                || die("a:$!\n");
	sysseek(*FH, 0, SEEK_SET)                          || die("d:$!\n");
	defined(sysread(*FH, $cmd, -s($file)))             || die("e:$!\n");
	sysseek(*FH, 0, SEEK_SET)                          || die("d:$!\n");

	$sh->add_command($cmd);
	$retval = $sh->exec_script(*FH);

	close(*FH);
	unlink($file);
	unlink($file.'~'); #emacs, vim et al...
    };

    if($@)
    {
	$sh->{ERRNO} = int($!);
	chomp($sh->{ERROR} = $@);
	return 0;
    }

    return $retval;
}


sub quit_cleanup ($)
{
    my $sh = shift(@_);

    $sh->set_dot_history();

    if($sh->{ENGINE}) { $sh->{ENGINE}->disconnect() }

    # zap the extra references:
    $sh->{TERM}->set_completion_function( undef() );
    $sh->{ADDHISTORY} = undef();

    if(WINDOWING)
    {
	my $title =
	  length($sh->{ORIG_ITITLE}) ?
	    $sh->{ORIG_TITLE} :
	      join('',
		   $ENV{TERM}, ':',
		   ($ENV{USER}||$ENV{LOGNAME}||$ENV{USERNAME}),
		   ($ENV{HOSTNAME} ? ('@',$ENV{HOSTNAME}) : '')
		  );
	my $ititle = length($sh->{ORIG_ITITLE}) ? $sh->{ORIG_ITITLE} : $title;

	DBIShell::Term_CTL::set_ititle($ititle);
	DBIShell::Term_CTL::set_title($title);
    }

    return 1;
}

sub is_terminated ($$)
{
    my $sh    = $_[0];
    local($_) = $_[1];
    my $e     = $sh->getvar('EOL',undef());
    my $one   = (@{$sh->{ACMT}} == 1);
    # / is special, since it can crop up in comments, which we would like
    # to ignore. So trap it here, in case the user set EOL to '/'
    chomp($e);
    ($e eq '/')   && ($e = undef());

    # Conditions for command completeness: docs moved to pod section

    (defined($e) ?
     (m(^$e\s*$) || m([^\\]$e\s*$)) :
      (m(^/\s*$) || m([^*\\]/\s*$)))
      || ($one &&
	  (/^[\!\$]/
	   || /^\s*show\b               /xi
	   || /^\s*describe\b           /xi
	   || /^\s*cd\b                 /xi
	   || /^\s*read\b               /xi
	   || /^\s*help\b               /xi
	   || /^\s*edit\b               /xi
	   || /^\s*spool\b              /xi
	   || /^\s*license\b            /xi
	   || /^\s*(?:dis)?connect\b    /xi
	   || /^\s*interpolat(?:e|ion)\b/xi
	   || /^\s*escap(?:e|ing)\b     /xi
	   || /^\s*quit\b               /xi
	  )
	 );
}

sub parse_loop ($)
{
    my($eol);
    my($q, $i);
    my $sh = shift(@_);
    local( $CUR_EOL );

    $CUR_EOL = $sh->getvar( EOL => '/' );

    if(WINDOWING)
    {
	$sh->{LAST_TITLE}  = $sh->{ENGINE}->title();
	$sh->{ORIG_TITLE}  = DBIShell::Term_CTL::set_ititle('dbishell');
	$sh->{ORIG_ITITLE} = DBIShell::Term_CTL::set_title($sh->{LAST_TITLE});
    }

  CMD_LINE:
    while(defined($q = $sh->readline($sh->{ENGINE}->prompt)))
    {
	if(WINDOWING)
	{
	    my $title =  $sh->{ENGINE}->title();
	    #warn("$title/",$sh->{LAST_TITLE},"\n");

	    if($title ne $sh->{LAST_TITLE})
	    {
		DBIShell::Term_CTL::set_title($title);
		$sh->{LAST_TITLE} = $title;
	    }
	}
	# I can't see how this ever worked without this next line...
	# Quantum bugs. I hate them.
	$i = undef(); # return value from dispatched call

	# user hit ^D, or stdin otherwise cut off:
	defined($q) || last CMD_LINE;

	# ignore leading blank lines only:
	(scalar(@{$sh->{ACMT}}) == 0) && ($q !~ /\S/) && next CMD_LINE;

	# store the line
	push(@{$sh->{ACMT}}, $q);

	# did we terminate the command?
	# ($q =~ /\/$/) || next CMD_LINE #naive
	$sh->is_terminated($q) || next CMD_LINE;

	# Aha, we did terminate the command - Very well, make it so:
	$i = $sh->exec_command();

	# abort! abort!
	if( $sh->{QUIT} ) { last CMD_LINE }
    }

    $sh->quit_cleanup();

    return 1;
}

sub connect # did we remember to declare this in a 'use sub' ?
{
    my $dbh;
    my $engine;
    my $sh   = shift(@_);
    my $opt  = $sh->{OPT};

    if($opt->{help})
    {
	$sh->errputf(CONTEXT_NIL, '%s', DBIShell::Help->help( undef() ));
	return undef();
    }

    if   ($sh->{OPT}{noconn}) { $sh->set_dbi_nullp_parameters() }
    else                      { $sh->get_dbi_parameters()       }

    my $real_driver = $opt->{'shell-driver'} || $opt->{driver};

    # jump through hoops to avoid doing a string eval:
    # this is a try/catch equivalent, not an evil eval.
    # see perldoc perlfunc, the section on 'eval BLOCK'
    # if there is a symbol table entry for our package, do not
    # try to reload it.

    $engine   = join('::','DBIShell::dr',$real_driver);
    $engine   = DBIShell::UTIL::dynaload($engine);
    $engine ||= DBIShell::UTIL::dynaload('DBIShell::dr::DEFAULT');

    if ($engine) { $sh->errputf(CONTEXT_INFO, "Using %s engine\n",$engine) }
    else
    {
	$sh->{ERRNO} = int($!);
	$sh->{ERROR} = $@;
	return undef();
    }

    # create a new engine object, or else go splat
    # don't actually replace the current engine object unless
    # we are sure we have connected to the database at the other end

    # the option must be the DBI driver we will be using
    # directly: eg 'Proxy' for DBI::Proxy - 'shell-driver'
    # controls which behaviours we'll get, but the engine must still use
    # a DBI driver of 'DBD::Proxy' [for example].
    eval { $engine = $engine->new($opt->{driver},$sh) };

    if($@ || !$engine)
    {
	$sh->{ERRNO} = int($!);
	$sh->{ERROR} = "Failed to initialise $engine: $@";
	return undef();
    }

    #warn("$engine\n");

    unless($engine->connect($opt))
    {
	$sh->{ERRNO} = $engine->errno();
	$sh->{ERROR} = $engine->error();
	return undef();
    }

    $sh->{ENGINE} = $engine;
    $sh->get_dot_history();

    $sh->read_rc_script();
    return $sh->{ENGINE}->dbh();
}

sub complete { $_[0]->{ENGINE}->complete( $_[0], $_[1], $_[2], $_[3] ) }

sub get_dot_history ($)
{
    my $fh    = local(*FH);
    my $sh    = shift(@_);
    my $hfile = $sh->dotfile(HISTORY);
    my $readl = $sh->{TERM};

    # zero out the history anyway:
    $readl->set_history();
    # don't actually care if the file is there yet or not:
    if(sysopen($fh, $hfile, O_RDONLY))
    {
	my $line;

	flock($fh, LOCK_SH);
	while($line = CORE::readline($fh))
	{
	    chomp($line);
	    $readl->add_history($line);
	}
	flock($fh, LOCK_UN);
	close($fh);
    }
}

sub set_dot_history ($)
{
    my $fh    = local(*FH);
    my $sh    = shift(@_);
    my $hfile = $sh->dotfile(HISTORY);
    my $readl = $sh->{TERM};

    #$sh->_strip_eol_from_history();

    if(sysopen($fh, $hfile, O_WRONLY|O_CREAT, 0600))
    {
	my $s = 0;
	flock($fh, LOCK_EX);
	seek($fh, 0, SEEK_SET);

	foreach my $line ($readl->get_history())
	{
	    $s += print($fh $line) ? length($line) : 0;
	    $s += print($fh "\n")  ? 1             : 0;
	}

	select((select($fh),$!=1)[0]);
	print($fh "");
	truncate($fh, $s);
	flock($fh, LOCK_UN);
	close($fh);
    }
}

sub dotfile ($$)
{
    my $sh      = shift(@_);
    my $section = shift(@_);

    my $dotdir  = $sh->{OPT}{dotdir};
    my $dbi_drv = $sh->{OPT}{'shell-driver'} || $sh->{OPT}{driver};

    return join('/', $dotdir, join('.', $dbi_drv, $section));
}

sub tmpfile ($$)
{
    my $sh  = shift(@_);
    my $tag = shift(@_);
    my $dotdir  = $sh->{OPT}{dotdir};
    my $tmpfile =
      sprintf('%s.%3.3d-%5.5d-%9.9d',$tag,rand(1000),seqno(),time());

    return join('/', $dotdir, TMPDIR, $tmpfile);
}

sub set_dbi_nullp_parameters ($)
{
    my $sh = $_[0];

    $sh->{OPT}{driver} = '';
    $sh->{OPT}{dsn}    = 'dbi:NullP';
    $sh->{OPT}{user}   = '';
    $sh->{OPT}{pass}   = '';
}

# read in DBI parameters that weren't passsed in on the command line
sub get_dbi_parameters ($)
{
    my $sh = $_[0];

    foreach my $s (DBI_OPT_SPEC)
    {
	unless(defined($sh->{OPT}{$s->[DBIOPT_NAME]}))
	{
	    $sh->{OPT}{$s->[DBIOPT_NAME]} =
	      DBIShell::UTIL::get_param($s->[DBIOPT_PRMT], $s->[DBIOPT_MODE]);
	}
    }
}

sub variables ($)
{
    my $sh = shift(@_);

    my @env = map { join(':','env',$_) } keys(%ENV);
    my @dbi = map { join(':','dbi',$_) } DBIShell::UTIL::DBI_ATTR_NAMES;
    my @grl = map { join(':','grl',$_) } keys( %{$sh->{TERM}->attr()} );
    my @var = keys( %{$sh->{VAR}} );

    return (@env, @dbi, @var, @grl);
}

sub interpolate ($$;$)
{
    my $sh      = shift(@_);
    my $thing   = shift(@_);
    my $nullrep = @_ ? shift(@_) : 'NULL';

    my $umap =
      eval
      {
	  $sh->{ENGINE}->UNIVERSAL::can('unslash_map') ?
	    $sh->{ENGINE}->unslash_map :
	      undef();
      };

    #warn("interpolating '$thing'\n");

    if($sh->{OPT}{intp})
    {
	#warn("Doing variable interpolation\n");
	#$thing =~ /\$([\w:]+)/ && warn("variable \$'$2' found\n");

	$thing =~
	  s/([^\\])\$((?:[\w]+:)?\w+)/join('',$1,$sh->getvar($2,"\x00"))/egs;
	$thing =~
	  s/^\$((?:[\w]+:)?\w+)/$sh->getvar($1,"\x00")/egs;

	# make sure that if we _really_ meant we wanted undef, we get it:
	if($thing =~ /^\x00\s*/) { $thing = $nullrep	                 }
	else                     { $thing =~ s/['"]?\x00["']?/$nullrep/g }
    }

    #warn("escaping '$thing'\n");
    # extra paranoia...
    if($sh->{OPT}{escp} && defined($thing) && ($thing ne $nullrep))
    {
	$thing =~ s/\\(.)/unslash($umap,$1)/ges;
    }

    #warn("returning '$thing'\n");

    return $thing;
}

__END__
# TLF: Nikola Tesla died for you....

=pod

=head1 NAME

DBIShell - Core of the dbishell program

=head1 SYNOPSIS

use DBIShell;

=head1 DESCRIPTION

This is the core of dbishell: It handles everything not directly database
related, like parsing parameters, reading config files, loading drivers
and managing the user interface. It provide mpst of the actual funcionality
used by the F<dbishell> script

=head1 DATA MEMBERS

Data members are documented for developers of DBIShell.pm only: they should
not be directly accessed from outside this package. Don't make me come over
there

=head2 TMPQ

Gets set if the next bit of output should be skipped by dbishell. Used
internally by a couple of things to skip some unneccesary verbiage.
Anything that cheks this variable should promptly set it back to zero

=head2 VAR

Hash reference that provides storage for dbishell variables. There are 3
special keys used for DBI in/out parameter handling, but they have 'illegal'
names, so we should never see a collision

=head2 ERRNO

Last system error number generated [like ENOENT or EINVAL, for example]

=head2 ERROR

Last error message generated by dbishell

=head2 OPT

Storage for the command line options

=head2 ACMT

Unfinished multiline commands are accumulated here before being interpreted

=head2 TERM

This is where the readline object is stored

=head2 OUTFH

Output file handle [probably *STDOUT]

=head2 ERRFH

Error file handle [probably *STDERR]

=head2 INFH

Input file handle [probably *STDIN]

=head2 SPOOL

A Multilevel hash: The first level has 3 keys: IN, OUT and ERR
Each of these keys corresponds to a hash ref which contains
filename => filehandle pairs for all the active output spools

=head2 ENGINE

Contains the DBIShell::dr::<FOO> object [the engine]

=head2 PAGER

Boolean. Whether the pager is currently active or not

=head2 CMDBUF

Buffer of multiline commands. [as opposed to the readline history, which is
a list of individual lines as opposed to full commands]

=head2 CMDLIM

Maximum size of the CMDBUF. Should probably be more configurable than it is

=head2 DFLT_SIGPIPE

Default SIGPIPE handler

=head2 LAST_TITLE

The last window title that was set. [only in xterm/rxvt right now]

=head2 ORIG_TITLE

Original title of window

=head2 ORIG_ITITLE

Original icon title of window

=head1 METHODS

=head2 $sh->error()

Return the last error string that was generated

=head2 $sh->errno()

Return last system error number that cropped up

=head2 $sh->readline([PROMPT])

Fetch a line from the user, logging/spooling it as required by the
current state of the spooler

=head2 $sh->outputf(CONTEXT, FORMAT, [ARGS...])

Write the data in ARGS out onto the output filehandle according to the
printf style format FORMAT, logging the output as required by the state
of the spooler. The CONTEXT argument is not used yeet, but is intended for
use with the GTK front end, or other cases where we want to pass more
information about the kind of output we are emitting.

=head2 $sh->errputf(CONTEXT, FORMAT,[ARGS])

As above [L</$sh-E<gt>outputf(CONTEXT, FORMAT,[ARGS...])>] but for the
error filehandle instead

=head2 DBIShell->new()

Create a new DBIShell object, and set it up to work with whatever
readline functionality is available

=head2 $sh->add_command(COMMAND)

Add a complete command to the command stack thingy

=head2 $sh->command(NUMBER)

Fetch the command NUMBER back from the end of the command stack thingy

=head2 $sh->paging(NLINES)

Return boolean value. based on NLINES [number of lines], indicating whether
the pager should be fired up. if the dbishell variable PAGE_SIZE is set,
then use that as the trigger size, otherwise attempt to determine the page
size in some other way. Will not return true if dbishell variable PAGING is 
not true

=head2 $sh->start_pager(NLINES)

If paging is required for NLINES of data [L</$sh-E<gt>paging(NLINES)>] then
fire up the pager command in the dbishell variable PAGER [or, if there's
nothing there, then try $ENV{PAGER}, otherwise fall back to 'C<less -S>'
cache the current output and error filehandles, and set them to the
PAGER pipe just opened. If the pager is already running, do nothing

=head2 $sh->stop_pager()

Close the PAGER pipe and put the old output and error filehandles back

=head2 $sh->set_signal_handlers() OBSOLETE+DEAD

Set up the SIGWINCH, SIGTSTP and SIGTTIN handlers. SIGWINCH works with both
Term::ReadLine::Gnu [rl version >= 4 only] and ::Perl [all versions, afaik]
SIGSTP and SIGTTIN only seem to work with ::Perl  - ::Gnu seems to block
them in some arcane way, and only deliver them at exit time. If someone can
wants to sort this out, or at least explain to me what;s going on, that
would be just peachy

=head2 $sh->set_dotdir()

Create the dot-directory [~/.dbishell, by default] if neccessary

=head2 $sh->set_completion_function(FUNC) OBSOLETE+DEAD

Set up the tab completion function [Term::ReadLine::Gnu and ::Perl do this in
different ways]

=head2 $sh->getopts()

Parse the command line args in @ARGV

=head2 $sh->disconnect()

Tell the driver to disconnect, zap the DBIShell::dr::<foo> object, flush
the readline history, clear the connection parameters and drop back to a
DBD::NullP connection

=head2 $sh->reconnect(ARGS)

Kill the current connection and open a new one, asking for any parameters
that weren't supplied in ARGS

=head2 $sh->spool(SPOOL_COMMAND_STRING)

Interpret a 'spool {in|out|err} target-file {on|off}' command, and
set the state of the spooler appropriately

=head2 $sh->exec_script(FILE)

FILE can be a filename or a filehandle. In either case, the indicated file is
read and interpreted almost exactly as if the user had typed in the commands
therein, with 2 minor differences:

1) The individual commands don't make it into the readline history

2) The last command need not be terminated with the EOL character 

=head2 $sh->set_show_var(VARCMD)

VARCMD is of the form: $NAME=VALUE
                   or: $!NAME

set dbishell variable NAME to VALUE, [or unset it]
and echo the resulting value back to the user

=head2 $sh->setvar(VARCMD)

Implements the actual interpretation of VARCMD
[See L</$sh-E<gt>set_show_var(VARCMD)>]

Returns (NAME, VALUE)

=head2 $sh->subshell(CMD)

Execute shell command CMD, or if CMD is not true, spwan an inferior shell

=head2 $sh->getvar(NAME,NULL_REPRESENTATION)

Get the value of dbishell variable NAME. If it is not defined, return
NULL_REPRESENTATION instead. [This maybe slightly inaccurate for $dbi:NAME
variables, but they're kind of a special case anyway]

=head2 $sh->getvar_ref(NAME)

Get a reference to the storage for dbishell variable NAME. Does not allow you
to fetch references to $dbi:NAME variables, though

=head2 $sh->put_parameter(NAME, IO)

Store the vriable name, reference and in-outness of a ? style placeholder
parameter

=head2 $sh->clear_parameters()

Clear the stored parameter list

=head2 $sh->get_parameter(N)

Return a reference to the storage of the Nth parameter

=head2 $sh->get_parameter_name(N)

Return the name of the dbishell variable in which the Nth parameter
is stored

=head2 $sh->get_parameter_io(N)

Return the in/out-ness of the Nth parameter

=head2 $sh->interpolation(BOOL)

Set the flag that indicates whether or not dbishell should do
variable interpolation or not

=head2 $sh->escaping(BOOL)

Set the flag that indicates whether dbishell should interpret
\X style escapes, or pass them through unaltered

=head2 $sh->show_license()

Show the license

=head2 $sh->pre_interpret(COMMAND)

Attempt to interpret and deal with user input COMMAND.
Return true on success, false on failure and undef to indicate
'I decline the command, pass on the next interpreter'

=head2 $sh->interpret(COMMAND)

Pass the command on to the DBIShell::dr::<foo> engine.
Return true on success, false on failure and undef to indicate
'I decline the command, pass on the next interpreter'

=head2 $sh->post_interpret(COMMAND)

Attempt to interpret and deal with user input COMMAND.
Return true on success, false on failure and undef to indicate
'I decline the command, pass on the next interpreter'

=head2 $sh->edit(NUMBER)

Launch the editor command in the dbishell variable EDITOR, or if that is empty
$ENV{EDITOR}, or, failing that, 'ed', to edit the Nth command back in the
command stack thingy. Execute the edited command when the editor returns

=head2 $sh->quit_cleanup()

Flush the readline history to appropriate dotfile, disconnect, and generally
clean up prior to shutdown

=head2 $sh->is_terminated(COMMAND)

Determine whether COMMAND is ready for interpretation/execution, taking
context into account, and return true or false, as appropriate.
Some commands are considered to be one liners, and therefore always complete,
others must be terminated by the character(s) in the dbishell variable
EOL [or '/', if EOL is unset]

The rules for termination, insofar as I can reconstruct my thoughts from the
code, are as follows:

     Conditions for command completeness:
     We shall treat a command as having been completed when:
     
     GIVEN that the terminator sequence <E> shall have a single trailing
     newline sequence [$/] removed:
     
     (
      (The terminator sequence '<E>' is set)
      AND (
           (occurs at the start of a line, containing nothing else,
            other than whitespace)
           OR
           (
            (occurs at the end of the line, discounting whitespace)
            AND (is NOT preceded by a '\' character)
           )
          )
      )
      OR
      (
       ((The terminator sequence <E> is unset) OR (<E> is set to '/'))
       AND (
            ('/' occurs at the start of a line, containing nothing else,
             other than whitespace)
            OR
            (
             ('/' occurs at the end of the line, discounting whitespace)
             AND (is NOT preceded by a '\' or a '*')
            )
           )
      )
      OR
      (
       (COMMAND consists of only one line)
       AND
       (
        (COMMAND begins with the subshell command character '!')
        OR
        (COMMAND begins with the variable indicator character '$')
        OR
        (COMMAND begins with one of the special one line command keywords
         [show describe license quit help edit spool disconnect
          connect read interpolate interpolation escape escaping])
       )
      )
     
     On reflection, this will mean that a terminator set by the user to
     contain multiple newline sequences will not work. I have not decided
     whether this constitutes a bug or a limitation

=head2 $sh->parse_loop()

Keep collecting user input, and shunt it along to the interpretes, as and
when appropriate. Similar to exec_script, [See L</$sh-E<gt>exec_script(FILE)>]
except that commands B<do> end up in the readline history

=head2 $sh->connect()

Collect any connection parameters that weren't supplied in the OPT storage
from the user, and then load the appropriate modules and set up a connection

=head2 $sh->complete()

Call the tab completion function in the DBIShell::dr::<foo> driver

=head2 $sh->get_dot_history()

Load the readline history for the current dr:: driver into the readline
history array from the appropriate dotfile

=head2 $sh->set_dot_history()

Flush the readline array to the appropriate dotfile

=head2 $sh->dotfile(SECTION)

Return the name of the dotfile for the section specified, for the current dr::
driver

=head2 $sh->tmpfile(TAG)

Return a tmpfile name. The tmpfile will lie in the 'draft' sub directory
of your dotdir ['~/.dbishell' by default], and is guaranteed to be unique.
[Unless you are uding threads, then all bets are off]. he tmfile will
contain the contents of TAG in its name [so don't put a '/' in there].

=head2 $sh->set_dbi_nullp_parameters()

Set the OPT connection parameters to dummy NullP connction values

=head2 $sh->get_dbi_parameters()

Get any connection parameters that haven't been set yet

=head2 $sh->variables()

Return a list of all the dbishell variables currently in existence

=head2 $sh->interpolate(THING, NULLREP)

Interpolate dbishell variables and transform escape sequences in
THING, replacing anything that transforms to undef with the value of
NULLREP. Any quotes immediately surrounding an interpolated undef
value will be removed from THING

eg: if $NARF is undef:

update foo set bar = '$NARF' where poinkt = 32

becomes:

update foo set bar = NULL where poinkt = 32

=head1 dbishell variables

=head2 Introduction

These fall into 4 categories, and have names of the form:

dbi:NAME    DBI attributes, (Database Handle+Universal ones) eg dbi:AutoCommit
env:NAME    environment variables
grl:NAME    GRL (GNU Read Line) attributes
NAME        normal dbishell variables

Neither dbi nor grl domain variables may be bound as parameters or undefined,
as it is unlikely to be helpful to do so, and may (imo) trigger bad XS - XS or
Perl XS interactions, as that is not what they were provided for.

=head2 Setting values

calling $sh->setvar() [See L</$sh-E<gt>setvar(VARCMD)>]
with a VARCMD of the form $NAME=VALUE will set the variable

=head2 Unsetting values

calling $sh->setvar() [See L</$sh-E<gt>setvar(VARCMD)>]
with a VARCMD of the form $!NAME will unset the variable

=head2 Special variables:

 EOL              : The command termination character
                    If unset [the default] '/' is used
                    Set to \n to disable multiline commands
 PAGING           : Boolean. Whether or not paging is allowed
 PAGER            : Command to open a pipe to when paging is called for 
 PAGE_SIZE        : Number of lines at which paging will be triggered
                    Set to -1 for 'always'
 EDITOR           : EDITOR command
 PRESCAN_ROWS     : Whether to prefetch all select data and
                    work out max col width before printing
                    If false, just use the precision/scale to
                    calculate the max width for each column
 TRUNCATE_COLUMN_NAMES:
                    Whether or not to truncate column names which
                    are wider than the max data width in the column
                    they refer to
 FUSSY_COMPLETION_WORKAROUND:
                    Handle a quirk in the tab completion, or not
 CASE_SENSITIVE   : Is the database case sensitive or not?
 FIELD_SEPARATOR  : Character to use to separate columns in output

=head1 BUGS

=over 4

=item paging

need to fix it so that it fails gracefully when it can't open a pipe to the
pager.

=item signal handling

Seem to be some issues w. SIGTSTP and SIGTTIN handling when Term::ReadlIne::Gnu
is used: they seem to get blocked till we exit. Also, if the readline version
is < 4.00, SIGWINCH doesn't seem to get handled at all: I think this is an
actual limitation in the old rl library.

=item terminal settings

When Term::Readline::Perl is used as the rl implementation, M-<foo> sequences
don't seem to work, you just get an 8-bit character instead: so to get emacs
style Meta-sequences, you have to use the ESC versions instead.

eg 'ESC >' for go to end of cmd. history instead of M->. I'm sure this is
configureable in some way, I just don't know how (yet).

=back

=head1 AUTHOR

Vivek Dasmohapatra <vivek@etla.org>

=cut