DBI::Shell - Interactive command shell for the DBI
perl -MDBI::Shell -e shell [<DBI data source> [<user> [<password>]]]
dbish [<DBI data source> [<user> [<password>]]]
The DBI::Shell module (and dbish command, if installed) provide a
simple but effective command line interface for the Perl DBI module.
DBI::Shell is very new, very experimental and very subject to change.
Your milage I<will> vary. Interfaces I<will> change with each release.
### See TO DO section in the docs at the end.
use vars
qw(@ISA @EXPORT $VERSION $SHELL);
$VERSION = sprintf "%d.%02d", '$Revision: 10.11 $ ' =~ /(\d+)\.(\d+)/;
WARNING: The DBI::Shell interface and functionality are
======= very likely to change in subsequent versions!
my @args = @_ ?
@_ : @ARGV;
$SHELL = DBI
::Shell
::Std
->new(@args);
# -------------------------------------------------------------
@ISA = qw(DBI::Shell::Base);
# XXX this package might be used to override commands etc.
# -------------------------------------------------------------
package DBI
::Shell
::Base
;
use Getopt
::Long
2.17; # upgrade from CPAN if needed: http://www.perl.com/CPAN
use DBI
1.00 qw(:sql_types :utils);
Usage: perl -MDBI::Shell -e shell [<DBI data source> [<user> [<password>]]]
($sh->{batch
}) ?
warn @_,"\n" : print @_,"\n"; # XXX maybe
sub alert
{ # XXX not quite sure how alert and err relate
# for msgs that would pop-up an alert dialog if this was a Tk app
sub err
{ # XXX not quite sure how alert and err relate
my ($sh, $msg, $die) = @_;
$msg = "DBI::Shell: $msg\n";
my ($sh, $opt, $default) = @_;
(my $opt_name = $opt) =~ s/[|=].*//;
croak
"Can't add_option '$opt_name', already defined"
if exists $sh->{$opt_name};
$sh->{options
}->{$opt_name} = $opt;
$sh->{$opt_name} = $default;
foreach my $where (qw(DBI/Shell DBI_Shell)) {
my $mod = $where; $mod =~ s!/!::!g; #/ so vim see the syn correctly
my @dir = map { -d
"$_/$where" ?
("$_/$where") : () } @INC;
opendir DIR
, $dir or warn "Unable to read $dir: $!\n";
push @pi, map { s/\.pm$//; "${mod}::$_" } grep { /\.pm$/ }
local $DBI::Shell
::SHELL
= $sh; # publish the current shell
$sh->alert("Unable to load $pi: $@") if $@
;
# plug-ins should remove options they recognise from (localized) @ARGV
# by calling Getopt::Long::GetOptions (which is already in pass_through mode).
local *ARGV
= $sh->{unhandled_options
};
my $sh = bless {}, $class;
# Set default configuration options
[ 'command_prefix=s' => '/' ],
[ 'chistory_size=i' => 50 ],
[ 'rhistory_size=i' => 50 ],
[ 'rhistory_head=i' => 5 ],
[ 'rhistory_tail=i' => 5 ],
[ 'editor|ed=s' => ($ENV{VISUAL
} || $ENV{EDITOR
} || 'vi') ],
[ 'displaymode|display'=> 'neat' ],
[ 'columnseparator=s' => ',' ],
# defaults for each new database connect:
[ 'init_trace|trace=i' => 0 ],
[ 'init_autocommit|autocommit=i' => 1 ],
[ 'debug|d=i' => ($ENV{DBISH_DEBUG
} || 0) ],
$sh->add_option(@
$opt_ref);
# Install default commands
# The sub is passed a reference to the shell and the @ARGV-style
# args it was invoked with.
hint
=> "display this list of commands",
hint
=> "set DBI trace level for current database",
hint
=> "connect to another data source/DSN",
hint
=> "execute the current statement",
hint
=> "execute the current (non-select) statement",
hint
=> "evaluate the current statement as perl code",
hint
=> "commit changes to the database",
hint
=> "rollback changes to the database",
# --- information commands
hint
=> "display tables that exist in current database",
hint
=> "display data types supported by current server",
hint
=> "display available DBI drivers",
# --- statement/history management commands
hint
=> "erase the current statement",
hint
=> "re-execute the previously executed statement",
hint
=> "make a previous statement current again",
hint
=> "display current statement",
hint
=> "edit current statement in an external editor",
hint
=> "display command history",
hint
=> "display result history",
hint
=> "set display format for selected data (Neat|Box)",
hint
=> "display combined command and result history",
hint
=> "display or set an option value",
hint
=> "display information about a table",
# Source config file which may override the defaults.
# Default is $ENV{HOME}/.dbish_config.
# Can be overridden with $ENV{DBISH_CONFIG}.
# Make $ENV{DBISH_CONFIG} empty to prevent sourcing config file.
# XXX all this will change
my $homedir = $ENV{HOME
} # unix
|| "$ENV{HOMEDRIVE}$ENV{HOMEPATH}"; # NT
$sh->{config_file
} = $ENV{DBISH_CONFIG
} || "$homedir/.dbish_config";
if ($sh->{config_file
} && -f
$sh->{config_file
}) {
require $sh->{config_file
};
# Handle command line parameters
# data_source and user command line parameters overrides both
# environment and config settings.
my @options = values %{ $sh->{options
} };
Getopt
::Long
::config
('pass_through'); # for plug-ins
unless (GetOptions
($sh, 'help|h', @options)) {
croak
"DBI::Shell aborted.\n";
$sh->{unhandled_options
} = [];
foreach my $arg (@ARGV) {
if ($arg =~ /^-/) { # expected to be in "--opt=value" format
push @
{$sh->{unhandled_options
}}, $arg;
$sh->do_format($sh->{displaymode
});
$sh->{data_source
} = shift(@args) || $ENV{DBI_DSN
} || '';
$sh->{user
} = shift(@args) || $ENV{DBI_USER
} || '';
$sh->{password
} = shift(@args) || $ENV{DBI_PASS
} || undef;
$sh->{chistory
} = []; # command history
$sh->{rhistory
} = []; # result history
if ($sh->{batch
} || ! -t STDIN
) {
$sh->{term
} = new Term
::ReadLine
($class);
$sh->log("DBI::Shell $DBI::Shell::VERSION using DBI $DBI::VERSION $mode");
$sh->log("DBI::Shell loaded from $INC{'DBI/Shell.pm'}") if $sh->{debug
};
die "Unrecognised options: @{$sh->{unhandled_options}}\n"
if @
{$sh->{unhandled_options
}};
$sh->log($warning) unless $sh->{batch
};
# Use valid "dbi:driver:..." to connect with source.
$sh->do_connect( $sh->{data_source
} );
$sh->{abbrev
} = Text
::Abbrev
::abbrev
(keys %{$sh->{commands
}})
$sh->{current_buffer
} = '';
my $prefix = $sh->{command_prefix
};
$current_line = $sh->readline($sh->prompt());
$current_line = "${prefix}quit" unless defined $current_line;
my ($stmt, $cmd, $args_string, $output) = ($1, $2, $3, $4||'');
$sh->{current_buffer
} .= "$stmt\n" if length $stmt;
$cmd = 'go' if $cmd eq '';
my @args = split ' ', $args_string||'';
warn("command='$cmd' args='$args_string' output='$output'")
$command = $sh->{abbrev
}->{$cmd};
$command = ($sh->{commands
}->{$cmd}) ?
$cmd : undef;
$sh->run_command($command, $output, @args);
die "Command '$cmd' not recognised";
$sh->alert("Command '$cmd' not recognised ",
"(enter ${prefix}help for help).");
elsif ($current_line ne "") {
$sh->{current_buffer
} .= $current_line . "\n";
# print whole buffer here so user can see it as
# it grows (and new users might guess that unrecognised
# inputs are treated as commands)
$sh->run_command('current', undef,
"(enter '$prefix' to execute or '${prefix}help' for help)");
$rv = $sh->{term
}->readline($prompt);
my ($sh, $command, $output, @args) = @_;
local(*STDOUT
) if $output;
local(*OUTPUT
) if $output;
if (open(OUTPUT
, $output)) {
$sh->err("Couldn't open output '$output'");
$sh->run_command('current', undef, '');
my $code = "do_$command";
$sh->err("$command failed: $@") if $@
;
my ($sh, $list_ref) = @_;
for(my $i = 0; $i < @
$list_ref; $i++) {
print $i+1,": $$list_ref[$i]\n";
print $sh->prompt(), $buffer, "\n";
my ($sh, $dsn, @args) = @_;
if ($dsn =~ m/^dbi:.*:/i) { # has second colon
return $dsn; # assumed to be full DSN
elsif ($dsn =~ m/^dbi:([^:]*)/i) {
$driver = $1 # use DriverName part
print "Ignored unrecognised DBI DSN '$dsn'.\n";
die "Missing or unrecognised DBI DSN.";
print "Available DBI drivers:\n";
my @drivers = DBI
->available_drivers;
for( my $cnt = 0; $cnt <= $#drivers; $cnt++ ) {
printf "%2d: dbi:%s\n", $cnt+1, $drivers[$cnt];
"Enter driver name or number, or full 'dbi:...:...' DSN: ");
exit unless defined $driver; # detect ^D / EOF
return $driver if $driver =~ /^dbi:.*:/i; # second colon entered
if ( $driver =~ /^\s*(\d+)/ ) {
$driver = $drivers[$1-1];
$driver =~ s/^dbi://i if $driver # incase they entered 'dbi:Name'
# XXX try to install $driver (if true)
# unset $driver if install fails.
while (!defined $source) {
my @data_sources = DBI
->data_sources($driver);
print "Enter data source to connect to: \n";
for( my $cnt = 0; $cnt <= $#data_sources; $cnt++ ) {
printf "%2d: %s\n", $cnt+1, $data_sources[$cnt];
$prompt = "Enter data source or number,";
print "(The data_sources method returned nothing.)\n";
$prompt = "Enter data source";
"$prompt or full 'dbi:...:...' DSN: ");
return if !defined $source; # detect ^D / EOF
if ($source =~ /^\s*(\d+)/) {
$source = $data_sources[$1-1]
elsif ($source =~ /^dbi:([^:]+)$/) { # no second colon
$driver = $1; # possibly new driver
sub prompt_for_password
{
if (!defined($haveTermReadKey)) {
$haveTermReadKey = eval { require Term
::ReadKey
} ?
1 : 0;
print "Password for $sh->{user} (",
($haveTermReadKey ?
"not " : "Warning: "),
Term
::ReadKey
::ReadMode
('noecho');
$sh->{password
} = Term
::ReadKey
::ReadLine
(0);
Term
::ReadKey
::ReadMode
('restore');
$sh->{password
} = <STDIN
>;
return "" if $sh->{batch
};
return "(not connected)> " unless $sh->{dbh
};
return "$sh->{user}\@$sh->{data_source}> ";
$cmd = $sh->{current_buffer
} unless defined $cmd;
$sh->{prev_buffer
} = $cmd;
my $chist = $sh->{chistory
};
shift @
$chist if @
$chist >= $sh->{chistory_size
};
my $prefix = $sh->{command_prefix
};
my $commands = $sh->{commands
};
print "Defined commands, in alphabetical order:\n";
foreach my $cmd (sort keys %$commands) {
my $hint = $commands->{$cmd}->{hint
} || '';
printf " %s%-10s %s\n", $prefix, $cmd, $hint;
print "Commands can be abbreviated.\n" if $sh->{abbrev
};
my $mode = $args[0] || '';
my $class = eval { DBI
::Format
->formatter($mode) };
$sh->alert("Unable to select '$mode': $@");
$sh->log("Using formatter class '$class'") if $sh->{debug
};
$sh->{display
} = $class->new($sh);
$sh->do_option("columnseparator=$col_sep") if $col_sep;
return if $sh->{current_buffer
} eq '';
$sh->{prev_buffer
} = $sh->{current_buffer
};
my $sth = $sh->{dbh
}->prepare($sh->{current_buffer
});
$err =~ s
: at \S
*DBI
/Shell
.pm line \d
+(,.*?chunk \d
+)?
::
if !$sh->{debug
} && $err =~ /^DBD::\w+::\w+ \w+/;
# There need to be a better way, maybe clearing the
# buffer when the next non command is typed.
# Or sprinkle <$sh->{current_buffer} ||= $sh->{prev_buffer};>
$sh->{current_buffer
} = '';
my ($sh, $sth, $execute) = @_;
if ($execute || !$sth->{Active
}) {
my $params = $sth->{NUM_OF_PARAMS
} || 0;
print "Statement has $params parameters:\n" if $params;
my $val = $sh->readline("Parameter $_ value: ");
$rv = $sth->execute(@params);
if (!$sth->{'NUM_OF_FIELDS'}) { # not a select statement
$rv = "undefined number of" unless defined $rv;
$rv = "unknown number of" if $rv == -1;
print "[$rv row" . ($rv==1 ?
"" : "s") . " affected]\n";
# Remove oldest result from history if reached limit
my $rhist = $sh->{rhistory
};
shift @
$rhist if @
$rhist >= $sh->{rhistory_size
};
# Keep a buffer of $sh->{rhistory_tail} many rows,
# when done with result add those to rhistory buffer.
# Could use $sth->rows(), but not all DBD's support it.
my $display = $sh->{display
} || die "panic: no display set";
$display->header($sth, \
*STDOUT
, $sh->{columnseparator
});
while (my $rowref = $sth->fetchrow_arrayref()) {
if ($i <= $sh->{rhistory_head
}) {
push @
{$rhist->[-1]}, [@
$rowref];
shift @rtail if @rtail == $sh->{rhistory_tail
};
my $ommitted = $i - $sh->{rhistory_head
} - @rtail;
[ "[...$ommitted rows out of $rows ommitted...]"]);
foreach my $rowref (@rtail) {
push @
{$rhist->[-1]}, $rowref;
#$sth->finish(); # drivers which need this are broken
my $rv = $sh->{dbh
}->do($sh->{current_buffer
});
print "[$rv row" . ($rv==1 ?
"" : "s") . " affected]\n"
# XXX I question setting the buffer to '' here.
# I may want to edit my line without having to scroll back.
$sh->{current_buffer
} = '';
return unless $sh->{dbh
};
$sh->log("Disconnecting from $sh->{data_source}.");
$sh->{sth
}->finish if $sh->{sth
};
$sh->{dbh
}->rollback unless $sh->{dbh
}->{AutoCommit
};
$sh->alert("Error during disconnect: $@") if $@
;
my ($sh, $dsn, $user, $pass) = @_;
$dsn = $sh->get_data_source($dsn);
$sh->do_disconnect if $sh->{dbh
};
$sh->{data_source
} = $dsn;
if (defined $user and length $user) {
$sh->{password
} = undef; # force prompt below
$sh->log("Connecting to '$sh->{data_source}' as '$sh->{user}'...");
if ($sh->{user
} and !defined $sh->{password
}) {
$sh->prompt_for_password();
$sh->{dbh
} = DBI
->connect(
$sh->{data_source
}, $sh->{user
}, $sh->{password
}, {
AutoCommit
=> $sh->{init_autocommit
},
$sh->{dbh
}->trace($sh->{init_trace
}) if $sh->{init_trace
};
my ($sh, $msg, @args) = @_;
$msg = $msg ?
" $msg" : "";
$sh->log("Current statement buffer$msg:\n" . $sh->{current_buffer
});
shift->{dbh
}->commit(@_);
shift->{dbh
}->rollback(@_);
$sh->do_disconnect if $sh->{dbh
};
# Until the alias command is working each command requires definition.
sub do_exit
{ shift->do_quit(@_); }
$sh->{current_buffer
} = '';
$sh->{current_buffer
} = $sh->{prev_buffer
} || '';
$sh->run_command('go') if $sh->{current_buffer
};
$sh->print_list($sh->{chistory
});
for(my $i = 0; $i < @
{$sh->{chistory
}}; $i++) {
print $i+1, ":\n", $sh->{chistory
}->[$i], "--------\n";
foreach my $rowref (@
{$sh->{rhistory
}[$i]}) {
print " ", join(", ", @
$rowref), "\n";
for(my $i = 0; $i < @
{$sh->{rhistory
}}; $i++) {
foreach my $rowref (@
{$sh->{rhistory
}[$i]}) {
print " ", join(", ", @
$rowref), "\n";
my ($sh, $num, @args) = @_;
if (!$num || $num !~ /^\d+$/ || !defined($sh->{chistory
}->[$num-1])) {
$sh->err("No such command number '$num'. Use /chistory to list previous commands.");
$sh->{current_buffer
} = $sh->{chistory
}->[$num-1];
$sh->print_buffer($sh->{current_buffer
});
$DBI::Shell
::eval::dbh
= $sh->{dbh
};
eval "package DBI::Shell::eval; $sh->{current_buffer}";
if ($@
) { $sh->err("Perl failed: $@") }
$sh->run_command('clear');
$sh->run_command('get', '', $&) if @args and $args[0] =~ /^\d+$/;
$sh->{current_buffer
} ||= $sh->{prev_buffer
};
# Find an area to write a temp file into.
my $tmp_dir = $ENV{DBISH_TMP
} || # Give people the choice.
$ENV{TMP
} || # Is TMP set?
$ENV{TEMP
} || # How about TEMP?
$ENV{HOME
} || # Look for HOME?
$ENV{HOMEDRIVE
} . $ENV{HOMEPATH
} || # Last env checked.
"."; # fallback: try to write in current directory.
my $tmp_file = "$tmp_dir/dbish$$.sql";
open(FH
, ">$tmp_file") ||
$sh->err("Can't create $tmp_file: $!\n", 1);
print FH
$sh->{current_buffer
} if defined $sh->{current_buffer
};
close(FH
) || $sh->err("Can't write $tmp_file: $!\n", 1);
my $command = "$sh->{editor} $tmp_file";
# Read changes back in (editor may have deleted and rewritten file)
open(FH
, "<$tmp_file") || $sh->err("Can't open $tmp_file: $!\n");
$sh->{current_buffer
} = join "", <FH
>;
$sh->run_command('current');
$sh->log("Available drivers:");
my @drivers = DBI
->available_drivers;
foreach my $driver (sort @drivers) {
my $ti = $dbh->type_info_all;
my $ti_cols = shift @
$ti;
my @names = sort { $ti_cols->{$a} <=> $ti_cols->{$b} } keys %$ti_cols;
my $sth = $sh->prepare_from_data("type_info", $ti, \
@names);
my ($sh, $tab, @argv) = @_;
$sh->log( "Describle: $tab" );
my $sql = qq{select * from
$tab where
1 = 0};
my $sth = $dbh->prepare( $sql );
my $cnt = $#{$sth->{NAME}}; #
my @names = qw{NAME TYPE NULLABLE
};
#push( @j, join( "\t", qw{NAME TYPE PRECISION SCALE NULLABLE}));
for ( my $c = 0; $c <= $cnt; $c++ ) {
push( my @j, $sth->{NAME
}->[$c] || 0 );
my $m = $dbh->type_info($sth->{TYPE
}->[$c]);
} elsif (not defined $m) {
$s = q{undef } . $sth->{TYPE
}->[$c];
warn "describe: can't parse data ($m) from type_info!";
if (defined $sth->{PRECISION
}->[$c]) {
$s .= "(" . $sth->{PRECISION
}->[$c] || '';
$s .= "," . $sth->{SCALE
}->[$c]
if ( defined $sth->{SCALE
}->[$c]
and $sth->{SCALE
}->[$c] ne 0);
$sth->{NULLABLE
}->[$c] ne 1?
qq{N
}: qq{Y
} );
$sth = $sh->prepare_from_data("describe", \
@ti, \
@names);
my ($sh, $statement, $data, $names, %attr) = @_;
my $sponge = DBI
->connect("dbi:Sponge:","","",{ RaiseError
=> 1 });
my $sth = $sponge->prepare($statement, { rows
=>$data, NAME
=>$names, %attr });
# Do option: sets or gets an option
foreach my $opt (sort keys %{ $sh->{options
}}) {
my $value = (defined $sh->{$opt}) ?
$sh->{$opt} : 'undef';
$sh->log(sprintf("%20s: %s", $opt, $value));
my $options = Text
::Abbrev
::abbrev
(keys %{$sh->{options
}});
# Expecting the form [option=value] [option=] [option]
foreach my $opt (@args) {
my ($opt_name, $value) = $opt =~ /^\s*(\w+)(?:=(.*))?/;
$opt_name = $options->{$opt_name} || $opt_name if $opt_name;
if (!$opt_name || !$sh->{options
}->{$opt_name}) {
$sh->log("Unknown or ambiguous option name '$opt_name' (use name=value format)");
my $crnt = (defined $sh->{$opt_name}) ?
$sh->{$opt_name} : 'undef';
if (not defined $value) {
$log = "$opt_name=$crnt";
$log = "/option $opt_name=$value (was $crnt)";
$sh->{$opt_name} = ($value eq 'undef') ?
undef : $value;
$sh->log($sh->{command_prefix
}."option $log");
my $sth = $dbh->table_info(@args);
print "Driver has not implemented the table_info() method, ",
my @tables = $dbh->tables(@args); # else try list context
print "No tables exist ",
"(or driver hasn't implemented the tables method)\n";
$sth = $sh->prepare_from_data("tables",
[ map { [ $_ ] } @tables ],
Proper docs - but not yet, too much is changing.
"/source file" command to read command file.
Allow to nest via stack of command file handles.
Add command log facility to create batch files.
Use Data::ShowTable if available.
Define DBI::Shell plug-in semantics.
Implement import/export as plug-in module
Clarify meaning of batch mode
Set/Get DBI handle attributes
Emulate popular command shell modes (Oracle, Ingres etc)?
Many commands - few documented, yet!
/chistory (display history of all commands entered)
/chistory | YourPager (display history with paging)
/clear (Clears the current command buffer)
/commit (commit changes to the database)
/connect (pick from available drivers and sources)
/connect dbi:Oracle (pick source from based on driver)
/connect dbi:YourDriver:YourSource i.e. dbi:Oracle:mysid
Use this option to change userid or password.
/current (Display current statement in the buffer)
/do (execute the current (non-select) statement)
dbish> create table foo ( mykey integer )
dbish> truncate table OldTable /do (Oracle truncate)
/drivers (Display available DBI drivers)
/edit (Edit current statement in an external editor)
Editor is defined using the enviroment variable $VISUAL or
$EDITOR or default is vi. Use /option editor=new editor to change
To read a file from the operating system invoke the editor (/edit)
and read the file into the editor buffer.
/get (Retrieve a previous command to the current buffer)
/go (Execute the current statement)
Run (execute) the statement in the current buffer. This is the default
action if the statement ends with /
dbish> select * from user_views/
dbish> select table_name from user_tables
dbish> where table_name like 'DSP%'
dbish> select table_name from all_tables/ | more
/history (Display combined command and result history)
/option [option1[=value]] [option2 ...]
/option (Displays the current options)
/option MyOption (Displays the value, if exists, of MyOption)
/option MyOption=4 (defines and/or sets value for MyOption)
/perl (Evaluate the current statement as perl code)
/quit (Leaves shell. Same as exit)
/redo (Re-execute the previously executed statement)
/rhistory (Display result history)
/rollback (rollback changes to the database)
For this to be useful, turn the autocommit off. /option autocommit=0
/table_info (display all tables that exist in current database)
/table_info | more (for paging)
/trace (set DBI trace level for current database)
Adjust the trace level for DBI 0 - 4. 0 off. 4 is lots of information.
Useful for determining what is really happening in DBI. See DBI.
/type_info (display data types supported by current server)
=head1 AUTHORS and ACKNOWLEDGEMENTS
The DBI::Shell has a long lineage.
It started life around 1994-1997 as the pmsql script written by Andreas
König. Jochen Wiedmann picked it up and ran with it (adding much along
the way) as I<dbimon>, bundled with his DBD::mSQL driver modules. In
1998, around the time I wanted to bundle a shell with the DBI, Adam
Marks was working on a dbish modeled after the Sybase sqsh utility.
Wanting to start from a cleaner slate than the feature-full but complex
dbimon, I worked with Adam to create a fairly open modular and very
configurable DBI::Shell module. Along the way Tom Lowery chipped in
ideas and patches. As we go further along more useful code and concepts
from Jochen's dbimon is bound to find it's way back in.
The DBI::Shell module is Copyright (c) 1998 Tim Bunce. England.
All rights reserved. Portions are Copyright by Jochen Wiedmann,
Adam Marks and Tom Lowery.
You may distribute under the terms of either the GNU General Public
License or the Artistic License, as specified in the Perl README file.