Added command completion targets to 'show' command.
[yasql.git] / yasql.in
blob237dff15397eb5075f8f4c68ed39e49e868a6ffc
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, PrintError => 0, AutoCommit => $conf{auto_commit},
788 LongReadLen => $conf{long_read_len}, LongTruncOk => $conf{long_trunc_ok},
789 ora_session_mode => $ora_session_mode
792 if($connect_string eq 'external') {
793 # the user wants to connect with external authentication
795 check_oracle_home();
797 # install alarm signal handle
798 $SIG{ALRM} = \&sighandle;
799 alarm($conf{connection_timeout});
801 if(!$opt_batch) {
802 print "Attempting connection to local database\n";
804 $dbhandle = DBI->connect('dbi:Oracle:',undef,undef,$attributes)
805 or do {
806 $dberr = $DBI::err;
807 $dberrstr = $DBI::errstr;
810 $this_prompt_host = $ENV{ORACLE_SID};
811 $this_prompt_user = $ENV{LOGNAME};
812 alarm(0); # cancel alarm
813 } elsif($connect_string) {
814 # We were provided with a connect string, so we can use the TNS method
816 check_oracle_home();
817 ($ora_session_mode, $username, $password) = get_up($ora_session_mode, $username, $password);
818 $attributes->{ora_session_mode} = $ora_session_mode if $ora_session_mode;
820 my $userstring;
821 if($username) {
822 $userstring = $username . '@' . $connect_string;
823 } else {
824 $userstring = $connect_string;
827 # install alarm signal handle
828 $SIG{ALRM} = \&sighandle;
829 alarm($conf{connection_timeout});
831 if(!$opt_batch) {
832 print "Attempting connection to $userstring\n";
834 $dbhandle = DBI->connect('dbi:Oracle:',$userstring,$password,$attributes)
835 or do {
836 $dberr = $DBI::err;
837 $dberrstr = $DBI::errstr;
840 $this_prompt_host = $connect_string;
841 $this_prompt_user = $username;
842 alarm(0); # cancel alarm
843 } elsif($opt_host) {
844 # attempt a connection to $opt_host
845 my $dsn;
846 $dsn = "host=$opt_host";
847 $dsn .= ";sid=$opt_sid" if $opt_sid;
848 $dsn .= ";port=$opt_port" if $opt_port;
850 ($ora_session_mode, $username, $password) = get_up($ora_session_mode, $username, $password);
851 $attributes->{ora_session_mode} = $ora_session_mode if $ora_session_mode;
853 # install alarm signal handle
854 $SIG{ALRM} = \&sighandle;
855 alarm($conf{connection_timeout});
857 print "Attempting connection to $opt_host\n";
858 debugmsg(1,"dsn: [$dsn]");
859 $dbhandle = DBI->connect("dbi:Oracle:$dsn",$username,$password,
860 $attributes)
861 or do {
862 $dberr = $DBI::err;
863 $dberrstr = $DBI::errstr;
866 $this_prompt_host = $opt_host;
867 $this_prompt_host = "$opt_sid!" . $this_prompt_host if $opt_sid;
868 $this_prompt_user = $username;
869 alarm(0); # cancel alarm
870 } else {
871 # attempt a connection without specifying a hostname or anything
873 check_oracle_home();
874 ($ora_session_mode, $username, $password) = get_up($ora_session_mode, $username, $password);
875 $attributes->{ora_session_mode} = $ora_session_mode if $ora_session_mode;
877 # install alarm signal handle
878 $SIG{ALRM} = \&sighandle;
879 alarm($conf{connection_timeout});
881 print "Attempting connection to local database\n";
882 $dbhandle = DBI->connect('dbi:Oracle:',$username,$password,$attributes)
883 or do {
884 $dberr = $DBI::err;
885 $dberrstr = $DBI::errstr;
888 $this_prompt_host = $ENV{ORACLE_SID};
889 $this_prompt_user = $username;
890 alarm(0); # cancel alarm
893 if($dbhandle) {
894 # Save the parameters for reconnecting
895 @dbparams = ($ora_session_mode, $username, $password, $connect_string);
897 # set the $dbuser global for use elsewhere
898 $dbuser = $username;
899 $num_connects = 0;
900 $prompt{host} = $this_prompt_host;
901 $prompt{user} = $this_prompt_user;
903 # Get the version banner
904 debugmsg(2,"Fetching version banner");
905 my $banner = $dbhandle->selectrow_array(
906 "select banner from v\$version where banner like 'Oracle%'");
907 if(!$opt_batch) {
908 if($banner) {
909 print "Connected to: $banner\n\n";
910 } else {
911 print "Connection successful!\n";
915 if($banner =~ / (\d+)\.(\d+)\.([\d\.]+)/) {
916 my ($major, $minor, $other) = ($1, $2, $3);
917 $dbversion = $major || 8;
920 # Issue a warning about autocommit. It's nice to know...
921 print STDERR "auto_commit is " . ($conf{auto_commit} ? "ON" : "OFF")
922 . ", commit_on_exit is " . ($conf{commit_on_exit} ? "ON" : "OFF")
923 . "\n" unless $opt_batch;
924 } elsif( ($dberr eq '1017' || $dberr eq '1005')
925 && ++$num_connects < $conf{max_connection_attempts}) {
926 $dberrstr =~ s/ \(DBD ERROR: OCISessionBegin\).*//;
927 print "Error: $dberrstr\n\n";
928 #@dbparams = (0,undef,undef,$connect_string);
929 $connect_string = '' if $connect_string eq 'external';
930 $dbhandle = db_connect($die_on_error,$ora_session_mode,undef,undef,$connect_string);
931 } elsif($die_on_error) {
932 lerr("Could not connect to database: $dberrstr [$dberr]");
933 } else {
934 wrn("Could not connect to database: $dberrstr [$dberr]");
935 return(0);
938 # set the NLS_DATE_FORMAT
939 if($conf{nls_date_format}) {
940 debugmsg(2, "setting NLS_DATE_FORMAT to $conf{nls_date_format}");
941 my $sqlstr = "alter session set nls_date_format = '"
942 . $conf{nls_date_format} . "'";
943 $dbhandle->do($sqlstr) or query_err('do', $DBI::errstr, $sqlstr);
946 $connected = 1;
947 return($dbhandle);
950 sub get_prompt {
951 my($prompt_string) = @_;
952 debugmsg(3, "get_prompt called", @_);
953 # This returns a prompt. It can be passed a string which will
954 # be manually put into the prompt. It will be padded on the left with
955 # white space
957 $prompt_length ||= 5; #just in case normal prompt hasn't been outputted
958 debugmsg(2, "prompt_length: [$prompt_length]");
960 if($prompt_string) {
961 my $temp_prompt = sprintf('%' . $prompt_length . 's', $prompt_string . '> ');
962 return($temp_prompt);
963 } else {
964 my $temp_prompt = $conf{prompt} . '> ';
965 my $temp_prompt_host = '@' . $prompt{host} if $prompt{host};
966 $temp_prompt =~ s/\%H/$temp_prompt_host/g;
967 $temp_prompt =~ s/\%U/$prompt{user}/g;
969 $prompt_length = length($temp_prompt);
970 return($temp_prompt);
974 sub get_up {
975 my($ora_session_mode, $username, $password) = @_;
976 debugmsg(3, "get_up called", @_);
978 if(!$opt_batch) {
980 setup_term() unless $term;
982 # Get username/password
983 unless($username) {
984 # prompt for the username
985 $username = $term->readline('Username: ');
986 if($username =~ /^(.*)\s+as\s+sys(\w+)\s*$/i) {
987 $ora_session_mode = 2 if lc($2) eq 'dba';
988 $ora_session_mode = 4 if lc($2) eq 'oper';
989 $username = $1;
992 # Take that entry off of the history list
993 if ($term_type eq 'gnu') {
994 $term->remove_history($term->where_history());
998 unless($password) {
999 # prompt for the password, and disable echo
1000 my $orig_redisplay = $attribs->{redisplay_function};
1001 $attribs->{redisplay_function} = \&shadow_redisplay;
1003 $password = $term->readline('Password: ');
1005 $attribs->{redisplay_function} = $orig_redisplay;
1007 # Take that entry off of the history list
1008 if ($term->ReadLine eq "Term::ReadLine::Gnu") {
1009 $term->remove_history($term->where_history());
1014 return($ora_session_mode, $username, $password);
1018 sub check_oracle_home {
1019 # This checks for the ORACLE_HOME environment variable and dies if it's
1020 # not set
1021 lerr("Please set your ORACLE_HOME environment variable!")
1022 unless $ENV{ORACLE_HOME};
1023 return(1);
1026 sub shadow_redisplay {
1027 # The one provided in Term::ReadLine::Gnu was broken
1028 # debugmsg(2, "shadow_redisplay called", @_);
1029 my $OUT = $attribs->{outstream};
1030 my $oldfh = select($OUT); $| = 1; select($oldfh);
1031 print $OUT ("\r", $attribs->{prompt});
1032 $oldfh = select($OUT); $| = 0; select($oldfh);
1035 sub print_non_print {
1036 my($string) = @_;
1038 my @string = unpack("C*", $string);
1039 my $ret_string;
1040 foreach(@string) {
1041 if($_ >= 40 && $_ <= 176) {
1042 $ret_string .= chr($_);
1043 } else {
1044 $ret_string .= "<$_>";
1047 return($ret_string);
1050 sub interface {
1051 debugmsg(3, "interface called", @_);
1052 # this is the main program loop that handles all the user input.
1053 my $input;
1054 my $prompt = get_prompt();
1056 setup_sigs();
1058 # Check if we were interactively called, or do we need to process STDIN
1059 if(-t STDIN) {
1060 while(defined($input = $term->readline($prompt))) {
1061 $sigintcaught = 0;
1062 $prompt = process_input($input, $prompt) || get_prompt();
1063 setup_sigs();
1065 } else {
1066 debugmsg(3, "non-interactive", @_);
1067 debugmsg(3, "\$opt_batch=$opt_batch", @_);
1068 debugmsg(3, "\$opt_batch=$opt_batch", @_);
1069 # Send STDIN to process_input();
1070 while(<STDIN>) {
1071 process_input($_);
1075 quit(0, undef, "\n");
1078 sub process_input {
1079 my($input, $prompt, $add_to_history) = @_;
1080 if (!(defined($add_to_history))) {
1081 $add_to_history = 1;
1083 debugmsg(3, "process_input called", @_);
1085 my $nprompt;
1086 SWITCH: {
1087 if(!$qbuffer) {
1088 # Commands that are only allowed if there is no current buffer
1089 $input =~ /^\s*(?:!|host)\s*(.*)\s*$/i and system($1), last SWITCH;
1090 $input =~ /^\s*\\a\s*$/i and populate_completion_list(), last SWITCH;
1091 $input =~ /^\s*\\\?\s*$/i and help(), last SWITCH;
1092 $input =~ /^\s*help\s*$/i and help(), last SWITCH;
1093 $input =~ /^\s*reconnect\s*$/i and db_reconnect(), last SWITCH;
1094 $input =~ /^\s*\\r\s*$/i and db_reconnect(), last SWITCH;
1095 $input =~ /^\s*conn(?:ect)?\s+(.*)$/i and connect_cmd($1), last SWITCH;
1096 $input =~ /^\s*disc(?:onnect)\s*$/i and disconnect_cmd($1), last SWITCH;
1097 $input =~ /^\s*\@\S+\s*$/i and $nprompt = run_script($input), last SWITCH;
1098 $input =~ /^\s*debug\s*(.*)$/i and debug_toggle($1), last SWITCH;
1099 $input =~ /^\s*autocommit\s*(.*)$/i and autocommit_toggle(), last SWITCH;
1100 $input =~ /^\s*commit/i and commit_cmd(), last SWITCH;
1101 $input =~ /^\s*rollback/i and rollback_cmd(), last SWITCH;
1102 $input =~ /^\s*(show\s*[^;\/\\]+)\s*$/i and show($1, 'table'),last SWITCH;
1103 $input =~ /^\s*(desc\s*[^;\/\\]+)\s*$/i and describe($1, 'table'),
1104 last SWITCH;
1105 $input =~ /^\s*(set\s*[^;\/\\]+)\s*$/i and set_cmd($1), last SWITCH;
1106 $input =~ /^\s*exec(?:ute)?\s*(.*)\s*$/i and exec_cmd($1), last SWITCH;
1107 $input =~ /^\s*\\d\s*$/ and show('show objects', 'table'), last SWITCH;
1108 $input =~ /^\s*\\dt\s*$/ and show('show tables', 'table'), last SWITCH;
1109 $input =~ /^\s*\\di\s*$/ and show('show indexes', 'table'), last SWITCH;
1110 $input =~ /^\s*\\ds\s*$/ and show('show sequences', 'table'), last SWITCH;
1111 $input =~ /^\s*\\dv\s*$/ and show('show views', 'table'), last SWITCH;
1112 $input =~ /^\s*\\df\s*$/ and show('show functions', 'table'), last SWITCH;
1114 # Global commands allowed any time (even in the middle of queries)
1115 $input =~ /^\s*quit\s*$/i and quit(0), last SWITCH;
1116 $input =~ /^\s*exit\s*$/i and quit(0), last SWITCH;
1117 $input =~ /^\s*\\q\s*$/i and quit(0), last SWITCH;
1118 $input =~ /^\s*\\l\s*$/i and show_qbuffer(), last SWITCH;
1119 $input =~ /^\s*\\p\s*$/i and show_qbuffer(), last SWITCH;
1120 $input =~ /^\s*l\s*$/i and show_qbuffer(), last SWITCH;
1121 $input =~ /^\s*list\s*$/i and show_qbuffer(), last SWITCH;
1122 $input =~ /^\s*\\c\s*$/i and $nprompt = clear_qbuffer(), last SWITCH;
1123 $input =~ /^\s*clear\s*$/i and $nprompt = clear_qbuffer(), last SWITCH;
1124 $input =~ /^\s*clear buffer\s*$/i and $nprompt=clear_qbuffer(), last SWITCH;
1125 $input =~ /^\s*\\e\s*(.*)$/i and $nprompt = edit($1), last SWITCH;
1126 $input =~ /^\s*edit\s*(.*)$/i and $nprompt = edit($1), last SWITCH;
1127 $input =~ /^\s*rem(?:ark)?/i and $input = '', last SWITCH;
1128 $input =~ /[^\s]/ and $nprompt = parse_input($input) || last, last SWITCH;
1130 # default
1131 $nprompt = $prompt if ($nprompt eq ''); # use last prompt if nothing caught (blank line)
1133 if(!$opt_batch && $term->ReadLine eq "Term::ReadLine::Gnu" && $input =~ /[^\s]/ &&
1134 $input ne $last_history) {
1135 if (!$opt_batch && $add_to_history) {
1136 $term->AddHistory($input);
1139 $last_history = $input;
1140 return($nprompt);
1143 sub parse_input {
1144 my($input) = @_;
1145 debugmsg(3, "parse_input called", @_);
1146 # this takes input and parses it. It looks for single quotes (') and double
1147 # quotes (") and presents prompts accordingly. It also looks for query
1148 # terminators, such as semicolon (;), forward-slash (/) and back-slash-g (\g).
1149 # If it finds a query terminator, then it pushes any text onto the query
1150 # buffer ($qbuffer) and then passes the entire query buffer, as well as the
1151 # format type, determined by the terminator type, to the query() function. It
1152 # also wipes out the qbuffer at this time.
1154 # It returns a prompt (like 'SQL> ' or ' -> ') if successfull, 0 otherwise
1156 # now we need to check for a terminator, if we're not inquotes
1157 while( $input =~ m/
1159 ['"] # match quotes
1160 | # or
1161 ; # the ';' terminator
1162 | # or
1163 ^\s*\/\s*$ # the slash terminator at end of string
1164 | # or
1165 \\[GgsSi] # one of the complex terminators
1166 | # or
1167 (?:^|\s+)create\s+ # create
1168 | # or
1169 (?:^|\s+)function\s+ # function
1170 | # or
1171 (?:^|\s+)package\s+ # package
1172 | # or
1173 (?:^|\s+)package\s+body\s+ # package body
1174 | # or
1175 (?:^|\s+)procedure\s+ # procedure
1176 | # or
1177 (?:^|\s+)trigger\s+ # trigger
1178 | # or
1179 (?:^|\s+)declare\s+ # declare
1180 | # or
1181 (?:^|\s+)begin\s+ # begin
1182 | # or
1183 \/\* # start of multiline comment
1184 | # or
1185 \*\/ # end of multiline comment
1186 )/gix )
1189 my($pre, $match, $post) = ($`, $1, $');
1190 # PREMATCH, MATCH, POSTMATCH
1191 debugmsg(1, "parse: [$pre] [$match] [$post]");
1193 if( ($match eq '\'' || $match eq '"')) {
1194 if(!$quote || $quote eq $match) {
1195 $inquotes = ($inquotes ? 0 : 1);
1196 if($inquotes) {
1197 $quote = $match;
1198 } else {
1199 undef($quote);
1202 } elsif($match =~ /create/ix) {
1203 $increate = 1;
1204 } elsif(!$increate &&
1205 $match =~ /function|package|package\s+body|procedure|trigger/ix)
1207 # do nothing if we're not in a create statement
1208 } elsif(($match =~ /declare|begin/ix) ||
1209 ($increate && $match =~ /function|package|package\s+body|procedure|trigger/ix))
1211 $inplsqlblock = 1;
1212 } elsif($match =~ /^\/\*/) {
1213 $incomment = 1;
1214 } elsif($match =~ /^\*\//) {
1215 $incomment = 0;
1216 } elsif(!$inquotes && !$incomment && $match !~ /^--/ &&
1217 ($match =~ /^\s*\/\s*$/ || !$inplsqlblock))
1219 $qbuffer .= $pre;
1220 debugmsg(4,"qbuffer IN: [$qbuffer]");
1221 my $terminator = $match;
1222 $post =~ / (\d*) # Match num_rows right after terminitor
1223 \s* # Optional whitespace
1224 (?: #
1225 ( >{1,2}|<|\| ) # Match redirection operators
1226 \s* # Optional whitespace
1227 ( .* ) # The redirector (include rest of line)
1228 )? # Match 0 or 1
1229 \s* # Optional whitespace
1230 (.*) # Catch everything else
1231 $ # End-Of-Line
1233 debugmsg(3,"1: [$1] 2: [$2] 3: [$3] 4: [$4]");
1235 my($num_rows,$op,$op_text,$extra) = ($1,$2,$3,$4);
1237 if($extra =~ /--.*$/) {
1238 undef $extra;
1241 # check that Text::CSV_XS is installed if a < redirection was given
1242 if($op eq '<' && $notextcsv) {
1243 soft_err("You must install Text::CSV_XS from CPAN to use this feature");
1244 return(0);
1247 # deduce the format from the terminator type
1248 my $format;
1250 $fbuffer = $terminator;
1252 if($terminator eq ';' || $terminator =~ /^\/\s*$/) {
1253 $format = 'table';
1254 } elsif($terminator eq '\g') {
1255 $format = 'list';
1256 } elsif($terminator eq '\G') {
1257 $format = 'list_aligned';
1258 } elsif($terminator eq '\s') {
1259 $format = 'csv';
1260 } elsif($terminator eq '\S') {
1261 $format = 'csv_no_header';
1262 } elsif($terminator eq '\i') {
1263 $format = 'sql';
1265 $num_rows ||= 0;
1267 debugmsg(4,"fbuffer: [$fbuffer]\n");
1269 # if there is nothing in the buffer, then we assume that the user just
1270 # wants to reexecute the last query, which we have saved in $last_qbuffer
1271 my($use_buffer, $copy_buffer);
1272 if($qbuffer) {
1273 $use_buffer = $qbuffer;
1274 $copy_buffer = 1;
1275 } elsif($last_qbuffer) {
1276 $use_buffer = $last_qbuffer;
1277 $copy_buffer = 0;
1278 } else {
1279 $use_buffer = undef;
1280 $copy_buffer = 0;
1283 if($use_buffer) {
1284 if($op eq '<') {
1285 my $count = 0;
1286 my($max_lines, @params, $max_lines_save, @querybench,
1287 $rows_affected, $success_code);
1288 my $result_output = 1;
1289 push(@querybench, get_bench());
1290 print STDERR "\n";
1291 while(($max_lines, @params) = get_csv_file($op, $op_text)) {
1292 $max_lines_save = $max_lines;
1293 print statusline($count, $max_lines);
1295 my @res = query( $use_buffer, $format,
1296 {num_rows => $num_rows, op => $op, op_text => $op_text,
1297 result_output => 0}, @params);
1299 debugmsg(3, "res: [@res]");
1301 unless(@res) {
1302 print "Error in line " . ($count + 1) . " of file '$op_text'\n";
1303 $result_output = 0;
1304 close_csv();
1305 last;
1308 $rows_affected += $res[0];
1309 $success_code = $res[1];
1310 $count++;
1312 push(@querybench, get_bench());
1314 if($result_output) {
1315 print "\r\e[K";
1317 if(!$opt_batch) {
1318 print STDERR format_affected($rows_affected, $success_code);
1319 if($opt_bench || $conf{extended_benchmarks}) {
1320 print STDERR "\n\n";
1321 print STDERR ('-' x 80);
1322 print STDERR "\n";
1323 output_benchmark("Query: ", @querybench, "\n");
1324 } else {
1325 output_benchmark(" (", @querybench, ")");
1326 print STDERR "\n";
1328 print STDERR "\n";
1331 } else {
1332 query($use_buffer, $format, {num_rows => $num_rows, op => $op,
1333 op_text => $op_text});
1336 if($copy_buffer) {
1337 # copy the current qbuffer to old_qbuffer
1338 $last_qbuffer = $qbuffer;
1339 $last_fbuffer = $fbuffer;
1341 } else {
1342 query_err('Query', 'No current query in buffer');
1345 undef($qbuffer);
1346 undef($fbuffer);
1347 $inplsqlblock = 0;
1348 $increate = 0;
1350 if($extra) {
1351 return(parse_input($extra));
1352 } else {
1353 # return a 'new' prompt
1354 return(get_prompt());
1359 $qbuffer .= $input . "\n";
1361 debugmsg(4,"qbuffer: [$qbuffer], input: [$input]");
1363 if($inquotes) {
1364 return(get_prompt($quote));
1365 } elsif($incomment) {
1366 return(get_prompt('DOC'));
1367 } else {
1368 return(get_prompt('-'));
1372 sub get_csv_file {
1373 my($op, $op_text) = @_;
1374 debugmsg(3, "get_csv_file called", @_);
1376 my @ret = ();
1378 unless($csv_max_lines) {
1379 ($op_text) = glob($op_text);
1380 debugmsg(3, "Opening file '$op_text' for line counting");
1381 open(CSV, $op_text) || do{
1382 query_err('redirect',"Cannot open file '$op_text' for reading: $!");
1383 return();
1385 while(<CSV>) {
1386 $csv_max_lines++;
1388 close(CSV);
1391 unless($csv_filehandle_open) {
1392 ($op_text) = glob($op_text);
1393 debugmsg(3, "Opening file '$op_text' for input");
1394 open(CSV, $op_text) || do{
1395 query_err('redirect',"Cannot open file '$op_text' for reading: $!");
1396 return();
1398 $csv_filehandle_open = 1;
1401 my $line = <CSV>;
1402 while(defined($line) && $line =~ /^\s*$/) {
1403 $line = <CSV>;
1406 unless($line) {
1407 close_csv();
1408 return();
1411 debugmsg(3, "read in CSV line", $line);
1413 my @fields;
1414 if($csv->parse($line)) {
1415 @fields = $csv->fields();
1416 debugmsg(3, "got CVS fields", @fields);
1417 } else {
1418 wrn("Parse of CSV file failed on argument, skipping to next: "
1419 . $csv->error_input());
1420 return(get_csv_file($op, $op_text));
1423 return($csv_max_lines, @fields);
1426 sub close_csv {
1427 close(CSV) || lerr("Could not close CSV filehandle: $!");
1428 $csv_filehandle_open = 0;
1429 $csv_max_lines = 0;
1432 sub connect_cmd {
1433 my($arg) = @_;
1434 debugmsg(3, "connect_cmd called", @_);
1436 unless($arg) {
1437 wrn("Invalid connect syntax. See help");
1438 return(0);
1441 my($ora_session_mode, $username, $password, $connect_string) = parse_logon_string($arg);
1443 my $new_dbh = db_connect(0, $ora_session_mode, $username, $password, $connect_string);
1444 if (not $new_dbh) {
1445 warn "failed to make new connection as $username to $connect_string: $DBI::errstr\n";
1446 warn "keeping old connection\n";
1447 return;
1450 if (defined $dbh) {
1451 commit_on_exit();
1452 $dbh->disconnect()
1453 or warn "failed to disconnect old connection - switching anyway\n";
1456 $dbh = $new_dbh;
1457 $connected = 1;
1460 sub disconnect_cmd {
1461 debugmsg(3, "disconnect_cmd called", @_);
1463 if ($connected) {
1464 print "Closing last connection...\n";
1465 commit_on_exit();
1467 $dbh->disconnect() if (defined $dbh);
1468 $connected = 0;
1469 } else {
1470 print "Not connected.\n";
1474 sub commit_cmd {
1475 debugmsg(3, "commit_cmd called", @_);
1476 # this just called commit
1478 if(defined $dbh) {
1479 if($dbh->{AutoCommit}) {
1480 wrn("commit ineffective with AutoCommit enabled");
1481 } else {
1482 if ($dbh->commit()) {
1483 print "Transaction committed\n";
1485 else {
1486 warn "Commit failed: $DBI::errstr\n";
1489 } else {
1490 print "No connection\n";
1494 sub rollback_cmd {
1495 debugmsg(3, "rollback_cmd called", @_);
1496 # this just called commit
1498 if(defined $dbh) {
1499 if($dbh->{AutoCommit}) {
1500 wrn("rollback ineffective with AutoCommit enabled");
1501 } else {
1502 if ($dbh->rollback()) {
1503 print "Transaction rolled back\n";
1505 else {
1506 warn "Rollback failed: $DBI::errstr\n";
1509 } else {
1510 print "No connection\n";
1514 sub exec_cmd {
1515 my($sqlstr) = @_;
1516 debugmsg(3, "exec_cmd called", @_);
1517 # Wrap the statement in BEGIN/END and execute
1519 $sqlstr = qq(
1520 BEGIN
1521 $sqlstr
1522 END;
1525 query($sqlstr, 'table');
1528 sub edit {
1529 my($filename) = @_;
1530 debugmsg(3, "edit called", @_);
1531 # This writes the current qbuffer to a file then opens up an editor on that
1532 # file... when the editor returns, we read in the file and overwrite the
1533 # qbuffer with it. If there is nothing in the qbuffer, and there is
1534 # something in the last_qbuffer, then we use the last_qbuffer. If nothing
1535 # is in either, then we just open the editor with a blank file.
1537 my $passed_file = 1 if $filename;
1538 my $filecontents;
1539 my $prompt = get_prompt();
1541 debugmsg(2, "passed_file: [$passed_file]");
1543 if($qbuffer) {
1544 debugmsg(2, "Using current qbuffer for contents");
1545 $filecontents = $qbuffer;
1546 } elsif($last_qbuffer) {
1547 debugmsg(2, "Using last_qbuffer for contents");
1548 $filecontents = $last_qbuffer . $last_fbuffer;
1549 } else {
1550 debugmsg(2, "Using blank contents");
1551 $filecontents = "";
1554 debugmsg(3, "filecontents: [$filecontents]");
1556 # determine the tmp directory
1557 my $tmpdir;
1558 if($ENV{TMP}) {
1559 $tmpdir = $ENV{TMP};
1560 } elsif($ENV{TEMP}) {
1561 $tmpdir = $ENV{TEMP};
1562 } elsif(-d "/tmp") {
1563 $tmpdir = "/tmp";
1564 } else {
1565 $tmpdir = ".";
1568 # determine the preferred editor
1569 my $editor;
1570 if($ENV{EDITOR}) {
1571 $editor = $ENV{EDITOR};
1572 } else {
1573 $editor = "vi";
1576 # create the filename, if not given one
1577 $filename ||= "$tmpdir/yasql_" . int(rand(1000)) . "_$$.sql";
1579 # expand the filename
1580 ($filename) = glob($filename);
1582 debugmsg(1, "Editing $filename with $editor");
1584 # check for file existance. If it exists, then we open it up but don't
1585 # write the buffer to it
1586 my $file_exists;
1587 if($passed_file) {
1588 # if the file was passed, then check for it's existance
1589 if(-e $filename) {
1590 # The file was found
1591 $file_exists = 1;
1592 } elsif(-e "$filename.sql") {
1593 # the file was found with a .sql extension
1594 $filename = "$filename.sql";
1595 $file_exists = 1;
1596 } else {
1597 wrn("$filename was not found, creating new file, which will not be ".
1598 "deleted");
1600 } else {
1601 # no file was specified, so just write to the the temp file, and we
1602 # don't care if it exists, since there's no way another process could
1603 # write to the same file at the same time since we use the PID in the
1604 # filename.
1605 my $ret = open(TMPFILE, ">$filename");
1606 if(!$ret) { #if file was NOT opened successfully
1607 wrn("Could not write to $filename: $!");
1608 } else {
1609 print TMPFILE $filecontents;
1610 close(TMPFILE);
1614 # now spawn the editor
1615 my($ret, @filecontents);
1616 debugmsg(2, "Executing $editor $filename");
1617 $ret = system($editor, "$filename");
1618 if($ret) {
1619 debugmsg(2, "Executing env $editor $filename");
1620 $ret = system("env", $editor, "$filename");
1622 if($ret) {
1623 debugmsg(2, "Executing `which $editor` $filename");
1624 $ret = system("`which $editor`", "$filename");
1627 if($ret) { #if the editor or system returned a positive return value
1628 wrn("Editor exited with $ret: $!");
1629 } else {
1630 # read in the tmp file and apply it's contents to the buffer
1631 my $ret = open(TMPFILE, "$filename");
1632 if(!$ret) { # if file was NOT opened successfully
1633 wrn("Could not read $filename: $!");
1634 } else {
1635 # delete our qbuffer and reset the inquotes var
1636 $qbuffer = "";
1637 $inquotes = 0;
1638 $increate = 0;
1639 $inplsqlblock = 0;
1640 $incomment = 0;
1641 while(<TMPFILE>) {
1642 push(@filecontents, $_);
1644 close(TMPFILE);
1648 if(@filecontents) {
1649 print "\n";
1650 print join('', @filecontents);
1651 print "\n";
1653 foreach my $line (@filecontents) {
1654 # chomp off newlines
1655 chomp($line);
1657 last if $sigintcaught;
1658 # now send it in to process_input
1659 # and don't add lines of the script to command history
1660 $prompt = process_input($line, '', 0);
1664 unless($passed_file) {
1665 # delete the tmp file
1666 debugmsg(1, "Deleting $filename");
1667 unlink("$filename") ||
1668 wrn("Could not unlink $filename: $!");
1671 return($prompt);
1674 sub run_script {
1675 my($input) = @_;
1676 debugmsg(3, "run_script called", @_);
1677 # This reads in the given script and executes it's lines as if they were typed
1678 # in directly. It will NOT erase the current buffer before it runs. It
1679 # will append the contents of the file to the current buffer, basicly
1681 my $prompt;
1683 # parse input
1684 $input =~ /^\@(.*)$/;
1685 my $file = $1;
1686 ($file) = glob($file);
1687 debugmsg(2, "globbed [$file]");
1689 my $first_char = substr($file, 0, 1);
1690 unless($first_char eq '/' or $first_char eq '.') {
1691 foreach my $path ('.', @sqlpath) {
1692 if(-e "$path/$file") {
1693 $file = "$path/$file";
1694 last;
1695 } elsif(-e "$path/$file.sql") {
1696 $file = "$path/$file.sql";
1697 last;
1701 debugmsg(2, "Found [$file]");
1703 # read in the tmp file and apply it's contents to the buffer
1704 my $ret = open(SCRIPT, $file);
1705 if(!$ret) { # if file was NOT opened successfully
1706 wrn("Could not read $file: $!");
1707 $prompt = get_prompt();
1708 } else {
1709 # read in the script
1710 while(<SCRIPT>) {
1711 # chomp off newlines
1712 chomp;
1714 last if $sigintcaught;
1716 # now send it in to process_input
1717 # and don't add lines of the script to command history
1718 $prompt = process_input($_, '', 0);
1720 close(SCRIPT);
1723 return($prompt);
1726 sub show_qbuffer {
1727 debugmsg(3, "show_qbuffer called", @_);
1728 # This outputs the current buffer
1730 #print "\nBuffer:\n";
1731 if($qbuffer) {
1732 print $qbuffer;
1733 } else {
1734 print STDERR "Buffer empty";
1736 print "\n";
1739 sub clear_qbuffer {
1740 debugmsg(3, "clear_qbuffer called", @_);
1741 # This clears the current buffer
1743 $qbuffer = '';
1744 $inquotes = 0;
1745 $inplsqlblock = 0;
1746 $increate = 0;
1747 $incomment = 0;
1748 print "Buffer cleared\n";
1749 return(get_prompt());
1752 sub debug_toggle {
1753 my($debuglevel) = @_;
1754 debugmsg(3, "debug_toggle called", @_);
1755 # If nothing is passed, then debugging is turned off if on, on if off. If
1756 # a number is passed, then we explicitly set debugging to that number
1759 if(length($debuglevel) > 0) {
1760 unless($debuglevel =~ /^\d+$/) {
1761 wrn('Debug level must be an integer');
1762 return(1);
1765 $opt_debug = $debuglevel;
1766 } else {
1767 if($opt_debug) {
1768 $opt_debug = 0;
1769 } else {
1770 $opt_debug = 1;
1773 $opt_debug > 3 ? DBI->trace(1) : DBI->trace(0);
1774 print "** debug is now " . ($opt_debug ? "level $opt_debug" : 'off') . "\n";
1777 sub autocommit_toggle {
1778 debugmsg(3, "autocommit_toggle called", @_);
1779 # autocommit is turned off if on on if off
1781 if($dbh->{AutoCommit}) {
1782 $dbh->{AutoCommit} = 0;
1783 } else {
1784 $dbh->{AutoCommit} = 1;
1787 print "AutoCommit is now " . ($dbh->{AutoCommit} ? 'on' : 'off') . "\n";
1790 sub show {
1791 my($input, $format, $num_rows, $op, $op_text) = @_;
1792 debugmsg(3, "show called", @_);
1793 # Can 'show thing'. Possible things:
1794 # tables - outputs all of the tables that the current user owns
1795 # sequences - outputs all of the sequences that the current user owns
1797 # Can also 'show thing on table'. Possible things:
1798 # constraints - Shows constraints on the 'table', like Check, Primary Key,
1799 # Unique, and Foreign Key
1800 # indexes - Shows indexes on the 'table'
1801 # triggers - Shows triggers on the 'table'
1803 # convert to lowercase for comparison operations
1804 $input = lc($input);
1806 # drop trailing whitespaces
1807 ($input = $input) =~ s/( +)$//;
1809 # parse the input to find out what 'thing' has been requested
1810 if($input =~ /^\s*show\s+([a-zA-Z0-9_\$\#\s]+)\s+(?:on|for)\s+([a-zA-Z0-9_\$\#]+)/) {
1811 # this is a thing on a table
1812 if($1 eq 'indexes') {
1813 my $sqlstr;
1814 if($dbversion >= 8) {
1815 $sqlstr = q{
1816 select ai.index_name "Index Name",
1817 ai.index_type "Type",
1818 ai.uniqueness "Unique?",
1819 aic.column_name "Column Name"
1820 from all_indexes ai, all_ind_columns aic
1821 where ai.index_name = aic.index_name
1822 and ai.table_owner = aic.table_owner
1823 and ai.table_name = ?
1824 and ai.table_owner = ?
1825 order by ai.index_name, aic.column_position
1827 } else {
1828 $sqlstr = q{
1829 select ai.index_name "Index Name",
1830 ai.uniqueness "Unique?",
1831 aic.column_name "Column Name"
1832 from all_indexes ai, all_ind_columns aic
1833 where ai.index_name = aic.index_name
1834 and ai.table_owner = aic.table_owner
1835 and ai.table_name = ?
1836 and ai.table_owner = ?
1837 order by ai.index_name, aic.column_position
1840 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
1841 op_text => $op_text}, uc($2), uc($dbuser));
1842 } elsif($1 eq 'constraints') {
1843 my $sqlstr = q{
1844 select constraint_name "Constraint Name",
1845 decode(constraint_type,
1846 'C', 'Check',
1847 'P', 'Primary Key',
1848 'R', 'Foreign Key',
1849 'U', 'Unique',
1850 '') "Type",
1851 search_condition "Search Condition"
1852 from all_constraints
1853 where table_name = ?
1854 and owner = ?
1855 order by constraint_name
1857 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
1858 op_text => $op_text}, uc($2), uc($dbuser));
1859 } elsif($1 eq 'keys') {
1860 my $sqlstr = q{
1861 select ac.constraint_name "Name",
1862 decode(ac.constraint_type,
1863 'R', 'Foreign Key',
1864 'U', 'Unique',
1865 'P', 'Primary Key',
1866 ac.constraint_type) "Type",
1867 ac.table_name "Table Name",
1868 acc.column_name "Column",
1869 r_ac.table_name "Parent Table",
1870 r_acc.column_name "Parent Column"
1871 from all_constraints ac, all_cons_columns acc,
1872 all_constraints r_ac, all_cons_columns r_acc
1873 where ac.constraint_name = acc.constraint_name
1874 and ac.owner = acc.owner
1875 and ac.constraint_type in ('R','U','P')
1876 and ac.r_constraint_name = r_ac.constraint_name(+)
1877 and r_ac.constraint_name = r_acc.constraint_name(+)
1878 and r_ac.owner = r_acc.owner(+)
1879 and ac.table_name = ?
1880 and ac.owner = ?
1881 order by ac.constraint_name, acc.position
1883 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
1884 op_text => $op_text}, uc($2), uc($dbuser));
1885 } elsif($1 eq 'checks') {
1886 my $sqlstr = q{
1887 select ac.constraint_name "Name",
1888 decode(ac.constraint_type,
1889 'C', 'Check',
1890 ac.constraint_type) "Type",
1891 ac.table_name "Table Name",
1892 ac.search_condition "Search Condition"
1893 from all_constraints ac
1894 where ac.table_name = ?
1895 and ac.constraint_type = 'C'
1896 and ac.owner = ?
1897 order by ac.constraint_name
1899 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
1900 op_text => $op_text}, uc($2), uc($dbuser));
1901 } elsif($1 eq 'triggers') {
1902 my $sqlstr = q{
1903 select trigger_name "Trigger Name",
1904 trigger_type "Type",
1905 when_clause "When",
1906 triggering_event "Event"
1907 from all_triggers
1908 where table_name = ?
1909 and owner = ?
1911 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
1912 op_text => $op_text}, uc($2), uc($dbuser));
1913 } elsif($1 eq 'query') {
1914 my $sqlstr = q{
1915 select count(*) from all_mviews where mview_name = ? and owner = ?
1917 my $is_mview = $dbh->selectrow_array($sqlstr, undef, uc($2), uc($dbuser));
1918 if($is_mview) {
1919 $sqlstr = q{
1920 select query
1921 from all_mviews
1922 where mview_name = ?
1923 and owner = ?
1925 } else {
1926 $sqlstr = q{
1927 select text
1928 from all_views
1929 where view_name = ?
1930 and owner = ?
1933 my $prev_LongReadLen = $dbh->{LongReadLen};
1934 $dbh->{LongReadLen} = 8000;
1935 query($sqlstr, 'single_output', {num_rows => $num_rows, op => $op,
1936 op_text => $op_text}, uc($2), uc($dbuser));
1937 $dbh->{LongReadLen} = $prev_LongReadLen;
1938 } else {
1939 query_err("show", "Unsupported show type", $input);
1941 } elsif($input =~ /^\s*show\s+all\s+([a-zA-Z0-9_\$\#\s]+)\s*$/) {
1942 if($1 eq 'tables') {
1943 my $sqlstr = q{
1944 select table_name "Table Name", 'TABLE' "Type", owner "Owner"
1945 from all_tables
1946 order by table_name
1948 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
1949 op_text => $op_text});
1950 } elsif($1 eq 'views') {
1951 my $sqlstr = q{
1952 select view_name "View Name", 'VIEW' "Type", owner "Owner"
1953 from all_views
1954 order by view_name
1956 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
1957 op_text => $op_text});
1958 } elsif($1 eq 'objects') {
1959 my $sqlstr = q{
1960 select object_name "Object Name", object_type "Type", owner "Owner"
1961 from all_objects
1962 order by object_name
1964 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
1965 op_text => $op_text});
1966 } elsif($1 eq 'sequences') {
1967 my $sqlstr = q{
1968 select sequence_name "Sequence Name", 'SEQUENCE' "Type", sequence_owner "Owner"
1969 from all_sequences
1970 order by sequence_name
1972 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
1973 op_text => $op_text});
1974 } elsif($1 eq 'clusters') {
1975 my $sqlstr = q{
1976 select cluster_name "Cluster Name", 'CLUSTER' "Type", owner "Owner"
1977 from all_clusters
1978 order by cluster_name
1980 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
1981 op_text => $op_text});
1982 } elsif($1 eq 'dimensions') {
1983 my $sqlstr = q{
1984 select dimension_name "Dimension Name", 'DIMENSION' "Type", owner "Owner"
1985 from all_dimensions
1986 order by dimension_name
1988 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
1989 op_text => $op_text});
1990 } elsif($1 eq 'functions') {
1991 my $sqlstr = q{
1992 select distinct name "Function Name", 'FUNCTION' "Type", owner "Owner"
1993 from all_source
1994 where type = 'FUNCTION'
1995 order by name
1997 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
1998 op_text => $op_text});
1999 } elsif($1 eq 'procedures') {
2000 my $sqlstr = q{
2001 select distinct name "Procedure Name", 'PROCEDURE' "Type", owner "Owner"
2002 from all_source
2003 where type = 'PROCEDURE'
2004 order by name
2006 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2007 op_text => $op_text});
2008 } elsif($1 eq 'packages') {
2009 my $sqlstr = q{
2010 select distinct name "Package Name", 'PACKAGES' "Type", owner "Owner"
2011 from all_source
2012 where type = 'PACKAGE'
2013 order by name
2015 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2016 op_text => $op_text});
2017 } elsif($1 eq 'indexes') {
2018 my $sqlstr = q{
2019 select index_name "Index Name", 'INDEXES' "Type", owner "Owner"
2020 from all_indexes
2021 order by index_name
2023 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2024 op_text => $op_text});
2025 } elsif($1 eq 'indextypes') {
2026 my $sqlstr = q{
2027 select indextype_name "Indextype Name", 'INDEXTYPE' "Type", owner "Owner"
2028 from all_indextypes
2029 order by indextype_name
2031 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2032 op_text => $op_text});
2033 } elsif($1 eq 'libraries') {
2034 my $sqlstr = q{
2035 select library_name "library Name", 'LIBRARY' "Type", owner "Owner"
2036 from all_libraries
2037 order by library_name
2039 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2040 op_text => $op_text});
2041 } elsif($1 eq 'materialized views') {
2042 my $sqlstr = q{
2043 select mview_name "Materialized View Name", 'MATERIALIZED VIEW' "Type", owner "Owner"
2044 from all_mviews
2045 order by mview_name
2047 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2048 op_text => $op_text});
2049 } elsif($1 eq 'snapshots') {
2050 my $sqlstr = q{
2051 select name "Snapshot Name", 'SNAPSHOT' "Type", owner "Owner"
2052 from all_snapshots
2053 order by name
2055 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2056 op_text => $op_text});
2057 } elsif($1 eq 'synonyms') {
2058 my $sqlstr = q{
2059 select synonym_name "Synonym Name", 'SYNONYM' "Type", owner "Owner"
2060 from all_synonyms
2061 order by synonym_name
2063 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2064 op_text => $op_text});
2065 } elsif($1 eq 'triggers') {
2066 my $sqlstr = q{
2067 select trigger_name "Trigger Name", 'TRIGGER' "Type", owner "Owner"
2068 from all_triggers
2069 order by trigger_name
2071 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2072 op_text => $op_text});
2073 } elsif($1 eq 'waits') {
2074 my $sqlstr = q{
2075 select vs.username "Username",
2076 vs.osuser "OS User",
2077 vsw.sid "SID",
2078 vsw.event "Event",
2079 decode(vsw.wait_time, -2, ' Unknown',
2080 to_char(vsw.seconds_in_wait,'999,999,999,999'))
2081 "Seconds Waiting"
2082 from v$session_wait vsw,
2083 v$session vs
2084 where vsw.sid = vs.sid
2085 order by vsw.wait_time desc, vsw.seconds_in_wait desc, vsw.sid
2087 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2088 op_text => $op_text});
2089 } else {
2090 query_err("show", "Unsupported show type", $input);
2092 } elsif($input =~ /^\s*show\s+([a-zA-Z0-9_\$\#\s]+)\s*$/) {
2093 if($1 eq 'tables') {
2094 my $sqlstr = q{
2095 select table_name "Table Name", 'TABLE' "Type", sys.login_user() "Owner"
2096 from user_tables
2097 order by table_name
2099 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2100 op_text => $op_text});
2101 } elsif($1 eq 'views') {
2102 my $sqlstr = q{
2103 select view_name "View Name", 'VIEW' "Type", sys.login_user() "Owner"
2104 from user_views
2105 order by view_name
2107 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2108 op_text => $op_text});
2109 } elsif($1 eq 'objects') {
2110 my $sqlstr = q{
2111 select object_name "Object Name", object_type "Type", sys.login_user() "Owner"
2112 from user_objects
2113 order by object_name
2115 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2116 op_text => $op_text});
2117 } elsif($1 eq 'sequences') {
2118 my $sqlstr = q{
2119 select sequence_name "Sequence Name", 'SEQUENCE' "Type", sys.login_user() "Owner"
2120 from user_sequences
2121 order by sequence_name
2123 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2124 op_text => $op_text});
2125 } elsif($1 eq 'clusters') {
2126 my $sqlstr = q{
2127 select cluster_name "Cluster Name", 'CLUSTER' "Type", sys.login_user() "Owner"
2128 from user_clusters
2129 order by cluster_name
2131 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2132 op_text => $op_text});
2133 } elsif($1 eq 'dimensions') {
2134 my $sqlstr = q{
2135 select dimension_name "Dimension Name", 'DIMENSION' "Type", sys.login_user() "Owner"
2136 from user_dimensions
2137 order by dimension_name
2139 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2140 op_text => $op_text});
2141 } elsif($1 eq 'functions') {
2142 my $sqlstr = q{
2143 select distinct name "Function Name", 'FUNCTION' "Type", sys.login_user() "Owner"
2144 from user_source
2145 where type = 'FUNCTION'
2146 order by name
2148 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2149 op_text => $op_text});
2150 } elsif($1 eq 'procedures') {
2151 my $sqlstr = q{
2152 select distinct name "Procedure Name", 'PROCEDURE' "Type", sys.login_user() "Owner"
2153 from user_source
2154 where type = 'PROCEDURE'
2155 order by name
2157 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2158 op_text => $op_text});
2159 } elsif($1 eq 'packages') {
2160 my $sqlstr = q{
2161 select distinct name "Package Name", 'PACKAGES' "Type", sys.login_user() "Owner"
2162 from user_source
2163 where type = 'PACKAGE'
2164 order by name
2166 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2167 op_text => $op_text});
2168 } elsif($1 eq 'indexes') {
2169 my $sqlstr = q{
2170 select index_name "Index Name", 'INDEXES' "Type", sys.login_user() "Owner"
2171 from user_indexes
2172 order by index_name
2174 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2175 op_text => $op_text});
2176 } elsif($1 eq 'indextypes') {
2177 my $sqlstr = q{
2178 select indextype_name "Indextype Name", 'INDEXTYPE' "Type", sys.login_user() "Owner"
2179 from user_indextypes
2180 order by indextype_name
2182 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2183 op_text => $op_text});
2184 } elsif($1 eq 'libraries') {
2185 my $sqlstr = q{
2186 select library_name "library Name", 'LIBRARY' "Type", sys.login_user() "Owner"
2187 from user_libraries
2188 order by library_name
2190 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2191 op_text => $op_text});
2192 } elsif($1 eq 'materialized views') {
2193 my $sqlstr = q{
2194 select mview_name "Materialized View Name", 'MATERIALIZED VIEW' "Type", sys.login_user() "Owner"
2195 from user_mviews
2196 order by mview_name
2198 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2199 op_text => $op_text});
2200 } elsif($1 eq 'snapshots') {
2201 my $sqlstr = q{
2202 select name "Snapshot Name", 'SNAPSHOT' "Type", sys.login_user() "Owner"
2203 from user_snapshots
2204 order by name
2206 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2207 op_text => $op_text});
2208 } elsif($1 eq 'synonyms') {
2209 my $sqlstr = q{
2210 select synonym_name "Synonym Name", 'SYNONYM' "Type", sys.login_user() "Owner"
2211 from user_synonyms
2212 order by synonym_name
2214 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2215 op_text => $op_text});
2216 } elsif($1 eq 'triggers') {
2217 my $sqlstr = q{
2218 select trigger_name "Trigger Name", 'TRIGGER' "Type", sys.login_user() "Owner"
2219 from user_triggers
2220 order by trigger_name
2222 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2223 op_text => $op_text});
2224 } elsif($1 eq 'processes') {
2225 my $sqlstr = q{
2226 select sid,
2227 vs.username "User",
2228 vs.status "Status",
2229 vs.schemaname "Schema",
2230 vs.osuser || '@' || vs.machine "From",
2231 to_char(vs.logon_time, 'Mon DD YYYY HH:MI:SS') "Logon Time",
2232 aa.name "Command"
2233 from v$session vs, audit_actions aa
2234 where vs.command = aa.action
2235 and username is not null
2237 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2238 op_text => $op_text});
2239 } elsif($1 eq 'waits') {
2240 my $sqlstr = q{
2241 select vs.username "Username",
2242 vs.osuser "OS User",
2243 vsw.sid "SID",
2244 vsw.event "Event",
2245 decode(vsw.wait_time, -2, ' Unknown',
2246 to_char(vsw.seconds_in_wait,'999,999,999,999'))
2247 "Seconds Waiting"
2248 from v$session_wait vsw,
2249 v$session vs
2250 where vsw.sid = vs.sid
2251 and vs.status = 'ACTIVE'
2252 and vs.username is not null
2253 order by vsw.wait_time desc, vsw.seconds_in_wait desc, vsw.sid
2255 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2256 op_text => $op_text});
2257 } elsif($1 eq 'plan') {
2258 # This following query is Copyright (c) Oracle Corporation 1998, 1999. All Rights Reserved.
2259 my $sqlstr = q{
2260 select '| Operation | Name | Rows | Bytes| Cost | Pstart| Pstop |' as "Plan Table" from dual
2261 union all
2262 select '--------------------------------------------------------------------------------' from dual
2263 union all
2264 select rpad('| '||substr(lpad(' ',1*(level-1)) ||operation||
2265 decode(options, null,'',' '||options), 1, 27), 28, ' ')||'|'||
2266 rpad(substr(object_name||' ',1, 9), 10, ' ')||'|'||
2267 lpad(decode(cardinality,null,' ',
2268 decode(sign(cardinality-1000), -1, cardinality||' ',
2269 decode(sign(cardinality-1000000), -1, trunc(cardinality/1000)||'K',
2270 decode(sign(cardinality-1000000000), -1, trunc(cardinality/1000000)||'M',
2271 trunc(cardinality/1000000000)||'G')))), 7, ' ') || '|' ||
2272 lpad(decode(bytes,null,' ',
2273 decode(sign(bytes-1024), -1, bytes||' ',
2274 decode(sign(bytes-1048576), -1, trunc(bytes/1024)||'K',
2275 decode(sign(bytes-1073741824), -1, trunc(bytes/1048576)||'M',
2276 trunc(bytes/1073741824)||'G')))), 6, ' ') || '|' ||
2277 lpad(decode(cost,null,' ',
2278 decode(sign(cost-10000000), -1, cost||' ',
2279 decode(sign(cost-1000000000), -1, trunc(cost/1000000)||'M',
2280 trunc(cost/1000000000)||'G'))), 8, ' ') || '|' ||
2281 lpad(decode(partition_start, 'ROW LOCATION', 'ROWID',
2282 decode(partition_start, 'KEY', 'KEY', decode(partition_start,
2283 'KEY(INLIST)', 'KEY(I)', decode(substr(partition_start, 1, 6),
2284 'NUMBER', substr(substr(partition_start, 8, 10), 1,
2285 length(substr(partition_start, 8, 10))-1),
2286 decode(partition_start,null,' ',partition_start)))))||' ', 7, ' ')|| '|' ||
2287 lpad(decode(partition_stop, 'ROW LOCATION', 'ROW L',
2288 decode(partition_stop, 'KEY', 'KEY', decode(partition_stop,
2289 'KEY(INLIST)', 'KEY(I)', decode(substr(partition_stop, 1, 6),
2290 'NUMBER', substr(substr(partition_stop, 8, 10), 1,
2291 length(substr(partition_stop, 8, 10))-1),
2292 decode(partition_stop,null,' ',partition_stop)))))||' ', 7, ' ')||'|' as "Explain plan"
2293 from plan_table
2294 start with id=0 and timestamp = (select max(timestamp) from plan_table where id=0)
2295 connect by prior id = parent_id
2296 and prior nvl(statement_id, ' ') = nvl(statement_id, ' ')
2297 and prior timestamp <= timestamp
2298 union all
2299 select '--------------------------------------------------------------------------------' from dual
2301 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2302 op_text => $op_text});
2303 } elsif($1 eq 'errors') {
2304 my $err = $dbh->func( 'plsql_errstr' );
2305 if($err) {
2306 print "\n$err\n\n";
2307 } else {
2308 print "\nNo errors.\n\n";
2310 } elsif($1 eq 'users') {
2311 my $sqlstr = q{
2312 select username, user_id, created
2313 from all_users
2315 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2316 op_text => $op_text});
2317 } elsif($1 eq 'user') {
2318 my $sqlstr = q{
2319 select user from dual
2321 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2322 op_text => $op_text});
2323 } elsif($1 eq 'uid') {
2324 my $sqlstr = q{
2325 select uid from dual
2327 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2328 op_text => $op_text});
2329 } elsif(($1 eq 'database links') || ($1 eq 'dblinks')) {
2330 my $sqlstr = q{
2331 select db_link, host, owner from all_db_links
2333 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2334 op_text => $op_text});
2335 } else {
2336 query_err("show", "Unsupported show type", $input);
2338 } else {
2339 query_err("show", "Unsupported show type", $input);
2345 sub describe {
2346 my($input, $format, $nosynonym, $num_rows, $op, $op_text) = @_;
2347 debugmsg(3, "describe called", @_);
2348 # This describes a table, view, sequence, or synonym by listing it's
2349 # columns and their attributes
2351 # convert to lowercase for comparison operations
2352 $input = lc($input);
2354 # make sure we're still connected to the database
2355 unless(ping()) {
2356 wrn("Database connection died");
2357 db_reconnect();
2360 # parse the query to find the table that was requested to be described
2361 if($input =~ /^\s*desc\w*\s*([a-zA-Z0-9_\$\#\.\@]+)/) {
2362 my $object = $1;
2363 my $sqlstr;
2364 my $type;
2365 my @ret;
2367 my $schema;
2368 my $dblink;
2369 if($object =~ /^([a-zA-Z0-9_\$\#]+)\.([a-zA-Z0-9_\$\#]+)\@([a-zA-Z0-9_\$\#]+)$/) {
2370 $schema = $1;
2371 $object = $2;
2372 $dblink = "\@$3";
2373 } elsif($object =~ /^([a-zA-Z0-9_\$\#]+)\@([a-zA-Z0-9_\$\#]+)$/) {
2374 $schema = $dbuser;
2375 $object = $1;
2376 $dblink = "\@$2";
2377 } elsif($object =~ /^([a-zA-Z0-9_\$\#]+)\.([a-zA-Z0-9_\$\#]+)$/) {
2378 $schema = $1;
2379 $object = $2;
2380 } else {
2381 $schema = $dbuser;
2384 debugmsg(1,"schema: [$schema] object: [$object] dblink: [$dblink]");
2386 if($conf{fast_describe}) {
2387 if(my $sth = $dbh->prepare("select * from $schema.$object$dblink")) {
2388 my $fields = $sth->{NAME};
2389 my $types = $sth->{TYPE};
2390 my $type_info = $dbh->type_info($types->[0]);
2391 my $precision = $sth->{PRECISION};
2392 my $scale = $sth->{SCALE};
2393 my $nullable = $sth->{NULLABLE};
2395 debugmsg(4, "fields: [" . join(',', @$fields) . "]");
2396 debugmsg(4, "types: [" . join(',', @$types) . "]");
2397 debugmsg(4, "type_info: [" . Dumper($type_info) . "]");
2398 debugmsg(4, "precision: [" . join(',', @$precision) . "]");
2399 debugmsg(4, "scale: [" . join(',', @$scale) . "]");
2400 debugmsg(4, "nullable: [" . join(',', @$nullable) . "]");
2402 # Assemble a multidiminsional array of the output
2403 my @desc;
2404 for(my $i = 0; $i < @$fields; $i++) {
2405 my ($name, $null, $type);
2406 $name = $fields->[$i];
2407 $null = ($nullable->[$i] ? 'NULL' : 'NOT NULL');
2408 my $type_info = $dbh->type_info($types->[$i]);
2409 $type = $type_info->{'TYPE_NAME'};
2410 # convert DECIMAL to NUMBER for our purposes (some kind of DBD kludge)
2411 $type = 'NUMBER' if $type eq 'DECIMAL';
2412 if( $type eq 'VARCHAR2' || $type eq 'NVARCHAR2' ||
2413 $type eq 'CHAR' || $type eq 'NCHAR' || $type eq 'RAW' )
2415 $type .= "($precision->[$i])";
2416 } elsif($type eq 'NUMBER' && ($scale->[$i] || $precision->[$i] < 38))
2418 $type .= "($precision->[$i],$scale->[$i])";
2420 push(@desc, [$name, $null, $type]);
2423 # figure max column sizes we'll need
2424 my @widths = (4,5,4);
2425 for(my $i = 0; $i < @desc; $i++) {
2426 for(my $j = 0; $j < @{$desc[0]}; $j++) {
2427 if(length($desc[$i][$j]) > $widths[$j]) {
2428 $widths[$j] = length($desc[$i][$j]);
2433 # open the redirection file
2434 if($op && $op eq '>' || $op eq '>>') {
2435 ($op_text) = glob($op_text);
2436 debugmsg(3, "Opening file '$op_text' for output redirection using [$op]");
2437 open(FOUT, $op . $op_text) || do query_err('redirect',"Cannot open file '$op_text' for writing: $!", '');
2438 } elsif($op eq '|') {
2439 debugmsg(3, "Opening pipe to '$op_text' for output redirection");
2440 open(FOUT, $op . $op_text) || do query_err('pipe',"Cannot open pipe '$op_text': $!", '');
2441 } else {
2442 open(FOUT, ">&STDOUT");
2445 if($opt_headers) {
2446 # Print headers
2447 print FOUT "\n";
2448 print FOUT sprintf("%-$widths[0]s", 'Name')
2449 . ' '
2450 . sprintf("%-$widths[1]s", 'Null?')
2451 . ' '
2452 . sprintf("%-$widths[2]s", 'Type')
2453 . "\n";
2454 print FOUT '-' x $widths[0]
2455 . ' '
2456 . '-' x $widths[1]
2457 . ' '
2458 . '-' x $widths[2]
2459 . "\n";
2461 for(my $i = 0; $i < @desc; $i++) {
2462 for(my $j = 0; $j < @{$desc[$i]}; $j++) {
2463 print FOUT ' ' if $j > 0;
2464 print FOUT sprintf("%-$widths[$j]s", $desc[$i][$j]);
2466 print FOUT "\n";
2468 print FOUT "\n";
2470 close(FOUT);
2472 return();
2476 # look in all_constraints for the object first. This is because oracle
2477 # stores information about primary keys in the all_objects table as "index"s
2478 # but it doesn't have foreign keys or constraints. So we want to match
2479 # there here first
2481 # now look in all_objects
2482 my $all_object_cols = 'object_type,owner,object_name,'
2483 . 'object_id,created,last_ddl_time,'
2484 . 'timestamp,status';
2486 @ret = $dbh->selectrow_array(
2487 "select $all_object_cols from all_objects where object_name = ? "
2488 ."and owner = ?"
2489 .($nosynonym ? " and object_type != 'SYNONYM'" : ""),
2490 undef, uc($object), uc($schema)
2491 ) or
2492 @ret = $dbh->selectrow_array(
2493 "select $all_object_cols from all_objects where object_name = ? "
2494 ."and owner = 'PUBLIC'"
2495 .($nosynonym ? " and object_type != 'SYNONYM'" : ""),
2496 undef, uc($object)
2499 unless(@ret) {
2500 @ret = $dbh->selectrow_array(
2501 "select constraint_type, constraint_name from all_constraints where "
2502 ."constraint_name = ?",
2503 undef, uc($object)
2507 if($ret[0] eq 'INDEX') {
2508 # Check if this 'index' is really a primary key and is in the
2509 # all_constraints table
2511 my @temp_ret = $dbh->selectrow_array(
2512 "select constraint_type, constraint_name from all_constraints where "
2513 ."constraint_name = ?",
2514 undef, uc($object)
2517 @ret = @temp_ret if @temp_ret;
2520 $type = $ret[0];
2521 debugmsg(1,"type: [$type] ret: [@ret]");
2523 if($type eq 'SYNONYM') {
2524 # Find what this is a synonym to, then recursively call this function
2525 # again to describe whatever it points to
2526 my($table_name, $table_owner) = $dbh->selectrow_array(
2527 'select table_name, table_owner from all_synonyms '
2528 .'where synonym_name = ? and owner = ?',
2529 undef, uc($ret[2]), uc($ret[1])
2532 describe("desc $table_owner.$table_name", $format, 1);
2533 } elsif($type eq 'SEQUENCE') {
2534 my $sqlstr = q{
2535 select sequence_name "Name",
2536 min_value "Min",
2537 max_value "Max",
2538 increment_by "Inc",
2539 cycle_flag "Cycle",
2540 order_flag "Order",
2541 last_number "Last"
2542 from all_sequences
2543 where sequence_name = ?
2544 and sequence_owner = ?
2546 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2547 op_text => $op_text}, uc($ret[2]), uc($ret[1]));
2548 } elsif($type eq 'TABLE' || $type eq 'VIEW' || $type eq 'TABLE PARTITION') {
2549 my $sqlstr = q{
2550 select column_name "Name",
2551 decode(nullable,
2552 'N','NOT NULL'
2553 ) "Null?",
2554 decode(data_type,
2555 'VARCHAR2','VARCHAR2(' || TO_CHAR(data_length) || ')',
2556 'NVARCHAR2','NVARCHAR2(' || TO_CHAR(data_length) || ')',
2557 'CHAR','CHAR(' || TO_CHAR(data_length) || ')',
2558 'NCHAR','NCHAR(' || TO_CHAR(data_length) || ')',
2559 'NUMBER',
2560 decode(data_precision,
2561 NULL, 'NUMBER',
2562 'NUMBER(' || TO_CHAR(data_precision)
2563 || ',' || TO_CHAR(data_scale) || ')'
2565 'FLOAT',
2566 decode(data_precision,
2567 NULL, 'FLOAT', 'FLOAT(' || TO_CHAR(data_precision) || ')'
2569 'DATE','DATE',
2570 'LONG','LONG',
2571 'LONG RAW','LONG RAW',
2572 'RAW','RAW(' || TO_CHAR(data_length) || ')',
2573 'MLSLABEL','MLSLABEL',
2574 'ROWID','ROWID',
2575 'CLOB','CLOB',
2576 'NCLOB','NCLOB',
2577 'BLOB','BLOB',
2578 'BFILE','BFILE',
2579 data_type || ' ???'
2580 ) "Type",
2581 data_default "Default"
2582 from all_tab_columns
2583 where table_name = ?
2584 and owner = ?
2585 order by column_id
2587 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2588 op_text => $op_text}, uc($ret[2]), uc($ret[1]));
2589 } elsif($type eq 'R') {
2590 my $sqlstr = q{
2591 select ac.constraint_name "Name",
2592 decode(ac.constraint_type,
2593 'R', 'Foreign Key',
2594 'C', 'Check',
2595 'U', 'Unique',
2596 'P', 'Primary Key',
2597 ac.constraint_type) "Type",
2598 ac.table_name "Table Name",
2599 acc.column_name "Column Name",
2600 r_ac.table_name "Parent Table",
2601 r_acc.column_name "Parent Column",
2602 ac.delete_rule "Delete Rule"
2603 from all_constraints ac, all_cons_columns acc,
2604 all_constraints r_ac, all_cons_columns r_acc
2605 where ac.constraint_name = acc.constraint_name
2606 and ac.owner = acc.owner
2607 and ac.r_constraint_name = r_ac.constraint_name
2608 and r_ac.constraint_name = r_acc.constraint_name
2609 and r_ac.owner = r_acc.owner
2610 and ac.constraint_type = 'R'
2611 and ac.constraint_name = ?
2612 and ac.owner = ?
2613 order by ac.constraint_name, acc.position
2615 query($sqlstr, 'list_aligned', {num_rows => $num_rows, op => $op,
2616 op_text => $op_text}, uc($ret[1]),
2617 uc($schema));
2618 } elsif($type eq 'P' || $type eq 'U') {
2619 my $sqlstr = q{
2620 select ac.constraint_name "Name",
2621 decode(ac.constraint_type,
2622 'R', 'Foreign Key',
2623 'C', 'Check',
2624 'U', 'Unique',
2625 'P', 'Primary Key',
2626 ac.constraint_type) "Type",
2627 ac.table_name "Table Name",
2628 acc.column_name "Column Name"
2629 from all_constraints ac, all_cons_columns acc
2630 where ac.constraint_name = acc.constraint_name
2631 and ac.owner = acc.owner
2632 and ac.constraint_name = ?
2633 and ac.owner = ?
2634 order by ac.constraint_name, acc.position
2636 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2637 op_text => $op_text}, uc($ret[1]), uc($schema));
2638 } elsif($type eq 'C') {
2639 my $sqlstr = q{
2640 select ac.constraint_name "Name",
2641 decode(ac.constraint_type,
2642 'R', 'Foreign Key',
2643 'C', 'Check',
2644 'U', 'Unique',
2645 'P', 'Primary Key',
2646 ac.constraint_type) "Type",
2647 ac.table_name "Table Name",
2648 ac.search_condition "Search Condition"
2649 from all_constraints ac
2650 where ac.constraint_name = ?
2651 order by ac.constraint_name
2653 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2654 op_text => $op_text}, uc($ret[1]));
2655 } elsif($type eq 'INDEX') {
2656 my $sqlstr = q{
2657 select ai.index_name "Index Name",
2658 ai.index_type "Type",
2659 ai.table_name "Table Name",
2660 ai.uniqueness "Unique?",
2661 aic.column_name "Column Name"
2662 from all_indexes ai, all_ind_columns aic
2663 where ai.index_name = aic.index_name(+)
2664 and ai.table_owner = aic.table_owner(+)
2665 and ai.index_name = ?
2666 and ai.table_owner = ?
2667 order by aic.column_position
2669 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2670 op_text => $op_text}, uc($ret[2]), uc($schema));
2671 } elsif($type eq 'TRIGGER') {
2672 my $sqlstr = q{
2673 select trigger_name "Trigger Name",
2674 trigger_type "Type",
2675 triggering_event "Event",
2676 table_name "Table",
2677 when_clause "When",
2678 description "Description",
2679 trigger_body "Body"
2680 from all_triggers
2681 where trigger_name = ?
2683 query($sqlstr, 'list_aligned', {num_rows => $num_rows, op => $op,
2684 op_text => $op_text}, uc($ret[2]));
2685 } elsif($type eq 'PACKAGE') {
2686 wrn("Not implemented (yet)");
2687 } elsif($type eq 'PROCEDURE') {
2688 wrn("Not implemented (yet)");
2689 } elsif($type eq 'CLUSTER') {
2690 wrn("Not implemented (yet)");
2691 } elsif($type eq 'TRIGGER') {
2692 wrn("Not implemented (yet)");
2693 } else {
2694 query_err('describe', "Object $object not found");
2699 sub set_cmd {
2700 my($input) = @_;
2701 debugmsg(3, "set_cmd called", @_);
2702 # This mimics SQL*Plus set commands, or ignores them completely. For those
2703 # that are not supported, we do nothing at all, but return silently.
2705 if($input =~ /^\s*set\s+serverout(?:put)?\s+(on|off)(?:\s+size\s+(\d+))?/i) {
2706 if(lc($1) eq 'on') {
2707 my $size = $2 || 1_000_000;
2708 debugmsg(2, "calling dbms_output_enable($size)");
2709 $dbh->func( $size, 'dbms_output_enable' )
2710 or warn "dbms_output_enable($size) failed: $DBI::errstr\n";
2711 $set{serveroutput} = 1;
2712 debugmsg(2, "serveroutput set to $set{serveroutput}");
2713 } else {
2714 $set{serveroutput} = 0;
2715 debugmsg(2, "serveroutput set to $set{serveroutput}");
2720 sub query {
2721 my($sqlstr, $format, $opts, @bind_vars) = @_;
2722 debugmsg(3, "query called", @_);
2723 # this runs the provided query and calls format_display to display the results
2725 my $num_rows = $opts->{num_rows};
2726 my $op = $opts->{op};
2727 my $op_text = $opts->{op_text};
2728 my $result_output = ( exists $opts->{result_output}
2729 ? $opts->{result_output}
2733 my(@totalbench, @querybench, @formatbench);
2735 # Look for special query types, such as "show" and "desc" that we handle
2736 # and don't send to the database at all, since they're not really valid SQL.
2738 my ($rows_affected, $success_code);
2740 if($sqlstr =~ /^\s*desc/i) {
2741 describe($sqlstr, $format, undef, $num_rows, $op, $op_text);
2742 } elsif($sqlstr =~ /^\s*show/i) {
2743 show($sqlstr, $format, $num_rows, $op, $op_text);
2744 } else {
2745 $running_query = 1;
2747 # make sure we're still connected to the database
2748 unless(ping()) {
2749 wrn("Database connection died");
2750 db_reconnect();
2753 $sqlstr = wildcard_expand($sqlstr) if $conf{column_wildcards};
2755 # send the query on to the database
2756 push(@totalbench, get_bench()) if !$conf{extended_benchmarks};
2757 push(@querybench, get_bench()) if $conf{extended_benchmarks};
2758 debugmsg(3, "preparing", $sqlstr);
2759 my $sth = $dbh->prepare($sqlstr);
2760 unless($sth) {
2761 my $err = $DBI::errstr;
2762 $err =~ s/ \(DBD ERROR\: OCIStmtExecute\/Describe\)//;
2764 if ($err =~ m/DBD ERROR\:/) {
2765 my $indicator_offset = $DBI::errstr;
2766 $indicator_offset =~ s/(.*)(at\ char\ )(\d+)(\ .*)/$3/;
2767 if ($indicator_offset > 0) {
2768 my $i = 0;
2769 print $sqlstr, "\n";
2770 for ($i=0;$i<$indicator_offset;++$i) {
2771 print " ";
2773 print "*\n";
2777 # Output message if serveroutput is on
2778 if($set{serveroutput}) {
2779 debugmsg(3, "Calling dmbs_output_get");
2780 my @output = $dbh->func( 'dbms_output_get' );
2781 print join("\n", @output) . "\n";
2783 query_err('prepare', $err, $sqlstr), setup_sigs(), return();
2785 debugmsg(2, "sth: [$sth]");
2787 $cursth = $sth;
2789 finish_query($sth), return() if $sigintcaught; #pseudo sig handle
2791 my $ret;
2792 eval {
2793 debugmsg(3, "executing", $sqlstr);
2794 $ret = $sth->execute(@bind_vars);
2796 debugmsg(3, "ret:", $ret, "\@:", $@, "\$DBI::errstr:", $DBI::errstr);
2797 if(!$ret) {
2798 my $eval_error = $@;
2799 $eval_error =~ s/at \(eval \d+\) line \d+, <\S+> line \d+\.//;
2800 my $err = $DBI::errstr;
2801 $err =~ s/ \(DBD ERROR: OCIStmtExecute\)//;
2802 # Output message is serveroutput is on
2803 if($set{serveroutput}) {
2804 debugmsg(3, "Calling dmbs_output_get");
2805 my @output = $dbh->func( 'dbms_output_get' );
2806 print join("\n", @output) . "\n";
2808 my $errstr = ($eval_error ? $eval_error : $err);
2809 query_err('execute', $errstr, $sqlstr);
2810 setup_sigs();
2811 return();
2814 if($DBI::errstr =~ /^ORA-24344/) {
2815 print "\nWarning: Procedure created with compilation errors.\n\n";
2816 setup_sigs();
2817 return();
2820 push(@querybench, get_bench()) if $conf{extended_benchmarks};
2822 finish_query($sth), return() if $sigintcaught; #pseudo sig handle
2824 debugmsg(1, "rows returned: [" . $sth->rows() . "]");
2826 # open the redirection file
2827 if($op && $op eq '>' || $op eq '>>') {
2828 ($op_text) = glob($op_text);
2829 debugmsg(3, "Opening file '$op_text' for output redirection using [$op]");
2830 open(FOUT, $op . $op_text) || do{
2831 query_err('redirect',"Cannot open file '$op_text' for writing: $!",
2832 $sqlstr);
2833 finish_query($sth);
2834 return();
2836 } elsif($op eq '|') {
2837 debugmsg(3, "Opening pipe to '$op_text' for output redirection");
2838 open(FOUT, $op . $op_text) || do{
2839 query_err('pipe',"Cannot open pipe '$op_text': $!", $sqlstr);
2840 finish_query($sth);
2841 return();
2843 } else {
2844 open(FOUT, ">&STDOUT");
2847 # Output message is serveroutput is on
2848 if($set{serveroutput}) {
2849 debugmsg(3, "Calling dmbs_output_get");
2850 my @output = $dbh->func( 'dbms_output_get' );
2851 print join("\n", @output) . "\n";
2854 # Determine type and output accordingly
2855 if($sqlstr =~ /^\s*declare|begin/i) {
2856 print STDERR "\nPL/SQL procedure successfully completed.\n\n";
2857 } else {
2858 push(@formatbench, get_bench()) if $conf{extended_benchmarks};
2859 ($rows_affected, $success_code) = format_output($sth, $format, $num_rows,
2860 $sqlstr, $op, $op_text)
2861 or finish_query($sth), return();
2862 push(@formatbench, get_bench()) if $conf{extended_benchmarks};
2863 push(@totalbench, get_bench()) if !$conf{extended_benchmarks};
2865 finish_query($sth), return() if $sigintcaught; #pseudo sig handle
2867 # output format_affected
2868 if($result_output) {
2869 if(!$opt_batch) {
2870 print STDERR "\n" . format_affected($rows_affected, $success_code);
2873 if(!$opt_batch) {
2874 if($opt_bench || $conf{extended_benchmarks}) {
2875 print STDERR "\n\n";
2876 print STDERR ('-' x 80);
2877 print STDERR "\n";
2878 output_benchmark("Query: ", @querybench, "\n");
2879 output_benchmark("Format:", @formatbench, "\n");
2880 } else {
2881 output_benchmark(" (", @totalbench, ")");
2882 print STDERR "\n";
2884 print STDERR "\n";
2889 close(FOUT);
2891 finish_query($sth);
2893 undef($sth);
2894 undef($cursth);
2897 return($rows_affected, $success_code);
2900 sub wildcard_expand {
2901 my($sql) = @_;
2902 debugmsg(3, "wildcard_expand called", @_);
2904 my $newsql = $sql;
2905 my $fromstuff;
2906 my $wheregrouporder = $sql;
2907 $wheregrouporder =~ s/.*(where|order|group).*/\1/;
2908 if ($wheregrouporder eq $sql) {
2909 $wheregrouporder = "";
2911 ($sql,$fromstuff) = split(/order|group|where/i,$sql,2);
2912 if ($sql =~ /^select\s+(.+?)\*\s+from\s+(.+)/i) {
2913 debugmsg(1, "Match made: ($1) ($2)");
2914 my $wildcardstring = uc($1);
2915 my $tablename = uc($2);
2916 my @tlist = split(/,/,$tablename);
2917 my $tablelist = "";
2918 my %column_prefix;
2919 foreach my $table (@tlist) {
2920 $table =~ s/^ *//;
2921 $table =~ s/([^ ]+)\s+(.*)/\1/;
2922 $column_prefix{$table} = $2 ? $2 : $table;
2923 $tablelist .= ($tablelist ? "," : "") . $table;
2925 $tablelist =~ s/,/' or table_name='/g;
2926 my $qstr = "select table_name||'.'||column_name from all_tab_columns where (table_name='$tablelist') and column_name like '$wildcardstring%' escape '\\'";
2927 debugmsg(1, "qstr: [$qstr]");
2928 my $sth = $dbh->prepare($qstr);
2929 $sth->execute();
2930 setup_sigs();
2931 my $colname;
2932 my $collist;
2933 while ( ($colname) = $sth->fetchrow_array() ) {
2934 foreach my $table (keys %column_prefix) {
2935 $colname =~ s/$table\./$column_prefix{$table}\./;
2936 $colname =~ s/ //g;
2938 $collist .= ($collist ? "," : "") . $colname;
2940 $collist = $collist ? $collist : "*";
2941 $newsql = "select " . $collist . " from " . $tablename . " "
2942 . $wheregrouporder . " " . $fromstuff;
2943 debugmsg(1, "newsql: [$newsql]");
2945 $newsql;
2948 sub finish_query {
2949 my($sth) = @_;
2950 # This just finishes the query and cleans up the state info
2952 $sth->finish;
2953 undef($cursth);
2954 $running_query = 0;
2955 setup_sigs();
2958 sub get_bench {
2959 debugmsg(3, "get_bench called", @_);
2960 # returns benchmark info
2962 my($benchmark, $hires);
2963 $benchmark = new Benchmark;
2965 if($nohires) {
2966 $hires = time;
2967 } else {
2968 # use an eval to keep perl from syntax checking it unless we have the
2969 # Time::HiRes module loaded
2970 eval q{
2971 $hires = [gettimeofday]
2975 return($benchmark, $hires);
2978 sub output_benchmark {
2979 my($string, $bstart, $hrstart, $bend, $hrend, $string2) = @_;
2980 debugmsg(3, "output_benchmark called", @_);
2981 # This just outputs the benchmark info
2983 my $bench = timediff($bend, $bstart);
2985 my $time;
2986 if($nohires) {
2987 # the times will be seconds
2988 $time = $hrend - $hrstart;
2989 } else {
2990 eval q{$time = tv_interval($hrstart, $hrend)};
2991 $time = sprintf("%.2f", $time);
2994 unless($opt_bench || $conf{extended_benchmarks}) {
2995 # convert $time to something more readable
2996 $time =~ s/\.(\d+)$//;
2997 my $decimal = $1;
2998 my @tparts;
2999 my $tmp;
3000 if(($tmp = int($time / 604800)) >= 1) {
3001 push(@tparts, "$tmp week" . ($tmp != 1 && 's'));
3002 $time %= 604800;
3004 if(($tmp = int($time / 86400)) >= 1) {
3005 push(@tparts, "$tmp day" . ($tmp != 1 && 's'));
3006 $time %= 86400;
3008 if(($tmp = int($time / 3600)) >= 1) {
3009 push(@tparts, "$tmp hour" . ($tmp != 1 && 's'));
3010 $time %= 3600;
3012 if(($tmp = int($time / 60)) >= 1) {
3013 push(@tparts, "$tmp minute" . ($tmp != 1 && 's'));
3014 $time %= 60;
3016 $time ||= '0';
3017 $decimal ||= '00';
3018 $time .= ".$decimal";
3019 push(@tparts, "$time second" . ($time != 1 && 's'));
3020 $time = join(", ", @tparts);
3023 if($opt_bench || $conf{extended_benchmarks}) {
3024 print STDERR "$string\[ $time second" . ($time != 1 && 's')
3025 . " ] [" . timestr($bench) . " ]$string2";
3026 } else {
3027 print STDERR "$string$time$string2";
3031 sub format_output {
3032 my($sth, $format, $num_rows, $sqlstr, $op, $op_text) = @_;
3033 debugmsg(3, "format_output called", @_);
3034 # Formats the output according to the query terminator. If it was a ';' or
3035 # a '/' then a normal table is output. If it was a '\g' then all the columns # and rows are output put line by line.
3036 # input: $sth $format
3037 # sth is the statement handler
3038 # format can be either 'table', 'list', or 'list_aligned'
3039 # output: returns 0 on error, ($success_code, $rows_affected) on success
3040 # $success_code = ('select', 'affected');
3042 debugmsg(3,"type: [" . Dumper($sth->{TYPE}) . "]");
3044 # Is this query a select?
3045 my $isselect = 1 if $sqlstr =~ /^\s*select/i;
3047 if($format eq 'table') {
3048 my $count = 0;
3049 my $res = [];
3050 my $overflow = 0;
3051 while(my @res = $sth->fetchrow_array()) {
3052 push(@$res, \@res);
3053 $count++;
3054 if($count > 1000) {
3055 debugmsg(1,"overflow in table output, switching to serial mode");
3056 $overflow = 1;
3057 last;
3059 debugmsg(1,"num_rows hit on fetch") if $num_rows && $count >= $num_rows;
3060 last if $num_rows && $count >= $num_rows;
3061 return(0) if $sigintcaught; #pseudo sig handle
3064 # If we didn't get any rows back, then the query was probably an insert or
3065 # update, so we call format_affected
3066 if(@$res <= 0 && !$isselect) {
3067 return($sth->rows(), 'affected');
3070 return(0) if $sigintcaught; #pseudo sig handle
3072 # First go through all the return data to determine column widths
3073 my @widths;
3074 for( my $i = 0; $i < @{$res}; $i++ ) {
3075 for( my $j = 0; $j < @{$res->[$i]}; $j++ ) {
3076 if(length($res->[$i]->[$j]) > $widths[$j]) {
3077 $widths[$j] = length($res->[$i]->[$j]);
3080 return(0) if $sigintcaught; #pseudo sig handle
3081 debugmsg(1,"num_rows hit on calc") if $num_rows && $i >= $num_rows-1;
3082 last if $num_rows && $i >= $num_rows-1;
3085 return(0) if $sigintcaught; #pseudo sig handle
3087 my $fields = $sth->{NAME};
3088 my $types = $sth->{TYPE};
3089 my $nullable = $sth->{NULLABLE};
3091 debugmsg(4, "fields: [" . Dumper($fields) . "]");
3092 debugmsg(4, "types: [" . Dumper($types) . "]");
3093 debugmsg(4, "nullable: [" . Dumper($nullable) . "]");
3095 return(0) if $sigintcaught; #pseudo sig handle
3097 # Extend the column widths if the column name is longer than any of the
3098 # data, so that it doesn't truncate the column name
3099 for( my $i = 0; $i < @$fields; $i++ ) {
3100 if(length($fields->[$i]) > $widths[$i]) {
3101 debugmsg(3, "Extending $fields->[$i] for name width");
3102 $widths[$i] = length($fields->[$i]);
3104 return(0) if $sigintcaught; #pseudo sig handle
3107 return(0) if $sigintcaught; #pseudo sig handle
3109 # Extend the column widths if the column is NULLABLE so that we'll
3110 # have room for 'NULL'
3111 for( my $i = 0; $i < @$nullable; $i++ ) {
3112 if($nullable->[$i] && $widths[$i] < 4) {
3113 debugmsg(3, "Extending $fields->[$i] for null");
3114 $widths[$i] = 4;
3116 return(0) if $sigintcaught; #pseudo sig handle
3119 return(0) if $sigintcaught; #pseudo sig handle
3121 my $sumwidths;
3122 foreach(@widths) {
3123 $sumwidths += $_;
3126 return(0) if $sigintcaught; #pseudo sig handle
3128 debugmsg(2,"fields: [" . join("|", @$fields) . "] sumwidths: [$sumwidths] widths: [" . join("|", @widths) . "]\n");
3130 return(0) if $sigintcaught; #pseudo sig handle
3132 # now do the actual outputting, starting with the header
3133 my $rows_selected = 0;
3134 if(@$res) {
3135 if(!$opt_batch) {
3136 print FOUT "\r\e[K" if $op eq '<';
3137 print FOUT "\n";
3138 for( my $i = 0; $i < @$fields; $i++ ) {
3139 if($opt_batch) {
3140 print FOUT "\t" if $i > 0;
3141 print FOUT sprintf("%s", $fields->[$i]);
3143 else
3145 print FOUT " " if $i > 0;
3146 if($types->[$i] == 3 || $types->[$i] == 8) {
3147 print FOUT sprintf("%$widths[$i]s", $fields->[$i]);
3148 } else {
3149 print FOUT sprintf("%-$widths[$i]s", $fields->[$i]);
3153 print FOUT "\n";
3155 for( my $i = 0; $i < @$fields; $i++ ) {
3156 print FOUT " " if $i > 0;
3157 print FOUT '-' x $widths[$i];
3159 print FOUT "\n";
3162 return(0) if $sigintcaught; #pseudo sig handle
3164 # now print the actual data rows
3165 my $count = 0;
3166 for( my $j = 0; $j < @$res; $j++ ) {
3167 $count = $j;
3168 for( my $i = 0; $i < @$fields; $i++ ) {
3169 print FOUT " " if $i > 0;
3170 my $data = $res->[$j]->[$i];
3171 # Strip out plain ole \r's since SQL*Plus seems to...
3172 $data =~ s/\r//g;
3173 $data = 'NULL' unless defined $data;
3174 if($types->[$i] == 3 || $types->[$i] == 8) {
3175 print FOUT sprintf("%$widths[$i]s", $data);
3176 } else {
3177 print FOUT sprintf("%-$widths[$i]s", $data);
3180 print FOUT "\n";
3182 $rows_selected++;
3183 debugmsg(2,"num_rows hit on output") if $num_rows && $j >= $num_rows-1;
3184 last if $num_rows && $j >= $num_rows-1;
3185 return(0) if $sigintcaught; #pseudo sig handle
3188 if($overflow) {
3189 # output the rest of the data from the statement handler
3190 while(my $res = $sth->fetch()) {
3191 $count++;
3192 for( my $i = 0; $i < @$fields; $i++ ) {
3193 print FOUT " " if $i > 0;
3194 my $data = substr($res->[$i],0,$widths[$i]);
3195 # Strip out plain ole \r's since SQL*Plus seems to...
3196 $data =~ s/\r//g;
3197 $data = 'NULL' unless defined $data;
3198 if($types->[$i] == 3 || $types->[$i] == 8) {
3199 print FOUT sprintf("%$widths[$i]s", $data);
3200 } else {
3201 print FOUT sprintf("%-$widths[$i]s", $data);
3204 print FOUT "\n";
3206 $rows_selected++;
3207 debugmsg(2,"num_rows hit on output")
3208 if $num_rows && $count >= $num_rows-1;
3209 last if $num_rows && $count >= $num_rows-1;
3210 return(0) if $sigintcaught; #pseudo sig handle
3215 return($rows_selected, 'selected');
3217 } elsif($format eq 'list') {
3218 # output in a nice list format, which is where we print each row in turn,
3219 # with each column on it's own line
3221 my $fields = $sth->{NAME};
3223 print "\r\e[K" if $op eq '<';
3224 print FOUT "\n";
3226 my $count = 0;
3227 while(my $res = $sth->fetch()) {
3228 print FOUT "\n**** Row: " . ($count+1) . "\n";
3229 for( my $i = 0; $i < @$fields; $i++ ) {
3230 my $data = $res->[$i];
3231 $data = 'NULL' unless defined $data;
3232 print FOUT $fields->[$i] . ": " . $data . "\n";
3234 $count++;
3235 last if $num_rows && $count >= $num_rows;
3236 return(0) if $sigintcaught; #pseudo sig handle
3239 return(0) if $sigintcaught; #pseudo sig handle
3241 # If we didn't get any rows back, then the query was probably an insert or
3242 # update, so we call format_affected
3243 if($count <= 0 && !$isselect) {
3244 return($sth->rows(), 'affected');
3247 return($count, 'selected');
3249 } elsif($format eq 'list_aligned') {
3250 # output in a nice list format, which is where we print each row in turn,
3251 # with each column on it's own line. The column names are aligned in this
3252 # one (so that the data all starts on the same column)
3254 my $fields = $sth->{NAME};
3256 print "\r\e[K" if $op eq '<';
3257 print FOUT "\n";
3259 my $maxwidth = 0;
3260 for( my $i = 0; $i < @$fields; $i++ ) {
3261 my $len = length($fields->[$i]) + 1; # +1 for the colon
3262 $maxwidth = $len if $len >= $maxwidth;
3265 return(0) if $sigintcaught; #pseudo sig handle
3267 my $count = 0;
3268 while(my $res = $sth->fetch()) {
3269 print FOUT "\n**** Row: " . ($count+1) . "\n";
3270 for( my $i = 0; $i < @$fields; $i++ ) {
3271 my $data = $res->[$i];
3272 $data = 'NULL' unless defined $data;
3273 print FOUT sprintf("%-" . $maxwidth . "s", $fields->[$i] . ":");
3274 print FOUT " " . $data . "\n";
3276 $count++;
3277 last if $num_rows && $count >= $num_rows;
3278 return(0) if $sigintcaught; #pseudo sig handle
3281 return(0) if $sigintcaught; #pseudo sig handle
3283 # If we didn't get any rows back, then the query was probably an insert or
3284 # update, so we call format_affected
3285 if($count <= 0 && !$isselect) {
3286 return($sth->rows(), 'affected');
3289 return($count, 'selected');
3291 } elsif($format eq 'single_output') {
3292 # Outputs a single return column/row without any labeling
3294 print FOUT "\n";
3296 my $res = $sth->fetchrow_array();
3297 print FOUT "$res\n";
3299 my $count = ($res ? 1 : 0);
3301 return(0) if $sigintcaught; #pseudo sig handle
3303 return($count, 'selected');
3305 } elsif($format eq 'csv' || $format eq 'csv_no_header') {
3306 # output in a comma seperated values format. fields with a ',' are quoted
3307 # with '"' quotes, and rows are seperated by '\n' newlines
3309 print "\r\e[K" if $op eq '<';
3310 print FOUT "\n";
3312 # check that Text::CSV_XS was included ok, if not output an error
3313 if($notextcsv) {
3314 soft_err("You must install Text::CSV_XS from CPAN to use this feature");
3315 return(0);
3316 } else {
3317 my $fields = $sth->{NAME};
3319 if($format eq 'csv') {
3320 # Print the column headers
3321 for(my $i = 0; $i < @$fields; $i++) {
3322 print FOUT "," if $i > 0;
3323 print FOUT $fields->[$i];
3325 print FOUT "\n";
3328 my $count = 0;
3329 while(my $res = $sth->fetch()) {
3330 $count++;
3332 $csv->combine(@$res);
3333 print FOUT $csv->string() . "\n";
3335 last if $num_rows && $count >= $num_rows;
3336 return(0) if $sigintcaught; #pseudo sig handle
3339 return(0) if $sigintcaught; #pseudo sig handle
3341 # If we didn't get any rows back, then the query was probably an insert or
3342 # update, so we call format_affected
3343 if($count <= 0 && !$isselect) {
3344 return($sth->rows(), 'affected');
3347 return($count, 'selected');
3349 } elsif($format eq 'sql') {
3350 # Produce SQL insert statements.
3351 print "\r" if $op eq '<';
3352 print FOUT "\n";
3354 my $cols = lc join(', ', @{$sth->{NAME}});
3355 my @types = map { scalar $dbh->type_info($_)->{TYPE_NAME} } @{ $sth->{TYPE} };
3356 my %warned_unknown_type;
3358 my $count = 0;
3359 while(my $res = $sth->fetch()) {
3360 $count++;
3361 die if @$res != @types;
3362 print FOUT "insert into TABLE ($cols) values (";
3363 foreach (0 .. $#$res) {
3364 my $t = $types[$_];
3365 my $v = $res->[$_];
3366 if (not defined $v) {
3367 print FOUT 'null';
3368 } else {
3369 if ($t eq 'DOUBLE' or $t eq 'DOUBLE PRECISION' or
3370 $t eq 'NUMBER' or $t eq 'DECIMAL') {
3371 die "bad number: $v" if $v !~ /\d/;
3372 print FOUT $v;
3373 } elsif ($t eq 'VARCHAR2' or $t eq 'CHAR' or $t eq 'CLOB') {
3374 $v =~ s/['']/''/g;
3375 print FOUT "'$v'";
3376 } elsif ($t eq 'DATE') {
3377 print FOUT "'$v'";
3378 } else {
3379 warn "don't know how to handle SQL type $t"
3380 unless $warned_unknown_type{$t}++;
3381 print FOUT "(unknown type $t: $v)";
3384 print FOUT ', ' unless $_ eq $#$res;
3386 print FOUT ");\n";
3387 last if $num_rows && $count >= $num_rows;
3388 return(0) if $sigintcaught; #pseudo sig handle
3390 return(0) if $sigintcaught; #pseudo sig handle
3392 # If we didn't get any rows back, then the query was probably an insert or
3393 # update, so we call format_affected
3394 if($count <= 0 && !$isselect) {
3395 return($sth->rows(), 'affected');
3397 return($count, 'selected');
3398 } else {
3399 die("Invalid format: $format");
3403 sub format_affected {
3404 my($rows_affected, $success_code) = @_;
3405 debugmsg(3, "format_affected called", @_);
3406 # This just outputs the given number
3408 return("$rows_affected row" . ($rows_affected == 1 ? '' : 's')
3409 ." $success_code");
3412 sub statusline {
3413 my($num, $max) = @_;
3414 debugmsg(3, "statusline called", @_);
3415 my $linewidth;
3416 eval q{
3417 use Term::ReadKey;
3418 (\$linewidth) = GetTerminalSize();
3420 if($@) {
3421 $linewidth = 80;
3423 my $numwidth = length($num);
3424 my $maxwidth = length($max);
3425 my $width = $linewidth - $numwidth - $maxwidth - 9;
3427 my $fillnum = (($num / $max) * $width);
3428 my $spacenum = ((($max - $num) / $max) * $width);
3430 if($fillnum =~ /\./) {
3431 $fillnum = int($fillnum) + 1;
3434 if($spacenum =~ /\./) {
3435 $spacenum = int($spacenum);
3438 my $fill = ('*' x $fillnum);
3439 my $space = ('-' x $spacenum);
3440 my $pcnt = sprintf("%.0d", ($num / $max * 100));
3442 return(sprintf("%-" . $linewidth . "s", "$num/$max [" . $fill . $space . "] $pcnt\%") . "\r");
3445 sub statusprint {
3446 my($string) = @_;
3448 return("\r\e[K$string\n");
3451 sub ping {
3452 debugmsg(3, "ping called", @_);
3453 if(!$dbh) {
3454 return(0);
3455 } else {
3456 # install alarm signal handle
3457 $SIG{ALRM} = \&sighandle;
3458 debugmsg(2, "Setting alarm for ping ($conf{connection_timeout} seconds)");
3459 alarm($conf{connection_timeout});
3461 debugmsg(2, "Pinging...");
3462 if($dbh->ping()) {
3463 debugmsg(2, "Ping successfull");
3464 alarm(0); # cancel alarm
3465 return(1);
3466 } else {
3467 debugmsg(2, "Ping failed");
3468 alarm(0); # cancel alarm
3469 db_reconnect();
3470 return(0);
3473 alarm(0); # cancel alarm
3476 sub query_err {
3477 my($query_type, $msg, $query) = @_;
3478 debugmsg(3, "query_err called", @_);
3479 # outputs a standard query error. does not exit
3480 # input: $query_type, $msg, $query
3482 chomp($query_type);
3483 chomp($msg);
3484 chomp($query);
3486 print STDERR "\n";
3487 print STDERR "$msg\n";
3488 print STDERR "Query: $query\n" if $query && $conf{sql_query_in_error};
3489 print STDERR "\n";
3492 sub lerr {
3493 my($msg) = @_;
3494 debugmsg(3, "err called", @_);
3495 # outputs an error message and exits
3497 print "Error: $msg\n";
3498 quit(1);
3501 sub soft_err {
3502 my($msg) = @_;
3503 debugmsg(3, "soft_err called", @_);
3504 # outputs a error, but doesn't exit
3506 print "\nError: $msg\n\n";
3509 sub wrn {
3510 my($msg) = @_;
3511 debugmsg(3, "wrn called", @_);
3512 # outputs a warning
3514 print STDERR "Warning: $msg\n";
3517 sub quit {
3518 my($exitcode, $force_quit, $msg) = @_;
3519 debugmsg(3, "quit called", @_);
3520 # just quits
3521 $exitcode ||= 0;
3522 $force_quit ||= 0; # Set this to 1 to try a smoother force quit
3523 $msg ||= '';
3525 setup_sigs();
3527 print "$msg" if $msg && $msg != "";
3528 $quitting = 1;
3530 if($force_quit) {
3531 exit($exitcode);
3534 commit_on_exit();
3536 # disconnect the database
3537 debugmsg(1, "disconnecting from database");
3538 if (defined $dbh) {
3539 $dbh->disconnect()
3540 or warn "Disconnect failed: $DBI::errstr\n";
3543 debugmsg(1, "exiting with exitcode: [$exitcode]");
3544 exit($exitcode);
3547 sub commit_on_exit {
3548 debugmsg(3, "commit_on_exit called", @_);
3550 # Commit... or not
3551 if($conf{commit_on_exit} && defined $dbh && !$dbh->{AutoCommit}) {
3552 # do nothing, oracle commits on disconnect
3553 } elsif(defined $dbh && !$dbh->{AutoCommit}) {
3554 print "Rolling back any outstanding transaction...\n";
3555 $dbh->rollback()
3556 or warn "Rollback failed: $DBI::errstr\n";
3560 sub debugmsg {
3561 my($debuglevel, @msgs) = @_;
3562 if($opt_debug >= $debuglevel ) {
3563 my @time = localtime();
3564 my $time = sprintf("%.4i-%.2i-%.2i %.2i:%.2i:%.2i", $time[5] + 1900,
3565 $time[4] + 1, $time[3], $time[2], $time[1], $time[0]);
3566 print STDERR "$time $debuglevel [" . join("] [", @msgs) . "]\n";
3570 sub usage {
3571 my($exit) = @_;
3572 debugmsg(3, "usage called", @_);
3574 $exit ||= 0;
3576 print <<_EOM_;
3577 Usage: yasql [options] [logon] [AS {SYSDBA|SYSOPER}] [@<file>[.ext]
3578 [<param1> <param2> ...]]
3579 Logon: <username>[/<password>][@<connect_string>] | /
3580 Options:
3581 -d, --debug=LEVEL Turn debugging on to LEVEL
3582 -H, --host=HOST Host to connect to
3583 -p, --port=PORT Host port to connect to
3584 -s, --sid=SID Oracle SID to connect to
3585 -h, -?, --help This help information
3586 -A, --nocomp Turn off building the auto-completion list
3587 -b, --bench, --benchmark Display extra benchmarking info
3588 -v, --version Print version and exit
3589 -B, --batch Batch mode (no headers, etc.)
3591 See the man pages for more help.
3592 _EOM_
3594 exit($exit);
3597 sub help {
3598 debugmsg(3, "help called", @_);
3599 # This just outputs online help
3601 my $help = <<_EOM_;
3603 Commands:
3604 help This screen
3605 quit, exit, \\q Exit the program.
3606 !<cmd>, host <cmd> Sends the command directly to a shell.
3607 \\A Regenerate the auto-completion list.
3608 connect [logon] [AS {SYSDBA|SYSOPER}]
3609 Open new connection.
3610 login = <username>[/<password>][@<connect_string>] | /
3611 reconnect, \\r Reconnect to the database
3612 desc[ribe] <object> Describe table, view, index, sequence, primary key,
3613 foreign key, constraint or trigger
3614 object = [<schema>.]<object>[\@dblink]
3615 show [all] <string> Shows [all] objects of a certain type
3616 string = tables, views, objects, sequences, clusters,
3617 dimensions, functions, procedures, packages,
3618 indexes, indextypes, libraries, snapshots
3619 materialized views, synonyms, triggers,
3620 show <string> on|for <object>
3621 Shows properties for a particular object
3622 string = indexes, constraints, keys, checks, triggers,
3623 query
3624 show processes Shows logged in users
3625 show [all] waits Shows [all] waits
3626 show plan Shows the last EXPLAIN PLAN ran
3627 show errors Shows errors from PL/SQL object creation
3628 l[ist], \\l, \\p List the contents of the current buffer
3629 cl[ear] [buffer], \\c
3630 Clear the current buffer
3631 ed[it] [filename], \\e [filename]
3632 Will open a text editor as defined by the EDITOR
3633 environment variable. If a file is given as the
3634 argument, then the editor will be opened with that
3635 file. If the given file does not exist then it will be
3636 created. In both cases the file will not be deleted,
3637 and the current buffer will be overwritten by the
3638 contents of the file. If no file is given, then the
3639 editor will be opened with a temporary file, which will
3640 contain the current contents of the buffer, or the last
3641 execute query if the buffer is empty. After the editor
3642 quits, the file will be read into the buffer. The
3643 contents will be parsed and executed just as if you had
3644 typed them all in by hand. You can have multiple
3645 commands and/or queries. If the last command is not
3646 terminated them you will be able to add furthur lines
3647 or input a terminator to execute the query.
3648 \@scriptname Execute all the commands in <filename> as if they were
3649 typed in directly. All CLI commands and queries are
3650 supported. yasql will quit after running all
3651 commands in the script.
3652 debug [num] Toggle debuggin on/off or if <num> is specified, then
3653 set debugging to that level
3654 autocommit Toggle AutoCommit on/off
3656 Queries:
3657 All other input is treated as a query, and is sent straight to the database.
3659 All queries must be terminated by one of the following characters:
3660 ; - Returns data in table form
3661 / - Returns data in table form
3662 \\g - Returns data in non-aligned list form
3663 \\G - Returns data in aligned list form
3664 \\s - Returns data in CSV form. The first line is the column names
3665 \\S - Returns data in CSV form, but no column names
3666 \\i - Returns data in sql select commands form
3668 You may re-run the last query by typing the terminator by itself.
3670 Example:
3671 user\@ORCL> select * from table;
3672 user\@ORCL> \\g
3674 Return limit:
3675 You may add a number after the terminator, which will cause only the
3676 first <num> rows to be returned. e.g. 'select * from table;10' will run
3677 the query and return the first 10 rows in table format. This will also work
3678 if you just type the terminator to rerun the last query.
3680 Examples:
3681 The following will run the query, then run it again with different settings:
3682 user\@ORCL> select * from table;10
3683 user\@ORCL> \G50
3685 Redirection:
3686 You can add a shell like redirection operator after a query to pipe the output
3687 to or from a file.
3689 Output:
3690 You can use either '>' or '>>' to output to a file. '>' will overwrite the
3691 file and '>>' will append to the end of the file. The file will be created
3692 if it does not exist.
3694 Examples:
3695 user\@ORCL> select * from table; > table.dump
3696 user\@ORCL> select * from table\S > table.csv
3698 Input:
3699 You can use '<' to grab data from a CSV file. The file must be formatted
3700 with comma delimiters, quoted special fields, and rows seperated by
3701 newlines. When you use this operator with a query, the query will be ran
3702 for every line in the file. Put either '?' or ':n' (n being a number)
3703 placeholders where you want the data from the CSV file to be interpolated.
3704 The number of placeholders must match the number of columns in the CSV file.
3705 Each query is run as if you had typed it in, so the AutoCommit setting
3706 applies the same. If there is an error then the process will stop, but no
3707 rollback or anything will be done.
3709 Examples:
3710 user\@ORCL> insert into table1 values (?,?,?); < table1.csv
3711 user\@ORCL> update table2 set col1 = :1, col3 = :3, col2 = :2; < table2.csv
3713 Piping
3714 You can pipe the output from a query to the STDIN of any program you wish.
3716 Examples:
3717 user\@ORCL> select * from table; | less
3718 user\@ORCL> select * from table; | sort -n
3720 Please see 'man yasql' or 'perldoc yasql' for more help
3721 _EOM_
3723 my $ret = open(PAGER, "|$conf{pager}");
3724 if($ret) {
3725 print PAGER $help;
3726 close(PAGER);
3727 } else {
3728 print $help;
3732 __END__
3734 =head1 NAME
3736 yasql - Yet Another SQL*Plus replacement
3738 =head1 SYNOPSIS
3740 B<yasql> [options] [logon] [@<file>[.ext] [<param1> <param2>]
3742 =over 4
3744 =item logon
3746 <I<username>>[/<I<password>>][@<I<connect_string>>] | /
3748 =item options
3750 =over 4
3752 =item -d I<debuglevel>, --debug=I<debuglevel>
3754 Turn debuggin on to I<debuglevel> level. Valid levels: 1,2,3,4
3756 =item -H I<hostaddress>, --host=I<hostaddress>
3758 Host to connect to
3760 =item -p I<hostport>, --port=I<hostport>
3762 Host port to connect to
3764 =item -s I<SID>, --sid=I<SID>
3766 Oracle SID to connect to
3768 =item -h, -?, --help
3770 Output usage information and quit.
3772 =item -A, --nocomp
3774 Turn off the generation of the auto-completion list at startup. Use This if
3775 it takes too long to generate the list with a large database.
3777 =item -b, --bench, --benchmark
3779 Turn on extended benchmark info, which includes times and CPU usages for both
3780 queries and formatting.
3782 =item -v, --version
3784 Print version and exit
3786 =back
3788 =item Examples
3790 =over 4
3792 =item Connect to local database
3794 =over 4
3796 =item yasql
3798 =item yasql user
3800 =item yasql user/password
3802 =item yasql user@LOCAL
3804 =item yasql user/password@LOCAL
3806 =item yasql -h localhost
3808 =item yasql -h localhost -p 1521
3810 =item yasql -h localhost -p 1521 -s ORCL
3812 =back
3814 =item Connect to remote host
3816 =over 4
3818 =item yasql user@REMOTE
3820 =item yasql user/password@REMOTE
3822 =item yasql -h remote.domain.com
3824 =item yasql -h remote.domain.com -p 1512
3826 =item yasql -h remote.domain.com -p 1512 -s ORCL
3828 =back
3830 =back
3832 =back
3834 If no connect_string or a hostaddress is given, then will attempt to connect to
3835 the local default database.
3837 =head1 DESCRIPTION
3839 YASQL is an open source Oracle command line interface. YASQL features a much
3840 kinder alternative to SQL*Plus's user interface. This is meant to be a
3841 complete replacement for SQL*Plus when dealing with ad hoc queries and general
3842 database interfacing. It's main features are:
3844 =over 4
3846 =item Full ReadLine support
3848 Allows the same command line style editing as other ReadLine enabled programs
3849 such as BASH and the Perl Debugger. You can edit the command line as well as
3850 browse your command history. The command
3851 history is saved in your home directory in a file called .yasql_history. You
3852 can also use tab completion on all table and column names.
3854 =item Alternate output methods
3856 A different style of output suited to each type of need. There are currently
3857 table, list and CSV output styles. Table style outputs in the same manner as
3858 SQL*Plus, except the column widths are set based on the width of the data in
3859 the column, and not the column length defined in the table schema. List outputs
3860 each row on it's own line, column after column for easier viewing of wide return
3861 results. CSV outputs the data in Comma Seperated Values format, for easy
3862 import into many other database/spreadsheet programs.
3864 =item Output of query results
3866 You can easily redirect the output of any query to an external file
3868 =item Data Input and Binding
3870 YASQL allows you to bind data in an external CSV file to any query, using
3871 standard DBI placeholders. This is the ultimate flexibility when inserting or
3872 updating data in the database.
3874 =item Command pipes
3876 You can easily pipe the output of any query to an external program.
3878 =item Tab completion
3880 All tables, columns, and other misc objects can be completed using tab, much
3881 like you can with bash.
3883 =item Easy top rownum listings
3885 You can easily put a number after a terminator, which will only output those
3886 number of lines. No more typing "where rownum < 10" after every query. Now
3887 you can type 'select * from table;10' instead.
3889 =item Enhanced Data Dictionary commands
3891 Special commands like 'show tables', 'desc <table>', 'show indexes on <table>',
3892 'desc <sequence>', and many many more so that you can easily see your schema.
3894 =item Query editing
3896 You can open and edit queries in your favorite text editor.
3898 =item Query chaining
3900 You can put an abitrary number of queries on the same line, and each will be
3901 executed in turn.
3903 =item Basic scripting
3905 You can put basic SQL queries in a script and execute them from YASQL.
3907 =item Config file
3909 You can create a config file of options so that you don't have to set them
3910 everytime you run it.
3912 =item Future extensibility
3914 We, the community, can modify and add to this whatever we want, we can't do that
3915 with SQL*Plus.
3917 =back
3919 =head1 REQUIREMENTS
3921 =over 4
3923 =item Perl 5
3925 This was developed with Perl 5.6, but is known to work on 5.005_03 and above.
3926 Any earlier version of Perl 5 may or may not work. Perl 4 will definately not
3927 work.
3929 =item Unix environment
3931 YASQL was developed under GNU/Linux, and aimed at as many Unix installations as
3932 possible. Known to be compatible with GNU/Linux, AIX and Sun Solaris.
3933 Please send me an email (qzy@users.sourceforge.net) if it works for other platforms.
3934 I'd be especially interested if it worked on Win32.
3936 =item Oracle Server
3938 It has been tested and developed for Oracle8 and Oracle8i. There is atleast
3939 one issue with Oracle7 that I know of (see ISSUES below) and I have not tested
3940 it with Oracle9i yet.
3942 =item Oracle client libraries
3944 The Oracle client libraries must be installed for DBD::Oracle. Of course you
3945 can't install DBD::Oracle without them...
3947 =item DBD::Oracle
3949 DBD::Oracle must be installed since this uses DBI for database connections.
3951 =item ORACLE_HOME
3953 The ORACLE_HOME environment variable must be set if you use a connection
3954 descriptor to connect so that YASQL can translate the descriptor into
3955 usefull connection information to make the actual connection.
3957 =item ORACLE_SID
3959 The ORACLE_SID environment variable must be set unless you specify one with the
3960 -s option (see options above).
3962 =item Term::Readline
3964 Term::Readline must be installed (it is with most Perl installations), but more
3965 importantly, installing Term::ReadLine::Gnu from CPAN will greatly enhance the
3966 usability.
3968 =item Time::HiRes
3970 This is used for high resolution benchmarking. It is optional.
3972 =item Text::CSV_XS
3974 This perl module is required if you want to output CSV or input from CSV files.
3975 If you don't plan on using this features, then you don't need to install this
3976 module.
3978 =item Term::ReadKey
3980 This module is used for better input and output control. Right now it isn't
3981 required, but some parts of YASQL will look and function better with this
3982 installed.
3984 =back
3986 =head1 CONFIG
3988 YASQL will look for a config file first in ~/.yasqlrc then
3989 /etc/yasql.conf. The following options are available:
3991 =over 4
3993 =item connection_timeout = <seconds>
3995 Timeout for connection attempts
3997 Default: 20
3999 =item max_connection_attempts = <num>
4001 The amount of times to attempt the connection if the username/password are wrong
4003 Default: 3
4005 =item history_file = <file>
4007 Where to save the history file. Shell metachars will be globbed (expanded)
4009 Default: ~/.yasql_history
4011 =item pager = <file>
4013 Your favorite pager for extended output. (right now only the help command)
4015 Default: /bin/more
4017 =item auto_commit = [0/1]
4019 Autocommit any updates/inserts etc
4021 Default: 0
4023 =item commit_on_exit = [0/1]
4025 Commit any pending transactions on exit. Errors or crashes will still cause
4026 the current transaction to rollback. But with this on a commit will occur
4027 when you explicitly exit.
4029 Default: 0
4031 =item long_trunc_ok = [0/1]
4033 Long truncation OK. If set to 1 then when a row contains a field that is
4034 set to a LONG time, such as BLOB, CLOB, etc will be truncated to long_read_len
4035 length. If 0, then the row will be skipped and not outputted.
4037 Default: 1
4039 =item long_read_len = <num_chars>
4041 Long Read Length. This is the length of characters to truncate to if
4042 long_trunc_ok is on
4044 Default: 80
4046 =item edit_history = [0/1]
4048 Whether or not to put the query edited from the 'edit' command into the
4049 command history.
4051 Default: 1
4053 =item auto_complete = [0/1]
4055 Whether or not to generate the autocompletion list on connection. If connecting
4056 to a large database (in number of tables/columns sense), the generation process
4057 could take a bit. For most databases it shouldn't take long at all though.
4059 Default: 1
4061 =item extended_complete_list = [0/1]
4063 extended complete list will cause the possible matches list to be filled by
4064 basicly any and all objects. With it off the tab list will be restricted to
4065 only tables, columns, and objects owned by the current user.
4067 Default: 0
4069 =item complete_tables = [0/1]
4071 This controls whether or not to add tables to the completion list. This does
4072 nothing if auto_complete is set to 0.
4074 Default: 1
4076 =item complete_columns = [0/1]
4078 This controls whether or not to add columns to the completion list. This does
4079 nothing if auto_complete is set to 0.
4081 Default: 1
4083 =item complete_objects = [0/1]
4085 This controls whether or not to add all other objects to the completion list.
4086 This does nothing if auto_complete is set to 0. (Hint... depending on your
4087 schema this will include tables and columns also, so you could turn the other
4088 two off)
4090 Default: 1
4092 =item extended_benchmarks = [0/1]
4094 Whether or not to include extended benchmarking info after queries. Will
4095 include both execution times and CPU loads for both the query and formatting
4096 parts of the process.
4098 Default: 0
4100 =item prompt
4102 A string to include in the prompt. The prompt will always be suffixed by a
4103 '>' string. Interpolated variables:
4104 %H = connected host. will be prefixed with a '@'
4105 %U = current user
4107 Default: %U%H
4109 =item column_wildcards = [0/1]
4111 Column wildcards is an extremely experimental feature that is still being
4112 hashed out due to the complex nature of it. This should affect only select
4113 statements and expands any wildcards (*) in the column list. such as
4114 'select col* from table;'.
4116 Default: 0
4118 =item sql_query_in_error = [0/1]
4120 This this on to output the query in the error message.
4122 Default: 0
4124 =item nls_date_format = <string>
4126 Set the preferred NLS_DATE_FORMAT. This effects both date input and output
4127 formats. The default is ISO standard (YYYY-MM-DD HH24:MI:SS', not oracle
4128 default (YYYY-MM-DD).
4130 Default: YYYY-MM-DD HH24:MI:SS
4132 =item fast_describe
4134 Turn on fast describes. These are much faster than the old style of desc
4135 <table>, however non-built in datatypes may not be returned properly. i.e. a
4136 FLOAT will be returned as a NUMBER type. Internally FLOATs really are just
4137 NUMBERs, but this might present problems for you. If so, set this to 0
4139 Default: 1
4141 =back
4143 =head1 ISSUES
4145 =over 4
4147 =item Oracle7
4149 DBD::Oracle for Oracle8 may have issues connecting to an Oracle7 database. The
4150 one problem I have seen is that the use of placeholders in a query will cause
4151 oracle to issue an error "ORA-01008: not all variables bound". This will affect
4152 all of the hard-coded queries that I use such as the ones for the 'desc' and
4153 'show' commands. The queries that you type in on the command line may still
4154 work. The DBD::Oracle README mentions the use of the '-8' option to the
4155 'perl Makefile.PL' command to use the older Oracle7 OCI. This has not been
4156 tested.
4158 =back
4160 =head1 AUTHOR
4162 Originaly written by Nathan Shafer (B<nshafer@ephibian.com>) with support from
4163 Ephibian, Inc. http://www.ephibian.com
4164 Now it is mostly developed and maintained by Balint Kozman
4165 (B<qzy@users.sourceforge.net>). http://www.imind.hu
4167 =head1 THANKS
4169 Thanks to everyone at Ephibian that helped with testing, and a special thanks
4170 to Tom Renfro at Ephibian who did a lot of testing and found quite a few
4171 doozies.
4172 Also a lot of thanks goes to the mates at iMind.dev who keep suffering from
4173 testing new features on them.
4175 The following people have also contributed to help make YASQL what it is:
4176 Allan Peda, Lance Klein, Scott Kister, Mark Dalphin, Matthew Walsh
4178 And always a big thanks to all those who report bugs and problems, especially
4179 on other platforms.
4181 =head1 COPYRIGHT
4183 Copyright (C) 2000-2002 Ephibian, Inc., 2005 iMind.dev.
4186 =head1 LICENSE
4188 This program is free software; you can redistribute it and/or
4189 modify it under the terms of the GNU General Public License
4190 as published by the Free Software Foundation; either version 2
4191 of the License, or (at your option) any later version.
4193 This program is distributed in the hope that it will be useful,
4194 but WITHOUT ANY WARRANTY; without even the implied warranty of
4195 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
4196 GNU General Public License for more details.
4198 You should have received a copy of the GNU General Public License
4199 along with this program; if not, write to the Free Software
4200 Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
4202 =head1 TODO
4204 =over 4
4206 =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
4208 =item allow history to be saved based on host (as an option)
4210 =item make stifle_history a configurable option
4212 =item a row is printed after "Attempting to cancel query"
4214 =item reading from a script will not change prompt properly (for a script with no terminator)
4216 =item NULL stops printing after table goes into overflow or something
4218 =item extra space in \G... maybe others
4220 =item bug: tag completion doesn't work with caps anymore
4222 =item Add support for /NOLOG
4224 =item allow dblinks in show blah on blah commands
4226 =item show query doesn't work with schemas and db links
4228 =item add save and get buffer commands
4230 =item add R[UN] command (/ equivilent)
4232 =item add support for just 'connect' and prompt for username and password
4234 =item add PASSW[ORD] command for changing password
4236 =item add -s[ilent] command line to suppress all startup output and command prompts
4238 =item add 'start' command for scripting
4240 =item add 'run' synonum for '/'
4242 =item add 'show parameters <filter>' support
4244 =item fix segfaults when cancelling large outputs
4246 =item Add a 'SPOOL' command
4248 =item fix 'set...' commands
4250 =item Add variable bindings, prompting, control structures, etc.
4252 =item be able to describe any kind of object
4254 =item Add 'startup queries' in config file or support glogin.sql and login.sql
4256 =item fix case sensitive object names
4258 =item make win32 compliant
4260 =item add better error messages when the user can't access a data dictionary
4261 table
4263 =item add better error output, with line/col numbers and maybe a pointer.
4265 =item add chained ops, exactly like bash
4267 =item add plugins and hooks for all aspects.
4269 =item Add smarter tables and wrapping in columns. Also add configurable max
4270 column widths and max table width.
4272 =item Add a curses interface option for easy viewing and scrolling, etc. This
4273 will require some research to determine if it's even worth it.
4275 =item Add HTML output option
4277 =back
4279 =head1 CHANGELOG
4281 $Log: yasql,v $
4282 Revision 1.83 2005/05/09 16:57:13 qzy
4283 Fixed the 'DECIMAL' problem with describe command.
4284 Added sql mode with \i (patch by Ed Avis).
4285 Added redirectors (>, >>, |) to describe.
4286 Added 'show user' command.
4287 Added 'show uid' command.
4288 Added new makefile targets: clean, check. (patch by Ed Avis)
4289 Added "and owner = ?" to some show targets (patch by anonymous).
4290 Added command_complete_list feature and config option.
4291 Added disconnect command
4292 Added command completion: select, update, insert, delete, execute, etc.
4293 Added table.column name completion.
4294 Added feature to run tty-less (patch by Michael Kroell).
4295 Added a workaround for SunOS's alarm() bug (patch by Ed Avis).
4296 Fixed some minor issues in parser code.
4298 Revision 1.82 2005/02/18 16:57:13 qzy
4299 Added batch mode (ewl patch).
4300 Allow connections AS SYSDBA, AS SYSOPER and internal (sysdba patch by Derek Whayman).
4301 Added server_output to config options.
4302 Changed script execution to only add script lines to the query buffer (and not to history).
4304 Revision 1.81 2002/03/06 21:55:13 nshafer
4305 Fixed bug with password prompt.
4306 Added 'show plan' for outputting last explain plan results.
4307 Added 'show query' for viewing queries for views and materialized views.
4308 Optimized describes to be as fast as describes in SQL*Plus.
4309 Added new option 'fast_describe' on by default for new describe method.
4310 Added single_output as a formatting option for internal use.
4311 Fixed problem with password, quit, exit, \q getting added to the history list.
4312 Changed history to not add duplicate entries right next to each other.
4313 Added support for basic (non-returning) PL/SQL commands.
4314 Added support for create function, package, package body, prodedure, trigger.
4315 Added 'show errors' command
4316 Added 'conn' shortcut for 'connection'.
4317 Added 'exec[ute]' command.
4318 Added 'set serverout[put] on|off' command to mimic SQL*Plus's.
4319 Added alarms to pings in cases where DB connection is dropped and ping hangs.
4320 Cleaned up error messages.
4321 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.
4322 Changed quote escaping to be '' and "" instead of \' and \".
4323 Added full support for comments: rem[ark], --, and /* */.
4324 Right-justify works for the '8' datatype as well as '3' now.
4325 Re-worked debug output levels.
4326 Optimized query for completion lists a bit.
4327 Added completion-list limiting based on location in some DML statements (select, update, insert).
4328 Fixed up the display of '...' when generating tab completion list. Should work a lot better when hitting tab in the middle of the line.
4329 Added show views, objects, sequences, clusters, dimensions, functions, procedures, packages, indexes, indextypes, libraries, materialized views, snapshots, synonyms, triggers.
4330 Added show all <objects> command.
4331 Added type and owner columns to show commands.
4332 Fixed commit_on_exit logic.
4333 Added ability to use external authentication ('yasql /').
4334 The .sql extension for the scripting and editing commands are now optional.
4335 Fixed up editor execution to hopefully find the editor better.
4336 Added "Command" entry to "show processes".
4337 Added "show waits" and "show all waits" commands.
4338 Re-organized command line usage in anticipation for script parameters.
4339 Removed all uses of 'stty'.
4340 Added processing of STDIN, so redirects and pipes to YASQL work now.
4341 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
4342 Updated documentation.
4343 Fixed up alarm() calls.
4344 Fixed setting of NLS_DATE_FORMAT to apply on reconnects.
4345 Broke commands into 2 sets... ones that exectute any time, and ones that execute only when nothing is in the buffer
4346 Fixed printing of text read in from an edit command. It now echoes all of it.
4347 Now ignoring most SET commands so we don't tack them onto queries
4348 Fixed permissions in tarball
4350 Revision 1.80 2001/08/01 18:06:27 nshafer
4351 Fixed bug with delayed $term initialization\e\b
4353 Revision 1.79 2001/08/01 17:52:35 nshafer
4354 Fixed compatibility issues with the data dictionary in Oracle 7. Fixed ordering
4355 of indexes for compound indexes. Fixed display of objects from other schemas
4356 in some data dictionary commands such as 'show indexes on table'. (Thanks Nix)
4357 Fixed matching of declare and end in query string. Will not only match if on
4358 blank line. Fixed matching of '/' terminator in middle of queries. Will now
4359 only match if at end of line (Thanks Wesley Hertlein). Temp file for editing
4360 now appends '.sql' to end of temp file so that editors, like vim, automatically
4361 turn on syntax highlighting. Added searching of environment variable SQLPATH
4362 when looking for scripts. Terminal setup is now after script parsing, so that
4363 it will work when run under cron (Thanks David Zverina).
4365 Revision 1.78 2001/07/05 13:52:56 nshafer
4366 Fixed bug where parens were matching improperly.
4368 Revision 1.77 2001/07/04 02:57:08 nshafer
4369 Fixed bug where terminators wouldn't match if they were the next character
4370 after a quote character.
4372 Revision 1.76 2001/06/28 04:17:53 nshafer
4373 Term::ReadLine::Perl now supported, for what little functionality it does
4374 provide. Fixed segfault when hitting up when history is empty. Fixed bug
4375 when providing script names on command line (Thanks to Dave Zverina.)
4376 Rewrote the query parser to fix a bug, caused by the multiple-queries-on-one-
4377 line feature, that causes terminators, such as ';' and '/' to match when in
4378 quotes. When hitting tab on a line starting with a '@' for scripts, tab will
4379 now complete filenames and not database objects. Fixed DB timeout when
4380 prompting for username and password. Added support for 'DECLARE' keyword,
4381 however this does not mean that variable binding in PL/SQL blocks works yet.
4382 Sped up startup time a bit more (hopefully).
4384 Revision 1.75 2001/06/19 16:02:16 nshafer
4385 Fixed typo in error message for Term::ReadLine::Gnu
4386 Fixed crash when tab hit at username or password prompt
4387 Added -- as a comment type and fixed case where comment in quotes would
4388 match. (Mark Dalphin)
4389 Fixed 'desc' to also describe partitioned tables (Erik)
4391 Revision 1.74 2001/06/18 21:07:55 nshafer
4392 Fixed bug where / would not rerun last query (thanks Scott Kister)
4394 Revision 1.73 2001/05/23 18:35:17 nshafer
4395 Got rid of "Prototype mismatch" errors. Fixed typo in extended benchmarks
4397 Revision 1.72 2001/05/22 16:06:36 nshafer
4398 Fixed bug with error messages not displaying first time, and fixed bug with
4399 tab completion output
4401 Revision 1.71 2001/05/17 21:28:40 nshafer
4402 New CSV output format. Added CSV file input on any query. Added ability to
4403 pipe query results to any program. Added ability for multiple queries on one
4404 line. Changed tab completion generator to run first time you hit tab instead
4405 of on startup, which speeds up database connection. Now using SelfLoader to
4406 speed up loading and minimize memory use. Added a 'show plan for ____' command
4407 for easy display of explain plan output. Query times are now more readable
4408 and will split into weeks, days, hours, minutes, and seconds. Hopefully fixed
4409 some problems with stty and Solaris 2.4. Added support for 'rem' comments in
4410 scripts. Redirection output files are now shell expanded.
4412 Revision 1.70 2001/05/08 17:49:51 nshafer
4413 Fixed all places where a non-alphanumeric object name would break or not
4414 match.
4415 Added code for autoconf style installs.
4417 Revision 1.69 2001/05/07 23:47:47 nshafer
4418 fixed type
4420 Revision 1.68 2001/05/07 22:26:20 nshafer
4421 Fixed tab completion problems when completing objects with a $ in their name.
4422 Added config options complete_tables, complete_columns, and complete_objects,
4423 Added redirection of query output to file. Hopefully sped up exiting.
4424 Updated documentation.
4426 Revision 1.67 2001/05/04 17:35:04 nshafer
4427 YASQL will now suspend properly back to the shell when SIGTSTP is sent, as in
4428 when you hit ctrl-z on most systems. Added NLS_DATE_FORMAT setting in config
4429 file to support alter date views. Defaults to ISO standard. YASQL will now
4430 attempt to change it's process name, such as when viewed in ps or top. This
4431 will not work on all systems, nor is it a complete bullet proof way to hide
4432 your password if you provide it on the command line. But it helps to not
4433 make it so obvious to regular users. Scripts entered on the command line are
4434 now checked to be readable before attempting connection. A failed 'connect
4435 command will no long alter the prompt. Added \p option for printing the
4436 current buffer, ala psql. Large query results (over 1000 rows) are now
4437 handled MUCH better. YASQL will no longer try to hold more than 1000 rows in
4438 memory, which keeps it from sucking memory, and also improves the speed.
4439 When a query does return more than 1000 rows in table mode, those first 1000
4440 will determine the column widths, and all rows after that will get truncated.
4441 AIX has been reported to run YASQL perfectly.
4443 Revision 1.66 2001/03/13 21:34:58 nshafer
4444 There are no longer any references to termcap, so yasql should now work on
4445 termcap-less systems such as Debian Linux and AIX
4447 Revision 1.65 2001/03/12 17:44:31 nshafer
4448 Restoring the terminal is hopefully more robust and better now. YASQL now
4449 tries to use the 'stty' program to dump the settings of the terminal on
4450 startup so that it can restore it back to those settings. It requires that
4451 stty is installed in the path, but that should be the case with most systems.
4452 Also made the output of the query in the error message an option that is off
4453 by default. I had never meant to include that in the final release, but kept
4454 on forgetting to take it out.
4456 Revision 1.64 2001/03/06 16:00:33 nshafer
4457 Fixed bug where desc would match anytime, even in middle of query, which is
4458 bad.
4460 Revision 1.63 2001/03/01 17:30:26 nshafer
4461 Refined the ctrl-c process for not-so-linuxy OS's, namely solaris. Now
4462 stripping out Dos carriage returns since SQL*Plus seems to.
4464 Revision 1.62 2001/02/26 22:39:12 nshafer
4465 Fixed bug where prompt would reset itself when a blank line was entered.
4466 Added script argument on command line (Lance Klein)
4467 Added support for any command line commands in the script (Lance Klein)
4468 The 'desc' and 'show' commands no longer require a terminator (like ;) as long as the whole statement is on one line (Lance Klein)
4469 Added option 'extended_tab_list' for a much bigger, more complete tab listing (Lance Klein)
4470 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.
4471 cleaned up documentation a bit
4473 Revision 1.61 2001/01/31 19:56:22 nshafer
4474 changed CommitOnExit to be 1 by default, to emulate SQL*Plus behavior, and
4475 at popular request
4477 Revision 1.60 2001/01/29 16:38:17 nshafer
4478 got rid of (tm)
4480 Revision 1.59 2001/01/29 16:28:22 nshafer
4481 Modified docs a little with the new scope of open source now in the mix.
4483 Revision 1.58 2001/01/24 15:27:00 nshafer
4484 cleanup_after_signals is not in the Term::ReadLine::Stub, so it would
4485 output error messages on systems without Term::ReadLine::Gnu. Fixed
4487 Revision 1.57 2001/01/17 23:26:53 nshafer
4488 Added Tom Renfro's column_wildcard expansion code. New conf variable:
4489 column_wildcards. 0 by default until this code is expanded on a bit more.
4491 Revision 1.56 2001/01/17 23:00:25 nshafer
4492 Added CommitOnExit config, 0 by default. Added info output at startup and
4493 when a new connection is initiated about the state of AutoCommit and
4494 CommitOnExit. Also added statement about explicit rollback or commit when
4495 disconnecting. Added warning message to commit_cmd and rollback_cmd if
4496 AutoCommit is on. Now explicitly committing or rolling back on disconnect,
4497 it is no longer left up to the DBI's discretion... except in abnormal
4498 termination.
4500 Revision 1.55 2001/01/11 18:05:12 nshafer
4501 Added trap for regex errors in tab completion (like if you put 'blah[' then
4502 hit tab)
4504 Revision 1.54 2001/01/10 17:07:22 nshafer
4505 added output to those last 2 commands
4507 Revision 1.53 2001/01/10 17:03:58 nshafer
4508 added commit and rollback commands so that you don't have to send them to the
4509 backend
4511 Revision 1.52 2001/01/10 16:00:08 nshafer
4512 fixed bug with prompt where on each call get_prompt would add another '@'.
4513 Thanks Tom
4515 Revision 1.51 2001/01/09 21:16:12 nshafer
4516 dar... fixed another bug where the %H would stay if there was no prompt_host
4518 Revision 1.50 2001/01/09 21:12:13 nshafer
4519 fixed bug with that last update. Now it only interpolates the %H variable
4520 if there is something to interpolate it with
4522 Revision 1.49 2001/01/09 21:09:56 nshafer
4523 changed the %H variable to be prefixed with a @
4525 Revision 1.48 2001/01/09 21:04:36 nshafer
4526 changed 'default' to '' for the prompt's hostname when no connect_string is
4527 used
4529 Revision 1.47 2001/01/09 20:55:11 nshafer
4530 added configurable prompt and changed the default prompt
4532 Revision 1.46 2001/01/09 18:50:50 nshafer
4533 updated todo list
4535 Revision 1.45 2001/01/09 18:32:35 nshafer
4536 Added 'connect <connect_string>' command. I may add the ability to specify
4537 options like on the command line (like '-H blah.com')
4539 Revision 1.44 2001/01/08 22:08:49 nshafer
4540 more documentation changes
4542 Revision 1.43 2001/01/08 20:51:31 nshafer
4543 added some documentation
4545 Revision 1.42 2001/01/08 20:09:35 nshafer
4546 Added debug and autocommit commands
4548 Revision 1.41 2001/01/08 18:12:43 nshafer
4549 added END handler to hopefully clean up the terminal better
4551 Revision 1.40 2001/01/05 23:29:38 nshafer
4552 new name!
4554 Revision 1.39 2001/01/05 18:00:16 nshafer
4555 Added config file options for auto completion generation and extended
4556 benchmark info
4558 Revision 1.38 2001/01/05 16:39:47 nshafer
4559 Fixed error where calling edit a second time would not open the file properly
4560 because of the way glob() works.
4562 Revision 1.37 2001/01/04 23:52:30 nshafer
4563 changed the version string to parse it out of the revision string (duh...)
4564 moved the prompting of username and password so that the check for the
4565 oracle_home variable happens before. Before if you didn't have the environment
4566 variable set then it will prompt you for username and password, then die
4567 with the error, which is annoying
4568 fixed the quit calls so taht they properly erase the quit line from the
4569 history. I had broken this a long time ago when I added the exit status
4570 param to the quit function
4571 Outputting in full table format (';' terminator) with a num_rows number
4572 (like ';100') would still cause the entire result set to be pulled into
4573 memory, which was really slow and could take a lot of memory if the table
4574 was large. Fixed it so that it only pulls in num_rows number of rows when
4575 using the digit option
4577 Revision 1.36 2000/12/22 22:12:18 nshafer
4578 fixed a wrong-quote-type in the debug messages
4580 Revision 1.35 2000/12/22 22:07:06 nshafer
4581 forgot version... you know the drill...
4583 Revision 1.34 2000/12/22 21:57:01 nshafer
4584 Added config file support, queries from the 'edit' command are now entered
4585 into the command history (configurable), cleaned up the SIGINT actions quite
4586 a bit so they should work better now, added LongReadLen and LongTruncOk
4587 options so that LONG columns types won't mess up, added the number after terminator
4588 feature to limit how many rows are returned.
4590 Revision 1.33 2000/12/20 22:56:03 nshafer
4591 version number.... again.... sigh
4593 Revision 1.32 2000/12/20 22:55:32 nshafer
4594 added todo item, now in rpms
4596 Revision 1.31 2000/12/20 17:07:52 nshafer
4597 added the reprompt for username/password on error 1005 null password given
4599 Revision 1.30 2000/12/20 17:04:18 nshafer
4600 Refined the shadow_redisplay stuff. Now I will only use my builtin function
4601 if the terminal type is set to "xterm" because that terminal type has a
4602 broken termcap entry. Also set it to not echo when entering password if
4603 Term::ReadLine::Gnu is not installed
4605 Revision 1.29 2000/12/20 15:47:56 nshafer
4606 trying a new scheme for the shadow_redisplay. Clear to EOL wasn't working
4607 Also fixed a few problems in the documentation
4610 Revision 1.28 2000/12/19 23:55:03 nshafer
4611 I need to stop forgetting the revision number...
4613 Revision 1.27 2000/12/19 23:48:49 nshafer
4614 cleaned up debugging
4616 Revision 1.26 2000/12/19 23:10:18 nshafer
4617 Lotsa new stuff... tab completion of table, column, and object names,
4618 improved signal handling, the edit command now accepts a filename parameter,
4619 new command 'show processes' which shows you info on who's connected,
4620 improved benchmark info, and a lot of other cleanup/tweaks
4622 Revision 1.25 2000/12/13 16:58:26 nshafer
4623 oops forgot documentation again
4625 Revision 1.24 2000/12/13 16:54:42 nshafer
4626 added desc <trigger>
4628 Revision 1.23 2000/12/12 17:52:15 nshafer
4629 updated todo list (oops, forgot)
4631 Revision 1.22 2000/12/12 17:51:39 nshafer
4632 added desc <index>
4634 Revision 1.21 2000/12/12 17:15:28 nshafer
4635 fixed bug when connecting using a host string (-H option)
4636 added a few more types to the 'show' and 'desc' commands
4638 Revision 1.20 2000/12/08 22:13:43 nshafer
4639 many little fixes and tweaks here and there
4641 Revision 1.19 2000/12/06 20:50:03 nshafer
4642 added scripting ability with "@<filename>" command
4643 changed all tabs to spaces!
4645 Revision 1.18 2000/12/06 19:30:38 nshafer
4646 added clear command
4647 refined connection process. if invalid username/password entered then prompt again
4649 Revision 1.17 2000/12/05 22:20:58 nshafer
4650 Tightened up outputs. Doesn't show column names if no rows selected, if
4651 it's not a select, then show number of rows affected
4653 Revision 1.16 2000/12/04 18:04:53 nshafer
4654 *** empty log message ***
4656 Revision 1.15 2000/12/04 18:03:14 nshafer
4657 fixed bug where the -H option was interpreted as -h or help. All command
4658 line options are now case sensitive
4660 Revision 1.14 2000/12/04 17:54:38 nshafer
4661 Added list command (and \l and l)
4663 Revision 1.13 2000/12/04 17:34:18 nshafer
4664 fixed a formatting issue if Time::HiRes isn't installed
4666 Revision 1.12 2000/12/04 17:29:41 nshafer
4667 Added benchmark options to view the extended benchmark info. Now it displays
4668 just the time in a more friendly format. The old style is only active if the
4669 benchmark option is specified.
4670 Cleaned up some formatting issues
4671 Brought the usage and POD documentation up to date
4672 Added some items to the TODO
4674 Revision 1.11 2000/11/30 22:54:38 nshafer
4675 Fixed bug with the edit command where if you were 'inquotes' then you would
4676 stay in quotes even after editing the file
4678 Revision 1.10 2000/11/30 22:01:38 nshafer
4679 Fixed bug where username and password were added to the command history.
4680 Set it so that the quit commands are not added to the command history either.
4681 Added the 'edit' command and modified it's todo list item, as well as added
4682 it to the 'help' command
4684 Revision 1.9 2000/11/29 17:55:35 nshafer
4685 changed version from .21 to 1.0 beta 9. I'll follow the revision numbers now
4687 Revision 1.8 2000/11/29 17:46:31 nshafer
4688 added a few items to the todo list
4690 Revision 1.7 2000/11/29 15:50:56 nshafer
4691 got rid of SID output at startup
4693 Revision 1.6 2000/11/29 15:49:51 nshafer
4694 moved revision info to $revision and added Id output
4696 Revision 1.5 2000/11/29 15:46:41 nshafer
4697 fixed revision number
4699 Revision 1.4 2000/11/29 15:44:23 nshafer
4700 fixed issue where environment variable ORACLE_SID overwrote explicit set
4701 on the command line. now whatever you put on the command line will overwrite
4702 the environment variable
4704 =cut