|
rtfm / SQL / dbishell / src/DBIShell/dr/DEFAULT.pm
|
|
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 |
|
|
|