refactoring, replace $1 with readable name
[yasql.git] / yasql.in
blobdf23f039605b729af7d5a84748aa128c4f8594d1
1 #! /usr/bin/env perl
2 # vim: set tabstop=2 smartindent shiftwidth=2 expandtab :
4 # Name: yasql - Yet Another SQL*Plus replacement
6 # See POD documentation at end
8 # $Id: yasql,v 1.83 2005/05/09 16:57:13 qzy Exp qzy $
10 # Copyright (C) 2000 Ephibian, Inc.
11 # Copyright (C) 2005 iMind.dev, Inc.
13 # This program is free software; you can redistribute it and/or
14 # modify it under the terms of the GNU General Public License
15 # as published by the Free Software Foundation; either version 2
16 # of the License, or (at your option) any later version.
18 # This program is distributed in the hope that it will be useful,
19 # but WITHOUT ANY WARRANTY; without even the implied warranty of
20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 # GNU General Public License for more details.
23 # You should have received a copy of the GNU General Public License
24 # along with this program; if not, write to the Free Software
25 # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
27 # Yasql was originally developed by Nathan Shafer at Ephibian, Inc.
28 # Now it is mainly developed and maintained by Balint Kozman at iMind.dev, Inc.
30 # email: nshafer@ephibian.com
31 # email: qzy@users.sourceforge.net
32 # email: jpnangle@users.sourceforge.net
35 use strict;
37 use SelfLoader;
39 use DBI;
40 use Term::ReadLine;
41 use Data::Dumper;
42 use Benchmark;
43 use Getopt::Long;
45 # Load DBD::Oracle early to work around SunOS bug. See
46 # http://article.gmane.org/gmane.comp.lang.perl.modules.dbi.general/207
48 require DBD::Oracle;
50 #Globals
51 use vars qw(
52 $VERSION $Id $dbh $cursth @dbparams $dbuser $dbversion $term $term_type
53 $features $attribs $last_history $num_connects $connected $running_query
54 @completion_list @completion_possibles $completion_built $opt_host $opt_sid
55 $opt_port $opt_debug $opt_bench $opt_nocomp $opt_version $qbuffer
56 $last_qbuffer $fbuffer $last_fbuffer $quote $inquotes $inplsqlblock $increate
57 $incomment $csv_filehandle_open $csv_max_lines $nohires $notextcsv $csv
58 $sysconf $sysconfdir $quitting $sigintcaught %conf %prompt $prompt_length
59 @sqlpath %set $opt_batch $opt_notbatch $opt_headers
62 select((select(STDOUT), $| = 1)[0]); #unbuffer STDOUT
64 $sysconfdir = "/etc";
65 $sysconf = "$sysconfdir/yasql.conf";
67 # try to include Time::HiRes for fine grained benchmarking
68 eval q{
69 use Time::HiRes qw (gettimeofday tv_interval);
72 # try to include Text::CSV_XS for input and output of CSV data
73 eval q{
74 use Text::CSV_XS;
76 if($@) {
77 $notextcsv = 1;
80 # install signal handlers
81 sub setup_sigs {
82 $SIG{INT} = \&sighandle;
83 $SIG{TSTP} = 'DEFAULT';
84 $SIG{TERM} = \&sighandle;
86 setup_sigs();
88 # install a filter on the __WARN__ handler so that we can get rid of
89 # DBD::Oracle's stupid ORACLE_HOME warning. It would warn even if we don't
90 # connect using a TNS name, which doesn't require access to the ORACLE_HOME
91 $SIG{__WARN__} = sub{
92 warn(@_) unless $_[0] =~ /environment variable not set!/;
95 # initialize the whole thing
96 init();
98 if($@) {
99 if(!$opt_batch) {
100 wrn("Time::HiRes not installed. Please install if you want benchmark times "
101 ."to include milliseconds.");
103 $nohires = 1;
107 $connected = 1;
109 # start the interface
110 interface();
112 # end
114 ################################################################################
115 ########### non-self-loaded functions ########################################
117 sub BEGIN {
118 $Id = '$Id: yasql,v 1.83 2005/05/09 02:07:13 nshafer Exp nshafer $';
119 ($VERSION) = $Id =~ /Id: \S+ (\d+\.\d+)/;
122 sub argv_sort {
123 if($a =~ /^\@/ && $b !~ /^\@/) {
124 return 1;
125 } elsif($a !~ /^\@/ && $b =~ /^\@/) {
126 return -1;
127 } else {
128 return 0;
132 sub sighandle {
133 my($sig) = @_;
134 debugmsg(3, "sighandle called", @_);
136 $SIG{$sig} = \&sighandle;
138 if($sig =~ /INT|TERM|TSTP/) {
139 if($quitting) {
140 # then we've already started quitting and so we just try to force exit
141 # without the graceful quit
142 print STDERR "Attempting to force exit...\n";
143 exit();
146 if($sigintcaught) {
147 # the user has alrady hit INT and so we now force an exit
148 print STDERR "Caught another SIG$sig\n";
149 quit(undef, 1);
150 } else {
151 $sigintcaught = 1;
154 if($running_query) {
155 if(defined $cursth) {
156 print STDERR "Attempting to cancel query...\n";
157 debugmsg(1, "canceling statement handle");
158 my $ret = $cursth->cancel();
159 $cursth->finish;
161 } elsif(!$connected) {
162 quit();
164 if(defined $cursth) {
165 print STDERR "Attempting to cancel query...\n";
166 debugmsg(1, "canceling statement handle");
167 my $ret = $cursth->cancel();
168 $cursth->finish;
172 } elsif($sig eq 'ALRM') {
174 if(defined $dbh) {
175 wrn("Connection lost (timeout: $conf{connection_timeout})");
176 quit(1);
177 } else {
178 lerr("Could not connect to database, timed out. (timeout: "
179 ."$conf{connection_timeout})");
184 sub END {
185 debugmsg(3, "END called", @_);
187 # save the history buffer
188 if($term_type && $term_type eq 'gnu' && $term->history_total_bytes()) {
189 debugmsg(1, "Writing history");
190 unless($term->WriteHistory($conf{history_file})) {
191 wrn("Could not write history file to $conf{history_file}. "
192 ."History not saved");
197 ################################################################################
198 ########### self-loaded functions ##############################################
200 #__DATA__
202 sub init {
203 # call GetOptions to parse the command line
204 my $opt_help;
205 Getopt::Long::Configure( qw(permute) );
206 $Getopt::Long::ignorecase = 0;
207 usage(1) unless GetOptions(
208 "debug|d:i" => \$opt_debug,
209 "host|H=s" => \$opt_host,
210 "port|p=s" => \$opt_port,
211 "sid|s=s" => \$opt_sid,
212 "help|h|?" => \$opt_help,
213 "nocomp|A" => \$opt_nocomp,
214 "bench|benchmark|b" => \$opt_bench,
215 "version|V" => \$opt_version,
216 "batch|B" => \$opt_batch,
217 "interactive|I" => \$opt_notbatch,
220 # set opt_debug to 1 if it's defined, which means the user just put -d or
221 # --debug without an integer argument
222 $opt_debug = 1 if !$opt_debug && defined $opt_debug;
224 $opt_batch = 0 if $opt_notbatch;
226 $opt_batch = 1 unless defined $opt_batch || -t STDIN;
228 debugmsg(3, "init called", @_);
229 # This reads the command line then initializes the DBI and Term::ReadLine
230 # packages
232 $sigintcaught = 0;
233 $completion_built = 0;
235 usage(0) if $opt_help;
237 # Output startup string
238 if(!$opt_batch) {
239 print STDERR "\n";
240 print STDERR "YASQL version $VERSION Copyright (c) 2000-2001 Ephibian, Inc, 2005 iMind.dev.\n";
241 print STDERR '$Id: yasql,v 1.83 2005/05/09 02:07:13 qzy Exp qzy $' . "\n";
244 if($opt_version) {
245 print STDERR "\n";
246 exit(0);
249 if(!$opt_batch) {
250 print STDERR "Please type 'help' for usage instructions\n";
251 print STDERR "\n";
254 # parse the config files. We first look for ~/.yasqlrc, then
255 # /etc/yasql.conf
256 # first set up the defaults
257 %conf = (
258 connection_timeout => 20,
259 max_connection_attempts => 3,
260 history_file => '~/.yasql_history',
261 pager => '/bin/more',
262 auto_commit => 0,
263 commit_on_exit => 1,
264 long_trunc_ok => 1,
265 long_read_len => 80,
266 edit_history => 1,
267 auto_complete => 1,
268 extended_benchmarks => 0,
269 prompt => '%U%H',
270 column_wildcards => 0,
271 extended_complete_list => 0,
272 command_complete_list => 1,
273 sql_query_in_error => 0,
274 nls_date_format => 'YYYY-MM-DD HH24:MI:SS',
275 complete_tables => 1,
276 complete_columns => 1,
277 complete_objects => 1,
278 fast_describe => 1,
279 server_output => 2000,
282 my $config_file;
283 if(-e "$ENV{HOME}/.yasqlrc") {
284 $config_file = "$ENV{HOME}/.yasqlrc";
285 } elsif(-e $sysconf) {
286 $config_file = $sysconf;
289 if($config_file) {
290 debugmsg(2, "Reading config: $config_file");
291 open(CONFIG, "$config_file");
292 while(<CONFIG>) {
293 chomp;
294 s/#.*//;
295 s/^\s+//;
296 s/\s+$//;
297 next unless length;
298 my($var, $value) = split(/\s*=\s*/, $_, 2);
299 $var = 'auto_commit' if $var eq 'AutoCommit';
300 $var = 'commit_on_exit' if $var eq 'CommitOnExit';
301 $var = 'long_trunc_ok' if $var eq 'LongTruncOk';
302 $var = 'long_read_len' if $var eq 'LongReadLen';
303 $conf{$var} = $value;
304 debugmsg(3, "Setting option [$var] to [$value]");
308 if (($conf{server_output} > 0) && ($conf{server_output} < 2000)) {
309 $conf{server_output} = 2000;
311 if ($conf{server_output} > 1000000) {
312 $conf{server_output} = 1000000;
315 ($conf{history_file}) = glob($conf{history_file});
317 debugmsg(3,"Conf: [" . Dumper(\%conf) . "]");
319 # Create a Text::CSV object
320 unless($notextcsv) {
321 $csv = new Text::CSV_XS( { binary => 1 } );
324 # Change the process name to just 'yasql' to somewhat help with security.
325 # This is not bullet proof, nor is it supported on all platforms. Those that
326 # don't support this will just fail silently.
327 debugmsg(2, "Process name: $0");
328 $0 = 'yasql';
330 # Parse the SQLPATH environment variable if it exists
331 if($ENV{SQLPATH}) {
332 @sqlpath = split(/;/, $ENV{SQLPATH});
335 # If the user set the SID on the command line, we'll overwrite the
336 # environment variable so that DBI sees it.
337 #print "Using SID $opt_sid\n" if $opt_sid;
338 $ENV{ORACLE_SID} = $opt_sid if $opt_sid;
340 # output info about the options given
341 print STDERR "Debugging is on\n" if $opt_debug;
342 DBI->trace(1) if $opt_debug > 3;
344 # Extending on from Oracle's conventions, try and obtain an early indication
345 # of ora_session_mode from AS SYSOPER, AS SYSDBA options. Be flexible :-)
346 my $ora_session_mode = 0;
347 my $osmp = '';
348 if (lc($ARGV[-2]) eq 'as') {
349 $ora_session_mode = 2 if lc($ARGV[-1]) eq 'sysdba';
350 $ora_session_mode = 4 if lc($ARGV[-1]) eq 'sysoper';
351 pop @ARGV;
352 pop @ARGV;
353 } elsif (lc($ARGV[1]) eq 'as') {
354 $ora_session_mode = 2 if lc($ARGV[2]) eq 'sysdba';
355 $ora_session_mode = 4 if lc($ARGV[2]) eq 'sysoper';
356 @ARGV = ($ARGV[0], @ARGV[3..$#ARGV]);
359 # set up DBI
360 if(@ARGV == 0) {
361 # nothing was provided
362 debugmsg(2, "No command line args were found");
363 $dbh = db_connect(1, $ora_session_mode);
364 } else {
365 debugmsg(2, "command line args found!");
366 debugmsg(2, @ARGV);
367 # an argument was given!
369 my $script = 0;
370 if(substr($ARGV[0], 0, 1) eq '@') {
371 # no logon string was given, must be a script
372 debugmsg(2, "Found: no logon, script name");
373 my($script_name, @script_params) = @ARGV;
374 $script = 1;
376 $dbh = db_connect(1, $ora_session_mode);
378 run_script($script_name);
379 } elsif(substr($ARGV[0], 0, 1) ne '@' && substr($ARGV[1], 0, 1) eq '@') {
380 # A logon string was given as well as a script file
381 debugmsg(2, "Found: login string, script name");
382 my($logon_string, $script_name, @script_params) = @ARGV;
383 $script = 1;
385 my($ora_session_mode2, $username, $password, $connect_string)
386 = parse_logon_string($logon_string);
387 $ora_session_mode = $ora_session_mode2 if $ora_session_mode2;
388 $dbh = db_connect(1, $ora_session_mode, $username, $password, $connect_string);
390 run_script($script_name);
391 } elsif(@ARGV == 1 && substr($ARGV[0], 0, 1) ne '@') {
392 # only a logon string was given
393 debugmsg(2, "Found: login string, no script name");
394 my($logon_string) = @ARGV;
396 my($ora_session_mode2, $username, $password, $connect_string)
397 = parse_logon_string($logon_string);
398 $ora_session_mode = $ora_session_mode2 if $ora_session_mode2;
399 $dbh = db_connect(1, $ora_session_mode, $username, $password, $connect_string);
400 } else {
401 usage(1);
404 if ($conf{server_output} > 0) {
405 $dbh->func( $conf{server_output}, 'dbms_output_enable' );
406 $set{serveroutput} = 1;
409 # Quit if one or more scripts were given on the command-line
410 quit(0) if $script;
413 if (!$opt_batch) {
414 setup_term() unless $term;
417 # set up the pager
418 $conf{pager} = $ENV{PAGER} if $ENV{PAGER};
421 sub setup_term {
422 # set up the Term::ReadLine
423 $term = new Term::ReadLine('YASQL');
424 $term->ornaments(0);
425 $term->MinLine(0);
427 debugmsg(1, "Using " . $term->ReadLine());
429 if($term->ReadLine eq 'Term::ReadLine::Gnu') {
430 # Term::ReadLine::Gnu specific setup
431 $term_type = 'gnu';
433 $attribs = $term->Attribs();
434 $features = $term->Features();
436 $term->stifle_history(500);
437 if($opt_debug >= 4) {
438 foreach(sort keys(%$attribs)) {
439 debugmsg(4,"[term-attrib] $_: $attribs->{$_}");
441 foreach(sort keys(%$features)) {
442 debugmsg(4,"[term-feature] $_: $features->{$_}");
446 # read in the ~/.yasql_history file
447 if(-e $conf{history_file}) {
448 unless($term->ReadHistory($conf{history_file})) {
449 wrn("Could not read $conf{history_file}. History not restored");
451 } else {
452 print STDERR "Creating $conf{history_file} to store your command line history\n";
453 open(HISTORY, ">$conf{history_file}")
454 or wrn("Could not create $conf{history_file}: $!");
455 close(HISTORY);
458 $last_history = $term->history_get($term->{history_length});
460 $attribs->{completion_entry_function} = \&complete_entry_function;
461 my $completer_word_break_characters
462 = $attribs->{completer_word_break_characters};
463 $completer_word_break_characters =~ s/[a-zA-Z0-9_\$\#]//g;
464 $attribs->{completer_word_break_characters}
465 = $completer_word_break_characters;
466 #$attribs->{catch_signals} = 0;
467 } elsif($term->ReadLine eq 'Term::ReadLine::Perl') {
468 # Term::ReadLine::Perl specific setup
469 $term_type = 'perl';
470 if($opt_debug >= 4) {
471 foreach(sort keys(%{$term->Features()})) {
472 debugmsg(4,"[term-feature] $_: $attribs->{$_}");
478 if ($term->ReadLine eq 'Term::ReadLine::Stub') {
479 wrn("Neither Term::ReadLine::Gnu or Term::ReadLine::Perl are installed.\n"
480 . "Please install from CPAN for advanced functionality. Until then "
481 . "YASQL will run\ncrippled. (like possibly not having command history "
482 . "or line editing...\n");
486 sub parse_logon_string {
487 debugmsg(3, "parse_logon_string called", @_);
489 my($arg) = @_;
490 my($ora_session_mode, $username, $password, $connect_string);
492 # strip off AS SYSDBA / AS SYSOPER first
493 if($arg =~ /^(.*)\s+as\s+sys(\w+)\s*$/i) {
494 $ora_session_mode = 2 if lc($2) eq 'dba';
495 $ora_session_mode = 4 if lc($2) eq 'oper';
496 $arg = $1 if $ora_session_mode;
497 $ora_session_mode = 0 unless $ora_session_mode;
499 if($arg =~ /^\/$/) {
500 $username = '';
501 $password = '';
502 $connect_string = 'external';
503 return($ora_session_mode, $username, $password, $connect_string);
504 } elsif($arg eq 'internal') {
505 $username = '';
506 $password = '';
507 $connect_string = 'external';
508 $ora_session_mode = 2;
509 return($ora_session_mode, $username, $password, $connect_string);
510 } elsif($arg =~ /^([^\/]+)\/([^\@]+)\@(.*)$/) {
511 #username/password@connect_string
512 $username = $1;
513 $password = $2;
514 $connect_string = $3;
515 return($ora_session_mode, $username, $password, $connect_string);
516 } elsif($arg =~ /^([^\@]+)\@(.*)$/) {
517 # username@connect_string
518 $username = $1;
519 $password = '';
520 $connect_string = $2;
521 return($ora_session_mode, $username, $password, $connect_string);
522 } elsif($arg =~ /^([^\/]+)\/([^\@]+)$/) {
523 # username/password
524 $username = $1;
525 $password = $2;
526 $connect_string = '';
527 return($ora_session_mode, $username, $password, $connect_string);
528 } elsif($arg =~ /^([^\/\@]+)$/) {
529 # username
530 $username = $1;
531 $password = $2;
532 $connect_string = '';
533 return($ora_session_mode, $username, $password, $connect_string);
534 } elsif($arg =~ /^\@(.*)$/) {
535 # @connect_string
536 $username = '';
537 $password = '';
538 $connect_string = $1;
539 return($ora_session_mode, $username, $password, $connect_string);
540 } else {
541 return(undef,undef,undef,undef);
545 sub populate_completion_list {
546 my($inline_print, $current_table_name) = @_;
547 debugmsg(3, "populate_completion_list called", @_);
549 # grab all the table and column names and put them in @completion_list
551 if($inline_print) {
552 $| = 1;
553 print STDERR "...";
554 } else {
555 print STDERR "Generating auto-complete list...\n";
558 if($conf{extended_complete_list}) {
559 my @queries;
560 if($conf{complete_tables}) {
561 push(@queries, 'select table_name from all_tables');
563 if($conf{complete_columns}) {
564 push(@queries, 'select column_name from all_tab_columns');
566 if($conf{complete_objects}) {
567 push(@queries, 'select object_name from all_objects');
570 my $sqlstr = join(' union ', @queries);
571 debugmsg(3, "query: [$sqlstr]");
573 my $sth = $dbh->prepare($sqlstr)
574 or query_err('prepare', $DBI::errstr, $sqlstr), setup_sigs(), return(0);
575 $sth->execute()
576 or query_err('execute', $DBI::errstr, $sqlstr), setup_sigs(), return(0);
577 while(my $res = $sth->fetchrow_array()) {
578 push(@completion_list, $res);
580 } else {
581 my @queries;
582 if($conf{complete_tables}) {
583 push(@queries, "select 'table-' || table_name from user_tables");
585 if($conf{complete_columns}) {
586 push(@queries, "select 'column-' || column_name from user_tab_columns");
588 if($conf{complete_objects}) {
589 push(@queries, "select 'object-' || object_name from user_objects");
592 my $sqlstr = join(' union ', @queries);
593 debugmsg(3, "query: [$sqlstr]");
595 my $sth = $dbh->prepare($sqlstr)
596 or query_err('prepare', $DBI::errstr, $sqlstr), setup_sigs(), return(0);
597 $sth->execute()
598 or query_err('execute', $DBI::errstr, $sqlstr), setup_sigs(), return(0);
599 while(my $res = $sth->fetchrow_array()) {
600 push(@completion_list, $res);
604 if ($conf{command_complete_list}) {
605 push(@completion_list, "command-create", "command-select", "command-insert", "command-update", "command-delete from", "command-from", "command-execute", "command-show", "command-describe", "command-drop");
606 push(@completion_list, "show-objects", "show-tables", "show-indexes", "show-sequences", "show-views", "show-functions", "show-constraints", "show-keys", "show-checks", "show-triggers", "show-query", "show-dimensions", "show-clusters", "show-procedures", "show-packages", "show-indextypes", "show-libraries", "show-materialized views", "show-snapshots", "show-synonyms", "show-waits", "show-processes", "show-errors", "show-user", "show-users", "show-uid", "show-plan", "show-database links", "show-dblinks");
609 if ($current_table_name) {
611 my @queries;
612 push(@queries, "select 'current_column-$current_table_name.' || column_name from user_tab_columns where table_name=\'".uc($current_table_name)."\'");
614 my $sqlstr = join(' union ', @queries);
615 debugmsg(3, "query: [$sqlstr]");
617 my $sth = $dbh->prepare($sqlstr)
618 or query_err('prepare', $DBI::errstr, $sqlstr), setup_sigs(), return(0);
619 $sth->execute()
620 or query_err('execute', $DBI::errstr, $sqlstr), setup_sigs(), return(0);
621 while(my $res = $sth->fetchrow_array()) {
622 push(@completion_list, $res);
626 setup_sigs();
628 if($inline_print) {
629 print "\r";
630 print "\e[K";
631 $| = 0;
632 $term->forced_update_display();
636 sub complete_entry_function {
637 my($word, $state) = @_;
638 debugmsg(3, "complete_entry_function called", @_);
639 # This is called by Term::ReadLine::Gnu when a list of matches needs to
640 # be generated. It takes a string that is the word to be completed and
641 # a state number, which should increment every time it's called.
643 return unless $connected;
645 my $line_buffer = $attribs->{line_buffer};
646 debugmsg(4, "line_buffer: [$line_buffer]");
648 if($line_buffer =~ /^\s*\@/) {
649 return($term->filename_completion_function(@_));
652 unless($completion_built) {
653 unless($opt_nocomp || !$conf{auto_complete}) {
654 populate_completion_list(1);
656 $completion_built = 1;
659 if($state == 0) {
660 # compute all the possibilies and put them in @completion_possibles
661 @completion_possibles = ();
662 my $last_char = substr($word,length($word)-1,1);
664 debugmsg(2,"last_char: [$last_char]");
666 my @grep = ();
667 if ($line_buffer =~ /select(?!.*(?:from|where))[\s\w\$\#_,]*\.[\w_]*$/) {
668 # This case is for "select mytable.mycolumn" type lines
669 my $current_table_name = $line_buffer;
670 $current_table_name =~ s/(select.*)(\s)([\w_]+)(\.)([\w_]*)$/$3/;
671 debugmsg(3, "current table name: $current_table_name");
673 unless($opt_nocomp || !$conf{auto_complete}) {
674 populate_completion_list(1, $current_table_name);
677 debugmsg(4, "select table.column");
679 push(@grep, '^current_column-');
680 } elsif($line_buffer =~ /select(?!.*(?:from|where))[\s\w\$\#_,]+$/) {
681 debugmsg(4, "select ...");
682 push(@grep, '^column-', '^table-');
683 } elsif($line_buffer =~ /from(?!.*where)[\s\w\$\#_,]*$/) {
684 debugmsg(4, "from ...");
685 push(@grep, '^table-');
686 } elsif($line_buffer =~ /where[\s\w\$\#_,]*$/) {
687 debugmsg(4, "where ...");
688 push(@grep, '^column-');
689 } elsif($line_buffer =~ /update(?!.*set)[\s\w\$\#_,]*$/) {
690 debugmsg(4, "where ...");
691 push(@grep, '^table-');
692 } elsif($line_buffer =~ /set[\s\w\$\#_,]*$/) {
693 debugmsg(4, "where ...");
694 push(@grep, '^column-');
695 } elsif($line_buffer =~ /insert.*into(?!.*values)[\s\w\$\#_,]*$/) {
696 debugmsg(4, "where ...");
697 push(@grep, '^table-');
698 } elsif($line_buffer =~ /^\s*show\s\w*/) {
699 push(@grep, 'show-');
700 } else {
701 push(@grep, '');
703 debugmsg(2,"grep: [@grep]");
705 my $use_lower;
706 if($last_char =~ /^[A-Z]$/) {
707 $use_lower = 0;
708 } else {
709 $use_lower = 1;
711 foreach my $grep (@grep) {
712 foreach my $list_item (grep(/$grep/, @completion_list)) {
713 my $item = $list_item;
714 $item =~ s/^\w*-//;
715 eval { #Trap errors
716 if($item =~ /^\Q$word\E/i) {
717 push(@completion_possibles,
718 ($use_lower ? lc($item) : uc($item))
722 debugmsg(2, "Trapped error in complete_entry_function eval: $@") if $@;
725 debugmsg(3,"possibles: [@completion_possibles]");
728 # return the '$state'th element of the possibles
729 return($completion_possibles[$state] || undef);
732 sub db_reconnect {
733 debugmsg(3, "db_reconnect called", @_);
734 # This first disconnects the database, then tries to reconnect
736 print "Reconnecting...\n";
738 commit_on_exit();
740 if (defined $dbh) {
741 if (not $dbh->disconnect()) {
742 warn "Disconnect failed: $DBI::errstr\n";
743 return;
747 $dbh = db_connect(1, @dbparams);
750 sub db_connect {
751 my($die_on_error, $ora_session_mode, $username, $password, $connect_string) = @_;
752 debugmsg(3, "db_connect called", @_);
753 # Tries to connect to the database, prompting for username and password
754 # if not given. There are several cases that can happen:
755 # connect_string is present:
756 # ORACLE_HOME has to exist and the driver tries to make a connection to
757 # given connect_string.
758 # connect_string is not present:
759 # $opt_host is set:
760 # Connect to $opt_host on $opt_sid. Specify port only if $opt_port is
761 # set
762 # $opt_host is not set:
763 # Try to make connection to the default database by not specifying any
764 # host or connect string
766 my($dbhandle, $dberr, $dberrstr, $this_prompt_host, $this_prompt_user);
768 debugmsg(1,"ora_session_mode: [$ora_session_mode] username: [$username] password: [$password] connect_string: [$connect_string]");
770 # The first thing we're going to check is that the Oracle DBD is available
771 # since it's a sorta required element =)
772 my @drivers = DBI->available_drivers();
773 my $found = 0;
774 foreach(@drivers) {
775 if($_ eq "Oracle") {
776 $found = 1;
779 unless($found) {
780 lerr("Could not find DBD::Oracle... please install. Available drivers: "
781 .join(", ", @drivers) . ".\n");
783 #print "drivers: [" . join("|", @drivers) . "]\n";
785 # Now we can attempt a connection to the database
786 my $attributes = {
787 RaiseError => 0,
788 PrintError => 0,
789 AutoCommit => $conf{auto_commit},
790 LongReadLen => $conf{long_read_len},
791 LongTruncOk => $conf{long_trunc_ok},
792 ora_session_mode => $ora_session_mode
795 if($connect_string eq 'external') {
796 # the user wants to connect with external authentication
798 check_oracle_home();
800 # install alarm signal handle
801 $SIG{ALRM} = \&sighandle;
802 alarm($conf{connection_timeout});
804 if(!$opt_batch) {
805 print "Attempting connection to local database\n";
807 $dbhandle = DBI->connect('dbi:Oracle:',undef,undef,$attributes)
808 or do {
809 $dberr = $DBI::err;
810 $dberrstr = $DBI::errstr;
813 $this_prompt_host = $ENV{ORACLE_SID};
814 $this_prompt_user = $ENV{LOGNAME};
815 alarm(0); # cancel alarm
816 } elsif($connect_string) {
817 # We were provided with a connect string, so we can use the TNS method
819 check_oracle_home();
820 ($ora_session_mode, $username, $password) = get_up($ora_session_mode, $username, $password);
821 $attributes->{ora_session_mode} = $ora_session_mode if $ora_session_mode;
823 my $userstring;
824 if($username) {
825 $userstring = $username . '@' . $connect_string;
826 } else {
827 $userstring = $connect_string;
830 # install alarm signal handle
831 $SIG{ALRM} = \&sighandle;
832 alarm($conf{connection_timeout});
834 if(!$opt_batch) {
835 print "Attempting connection to $userstring\n";
837 $dbhandle = DBI->connect('dbi:Oracle:',$userstring,$password,$attributes)
838 or do {
839 $dberr = $DBI::err;
840 $dberrstr = $DBI::errstr;
843 $this_prompt_host = $connect_string;
844 $this_prompt_user = $username;
845 alarm(0); # cancel alarm
846 } elsif($opt_host) {
847 # attempt a connection to $opt_host
848 my $dsn;
849 $dsn = "host=$opt_host";
850 $dsn .= ";sid=$opt_sid" if $opt_sid;
851 $dsn .= ";port=$opt_port" if $opt_port;
853 ($ora_session_mode, $username, $password) = get_up($ora_session_mode, $username, $password);
854 $attributes->{ora_session_mode} = $ora_session_mode if $ora_session_mode;
856 # install alarm signal handle
857 $SIG{ALRM} = \&sighandle;
858 alarm($conf{connection_timeout});
860 print "Attempting connection to $opt_host\n";
861 debugmsg(1,"dsn: [$dsn]");
862 $dbhandle = DBI->connect("dbi:Oracle:$dsn",$username,$password,
863 $attributes)
864 or do {
865 $dberr = $DBI::err;
866 $dberrstr = $DBI::errstr;
869 $this_prompt_host = $opt_host;
870 $this_prompt_host = "$opt_sid!" . $this_prompt_host if $opt_sid;
871 $this_prompt_user = $username;
872 alarm(0); # cancel alarm
873 } else {
874 # attempt a connection without specifying a hostname or anything
876 check_oracle_home();
877 ($ora_session_mode, $username, $password) = get_up($ora_session_mode, $username, $password);
878 $attributes->{ora_session_mode} = $ora_session_mode if $ora_session_mode;
880 # install alarm signal handle
881 $SIG{ALRM} = \&sighandle;
882 alarm($conf{connection_timeout});
884 print "Attempting connection to local database\n";
885 $dbhandle = DBI->connect('dbi:Oracle:',$username,$password,$attributes)
886 or do {
887 $dberr = $DBI::err;
888 $dberrstr = $DBI::errstr;
891 $this_prompt_host = $ENV{ORACLE_SID};
892 $this_prompt_user = $username;
893 alarm(0); # cancel alarm
896 if($dbhandle) {
897 # Save the parameters for reconnecting
898 @dbparams = ($ora_session_mode, $username, $password, $connect_string);
900 # set the $dbuser global for use elsewhere
901 $dbuser = $username;
902 $num_connects = 0;
903 $prompt{host} = $this_prompt_host;
904 $prompt{user} = $this_prompt_user;
906 # Get the version banner
907 debugmsg(2,"Fetching version banner");
908 my $banner = $dbhandle->selectrow_array(
909 "select banner from v\$version where banner like 'Oracle%'");
910 if(!$opt_batch) {
911 if($banner) {
912 print "Connected to: $banner\n\n";
913 } else {
914 print "Connection successful!\n";
918 if($banner =~ / (\d+)\.(\d+)\.([\d\.]+)/) {
919 my ($major, $minor, $other) = ($1, $2, $3);
920 $dbversion = $major || 8;
923 # Issue a warning about autocommit. It's nice to know...
924 print STDERR "auto_commit is " . ($conf{auto_commit} ? "ON" : "OFF")
925 . ", commit_on_exit is " . ($conf{commit_on_exit} ? "ON" : "OFF")
926 . "\n" unless $opt_batch;
927 } elsif( ($dberr eq '1017' || $dberr eq '1005')
928 && ++$num_connects < $conf{max_connection_attempts}) {
929 $dberrstr =~ s/ \(DBD ERROR: OCISessionBegin\).*//;
930 print "Error: $dberrstr\n\n";
931 #@dbparams = (0,undef,undef,$connect_string);
932 $connect_string = '' if $connect_string eq 'external';
933 $dbhandle = db_connect($die_on_error,$ora_session_mode,undef,undef,$connect_string);
934 } elsif($die_on_error) {
935 lerr("Could not connect to database: $dberrstr [$dberr]");
936 } else {
937 wrn("Could not connect to database: $dberrstr [$dberr]");
938 return(0);
941 # set the NLS_DATE_FORMAT
942 if($conf{nls_date_format}) {
943 debugmsg(2, "setting NLS_DATE_FORMAT to $conf{nls_date_format}");
944 my $sqlstr = "alter session set nls_date_format = '"
945 . $conf{nls_date_format} . "'";
946 $dbhandle->do($sqlstr) or query_err('do', $DBI::errstr, $sqlstr);
949 $connected = 1;
950 return($dbhandle);
953 sub get_prompt {
954 my($prompt_string) = @_;
955 debugmsg(3, "get_prompt called", @_);
956 # This returns a prompt. It can be passed a string which will
957 # be manually put into the prompt. It will be padded on the left with
958 # white space
960 $prompt_length ||= 5; #just in case normal prompt hasn't been outputted
961 debugmsg(2, "prompt_length: [$prompt_length]");
963 if($prompt_string) {
964 my $temp_prompt = sprintf('%' . $prompt_length . 's', $prompt_string . '> ');
965 return($temp_prompt);
966 } else {
967 my $temp_prompt = $conf{prompt} . '> ';
968 my $temp_prompt_host = '@' . $prompt{host} if $prompt{host};
969 $temp_prompt =~ s/\%H/$temp_prompt_host/g;
970 $temp_prompt =~ s/\%U/$prompt{user}/g;
972 $prompt_length = length($temp_prompt);
973 return($temp_prompt);
977 sub get_up {
978 my($ora_session_mode, $username, $password) = @_;
979 debugmsg(3, "get_up called", @_);
981 if(!$opt_batch) {
983 setup_term() unless $term;
985 # Get username/password
986 unless($username) {
987 # prompt for the username
988 $username = $term->readline('Username: ');
989 if($username =~ /^(.*)\s+as\s+sys(\w+)\s*$/i) {
990 $ora_session_mode = 2 if lc($2) eq 'dba';
991 $ora_session_mode = 4 if lc($2) eq 'oper';
992 $username = $1;
995 # Take that entry off of the history list
996 if ($term_type eq 'gnu') {
997 $term->remove_history($term->where_history());
1001 unless($password) {
1002 # prompt for the password, and disable echo
1003 my $orig_redisplay = $attribs->{redisplay_function};
1004 $attribs->{redisplay_function} = \&shadow_redisplay;
1006 $password = $term->readline('Password: ');
1008 $attribs->{redisplay_function} = $orig_redisplay;
1010 # Take that entry off of the history list
1011 if ($term->ReadLine eq "Term::ReadLine::Gnu") {
1012 $term->remove_history($term->where_history());
1017 return($ora_session_mode, $username, $password);
1021 sub check_oracle_home {
1022 # This checks for the ORACLE_HOME environment variable and dies if it's
1023 # not set
1024 lerr("Please set your ORACLE_HOME environment variable!")
1025 unless $ENV{ORACLE_HOME};
1026 return(1);
1029 sub shadow_redisplay {
1030 # The one provided in Term::ReadLine::Gnu was broken
1031 # debugmsg(2, "shadow_redisplay called", @_);
1032 my $OUT = $attribs->{outstream};
1033 my $oldfh = select($OUT); $| = 1; select($oldfh);
1034 print $OUT ("\r", $attribs->{prompt});
1035 $oldfh = select($OUT); $| = 0; select($oldfh);
1038 sub print_non_print {
1039 my($string) = @_;
1041 my @string = unpack("C*", $string);
1042 my $ret_string;
1043 foreach(@string) {
1044 if($_ >= 40 && $_ <= 176) {
1045 $ret_string .= chr($_);
1046 } else {
1047 $ret_string .= "<$_>";
1050 return($ret_string);
1053 sub interface {
1054 debugmsg(3, "interface called", @_);
1055 # this is the main program loop that handles all the user input.
1056 my $input;
1057 my $prompt = get_prompt();
1059 setup_sigs();
1061 # Check if we were interactively called, or do we need to process STDIN
1062 if(-t STDIN) {
1063 while(defined($input = $term->readline($prompt))) {
1064 $sigintcaught = 0;
1065 $prompt = process_input($input, $prompt) || get_prompt();
1066 setup_sigs();
1068 } else {
1069 debugmsg(3, "non-interactive", @_);
1070 debugmsg(3, "\$opt_batch=$opt_batch", @_);
1071 debugmsg(3, "\$opt_batch=$opt_batch", @_);
1072 # Send STDIN to process_input();
1073 while(<STDIN>) {
1074 process_input($_);
1078 quit(0, undef, "\n");
1081 sub process_input {
1082 my($input, $prompt, $add_to_history) = @_;
1083 if (!(defined($add_to_history))) {
1084 $add_to_history = 1;
1086 debugmsg(3, "process_input called", @_);
1088 my $nprompt;
1089 SWITCH: {
1090 if(!$qbuffer) {
1091 # Commands that are only allowed if there is no current buffer
1092 $input =~ /^\s*(?:!|host)\s*(.*)\s*$/i and system($1), last SWITCH;
1093 $input =~ /^\s*\\a\s*$/i and populate_completion_list(), last SWITCH;
1094 $input =~ /^\s*\\\?\s*$/i and help(), last SWITCH;
1095 $input =~ /^\s*help\s*$/i and help(), last SWITCH;
1096 $input =~ /^\s*reconnect\s*$/i and db_reconnect(), last SWITCH;
1097 $input =~ /^\s*\\r\s*$/i and db_reconnect(), last SWITCH;
1098 $input =~ /^\s*conn(?:ect)?\s+(.*)$/i and connect_cmd($1), last SWITCH;
1099 $input =~ /^\s*disc(?:onnect)\s*$/i and disconnect_cmd($1), last SWITCH;
1100 $input =~ /^\s*\@\S+\s*$/i and $nprompt = run_script($input), last SWITCH;
1101 $input =~ /^\s*debug\s*(.*)$/i and debug_toggle($1), last SWITCH;
1102 $input =~ /^\s*autocommit\s*(.*)$/i and autocommit_toggle(), last SWITCH;
1103 $input =~ /^\s*commit/i and commit_cmd(), last SWITCH;
1104 $input =~ /^\s*rollback/i and rollback_cmd(), last SWITCH;
1105 $input =~ /^\s*(search\s*[^;\/\\]+)\s*$/i and search_cmd($1,'table'),last SWITCH;
1106 $input =~ /^\s*(show\s*[^;\/\\]+)\s*$/i and show($1, 'table'),last SWITCH;
1107 $input =~ /^\s*(desc\s*[^;\/\\]+)\s*$/i and describe($1, 'table'),
1108 last SWITCH;
1109 $input =~ /^\s*(set\s*[^;\/\\]+)\s*$/i and set_cmd($1), last SWITCH;
1110 $input =~ /^\s*exec(?:ute)?\s*(.*)\s*$/i and exec_cmd($1), last SWITCH;
1111 $input =~ /^\s*\\d\s*$/ and show('show objects', 'table'), last SWITCH;
1112 $input =~ /^\s*\\dt\s*$/ and show('show tables', 'table'), last SWITCH;
1113 $input =~ /^\s*\\di\s*$/ and show('show indexes', 'table'), last SWITCH;
1114 $input =~ /^\s*\\ds\s*$/ and show('show sequences', 'table'), last SWITCH;
1115 $input =~ /^\s*\\dv\s*$/ and show('show views', 'table'), last SWITCH;
1116 $input =~ /^\s*\\df\s*$/ and show('show functions', 'table'), last SWITCH;
1118 # Global commands allowed any time (even in the middle of queries)
1119 $input =~ /^\s*quit\s*$/i and quit(0), last SWITCH;
1120 $input =~ /^\s*exit\s*$/i and quit(0), last SWITCH;
1121 $input =~ /^\s*\\q\s*$/i and quit(0), last SWITCH;
1122 $input =~ /^\s*\\l\s*$/i and show_qbuffer(), last SWITCH;
1123 $input =~ /^\s*\\p\s*$/i and show_qbuffer(), last SWITCH;
1124 $input =~ /^\s*l\s*$/i and show_qbuffer(), last SWITCH;
1125 $input =~ /^\s*list\s*$/i and show_qbuffer(), last SWITCH;
1126 $input =~ /^\s*\\c\s*$/i and $nprompt = clear_qbuffer(), last SWITCH;
1127 $input =~ /^\s*clear\s*$/i and $nprompt = clear_qbuffer(), last SWITCH;
1128 $input =~ /^\s*clear buffer\s*$/i and $nprompt=clear_qbuffer(), last SWITCH;
1129 $input =~ /^\s*\\e\s*(.*)$/i and $nprompt = edit($1), last SWITCH;
1130 $input =~ /^\s*edit\s*(.*)$/i and $nprompt = edit($1), last SWITCH;
1131 $input =~ /^\s*rem(?:ark)?/i and $input = '', last SWITCH;
1132 $input =~ /[^\s]/ and $nprompt = parse_input($input) || last, last SWITCH;
1134 # default
1135 $nprompt = $prompt if ($nprompt eq ''); # use last prompt if nothing caught (blank line)
1137 if(!$opt_batch && $term->ReadLine eq "Term::ReadLine::Gnu" && $input =~ /[^\s]/ &&
1138 $input ne $last_history) {
1139 if (!$opt_batch && $add_to_history) {
1140 $term->AddHistory($input);
1143 $last_history = $input;
1144 return($nprompt);
1147 sub parse_input {
1148 my($input) = @_;
1149 debugmsg(3, "parse_input called", @_);
1150 # this takes input and parses it. It looks for single quotes (') and double
1151 # quotes (") and presents prompts accordingly. It also looks for query
1152 # terminators, such as semicolon (;), forward-slash (/) and back-slash-g (\g).
1153 # If it finds a query terminator, then it pushes any text onto the query
1154 # buffer ($qbuffer) and then passes the entire query buffer, as well as the
1155 # format type, determined by the terminator type, to the query() function. It
1156 # also wipes out the qbuffer at this time.
1158 # It returns a prompt (like 'SQL> ' or ' -> ') if successfull, 0 otherwise
1160 # now we need to check for a terminator, if we're not inquotes
1161 while( $input =~ m/
1163 ['"] # match quotes
1164 | # or
1165 ; # the ';' terminator
1166 | # or
1167 ^\s*\/\s*$ # the slash terminator at end of string
1168 | # or
1169 \\[GgsSi] # one of the complex terminators
1170 | # or
1171 (?:^|\s+)create\s+ # create
1172 | # or
1173 (?:^|\s+)function\s+ # function
1174 | # or
1175 (?:^|\s+)package\s+ # package
1176 | # or
1177 (?:^|\s+)package\s+body\s+ # package body
1178 | # or
1179 (?:^|\s+)procedure\s+ # procedure
1180 | # or
1181 (?:^|\s+)trigger\s+ # trigger
1182 | # or
1183 (?:^|\s+)declare\s+ # declare
1184 | # or
1185 (?:^|\s+)begin\s+ # begin
1186 | # or
1187 \/\* # start of multiline comment
1188 | # or
1189 \*\/ # end of multiline comment
1190 )/gix )
1193 my($pre, $match, $post) = ($`, $1, $');
1194 # PREMATCH, MATCH, POSTMATCH
1195 debugmsg(1, "parse: [$pre] [$match] [$post]");
1197 if( ($match eq '\'' || $match eq '"')) {
1198 if(!$quote || $quote eq $match) {
1199 $inquotes = ($inquotes ? 0 : 1);
1200 if($inquotes) {
1201 $quote = $match;
1202 } else {
1203 undef($quote);
1206 } elsif($match =~ /create/ix) {
1207 $increate = 1;
1208 } elsif(!$increate &&
1209 $match =~ /function|package|package\s+body|procedure|trigger/ix)
1211 # do nothing if we're not in a create statement
1212 } elsif(($match =~ /declare|begin/ix) ||
1213 ($increate && $match =~ /function|package|package\s+body|procedure|trigger/ix))
1215 $inplsqlblock = 1;
1216 } elsif($match =~ /^\/\*/) {
1217 $incomment = 1;
1218 } elsif($match =~ /^\*\//) {
1219 $incomment = 0;
1220 } elsif(!$inquotes && !$incomment && $match !~ /^--/ &&
1221 ($match =~ /^\s*\/\s*$/ || !$inplsqlblock))
1223 $qbuffer .= $pre;
1224 debugmsg(4,"qbuffer IN: [$qbuffer]");
1225 my $terminator = $match;
1226 $post =~ / (\d*) # Match num_rows right after terminitor
1227 \s* # Optional whitespace
1228 (?: #
1229 ( >{1,2}|<|\| ) # Match redirection operators
1230 \s* # Optional whitespace
1231 ( .* ) # The redirector (include rest of line)
1232 )? # Match 0 or 1
1233 \s* # Optional whitespace
1234 (.*) # Catch everything else
1235 $ # End-Of-Line
1237 debugmsg(3,"1: [$1] 2: [$2] 3: [$3] 4: [$4]");
1239 my($num_rows,$op,$op_text,$extra) = ($1,$2,$3,$4);
1241 if($extra =~ /--.*$/) {
1242 undef $extra;
1245 # check that Text::CSV_XS is installed if a < redirection was given
1246 if($op eq '<' && $notextcsv) {
1247 soft_err("You must install Text::CSV_XS from CPAN to use this feature");
1248 return(0);
1251 # deduce the format from the terminator type
1252 my $format;
1254 $fbuffer = $terminator;
1256 if($terminator eq ';' || $terminator =~ /^\/\s*$/) {
1257 $format = 'table';
1258 } elsif($terminator eq '\g') {
1259 $format = 'list';
1260 } elsif($terminator eq '\G') {
1261 $format = 'list_aligned';
1262 } elsif($terminator eq '\s') {
1263 $format = 'csv';
1264 } elsif($terminator eq '\S') {
1265 $format = 'csv_no_header';
1266 } elsif($terminator eq '\i') {
1267 $format = 'sql';
1269 $num_rows ||= 0;
1271 debugmsg(4,"fbuffer: [$fbuffer]\n");
1273 # if there is nothing in the buffer, then we assume that the user just
1274 # wants to reexecute the last query, which we have saved in $last_qbuffer
1275 my($use_buffer, $copy_buffer);
1276 if($qbuffer) {
1277 $use_buffer = $qbuffer;
1278 $copy_buffer = 1;
1279 } elsif($last_qbuffer) {
1280 $use_buffer = $last_qbuffer;
1281 $copy_buffer = 0;
1282 } else {
1283 $use_buffer = undef;
1284 $copy_buffer = 0;
1287 if($use_buffer) {
1288 if($op eq '<') {
1289 my $count = 0;
1290 my($max_lines, @params, $max_lines_save, @querybench,
1291 $rows_affected, $success_code);
1292 my $result_output = 1;
1293 push(@querybench, get_bench());
1294 print STDERR "\n";
1295 while(($max_lines, @params) = get_csv_file($op, $op_text)) {
1296 $max_lines_save = $max_lines;
1297 print statusline($count, $max_lines);
1299 my @res = query( $use_buffer, $format,
1300 {num_rows => $num_rows, op => $op, op_text => $op_text,
1301 result_output => 0}, @params);
1303 debugmsg(3, "res: [@res]");
1305 unless(@res) {
1306 print "Error in line " . ($count + 1) . " of file '$op_text'\n";
1307 $result_output = 0;
1308 close_csv();
1309 last;
1312 $rows_affected += $res[0];
1313 $success_code = $res[1];
1314 $count++;
1316 push(@querybench, get_bench());
1318 if($result_output) {
1319 print "\r\e[K";
1321 if(!$opt_batch) {
1322 print STDERR format_affected($rows_affected, $success_code);
1323 if($opt_bench || $conf{extended_benchmarks}) {
1324 print STDERR "\n\n";
1325 print STDERR ('-' x 80);
1326 print STDERR "\n";
1327 output_benchmark("Query: ", @querybench, "\n");
1328 } else {
1329 output_benchmark(" (", @querybench, ")");
1330 print STDERR "\n";
1332 print STDERR "\n";
1335 } else {
1336 query($use_buffer, $format, {num_rows => $num_rows, op => $op,
1337 op_text => $op_text});
1340 if($copy_buffer) {
1341 # copy the current qbuffer to old_qbuffer
1342 $last_qbuffer = $qbuffer;
1343 $last_fbuffer = $fbuffer;
1345 } else {
1346 query_err('Query', 'No current query in buffer');
1349 undef($qbuffer);
1350 undef($fbuffer);
1351 $inplsqlblock = 0;
1352 $increate = 0;
1354 if($extra) {
1355 return(parse_input($extra));
1356 } else {
1357 # return a 'new' prompt
1358 return(get_prompt());
1363 $qbuffer .= $input . "\n";
1365 debugmsg(4,"qbuffer: [$qbuffer], input: [$input]");
1367 if($inquotes) {
1368 return(get_prompt($quote));
1369 } elsif($incomment) {
1370 return(get_prompt('DOC'));
1371 } else {
1372 return(get_prompt('-'));
1376 sub get_csv_file {
1377 my($op, $op_text) = @_;
1378 debugmsg(3, "get_csv_file called", @_);
1380 my @ret = ();
1382 unless($csv_max_lines) {
1383 ($op_text) = glob($op_text);
1384 debugmsg(3, "Opening file '$op_text' for line counting");
1385 open(CSV, $op_text) || do{
1386 query_err('redirect',"Cannot open file '$op_text' for reading: $!");
1387 return();
1389 while(<CSV>) {
1390 $csv_max_lines++;
1392 close(CSV);
1395 unless($csv_filehandle_open) {
1396 ($op_text) = glob($op_text);
1397 debugmsg(3, "Opening file '$op_text' for input");
1398 open(CSV, $op_text) || do{
1399 query_err('redirect',"Cannot open file '$op_text' for reading: $!");
1400 return();
1402 $csv_filehandle_open = 1;
1405 my $line = <CSV>;
1406 while(defined($line) && $line =~ /^\s*$/) {
1407 $line = <CSV>;
1410 unless($line) {
1411 close_csv();
1412 return();
1415 debugmsg(3, "read in CSV line", $line);
1417 my @fields;
1418 if($csv->parse($line)) {
1419 @fields = $csv->fields();
1420 debugmsg(3, "got CVS fields", @fields);
1421 } else {
1422 wrn("Parse of CSV file failed on argument, skipping to next: "
1423 . $csv->error_input());
1424 return(get_csv_file($op, $op_text));
1427 return($csv_max_lines, @fields);
1430 sub close_csv {
1431 close(CSV) || lerr("Could not close CSV filehandle: $!");
1432 $csv_filehandle_open = 0;
1433 $csv_max_lines = 0;
1436 sub connect_cmd {
1437 my($arg) = @_;
1438 debugmsg(3, "connect_cmd called", @_);
1440 unless($arg) {
1441 wrn("Invalid connect syntax. See help");
1442 return(0);
1445 my($ora_session_mode, $username, $password, $connect_string) = parse_logon_string($arg);
1447 my $new_dbh = db_connect(0, $ora_session_mode, $username, $password, $connect_string);
1448 if (not $new_dbh) {
1449 warn "failed to make new connection as $username to $connect_string: $DBI::errstr\n";
1450 warn "keeping old connection\n";
1451 return;
1454 if (defined $dbh) {
1455 commit_on_exit();
1456 $dbh->disconnect()
1457 or warn "failed to disconnect old connection - switching anyway\n";
1460 $dbh = $new_dbh;
1461 $connected = 1;
1464 sub disconnect_cmd {
1465 debugmsg(3, "disconnect_cmd called", @_);
1467 if ($connected) {
1468 print "Closing last connection...\n";
1469 commit_on_exit();
1471 $dbh->disconnect() if (defined $dbh);
1472 $connected = 0;
1473 } else {
1474 print "Not connected.\n";
1478 sub commit_cmd {
1479 debugmsg(3, "commit_cmd called", @_);
1480 # this just called commit
1482 if(defined $dbh) {
1483 if($dbh->{AutoCommit}) {
1484 wrn("commit ineffective with AutoCommit enabled");
1485 } else {
1486 if ($dbh->commit()) {
1487 print "Transaction committed\n";
1489 else {
1490 warn "Commit failed: $DBI::errstr\n";
1493 } else {
1494 print "No connection\n";
1498 sub rollback_cmd {
1499 debugmsg(3, "rollback_cmd called", @_);
1500 # this just called commit
1502 if(defined $dbh) {
1503 if($dbh->{AutoCommit}) {
1504 wrn("rollback ineffective with AutoCommit enabled");
1505 } else {
1506 if ($dbh->rollback()) {
1507 print "Transaction rolled back\n";
1509 else {
1510 warn "Rollback failed: $DBI::errstr\n";
1513 } else {
1514 print "No connection\n";
1518 sub exec_cmd {
1519 my($sqlstr) = @_;
1520 debugmsg(3, "exec_cmd called", @_);
1521 # Wrap the statement in BEGIN/END and execute
1523 $sqlstr = qq(
1524 BEGIN
1525 $sqlstr
1526 END;
1529 query($sqlstr, 'table');
1532 sub edit {
1533 my($filename) = @_;
1534 debugmsg(3, "edit called", @_);
1535 # This writes the current qbuffer to a file then opens up an editor on that
1536 # file... when the editor returns, we read in the file and overwrite the
1537 # qbuffer with it. If there is nothing in the qbuffer, and there is
1538 # something in the last_qbuffer, then we use the last_qbuffer. If nothing
1539 # is in either, then we just open the editor with a blank file.
1541 my $passed_file = 1 if $filename;
1542 my $filecontents;
1543 my $prompt = get_prompt();
1545 debugmsg(2, "passed_file: [$passed_file]");
1547 if($qbuffer) {
1548 debugmsg(2, "Using current qbuffer for contents");
1549 $filecontents = $qbuffer;
1550 } elsif($last_qbuffer) {
1551 debugmsg(2, "Using last_qbuffer for contents");
1552 $filecontents = $last_qbuffer . $last_fbuffer;
1553 } else {
1554 debugmsg(2, "Using blank contents");
1555 $filecontents = "";
1558 debugmsg(3, "filecontents: [$filecontents]");
1560 # determine the tmp directory
1561 my $tmpdir;
1562 if($ENV{TMP}) {
1563 $tmpdir = $ENV{TMP};
1564 } elsif($ENV{TEMP}) {
1565 $tmpdir = $ENV{TEMP};
1566 } elsif(-d "/tmp") {
1567 $tmpdir = "/tmp";
1568 } else {
1569 $tmpdir = ".";
1572 # determine the preferred editor
1573 my $editor;
1574 if($ENV{EDITOR}) {
1575 $editor = $ENV{EDITOR};
1576 } else {
1577 $editor = "vi";
1580 # create the filename, if not given one
1581 $filename ||= "$tmpdir/yasql_" . int(rand(1000)) . "_$$.sql";
1583 # expand the filename
1584 ($filename) = glob($filename);
1586 debugmsg(1, "Editing $filename with $editor");
1588 # check for file existance. If it exists, then we open it up but don't
1589 # write the buffer to it
1590 my $file_exists;
1591 if($passed_file) {
1592 # if the file was passed, then check for it's existance
1593 if(-e $filename) {
1594 # The file was found
1595 $file_exists = 1;
1596 } elsif(-e "$filename.sql") {
1597 # the file was found with a .sql extension
1598 $filename = "$filename.sql";
1599 $file_exists = 1;
1600 } else {
1601 wrn("$filename was not found, creating new file, which will not be ".
1602 "deleted");
1604 } else {
1605 # no file was specified, so just write to the the temp file, and we
1606 # don't care if it exists, since there's no way another process could
1607 # write to the same file at the same time since we use the PID in the
1608 # filename.
1609 my $ret = open(TMPFILE, ">$filename");
1610 if(!$ret) { #if file was NOT opened successfully
1611 wrn("Could not write to $filename: $!");
1612 } else {
1613 print TMPFILE $filecontents;
1614 close(TMPFILE);
1618 # now spawn the editor
1619 my($ret, @filecontents);
1620 debugmsg(2, "Executing $editor $filename");
1621 $ret = system($editor, "$filename");
1622 if($ret) {
1623 debugmsg(2, "Executing env $editor $filename");
1624 $ret = system("env", $editor, "$filename");
1626 if($ret) {
1627 debugmsg(2, "Executing `which $editor` $filename");
1628 $ret = system("`which $editor`", "$filename");
1631 if($ret) { #if the editor or system returned a positive return value
1632 wrn("Editor exited with $ret: $!");
1633 } else {
1634 # read in the tmp file and apply it's contents to the buffer
1635 my $ret = open(TMPFILE, "$filename");
1636 if(!$ret) { # if file was NOT opened successfully
1637 wrn("Could not read $filename: $!");
1638 } else {
1639 # delete our qbuffer and reset the inquotes var
1640 $qbuffer = "";
1641 $inquotes = 0;
1642 $increate = 0;
1643 $inplsqlblock = 0;
1644 $incomment = 0;
1645 while(<TMPFILE>) {
1646 push(@filecontents, $_);
1648 close(TMPFILE);
1652 if(@filecontents) {
1653 print "\n";
1654 print join('', @filecontents);
1655 print "\n";
1657 foreach my $line (@filecontents) {
1658 # chomp off newlines
1659 chomp($line);
1661 last if $sigintcaught;
1662 # now send it in to process_input
1663 # and don't add lines of the script to command history
1664 $prompt = process_input($line, '', 0);
1668 unless($passed_file) {
1669 # delete the tmp file
1670 debugmsg(1, "Deleting $filename");
1671 unlink("$filename") ||
1672 wrn("Could not unlink $filename: $!");
1675 return($prompt);
1678 sub run_script {
1679 my($input) = @_;
1680 debugmsg(3, "run_script called", @_);
1681 # This reads in the given script and executes it's lines as if they were typed
1682 # in directly. It will NOT erase the current buffer before it runs. It
1683 # will append the contents of the file to the current buffer, basicly
1685 my $prompt;
1687 # parse input
1688 $input =~ /^\@(.*)$/;
1689 my $file = $1;
1690 ($file) = glob($file);
1691 debugmsg(2, "globbed [$file]");
1693 my $first_char = substr($file, 0, 1);
1694 unless($first_char eq '/' or $first_char eq '.') {
1695 foreach my $path ('.', @sqlpath) {
1696 if(-e "$path/$file") {
1697 $file = "$path/$file";
1698 last;
1699 } elsif(-e "$path/$file.sql") {
1700 $file = "$path/$file.sql";
1701 last;
1705 debugmsg(2, "Found [$file]");
1707 # read in the tmp file and apply it's contents to the buffer
1708 my $ret = open(SCRIPT, $file);
1709 if(!$ret) { # if file was NOT opened successfully
1710 wrn("Could not read $file: $!");
1711 $prompt = get_prompt();
1712 } else {
1713 # read in the script
1714 while(<SCRIPT>) {
1715 # chomp off newlines
1716 chomp;
1718 last if $sigintcaught;
1720 # now send it in to process_input
1721 # and don't add lines of the script to command history
1722 $prompt = process_input($_, '', 0);
1724 close(SCRIPT);
1727 return($prompt);
1730 sub show_qbuffer {
1731 debugmsg(3, "show_qbuffer called", @_);
1732 # This outputs the current buffer
1734 #print "\nBuffer:\n";
1735 if($qbuffer) {
1736 print $qbuffer;
1737 } else {
1738 print STDERR "Buffer empty";
1740 print "\n";
1743 sub clear_qbuffer {
1744 debugmsg(3, "clear_qbuffer called", @_);
1745 # This clears the current buffer
1747 $qbuffer = '';
1748 $inquotes = 0;
1749 $inplsqlblock = 0;
1750 $increate = 0;
1751 $incomment = 0;
1752 print "Buffer cleared\n";
1753 return(get_prompt());
1756 sub debug_toggle {
1757 my($debuglevel) = @_;
1758 debugmsg(3, "debug_toggle called", @_);
1759 # If nothing is passed, then debugging is turned off if on, on if off. If
1760 # a number is passed, then we explicitly set debugging to that number
1763 if(length($debuglevel) > 0) {
1764 unless($debuglevel =~ /^\d+$/) {
1765 wrn('Debug level must be an integer');
1766 return(1);
1769 $opt_debug = $debuglevel;
1770 } else {
1771 if($opt_debug) {
1772 $opt_debug = 0;
1773 } else {
1774 $opt_debug = 1;
1777 $opt_debug > 3 ? DBI->trace(1) : DBI->trace(0);
1778 print "** debug is now " . ($opt_debug ? "level $opt_debug" : 'off') . "\n";
1781 sub autocommit_toggle {
1782 debugmsg(3, "autocommit_toggle called", @_);
1783 # autocommit is turned off if on on if off
1785 if($dbh->{AutoCommit}) {
1786 $dbh->{AutoCommit} = 0;
1787 } else {
1788 $dbh->{AutoCommit} = 1;
1791 print "AutoCommit is now " . ($dbh->{AutoCommit} ? 'on' : 'off') . "\n";
1794 sub show {
1795 my($input, $format, $num_rows, $op, $op_text) = @_;
1796 debugmsg(3, "show called", @_);
1797 # Can 'show thing'. Possible things:
1798 # tables - outputs all of the tables that the current user owns
1799 # sequences - outputs all of the sequences that the current user owns
1801 # Can also 'show thing on table'. Possible things:
1802 # constraints - Shows constraints on the 'table', like Check, Primary Key,
1803 # Unique, and Foreign Key
1804 # indexes - Shows indexes on the 'table'
1805 # triggers - Shows triggers on the 'table'
1807 # convert to lowercase for comparison operations
1808 $input = lc($input);
1810 # drop trailing whitespaces
1811 ($input = $input) =~ s/( +)$//;
1813 # parse the input to find out what 'thing' has been requested
1814 if($input =~ /^\s*show\s+([a-zA-Z0-9_\$\#\s]+)\s+(?:on|for)\s+([a-zA-Z0-9_\$\#]+)/) {
1815 # this is a thing on a table
1816 if($1 eq 'indexes') {
1817 my $sqlstr;
1818 if($dbversion >= 8) {
1819 $sqlstr = q{
1820 select ai.index_name "Index Name",
1821 ai.index_type "Type",
1822 ai.uniqueness "Unique?",
1823 aic.column_name "Column Name"
1824 from all_indexes ai, all_ind_columns aic
1825 where ai.index_name = aic.index_name
1826 and ai.table_owner = aic.table_owner
1827 and ai.table_name = ?
1828 and ai.table_owner = ?
1829 order by ai.index_name, aic.column_position
1831 } else {
1832 $sqlstr = q{
1833 select ai.index_name "Index Name",
1834 ai.uniqueness "Unique?",
1835 aic.column_name "Column Name"
1836 from all_indexes ai, all_ind_columns aic
1837 where ai.index_name = aic.index_name
1838 and ai.table_owner = aic.table_owner
1839 and ai.table_name = ?
1840 and ai.table_owner = ?
1841 order by ai.index_name, aic.column_position
1844 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
1845 op_text => $op_text}, uc($2), uc($dbuser));
1846 } elsif($1 eq 'constraints') {
1847 my $sqlstr = q{
1848 select constraint_name "Constraint Name",
1849 decode(constraint_type,
1850 'C', 'Check',
1851 'P', 'Primary Key',
1852 'R', 'Foreign Key',
1853 'U', 'Unique',
1854 '') "Type",
1855 search_condition "Search Condition"
1856 from all_constraints
1857 where table_name = ?
1858 and owner = ?
1859 order by constraint_name
1861 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
1862 op_text => $op_text}, uc($2), uc($dbuser));
1863 } elsif($1 eq 'keys') {
1864 my $sqlstr = q{
1865 select ac.constraint_name "Name",
1866 decode(ac.constraint_type,
1867 'R', 'Foreign Key',
1868 'U', 'Unique',
1869 'P', 'Primary Key',
1870 ac.constraint_type) "Type",
1871 ac.table_name "Table Name",
1872 acc.column_name "Column",
1873 r_ac.table_name "Parent Table",
1874 r_acc.column_name "Parent Column"
1875 from all_constraints ac, all_cons_columns acc,
1876 all_constraints r_ac, all_cons_columns r_acc
1877 where ac.constraint_name = acc.constraint_name
1878 and ac.owner = acc.owner
1879 and ac.constraint_type in ('R','U','P')
1880 and ac.r_constraint_name = r_ac.constraint_name(+)
1881 and r_ac.constraint_name = r_acc.constraint_name(+)
1882 and r_ac.owner = r_acc.owner(+)
1883 and ac.table_name = ?
1884 and ac.owner = ?
1885 order by ac.constraint_name, acc.position
1887 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
1888 op_text => $op_text}, uc($2), uc($dbuser));
1889 } elsif($1 eq 'checks') {
1890 my $sqlstr = q{
1891 select ac.constraint_name "Name",
1892 decode(ac.constraint_type,
1893 'C', 'Check',
1894 ac.constraint_type) "Type",
1895 ac.table_name "Table Name",
1896 ac.search_condition "Search Condition"
1897 from all_constraints ac
1898 where ac.table_name = ?
1899 and ac.constraint_type = 'C'
1900 and ac.owner = ?
1901 order by ac.constraint_name
1903 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
1904 op_text => $op_text}, uc($2), uc($dbuser));
1905 } elsif($1 eq 'triggers') {
1906 my $sqlstr = q{
1907 select trigger_name "Trigger Name",
1908 trigger_type "Type",
1909 when_clause "When",
1910 triggering_event "Event"
1911 from all_triggers
1912 where table_name = ?
1913 and owner = ?
1915 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
1916 op_text => $op_text}, uc($2), uc($dbuser));
1917 } elsif($1 eq 'query') {
1918 my $sqlstr = q{
1919 select count(*) from all_mviews where mview_name = ? and owner = ?
1921 my $is_mview = $dbh->selectrow_array($sqlstr, undef, uc($2), uc($dbuser));
1922 if($is_mview) {
1923 $sqlstr = q{
1924 select query
1925 from all_mviews
1926 where mview_name = ?
1927 and owner = ?
1929 } else {
1930 $sqlstr = q{
1931 select text
1932 from all_views
1933 where view_name = ?
1934 and owner = ?
1937 my $prev_LongReadLen = $dbh->{LongReadLen};
1938 $dbh->{LongReadLen} = 8000;
1939 query($sqlstr, 'single_output', {num_rows => $num_rows, op => $op,
1940 op_text => $op_text}, uc($2), uc($dbuser));
1941 $dbh->{LongReadLen} = $prev_LongReadLen;
1942 } else {
1943 query_err("show", "Unsupported show type", $input);
1945 } elsif($input =~ /^\s*show\s+all\s+([a-zA-Z0-9_\$\#]+)\s*([a-zA-Z0-9_\'\$\#\%\s]*)$/) {
1946 my $object = $1;
1947 if($object eq 'tables') {
1948 my $sqlstr = q{
1949 select table_name "Table Name", 'TABLE' "Type", owner "Owner"
1950 from all_tables
1952 my $post_sqlstr = ' order by table_name ';
1953 my $sql_like;
1954 if ($2 =~ /\s*(\w+)\s+[']?([a-zA-Z0-9_\$\#\%]+)[']?/){
1955 if (lc($1) eq 'like'){
1956 $sqlstr .= ' where table_name like ? ';
1957 $sql_like = uc($2);
1959 query($sqlstr.$post_sqlstr , $format, {num_rows => $num_rows, op => $op,
1960 op_text => $op_text}, $sql_like || undef );
1962 }else{
1963 query($sqlstr.$post_sqlstr , $format, {num_rows => $num_rows, op => $op,
1964 op_text => $op_text} );
1967 } elsif($object eq 'views') {
1968 my $sqlstr = q{
1969 select view_name "View Name", 'VIEW' "Type", owner "Owner"
1970 from all_views
1971 order by view_name
1973 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
1974 op_text => $op_text});
1975 } elsif($object eq 'objects') {
1976 my $sqlstr = q{
1977 select object_name "Object Name", object_type "Type", owner "Owner"
1978 from all_objects
1979 order by object_name
1981 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
1982 op_text => $op_text});
1983 } elsif($object eq 'sequences') {
1984 my $sqlstr = q{
1985 select sequence_name "Sequence Name", 'SEQUENCE' "Type", sequence_owner "Owner"
1986 from all_sequences
1987 order by sequence_name
1989 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
1990 op_text => $op_text});
1991 } elsif($object eq 'clusters') {
1992 my $sqlstr = q{
1993 select cluster_name "Cluster Name", 'CLUSTER' "Type", owner "Owner"
1994 from all_clusters
1995 order by cluster_name
1997 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
1998 op_text => $op_text});
1999 } elsif($object eq 'dimensions') {
2000 my $sqlstr = q{
2001 select dimension_name "Dimension Name", 'DIMENSION' "Type", owner "Owner"
2002 from all_dimensions
2003 order by dimension_name
2005 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2006 op_text => $op_text});
2007 } elsif($object eq 'functions') {
2008 my $sqlstr = q{
2009 select distinct name "Function Name", 'FUNCTION' "Type", owner "Owner"
2010 from all_source
2011 where type = 'FUNCTION'
2012 order by name
2014 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2015 op_text => $op_text});
2016 } elsif($object eq 'procedures') {
2017 my $sqlstr = q{
2018 select distinct name "Procedure Name", 'PROCEDURE' "Type", owner "Owner"
2019 from all_source
2020 where type = 'PROCEDURE'
2021 order by name
2023 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2024 op_text => $op_text});
2025 } elsif($object eq 'packages') {
2026 my $sqlstr = q{
2027 select distinct name "Package Name", 'PACKAGES' "Type", owner "Owner"
2028 from all_source
2029 where type = 'PACKAGE'
2030 order by name
2032 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2033 op_text => $op_text});
2034 } elsif($object eq 'indexes') {
2035 my $sqlstr = q{
2036 select index_name "Index Name", 'INDEXES' "Type", owner "Owner"
2037 from all_indexes
2038 order by index_name
2040 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2041 op_text => $op_text});
2042 } elsif($object eq 'indextypes') {
2043 my $sqlstr = q{
2044 select indextype_name "Indextype Name", 'INDEXTYPE' "Type", owner "Owner"
2045 from all_indextypes
2046 order by indextype_name
2048 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2049 op_text => $op_text});
2050 } elsif($object eq 'libraries') {
2051 my $sqlstr = q{
2052 select library_name "library Name", 'LIBRARY' "Type", owner "Owner"
2053 from all_libraries
2054 order by library_name
2056 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2057 op_text => $op_text});
2058 } elsif($object eq 'materialized views') {
2059 my $sqlstr = q{
2060 select mview_name "Materialized View Name", 'MATERIALIZED VIEW' "Type", owner "Owner"
2061 from all_mviews
2062 order by mview_name
2064 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2065 op_text => $op_text});
2066 } elsif($object eq 'snapshots') {
2067 my $sqlstr = q{
2068 select name "Snapshot Name", 'SNAPSHOT' "Type", owner "Owner"
2069 from all_snapshots
2070 order by name
2072 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2073 op_text => $op_text});
2074 } elsif($object eq 'synonyms') {
2075 my $sqlstr = q{
2076 select synonym_name "Synonym Name", 'SYNONYM' "Type", owner "Owner"
2077 from all_synonyms
2078 order by synonym_name
2080 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2081 op_text => $op_text});
2082 } elsif($object eq 'triggers') {
2083 my $sqlstr = q{
2084 select trigger_name "Trigger Name", 'TRIGGER' "Type", owner "Owner"
2085 from all_triggers
2086 order by trigger_name
2088 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2089 op_text => $op_text});
2090 } elsif($object eq 'waits') {
2091 my $sqlstr = q{
2092 select vs.username "Username",
2093 vs.osuser "OS User",
2094 vsw.sid "SID",
2095 vsw.event "Event",
2096 decode(vsw.wait_time, -2, ' Unknown',
2097 to_char(vsw.seconds_in_wait,'999,999,999,999'))
2098 "Seconds Waiting"
2099 from v$session_wait vsw,
2100 v$session vs
2101 where vsw.sid = vs.sid
2102 order by vsw.wait_time desc, vsw.seconds_in_wait desc, vsw.sid
2104 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2105 op_text => $op_text});
2106 } else {
2107 query_err("show", "Unsupported show type", $input);
2109 } elsif($input =~ /^\s*show\s+([a-zA-Z0-9_\$\#\s]+)\s*$/) {
2110 if($1 eq 'tables') {
2111 my $sqlstr = q{
2112 select table_name "Table Name", 'TABLE' "Type", sys.login_user() "Owner"
2113 from user_tables
2114 order by table_name
2116 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2117 op_text => $op_text});
2118 } elsif($1 eq 'views') {
2119 my $sqlstr = q{
2120 select view_name "View Name", 'VIEW' "Type", sys.login_user() "Owner"
2121 from user_views
2122 order by view_name
2124 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2125 op_text => $op_text});
2126 } elsif($1 eq 'objects') {
2127 my $sqlstr = q{
2128 select object_name "Object Name", object_type "Type", sys.login_user() "Owner"
2129 from user_objects
2130 order by object_name
2132 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2133 op_text => $op_text});
2134 } elsif($1 eq 'sequences') {
2135 my $sqlstr = q{
2136 select sequence_name "Sequence Name", 'SEQUENCE' "Type", sys.login_user() "Owner"
2137 from user_sequences
2138 order by sequence_name
2140 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2141 op_text => $op_text});
2142 } elsif($1 eq 'clusters') {
2143 my $sqlstr = q{
2144 select cluster_name "Cluster Name", 'CLUSTER' "Type", sys.login_user() "Owner"
2145 from user_clusters
2146 order by cluster_name
2148 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2149 op_text => $op_text});
2150 } elsif($1 eq 'dimensions') {
2151 my $sqlstr = q{
2152 select dimension_name "Dimension Name", 'DIMENSION' "Type", sys.login_user() "Owner"
2153 from user_dimensions
2154 order by dimension_name
2156 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2157 op_text => $op_text});
2158 } elsif($1 eq 'functions') {
2159 my $sqlstr = q{
2160 select distinct name "Function Name", 'FUNCTION' "Type", sys.login_user() "Owner"
2161 from user_source
2162 where type = 'FUNCTION'
2163 order by name
2165 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2166 op_text => $op_text});
2167 } elsif($1 eq 'procedures') {
2168 my $sqlstr = q{
2169 select distinct name "Procedure Name", 'PROCEDURE' "Type", sys.login_user() "Owner"
2170 from user_source
2171 where type = 'PROCEDURE'
2172 order by name
2174 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2175 op_text => $op_text});
2176 } elsif($1 eq 'packages') {
2177 my $sqlstr = q{
2178 select distinct name "Package Name", 'PACKAGES' "Type", sys.login_user() "Owner"
2179 from user_source
2180 where type = 'PACKAGE'
2181 order by name
2183 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2184 op_text => $op_text});
2185 } elsif($1 eq 'indexes') {
2186 my $sqlstr = q{
2187 select index_name "Index Name", 'INDEXES' "Type", sys.login_user() "Owner"
2188 from user_indexes
2189 order by index_name
2191 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2192 op_text => $op_text});
2193 } elsif($1 eq 'indextypes') {
2194 my $sqlstr = q{
2195 select indextype_name "Indextype Name", 'INDEXTYPE' "Type", sys.login_user() "Owner"
2196 from user_indextypes
2197 order by indextype_name
2199 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2200 op_text => $op_text});
2201 } elsif($1 eq 'libraries') {
2202 my $sqlstr = q{
2203 select library_name "library Name", 'LIBRARY' "Type", sys.login_user() "Owner"
2204 from user_libraries
2205 order by library_name
2207 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2208 op_text => $op_text});
2209 } elsif($1 eq 'materialized views') {
2210 my $sqlstr = q{
2211 select mview_name "Materialized View Name", 'MATERIALIZED VIEW' "Type", sys.login_user() "Owner"
2212 from user_mviews
2213 order by mview_name
2215 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2216 op_text => $op_text});
2217 } elsif($1 eq 'snapshots') {
2218 my $sqlstr = q{
2219 select name "Snapshot Name", 'SNAPSHOT' "Type", sys.login_user() "Owner"
2220 from user_snapshots
2221 order by name
2223 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2224 op_text => $op_text});
2225 } elsif($1 eq 'synonyms') {
2226 my $sqlstr = q{
2227 select synonym_name "Synonym Name", 'SYNONYM' "Type", sys.login_user() "Owner"
2228 from user_synonyms
2229 order by synonym_name
2231 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2232 op_text => $op_text});
2233 } elsif($1 eq 'triggers') {
2234 my $sqlstr = q{
2235 select trigger_name "Trigger Name", 'TRIGGER' "Type", sys.login_user() "Owner"
2236 from user_triggers
2237 order by trigger_name
2239 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2240 op_text => $op_text});
2241 } elsif($1 eq 'processes') {
2242 my $sqlstr = q{
2243 select sid,
2244 vs.username "User",
2245 vs.status "Status",
2246 vs.schemaname "Schema",
2247 vs.osuser || '@' || vs.machine "From",
2248 to_char(vs.logon_time, 'Mon DD YYYY HH:MI:SS') "Logon Time",
2249 aa.name "Command"
2250 from v$session vs, audit_actions aa
2251 where vs.command = aa.action
2252 and username is not null
2254 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2255 op_text => $op_text});
2256 } elsif($1 eq 'waits') {
2257 my $sqlstr = q{
2258 select vs.username "Username",
2259 vs.osuser "OS User",
2260 vsw.sid "SID",
2261 vsw.event "Event",
2262 decode(vsw.wait_time, -2, ' Unknown',
2263 to_char(vsw.seconds_in_wait,'999,999,999,999'))
2264 "Seconds Waiting"
2265 from v$session_wait vsw,
2266 v$session vs
2267 where vsw.sid = vs.sid
2268 and vs.status = 'ACTIVE'
2269 and vs.username is not null
2270 order by vsw.wait_time desc, vsw.seconds_in_wait desc, vsw.sid
2272 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2273 op_text => $op_text});
2274 } elsif($1 eq 'plan') {
2275 # This following query is Copyright (c) Oracle Corporation 1998, 1999. All Rights Reserved.
2276 my $sqlstr = q{
2277 select '| Operation | Name | Rows | Bytes| Cost | Pstart| Pstop |' as "Plan Table" from dual
2278 union all
2279 select '--------------------------------------------------------------------------------' from dual
2280 union all
2281 select rpad('| '||substr(lpad(' ',1*(level-1)) ||operation||
2282 decode(options, null,'',' '||options), 1, 27), 28, ' ')||'|'||
2283 rpad(substr(object_name||' ',1, 9), 10, ' ')||'|'||
2284 lpad(decode(cardinality,null,' ',
2285 decode(sign(cardinality-1000), -1, cardinality||' ',
2286 decode(sign(cardinality-1000000), -1, trunc(cardinality/1000)||'K',
2287 decode(sign(cardinality-1000000000), -1, trunc(cardinality/1000000)||'M',
2288 trunc(cardinality/1000000000)||'G')))), 7, ' ') || '|' ||
2289 lpad(decode(bytes,null,' ',
2290 decode(sign(bytes-1024), -1, bytes||' ',
2291 decode(sign(bytes-1048576), -1, trunc(bytes/1024)||'K',
2292 decode(sign(bytes-1073741824), -1, trunc(bytes/1048576)||'M',
2293 trunc(bytes/1073741824)||'G')))), 6, ' ') || '|' ||
2294 lpad(decode(cost,null,' ',
2295 decode(sign(cost-10000000), -1, cost||' ',
2296 decode(sign(cost-1000000000), -1, trunc(cost/1000000)||'M',
2297 trunc(cost/1000000000)||'G'))), 8, ' ') || '|' ||
2298 lpad(decode(partition_start, 'ROW LOCATION', 'ROWID',
2299 decode(partition_start, 'KEY', 'KEY', decode(partition_start,
2300 'KEY(INLIST)', 'KEY(I)', decode(substr(partition_start, 1, 6),
2301 'NUMBER', substr(substr(partition_start, 8, 10), 1,
2302 length(substr(partition_start, 8, 10))-1),
2303 decode(partition_start,null,' ',partition_start)))))||' ', 7, ' ')|| '|' ||
2304 lpad(decode(partition_stop, 'ROW LOCATION', 'ROW L',
2305 decode(partition_stop, 'KEY', 'KEY', decode(partition_stop,
2306 'KEY(INLIST)', 'KEY(I)', decode(substr(partition_stop, 1, 6),
2307 'NUMBER', substr(substr(partition_stop, 8, 10), 1,
2308 length(substr(partition_stop, 8, 10))-1),
2309 decode(partition_stop,null,' ',partition_stop)))))||' ', 7, ' ')||'|' as "Explain plan"
2310 from plan_table
2311 start with id=0 and timestamp = (select max(timestamp) from plan_table where id=0)
2312 connect by prior id = parent_id
2313 and prior nvl(statement_id, ' ') = nvl(statement_id, ' ')
2314 and prior timestamp <= timestamp
2315 union all
2316 select '--------------------------------------------------------------------------------' from dual
2318 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2319 op_text => $op_text});
2320 } elsif($1 eq 'errors') {
2321 my $err = $dbh->func( 'plsql_errstr' );
2322 if($err) {
2323 print "\n$err\n\n";
2324 } else {
2325 print "\nNo errors.\n\n";
2327 } elsif($1 eq 'users') {
2328 my $sqlstr = q{
2329 select username, user_id, created
2330 from all_users
2332 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2333 op_text => $op_text});
2334 } elsif($1 eq 'user') {
2335 my $sqlstr = q{
2336 select user from dual
2338 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2339 op_text => $op_text});
2340 } elsif($1 eq 'uid') {
2341 my $sqlstr = q{
2342 select uid from dual
2344 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2345 op_text => $op_text});
2346 } elsif(($1 eq 'database links') || ($1 eq 'dblinks')) {
2347 my $sqlstr = q{
2348 select db_link, host, owner from all_db_links
2350 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2351 op_text => $op_text});
2352 } else {
2353 query_err("show", "Unsupported show type", $input);
2355 } else {
2356 query_err("show", "Unsupported show type", $input);
2362 sub describe {
2363 my($input, $format, $nosynonym, $num_rows, $op, $op_text) = @_;
2364 debugmsg(3, "describe called", @_);
2365 # This describes a table, view, sequence, or synonym by listing it's
2366 # columns and their attributes
2368 # convert to lowercase for comparison operations
2369 $input = lc($input);
2371 # make sure we're still connected to the database
2372 unless(ping()) {
2373 wrn("Database connection died");
2374 db_reconnect();
2377 # parse the query to find the table that was requested to be described
2378 if($input =~ /^\s*desc\w*\s*([a-zA-Z0-9_\$\#\.\@]+)/) {
2379 my $object = $1;
2380 my $sqlstr;
2381 my $type;
2382 my @ret;
2384 my $schema;
2385 my $dblink;
2386 if($object =~ /^([a-zA-Z0-9_\$\#]+)\.([a-zA-Z0-9_\$\#]+)\@([a-zA-Z0-9_\$\#]+)$/) {
2387 $schema = $1;
2388 $object = $2;
2389 $dblink = "\@$3";
2390 } elsif($object =~ /^([a-zA-Z0-9_\$\#]+)\@([a-zA-Z0-9_\$\#]+)$/) {
2391 $schema = $dbuser;
2392 $object = $1;
2393 $dblink = "\@$2";
2394 } elsif($object =~ /^([a-zA-Z0-9_\$\#]+)\.([a-zA-Z0-9_\$\#]+)$/) {
2395 $schema = $1;
2396 $object = $2;
2397 } else {
2398 $schema = $dbuser;
2401 debugmsg(1,"schema: [$schema] object: [$object] dblink: [$dblink]");
2403 if($conf{fast_describe}) {
2404 if(my $sth = $dbh->prepare("select * from $schema.$object$dblink")) {
2405 my $fields = $sth->{NAME};
2406 my $types = $sth->{TYPE};
2407 my $type_info = $dbh->type_info($types->[0]);
2408 my $precision = $sth->{PRECISION};
2409 my $scale = $sth->{SCALE};
2410 my $nullable = $sth->{NULLABLE};
2412 debugmsg(4, "fields: [" . join(',', @$fields) . "]");
2413 debugmsg(4, "types: [" . join(',', @$types) . "]");
2414 debugmsg(4, "type_info: [" . Dumper($type_info) . "]");
2415 debugmsg(4, "precision: [" . join(',', @$precision) . "]");
2416 debugmsg(4, "scale: [" . join(',', @$scale) . "]");
2417 debugmsg(4, "nullable: [" . join(',', @$nullable) . "]");
2419 # Assemble a multidiminsional array of the output
2420 my @desc;
2421 for(my $i = 0; $i < @$fields; $i++) {
2422 my ($name, $null, $type);
2423 $name = $fields->[$i];
2424 $null = ($nullable->[$i] ? 'NULL' : 'NOT NULL');
2425 my $type_info = $dbh->type_info($types->[$i]);
2426 $type = $type_info->{'TYPE_NAME'};
2427 # convert DECIMAL to NUMBER for our purposes (some kind of DBD kludge)
2428 $type = 'NUMBER' if $type eq 'DECIMAL';
2429 if( $type eq 'VARCHAR2' || $type eq 'NVARCHAR2' ||
2430 $type eq 'CHAR' || $type eq 'NCHAR' || $type eq 'RAW' )
2432 $type .= "($precision->[$i])";
2433 } elsif($type eq 'NUMBER' && ($scale->[$i] || $precision->[$i] < 38))
2435 $type .= "($precision->[$i],$scale->[$i])";
2437 push(@desc, [$name, $null, $type]);
2440 # figure max column sizes we'll need
2441 my @widths = (4,5,4);
2442 for(my $i = 0; $i < @desc; $i++) {
2443 for(my $j = 0; $j < @{$desc[0]}; $j++) {
2444 if(length($desc[$i][$j]) > $widths[$j]) {
2445 $widths[$j] = length($desc[$i][$j]);
2450 # open the redirection file
2451 if($op && $op eq '>' || $op eq '>>') {
2452 ($op_text) = glob($op_text);
2453 debugmsg(3, "Opening file '$op_text' for output redirection using [$op]");
2454 open(FOUT, $op . $op_text) || do query_err('redirect',"Cannot open file '$op_text' for writing: $!", '');
2455 } elsif($op eq '|') {
2456 debugmsg(3, "Opening pipe to '$op_text' for output redirection");
2457 open(FOUT, $op . $op_text) || do query_err('pipe',"Cannot open pipe '$op_text': $!", '');
2458 } else {
2459 open(FOUT, ">&STDOUT");
2462 if($opt_headers) {
2463 # Print headers
2464 print FOUT "\n";
2465 print FOUT sprintf("%-$widths[0]s", 'Name')
2466 . ' '
2467 . sprintf("%-$widths[1]s", 'Null?')
2468 . ' '
2469 . sprintf("%-$widths[2]s", 'Type')
2470 . "\n";
2471 print FOUT '-' x $widths[0]
2472 . ' '
2473 . '-' x $widths[1]
2474 . ' '
2475 . '-' x $widths[2]
2476 . "\n";
2478 for(my $i = 0; $i < @desc; $i++) {
2479 for(my $j = 0; $j < @{$desc[$i]}; $j++) {
2480 print FOUT ' ' if $j > 0;
2481 print FOUT sprintf("%-$widths[$j]s", $desc[$i][$j]);
2483 print FOUT "\n";
2485 print FOUT "\n";
2487 close(FOUT);
2489 return();
2493 # look in all_constraints for the object first. This is because oracle
2494 # stores information about primary keys in the all_objects table as "index"s
2495 # but it doesn't have foreign keys or constraints. So we want to match
2496 # there here first
2498 # now look in all_objects
2499 my $all_object_cols = 'object_type,owner,object_name,'
2500 . 'object_id,created,last_ddl_time,'
2501 . 'timestamp,status';
2503 @ret = $dbh->selectrow_array(
2504 "select $all_object_cols from all_objects where object_name = ? "
2505 ."and owner = ?"
2506 .($nosynonym ? " and object_type != 'SYNONYM'" : ""),
2507 undef, uc($object), uc($schema)
2508 ) or
2509 @ret = $dbh->selectrow_array(
2510 "select $all_object_cols from all_objects where object_name = ? "
2511 ."and owner = 'PUBLIC'"
2512 .($nosynonym ? " and object_type != 'SYNONYM'" : ""),
2513 undef, uc($object)
2516 unless(@ret) {
2517 @ret = $dbh->selectrow_array(
2518 "select constraint_type, constraint_name from all_constraints where "
2519 ."constraint_name = ?",
2520 undef, uc($object)
2524 if($ret[0] eq 'INDEX') {
2525 # Check if this 'index' is really a primary key and is in the
2526 # all_constraints table
2528 my @temp_ret = $dbh->selectrow_array(
2529 "select constraint_type, constraint_name from all_constraints where "
2530 ."constraint_name = ?",
2531 undef, uc($object)
2534 @ret = @temp_ret if @temp_ret;
2537 $type = $ret[0];
2538 debugmsg(1,"type: [$type] ret: [@ret]");
2540 if($type eq 'SYNONYM') {
2541 # Find what this is a synonym to, then recursively call this function
2542 # again to describe whatever it points to
2543 my($table_name, $table_owner) = $dbh->selectrow_array(
2544 'select table_name, table_owner from all_synonyms '
2545 .'where synonym_name = ? and owner = ?',
2546 undef, uc($ret[2]), uc($ret[1])
2549 describe("desc $table_owner.$table_name", $format, 1);
2550 } elsif($type eq 'SEQUENCE') {
2551 my $sqlstr = q{
2552 select sequence_name "Name",
2553 min_value "Min",
2554 max_value "Max",
2555 increment_by "Inc",
2556 cycle_flag "Cycle",
2557 order_flag "Order",
2558 last_number "Last"
2559 from all_sequences
2560 where sequence_name = ?
2561 and sequence_owner = ?
2563 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2564 op_text => $op_text}, uc($ret[2]), uc($ret[1]));
2565 } elsif($type eq 'TABLE' || $type eq 'VIEW' || $type eq 'TABLE PARTITION') {
2566 my $sqlstr = q{
2567 select column_name "Name",
2568 decode(nullable,
2569 'N','NOT NULL'
2570 ) "Null?",
2571 decode(data_type,
2572 'VARCHAR2','VARCHAR2(' || TO_CHAR(data_length) || ')',
2573 'NVARCHAR2','NVARCHAR2(' || TO_CHAR(data_length) || ')',
2574 'CHAR','CHAR(' || TO_CHAR(data_length) || ')',
2575 'NCHAR','NCHAR(' || TO_CHAR(data_length) || ')',
2576 'NUMBER',
2577 decode(data_precision,
2578 NULL, 'NUMBER',
2579 'NUMBER(' || TO_CHAR(data_precision)
2580 || ',' || TO_CHAR(data_scale) || ')'
2582 'FLOAT',
2583 decode(data_precision,
2584 NULL, 'FLOAT', 'FLOAT(' || TO_CHAR(data_precision) || ')'
2586 'DATE','DATE',
2587 'LONG','LONG',
2588 'LONG RAW','LONG RAW',
2589 'RAW','RAW(' || TO_CHAR(data_length) || ')',
2590 'MLSLABEL','MLSLABEL',
2591 'ROWID','ROWID',
2592 'CLOB','CLOB',
2593 'NCLOB','NCLOB',
2594 'BLOB','BLOB',
2595 'BFILE','BFILE',
2596 data_type || ' ???'
2597 ) "Type",
2598 data_default "Default"
2599 from all_tab_columns
2600 where table_name = ?
2601 and owner = ?
2602 order by column_id
2604 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2605 op_text => $op_text}, uc($ret[2]), uc($ret[1]));
2606 } elsif($type eq 'R') {
2607 my $sqlstr = q{
2608 select ac.constraint_name "Name",
2609 decode(ac.constraint_type,
2610 'R', 'Foreign Key',
2611 'C', 'Check',
2612 'U', 'Unique',
2613 'P', 'Primary Key',
2614 ac.constraint_type) "Type",
2615 ac.table_name "Table Name",
2616 acc.column_name "Column Name",
2617 r_ac.table_name "Parent Table",
2618 r_acc.column_name "Parent Column",
2619 ac.delete_rule "Delete Rule"
2620 from all_constraints ac, all_cons_columns acc,
2621 all_constraints r_ac, all_cons_columns r_acc
2622 where ac.constraint_name = acc.constraint_name
2623 and ac.owner = acc.owner
2624 and ac.r_constraint_name = r_ac.constraint_name
2625 and r_ac.constraint_name = r_acc.constraint_name
2626 and r_ac.owner = r_acc.owner
2627 and ac.constraint_type = 'R'
2628 and ac.constraint_name = ?
2629 and ac.owner = ?
2630 order by ac.constraint_name, acc.position
2632 query($sqlstr, 'list_aligned', {num_rows => $num_rows, op => $op,
2633 op_text => $op_text}, uc($ret[1]),
2634 uc($schema));
2635 } elsif($type eq 'P' || $type eq 'U') {
2636 my $sqlstr = q{
2637 select ac.constraint_name "Name",
2638 decode(ac.constraint_type,
2639 'R', 'Foreign Key',
2640 'C', 'Check',
2641 'U', 'Unique',
2642 'P', 'Primary Key',
2643 ac.constraint_type) "Type",
2644 ac.table_name "Table Name",
2645 acc.column_name "Column Name"
2646 from all_constraints ac, all_cons_columns acc
2647 where ac.constraint_name = acc.constraint_name
2648 and ac.owner = acc.owner
2649 and ac.constraint_name = ?
2650 and ac.owner = ?
2651 order by ac.constraint_name, acc.position
2653 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2654 op_text => $op_text}, uc($ret[1]), uc($schema));
2655 } elsif($type eq 'C') {
2656 my $sqlstr = q{
2657 select ac.constraint_name "Name",
2658 decode(ac.constraint_type,
2659 'R', 'Foreign Key',
2660 'C', 'Check',
2661 'U', 'Unique',
2662 'P', 'Primary Key',
2663 ac.constraint_type) "Type",
2664 ac.table_name "Table Name",
2665 ac.search_condition "Search Condition"
2666 from all_constraints ac
2667 where ac.constraint_name = ?
2668 order by ac.constraint_name
2670 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2671 op_text => $op_text}, uc($ret[1]));
2672 } elsif($type eq 'INDEX') {
2673 my $sqlstr = q{
2674 select ai.index_name "Index Name",
2675 ai.index_type "Type",
2676 ai.table_name "Table Name",
2677 ai.uniqueness "Unique?",
2678 aic.column_name "Column Name"
2679 from all_indexes ai, all_ind_columns aic
2680 where ai.index_name = aic.index_name(+)
2681 and ai.table_owner = aic.table_owner(+)
2682 and ai.index_name = ?
2683 and ai.table_owner = ?
2684 order by aic.column_position
2686 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2687 op_text => $op_text}, uc($ret[2]), uc($schema));
2688 } elsif($type eq 'TRIGGER') {
2689 my $sqlstr = q{
2690 select trigger_name "Trigger Name",
2691 trigger_type "Type",
2692 triggering_event "Event",
2693 table_name "Table",
2694 when_clause "When",
2695 description "Description",
2696 trigger_body "Body"
2697 from all_triggers
2698 where trigger_name = ?
2700 query($sqlstr, 'list_aligned', {num_rows => $num_rows, op => $op,
2701 op_text => $op_text}, uc($ret[2]));
2702 } elsif($type eq 'PACKAGE') {
2703 wrn("Not implemented (yet)");
2704 } elsif($type eq 'PROCEDURE') {
2705 wrn("Not implemented (yet)");
2706 } elsif($type eq 'CLUSTER') {
2707 wrn("Not implemented (yet)");
2708 } elsif($type eq 'TRIGGER') {
2709 wrn("Not implemented (yet)");
2710 } else {
2711 query_err('describe', "Object $object not found");
2716 sub set_cmd {
2717 my($input) = @_;
2718 debugmsg(3, "set_cmd called", @_);
2719 # This mimics SQL*Plus set commands, or ignores them completely. For those
2720 # that are not supported, we do nothing at all, but return silently.
2722 if($input =~ /^\s*set\s+serverout(?:put)?\s+(on|off)(?:\s+size\s+(\d+))?/i) {
2723 if(lc($1) eq 'on') {
2724 my $size = $2 || 1_000_000;
2725 debugmsg(2, "calling dbms_output_enable($size)");
2726 $dbh->func( $size, 'dbms_output_enable' )
2727 or warn "dbms_output_enable($size) failed: $DBI::errstr\n";
2728 $set{serveroutput} = 1;
2729 debugmsg(2, "serveroutput set to $set{serveroutput}");
2730 } else {
2731 $set{serveroutput} = 0;
2732 debugmsg(2, "serveroutput set to $set{serveroutput}");
2734 }elsif($input =~ /^\s*set\s+(long_read_len|LongReadLen)\s+(\d+)/i){
2735 debugmsg(2, "long_read_len/LongReadLen set to $2");
2736 $dbh->{LongReadLen} = $2;
2737 }elsif($input =~ /^\s*set\s+fast_describe\s+(on|off)/i){
2738 $conf{fast_describe} = (lc($1) eq 'on') ? 1 : 0;
2739 print "fast_describe is now " . ($conf{fast_describe} ? 'on' : 'off') . "\n";
2744 sub search_cmd {
2745 my($input, $format, $num_rows, $op, $op_text) = @_;
2746 debugmsg(3, "search called", @_);
2748 if($input =~ /^\s*search\s+([a-zA-Z0-9_\$\#\s]+)\s+(?:for)\s+([a-zA-Z0-9_\$\#]+)/) {
2749 debugmsg(3, "search reg", $1,$2, $3);
2751 if ($1 eq 'constraints'){
2752 my $sqlstr = q{
2753 select
2754 CONSTRAINT_NAME "Constraint Name"
2755 ,decode(constraint_type,
2756 'C', 'Check',
2757 'P', 'Primary Key',
2758 'R', 'Foreign Key',
2759 'U', 'Unique',
2760 '') "Type"
2761 ,TABLE_NAME "Table Name"
2762 ,INDEX_NAME "Index Name"
2763 ,STATUS "Status"
2764 from all_constraints
2765 where owner = ? and (
2766 CONSTRAINT_NAME like ?
2769 query(
2770 $sqlstr
2771 ,$format
2773 num_rows => $num_rows
2774 ,op => $op
2775 ,op_text => $op_text
2777 , uc $dbuser
2778 , "%".uc($2)."%"
2781 }else{
2782 query_err("search", "Unsupported search type", $input);
2785 }else{
2786 query_err("search", "Unsupported search type", $input);
2792 sub query {
2793 my($sqlstr, $format, $opts, @bind_vars) = @_;
2794 debugmsg(3, "query called", @_);
2795 # this runs the provided query and calls format_display to display the results
2797 my $num_rows = $opts->{num_rows};
2798 my $op = $opts->{op};
2799 my $op_text = $opts->{op_text};
2800 my $result_output = ( exists $opts->{result_output}
2801 ? $opts->{result_output}
2805 my(@totalbench, @querybench, @formatbench);
2807 # Look for special query types, such as "show" and "desc" that we handle
2808 # and don't send to the database at all, since they're not really valid SQL.
2810 my ($rows_affected, $success_code);
2812 if($sqlstr =~ /^\s*desc/i) {
2813 describe($sqlstr, $format, undef, $num_rows, $op, $op_text);
2814 } elsif($sqlstr =~ /^\s*show/i) {
2815 show($sqlstr, $format, $num_rows, $op, $op_text);
2816 } else {
2817 $running_query = 1;
2819 # make sure we're still connected to the database
2820 unless(ping()) {
2821 wrn("Database connection died");
2822 db_reconnect();
2825 $sqlstr = wildcard_expand($sqlstr) if $conf{column_wildcards};
2827 # send the query on to the database
2828 push(@totalbench, get_bench()) if !$conf{extended_benchmarks};
2829 push(@querybench, get_bench()) if $conf{extended_benchmarks};
2830 debugmsg(3, "preparing", $sqlstr);
2831 my $sth = $dbh->prepare($sqlstr);
2832 unless($sth) {
2833 my $err = $DBI::errstr;
2834 $err =~ s/ \(DBD ERROR\: OCIStmtExecute\/Describe\)//;
2836 if ($err =~ m/DBD ERROR\:/) {
2837 my $indicator_offset = $DBI::errstr;
2838 $indicator_offset =~ s/(.*)(at\ char\ )(\d+)(\ .*)/$3/;
2839 if ($indicator_offset > 0) {
2840 my $i = 0;
2841 print $sqlstr, "\n";
2842 for ($i=0;$i<$indicator_offset;++$i) {
2843 print " ";
2845 print "*\n";
2849 # Output message if serveroutput is on
2850 if($set{serveroutput}) {
2851 debugmsg(3, "Calling dmbs_output_get");
2852 my @output = $dbh->func( 'dbms_output_get' );
2853 print join("\n", @output) . "\n";
2855 query_err('prepare', $err, $sqlstr), setup_sigs(), return();
2857 debugmsg(2, "sth: [$sth]");
2859 $cursth = $sth;
2861 finish_query($sth), return() if $sigintcaught; #pseudo sig handle
2863 my $ret;
2864 eval {
2865 debugmsg(3, "executing", $sqlstr);
2866 $ret = $sth->execute(@bind_vars);
2868 debugmsg(3, "ret:", $ret, "\@:", $@, "\$DBI::errstr:", $DBI::errstr);
2869 if(!$ret) {
2870 my $eval_error = $@;
2871 $eval_error =~ s/at \(eval \d+\) line \d+, <\S+> line \d+\.//;
2872 my $err = $DBI::errstr;
2873 $err =~ s/ \(DBD ERROR: OCIStmtExecute\)//;
2874 # Output message is serveroutput is on
2875 if($set{serveroutput}) {
2876 debugmsg(3, "Calling dmbs_output_get");
2877 my @output = $dbh->func( 'dbms_output_get' );
2878 print join("\n", @output) . "\n";
2880 my $errstr = ($eval_error ? $eval_error : $err);
2881 query_err('execute', $errstr, $sqlstr);
2882 setup_sigs();
2883 return();
2886 if($DBI::errstr =~ /^ORA-24344/) {
2887 print "\nWarning: Procedure created with compilation errors.\n\n";
2888 setup_sigs();
2889 return();
2892 push(@querybench, get_bench()) if $conf{extended_benchmarks};
2894 finish_query($sth), return() if $sigintcaught; #pseudo sig handle
2896 debugmsg(1, "rows returned: [" . $sth->rows() . "]");
2898 # open the redirection file
2899 if($op && $op eq '>' || $op eq '>>') {
2900 ($op_text) = glob($op_text);
2901 debugmsg(3, "Opening file '$op_text' for output redirection using [$op]");
2902 open(FOUT, $op . $op_text) || do{
2903 query_err('redirect',"Cannot open file '$op_text' for writing: $!",
2904 $sqlstr);
2905 finish_query($sth);
2906 return();
2908 } elsif($op eq '|') {
2909 debugmsg(3, "Opening pipe to '$op_text' for output redirection");
2910 open(FOUT, $op . $op_text) || do{
2911 query_err('pipe',"Cannot open pipe '$op_text': $!", $sqlstr);
2912 finish_query($sth);
2913 return();
2915 } else {
2916 open(FOUT, ">&STDOUT");
2919 # Output message is serveroutput is on
2920 if($set{serveroutput}) {
2921 debugmsg(3, "Calling dmbs_output_get");
2922 my @output = $dbh->func( 'dbms_output_get' );
2923 print join("\n", @output) . "\n";
2926 # Determine type and output accordingly
2927 if($sqlstr =~ /^\s*declare|begin/i) {
2928 print STDERR "\nPL/SQL procedure successfully completed.\n\n";
2929 } else {
2930 push(@formatbench, get_bench()) if $conf{extended_benchmarks};
2931 ($rows_affected, $success_code) = format_output($sth, $format, $num_rows,
2932 $sqlstr, $op, $op_text)
2933 or finish_query($sth), return();
2934 push(@formatbench, get_bench()) if $conf{extended_benchmarks};
2935 push(@totalbench, get_bench()) if !$conf{extended_benchmarks};
2937 finish_query($sth), return() if $sigintcaught; #pseudo sig handle
2939 # output format_affected
2940 if($result_output) {
2941 if(!$opt_batch) {
2942 print STDERR "\n" . format_affected($rows_affected, $success_code);
2945 if(!$opt_batch) {
2946 if($opt_bench || $conf{extended_benchmarks}) {
2947 print STDERR "\n\n";
2948 print STDERR ('-' x 80);
2949 print STDERR "\n";
2950 output_benchmark("Query: ", @querybench, "\n");
2951 output_benchmark("Format:", @formatbench, "\n");
2952 } else {
2953 output_benchmark(" (", @totalbench, ")");
2954 print STDERR "\n";
2956 print STDERR "\n";
2961 close(FOUT);
2963 finish_query($sth);
2965 undef($sth);
2966 undef($cursth);
2969 return($rows_affected, $success_code);
2972 sub wildcard_expand {
2973 my($sql) = @_;
2974 debugmsg(3, "wildcard_expand called", @_);
2976 my $newsql = $sql;
2977 my $fromstuff;
2978 my $wheregrouporder = $sql;
2979 $wheregrouporder =~ s/.*(where|order|group).*/\1/;
2980 if ($wheregrouporder eq $sql) {
2981 $wheregrouporder = "";
2983 ($sql,$fromstuff) = split(/order|group|where/i,$sql,2);
2984 if ($sql =~ /^select\s+(.+?)\*\s+from\s+(.+)/i) {
2985 debugmsg(1, "Match made: ($1) ($2)");
2986 my $wildcardstring = uc($1);
2987 my $tablename = uc($2);
2988 my @tlist = split(/,/,$tablename);
2989 my $tablelist = "";
2990 my %column_prefix;
2991 foreach my $table (@tlist) {
2992 $table =~ s/^ *//;
2993 $table =~ s/([^ ]+)\s+(.*)/\1/;
2994 $column_prefix{$table} = $2 ? $2 : $table;
2995 $tablelist .= ($tablelist ? "," : "") . $table;
2997 $tablelist =~ s/,/' or table_name='/g;
2998 my $qstr = "select table_name||'.'||column_name from all_tab_columns where (table_name='$tablelist') and column_name like '$wildcardstring%' escape '\\'";
2999 debugmsg(1, "qstr: [$qstr]");
3000 my $sth = $dbh->prepare($qstr);
3001 $sth->execute();
3002 setup_sigs();
3003 my $colname;
3004 my $collist;
3005 while ( ($colname) = $sth->fetchrow_array() ) {
3006 foreach my $table (keys %column_prefix) {
3007 $colname =~ s/$table\./$column_prefix{$table}\./;
3008 $colname =~ s/ //g;
3010 $collist .= ($collist ? "," : "") . $colname;
3012 $collist = $collist ? $collist : "*";
3013 $newsql = "select " . $collist . " from " . $tablename . " "
3014 . $wheregrouporder . " " . $fromstuff;
3015 debugmsg(1, "newsql: [$newsql]");
3017 $newsql;
3020 sub finish_query {
3021 my($sth) = @_;
3022 # This just finishes the query and cleans up the state info
3024 $sth->finish;
3025 undef($cursth);
3026 $running_query = 0;
3027 setup_sigs();
3030 sub get_bench {
3031 debugmsg(3, "get_bench called", @_);
3032 # returns benchmark info
3034 my($benchmark, $hires);
3035 $benchmark = new Benchmark;
3037 if($nohires) {
3038 $hires = time;
3039 } else {
3040 # use an eval to keep perl from syntax checking it unless we have the
3041 # Time::HiRes module loaded
3042 eval q{
3043 $hires = [gettimeofday]
3047 return($benchmark, $hires);
3050 sub output_benchmark {
3051 my($string, $bstart, $hrstart, $bend, $hrend, $string2) = @_;
3052 debugmsg(3, "output_benchmark called", @_);
3053 # This just outputs the benchmark info
3055 my $bench = timediff($bend, $bstart);
3057 my $time;
3058 if($nohires) {
3059 # the times will be seconds
3060 $time = $hrend - $hrstart;
3061 } else {
3062 eval q{$time = tv_interval($hrstart, $hrend)};
3063 $time = sprintf("%.2f", $time);
3066 unless($opt_bench || $conf{extended_benchmarks}) {
3067 # convert $time to something more readable
3068 $time =~ s/\.(\d+)$//;
3069 my $decimal = $1;
3070 my @tparts;
3071 my $tmp;
3072 if(($tmp = int($time / 604800)) >= 1) {
3073 push(@tparts, "$tmp week" . ($tmp != 1 && 's'));
3074 $time %= 604800;
3076 if(($tmp = int($time / 86400)) >= 1) {
3077 push(@tparts, "$tmp day" . ($tmp != 1 && 's'));
3078 $time %= 86400;
3080 if(($tmp = int($time / 3600)) >= 1) {
3081 push(@tparts, "$tmp hour" . ($tmp != 1 && 's'));
3082 $time %= 3600;
3084 if(($tmp = int($time / 60)) >= 1) {
3085 push(@tparts, "$tmp minute" . ($tmp != 1 && 's'));
3086 $time %= 60;
3088 $time ||= '0';
3089 $decimal ||= '00';
3090 $time .= ".$decimal";
3091 push(@tparts, "$time second" . ($time != 1 && 's'));
3092 $time = join(", ", @tparts);
3095 if($opt_bench || $conf{extended_benchmarks}) {
3096 print STDERR "$string\[ $time second" . ($time != 1 && 's')
3097 . " ] [" . timestr($bench) . " ]$string2";
3098 } else {
3099 print STDERR "$string$time$string2";
3103 sub format_output {
3104 my($sth, $format, $num_rows, $sqlstr, $op, $op_text) = @_;
3105 debugmsg(3, "format_output called", @_);
3106 # Formats the output according to the query terminator. If it was a ';' or
3107 # a '/' then a normal table is output. If it was a '\g' then all the columns # and rows are output put line by line.
3108 # input: $sth $format
3109 # sth is the statement handler
3110 # format can be either 'table', 'list', or 'list_aligned'
3111 # output: returns 0 on error, ($success_code, $rows_affected) on success
3112 # $success_code = ('select', 'affected');
3114 debugmsg(3,"type: [" . Dumper($sth->{TYPE}) . "]");
3116 # Is this query a select?
3117 my $isselect = 1 if $sqlstr =~ /^\s*select/i;
3119 if($format eq 'table') {
3120 my $count = 0;
3121 my $res = [];
3122 my $overflow = 0;
3123 while(my @res = $sth->fetchrow_array()) {
3124 push(@$res, \@res);
3125 $count++;
3126 if($count > 1000) {
3127 debugmsg(1,"overflow in table output, switching to serial mode");
3128 $overflow = 1;
3129 last;
3131 debugmsg(1,"num_rows hit on fetch") if $num_rows && $count >= $num_rows;
3132 last if $num_rows && $count >= $num_rows;
3133 return(0) if $sigintcaught; #pseudo sig handle
3136 # If we didn't get any rows back, then the query was probably an insert or
3137 # update, so we call format_affected
3138 if(@$res <= 0 && !$isselect) {
3139 return($sth->rows(), 'affected');
3142 return(0) if $sigintcaught; #pseudo sig handle
3144 # First go through all the return data to determine column widths
3145 my @widths;
3146 for( my $i = 0; $i < @{$res}; $i++ ) {
3147 for( my $j = 0; $j < @{$res->[$i]}; $j++ ) {
3148 if(length($res->[$i]->[$j]) > $widths[$j]) {
3149 $widths[$j] = length($res->[$i]->[$j]);
3152 return(0) if $sigintcaught; #pseudo sig handle
3153 debugmsg(1,"num_rows hit on calc") if $num_rows && $i >= $num_rows-1;
3154 last if $num_rows && $i >= $num_rows-1;
3157 return(0) if $sigintcaught; #pseudo sig handle
3159 my $fields = $sth->{NAME};
3160 my $types = $sth->{TYPE};
3161 my $nullable = $sth->{NULLABLE};
3163 debugmsg(4, "fields: [" . Dumper($fields) . "]");
3164 debugmsg(4, "types: [" . Dumper($types) . "]");
3165 debugmsg(4, "nullable: [" . Dumper($nullable) . "]");
3167 return(0) if $sigintcaught; #pseudo sig handle
3169 # Extend the column widths if the column name is longer than any of the
3170 # data, so that it doesn't truncate the column name
3171 for( my $i = 0; $i < @$fields; $i++ ) {
3172 if(length($fields->[$i]) > $widths[$i]) {
3173 debugmsg(3, "Extending $fields->[$i] for name width");
3174 $widths[$i] = length($fields->[$i]);
3176 return(0) if $sigintcaught; #pseudo sig handle
3179 return(0) if $sigintcaught; #pseudo sig handle
3181 # Extend the column widths if the column is NULLABLE so that we'll
3182 # have room for 'NULL'
3183 for( my $i = 0; $i < @$nullable; $i++ ) {
3184 if($nullable->[$i] && $widths[$i] < 4) {
3185 debugmsg(3, "Extending $fields->[$i] for null");
3186 $widths[$i] = 4;
3188 return(0) if $sigintcaught; #pseudo sig handle
3191 return(0) if $sigintcaught; #pseudo sig handle
3193 my $sumwidths;
3194 foreach(@widths) {
3195 $sumwidths += $_;
3198 return(0) if $sigintcaught; #pseudo sig handle
3200 debugmsg(2,"fields: [" . join("|", @$fields) . "] sumwidths: [$sumwidths] widths: [" . join("|", @widths) . "]\n");
3202 return(0) if $sigintcaught; #pseudo sig handle
3204 # now do the actual outputting, starting with the header
3205 my $rows_selected = 0;
3206 if(@$res) {
3207 if(!$opt_batch) {
3208 print FOUT "\r\e[K" if $op eq '<';
3209 print FOUT "\n";
3210 for( my $i = 0; $i < @$fields; $i++ ) {
3211 if($opt_batch) {
3212 print FOUT "\t" if $i > 0;
3213 print FOUT sprintf("%s", $fields->[$i]);
3215 else
3217 print FOUT " " if $i > 0;
3218 if($types->[$i] == 3 || $types->[$i] == 8) {
3219 print FOUT sprintf("%$widths[$i]s", $fields->[$i]);
3220 } else {
3221 print FOUT sprintf("%-$widths[$i]s", $fields->[$i]);
3225 print FOUT "\n";
3227 for( my $i = 0; $i < @$fields; $i++ ) {
3228 print FOUT " " if $i > 0;
3229 print FOUT '-' x $widths[$i];
3231 print FOUT "\n";
3234 return(0) if $sigintcaught; #pseudo sig handle
3236 # now print the actual data rows
3237 my $count = 0;
3238 for( my $j = 0; $j < @$res; $j++ ) {
3239 $count = $j;
3240 for( my $i = 0; $i < @$fields; $i++ ) {
3241 print FOUT " " if $i > 0;
3242 my $data = $res->[$j]->[$i];
3243 # Strip out plain ole \r's since SQL*Plus seems to...
3244 $data =~ s/\r//g;
3245 $data = 'NULL' unless defined $data;
3246 if($types->[$i] == 3 || $types->[$i] == 8) {
3247 print FOUT sprintf("%$widths[$i]s", $data);
3248 } else {
3249 print FOUT sprintf("%-$widths[$i]s", $data);
3252 print FOUT "\n";
3254 $rows_selected++;
3255 debugmsg(2,"num_rows hit on output") if $num_rows && $j >= $num_rows-1;
3256 last if $num_rows && $j >= $num_rows-1;
3257 return(0) if $sigintcaught; #pseudo sig handle
3260 if($overflow) {
3261 # output the rest of the data from the statement handler
3262 while(my $res = $sth->fetch()) {
3263 $count++;
3264 for( my $i = 0; $i < @$fields; $i++ ) {
3265 print FOUT " " if $i > 0;
3266 my $data = substr($res->[$i],0,$widths[$i]);
3267 # Strip out plain ole \r's since SQL*Plus seems to...
3268 $data =~ s/\r//g;
3269 $data = 'NULL' unless defined $data;
3270 if($types->[$i] == 3 || $types->[$i] == 8) {
3271 print FOUT sprintf("%$widths[$i]s", $data);
3272 } else {
3273 print FOUT sprintf("%-$widths[$i]s", $data);
3276 print FOUT "\n";
3278 $rows_selected++;
3279 debugmsg(2,"num_rows hit on output")
3280 if $num_rows && $count >= $num_rows-1;
3281 last if $num_rows && $count >= $num_rows-1;
3282 return(0) if $sigintcaught; #pseudo sig handle
3287 return($rows_selected, 'selected');
3289 } elsif($format eq 'list') {
3290 # output in a nice list format, which is where we print each row in turn,
3291 # with each column on it's own line
3293 my $fields = $sth->{NAME};
3295 print "\r\e[K" if $op eq '<';
3296 print FOUT "\n";
3298 my $count = 0;
3299 while(my $res = $sth->fetch()) {
3300 print FOUT "\n**** Row: " . ($count+1) . "\n";
3301 for( my $i = 0; $i < @$fields; $i++ ) {
3302 my $data = $res->[$i];
3303 $data = 'NULL' unless defined $data;
3304 print FOUT $fields->[$i] . ": " . $data . "\n";
3306 $count++;
3307 last if $num_rows && $count >= $num_rows;
3308 return(0) if $sigintcaught; #pseudo sig handle
3311 return(0) if $sigintcaught; #pseudo sig handle
3313 # If we didn't get any rows back, then the query was probably an insert or
3314 # update, so we call format_affected
3315 if($count <= 0 && !$isselect) {
3316 return($sth->rows(), 'affected');
3319 return($count, 'selected');
3321 } elsif($format eq 'list_aligned') {
3322 # output in a nice list format, which is where we print each row in turn,
3323 # with each column on it's own line. The column names are aligned in this
3324 # one (so that the data all starts on the same column)
3326 my $fields = $sth->{NAME};
3328 print "\r\e[K" if $op eq '<';
3329 print FOUT "\n";
3331 my $maxwidth = 0;
3332 for( my $i = 0; $i < @$fields; $i++ ) {
3333 my $len = length($fields->[$i]) + 1; # +1 for the colon
3334 $maxwidth = $len if $len >= $maxwidth;
3337 return(0) if $sigintcaught; #pseudo sig handle
3339 my $count = 0;
3340 while(my $res = $sth->fetch()) {
3341 print FOUT "\n**** Row: " . ($count+1) . "\n";
3342 for( my $i = 0; $i < @$fields; $i++ ) {
3343 my $data = $res->[$i];
3344 $data = 'NULL' unless defined $data;
3345 print FOUT sprintf("%-" . $maxwidth . "s", $fields->[$i] . ":");
3346 print FOUT " " . $data . "\n";
3348 $count++;
3349 last if $num_rows && $count >= $num_rows;
3350 return(0) if $sigintcaught; #pseudo sig handle
3353 return(0) if $sigintcaught; #pseudo sig handle
3355 # If we didn't get any rows back, then the query was probably an insert or
3356 # update, so we call format_affected
3357 if($count <= 0 && !$isselect) {
3358 return($sth->rows(), 'affected');
3361 return($count, 'selected');
3363 } elsif($format eq 'single_output') {
3364 # Outputs a single return column/row without any labeling
3366 print FOUT "\n";
3368 my $res = $sth->fetchrow_array();
3369 print FOUT "$res\n";
3371 my $count = ($res ? 1 : 0);
3373 return(0) if $sigintcaught; #pseudo sig handle
3375 return($count, 'selected');
3377 } elsif($format eq 'csv' || $format eq 'csv_no_header') {
3378 # output in a comma seperated values format. fields with a ',' are quoted
3379 # with '"' quotes, and rows are seperated by '\n' newlines
3381 print "\r\e[K" if $op eq '<';
3382 print FOUT "\n";
3384 # check that Text::CSV_XS was included ok, if not output an error
3385 if($notextcsv) {
3386 soft_err("You must install Text::CSV_XS from CPAN to use this feature");
3387 return(0);
3388 } else {
3389 my $fields = $sth->{NAME};
3391 if($format eq 'csv') {
3392 # Print the column headers
3393 for(my $i = 0; $i < @$fields; $i++) {
3394 print FOUT "," if $i > 0;
3395 print FOUT $fields->[$i];
3397 print FOUT "\n";
3400 my $count = 0;
3401 while(my $res = $sth->fetch()) {
3402 $count++;
3404 $csv->combine(@$res);
3405 print FOUT $csv->string() . "\n";
3407 last if $num_rows && $count >= $num_rows;
3408 return(0) if $sigintcaught; #pseudo sig handle
3411 return(0) if $sigintcaught; #pseudo sig handle
3413 # If we didn't get any rows back, then the query was probably an insert or
3414 # update, so we call format_affected
3415 if($count <= 0 && !$isselect) {
3416 return($sth->rows(), 'affected');
3419 return($count, 'selected');
3421 } elsif($format eq 'sql') {
3422 # Produce SQL insert statements.
3423 print "\r" if $op eq '<';
3424 print FOUT "\n";
3426 my $cols = lc join(', ', @{$sth->{NAME}});
3427 my @types = map { scalar $dbh->type_info($_)->{TYPE_NAME} } @{ $sth->{TYPE} };
3428 my %warned_unknown_type;
3430 my $count = 0;
3431 while(my $res = $sth->fetch()) {
3432 $count++;
3433 die if @$res != @types;
3434 print FOUT "insert into TABLE ($cols) values (";
3435 foreach (0 .. $#$res) {
3436 my $t = $types[$_];
3437 my $v = $res->[$_];
3438 if (not defined $v) {
3439 print FOUT 'null';
3440 } else {
3441 if ($t eq 'DOUBLE' or $t eq 'DOUBLE PRECISION' or
3442 $t eq 'NUMBER' or $t eq 'DECIMAL') {
3443 die "bad number: $v" if $v !~ /\d/;
3444 print FOUT $v;
3445 } elsif ($t eq 'VARCHAR2' or $t eq 'CHAR' or $t eq 'CLOB') {
3446 $v =~ s/['']/''/g;
3447 print FOUT "'$v'";
3448 } elsif ($t eq 'DATE') {
3449 print FOUT "'$v'";
3450 } else {
3451 warn "don't know how to handle SQL type $t"
3452 unless $warned_unknown_type{$t}++;
3453 print FOUT "(unknown type $t: $v)";
3456 print FOUT ', ' unless $_ eq $#$res;
3458 print FOUT ");\n";
3459 last if $num_rows && $count >= $num_rows;
3460 return(0) if $sigintcaught; #pseudo sig handle
3462 return(0) if $sigintcaught; #pseudo sig handle
3464 # If we didn't get any rows back, then the query was probably an insert or
3465 # update, so we call format_affected
3466 if($count <= 0 && !$isselect) {
3467 return($sth->rows(), 'affected');
3469 return($count, 'selected');
3470 } else {
3471 die("Invalid format: $format");
3475 sub format_affected {
3476 my($rows_affected, $success_code) = @_;
3477 debugmsg(3, "format_affected called", @_);
3478 # This just outputs the given number
3480 return("$rows_affected row" . ($rows_affected == 1 ? '' : 's')
3481 ." $success_code");
3484 sub statusline {
3485 my($num, $max) = @_;
3486 debugmsg(3, "statusline called", @_);
3487 my $linewidth;
3488 eval q{
3489 use Term::ReadKey;
3490 (\$linewidth) = GetTerminalSize();
3492 if($@) {
3493 $linewidth = 80;
3495 my $numwidth = length($num);
3496 my $maxwidth = length($max);
3497 my $width = $linewidth - $numwidth - $maxwidth - 9;
3499 my $fillnum = (($num / $max) * $width);
3500 my $spacenum = ((($max - $num) / $max) * $width);
3502 if($fillnum =~ /\./) {
3503 $fillnum = int($fillnum) + 1;
3506 if($spacenum =~ /\./) {
3507 $spacenum = int($spacenum);
3510 my $fill = ('*' x $fillnum);
3511 my $space = ('-' x $spacenum);
3512 my $pcnt = sprintf("%.0d", ($num / $max * 100));
3514 return(sprintf("%-" . $linewidth . "s", "$num/$max [" . $fill . $space . "] $pcnt\%") . "\r");
3517 sub statusprint {
3518 my($string) = @_;
3520 return("\r\e[K$string\n");
3523 sub ping {
3524 debugmsg(3, "ping called", @_);
3525 if(!$dbh) {
3526 return(0);
3527 } else {
3528 # install alarm signal handle
3529 $SIG{ALRM} = \&sighandle;
3530 debugmsg(2, "Setting alarm for ping ($conf{connection_timeout} seconds)");
3531 alarm($conf{connection_timeout});
3533 debugmsg(2, "Pinging...");
3534 if($dbh->ping()) {
3535 debugmsg(2, "Ping successfull");
3536 alarm(0); # cancel alarm
3537 return(1);
3538 } else {
3539 debugmsg(2, "Ping failed");
3540 alarm(0); # cancel alarm
3541 db_reconnect();
3542 return(0);
3545 alarm(0); # cancel alarm
3548 sub query_err {
3549 my($query_type, $msg, $query) = @_;
3550 debugmsg(3, "query_err called", @_);
3551 # outputs a standard query error. does not exit
3552 # input: $query_type, $msg, $query
3554 chomp($query_type);
3555 chomp($msg);
3556 chomp($query);
3558 print STDERR "\n";
3559 print STDERR "$msg\n";
3560 print STDERR "Query: $query\n" if $query && $conf{sql_query_in_error};
3561 print STDERR "\n";
3564 sub lerr {
3565 my($msg) = @_;
3566 debugmsg(3, "err called", @_);
3567 # outputs an error message and exits
3569 print "Error: $msg\n";
3570 quit(1);
3573 sub soft_err {
3574 my($msg) = @_;
3575 debugmsg(3, "soft_err called", @_);
3576 # outputs a error, but doesn't exit
3578 print "\nError: $msg\n\n";
3581 sub wrn {
3582 my($msg) = @_;
3583 debugmsg(3, "wrn called", @_);
3584 # outputs a warning
3586 print STDERR "Warning: $msg\n";
3589 sub quit {
3590 my($exitcode, $force_quit, $msg) = @_;
3591 debugmsg(3, "quit called", @_);
3592 # just quits
3593 $exitcode ||= 0;
3594 $force_quit ||= 0; # Set this to 1 to try a smoother force quit
3595 $msg ||= '';
3597 setup_sigs();
3599 print "$msg" if $msg && $msg != "";
3600 $quitting = 1;
3602 if($force_quit) {
3603 exit($exitcode);
3606 commit_on_exit();
3608 # disconnect the database
3609 debugmsg(1, "disconnecting from database");
3610 if (defined $dbh) {
3611 $dbh->disconnect()
3612 or warn "Disconnect failed: $DBI::errstr\n";
3615 debugmsg(1, "exiting with exitcode: [$exitcode]");
3616 exit($exitcode);
3619 sub commit_on_exit {
3620 debugmsg(3, "commit_on_exit called", @_);
3622 # Commit... or not
3623 if($conf{commit_on_exit} && defined $dbh && !$dbh->{AutoCommit}) {
3624 # do nothing, oracle commits on disconnect
3625 } elsif(defined $dbh && !$dbh->{AutoCommit}) {
3626 print "Rolling back any outstanding transaction...\n";
3627 $dbh->rollback()
3628 or warn "Rollback failed: $DBI::errstr\n";
3632 sub debugmsg {
3633 my($debuglevel, @msgs) = @_;
3634 if($opt_debug >= $debuglevel ) {
3635 my @time = localtime();
3636 my $time = sprintf("%.4i-%.2i-%.2i %.2i:%.2i:%.2i", $time[5] + 1900,
3637 $time[4] + 1, $time[3], $time[2], $time[1], $time[0]);
3638 print STDERR "$time $debuglevel [" . join("] [", @msgs) . "]\n";
3642 sub usage {
3643 my($exit) = @_;
3644 debugmsg(3, "usage called", @_);
3646 $exit ||= 0;
3648 print <<_EOM_;
3649 Usage: yasql [options] [logon] [AS {SYSDBA|SYSOPER}] [@<file>[.ext]
3650 [<param1> <param2> ...]]
3651 Logon: <username>[/<password>][@<connect_string>] | /
3652 Options:
3653 -d, --debug=LEVEL Turn debugging on to LEVEL
3654 -H, --host=HOST Host to connect to
3655 -p, --port=PORT Host port to connect to
3656 -s, --sid=SID Oracle SID to connect to
3657 -h, -?, --help This help information
3658 -A, --nocomp Turn off building the auto-completion list
3659 -b, --bench, --benchmark Display extra benchmarking info
3660 -v, --version Print version and exit
3661 -B, --batch Batch mode (no headers, etc.)
3663 See the man pages for more help.
3664 _EOM_
3666 exit($exit);
3669 sub help {
3670 debugmsg(3, "help called", @_);
3671 # This just outputs online help
3673 my $help = <<_EOM_;
3675 Commands:
3676 help This screen
3677 quit, exit, \\q Exit the program.
3678 !<cmd>, host <cmd> Sends the command directly to a shell.
3679 \\A Regenerate the auto-completion list.
3680 connect [logon] [AS {SYSDBA|SYSOPER}]
3681 Open new connection.
3682 login = <username>[/<password>][@<connect_string>] | /
3683 reconnect, \\r Reconnect to the database
3684 desc[ribe] <object> Describe table, view, index, sequence, primary key,
3685 foreign key, constraint or trigger
3686 object = [<schema>.]<object>[\@dblink]
3687 show [all] <string> Shows [all] objects of a certain type
3688 string = tables, views, objects, sequences, clusters,
3689 dimensions, functions, procedures, packages,
3690 indexes, indextypes, libraries, snapshots
3691 materialized views, synonyms, triggers,
3692 show <string> on|for <object>
3693 Shows properties for a particular object
3694 string = indexes, constraints, keys, checks, triggers,
3695 query
3696 show processes Shows logged in users
3697 show [all] waits Shows [all] waits
3698 show plan Shows the last EXPLAIN PLAN ran
3699 show errors Shows errors from PL/SQL object creation
3700 search <string> for <name>
3701 Search Objects by name
3702 string = constraints
3703 l[ist], \\l, \\p List the contents of the current buffer
3704 cl[ear] [buffer], \\c
3705 Clear the current buffer
3706 ed[it] [filename], \\e [filename]
3707 Will open a text editor as defined by the EDITOR
3708 environment variable. If a file is given as the
3709 argument, then the editor will be opened with that
3710 file. If the given file does not exist then it will be
3711 created. In both cases the file will not be deleted,
3712 and the current buffer will be overwritten by the
3713 contents of the file. If no file is given, then the
3714 editor will be opened with a temporary file, which will
3715 contain the current contents of the buffer, or the last
3716 execute query if the buffer is empty. After the editor
3717 quits, the file will be read into the buffer. The
3718 contents will be parsed and executed just as if you had
3719 typed them all in by hand. You can have multiple
3720 commands and/or queries. If the last command is not
3721 terminated them you will be able to add furthur lines
3722 or input a terminator to execute the query.
3723 \@scriptname Execute all the commands in <filename> as if they were
3724 typed in directly. All CLI commands and queries are
3725 supported. yasql will quit after running all
3726 commands in the script.
3727 debug [num] Toggle debuggin on/off or if <num> is specified, then
3728 set debugging to that level
3729 autocommit Toggle AutoCommit on/off
3730 set <string> Set options
3731 string = [
3732 [long_read_len <size>]
3733 || [ fast_describe [on|off]]
3734 || [ serverout{put} [on|off] {size <size>} ]
3737 Queries:
3738 All other input is treated as a query, and is sent straight to the database.
3740 All queries must be terminated by one of the following characters:
3741 ; - Returns data in table form
3742 / - Returns data in table form
3743 \\g - Returns data in non-aligned list form
3744 \\G - Returns data in aligned list form
3745 \\s - Returns data in CSV form. The first line is the column names
3746 \\S - Returns data in CSV form, but no column names
3747 \\i - Returns data in sql select commands form
3749 You may re-run the last query by typing the terminator by itself.
3751 Example:
3752 user\@ORCL> select * from table;
3753 user\@ORCL> \\g
3755 Return limit:
3756 You may add a number after the terminator, which will cause only the
3757 first <num> rows to be returned. e.g. 'select * from table;10' will run
3758 the query and return the first 10 rows in table format. This will also work
3759 if you just type the terminator to rerun the last query.
3761 Examples:
3762 The following will run the query, then run it again with different settings:
3763 user\@ORCL> select * from table;10
3764 user\@ORCL> \G50
3766 Redirection:
3767 You can add a shell like redirection operator after a query to pipe the output
3768 to or from a file.
3770 Output:
3771 You can use either '>' or '>>' to output to a file. '>' will overwrite the
3772 file and '>>' will append to the end of the file. The file will be created
3773 if it does not exist.
3775 Examples:
3776 user\@ORCL> select * from table; > table.dump
3777 user\@ORCL> select * from table\S > table.csv
3779 Input:
3780 You can use '<' to grab data from a CSV file. The file must be formatted
3781 with comma delimiters, quoted special fields, and rows seperated by
3782 newlines. When you use this operator with a query, the query will be ran
3783 for every line in the file. Put either '?' or ':n' (n being a number)
3784 placeholders where you want the data from the CSV file to be interpolated.
3785 The number of placeholders must match the number of columns in the CSV file.
3786 Each query is run as if you had typed it in, so the AutoCommit setting
3787 applies the same. If there is an error then the process will stop, but no
3788 rollback or anything will be done.
3790 Examples:
3791 user\@ORCL> insert into table1 values (?,?,?); < table1.csv
3792 user\@ORCL> update table2 set col1 = :1, col3 = :3, col2 = :2; < table2.csv
3794 Piping
3795 You can pipe the output from a query to the STDIN of any program you wish.
3797 Examples:
3798 user\@ORCL> select * from table; | less
3799 user\@ORCL> select * from table; | sort -n
3801 Please see 'man yasql' or 'perldoc yasql' for more help
3802 _EOM_
3804 my $ret = open(PAGER, "|$conf{pager}");
3805 if($ret) {
3806 print PAGER $help;
3807 close(PAGER);
3808 } else {
3809 print $help;
3813 __END__
3815 =head1 NAME
3817 yasql - Yet Another SQL*Plus replacement
3819 =head1 SYNOPSIS
3821 B<yasql> [options] [logon] [@<file>[.ext] [<param1> <param2>]
3823 =over 4
3825 =item logon
3827 <I<username>>[/<I<password>>][@<I<connect_string>>] | /
3829 =item options
3831 =over 4
3833 =item -d I<debuglevel>, --debug=I<debuglevel>
3835 Turn debuggin on to I<debuglevel> level. Valid levels: 1,2,3,4
3837 =item -H I<hostaddress>, --host=I<hostaddress>
3839 Host to connect to
3841 =item -p I<hostport>, --port=I<hostport>
3843 Host port to connect to
3845 =item -s I<SID>, --sid=I<SID>
3847 Oracle SID to connect to
3849 =item -h, -?, --help
3851 Output usage information and quit.
3853 =item -A, --nocomp
3855 Turn off the generation of the auto-completion list at startup. Use This if
3856 it takes too long to generate the list with a large database.
3858 =item -b, --bench, --benchmark
3860 Turn on extended benchmark info, which includes times and CPU usages for both
3861 queries and formatting.
3863 =item -v, --version
3865 Print version and exit
3867 =back
3869 =item Examples
3871 =over 4
3873 =item Connect to local database
3875 =over 4
3877 =item yasql
3879 =item yasql user
3881 =item yasql user/password
3883 =item yasql user@LOCAL
3885 =item yasql user/password@LOCAL
3887 =item yasql -h localhost
3889 =item yasql -h localhost -p 1521
3891 =item yasql -h localhost -p 1521 -s ORCL
3893 =back
3895 =item Connect to remote host
3897 =over 4
3899 =item yasql user@REMOTE
3901 =item yasql user/password@REMOTE
3903 =item yasql -h remote.domain.com
3905 =item yasql -h remote.domain.com -p 1512
3907 =item yasql -h remote.domain.com -p 1512 -s ORCL
3909 =back
3911 =back
3913 =back
3915 If no connect_string or a hostaddress is given, then will attempt to connect to
3916 the local default database.
3918 =head1 DESCRIPTION
3920 YASQL is an open source Oracle command line interface. YASQL features a much
3921 kinder alternative to SQL*Plus's user interface. This is meant to be a
3922 complete replacement for SQL*Plus when dealing with ad hoc queries and general
3923 database interfacing. It's main features are:
3925 =over 4
3927 =item Full ReadLine support
3929 Allows the same command line style editing as other ReadLine enabled programs
3930 such as BASH and the Perl Debugger. You can edit the command line as well as
3931 browse your command history. The command
3932 history is saved in your home directory in a file called .yasql_history. You
3933 can also use tab completion on all table and column names.
3935 =item Alternate output methods
3937 A different style of output suited to each type of need. There are currently
3938 table, list and CSV output styles. Table style outputs in the same manner as
3939 SQL*Plus, except the column widths are set based on the width of the data in
3940 the column, and not the column length defined in the table schema. List outputs
3941 each row on it's own line, column after column for easier viewing of wide return
3942 results. CSV outputs the data in Comma Seperated Values format, for easy
3943 import into many other database/spreadsheet programs.
3945 =item Output of query results
3947 You can easily redirect the output of any query to an external file
3949 =item Data Input and Binding
3951 YASQL allows you to bind data in an external CSV file to any query, using
3952 standard DBI placeholders. This is the ultimate flexibility when inserting or
3953 updating data in the database.
3955 =item Command pipes
3957 You can easily pipe the output of any query to an external program.
3959 =item Tab completion
3961 All tables, columns, and other misc objects can be completed using tab, much
3962 like you can with bash.
3964 =item Easy top rownum listings
3966 You can easily put a number after a terminator, which will only output those
3967 number of lines. No more typing "where rownum < 10" after every query. Now
3968 you can type 'select * from table;10' instead.
3970 =item Enhanced Data Dictionary commands
3972 Special commands like 'show tables', 'desc <table>', 'show indexes on <table>',
3973 'desc <sequence>', and many many more so that you can easily see your schema.
3975 =item Query editing
3977 You can open and edit queries in your favorite text editor.
3979 =item Query chaining
3981 You can put an abitrary number of queries on the same line, and each will be
3982 executed in turn.
3984 =item Basic scripting
3986 You can put basic SQL queries in a script and execute them from YASQL.
3988 =item Config file
3990 You can create a config file of options so that you don't have to set them
3991 everytime you run it.
3993 =item Future extensibility
3995 We, the community, can modify and add to this whatever we want, we can't do that
3996 with SQL*Plus.
3998 =back
4000 =head1 REQUIREMENTS
4002 =over 4
4004 =item Perl 5
4006 This was developed with Perl 5.6, but is known to work on 5.005_03 and above.
4007 Any earlier version of Perl 5 may or may not work. Perl 4 will definately not
4008 work.
4010 =item Unix environment
4012 YASQL was developed under GNU/Linux, and aimed at as many Unix installations as
4013 possible. Known to be compatible with GNU/Linux, AIX and Sun Solaris.
4014 Please send me an email (qzy@users.sourceforge.net) if it works for other platforms.
4015 I'd be especially interested if it worked on Win32.
4017 =item Oracle Server
4019 It has been tested and developed for Oracle8 and Oracle8i. There is atleast
4020 one issue with Oracle7 that I know of (see ISSUES below) and I have not tested
4021 it with Oracle9i yet.
4023 =item Oracle client libraries
4025 The Oracle client libraries must be installed for DBD::Oracle. Of course you
4026 can't install DBD::Oracle without them...
4028 =item DBD::Oracle
4030 DBD::Oracle must be installed since this uses DBI for database connections.
4032 =item ORACLE_HOME
4034 The ORACLE_HOME environment variable must be set if you use a connection
4035 descriptor to connect so that YASQL can translate the descriptor into
4036 usefull connection information to make the actual connection.
4038 =item ORACLE_SID
4040 The ORACLE_SID environment variable must be set unless you specify one with the
4041 -s option (see options above).
4043 =item Term::Readline
4045 Term::Readline must be installed (it is with most Perl installations), but more
4046 importantly, installing Term::ReadLine::Gnu from CPAN will greatly enhance the
4047 usability.
4049 =item Time::HiRes
4051 This is used for high resolution benchmarking. It is optional.
4053 =item Text::CSV_XS
4055 This perl module is required if you want to output CSV or input from CSV files.
4056 If you don't plan on using this features, then you don't need to install this
4057 module.
4059 =item Term::ReadKey
4061 This module is used for better input and output control. Right now it isn't
4062 required, but some parts of YASQL will look and function better with this
4063 installed.
4065 =back
4067 =head1 CONFIG
4069 YASQL will look for a config file first in ~/.yasqlrc then
4070 /etc/yasql.conf. The following options are available:
4072 =over 4
4074 =item connection_timeout = <seconds>
4076 Timeout for connection attempts
4078 Default: 20
4080 =item max_connection_attempts = <num>
4082 The amount of times to attempt the connection if the username/password are wrong
4084 Default: 3
4086 =item history_file = <file>
4088 Where to save the history file. Shell metachars will be globbed (expanded)
4090 Default: ~/.yasql_history
4092 =item pager = <file>
4094 Your favorite pager for extended output. (right now only the help command)
4096 Default: /bin/more
4098 =item auto_commit = [0/1]
4100 Autocommit any updates/inserts etc
4102 Default: 0
4104 =item commit_on_exit = [0/1]
4106 Commit any pending transactions on exit. Errors or crashes will still cause
4107 the current transaction to rollback. But with this on a commit will occur
4108 when you explicitly exit.
4110 Default: 0
4112 =item long_trunc_ok = [0/1]
4114 Long truncation OK. If set to 1 then when a row contains a field that is
4115 set to a LONG time, such as BLOB, CLOB, etc will be truncated to long_read_len
4116 length. If 0, then the row will be skipped and not outputted.
4118 Default: 1
4120 =item long_read_len = <num_chars>
4122 Long Read Length. This is the length of characters to truncate to if
4123 long_trunc_ok is on
4125 Default: 80
4127 =item edit_history = [0/1]
4129 Whether or not to put the query edited from the 'edit' command into the
4130 command history.
4132 Default: 1
4134 =item auto_complete = [0/1]
4136 Whether or not to generate the autocompletion list on connection. If connecting
4137 to a large database (in number of tables/columns sense), the generation process
4138 could take a bit. For most databases it shouldn't take long at all though.
4140 Default: 1
4142 =item extended_complete_list = [0/1]
4144 extended complete list will cause the possible matches list to be filled by
4145 basicly any and all objects. With it off the tab list will be restricted to
4146 only tables, columns, and objects owned by the current user.
4148 Default: 0
4150 =item complete_tables = [0/1]
4152 This controls whether or not to add tables to the completion list. This does
4153 nothing if auto_complete is set to 0.
4155 Default: 1
4157 =item complete_columns = [0/1]
4159 This controls whether or not to add columns to the completion list. This does
4160 nothing if auto_complete is set to 0.
4162 Default: 1
4164 =item complete_objects = [0/1]
4166 This controls whether or not to add all other objects to the completion list.
4167 This does nothing if auto_complete is set to 0. (Hint... depending on your
4168 schema this will include tables and columns also, so you could turn the other
4169 two off)
4171 Default: 1
4173 =item extended_benchmarks = [0/1]
4175 Whether or not to include extended benchmarking info after queries. Will
4176 include both execution times and CPU loads for both the query and formatting
4177 parts of the process.
4179 Default: 0
4181 =item prompt
4183 A string to include in the prompt. The prompt will always be suffixed by a
4184 '>' string. Interpolated variables:
4185 %H = connected host. will be prefixed with a '@'
4186 %U = current user
4188 Default: %U%H
4190 =item column_wildcards = [0/1]
4192 Column wildcards is an extremely experimental feature that is still being
4193 hashed out due to the complex nature of it. This should affect only select
4194 statements and expands any wildcards (*) in the column list. such as
4195 'select col* from table;'.
4197 Default: 0
4199 =item sql_query_in_error = [0/1]
4201 This this on to output the query in the error message.
4203 Default: 0
4205 =item nls_date_format = <string>
4207 Set the preferred NLS_DATE_FORMAT. This effects both date input and output
4208 formats. The default is ISO standard (YYYY-MM-DD HH24:MI:SS', not oracle
4209 default (YYYY-MM-DD).
4211 Default: YYYY-MM-DD HH24:MI:SS
4213 =item fast_describe
4215 Turn on fast describes. These are much faster than the old style of desc
4216 <table>, however non-built in datatypes may not be returned properly. i.e. a
4217 FLOAT will be returned as a NUMBER type. Internally FLOATs really are just
4218 NUMBERs, but this might present problems for you. If so, set this to 0
4220 Default: 1
4222 =back
4224 =head1 ISSUES
4226 =over 4
4228 =item Oracle7
4230 DBD::Oracle for Oracle8 may have issues connecting to an Oracle7 database. The
4231 one problem I have seen is that the use of placeholders in a query will cause
4232 oracle to issue an error "ORA-01008: not all variables bound". This will affect
4233 all of the hard-coded queries that I use such as the ones for the 'desc' and
4234 'show' commands. The queries that you type in on the command line may still
4235 work. The DBD::Oracle README mentions the use of the '-8' option to the
4236 'perl Makefile.PL' command to use the older Oracle7 OCI. This has not been
4237 tested.
4239 =back
4241 =head1 AUTHOR
4243 Originaly written by Nathan Shafer (B<nshafer@ephibian.com>) with support from
4244 Ephibian, Inc. http://www.ephibian.com
4245 Now it is mostly developed and maintained by Balint Kozman
4246 (B<qzy@users.sourceforge.net>). http://www.imind.hu
4248 =head1 THANKS
4250 Thanks to everyone at Ephibian that helped with testing, and a special thanks
4251 to Tom Renfro at Ephibian who did a lot of testing and found quite a few
4252 doozies.
4253 Also a lot of thanks goes to the mates at iMind.dev who keep suffering from
4254 testing new features on them.
4256 The following people have also contributed to help make YASQL what it is:
4257 Allan Peda, Lance Klein, Scott Kister, Mark Dalphin, Matthew Walsh
4259 And always a big thanks to all those who report bugs and problems, especially
4260 on other platforms.
4262 =head1 COPYRIGHT
4264 Copyright (C) 2000-2002 Ephibian, Inc., 2005 iMind.dev.
4267 =head1 LICENSE
4269 This program is free software; you can redistribute it and/or
4270 modify it under the terms of the GNU General Public License
4271 as published by the Free Software Foundation; either version 2
4272 of the License, or (at your option) any later version.
4274 This program is distributed in the hope that it will be useful,
4275 but WITHOUT ANY WARRANTY; without even the implied warranty of
4276 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
4277 GNU General Public License for more details.
4279 You should have received a copy of the GNU General Public License
4280 along with this program; if not, write to the Free Software
4281 Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
4283 =head1 TODO
4285 =over 4
4287 =item desc a synomym doesn't keep the right schema... I think. Saw in desc parking.customer when logged in as cccrsmgr in 3c db
4289 =item allow history to be saved based on host (as an option)
4291 =item make stifle_history a configurable option
4293 =item a row is printed after "Attempting to cancel query"
4295 =item reading from a script will not change prompt properly (for a script with no terminator)
4297 =item NULL stops printing after table goes into overflow or something
4299 =item extra space in \G... maybe others
4301 =item bug: tag completion doesn't work with caps anymore
4303 =item Add support for /NOLOG
4305 =item allow dblinks in show blah on blah commands
4307 =item show query doesn't work with schemas and db links
4309 =item add save and get buffer commands
4311 =item add R[UN] command (/ equivilent)
4313 =item add support for just 'connect' and prompt for username and password
4315 =item add PASSW[ORD] command for changing password
4317 =item add -s[ilent] command line to suppress all startup output and command prompts
4319 =item add 'start' command for scripting
4321 =item add 'run' synonum for '/'
4323 =item add 'show parameters <filter>' support
4325 =item fix segfaults when cancelling large outputs
4327 =item Add a 'SPOOL' command
4329 =item fix 'set...' commands
4331 =item Add variable bindings, prompting, control structures, etc.
4333 =item be able to describe any kind of object
4335 =item Add 'startup queries' in config file or support glogin.sql and login.sql
4337 =item fix case sensitive object names
4339 =item make win32 compliant
4341 =item add better error messages when the user can't access a data dictionary
4342 table
4344 =item add better error output, with line/col numbers and maybe a pointer.
4346 =item add chained ops, exactly like bash
4348 =item add plugins and hooks for all aspects.
4350 =item Add smarter tables and wrapping in columns. Also add configurable max
4351 column widths and max table width.
4353 =item Add a curses interface option for easy viewing and scrolling, etc. This
4354 will require some research to determine if it's even worth it.
4356 =item Add HTML output option
4358 =back
4360 =head1 CHANGELOG
4362 $Log: yasql,v $
4363 Revision 1.83 2005/05/09 16:57:13 qzy
4364 Fixed the 'DECIMAL' problem with describe command.
4365 Added sql mode with \i (patch by Ed Avis).
4366 Added redirectors (>, >>, |) to describe.
4367 Added 'show user' command.
4368 Added 'show uid' command.
4369 Added new makefile targets: clean, check. (patch by Ed Avis)
4370 Added "and owner = ?" to some show targets (patch by anonymous).
4371 Added command_complete_list feature and config option.
4372 Added disconnect command
4373 Added command completion: select, update, insert, delete, execute, etc.
4374 Added table.column name completion.
4375 Added feature to run tty-less (patch by Michael Kroell).
4376 Added a workaround for SunOS's alarm() bug (patch by Ed Avis).
4377 Fixed some minor issues in parser code.
4379 Revision 1.82 2005/02/18 16:57:13 qzy
4380 Added batch mode (ewl patch).
4381 Allow connections AS SYSDBA, AS SYSOPER and internal (sysdba patch by Derek Whayman).
4382 Added server_output to config options.
4383 Changed script execution to only add script lines to the query buffer (and not to history).
4385 Revision 1.81 2002/03/06 21:55:13 nshafer
4386 Fixed bug with password prompt.
4387 Added 'show plan' for outputting last explain plan results.
4388 Added 'show query' for viewing queries for views and materialized views.
4389 Optimized describes to be as fast as describes in SQL*Plus.
4390 Added new option 'fast_describe' on by default for new describe method.
4391 Added single_output as a formatting option for internal use.
4392 Fixed problem with password, quit, exit, \q getting added to the history list.
4393 Changed history to not add duplicate entries right next to each other.
4394 Added support for basic (non-returning) PL/SQL commands.
4395 Added support for create function, package, package body, prodedure, trigger.
4396 Added 'show errors' command
4397 Added 'conn' shortcut for 'connection'.
4398 Added 'exec[ute]' command.
4399 Added 'set serverout[put] on|off' command to mimic SQL*Plus's.
4400 Added alarms to pings in cases where DB connection is dropped and ping hangs.
4401 Cleaned up error messages.
4402 Renamed config options AutoCommit, CommitOnExit, LongTruncOk, and LongReadLen toauto_commit, commit_on_exit, long_trunc_ok, and long_read_len. Old names are now deprecated.
4403 Changed quote escaping to be '' and "" instead of \' and \".
4404 Added full support for comments: rem[ark], --, and /* */.
4405 Right-justify works for the '8' datatype as well as '3' now.
4406 Re-worked debug output levels.
4407 Optimized query for completion lists a bit.
4408 Added completion-list limiting based on location in some DML statements (select, update, insert).
4409 Fixed up the display of '...' when generating tab completion list. Should work a lot better when hitting tab in the middle of the line.
4410 Added show views, objects, sequences, clusters, dimensions, functions, procedures, packages, indexes, indextypes, libraries, materialized views, snapshots, synonyms, triggers.
4411 Added show all <objects> command.
4412 Added type and owner columns to show commands.
4413 Fixed commit_on_exit logic.
4414 Added ability to use external authentication ('yasql /').
4415 The .sql extension for the scripting and editing commands are now optional.
4416 Fixed up editor execution to hopefully find the editor better.
4417 Added "Command" entry to "show processes".
4418 Added "show waits" and "show all waits" commands.
4419 Re-organized command line usage in anticipation for script parameters.
4420 Removed all uses of 'stty'.
4421 Added processing of STDIN, so redirects and pipes to YASQL work now.
4422 Changed benchmarking to include time for fetching... this should work better with Oracle 7.x, which doesn't seem to execute the query until you try fetching
4423 Updated documentation.
4424 Fixed up alarm() calls.
4425 Fixed setting of NLS_DATE_FORMAT to apply on reconnects.
4426 Broke commands into 2 sets... ones that exectute any time, and ones that execute only when nothing is in the buffer
4427 Fixed printing of text read in from an edit command. It now echoes all of it.
4428 Now ignoring most SET commands so we don't tack them onto queries
4429 Fixed permissions in tarball
4431 Revision 1.80 2001/08/01 18:06:27 nshafer
4432 Fixed bug with delayed $term initialization\e\b
4434 Revision 1.79 2001/08/01 17:52:35 nshafer
4435 Fixed compatibility issues with the data dictionary in Oracle 7. Fixed ordering
4436 of indexes for compound indexes. Fixed display of objects from other schemas
4437 in some data dictionary commands such as 'show indexes on table'. (Thanks Nix)
4438 Fixed matching of declare and end in query string. Will not only match if on
4439 blank line. Fixed matching of '/' terminator in middle of queries. Will now
4440 only match if at end of line (Thanks Wesley Hertlein). Temp file for editing
4441 now appends '.sql' to end of temp file so that editors, like vim, automatically
4442 turn on syntax highlighting. Added searching of environment variable SQLPATH
4443 when looking for scripts. Terminal setup is now after script parsing, so that
4444 it will work when run under cron (Thanks David Zverina).
4446 Revision 1.78 2001/07/05 13:52:56 nshafer
4447 Fixed bug where parens were matching improperly.
4449 Revision 1.77 2001/07/04 02:57:08 nshafer
4450 Fixed bug where terminators wouldn't match if they were the next character
4451 after a quote character.
4453 Revision 1.76 2001/06/28 04:17:53 nshafer
4454 Term::ReadLine::Perl now supported, for what little functionality it does
4455 provide. Fixed segfault when hitting up when history is empty. Fixed bug
4456 when providing script names on command line (Thanks to Dave Zverina.)
4457 Rewrote the query parser to fix a bug, caused by the multiple-queries-on-one-
4458 line feature, that causes terminators, such as ';' and '/' to match when in
4459 quotes. When hitting tab on a line starting with a '@' for scripts, tab will
4460 now complete filenames and not database objects. Fixed DB timeout when
4461 prompting for username and password. Added support for 'DECLARE' keyword,
4462 however this does not mean that variable binding in PL/SQL blocks works yet.
4463 Sped up startup time a bit more (hopefully).
4465 Revision 1.75 2001/06/19 16:02:16 nshafer
4466 Fixed typo in error message for Term::ReadLine::Gnu
4467 Fixed crash when tab hit at username or password prompt
4468 Added -- as a comment type and fixed case where comment in quotes would
4469 match. (Mark Dalphin)
4470 Fixed 'desc' to also describe partitioned tables (Erik)
4472 Revision 1.74 2001/06/18 21:07:55 nshafer
4473 Fixed bug where / would not rerun last query (thanks Scott Kister)
4475 Revision 1.73 2001/05/23 18:35:17 nshafer
4476 Got rid of "Prototype mismatch" errors. Fixed typo in extended benchmarks
4478 Revision 1.72 2001/05/22 16:06:36 nshafer
4479 Fixed bug with error messages not displaying first time, and fixed bug with
4480 tab completion output
4482 Revision 1.71 2001/05/17 21:28:40 nshafer
4483 New CSV output format. Added CSV file input on any query. Added ability to
4484 pipe query results to any program. Added ability for multiple queries on one
4485 line. Changed tab completion generator to run first time you hit tab instead
4486 of on startup, which speeds up database connection. Now using SelfLoader to
4487 speed up loading and minimize memory use. Added a 'show plan for ____' command
4488 for easy display of explain plan output. Query times are now more readable
4489 and will split into weeks, days, hours, minutes, and seconds. Hopefully fixed
4490 some problems with stty and Solaris 2.4. Added support for 'rem' comments in
4491 scripts. Redirection output files are now shell expanded.
4493 Revision 1.70 2001/05/08 17:49:51 nshafer
4494 Fixed all places where a non-alphanumeric object name would break or not
4495 match.
4496 Added code for autoconf style installs.
4498 Revision 1.69 2001/05/07 23:47:47 nshafer
4499 fixed type
4501 Revision 1.68 2001/05/07 22:26:20 nshafer
4502 Fixed tab completion problems when completing objects with a $ in their name.
4503 Added config options complete_tables, complete_columns, and complete_objects,
4504 Added redirection of query output to file. Hopefully sped up exiting.
4505 Updated documentation.
4507 Revision 1.67 2001/05/04 17:35:04 nshafer
4508 YASQL will now suspend properly back to the shell when SIGTSTP is sent, as in
4509 when you hit ctrl-z on most systems. Added NLS_DATE_FORMAT setting in config
4510 file to support alter date views. Defaults to ISO standard. YASQL will now
4511 attempt to change it's process name, such as when viewed in ps or top. This
4512 will not work on all systems, nor is it a complete bullet proof way to hide
4513 your password if you provide it on the command line. But it helps to not
4514 make it so obvious to regular users. Scripts entered on the command line are
4515 now checked to be readable before attempting connection. A failed 'connect
4516 command will no long alter the prompt. Added \p option for printing the
4517 current buffer, ala psql. Large query results (over 1000 rows) are now
4518 handled MUCH better. YASQL will no longer try to hold more than 1000 rows in
4519 memory, which keeps it from sucking memory, and also improves the speed.
4520 When a query does return more than 1000 rows in table mode, those first 1000
4521 will determine the column widths, and all rows after that will get truncated.
4522 AIX has been reported to run YASQL perfectly.
4524 Revision 1.66 2001/03/13 21:34:58 nshafer
4525 There are no longer any references to termcap, so yasql should now work on
4526 termcap-less systems such as Debian Linux and AIX
4528 Revision 1.65 2001/03/12 17:44:31 nshafer
4529 Restoring the terminal is hopefully more robust and better now. YASQL now
4530 tries to use the 'stty' program to dump the settings of the terminal on
4531 startup so that it can restore it back to those settings. It requires that
4532 stty is installed in the path, but that should be the case with most systems.
4533 Also made the output of the query in the error message an option that is off
4534 by default. I had never meant to include that in the final release, but kept
4535 on forgetting to take it out.
4537 Revision 1.64 2001/03/06 16:00:33 nshafer
4538 Fixed bug where desc would match anytime, even in middle of query, which is
4539 bad.
4541 Revision 1.63 2001/03/01 17:30:26 nshafer
4542 Refined the ctrl-c process for not-so-linuxy OS's, namely solaris. Now
4543 stripping out Dos carriage returns since SQL*Plus seems to.
4545 Revision 1.62 2001/02/26 22:39:12 nshafer
4546 Fixed bug where prompt would reset itself when a blank line was entered.
4547 Added script argument on command line (Lance Klein)
4548 Added support for any command line commands in the script (Lance Klein)
4549 The 'desc' and 'show' commands no longer require a terminator (like ;) as long as the whole statement is on one line (Lance Klein)
4550 Added option 'extended_tab_list' for a much bigger, more complete tab listing (Lance Klein)
4551 The edit command is no longer limited to 1 query at a time. You can now put any valid command or query, and as many of them as you want. The parsing rules for the edit command is exactly identical to the script parsing.
4552 cleaned up documentation a bit
4554 Revision 1.61 2001/01/31 19:56:22 nshafer
4555 changed CommitOnExit to be 1 by default, to emulate SQL*Plus behavior, and
4556 at popular request
4558 Revision 1.60 2001/01/29 16:38:17 nshafer
4559 got rid of (tm)
4561 Revision 1.59 2001/01/29 16:28:22 nshafer
4562 Modified docs a little with the new scope of open source now in the mix.
4564 Revision 1.58 2001/01/24 15:27:00 nshafer
4565 cleanup_after_signals is not in the Term::ReadLine::Stub, so it would
4566 output error messages on systems without Term::ReadLine::Gnu. Fixed
4568 Revision 1.57 2001/01/17 23:26:53 nshafer
4569 Added Tom Renfro's column_wildcard expansion code. New conf variable:
4570 column_wildcards. 0 by default until this code is expanded on a bit more.
4572 Revision 1.56 2001/01/17 23:00:25 nshafer
4573 Added CommitOnExit config, 0 by default. Added info output at startup and
4574 when a new connection is initiated about the state of AutoCommit and
4575 CommitOnExit. Also added statement about explicit rollback or commit when
4576 disconnecting. Added warning message to commit_cmd and rollback_cmd if
4577 AutoCommit is on. Now explicitly committing or rolling back on disconnect,
4578 it is no longer left up to the DBI's discretion... except in abnormal
4579 termination.
4581 Revision 1.55 2001/01/11 18:05:12 nshafer
4582 Added trap for regex errors in tab completion (like if you put 'blah[' then
4583 hit tab)
4585 Revision 1.54 2001/01/10 17:07:22 nshafer
4586 added output to those last 2 commands
4588 Revision 1.53 2001/01/10 17:03:58 nshafer
4589 added commit and rollback commands so that you don't have to send them to the
4590 backend
4592 Revision 1.52 2001/01/10 16:00:08 nshafer
4593 fixed bug with prompt where on each call get_prompt would add another '@'.
4594 Thanks Tom
4596 Revision 1.51 2001/01/09 21:16:12 nshafer
4597 dar... fixed another bug where the %H would stay if there was no prompt_host
4599 Revision 1.50 2001/01/09 21:12:13 nshafer
4600 fixed bug with that last update. Now it only interpolates the %H variable
4601 if there is something to interpolate it with
4603 Revision 1.49 2001/01/09 21:09:56 nshafer
4604 changed the %H variable to be prefixed with a @
4606 Revision 1.48 2001/01/09 21:04:36 nshafer
4607 changed 'default' to '' for the prompt's hostname when no connect_string is
4608 used
4610 Revision 1.47 2001/01/09 20:55:11 nshafer
4611 added configurable prompt and changed the default prompt
4613 Revision 1.46 2001/01/09 18:50:50 nshafer
4614 updated todo list
4616 Revision 1.45 2001/01/09 18:32:35 nshafer
4617 Added 'connect <connect_string>' command. I may add the ability to specify
4618 options like on the command line (like '-H blah.com')
4620 Revision 1.44 2001/01/08 22:08:49 nshafer
4621 more documentation changes
4623 Revision 1.43 2001/01/08 20:51:31 nshafer
4624 added some documentation
4626 Revision 1.42 2001/01/08 20:09:35 nshafer
4627 Added debug and autocommit commands
4629 Revision 1.41 2001/01/08 18:12:43 nshafer
4630 added END handler to hopefully clean up the terminal better
4632 Revision 1.40 2001/01/05 23:29:38 nshafer
4633 new name!
4635 Revision 1.39 2001/01/05 18:00:16 nshafer
4636 Added config file options for auto completion generation and extended
4637 benchmark info
4639 Revision 1.38 2001/01/05 16:39:47 nshafer
4640 Fixed error where calling edit a second time would not open the file properly
4641 because of the way glob() works.
4643 Revision 1.37 2001/01/04 23:52:30 nshafer
4644 changed the version string to parse it out of the revision string (duh...)
4645 moved the prompting of username and password so that the check for the
4646 oracle_home variable happens before. Before if you didn't have the environment
4647 variable set then it will prompt you for username and password, then die
4648 with the error, which is annoying
4649 fixed the quit calls so taht they properly erase the quit line from the
4650 history. I had broken this a long time ago when I added the exit status
4651 param to the quit function
4652 Outputting in full table format (';' terminator) with a num_rows number
4653 (like ';100') would still cause the entire result set to be pulled into
4654 memory, which was really slow and could take a lot of memory if the table
4655 was large. Fixed it so that it only pulls in num_rows number of rows when
4656 using the digit option
4658 Revision 1.36 2000/12/22 22:12:18 nshafer
4659 fixed a wrong-quote-type in the debug messages
4661 Revision 1.35 2000/12/22 22:07:06 nshafer
4662 forgot version... you know the drill...
4664 Revision 1.34 2000/12/22 21:57:01 nshafer
4665 Added config file support, queries from the 'edit' command are now entered
4666 into the command history (configurable), cleaned up the SIGINT actions quite
4667 a bit so they should work better now, added LongReadLen and LongTruncOk
4668 options so that LONG columns types won't mess up, added the number after terminator
4669 feature to limit how many rows are returned.
4671 Revision 1.33 2000/12/20 22:56:03 nshafer
4672 version number.... again.... sigh
4674 Revision 1.32 2000/12/20 22:55:32 nshafer
4675 added todo item, now in rpms
4677 Revision 1.31 2000/12/20 17:07:52 nshafer
4678 added the reprompt for username/password on error 1005 null password given
4680 Revision 1.30 2000/12/20 17:04:18 nshafer
4681 Refined the shadow_redisplay stuff. Now I will only use my builtin function
4682 if the terminal type is set to "xterm" because that terminal type has a
4683 broken termcap entry. Also set it to not echo when entering password if
4684 Term::ReadLine::Gnu is not installed
4686 Revision 1.29 2000/12/20 15:47:56 nshafer
4687 trying a new scheme for the shadow_redisplay. Clear to EOL wasn't working
4688 Also fixed a few problems in the documentation
4691 Revision 1.28 2000/12/19 23:55:03 nshafer
4692 I need to stop forgetting the revision number...
4694 Revision 1.27 2000/12/19 23:48:49 nshafer
4695 cleaned up debugging
4697 Revision 1.26 2000/12/19 23:10:18 nshafer
4698 Lotsa new stuff... tab completion of table, column, and object names,
4699 improved signal handling, the edit command now accepts a filename parameter,
4700 new command 'show processes' which shows you info on who's connected,
4701 improved benchmark info, and a lot of other cleanup/tweaks
4703 Revision 1.25 2000/12/13 16:58:26 nshafer
4704 oops forgot documentation again
4706 Revision 1.24 2000/12/13 16:54:42 nshafer
4707 added desc <trigger>
4709 Revision 1.23 2000/12/12 17:52:15 nshafer
4710 updated todo list (oops, forgot)
4712 Revision 1.22 2000/12/12 17:51:39 nshafer
4713 added desc <index>
4715 Revision 1.21 2000/12/12 17:15:28 nshafer
4716 fixed bug when connecting using a host string (-H option)
4717 added a few more types to the 'show' and 'desc' commands
4719 Revision 1.20 2000/12/08 22:13:43 nshafer
4720 many little fixes and tweaks here and there
4722 Revision 1.19 2000/12/06 20:50:03 nshafer
4723 added scripting ability with "@<filename>" command
4724 changed all tabs to spaces!
4726 Revision 1.18 2000/12/06 19:30:38 nshafer
4727 added clear command
4728 refined connection process. if invalid username/password entered then prompt again
4730 Revision 1.17 2000/12/05 22:20:58 nshafer
4731 Tightened up outputs. Doesn't show column names if no rows selected, if
4732 it's not a select, then show number of rows affected
4734 Revision 1.16 2000/12/04 18:04:53 nshafer
4735 *** empty log message ***
4737 Revision 1.15 2000/12/04 18:03:14 nshafer
4738 fixed bug where the -H option was interpreted as -h or help. All command
4739 line options are now case sensitive
4741 Revision 1.14 2000/12/04 17:54:38 nshafer
4742 Added list command (and \l and l)
4744 Revision 1.13 2000/12/04 17:34:18 nshafer
4745 fixed a formatting issue if Time::HiRes isn't installed
4747 Revision 1.12 2000/12/04 17:29:41 nshafer
4748 Added benchmark options to view the extended benchmark info. Now it displays
4749 just the time in a more friendly format. The old style is only active if the
4750 benchmark option is specified.
4751 Cleaned up some formatting issues
4752 Brought the usage and POD documentation up to date
4753 Added some items to the TODO
4755 Revision 1.11 2000/11/30 22:54:38 nshafer
4756 Fixed bug with the edit command where if you were 'inquotes' then you would
4757 stay in quotes even after editing the file
4759 Revision 1.10 2000/11/30 22:01:38 nshafer
4760 Fixed bug where username and password were added to the command history.
4761 Set it so that the quit commands are not added to the command history either.
4762 Added the 'edit' command and modified it's todo list item, as well as added
4763 it to the 'help' command
4765 Revision 1.9 2000/11/29 17:55:35 nshafer
4766 changed version from .21 to 1.0 beta 9. I'll follow the revision numbers now
4768 Revision 1.8 2000/11/29 17:46:31 nshafer
4769 added a few items to the todo list
4771 Revision 1.7 2000/11/29 15:50:56 nshafer
4772 got rid of SID output at startup
4774 Revision 1.6 2000/11/29 15:49:51 nshafer
4775 moved revision info to $revision and added Id output
4777 Revision 1.5 2000/11/29 15:46:41 nshafer
4778 fixed revision number
4780 Revision 1.4 2000/11/29 15:44:23 nshafer
4781 fixed issue where environment variable ORACLE_SID overwrote explicit set
4782 on the command line. now whatever you put on the command line will overwrite
4783 the environment variable
4785 =cut