RTFM
rtfm / SQL / dbishell / src/DBIShell/dr/DEFAULT.pm
.etla.org
package DBIShell::dr::DEFAULT;

#  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 strict;

use DBI;
use Exporter ();
use DBIShell::UTIL qw/:param :context stringify _NULLS IS_NUMERIC TRUE FALSE/;
use DBIShell::Help;

use constant OGREP_FN => sub { (shift(@_))->grep_objnames(@_)      };
use constant SGREP_FN => sub { (shift(@_))->grep_shownames(@_)     };
use constant TGREP_FN => sub { (shift(@_))->grep_tabnames(@_)      };
use constant HGREP_FN => sub { ($_[0])->{HELP}->topics($_[1])  };
use constant FGREP_FN => sub { (shift(@_))->grep_fs($_[0])         };

use constant UNDEF_FN => sub { () };

use constant DBI_ATTRIB => {
			    PrintError  => 0,
			    RaiseError  => 0,
			    AutoCommit  => 1,
			    ChopBlanks  => 0,
			    LongReadLen => 1024,
			    LongTruncOk => 1
			   };

use vars qw($VERSION @EXPORT @EXPORT_OK %EXPORT_TAGS @ISA);

$VERSION     = 0.01_57;
@EXPORT      = qw();
@EXPORT_OK   = qw(TGREP_FN HGREP_FN OGREP_FN SGREP_FN FGREP_FN);
%EXPORT_TAGS = qw();
@ISA         = qw(Exporter);

use vars qw(%DBI_TYPE %VISIBLE_INTERNAL *DH);

use subs qw(connect);

use constant DESCQ => 'select * from %s where 1 = 0';

use constant CMNDS =>
      qw(select
         insert
         update
         delete
         create
         drop
         show
         describe
         commit
         rollback
         read
         cd
        );

use constant KEYWDS =>
  qw^ into
      from
      where
      like in and or not null is
      order
      group
      by distinct
      table
      varchar
      char
      numeric
      integer^;

# completion map:
# keys are the words which trigger those completions
# values are aither:
#
# 0) a ref to a list holding the valid completions
# 1) a ref to a function, called thusly:
#    &function(ENGINE, TEXT, CTFN_CODEREF)
#
# things mapped from ARRAY refs will always be mapped case insensetively,
# [this is because big chunks of SQL are defined to be case insensitive:]
# CODE refs get passed a CTFN_CODEREF which does any case mangling required.

use constant COMPLETION_MAP =>
  (
   select   => [ KEYWDS ],
   from     => TGREP_FN,
   table    => TGREP_FN,
   update   => TGREP_FN,
   into     => TGREP_FN,
   describe => TGREP_FN,
   join     => TGREP_FN,
   help     => HGREP_FN,
   create   => [ 'table' ],
   drop     => [ 'table' ],
   delete   => [ 'from'  ],
   insert   => [ 'into'  ],
   is       => [ qw(null not) ],
   not      => [ 'null' ],
   show     => SGREP_FN,
   read     => FGREP_FN,
   cd       => FGREP_FN
  );

# things outsiders are allowed to mangle:
%VISIBLE_INTERNAL = (
		     COMP_MAP   => 1,
		     KEYWORDS   => 1,
		     COMMANDS   => 1,
		     DBI_ATTRIB => 1,
		     DBI_DRIVER => 1
		     );

BEGIN
{
    foreach my $c (@{$DBI::EXPORT_TAGS{sql_types}})
    {
	$DBI_TYPE{&{ $::{'DBI::'}{$c} }()} = $c;
    }
}


sub xwarn {}
#sub xwarn { warn(@_) }

sub new ($;$$)
{
    #warn("DBIShell::DEFAULT->new(@_) called\n");
    my $package = ref($_[0]) ? ref(shift()) : shift();
    my $dbi_drv = shift() || 'NullP';
    my $sh      = $_[0];

    my $engine = {
		  ERRNO      => 0,
		  ERROR      => '',
		  PROMPT     => '',
		  TITLE      => '',
		  DBH        => undef(),
		  HELP       => DBIShell::Help->new($dbi_drv),
		  DBI_DRIVER => $dbi_drv,
		  DBI_ATTRIB => DBI_ATTRIB,
		  COMP_MAP   => { COMPLETION_MAP() },
		  KEYWORDS   => [ KEYWDS()         ],
		  COMMANDS   => [ CMNDS()          ],
		  TABLES     => undef(),
		  PROCS      => undef(),
		  VIEWS      => undef(),
		  SEQUENCES  => undef(),
		  TRIGGERS   => undef(),
		  USERS      => undef(),
		  FIELDS     => {},
		  DR_DATA    => {},
		 };

    bless($engine, $package);

    $engine->set_initvars($sh);

    return $engine;
}

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

    $sh->setvar("CASE_SENSITIVE=0");
    $sh->setvar("PRESCAN_ROWS=1");
    $sh->setvar("TRUNCATE_COLUMN_NAMES=0");
    $sh->setvar(join('=', DRIVER => ref($engine)));
}

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

sub prompt ($;$){ if(@_>1){$_[0]->{PROMPT}     = $_[1]} $_[0]->{PROMPT}     }
sub title  ($;$){ if(@_>1){$_[0]->{TITLE}      = $_[1]} $_[0]->{TITLE}      }
sub driver ($;$){ if(@_>1){$_[0]->{DBI_DRIVER} = $_[1]} $_[0]->{DBI_DRIVER} }

sub _var ($$;$)
{
    my $engine = shift(@_);
    my $v_name = shift(@_);

    if($VISIBLE_INTERNAL{$v_name})
    {
	if (@_) { $engine->{$v_name} = $_[0] }
	return $engine->{$v_name};
    }
    else
    {
	$engine->{ERRNO} = -1;
	$engine->{ERROR} = "$v_name not an allowed variable";
	return undef;
    }
}

sub commands ($)
{
    (ref($_[0]->{COMMANDS}) eq 'ARRAY') ? @{ $_[0]->{COMMANDS} } :
      (ref($_[0]->{COMMANDS}) eq 'HASH') ? keys(%{$_[0]->{COMMANDS}}) :
	();
}

sub keywords ($)
{
    (ref($_[0]->{KEYWORDS}) eq 'ARRAY') ? @{ $_[0]->{KEYWORDS} } :
      (ref($_[0]->{KEYWORDS}) eq 'HASH') ? keys(%{$_[0]->{KEYWORDS}}) :
	();
}

sub _triggers  ($) { () }
sub _sequences ($) { () }
sub _users     ($) { () }
sub _views     ($) { () }
sub _procs     ($) { () }
sub _tables    ($) { $_[0]->dbh()->tables() }

sub users ($)
{
    if(!$_[0]->{USERS} && $_[0]->UNIVERSAL::can('load_users'))
    {
	$_[0]->load_users();
    }

    (ref($_[0]->{USERS}) eq 'ARRAY') ? @{ $_[0]->{USERS} } :
      (ref($_[0]->{USERS}) eq 'HASH') ? keys(%{$_[0]->{USERS}}) :
	(eval { $_[0]->_users() });
}

sub sequences ($)
{
    if(!$_[0]->{SEQUENCES} && $_[0]->UNIVERSAL::can('load_sequences'))
    {
	$_[0]->load_sequences();
    }

    (ref($_[0]->{SEQUENCES}) eq 'ARRAY') ? @{ $_[0]->{SEQUENCES} } :
      (ref($_[0]->{SEQUENCES}) eq 'HASH') ? keys(%{$_[0]->{SEQUENCES}}) :
	(eval { $_[0]->_sequences() });
}

sub triggers ($)
{
    if(!$_[0]->{TRIGGERS} && $_[0]->UNIVERSAL::can('load_triggers'))
    {
	$_[0]->load_triggers();
    }

    (ref($_[0]->{TRIGGERS}) eq 'ARRAY') ? @{ $_[0]->{TRIGGERS} } :
      (ref($_[0]->{TRIGGERS}) eq 'HASH') ? keys(%{$_[0]->{TRIGGERS}}) :
	(eval { $_[0]->_triggers() });
}

sub procs ($)
{
    if(!$_[0]->{PROCS} && $_[0]->UNIVERSAL::can('load_procs'))
    {
	$_[0]->load_procs();
    }

    (ref($_[0]->{PROCS}) eq 'ARRAY') ? @{ $_[0]->{PROCS} } :
      (ref($_[0]->{PROCS}) eq 'HASH') ? keys(%{$_[0]->{PROCS}}) :
	(eval { $_[0]->_procs() });
}

sub tables ($)
{
    if(!$_[0]->{TABLES} && $_[0]->UNIVERSAL::can('load_tables'))
    {
	$_[0]->load_tables();
    }

    (ref($_[0]->{TABLES}) eq 'ARRAY') ? @{ $_[0]->{TABLES} } :
      (ref($_[0]->{TABLES}) eq 'HASH') ? keys(%{$_[0]->{TABLES}}) :
	map { s/\"(\w+)\"\./${1}./g; $_ } (eval { $_[0]->_tables() });
}

sub views ($)
{
    if(!$_[0]->{VIEWS} && $_[0]->UNIVERSAL::can('load_views'))
    {
	$_[0]->load_views();
    }

    (ref($_[0]->{VIEWS}) eq 'ARRAY') ? @{ $_[0]->{VIEWS} } :
      (ref($_[0]->{VIEWS}) eq 'HASH') ? keys(%{$_[0]->{VIEWS}}) :
	map { s/\"(\w+)\"\./${1}./g; $_ } (eval { $_[0]->_views() });
}

sub obj_types (;@) { qw(tables views procs triggers sequences users) }

sub objs ($)
{
    my @obj;
    my $engine = $_[0];

    foreach my $type ($engine->obj_types())
    {
	push(@obj,
	     ($engine->UNIVERSAL::can($type) || UNDEF_FN)->($engine)
	    );
    }

    return @obj;
}

sub fields ($$) {()}

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

    $sh->errputf(CONTEXT_WARN,
		 "Sorry: %s cannot extract SQL definitions\n",
		 ref($engine)
		);

    return 0;
}

sub show ($$$)
{
    my $engine = shift(@_);
    my $sh     = shift(@_);
    my $target = shift(@_);

    if($target =~ /^(tables|procs|views|triggers|users|sequences)\b/i)
    {
	my $type = $1;
	my @list = ($engine->UNIVERSAL::can($type) || UNDEF_FN)->($engine);
	$sh->errputf(CONTEXT_NIL, " \n");
	$sh->start_pager(scalar(@list) + 5);
	foreach (@list) { $sh->outputf(CONTEXT_ITEM, "%s\n", $_) }
	$sh->stop_pager();
	return 1;
    }
    elsif ($engine->UNIVERSAL::can('dump_def'))
    {
	return $engine->dump_def($sh, $target);
    }

    return undef;
}

sub describe ($$$)
{
    my($i,$dbh,$sth,$query);
    my $engine = shift(@_);
    my $sh     = shift(@_);
    my $target = shift(@_);

    my $csep;
    $csep = $sh->getvar('FIELD_SEPARATOR');
    $csep = defined($csep) ? $csep : '|';

    $i = 0;
    $query = sprintf(DESCQ, $target);

    if ($dbh = $engine->dbh())
    {
	if ($sth = $dbh->prepare($query))
	{
	    if ($sth->execute())
	    {
		my $X = @{$sth->{NAME}};
		$i = 1;
		$sh->errputf(CONTEXT_NIL, " \n");
		$sh->start_pager($X);
		#foreach (qw(NAME TYPE PRECISION SCALE NULLABLE))
		#{
		#    warn("$_ : [ ", join('|',@{$sth->{$_}})," ]\n");
		#}

		for (my $x = 0; $x < $X; $x++)
		{
		    my $fmt =
		      join(" $csep ",'%-30s','%-20s','%5d.%-5d',"%s\n");
		    $sh->outputf(CONTEXT_DATA,
				 $fmt,
				 $sth->{NAME}[$x],
				 $DBI_TYPE{$sth->{TYPE}[$x]},
				 $sth->{PRECISION}[$x],
				 $sth->{SCALE}[$x],
				 $sth->{NULLABLE}[$x]?'NULL':'NOT NULL'
				);
		}
		$sh->stop_pager();
		$sth->finish();
	    }
	    else
	    {
		$engine->{ERROR} =
		  sprintf("EXECUTE failed: %s: %s", $query, $sth->errstr);
	    }
	}
	else
	{
	    $engine->{ERROR} =
	      sprintf("PREPARE failed: %s: %s", $query, $dbh->errstr);
	}
    }
    else
    {
	$engine->{ERROR} = "No database handle available";
    }

    return $i;
}

sub connect			#($$)
{
    #    warn("DBIShell::DEFAULT->connect()\n");
    my $dbh;
    my $title;
    my $engine = shift(@_);
    my $opt    = shift(@_);
    my $attrib = shift(@_) || $engine->{DBI_ATTRIB};
    my $dbd    =
      ($opt->{driver} eq 'Proxy') ?
	'Proxy' :
	  ($engine->{DBI_DRIVER} || $opt->{driver});
    my $connstr = join(':', dbi => $dbd, $opt->{dsn} );
    my $kludge  = FALSE;

    # attempt to make an actual connection:
    eval
    {
	$dbh = DBI->connect( $connstr, $opt->{user}, $opt->{pass}, $attrib );
	$kludge = $DBI::errstr;
    };

    # problem: DBI->connect won't generate an error inside an eval (!):
    # or rather it throws an error of undef(), which is hellaciously
    # confusing, since the eval bombs out, but none of the standard $@
    # tests will indicate that it did so. So kludge it, and fake up an
    # appropriate error. ( Note that if it did bomb our, $DBI::errstr
    # itself seems to become inaccessible in some bletchereous way, so
    # we have to kludge our kludge, too.... )
    if( !$dbh )
    {
      FAKE_ERROR:
	if( !$kludge )
	{
	    my @dbd;
	    @dbd = DBI->available_drivers();

	    foreach my $dr (@dbd)
	    {
		if ( $dr eq $dbd )
		{
		    $kludge =
		      "Null Error during connect($dbd) (bug in DBI)\n";
		    last FAKE_ERROR;
		}
	    }
	    $kludge = <<TXT;
connect for $dbd failed: DBD::$dbd not found?
Available DBD drivers: [ @dbd ]
TXT
	}

	# oops, we threw an exception
	if ( $kludge )
	{
	    $engine->{ERRNO} = -1;
	    $engine->{ERROR} = $kludge;
	    return undef();
	}
    }

    $engine->{DBH} = $dbh;

    $opt->{dsn} =~ /^(\S+=\S+)/;
    $title =
      join(':', dbi => $opt->{driver},
	   (length($1)?$1:()),
	   (length($opt->{user}) ? $opt->{user} : ())
	  );

    $engine->{TITLE}  = $title;
    $engine->{PROMPT} = "$title>";

    return $dbh;
}

sub disconnect ($)
{
    my $engine = shift(@_);
    my $dbh = $engine->dbh();

    if($dbh)
    {
	# commit on exit:
	$dbh->{AutoCommit} || $dbh->commit();
	$dbh->disconnect();
    }
}

# complete_word(OBJECT, WORD [, FRAGMENT[, CTFN_CODEREF]])
sub complete_word ($$;$$)
{
    my $E = $_[0]; # engine object
    my $W = $_[1]; # last complete word
    # OPTIONAL:
    my $F = $_[2]; # thing we're trying to complete
    my $C = $_[3]; # CTFN function ref

    my $f = lc($F);
    my $l = length($F);

    if(exists($E->{COMP_MAP}) && exists($E->{COMP_MAP}{lc($W)}))
    {
	my $thing = $E->{COMP_MAP}{lc($W)};
	my $ref   = ref($thing);

	return
	  ($ref eq 'ARRAY') ?
	    (wantarray ? (grep {lc(substr($_,0,$l)) eq $f } @$thing) : 1) :
	      ($ref eq 'CODE') ?
		(wantarray ? $thing->($E,$F,$C) : 1) :
		  ();
    }

    return ();

    # exists($_[0]->{COMP_MAP}) && exists($_[0]->{COMP_MAP}{lc($_[1])}) ?
    #	(wantarray ? @{$_[0]->{COMP_MAP}{lc($_[1])}} : 1):
    #	  ();
}

sub complete ($$$$$)
{
    my $CTFN;
    my @clist;
    my $E  = shift();
    my $sh = shift();

    # xwarn("\nCOMPLETE ",join('/',@_),"\n");
    # text: word or part word we are trying to tab complete [may be '']
    # line: the whole line so far
    # pos:  postion in line [0 indexed] at which text starts

    my($text, $line, $pos) = @_;
    my $ltext = lc($text);
    my $l     = length($text);
    my $cs    = $sh->getvar('CASE_SENSITIVE');
    my $fw    = $sh->getvar('FUSSY_COMPLETION_WORKAROUND');

    if($cs) { $CTFN = sub { $_[0]     } }
    else    { $CTFN = sub { lc($_[0]) } }

    # if we're at the beginning of the line, just return basic commands:
    # note that this is basically wrong for multiline commands on all but
    # the first line, but if you're tabbing on the 0th character of a line,
    # you've basically provided no context at all, so what are you
    # bitching about anyway?

    if (substr($line, 0, 1) eq '!')
    {
	# shell command completion
	if($pos == 0)
	{
	    # shell command itself
	    xwarn("COMPLETE SHELL [$line/$text/$pos/$l]\n");
	    my @com;
	    my $tx = substr($text,1);
	    my $ll = $l - 1;
	    xwarn("COMPLETE SHELL [$line/$tx/$pos/$l]\n");

	    foreach (split(/:/, $ENV{PATH}))
	    {
		my($dirent);
		local(*DH);

		-d($_)           || next;
		opendir(*DH, $_) || next;

		while($dirent = readdir(*DH))
		{
		    -x(join('/',$_,$dirent))
		      && push(@com, $dirent)
		}
		closedir(*DH);
	    }

	    $ll || return @com;
	    # 4 arg substr not available in 5.004
	    return
	      grep { (substr($_,0,$ll) eq $tx) && (substr($_,0,$ll) = $text) }
		@com;
	}
	else
	{
	    # shell file completion

	    @clist = $E->grep_fs($text);
	    return @clist;
	}
    }
    elsif (!$pos)
    {
	# completion at start of line
	# this one is _always_ case insensitive:
	xwarn("COMPLETE COMMANDS\n");

	if($l){@clist = grep {lc(substr($_, 0, $l)) eq $ltext} $E->commands()}
	else  {@clist = $E->commands()                                       }
    }
    elsif (substr($line, $pos-1, 1) eq '$')
    {
	# variable-name completion
	# this one is always case sensitive:
	xwarn("COMPLETE VARIABLES\n");
	if($l){ @clist = grep { substr($_, 0, $l) eq $text } $sh->variables() }
	else  { @clist = $sh->variables()                                     }
    }
    elsif (($pos > 1) && (substr($line, $pos-2, 2) =~ /^\$[<>]$/))
    {
	# parameter completion
	# this one is always case sensitive:
	# similar to variables, but we don't allow DBI paramaters

	xwarn("COMPLETE PARAMETER CANDIDATES\n");
	my @pc = grep { !/^dbi:/ } $sh->variables();

	if ($l) { @clist = grep { substr($_, 0, $l) eq $text } @pc }
	else    { @clist = @pc                                     }
    }
    else
    {
	# houston, we have a thing....

	# fcontext == full context, except this word
	# pcontext == last complete word

	my $fcontext = substr($line, 0, $pos);
	$fcontext =~ /(\w+)\W+$/;
	my $pcontext = $1;

	if ($E->complete_word($pcontext))
	{
	    # is the word in our completion map:
	    # always case insensitive ? maybe not...
	    # we have to do funky things w. table names...
	    xwarn("COMPLETE from MAP\n");
	    @clist = $E->complete_word($pcontext, $text, $CTFN);
	}
	else
	{
	    # are we dealing with schema.table.TEXT type completion?
	    my $dp = rindex($ltext, '.');

	    # if so, try to work out a column name:
	    # [Note: doesn't see to work right yet]
	    if ($dp != -1)
	    {
		xwarn("COMPLETE FIELD [$fcontext/$pcontext]\n");
		my $schema = substr($ltext, 0, $dp + 1);
		my $fieldp = substr($ltext, $dp + 1);

		# get a list of fields [columns] matching our schema
		my @L =
		  $E->UNIVERSAL::can('fields') ?
		    $E->fields($schema) :
		      ();

		# if our field name has nonzero length, filter:
		if (!length($fieldp))
		{
		    my $L = $l - $dp;
		    @L = grep { substr($_, 0, $L) eq $fieldp } @L;
		}

		# return, remembering to tack the schema back on if
		# necessary:
		if (length($schema))
		{
		    @clist = map { join('.', $schema, $_) } @L;
		}
		else { @clist =  @L }
	    }
	    else
	    {
		xwarn("COMPLETE GENERIC [$fcontext/$pcontext]\n");
		@clist =
		  ((grep { lc(substr($_, 0, $l)) eq lc($text) }
		    (($E->UNIVERSAL::can('commands')? $E->commands():()),
		     ($E->UNIVERSAL::can('keywords')? $E->keywords():())
		    )
		   ),
		   (grep { $CTFN->(substr($_, 0, $l)) eq $CTFN->($text) }
		    (($E->UNIVERSAL::can('tables')  ? $E->tables()  :()),
		     ($E->UNIVERSAL::can('procs')   ? $E->procs()   :())
		    )
		   )
		  );
	    }
	}
    }

    if($fw && $l) { return grep { substr($_, 0, $l) = $text } @clist }

    return @clist;
}

sub grep_fs ($$;$)
{
    my @list;
    my $engine   = shift();
    my $TX       = shift();
    my $CTFN     = shift(); # Not used. Have assumed fs is case sensitive

    @list = map { -d($_) ? "$_/" : $_ } glob(join('', $TX, '*'));

    # if we have a singular completion to a directory, recurse into it:
    if((@list == 1) && -d(_)) { push(@list, $engine->grep_fs($list[0])) }

    return @list;
}

sub grep_tabnames ($$$)
{
    my $engine   = shift();
    my $TX       = shift();
    my $CTFN     = shift() || sub { $_[0] };
    my @tables   = $engine->tables();
    my @views    = $engine->views();

    my $l        = length($TX);

    if(!$l) { return (@tables,@views) }

    return $engine->nonschema_grep($TX, $CTFN, (@tables,@views));
}

sub grep_objnames ($$$)
{
    my $engine   = shift();
    my $TX       = shift();
    my $CTFN     = shift() || sub {$_[0]};

    my @things   = $engine->objs();
    my $l        = length($TX);

    if(!$l) { return @things }

    return $engine->nonschema_grep($TX, $CTFN, @things);
}

sub grep_shownames ($$$)
{
    my $engine   = shift();
    my $TX       = shift();
    my $CTFN     = shift() || sub {$_[0]};

    my @things   = $engine->showables();
    my $l        = length($TX);

    if(!$l) { return @things }

    return $engine->nonschema_grep($TX, $CTFN, @things);
}

sub showables ($;@) { return qw(tables) }

sub nonschema_grep ($$$@)
{
    my %tn;
    my $engine   = shift();
    my $text     = shift();
    my $CTFN     = shift() || sub{ $_[0] };
    my $tx       = $CTFN->($text);
    my $l        = length($tx);

#    warn(<<ARGH);
#CALLER: @{[caller()]}
#TARGET: $text
#SOURCE: @_
#ARGH

    foreach my $O (@_)
    {
	(length($O) >= $l)                       && ($tn{$CTFN->($O)} = 1);
	($O  =~ /\.(.*)$/) && (length($1) >= $l) && ($tn{$CTFN->($1)} = 1);
    }

    return grep { $CTFN->(substr($_,0,$l)) eq $text } keys(%tn);
}

sub load_triggers ($)
{
    my @triggers;
    my $engine = shift(@_);
    my $cache;

    eval
    {
	$cache  = $engine->{TRIGGERS};
	$engine->{TRIGGERS} = undef();
	@triggers = $engine->_triggers();
    };

    if ($@)
    {
	#warn("Loading triggers: ERROR!\n");
	$engine->{TRIGGERS} = $cache;
	$engine->{ERROR}  = $@;
	return undef;
    }
    else
    {
	#warn("Loading triggers: OK\n");
	$engine->{TRIGGERS} = \@triggers;
	return 1;
    }
}

sub load_sequences ($)
{
    my @sequences;
    my $engine = shift(@_);
    my $cache;

    eval
    {
	$cache  = $engine->{SEQUENCES};
	$engine->{SEQUENCES} = undef();
	@sequences = $engine->_sequences();
    };

    if ($@)
    {
	#warn("Loading sequences: ERROR!\n");
	$engine->{SEQUENCES} = $cache;
	$engine->{ERROR}  = $@;
	return undef;
    }
    else
    {
	#warn("Loading sequences: OK\n");
	$engine->{SEQUENCES} = \@sequences;
	return 1;
    }
}

sub load_users ($)
{
    my @users;
    my $engine = shift(@_);
    my $cache;

    eval
    {
	$cache  = $engine->{USERS};
	$engine->{USERS} = undef();
	@users = $engine->_users();
    };

    if ($@)
    {
	#warn("Loading users: ERROR!\n");
	$engine->{USERS} = $cache;
	$engine->{ERROR}  = $@;
	return undef;
    }
    else
    {
	#warn("Loading users: OK\n");
	$engine->{USERS} = \@users;
	return 1;
    }
}

sub load_tables ($)
{
    my @tables;
    my $engine = shift(@_);
    my $cache;

    eval
    {
	$cache  = $engine->{TABLES};
	$engine->{TABLES} = undef();
	@tables = $engine->_tables();
    };

    if ($@)
    {
	#warn("Loading tables: ERROR!\n");
	$engine->{TABLES} = $cache;
	$engine->{ERROR}  = $@;
	return undef;
    }
    else
    {
	#warn("Loading tables: OK\n");
	$engine->{TABLES} = \@tables;
	return 1;
    }
}

sub load_views ($)
{
    my @views;
    my $engine = shift(@_);
    my $cache;

    eval
    {
	$cache  = $engine->{VIEWS};
	$engine->{VIEWS} = undef();
	@views = $engine->_views();
    };

    if ($@)
    {
	#warn("Loading views: ERROR!\n");
	$engine->{VIEWS} = $cache;
	$engine->{ERROR}  = $@;
	return undef;
    }
    else
    {
	#warn("Loading views: OK\n");
	$engine->{VIEWS} = \@views;
	return 1;
    }
}


sub load_procs ($)
{
    my @procs;
    my $engine = shift(@_);
    my $cache;

    eval
    {
	$cache  = $engine->{PROCS};
	$engine->{PROCS} = undef();
	@procs = $engine->_procs();
    };

    if ($@)
    {
	#warn("Loading procs: ERROR!\n");
	$engine->{PROCS} = $cache;
	$engine->{ERROR}  = $@;
	return undef;
    }
    else
    {
	#warn("Loading procs: OK\n");
	$engine->{PROCS} = \@procs;
	return 1;
    }
}


sub load_columns ($@)
{
    my $i      = undef;
    my $engine = shift(@_);
    my $dbh    = $engine->dbh();

    unless($dbh)
    {
	$engine->{ERROR} = "No database handle available";
	return undef;
    }

    my @err;
    my @tables = @_ ? @_ : eval { $engine->tables };

    foreach my $tab (@tables)
    {
	my $query = sprintf(DESCQ, $tab);
	my $sth   = $dbh->prepare($query)
	  || (push(@err, $dbh->errstr),next);
	$sth->execute()
	  || (push(@err, $sth->errstr),$sth->finish(),next);

	$engine->{FIELDS}       ||= {};
	$engine->{FIELDS}{$tab}  =  [ @{$sth->{NAME}} ];

	$i++;
	$sth->finish();
    }

    if (@err) { $engine->{ERROR} = join("\n", @err) }

    return $i;
}

sub noscan_format ($$$)
{
    my $buf;
    my $engine = shift(@_);
    my $sh     = shift(@_);
    my $sth    = shift(@_);

    my $csep;
    $csep  = $sh->getvar('FIELD_SEPARATOR');
    $csep  = defined($csep) ? $csep : '|';

    my @fmt;

    eval
    {
	$buf = $sth->{PRECISION};
	$buf = $sth->{SCALE};
    };

    if ($@)
    {
	$sh->errputf(CONTEXT_WARN, <<OldDriverWarning);
DBD driver is out of date: PRECISION/SCALE not supported
Turning on PRESCAN_ROWS to work around problem
Data may look mangled this time around
OldDriverWarning

	$sh->set_show_var('PRESCAN_ROWS=1');

	return join($csep, (('%s') x $sth->{NUM_OF_FIELDS}), "\n");
    }

    for (my $p = 0; $p < $sth->{NUM_OF_FIELDS}; $p++)
    {
	my $x = 2;
	$x           += $sth->{PRECISION}[$p];
	$x           += $sth->{SCALE}[$p];
	($x >  $sth->{LongReadLen}) && ($x = $sth->{LongReadLen});
	($x == 2)                   && ($x = $sth->{LongReadLen});
	($x >  3)    || ($x = 4);

	#printf(STDERR "FIELD[%d] : %d . %d -> %d\n", $p,
	#       $sth->{PRECISION}[$p],
	#       $sth->{SCALE}[$p], $x
	#      );

	$fmt[$p] = join('','%-',$x,'.',$x,'s');
    }

    return join($csep, @fmt, "\n");
}

sub prescan_format ($$$$)
{
    my @fmt;
    my @len;
    my $ncols;
    my $csep;

    my $engine = shift(@_);
    my $sh     = shift(@_);
    my $sth    = shift(@_);
    my $data   = shift(@_);

    $ncols = $sth->{NUM_OF_FIELDS};
    $csep  = $sh->getvar('FIELD_SEPARATOR');
    $csep  = defined($csep) ? $csep : '|';

    @len  = ((4) x $ncols);

    for(my $x = 0; $x <= $#{$data}; $x++)
    {
	for(my $y = 0; $y < $ncols; $y++)
	{
	    my $l = length($data->[$x][$y]);
	    ($l > $len[$y]) && ($len[$y] = $l);
	}
    }

    unless($sh->getvar('TRUNCATE_COLUMN_NAMES'))
    {
	for(my $z = 0; $z < $ncols; $z++)
	{
	    my $l = length($sth->{NAME}[$z]);
	    ($l > $len[$z]) && ($len[$z] = $l);
	}
    }

    for(my $z = 0; $z < $ncols; $z++)
    {
	$fmt[$z] = join('','%-',$len[$z],'.',$len[$z],'s');
    }

#    for(my $z = 0; $z < $ncols; $z++)
#    {
#	if(IS_NUMERIC($sth->{TYPE}[$z]))
#	{
#	    my $x = 2 + $sth->{PRECISION}[$z] + $sth->{SCALE}[$z];
#	    ($x > 3) || ($x = 4);
#	    $fmt[$z] = join('','%-',$x,'.',$x,'s');
#	}
#	else
#	{
#	    $fmt[$z] = join('','%-',$len[$z],'.',$len[$z],'s');
#	}
#    }

    return join($csep, @fmt, "\n");
}

sub map_inout_parameters ($$$)
{
    my $engine = shift(@_);
    my $sh     = shift(@_);
    my $query  = shift(@_);

    $sh->clear_parameters();

    while ($query =~ s/([^\\])\$([<>])((?:[\w]+:)?\w+)/$1?/)
    {
	$sh->put_parameter($3, ($2 eq '<') ? PARAM_OUT : PARAM_IN);
    }

    #warn("MIP:mapped:<$query>\n");
    return $query;
}

sub bind_parameters ($$$)
{
    my $engine = shift(@_);
    my $sh     = shift(@_);
    my $sth    = shift(@_);

    for (my $n = 0; $n < $sth->{NUM_OF_PARAMS}; $n++)
    {
	eval
	{
	    my $io = $sh->get_parameter_io($n);
	    if    ($io == PARAM_IN)
	    {
		$sth->bind_param($n + 1, ${ $sh->get_parameter($n) })
		  || die($sth->errstr,"\n");
	    }
	    elsif ($io == PARAM_OUT)
	    {
		$sth->bind_param_inout($n + 1, $sh->get_parameter($n), 255)
		  || die($sth->errstr,"\n");
	    }
	}
	  || $sh->errputf(CONTEXT_ERR,
			  "bind_param_inout() failed: %s\n",
			  $sth->errstr || $@);
    }
}

sub help ($$$)
{
    my $engine = $_[0];
    my $sh     = $_[1];
    my $thing  = $_[2];

    my $rv = eval
    {
	if($ENV{PAGER} && open(PAGER, "|$ENV{PAGER}"))
	{
	    printf(PAGER "%s\n\n", $engine->{HELP}->help($thing));
	    close(PAGER);
	}
	else
	{
	    $sh->errputf(CONTEXT_HELP,
			 "%s\n\n",
			 $engine->{HELP}->help($thing)
			);
	}

	return 1;
    };

    return $rv || undef;
}

sub fetch_results ($$$)
{
    my $i      = undef;
    my $engine = shift(@_);
    my $sh     = shift(@_);
    my $sth    = shift(@_);

    if($sh->getvar('PRESCAN_ROWS'))
    {
	# fetchall arrayref seems to invalidate a whole bunch of
	# handle attributes, so we have to precache them:
	my $dummy_sth = DBIShell::UTIL::cache_sth_attr($sth);

	my $data = $sth->fetchall_arrayref();
	my $fmt  = $engine->prescan_format($sh,$dummy_sth,$data);

	$sh->errputf(CONTEXT_NIL, " \n");

	$sh->start_pager($#{$data} + 3);
	$sh->outputf(CONTEXT_HEAD, $fmt, @{ $dummy_sth->{NAME} });
	for ($i = 0; $i <= $#{$data}; $i++)
	{
	    $sh->outputf(CONTEXT_DATA, $fmt, _NULLS(@{ $data->[$i] }));
	}
	$sh->stop_pager();
    }
    else
    {
	my %row;
	my $fmt;

	unless($sth->bind_columns(undef, \@row{@{ $sth->{NAME} }}))
	{
	    $engine->{ERROR} = $sth->errstr;
	    return 0;
	}

	$fmt = $engine->noscan_format($sh,$sth);

	$sh->errputf(CONTEXT_NIL, " \n");

	$sh->start_pager($sth->rows());
	$sh->outputf(CONTEXT_HEAD, $fmt, @{ $sth->{NAME} });
	while ($sth->fetchrow_arrayref())
	{
	    $sh->outputf(CONTEXT_DATA, $fmt, _NULLS(@row{@{ $sth->{NAME} }}));
	    $i++;
	}
	$sh->stop_pager();
    }

    $sh->errputf(CONTEXT_META, "%d rows returned\n", $i);

    # return the number of rows fetched, but make it always true:
    return int($i) ? $i : '0E0';
}

sub interpret ($$)
{
    my $i      = undef;

    my $engine = shift(@_);
    my $sh     = shift(@_);
    my $query  = shift(@_);

    #xwarn("INTERPRET [$query]\n");
    #$query =~ /^\s*describe/si && return $i;

    if ($query =~ /^\s*help\s+(.*)/i)
    {
	my $thing = $1;
	$thing =~ s/\s+$//g;
	$thing =~ s/ /_/g;
	#warn("REQUESTING HELP FOR $thing\n");
	return $engine->help($sh,$thing);
    }

    if ($query =~ /^\s*load\s/si)
    {
	# we can attempt to use the H->tables functionality,
	# wrapped in an eval, just in case the DBD driver
	# implements something: SQL9X is no use - it [as usual]
	# specifies no standards or behaviours for
	# this that I am aware of:
	if ($query =~ /tables/i)          { $i = $engine->load_tables() }
	if ($query =~ /proc(?:edure)?s/i) { $i = $engine->load_procs()  }

	# we can use describe functionality to accomplish this one:
	# as DBI will allow us to describe tables by doing a select
	# that will never return rows [where 1 = 0 clause, for example]
	if ($query =~ /fields(?:\s+(.*))?/i)
	{
	    my $tbl = $1;
	    my @tbl = split(/\s+/, $tbl);

	    unless (@tbl) { @tbl = $engine->tables() }
	    $i = $engine->load_columns(@tbl);
	}

	# there's no DBI or SQL9X spec for procedures,
	# and COMMANDS and KEYWORDS are purely up to the
	# specific driver anyway, so they can be loaded as constants:
    }
    elsif ($query =~ /^\s*describe\s+(\S+)/si)
    {
	$i = $engine->describe($sh, $1);
    }
    elsif ($query =~ /^\s*show\s+(\S+)/)
    {
	$i = $engine->show($sh, $1);
    }
    else
    {
	my($sth,$nparam);
	my $dbh = $engine->dbh();

	#xwarn("Attempting to INTERPRET SQL [$dbh]\n");
	$query = $engine->map_inout_parameters($sh,$query);

	unless($sth = $dbh->prepare($query))
	{
	    $engine->{ERROR} = $dbh->errstr;
	    return 0;
	}

	#xwarn("QUERY prepared [$sth]\n");
	# most likely this will fail, since only DBD::Oracle;
	# supports bind_param_inout as of this moment [afaik]
	# but it won't hurt:
	if ($nparam = $sth->{NUM_OF_PARAMS})
	{
	    $engine->bind_parameters($sh, $sth);
	}

	#$sth->{LongReadLen} = $dbh->{LongReadLen};
	#$sth->{LongTruncOk} = $dbh->{LongTruncOk};

	unless($sth->execute())
	{
	    $engine->{ERROR} = $sth->errstr;
	    return 0;
	}

	#xwarn("QUERY executed");
	# are we in a select type query?
	if ($sth->{NUM_OF_FIELDS})
	{
	    $i = $engine->fetch_results($sh,$sth);
	}
	else			# or is this a non-row returning thing?
	{
	    my $n = $sth->rows();
	    my $nstr =
	      (defined($n) && ($n >= 0))?
		(($n == 1)?"$n row":"$n rows"):
		  'unknown number of rows';

	    $sh->errputf(CONTEXT_META, "Ok - %s affected\n", $nstr);
	    $i++;
	}

	# did we have parameters? print them out:
	for (my $x = 0; $x < $nparam; $x++)
	{
	    ($sh->get_parameter_io($x) == PARAM_OUT) || next;

	    $x || $sh->errputf(CONTEXT_NIL, " \n");

	    my $pname = $sh->get_parameter_name($x);
	    $sh->outputf(CONTEXT_META,
			 "Parameter [%s] == %s\n",
			 $pname,
			 _NULLS($sh->getvar($pname))
			);
	}
    }

    return $i;
}

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

=pod

=head1 NAME

DBIShell::dr::DEFAULT - Default DBI engine/driver thingy

=head1 SYNOPSIS

use DBIShell::dr::DEFAULT qw(HGREP_FN TGREP_FN);

=head1 DESCRIPTION

This is the default 'engine' that dbishell uses when it can't find a
DBD Driver specific engine. It also provides the bulk of the functionality
of all the DBD-Driver specific engines written so far. It is also the de-facto
interface definition/reference implementation for all the dbishell engines,
since DBIShell assumes all drivers present a uniform interface. Enough
babble, on to the documentation:

=head1 EXPORTED_SYMBOLS

=over 4

=item HGREP_FN

Utility function for returning a list of help topics matching a fragment
See L</$engine-E<gt>complete_word(WORD, FRAGMENT, CTFN)>

=item TGREP_FN

Utility function for returning a list of help topics matching a fragment
See L</$engine-E<gt>complete_word(WORD, FRAGMENT, CTFN)>

=back

=head1 DATA_MEMBERS

=head2 So what are they?

We're using the standard 'blessed hash reference' for objects here: data
members are the elements of the hash. So for those of you who asked, now you
know.

=head2 ERRNO

Contains the value of the last system error [eg ENOENT, EINVAL, EHOSTUNREACH]
that the engine incurred. Not used much, but handy when debugging,

=head2 ERROR

Contains the last error string generated by the engine.

=head2 PROMPT

The user prompt string.

=head2 TITLE

The 'title' assigned to the shell. Not curently used, but I might make it
set the xterm title, if an xterm is detected. I think that's what I wanted
it for.

=head2 DBH

The DBI Database handle.

=head2 HELP

The Object that provides help information.

=head2 DBI_DRIVER

The name of the DBD driver [Oracle, Sybase, ODBC, mysql, whatever... ] we
want to load.

=head2 DBI_ATTRIB

Hash reference containing the default DBI attributes to use when connecting.

=head2 COMP_MAP

The tab completion map [a hash of lists and functions].

See L</$engine-E<gt>complete_word(WORD, FRAGMENT, CTFN)>

=head2 KEYWORDS

List reference containing a list of keywords understood by the
shell/engine/SQL engine.

See L</$engine-E<gt>complete_word(WORD, FRAGMENT, CTFN)>

=head2 COMMANDS

List reference containing all the commands understood by the shell/engine/SQL
engine.

See L</$engine-E<gt>complete_word(WORD, FRAGMENT, CTFN)>

=head2 TABLES

Initially undef, but may hold either a list of SQL tables or a hash of the
same. Loaded when the user issues a 'load tables' command, or when
engine->tables() is called [which in turn calls engine->load_tables()]

See Also:

=over 4

=item L</$engine->E<gt>tables()>

=item L</$engine->E<gt>load_tables()>

=item L</$engine->E<gt>_tables()>

=back

=head2 VIEWS

For view data. See:

=over 4

=item L</TABLES>

=item L</$engine->E<gt>views()>

=item L</$engine->E<gt>load_views()>

=item L</$engine->E<gt>_views()>

=back

=head2 PROCS

For procedure/function data:

=over 4

=item L</TABLES>

=item L</$engine->E<gt>procs()>

=item L</$engine->E<gt>load_procs()>

=item L</$engine->E<gt>_procs()>

=back

=head2 USERS

For user data:

=over 4

=item L</TABLES>

=item L</$engine->E<gt>users()>

=item L</$engine->E<gt>load_users()>

=item L</$engine->E<gt>_users()>

=back

=head2 SEQUENCES

For sequence data:

=over 4

=item L</TABLES>

=item L</$engine->E<gt>sequences()>

=item L</$engine->E<gt>load_sequences()>

=item L</$engine->E<gt>_sequences()>

=back

=head2 TRIGGERS

For trigger data:

=over 4

=item L</TABLES>

=item L</$engine->E<gt>triggers()>

=item L</$engine->E<gt>load_triggers()>

=item L</$engine->E<gt>_triggers()>

=back

=head2 FIELDS

An empty hash reference. I plan to use this to store table_name => field_list
data, so that field name tab completion can be attempted in certain
circumstances. [ Normally, the structure of SQL queries makes this impossible
except in update statements... [ Although the planned GTK interface might be able to do something shiny here ] ]

Not used yet, in any case...

=head2 DR_DATA

Hash for drivers that inherit from us to store private dr specific data in.

=head1 METHODS

=head2 DBIShell::dr::DEFAULT->new(DBD_DRIVER, SHELL_OBJ)

Creates, fills in and returns a new DBIShell::dr::DEFAULT object.
DBD_DRIVER is the name of the DBD_DRIVER to be used, (Oracle, mysql, etc)
and SHELL_OBJ is a reference the calling DBIShell object: new() requires
that this implements the ->setvar("LABEL=VALUE") method.

=head2 $engine->set_initvars(SHELL_OBJ)

Does the actual work of setting certain dbishell variables by calling 
->setvar("LABEL=VALUE") on the SHELL_OBJ passed to it.

=head2 $engine->dbh()

Returns the database handle that lies at the core of the engine.

=head2 $engine->error()

Returns the last error string generated by the engine.

=head2 $engine->errno()

Returns the last error number generated by the engine. You can find out what
this meant by assigning it to $! and then printing $! in a string context.

=head2 $engine->prompt()

Returns the prompt that should be displayed to the user.

=head2 $engine->title()

Returns the title that is currently in effect. This is the method that will be
called by dbishell to determine what to set xterm titles to, and so on, when
I implement those sorts of things.

=head2 $engine->driver()

Return the name of the DBD driver that the engine is using/will use.

=head2 $engine->_var()

This allows the caller to set the named data member to the value passed in,
but B<only> if the data member is on the 'allowed to mangle' list.

=head2 $engine->commands()

Returns a list of commands understood by the SQL engine, as far as is known
by the engine.

=head2 $engine->keywords()

Returns a list of dbishell/SQL keywords that are known by the engine.

=head2 $engine->procs()

Returns a list of procedures/functions:

If the cache is empty, tries to call $engine->load_procs() first.
If the cache is still empty after this call, it tries to call
$engine->_procs(), and returns the resulting list.

=over 4

=item L</PROCS>

=item L</$engine-E<gt>load_procs()>

=item L</$engine->E<gt>_procs()>

=back

=head2 $engine->tables()

Returns a list of tables:

If the cache is empty, tries to call $engine->load_tables() first.
If the cache is still empty after this call, it tries to call
$engine->_tables(), and returns the resulting list.

=over 4

=item L</TABLES>

=item L</$engine-E<gt>load_tables()>

=item L</$engine->E<gt>_tables()>

=back

=head2 $engine->users()

Returns a list of users:

If the cache is empty, tries to call $engine->load_tables() first.
If the cache is still empty after this call, it tries to call
$engine->_tables(), and returns the resulting list.

=over 4

=item L</USERS>

=item L</$engine-E<gt>load_users()>

=item L</$engine->E<gt>_users()>

=back

=head2 $engine->sequences()

Returns a list of sequences:

If the cache is empty, tries to call $engine->load_sequences() first.
If the cache is still empty after this call, it tries to call
$engine->_sequences(), and returns the resulting list.

=over 4

=item L</SEQUENCES>

=item L</$engine-E<gt>load_sequences()>

=item L</$engine->E<gt>_sequences()>

=back

=head2 $engine->views()

Returns a list of views:

If the cache is empty, tries to call $engine->load_views() first.
If the cache is still empty after this call, it tries to call
$engine->_views(), and returns the resulting list.

=over 4

=item L</VIEWS>

=item L</$engine-E<gt>load_views()>

=item L</$engine->E<gt>_views()>

=back

=head2 $engine->triggers()

Returns a list of triggers:

If the cache is empty, tries to call $engine->load_triggers() first.
If the cache is still empty after this call, it tries to call
$engine->_triggers(), and returns the resulting list.

=over 4

=item L</TRIGGERS>

=item L</$engine-E<gt>load_triggers()>

=item L</$engine->E<gt>_triggers()>

=back

=head2 $engine->_tables()

Fetches a list of tables directly from the DB. Guranteed never to look at the
cache.

=head2 $engine->_users()

Fetches a list of users directly from the DB. Guaranteed never to look at the 
cache. There is no generic way to do this, so dr::DEFAULT only provides a 
stubroutine

=head2 $engine->_sequences()

Fetches a list of sequences directly from the DB. Guaranteed never to look at the 
cache. There is no generic way to do this, so dr::DEFAULT only provides a 
stubroutine

=head2 $engine->_triggers()

Fetches a list of triggers directly from the DB. Guaranteed never to look at the 
cache. There is no generic way to do this, so dr::DEFAULT only provides a 
stubroutine

=head2 $engine->_procs()

Fetches a list of procs directly from the DB. Guaranteed never to look at the 
cache. There is no generic way to do this, so dr::DEFAULT only provides a 
stubroutine

=head2 $engine->_views()

Fetches a list of views directly from the DB. Guaranteed never to look at the 
cache. There is no generic way to do this, so dr::DEFAULT only provides a 
stubroutine

=head2 $engine->fields(TABLE)

Stubroutine that should consult the internal cache and return the field names
for TABLE. Not yet implemented.

=head2 $engine->show(SHELL_OBJ, TARGET)

Method used to implement the 'show' command, which displays a list of tables,
or proceures, or, if the engine knows how [ie if it implements a dump_def
method] some information about the named SQL object.

SHELL_OBJ should implement

    ->errputf(CONTEXT, FORMAT [,LIST])
    ->outputf(CONTEXT, FORMAT [,LIST])

TARGET is the name of the 'thing' we want to see. The names 'tables' and
'procs' are reserved, and will mask out objects in the SQL database with
those names.

=head2 $engine->describe(SHELL_OBJ, TARGET)

Displays a description of the named TARGET, using SHELL_OBJ for outputf and
errputf methods.

=head2 $engine->connect(OPT_HASH, CONN_ATTR_HASH)

Connects to the database according to the data in OPT_HASH, with the
parameters specified in CONN_ATTR_HASH. The keys expected in OPT_HASH
are:

  driver  : The DBD driver, eg: 'Sybase'
  dsn     : The dsn,        eg: 'hostname=narf;database=foo'      
  user    : The user name   eg: 'sa'
  pass    : The password    eg: 'changeme'

=head2 $engine->disconnect()

disconnects from the SQL database.

=head2 $engine->complete_word(WORD, FRAGMENT, CTFN)

The inner core of the tab completion system. This uses the COMP_MAP
data member to figure out what to do.

WORD     is the last full word encountered.
FRAGMENT is the current word fragment.
CTFN     is a case translation function.

If called in a scalar context, complete_word returns 1 if WORD is in its
completion map, and undef otherwise.

If called in a list context, it does the following:

1) Retrieves the COMP_MAP entry corresponding to WORD
2) If the entry is an array, it returns all members thereof that start with
   FRAGMENT
3) If the entry is a function, it is called with the following arguments:
   entry->(ENGINE, FRAGMENT, CTFN)
   and the result is returned.

CTFN typically either just returns its arguments unchanged [case sensitive]
or returns them with their cases folded [case insensitive]

=head2 $engine->complete(SHELL_OBJ, FRAGMENT, LINE, POS)

The big tangled mess that is tab completion.
ALL the non database specific tab completion stuff is implemented here.
Database specific stuff is passed on to complete_word, and is handled
according to the completion map.

 FRAGMENT: word or part word we are trying to tab complete [may be '']
 LINE    : the whole line so far
 POS     :  postion in line [0 indexed] at which FRAGMENT starts

See L<COMP_MAP>

=head2 $engine->grep_tabnames(TARGET, CTFN)

Compares the table TARGET [may be of the 'schema.table' form] with each
element of the list returned by $engine->tables(), with case sensitivity
determined by CTFN, and returns the list of tables that match. Part of the 
tab completion system.

=head2 $engine->load_tables()

Loads the table cache TABLES with a list of tables. dr::DEFAULT
does so by calling $engine->_tables(), intheory, _tables() is the only
table list related method any other driver inheriting from dr::DEFAULT
should have to implement.

=over 4

=item L</$engine-E<gt>tables()>

=item L</$engine-E<gt>_tables()>

=back

=head2 $engine->load_views()

Loads the view cache VIEWS with a list of views. dr::DEFAULT
does so by calling $engine->_views(), intheory, _views() is the only
view list related method any other driver inheriting from dr::DEFAULT
should have to implement.

=over 4

=item L</$engine-E<gt>views()>

=item L</$engine-E<gt>_views()>

=back

=head2 $engine->load_procs()

Loads the proc cache PROCS with a list of procs. dr::DEFAULT
does so by calling $engine->_procs(), intheory, _procs() is the only
proc list related method any other driver inheriting from dr::DEFAULT
should have to implement.

=over 4

=item L</$engine-E<gt>procs()>

=item L</$engine-E<gt>_procs()>

=back

=head2 $engine->load_users()

Loads the user cache USERS with a list of users. dr::DEFAULT
does so by calling $engine->_users(), intheory, _users() is the only
user list related method any other driver inheriting from dr::DEFAULT
should have to implement.

=over 4

=item L</$engine-E<gt>users()>

=item L</$engine-E<gt>_users()>

=back

=head2 $engine->load_sequences()

Loads the sequence cache SEQUENCES with a list of sequences. dr::DEFAULT
does so by calling $engine->_sequences(), intheory, _sequences() is the only
sequence list related method any other driver inheriting from dr::DEFAULT
should have to implement.

=over 4

=item L</$engine-E<gt>sequences()>

=item L</$engine-E<gt>_sequences()>

=back

=head2 $engine->load_triggers()

Loads the trigger cache TRIGGERS with a list of triggers. dr::DEFAULT
does so by calling $engine->_triggers(), intheory, _triggers() is the only
trigger list related method any other driver inheriting from dr::DEFAULT
should have to implement.

=over 4

=item L</$engine-E<gt>triggers()>

=item L</$engine-E<gt>_triggers()>

=back

=head2 $engine->load_columns(TABLIST)

Loads the table/field_list cache, or tries to. If TABLIST is empty, gets
all the data about all the tables it can.


=head2 $engine->noscan_format(SHELL_OBJ, STH)

Returns a sprintf-style format string for the output of the statement in
STH [a DBI statement handle], based on the statement meta-data therein.

Some aspects of the format are controlled by SHELL_OBJ variables retrieved
with SHELL_OBJ->getvar("VARNAME")

=head2 $engine->prescan_format(SHELL_OBJ, STH, DATA_LOL)

Returns a sprintf-style format for the data in DATA_LOL, based on that data
and the statement handle STH.

Note: DATA_LOL is typically loaded with fetchall_arrayref(), but this has
the unfortunate effect of obliterating all the statement meta-data in STH,
Therefore the STH that prescan_format see's is almost always a dummy, created
with DBIShell::UTIL::cache_sth_attr(REAL_STH)

Some aspects of the format are controlled by SHELL_OBJ variables retrieved
with SHELL_OBJ->getvar("VARNAME")

=head2 $engine->map_inout_parameters(SHELL_OBJ, QUERY)

Scans the query for parameters, registers the dbishell variables they
are associated with, and replaces dbishell style paramaters with DBI style ?
placeholders, returning a query that DBI will actually be able to handle.

=head2 $engine->bind_parameters(SHELL_OBJ, STH)

Uses the meta data in STH and the data stored by map_inout_parameters()
to actually bind the parameters in the query.

=head2 $engine->help(SHELL_OBJ, THING)

Fetches the help for THING, if available, or the default help, and
attempts to shove it into your default pager [as determined by the PAGER
environment variable]. If a pager is unavailable, displays the help with
SHELL_OBJ->errputf(CONTEXT, "%s\n\n") instead.

=head2 $engine->fetch_results(SHELL_OBJ, STH)

Retrieves and displays the results from STH, formatted according to
certain dbishell variables, as appropriate.

Returns the number of rows returned [or '0E0' if no rows were fetched]
So it always returns a true value if it doesn't encounter an error.

=head2 $engine->interpret(SHELL_OBJ, QUERY)

This is it: receives a query, examines it, cuts it up, dispatches various
bits and pieces to different methods, and returns a true value on success,
0 on error, or undef if it declines to interpret the query.

=head1 BUGS

Almost certainly, but obviously, I don't know about them, or I'd fix them.

=head1 LIMITATIONS

=over 4

=item Tab completion

Not nearly smart enough yet - maybe some sort of analysis of the statement so
far would help - must investigate SQL::Statement, or whatever it is.

=back

=head1 AUTHOR

Vivek Dasmohapatra <vivek@etla.org>

=head1 SEE ALSO

dbishell

DBIShell

DBIShell::Help

DBIShell::UTIL

=cut

Valid HTML 4.01! Valid CSS! Any Browser Debian Pepperfish