don't start CSV files with newline
[yasql.git] / yasql.in
blob960d1b13f2684efb07e389de070492b4b3ccf663
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 $VERSION = 'unknown';
121 sub argv_sort {
122 if($a =~ /^\@/ && $b !~ /^\@/) {
123 return 1;
124 } elsif($a !~ /^\@/ && $b =~ /^\@/) {
125 return -1;
126 } else {
127 return 0;
131 sub sighandle {
132 my($sig) = @_;
133 debugmsg(3, "sighandle called", @_);
135 $SIG{$sig} = \&sighandle;
137 if($sig =~ /INT|TERM|TSTP/) {
138 if($quitting) {
139 # then we've already started quitting and so we just try to force exit
140 # without the graceful quit
141 print STDERR "Attempting to force exit...\n";
142 exit();
145 if($sigintcaught) {
146 # the user has alrady hit INT and so we now force an exit
147 print STDERR "Caught another SIG$sig\n";
148 quit(undef, 1);
149 } else {
150 $sigintcaught = 1;
153 if($running_query) {
154 if(defined $cursth) {
155 print STDERR "Attempting to cancel query...\n";
156 debugmsg(1, "canceling statement handle");
157 my $ret = $cursth->cancel();
158 $cursth->finish;
160 } elsif(!$connected) {
161 quit();
163 if(defined $cursth) {
164 print STDERR "Attempting to cancel query...\n";
165 debugmsg(1, "canceling statement handle");
166 my $ret = $cursth->cancel();
167 $cursth->finish;
171 } elsif($sig eq 'ALRM') {
173 if(defined $dbh) {
174 wrn("Connection lost (timeout: $conf{connection_timeout})");
175 quit(1);
176 } else {
177 lerr("Could not connect to database, timed out. (timeout: "
178 ."$conf{connection_timeout})");
183 sub END {
184 debugmsg(3, "END called", @_);
186 # save the history buffer
187 if($term_type && $term_type eq 'gnu' && $term->history_total_bytes()) {
188 debugmsg(1, "Writing history");
189 unless($term->WriteHistory($conf{history_file})) {
190 wrn("Could not write history file to $conf{history_file}. "
191 ."History not saved");
196 ################################################################################
197 ########### self-loaded functions ##############################################
199 #__DATA__
201 sub init {
202 # call GetOptions to parse the command line
203 my $opt_help;
204 Getopt::Long::Configure( qw(permute) );
205 $Getopt::Long::ignorecase = 0;
206 usage(1) unless GetOptions(
207 "debug|d:i" => \$opt_debug,
208 "host|H=s" => \$opt_host,
209 "port|p=s" => \$opt_port,
210 "sid|s=s" => \$opt_sid,
211 "help|h|?" => \$opt_help,
212 "nocomp|A" => \$opt_nocomp,
213 "bench|benchmark|b" => \$opt_bench,
214 "version|V" => \$opt_version,
215 "batch|B" => \$opt_batch,
216 "interactive|I" => \$opt_notbatch,
219 # set opt_debug to 1 if it's defined, which means the user just put -d or
220 # --debug without an integer argument
221 $opt_debug = 1 if !$opt_debug && defined $opt_debug;
223 $opt_batch = 0 if $opt_notbatch;
225 $opt_batch = 1 unless defined $opt_batch || -t STDIN;
227 debugmsg(3, "init called", @_);
228 # This reads the command line then initializes the DBI and Term::ReadLine
229 # packages
231 $sigintcaught = 0;
232 $completion_built = 0;
234 usage(0) if $opt_help;
236 # Output startup string
237 if(!$opt_batch) {
238 print STDERR "\n";
239 print STDERR "YASQL version $VERSION Copyright (c) 2000-2001 Ephibian, Inc, 2005 iMind.dev.\n";
240 print STDERR '$Id: yasql,v 1.83 2005/05/09 02:07:13 qzy Exp qzy $' . "\n";
243 if($opt_version) {
244 print STDERR "\n";
245 exit(0);
248 if(!$opt_batch) {
249 print STDERR "Please type 'help' for usage instructions\n";
250 print STDERR "\n";
253 # parse the config files. We first look for ~/.yasqlrc, then
254 # /etc/yasql.conf
255 # first set up the defaults
256 %conf = (
257 connection_timeout => 20,
258 max_connection_attempts => 3,
259 history_file => '~/.yasql_history',
260 pager => '/bin/more',
261 auto_commit => 0,
262 commit_on_exit => 1,
263 long_trunc_ok => 1,
264 long_read_len => 80,
265 edit_history => 1,
266 auto_complete => 1,
267 extended_benchmarks => 0,
268 prompt => '%U%H',
269 column_wildcards => 0,
270 extended_complete_list => 0,
271 command_complete_list => 1,
272 sql_query_in_error => 0,
273 nls_date_format => 'YYYY-MM-DD HH24:MI:SS',
274 complete_tables => 1,
275 complete_columns => 1,
276 complete_objects => 1,
277 fast_describe => 1,
278 server_output => 2000,
281 my $config_file;
282 if( -e $ENV{YASQLCONF} ) {
283 $config_file = $ENV{YASQLCONF};
284 } elsif(-e "$ENV{HOME}/.yasqlrc") {
285 $config_file = "$ENV{HOME}/.yasqlrc";
286 } elsif(-e $sysconf) {
287 $config_file = $sysconf;
290 if($config_file) {
291 debugmsg(2, "Reading config: $config_file");
292 open(CONFIG, "$config_file");
293 while(<CONFIG>) {
294 chomp;
295 s/#.*//;
296 s/^\s+//;
297 s/\s+$//;
298 next unless length;
299 my($var, $value) = split(/\s*=\s*/, $_, 2);
300 $var = 'auto_commit' if $var eq 'AutoCommit';
301 $var = 'commit_on_exit' if $var eq 'CommitOnExit';
302 $var = 'long_trunc_ok' if $var eq 'LongTruncOk';
303 $var = 'long_read_len' if $var eq 'LongReadLen';
304 $conf{$var} = $value;
305 debugmsg(3, "Setting option [$var] to [$value]");
309 if (($conf{server_output} > 0) && ($conf{server_output} < 2000)) {
310 $conf{server_output} = 2000;
312 if ($conf{server_output} > 1000000) {
313 $conf{server_output} = 1000000;
316 ($conf{history_file}) = glob($conf{history_file});
318 debugmsg(3,"Conf: [" . Dumper(\%conf) . "]");
320 # Create a Text::CSV object
321 unless($notextcsv) {
322 $csv = new Text::CSV_XS( { binary => 1 } );
325 # Change the process name to just 'yasql' to somewhat help with security.
326 # This is not bullet proof, nor is it supported on all platforms. Those that
327 # don't support this will just fail silently.
328 debugmsg(2, "Process name: $0");
329 $0 = 'yasql';
331 # Parse the SQLPATH environment variable if it exists
332 if($ENV{SQLPATH}) {
333 @sqlpath = split(/;/, $ENV{SQLPATH});
336 # If the user set the SID on the command line, we'll overwrite the
337 # environment variable so that DBI sees it.
338 #print "Using SID $opt_sid\n" if $opt_sid;
339 $ENV{ORACLE_SID} = $opt_sid if $opt_sid;
341 # output info about the options given
342 print STDERR "Debugging is on\n" if $opt_debug;
343 DBI->trace(1) if $opt_debug > 3;
345 # Extending on from Oracle's conventions, try and obtain an early indication
346 # of ora_session_mode from AS SYSOPER, AS SYSDBA options. Be flexible :-)
347 my $ora_session_mode = 0;
348 my $osmp = '';
349 if (lc($ARGV[-2]) eq 'as') {
350 $ora_session_mode = 2 if lc($ARGV[-1]) eq 'sysdba';
351 $ora_session_mode = 4 if lc($ARGV[-1]) eq 'sysoper';
352 pop @ARGV;
353 pop @ARGV;
354 } elsif (lc($ARGV[1]) eq 'as') {
355 $ora_session_mode = 2 if lc($ARGV[2]) eq 'sysdba';
356 $ora_session_mode = 4 if lc($ARGV[2]) eq 'sysoper';
357 @ARGV = ($ARGV[0], @ARGV[3..$#ARGV]);
360 # set up DBI
361 if(@ARGV == 0) {
362 # nothing was provided
363 debugmsg(2, "No command line args were found");
364 $dbh = db_connect(1, $ora_session_mode);
365 } else {
366 debugmsg(2, "command line args found!");
367 debugmsg(2, @ARGV);
368 # an argument was given!
370 my $script = 0;
371 if(substr($ARGV[0], 0, 1) eq '@') {
372 # no logon string was given, must be a script
373 debugmsg(2, "Found: no logon, script name");
374 my($script_name, @script_params) = @ARGV;
375 $script = 1;
377 $dbh = db_connect(1, $ora_session_mode);
379 run_script($script_name);
380 } elsif(substr($ARGV[0], 0, 1) ne '@' && substr($ARGV[1], 0, 1) eq '@') {
381 # A logon string was given as well as a script file
382 debugmsg(2, "Found: login string, script name");
383 my($logon_string, $script_name, @script_params) = @ARGV;
384 $script = 1;
386 my($ora_session_mode2, $username, $password, $connect_string)
387 = parse_logon_string($logon_string);
388 $ora_session_mode = $ora_session_mode2 if $ora_session_mode2;
389 $dbh = db_connect(1, $ora_session_mode, $username, $password, $connect_string);
391 run_script($script_name);
392 } elsif(@ARGV == 1 && substr($ARGV[0], 0, 1) ne '@') {
393 # only a logon string was given
394 debugmsg(2, "Found: login string, no script name");
395 my($logon_string) = @ARGV;
397 my($ora_session_mode2, $username, $password, $connect_string)
398 = parse_logon_string($logon_string);
399 $ora_session_mode = $ora_session_mode2 if $ora_session_mode2;
400 $dbh = db_connect(1, $ora_session_mode, $username, $password, $connect_string);
401 } else {
402 usage(1);
405 if ($conf{server_output} > 0) {
406 $dbh->func( $conf{server_output}, 'dbms_output_enable' );
407 $set{serveroutput} = 1;
410 # Quit if one or more scripts were given on the command-line
411 quit(0) if $script;
414 if (!$opt_batch) {
415 setup_term() unless $term;
418 # set up the pager
419 $conf{pager} = $ENV{PAGER} if $ENV{PAGER};
422 sub setup_term {
423 # set up the Term::ReadLine
424 $term = new Term::ReadLine('YASQL');
425 $term->ornaments(0);
426 $term->MinLine(0);
428 debugmsg(1, "Using " . $term->ReadLine());
430 if($term->ReadLine eq 'Term::ReadLine::Gnu') {
431 # Term::ReadLine::Gnu specific setup
432 $term_type = 'gnu';
434 $attribs = $term->Attribs();
435 $features = $term->Features();
437 $term->stifle_history(500);
438 if($opt_debug >= 4) {
439 foreach(sort keys(%$attribs)) {
440 debugmsg(4,"[term-attrib] $_: $attribs->{$_}");
442 foreach(sort keys(%$features)) {
443 debugmsg(4,"[term-feature] $_: $features->{$_}");
447 # read in the ~/.yasql_history file
448 if(-e $conf{history_file}) {
449 unless($term->ReadHistory($conf{history_file})) {
450 wrn("Could not read $conf{history_file}. History not restored");
452 } else {
453 print STDERR "Creating $conf{history_file} to store your command line history\n";
454 open(HISTORY, ">$conf{history_file}")
455 or wrn("Could not create $conf{history_file}: $!");
456 close(HISTORY);
459 $last_history = $term->history_get($term->{history_length});
461 $attribs->{completion_entry_function} = \&complete_entry_function;
462 my $completer_word_break_characters
463 = $attribs->{completer_word_break_characters};
464 $completer_word_break_characters =~ s/[a-zA-Z0-9_\$\#]//g;
465 $attribs->{completer_word_break_characters}
466 = $completer_word_break_characters;
467 #$attribs->{catch_signals} = 0;
468 } elsif($term->ReadLine eq 'Term::ReadLine::Perl') {
469 # Term::ReadLine::Perl specific setup
470 $term_type = 'perl';
471 if($opt_debug >= 4) {
472 foreach(sort keys(%{$term->Features()})) {
473 debugmsg(4,"[term-feature] $_: $attribs->{$_}");
479 if ($term->ReadLine eq 'Term::ReadLine::Stub') {
480 wrn("Neither Term::ReadLine::Gnu or Term::ReadLine::Perl are installed.\n"
481 . "Please install from CPAN for advanced functionality. Until then "
482 . "YASQL will run\ncrippled. (like possibly not having command history "
483 . "or line editing...\n");
487 sub parse_logon_string {
488 debugmsg(3, "parse_logon_string called", @_);
490 my($arg) = @_;
491 my($ora_session_mode, $username, $password, $connect_string);
493 # strip off AS SYSDBA / AS SYSOPER first
494 if($arg =~ /^(.*)\s+as\s+sys(\w+)\s*$/i) {
495 $ora_session_mode = 2 if lc($2) eq 'dba';
496 $ora_session_mode = 4 if lc($2) eq 'oper';
497 $arg = $1 if $ora_session_mode;
498 $ora_session_mode = 0 unless $ora_session_mode;
500 if($arg =~ /^\/$/) {
501 $username = '';
502 $password = '';
503 $connect_string = 'external';
504 return($ora_session_mode, $username, $password, $connect_string);
505 } elsif($arg eq 'internal') {
506 $username = '';
507 $password = '';
508 $connect_string = 'external';
509 $ora_session_mode = 2;
510 return($ora_session_mode, $username, $password, $connect_string);
511 } elsif($arg =~ /^([^\/]+)\/([^\@]+)\@(.*)$/) {
512 #username/password@connect_string
513 $username = $1;
514 $password = $2;
515 $connect_string = $3;
516 return($ora_session_mode, $username, $password, $connect_string);
517 } elsif($arg =~ /^([^\@]+)\@(.*)$/) {
518 # username@connect_string
519 $username = $1;
520 $password = '';
521 $connect_string = $2;
522 return($ora_session_mode, $username, $password, $connect_string);
523 } elsif($arg =~ /^([^\/]+)\/([^\@]+)$/) {
524 # username/password
525 $username = $1;
526 $password = $2;
527 $connect_string = '';
528 return($ora_session_mode, $username, $password, $connect_string);
529 } elsif($arg =~ /^([^\/\@]+)$/) {
530 # username
531 $username = $1;
532 $password = $2;
533 $connect_string = '';
534 return($ora_session_mode, $username, $password, $connect_string);
535 } elsif($arg =~ /^\@(.*)$/) {
536 # @connect_string
537 $username = '';
538 $password = '';
539 $connect_string = $1;
540 return($ora_session_mode, $username, $password, $connect_string);
541 } else {
542 return(undef,undef,undef,undef);
546 sub populate_completion_list {
547 my($inline_print, $current_table_name) = @_;
548 debugmsg(3, "populate_completion_list called", @_);
550 # grab all the table and column names and put them in @completion_list
552 if($inline_print) {
553 $| = 1;
554 print STDERR "...";
555 } else {
556 print STDERR "Generating auto-complete list...\n";
559 if($conf{extended_complete_list}) {
560 my @queries;
561 if($conf{complete_tables}) {
562 push(@queries, 'select table_name x from all_tables union select view_name x from all_views');
564 if($conf{complete_columns}) {
565 push(@queries, 'select column_name from all_tab_columns');
567 if($conf{complete_objects}) {
568 push(@queries, 'select object_name from all_objects');
571 my $sqlstr = join(' union ', @queries);
572 debugmsg(3, "query: [$sqlstr]");
574 my $sth = $dbh->prepare($sqlstr)
575 or query_err('prepare', $DBI::errstr, $sqlstr), setup_sigs(), return(0);
576 $sth->execute()
577 or query_err('execute', $DBI::errstr, $sqlstr), setup_sigs(), return(0);
578 while(my $res = $sth->fetchrow_array()) {
579 push(@completion_list, $res);
581 } else {
582 my @queries;
583 if($conf{complete_tables}) {
584 push(@queries, "select 'table-' || table_name x from user_tables union select 'table-' || view_name x from user_views");
586 if($conf{complete_columns}) {
587 push(@queries, "select 'column-' || column_name from user_tab_columns");
589 if($conf{complete_objects}) {
590 push(@queries, "select 'object-' || object_name from user_objects");
593 my $sqlstr = join(' union ', @queries);
594 debugmsg(3, "query: [$sqlstr]");
596 my $sth = $dbh->prepare($sqlstr)
597 or query_err('prepare', $DBI::errstr, $sqlstr), setup_sigs(), return(0);
598 $sth->execute()
599 or query_err('execute', $DBI::errstr, $sqlstr), setup_sigs(), return(0);
600 while(my $res = $sth->fetchrow_array()) {
601 push(@completion_list, $res);
605 if ($conf{command_complete_list}) {
606 push(@completion_list, "command-create", "command-select", "command-insert", "command-update", "command-delete from", "command-from", "command-execute", "command-show", "command-describe", "command-drop");
607 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");
610 if ($current_table_name) {
612 my @queries;
613 push(@queries, "select 'current_column-$current_table_name.' || column_name from user_tab_columns where table_name=\'".uc($current_table_name)."\'");
615 my $sqlstr = join(' union ', @queries);
616 debugmsg(3, "query: [$sqlstr]");
618 my $sth = $dbh->prepare($sqlstr)
619 or query_err('prepare', $DBI::errstr, $sqlstr), setup_sigs(), return(0);
620 $sth->execute()
621 or query_err('execute', $DBI::errstr, $sqlstr), setup_sigs(), return(0);
622 while(my $res = $sth->fetchrow_array()) {
623 push(@completion_list, $res);
627 setup_sigs();
629 if($inline_print) {
630 print "\r";
631 print "\e[K";
632 $| = 0;
633 $term->forced_update_display();
637 sub complete_entry_function {
638 my($word, $state) = @_;
639 debugmsg(3, "complete_entry_function called", @_);
640 # This is called by Term::ReadLine::Gnu when a list of matches needs to
641 # be generated. It takes a string that is the word to be completed and
642 # a state number, which should increment every time it's called.
644 return unless $connected;
646 my $line_buffer = $attribs->{line_buffer};
647 debugmsg(4, "line_buffer: [$line_buffer]");
649 if($line_buffer =~ /^\s*\@/) {
650 return($term->filename_completion_function(@_));
653 unless($completion_built) {
654 unless($opt_nocomp || !$conf{auto_complete}) {
655 populate_completion_list(1);
657 $completion_built = 1;
660 if($state == 0) {
661 # compute all the possibilies and put them in @completion_possibles
662 @completion_possibles = ();
663 my $last_char = substr($word,length($word)-1,1);
665 debugmsg(2,"last_char: [$last_char]");
667 my @grep = ();
668 if ($line_buffer =~ /select(?!.*(?:from|where))[\s\w\$\#_,]*\.[\w_]*$/) {
669 # This case is for "select mytable.mycolumn" type lines
670 my $current_table_name = $line_buffer;
671 $current_table_name =~ s/(select.*)(\s)([\w_]+)(\.)([\w_]*)$/$3/;
672 debugmsg(3, "current table name: $current_table_name");
674 unless($opt_nocomp || !$conf{auto_complete}) {
675 populate_completion_list(1, $current_table_name);
678 debugmsg(4, "select table.column");
680 push(@grep, '^current_column-');
681 } elsif($line_buffer =~ /select(?!.*(?:from|where))[\s\w\$\#_,]+$/) {
682 debugmsg(4, "select ...");
683 push(@grep, '^column-', '^table-');
684 } elsif($line_buffer =~ /from(?!.*where)[\s\w\$\#_,]*$/) {
685 debugmsg(4, "from ...");
686 push(@grep, '^table-');
687 } elsif($line_buffer =~ /where[\s\w\$\#_,]*$/) {
688 debugmsg(4, "where ...");
689 push(@grep, '^column-');
690 } elsif($line_buffer =~ /update(?!.*set)[\s\w\$\#_,]*$/) {
691 debugmsg(4, "where ...");
692 push(@grep, '^table-');
693 } elsif($line_buffer =~ /set[\s\w\$\#_,]*$/) {
694 debugmsg(4, "where ...");
695 push(@grep, '^column-');
696 } elsif($line_buffer =~ /insert.*into(?!.*values)[\s\w\$\#_,]*$/) {
697 debugmsg(4, "where ...");
698 push(@grep, '^table-');
699 } elsif($line_buffer =~ /^\s*show\s\w*/) {
700 push(@grep, 'show-');
701 } else {
702 push(@grep, '');
704 debugmsg(2,"grep: [@grep]");
706 my $use_lower;
707 if($last_char =~ /^[A-Z]$/) {
708 $use_lower = 0;
709 } else {
710 $use_lower = 1;
712 foreach my $grep (@grep) {
713 foreach my $list_item (grep(/$grep/, @completion_list)) {
714 my $item = $list_item;
715 $item =~ s/^\w*-//;
716 eval { #Trap errors
717 if($item =~ /^\Q$word\E/i) {
718 push(@completion_possibles,
719 ($use_lower ? lc($item) : uc($item))
723 debugmsg(2, "Trapped error in complete_entry_function eval: $@") if $@;
726 debugmsg(3,"possibles: [@completion_possibles]");
729 # return the '$state'th element of the possibles
730 return($completion_possibles[$state] || undef);
733 sub db_reconnect {
734 debugmsg(3, "db_reconnect called", @_);
735 # This first disconnects the database, then tries to reconnect
737 print "Reconnecting...\n";
739 commit_on_exit();
741 if (defined $dbh) {
742 if (not $dbh->disconnect()) {
743 warn "Disconnect failed: $DBI::errstr\n";
744 return;
748 $dbh = db_connect(1, @dbparams);
751 sub db_connect {
752 my($die_on_error, $ora_session_mode, $username, $password, $connect_string) = @_;
753 debugmsg(3, "db_connect called", @_);
754 # Tries to connect to the database, prompting for username and password
755 # if not given. There are several cases that can happen:
756 # connect_string is present:
757 # ORACLE_HOME has to exist and the driver tries to make a connection to
758 # given connect_string.
759 # connect_string is not present:
760 # $opt_host is set:
761 # Connect to $opt_host on $opt_sid. Specify port only if $opt_port is
762 # set
763 # $opt_host is not set:
764 # Try to make connection to the default database by not specifying any
765 # host or connect string
767 my($dbhandle, $dberr, $dberrstr, $this_prompt_host, $this_prompt_user);
769 debugmsg(1,"ora_session_mode: [$ora_session_mode] username: [$username] password: [$password] connect_string: [$connect_string]");
771 # The first thing we're going to check is that the Oracle DBD is available
772 # since it's a sorta required element =)
773 my @drivers = DBI->available_drivers();
774 my $found = 0;
775 foreach(@drivers) {
776 if($_ eq "Oracle") {
777 $found = 1;
780 unless($found) {
781 lerr("Could not find DBD::Oracle... please install. Available drivers: "
782 .join(", ", @drivers) . ".\n");
784 #print "drivers: [" . join("|", @drivers) . "]\n";
786 # Now we can attempt a connection to the database
787 my $attributes = {
788 RaiseError => 0,
789 PrintError => 0,
790 AutoCommit => $conf{auto_commit},
791 LongReadLen => $conf{long_read_len},
792 LongTruncOk => $conf{long_trunc_ok},
793 ora_session_mode => $ora_session_mode
796 if($connect_string eq 'external') {
797 # the user wants to connect with external authentication
799 check_oracle_home();
801 # install alarm signal handle
802 $SIG{ALRM} = \&sighandle;
803 alarm($conf{connection_timeout});
805 if(!$opt_batch) {
806 print "Attempting connection to local database\n";
808 $dbhandle = DBI->connect('dbi:Oracle:',undef,undef,$attributes)
809 or do {
810 $dberr = $DBI::err;
811 $dberrstr = $DBI::errstr;
814 $this_prompt_host = $ENV{ORACLE_SID};
815 $this_prompt_user = $ENV{LOGNAME};
816 alarm(0); # cancel alarm
817 } elsif($connect_string) {
818 # We were provided with a connect string, so we can use the TNS method
820 check_oracle_home();
821 ($ora_session_mode, $username, $password) = get_up($ora_session_mode, $username, $password);
822 $attributes->{ora_session_mode} = $ora_session_mode if $ora_session_mode;
824 my $userstring;
825 if($username) {
826 $userstring = $username . '@' . $connect_string;
827 } else {
828 $userstring = $connect_string;
831 # install alarm signal handle
832 $SIG{ALRM} = \&sighandle;
833 alarm($conf{connection_timeout});
835 if(!$opt_batch) {
836 print "Attempting connection to $userstring\n";
838 $dbhandle = DBI->connect('dbi:Oracle:',$userstring,$password,$attributes)
839 or do {
840 $dberr = $DBI::err;
841 $dberrstr = $DBI::errstr;
844 $this_prompt_host = $connect_string;
845 $this_prompt_user = $username;
846 alarm(0); # cancel alarm
847 } elsif($opt_host) {
848 # attempt a connection to $opt_host
849 my $dsn;
850 $dsn = "host=$opt_host";
851 $dsn .= ";sid=$opt_sid" if $opt_sid;
852 $dsn .= ";port=$opt_port" if $opt_port;
854 ($ora_session_mode, $username, $password) = get_up($ora_session_mode, $username, $password);
855 $attributes->{ora_session_mode} = $ora_session_mode if $ora_session_mode;
857 # install alarm signal handle
858 $SIG{ALRM} = \&sighandle;
859 alarm($conf{connection_timeout});
861 print "Attempting connection to $opt_host\n";
862 debugmsg(1,"dsn: [$dsn]");
863 $dbhandle = DBI->connect("dbi:Oracle:$dsn",$username,$password,
864 $attributes)
865 or do {
866 $dberr = $DBI::err;
867 $dberrstr = $DBI::errstr;
870 $this_prompt_host = $opt_host;
871 $this_prompt_host = "$opt_sid!" . $this_prompt_host if $opt_sid;
872 $this_prompt_user = $username;
873 alarm(0); # cancel alarm
874 } else {
875 # attempt a connection without specifying a hostname or anything
877 check_oracle_home();
878 ($ora_session_mode, $username, $password) = get_up($ora_session_mode, $username, $password);
879 $attributes->{ora_session_mode} = $ora_session_mode if $ora_session_mode;
881 # install alarm signal handle
882 $SIG{ALRM} = \&sighandle;
883 alarm($conf{connection_timeout});
885 print "Attempting connection to local database\n";
886 $dbhandle = DBI->connect('dbi:Oracle:',$username,$password,$attributes)
887 or do {
888 $dberr = $DBI::err;
889 $dberrstr = $DBI::errstr;
892 $this_prompt_host = $ENV{ORACLE_SID};
893 $this_prompt_user = $username;
894 alarm(0); # cancel alarm
897 if($dbhandle) {
898 # Save the parameters for reconnecting
899 @dbparams = ($ora_session_mode, $username, $password, $connect_string);
901 # set the $dbuser global for use elsewhere
902 $dbuser = $username;
903 $num_connects = 0;
904 $prompt{host} = $this_prompt_host;
905 $prompt{user} = $this_prompt_user;
907 # Get the version banner
908 debugmsg(2,"Fetching version banner");
909 my $banner = $dbhandle->selectrow_array(
910 "select banner from v\$version where banner like 'Oracle%'");
911 if(!$opt_batch) {
912 if($banner) {
913 print "Connected to: $banner\n\n";
914 } else {
915 print "Connection successful!\n";
919 if($banner =~ / (\d+)\.(\d+)\.([\d\.]+)/) {
920 my ($major, $minor, $other) = ($1, $2, $3);
921 $dbversion = $major || 8;
924 # Issue a warning about autocommit. It's nice to know...
925 print STDERR "auto_commit is " . ($conf{auto_commit} ? "ON" : "OFF")
926 . ", commit_on_exit is " . ($conf{commit_on_exit} ? "ON" : "OFF")
927 . "\n" unless $opt_batch;
928 } elsif( ($dberr eq '1017' || $dberr eq '1005')
929 && ++$num_connects < $conf{max_connection_attempts}) {
930 $dberrstr =~ s/ \(DBD ERROR: OCISessionBegin\).*//;
931 print "Error: $dberrstr\n\n";
932 #@dbparams = (0,undef,undef,$connect_string);
933 $connect_string = '' if $connect_string eq 'external';
934 $dbhandle = db_connect($die_on_error,$ora_session_mode,undef,undef,$connect_string);
935 } elsif($die_on_error) {
936 lerr("Could not connect to database: $dberrstr [$dberr]");
937 } else {
938 wrn("Could not connect to database: $dberrstr [$dberr]");
939 return(0);
942 # set the NLS_DATE_FORMAT
943 if($conf{nls_date_format}) {
944 debugmsg(2, "setting NLS_DATE_FORMAT to $conf{nls_date_format}");
945 my $sqlstr = "alter session set nls_date_format = '"
946 . $conf{nls_date_format} . "'";
947 $dbhandle->do($sqlstr) or query_err('do', $DBI::errstr, $sqlstr);
950 $connected = 1;
951 return($dbhandle);
954 sub get_prompt {
955 my($prompt_string) = @_;
956 debugmsg(3, "get_prompt called", @_);
957 # This returns a prompt. It can be passed a string which will
958 # be manually put into the prompt. It will be padded on the left with
959 # white space
961 $prompt_length ||= 5; #just in case normal prompt hasn't been outputted
962 debugmsg(2, "prompt_length: [$prompt_length]");
964 if($prompt_string) {
965 my $temp_prompt = sprintf('%' . $prompt_length . 's', $prompt_string . '> ');
966 return($temp_prompt);
967 } else {
968 my $temp_prompt = $conf{prompt} . '> ';
969 my $temp_prompt_host = '@' . $prompt{host} if $prompt{host};
970 $temp_prompt =~ s/\%H/$temp_prompt_host/g;
971 $temp_prompt =~ s/\%U/$prompt{user}/g;
973 $prompt_length = length($temp_prompt);
974 return($temp_prompt);
978 sub get_up {
979 my($ora_session_mode, $username, $password) = @_;
980 debugmsg(3, "get_up called", @_);
982 if(!$opt_batch) {
984 setup_term() unless $term;
986 # Get username/password
987 unless($username) {
988 # prompt for the username
989 $username = $term->readline('Username: ');
990 if($username =~ /^(.*)\s+as\s+sys(\w+)\s*$/i) {
991 $ora_session_mode = 2 if lc($2) eq 'dba';
992 $ora_session_mode = 4 if lc($2) eq 'oper';
993 $username = $1;
996 # Take that entry off of the history list
997 if ($term_type eq 'gnu') {
998 $term->remove_history($term->where_history());
1002 unless($password) {
1003 # prompt for the password, and disable echo
1004 my $orig_redisplay = $attribs->{redisplay_function};
1005 $attribs->{redisplay_function} = \&shadow_redisplay;
1007 $password = $term->readline('Password: ');
1009 $attribs->{redisplay_function} = $orig_redisplay;
1011 # Take that entry off of the history list
1012 if ($term->ReadLine eq "Term::ReadLine::Gnu") {
1013 $term->remove_history($term->where_history());
1018 return($ora_session_mode, $username, $password);
1022 sub check_oracle_home {
1023 # This checks for the ORACLE_HOME environment variable and dies if it's
1024 # not set
1025 lerr("Please set your ORACLE_HOME environment variable!")
1026 unless $ENV{ORACLE_HOME};
1027 return(1);
1030 sub shadow_redisplay {
1031 # The one provided in Term::ReadLine::Gnu was broken
1032 # debugmsg(2, "shadow_redisplay called", @_);
1033 my $OUT = $attribs->{outstream};
1034 my $oldfh = select($OUT); $| = 1; select($oldfh);
1035 print $OUT ("\r", $attribs->{prompt});
1036 $oldfh = select($OUT); $| = 0; select($oldfh);
1039 sub print_non_print {
1040 my($string) = @_;
1042 my @string = unpack("C*", $string);
1043 my $ret_string;
1044 foreach(@string) {
1045 if($_ >= 40 && $_ <= 176) {
1046 $ret_string .= chr($_);
1047 } else {
1048 $ret_string .= "<$_>";
1051 return($ret_string);
1054 sub interface {
1055 debugmsg(3, "interface called", @_);
1056 # this is the main program loop that handles all the user input.
1057 my $input;
1058 my $prompt = get_prompt();
1060 setup_sigs();
1062 # Check if we were interactively called, or do we need to process STDIN
1063 if(-t STDIN) {
1064 while(defined($input = $term->readline($prompt))) {
1065 $sigintcaught = 0;
1066 $prompt = process_input($input, $prompt) || get_prompt();
1067 setup_sigs();
1069 } else {
1070 debugmsg(3, "non-interactive", @_);
1071 debugmsg(3, "\$opt_batch=$opt_batch", @_);
1072 debugmsg(3, "\$opt_batch=$opt_batch", @_);
1073 # Send STDIN to process_input();
1074 while(<STDIN>) {
1075 process_input($_);
1079 quit(0, undef, "\n");
1082 sub process_input {
1083 my($input, $prompt, $add_to_history) = @_;
1084 if (!(defined($add_to_history))) {
1085 $add_to_history = 1;
1087 debugmsg(3, "process_input called", @_);
1089 my $nprompt;
1090 SWITCH: {
1091 if(!$qbuffer) {
1092 # Commands that are only allowed if there is no current buffer
1093 $input =~ /^\s*(?:!|host)\s*(.*)\s*$/i and system($1), last SWITCH;
1094 $input =~ /^\s*\\a\s*$/i and populate_completion_list(), last SWITCH;
1095 $input =~ /^\s*\\\?\s*$/i and help(), last SWITCH;
1096 $input =~ /^\s*help\s*$/i and help(), last SWITCH;
1097 $input =~ /^\s*reconnect\s*$/i and db_reconnect(), last SWITCH;
1098 $input =~ /^\s*\\r\s*$/i and db_reconnect(), last SWITCH;
1099 $input =~ /^\s*conn(?:ect)?\s+(.*)$/i and connect_cmd($1), last SWITCH;
1100 $input =~ /^\s*disc(?:onnect)\s*$/i and disconnect_cmd($1), last SWITCH;
1101 $input =~ /^\s*\@\S+\s*$/i and $nprompt = run_script($input), last SWITCH;
1102 $input =~ /^\s*debug\s*(.*)$/i and debug_toggle($1), last SWITCH;
1103 $input =~ /^\s*autocommit\s*(.*)$/i and autocommit_toggle(), last SWITCH;
1104 $input =~ /^\s*commit/i and commit_cmd(), last SWITCH;
1105 $input =~ /^\s*rollback/i and rollback_cmd(), last SWITCH;
1106 $input =~ /^\s*(show\s*[^;\/\\]+)\s*$/i and show($1, 'table'),last SWITCH;
1107 $input =~ /^\s*(desc\s*[^;\/\\]+)\s*$/i and describe($1, 'table'),
1108 last SWITCH;
1109 $input =~ /^\s*(set\s*[^;\/\\]+)\s*$/i and set_cmd($1), last SWITCH;
1110 $input =~ /^\s*(let\s*[^;\/\\]*)\s*$/i and let_cmd($1), last SWITCH;
1111 $input =~ /^\s*exec(?:ute)?\s*(.*)\s*$/i and exec_cmd($1), last SWITCH;
1112 $input =~ /^\s*\\d\s*$/ and show('show objects', 'table'), last SWITCH;
1113 $input =~ /^\s*\\dt\s*$/ and show('show tables', 'table'), last SWITCH;
1114 $input =~ /^\s*\\di\s*$/ and show('show indexes', 'table'), last SWITCH;
1115 $input =~ /^\s*\\ds\s*$/ and show('show sequences', 'table'), last SWITCH;
1116 $input =~ /^\s*\\dv\s*$/ and show('show views', 'table'), last SWITCH;
1117 $input =~ /^\s*\\df\s*$/ and show('show functions', 'table'), last SWITCH;
1119 # Global commands allowed any time (even in the middle of queries)
1120 $input =~ /^\s*quit\s*$/i and quit(0), last SWITCH;
1121 $input =~ /^\s*exit\s*$/i and quit(0), last SWITCH;
1122 $input =~ /^\s*\\q\s*$/i and quit(0), last SWITCH;
1123 $input =~ /^\s*\\l\s*$/i and show_qbuffer(), last SWITCH;
1124 $input =~ /^\s*\\p\s*$/i and show_qbuffer(), last SWITCH;
1125 $input =~ /^\s*l\s*$/i and show_qbuffer(), last SWITCH;
1126 $input =~ /^\s*list\s*$/i and show_qbuffer(), last SWITCH;
1127 $input =~ /^\s*\\c\s*$/i and $nprompt = clear_qbuffer(), last SWITCH;
1128 $input =~ /^\s*clear\s*$/i and $nprompt = clear_qbuffer(), last SWITCH;
1129 $input =~ /^\s*clear buffer\s*$/i and $nprompt=clear_qbuffer(), last SWITCH;
1130 $input =~ /^\s*\\e\s*(.*)$/i and $nprompt = edit($1), last SWITCH;
1131 $input =~ /^\s*edit\s*(.*)$/i and $nprompt = edit($1), last SWITCH;
1132 $input =~ /^\s*rem(?:ark)?/i and $input = '', last SWITCH;
1133 $input =~ /[^\s]/ and $nprompt = parse_input($input) || last, last SWITCH;
1135 # default
1136 $nprompt = $prompt if ($nprompt eq ''); # use last prompt if nothing caught (blank line)
1138 if(!$opt_batch && $term->ReadLine eq "Term::ReadLine::Gnu" && $input =~ /[^\s]/ &&
1139 $input ne $last_history) {
1140 if (!$opt_batch && $add_to_history) {
1141 $term->AddHistory($input);
1144 $last_history = $input;
1145 return($nprompt);
1148 sub parse_input {
1149 my($input) = @_;
1150 debugmsg(3, "parse_input called", @_);
1151 # this takes input and parses it. It looks for single quotes (') and double
1152 # quotes (") and presents prompts accordingly. It also looks for query
1153 # terminators, such as semicolon (;), forward-slash (/) and back-slash-g (\g).
1154 # If it finds a query terminator, then it pushes any text onto the query
1155 # buffer ($qbuffer) and then passes the entire query buffer, as well as the
1156 # format type, determined by the terminator type, to the query() function. It
1157 # also wipes out the qbuffer at this time.
1159 # It returns a prompt (like 'SQL> ' or ' -> ') if successfull, 0 otherwise
1161 # now we need to check for a terminator, if we're not inquotes
1162 while( $input =~ m/
1164 ['"] # match quotes
1165 | # or
1166 ; # the ';' terminator
1167 | # or
1168 ^\s*\/\s*$ # the slash terminator at end of string
1169 | # or
1170 \\[GgsSi] # one of the complex terminators
1171 | # or
1172 (?:^|\s+)create\s+ # create
1173 | # or
1174 (?:^|\s+)function\s+ # function
1175 | # or
1176 (?:^|\s+)package\s+ # package
1177 | # or
1178 (?:^|\s+)package\s+body\s+ # package body
1179 | # or
1180 (?:^|\s+)procedure\s+ # procedure
1181 | # or
1182 (?:^|\s+)trigger\s+ # trigger
1183 | # or
1184 (?:^|\s+)declare\s+ # declare
1185 | # or
1186 (?:^|\s+)begin\s+ # begin
1187 | # or
1188 \/\* # start of multiline comment
1189 | # or
1190 \*\/ # end of multiline comment
1191 )/gix )
1194 my($pre, $match, $post) = ($`, $1, $');
1195 # PREMATCH, MATCH, POSTMATCH
1196 debugmsg(1, "parse: [$pre] [$match] [$post]");
1198 if( ($match eq '\'' || $match eq '"')) {
1199 if(!$quote || $quote eq $match) {
1200 $inquotes = ($inquotes ? 0 : 1);
1201 if($inquotes) {
1202 $quote = $match;
1203 } else {
1204 undef($quote);
1207 } elsif($match =~ /create/ix) {
1208 $increate = 1;
1209 } elsif(!$increate &&
1210 $match =~ /function|package|package\s+body|procedure|trigger/ix)
1212 # do nothing if we're not in a create statement
1213 } elsif(($match =~ /declare|begin/ix) ||
1214 ($increate && $match =~ /function|package|package\s+body|procedure|trigger/ix))
1216 $inplsqlblock = 1;
1217 } elsif($match =~ /^\/\*/) {
1218 $incomment = 1;
1219 } elsif($match =~ /^\*\//) {
1220 $incomment = 0;
1221 } elsif(!$inquotes && !$incomment && $match !~ /^--/ &&
1222 ($match =~ /^\s*\/\s*$/ || !$inplsqlblock))
1224 $qbuffer .= $pre;
1225 debugmsg(4,"qbuffer IN: [$qbuffer]");
1226 my $terminator = $match;
1227 $post =~ / (\d*) # Match num_rows right after terminitor
1228 \s* # Optional whitespace
1229 (?: #
1230 ( >{1,2}|<|\| ) # Match redirection operators
1231 \s* # Optional whitespace
1232 ( .* ) # The redirector (include rest of line)
1233 )? # Match 0 or 1
1234 \s* # Optional whitespace
1235 (.*) # Catch everything else
1236 $ # End-Of-Line
1238 debugmsg(3,"1: [$1] 2: [$2] 3: [$3] 4: [$4]");
1240 my($num_rows,$op,$op_text,$extra) = ($1,$2,$3,$4);
1242 if($extra =~ /--.*$/) {
1243 undef $extra;
1246 # check that Text::CSV_XS is installed if a < redirection was given
1247 if($op eq '<' && $notextcsv) {
1248 soft_err("You must install Text::CSV_XS from CPAN to use this feature");
1249 return(0);
1252 # deduce the format from the terminator type
1253 my $format;
1255 $fbuffer = $terminator;
1257 if($terminator eq ';' || $terminator =~ /^\/\s*$/) {
1258 $format = 'table';
1259 } elsif($terminator eq '\g') {
1260 $format = 'list';
1261 } elsif($terminator eq '\G') {
1262 $format = 'list_aligned';
1263 } elsif($terminator eq '\s') {
1264 $format = 'csv';
1265 } elsif($terminator eq '\S') {
1266 $format = 'csv_no_header';
1267 } elsif($terminator eq '\i') {
1268 $format = 'sql';
1270 $num_rows ||= 0;
1272 debugmsg(4,"fbuffer: [$fbuffer]\n");
1274 # if there is nothing in the buffer, then we assume that the user just
1275 # wants to reexecute the last query, which we have saved in $last_qbuffer
1276 my($use_buffer, $copy_buffer);
1277 if($qbuffer) {
1278 $use_buffer = $qbuffer;
1279 $copy_buffer = 1;
1280 } elsif($last_qbuffer) {
1281 $use_buffer = $last_qbuffer;
1282 $copy_buffer = 0;
1283 } else {
1284 $use_buffer = undef;
1285 $copy_buffer = 0;
1288 if($use_buffer) {
1289 if($op eq '<') {
1290 my $count = 0;
1291 my($max_lines, @params, $max_lines_save, @querybench,
1292 $rows_affected, $success_code);
1293 my $result_output = 1;
1294 push(@querybench, get_bench());
1295 print STDERR "\n";
1296 while(($max_lines, @params) = get_csv_file($op, $op_text)) {
1297 $max_lines_save = $max_lines;
1298 print statusline($count, $max_lines);
1300 my @res = query( $use_buffer, $format,
1301 {num_rows => $num_rows, op => $op, op_text => $op_text,
1302 result_output => 0}, @params);
1304 debugmsg(3, "res: [@res]");
1306 unless(@res) {
1307 print "Error in line " . ($count + 1) . " of file '$op_text'\n";
1308 $result_output = 0;
1309 close_csv();
1310 last;
1313 $rows_affected += $res[0];
1314 $success_code = $res[1];
1315 $count++;
1317 push(@querybench, get_bench());
1319 if($result_output) {
1320 print "\r\e[K";
1322 if(!$opt_batch) {
1323 print STDERR format_affected($rows_affected, $success_code);
1324 if($opt_bench || $conf{extended_benchmarks}) {
1325 print STDERR "\n\n";
1326 print STDERR ('-' x 80);
1327 print STDERR "\n";
1328 output_benchmark("Query: ", @querybench, "\n");
1329 } else {
1330 output_benchmark(" (", @querybench, ")");
1331 print STDERR "\n";
1333 print STDERR "\n";
1336 } else {
1337 query($use_buffer, $format, {num_rows => $num_rows, op => $op,
1338 op_text => $op_text});
1341 if($copy_buffer) {
1342 # copy the current qbuffer to old_qbuffer
1343 $last_qbuffer = $qbuffer;
1344 $last_fbuffer = $fbuffer;
1346 } else {
1347 query_err('Query', 'No current query in buffer');
1350 undef($qbuffer);
1351 undef($fbuffer);
1352 $inplsqlblock = 0;
1353 $increate = 0;
1355 if($extra) {
1356 return(parse_input($extra));
1357 } else {
1358 # return a 'new' prompt
1359 return(get_prompt());
1364 $qbuffer .= $input . "\n";
1366 debugmsg(4,"qbuffer: [$qbuffer], input: [$input]");
1368 if($inquotes) {
1369 return(get_prompt($quote));
1370 } elsif($incomment) {
1371 return(get_prompt('DOC'));
1372 } else {
1373 return(get_prompt('-'));
1377 sub get_csv_file {
1378 my($op, $op_text) = @_;
1379 debugmsg(3, "get_csv_file called", @_);
1381 my @ret = ();
1383 unless($csv_max_lines) {
1384 ($op_text) = glob($op_text);
1385 debugmsg(3, "Opening file '$op_text' for line counting");
1386 open(CSV, $op_text) || do{
1387 query_err('redirect',"Cannot open file '$op_text' for reading: $!");
1388 return();
1390 while(<CSV>) {
1391 $csv_max_lines++;
1393 close(CSV);
1396 unless($csv_filehandle_open) {
1397 ($op_text) = glob($op_text);
1398 debugmsg(3, "Opening file '$op_text' for input");
1399 open(CSV, $op_text) || do{
1400 query_err('redirect',"Cannot open file '$op_text' for reading: $!");
1401 return();
1403 $csv_filehandle_open = 1;
1406 my $line = <CSV>;
1407 while(defined($line) && $line =~ /^\s*$/) {
1408 $line = <CSV>;
1411 unless($line) {
1412 close_csv();
1413 return();
1416 debugmsg(3, "read in CSV line", $line);
1418 my @fields;
1419 if($csv->parse($line)) {
1420 @fields = $csv->fields();
1421 debugmsg(3, "got CVS fields", @fields);
1422 } else {
1423 wrn("Parse of CSV file failed on argument, skipping to next: "
1424 . $csv->error_input());
1425 return(get_csv_file($op, $op_text));
1428 return($csv_max_lines, @fields);
1431 sub close_csv {
1432 close(CSV) || lerr("Could not close CSV filehandle: $!");
1433 $csv_filehandle_open = 0;
1434 $csv_max_lines = 0;
1437 sub connect_cmd {
1438 my($arg) = @_;
1439 debugmsg(3, "connect_cmd called", @_);
1441 unless($arg) {
1442 wrn("Invalid connect syntax. See help");
1443 return(0);
1446 my($ora_session_mode, $username, $password, $connect_string) = parse_logon_string($arg);
1448 my $new_dbh = db_connect(0, $ora_session_mode, $username, $password, $connect_string);
1449 if (not $new_dbh) {
1450 warn "failed to make new connection as $username to $connect_string: $DBI::errstr\n";
1451 warn "keeping old connection\n";
1452 return;
1455 if (defined $dbh) {
1456 commit_on_exit();
1457 $dbh->disconnect()
1458 or warn "failed to disconnect old connection - switching anyway\n";
1461 $dbh = $new_dbh;
1462 $connected = 1;
1465 sub disconnect_cmd {
1466 debugmsg(3, "disconnect_cmd called", @_);
1468 if ($connected) {
1469 print "Closing last connection...\n";
1470 commit_on_exit();
1472 $dbh->disconnect() if (defined $dbh);
1473 $connected = 0;
1474 } else {
1475 print "Not connected.\n";
1479 sub commit_cmd {
1480 debugmsg(3, "commit_cmd called", @_);
1481 # this just called commit
1483 if(defined $dbh) {
1484 if($dbh->{AutoCommit}) {
1485 wrn("commit ineffective with AutoCommit enabled");
1486 } else {
1487 if ($dbh->commit()) {
1488 print "Transaction committed\n";
1490 else {
1491 warn "Commit failed: $DBI::errstr\n";
1494 } else {
1495 print "No connection\n";
1499 sub rollback_cmd {
1500 debugmsg(3, "rollback_cmd called", @_);
1501 # this just called commit
1503 if(defined $dbh) {
1504 if($dbh->{AutoCommit}) {
1505 wrn("rollback ineffective with AutoCommit enabled");
1506 } else {
1507 if ($dbh->rollback()) {
1508 print "Transaction rolled back\n";
1510 else {
1511 warn "Rollback failed: $DBI::errstr\n";
1514 } else {
1515 print "No connection\n";
1519 sub exec_cmd {
1520 my($sqlstr) = @_;
1521 debugmsg(3, "exec_cmd called", @_);
1522 # Wrap the statement in BEGIN/END and execute
1524 $sqlstr = qq(
1525 BEGIN
1526 $sqlstr
1527 END;
1530 query($sqlstr, 'table');
1533 sub edit {
1534 my($filename) = @_;
1535 debugmsg(3, "edit called", @_);
1536 # This writes the current qbuffer to a file then opens up an editor on that
1537 # file... when the editor returns, we read in the file and overwrite the
1538 # qbuffer with it. If there is nothing in the qbuffer, and there is
1539 # something in the last_qbuffer, then we use the last_qbuffer. If nothing
1540 # is in either, then we just open the editor with a blank file.
1542 my $passed_file = 1 if $filename;
1543 my $filecontents;
1544 my $prompt = get_prompt();
1546 debugmsg(2, "passed_file: [$passed_file]");
1548 if($qbuffer) {
1549 debugmsg(2, "Using current qbuffer for contents");
1550 $filecontents = $qbuffer;
1551 } elsif($last_qbuffer) {
1552 debugmsg(2, "Using last_qbuffer for contents");
1553 $filecontents = $last_qbuffer . $last_fbuffer;
1554 } else {
1555 debugmsg(2, "Using blank contents");
1556 $filecontents = "";
1559 debugmsg(3, "filecontents: [$filecontents]");
1561 # determine the tmp directory
1562 my $tmpdir;
1563 if($ENV{TMP}) {
1564 $tmpdir = $ENV{TMP};
1565 } elsif($ENV{TEMP}) {
1566 $tmpdir = $ENV{TEMP};
1567 } elsif(-d "/tmp") {
1568 $tmpdir = "/tmp";
1569 } else {
1570 $tmpdir = ".";
1573 # determine the preferred editor
1574 my $editor;
1575 if($ENV{EDITOR}) {
1576 $editor = $ENV{EDITOR};
1577 } else {
1578 $editor = "vi";
1581 # create the filename, if not given one
1582 $filename ||= "$tmpdir/yasql_" . int(rand(1000)) . "_$$.sql";
1584 # expand the filename
1585 ($filename) = glob($filename);
1587 debugmsg(1, "Editing $filename with $editor");
1589 # check for file existance. If it exists, then we open it up but don't
1590 # write the buffer to it
1591 my $file_exists;
1592 if($passed_file) {
1593 # if the file was passed, then check for it's existance
1594 if(-e $filename) {
1595 # The file was found
1596 $file_exists = 1;
1597 } elsif(-e "$filename.sql") {
1598 # the file was found with a .sql extension
1599 $filename = "$filename.sql";
1600 $file_exists = 1;
1601 } else {
1602 wrn("$filename was not found, creating new file, which will not be ".
1603 "deleted");
1605 } else {
1606 # no file was specified, so just write to the the temp file, and we
1607 # don't care if it exists, since there's no way another process could
1608 # write to the same file at the same time since we use the PID in the
1609 # filename.
1610 my $ret = open(TMPFILE, ">$filename");
1611 if(!$ret) { #if file was NOT opened successfully
1612 wrn("Could not write to $filename: $!");
1613 } else {
1614 print TMPFILE $filecontents;
1615 close(TMPFILE);
1619 # now spawn the editor
1620 my($ret, @filecontents);
1621 debugmsg(2, "Executing $editor $filename");
1622 $ret = system($editor, "$filename");
1623 if($ret) {
1624 debugmsg(2, "Executing env $editor $filename");
1625 $ret = system("env", $editor, "$filename");
1627 if($ret) {
1628 debugmsg(2, "Executing `which $editor` $filename");
1629 $ret = system("`which $editor`", "$filename");
1632 if($ret) { #if the editor or system returned a positive return value
1633 wrn("Editor exited with $ret: $!");
1634 } else {
1635 # read in the tmp file and apply it's contents to the buffer
1636 my $ret = open(TMPFILE, "$filename");
1637 if(!$ret) { # if file was NOT opened successfully
1638 wrn("Could not read $filename: $!");
1639 } else {
1640 # delete our qbuffer and reset the inquotes var
1641 $qbuffer = "";
1642 $inquotes = 0;
1643 $increate = 0;
1644 $inplsqlblock = 0;
1645 $incomment = 0;
1646 while(<TMPFILE>) {
1647 push(@filecontents, $_);
1649 close(TMPFILE);
1653 if(@filecontents) {
1654 print "\n";
1655 print join('', @filecontents);
1656 print "\n";
1658 foreach my $line (@filecontents) {
1659 # chomp off newlines
1660 chomp($line);
1662 last if $sigintcaught;
1663 # now send it in to process_input
1664 # and don't add lines of the script to command history
1665 $prompt = process_input($line, '', 0);
1669 unless($passed_file) {
1670 # delete the tmp file
1671 debugmsg(1, "Deleting $filename");
1672 unlink("$filename") ||
1673 wrn("Could not unlink $filename: $!");
1676 return($prompt);
1679 sub run_script {
1680 my($input) = @_;
1681 debugmsg(3, "run_script called", @_);
1682 # This reads in the given script and executes it's lines as if they were typed
1683 # in directly. It will NOT erase the current buffer before it runs. It
1684 # will append the contents of the file to the current buffer, basicly
1686 my $prompt;
1688 # parse input
1689 $input =~ /^\@(.*)$/;
1690 my $file = $1;
1691 ($file) = glob($file);
1692 debugmsg(2, "globbed [$file]");
1694 my $first_char = substr($file, 0, 1);
1695 unless($first_char eq '/' or $first_char eq '.') {
1696 foreach my $path ('.', @sqlpath) {
1697 if(-e "$path/$file") {
1698 $file = "$path/$file";
1699 last;
1700 } elsif(-e "$path/$file.sql") {
1701 $file = "$path/$file.sql";
1702 last;
1706 debugmsg(2, "Found [$file]");
1708 # read in the tmp file and apply it's contents to the buffer
1709 my $ret = open(SCRIPT, $file);
1710 if(!$ret) { # if file was NOT opened successfully
1711 wrn("Could not read $file: $!");
1712 $prompt = get_prompt();
1713 } else {
1714 # read in the script
1715 while(<SCRIPT>) {
1716 # chomp off newlines
1717 chomp;
1719 last if $sigintcaught;
1721 # now send it in to process_input
1722 # and don't add lines of the script to command history
1723 $prompt = process_input($_, '', 0);
1725 close(SCRIPT);
1728 return($prompt);
1731 sub show_qbuffer {
1732 debugmsg(3, "show_qbuffer called", @_);
1733 # This outputs the current buffer
1735 #print "\nBuffer:\n";
1736 if($qbuffer) {
1737 print $qbuffer;
1738 } else {
1739 print STDERR "Buffer empty";
1741 print "\n";
1744 sub clear_qbuffer {
1745 debugmsg(3, "clear_qbuffer called", @_);
1746 # This clears the current buffer
1748 $qbuffer = '';
1749 $inquotes = 0;
1750 $inplsqlblock = 0;
1751 $increate = 0;
1752 $incomment = 0;
1753 print "Buffer cleared\n";
1754 return(get_prompt());
1757 sub debug_toggle {
1758 my($debuglevel) = @_;
1759 debugmsg(3, "debug_toggle called", @_);
1760 # If nothing is passed, then debugging is turned off if on, on if off. If
1761 # a number is passed, then we explicitly set debugging to that number
1764 if(length($debuglevel) > 0) {
1765 unless($debuglevel =~ /^\d+$/) {
1766 wrn('Debug level must be an integer');
1767 return(1);
1770 $opt_debug = $debuglevel;
1771 } else {
1772 if($opt_debug) {
1773 $opt_debug = 0;
1774 } else {
1775 $opt_debug = 1;
1778 $opt_debug > 3 ? DBI->trace(1) : DBI->trace(0);
1779 print "** debug is now " . ($opt_debug ? "level $opt_debug" : 'off') . "\n";
1782 sub autocommit_toggle {
1783 debugmsg(3, "autocommit_toggle called", @_);
1784 # autocommit is turned off if on on if off
1786 if($dbh->{AutoCommit}) {
1787 $dbh->{AutoCommit} = 0;
1788 } else {
1789 $dbh->{AutoCommit} = 1;
1792 print "AutoCommit is now " . ($dbh->{AutoCommit} ? 'on' : 'off') . "\n";
1795 sub show_all_query {
1796 my ( $select, $order_by, $format, $opts, $static_where , $option, $option_key, @values ) = @_;
1797 debugmsg(3, "show_all_query called");
1798 my $where = ' where ';
1799 if ( $static_where ) {
1800 $where = ' where '. $static_where . ' ';
1803 if ( $option eq 'like' ){
1804 my $sqlstr = $select . $where;
1805 $sqlstr .= ' and ' if ( $static_where );
1806 $sqlstr .= $option_key ." like ? " . $order_by;
1808 query($sqlstr , $format, $opts, @values );
1809 }else{
1810 my $sqlstr = $select;
1811 $sqlstr .= $where if ($static_where);
1812 $sqlstr .= $order_by;
1814 query($sqlstr , $format, $opts );
1819 sub show {
1820 my($input, $format, $num_rows, $op, $op_text) = @_;
1821 debugmsg(3, "show called", @_);
1822 # Can 'show thing'. Possible things:
1823 # tables - outputs all of the tables that the current user owns
1824 # sequences - outputs all of the sequences that the current user owns
1826 # Can also 'show thing on table'. Possible things:
1827 # constraints - Shows constraints on the 'table', like Check, Primary Key,
1828 # Unique, and Foreign Key
1829 # indexes - Shows indexes on the 'table'
1830 # triggers - Shows triggers on the 'table'
1832 # convert to lowercase for comparison operations
1833 $input = lc($input);
1835 # drop trailing whitespaces
1836 ($input = $input) =~ s/( +)$//;
1838 # parse the input to find out what 'thing' has been requested
1839 if($input =~ /^\s*show\s+([a-zA-Z0-9_\$\#\s]+)\s+(?:on|for)\s+([a-zA-Z0-9_\$\#]+)/) {
1840 # this is a thing on a table
1841 if($1 eq 'indexes') {
1842 my $sqlstr;
1843 if($dbversion >= 8) {
1844 $sqlstr = q{
1845 select ai.index_name "Index Name",
1846 ai.index_type "Type",
1847 ai.uniqueness "Unique?",
1848 aic.column_name "Column Name"
1849 from all_indexes ai, all_ind_columns aic
1850 where ai.index_name = aic.index_name
1851 and ai.table_owner = aic.table_owner
1852 and ai.table_name = ?
1853 and ai.table_owner = ?
1854 order by ai.index_name, aic.column_position
1856 } else {
1857 $sqlstr = q{
1858 select ai.index_name "Index Name",
1859 ai.uniqueness "Unique?",
1860 aic.column_name "Column Name"
1861 from all_indexes ai, all_ind_columns aic
1862 where ai.index_name = aic.index_name
1863 and ai.table_owner = aic.table_owner
1864 and ai.table_name = ?
1865 and ai.table_owner = ?
1866 order by ai.index_name, aic.column_position
1869 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
1870 op_text => $op_text}, uc($2), uc($dbuser));
1871 } elsif($1 eq 'constraints') {
1872 my $sqlstr = q{
1873 select constraint_name "Constraint Name",
1874 decode(constraint_type,
1875 'C', 'Check',
1876 'P', 'Primary Key',
1877 'R', 'Foreign Key',
1878 'U', 'Unique',
1879 '') "Type",
1880 search_condition "Search Condition"
1881 from all_constraints
1882 where table_name = ?
1883 and owner = ?
1884 order by constraint_name
1886 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
1887 op_text => $op_text}, uc($2), uc($dbuser));
1888 } elsif($1 eq 'keys') {
1889 my $sqlstr = q{
1890 select ac.constraint_name "Name",
1891 decode(ac.constraint_type,
1892 'R', 'Foreign Key',
1893 'U', 'Unique',
1894 'P', 'Primary Key',
1895 ac.constraint_type) "Type",
1896 ac.table_name "Table Name",
1897 acc.column_name "Column",
1898 r_ac.table_name "Parent Table",
1899 r_acc.column_name "Parent Column"
1900 from all_constraints ac, all_cons_columns acc,
1901 all_constraints r_ac, all_cons_columns r_acc
1902 where ac.constraint_name = acc.constraint_name
1903 and ac.owner = acc.owner
1904 and ac.constraint_type in ('R','U','P')
1905 and ac.r_constraint_name = r_ac.constraint_name(+)
1906 and r_ac.constraint_name = r_acc.constraint_name(+)
1907 and r_ac.owner = r_acc.owner(+)
1908 and ac.table_name = ?
1909 and ac.owner = ?
1910 order by ac.constraint_name, acc.position
1912 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
1913 op_text => $op_text}, uc($2), uc($dbuser));
1914 } elsif($1 eq 'checks') {
1915 my $sqlstr = q{
1916 select ac.constraint_name "Name",
1917 decode(ac.constraint_type,
1918 'C', 'Check',
1919 ac.constraint_type) "Type",
1920 ac.table_name "Table Name",
1921 ac.search_condition "Search Condition"
1922 from all_constraints ac
1923 where ac.table_name = ?
1924 and ac.constraint_type = 'C'
1925 and ac.owner = ?
1926 order by ac.constraint_name
1928 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
1929 op_text => $op_text}, uc($2), uc($dbuser));
1930 } elsif($1 eq 'triggers') {
1931 my $sqlstr = q{
1932 select trigger_name "Trigger Name",
1933 trigger_type "Type",
1934 when_clause "When",
1935 triggering_event "Event"
1936 from all_triggers
1937 where table_name = ?
1938 and owner = ?
1940 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
1941 op_text => $op_text}, uc($2), uc($dbuser));
1942 } elsif($1 eq 'query') {
1943 my $sqlstr = q{
1944 select count(*) from all_mviews where mview_name = ? and owner = ?
1946 my $is_mview = $dbh->selectrow_array($sqlstr, undef, uc($2), uc($dbuser));
1947 if($is_mview) {
1948 $sqlstr = q{
1949 select query
1950 from all_mviews
1951 where mview_name = ?
1952 and owner = ?
1954 } else {
1955 $sqlstr = q{
1956 select text
1957 from all_views
1958 where view_name = ?
1959 and owner = ?
1962 my $prev_LongReadLen = $dbh->{LongReadLen};
1963 $dbh->{LongReadLen} = 8000;
1964 query($sqlstr, 'single_output', {num_rows => $num_rows, op => $op,
1965 op_text => $op_text}, uc($2), uc($dbuser));
1966 $dbh->{LongReadLen} = $prev_LongReadLen;
1967 } elsif($1 eq 'deps') {
1968 my $table = $2;
1969 my $sqlstr = q{
1970 select
1971 column_name "Column Name"
1972 , type "Type"
1973 , tablett || '(' || pk || ')' "Reference"
1974 , constraint_name "Constraint"
1975 , delete_rule "On delete"
1976 from (
1977 select
1978 a.owner,
1979 a.table_name,
1980 b.column_name,
1981 c.owner || '.' || c.table_name tablett,
1982 d.column_name pk,
1983 a.constraint_name,
1984 a.delete_rule,
1985 'parent ->' type
1986 from all_constraints a,
1987 all_cons_columns b,
1988 all_constraints c,
1989 all_cons_columns d
1990 where a.constraint_name = b.constraint_name
1991 and a.r_constraint_name is not null
1992 and a.r_constraint_name=c.constraint_name
1993 and c.constraint_name=d.constraint_name
1994 and a.owner = b.owner and c.owner = d.owner
1995 UNION
1996 SELECT
1997 a.owner,
1998 a.table_name parent_table,
1999 b.column_name,
2000 c.owner || '.' || c.table_name tablett,
2001 d.column_name pk,
2002 c.constraint_name,
2003 c.delete_rule,
2004 'child <-' as type
2005 FROM all_constraints a,
2006 all_cons_columns b,
2007 all_constraints c,
2008 all_cons_columns d
2009 WHERE a.constraint_name = b.constraint_name
2010 AND a.constraint_name = c.r_constraint_name
2011 AND c.constraint_name = d.constraint_name
2012 and a.owner = b.owner and c.owner = d.owner
2013 ) where table_name like ?
2014 and owner like ?
2015 ORDER BY 2,1,3,4
2017 query($sqlstr, 'table', {num_rows => $num_rows, op => $op,
2018 op_text => $op_text}, uc($table), uc($dbuser));
2019 } elsif($1 eq 'ddl') {
2020 my $object_name = $2;
2021 my $object_type = get_object_type($object_name);
2023 my $prev_LongReadLen = $dbh->{LongReadLen};
2024 $dbh->{LongReadLen} = 16_000;
2026 if ( $object_type eq 'TABLE'){
2027 my $sqlstr = q{
2028 SELECT DBMS_METADATA.GET_DDL('TABLE', ?, ?) FROM dual
2029 union all
2030 SELECT DBMS_METADATA.GET_DEPENDENT_DDL('INDEX', ?, ?) FROM dual
2031 union all
2032 SELECT DBMS_METADATA.GET_DEPENDENT_DDL ('COMMENT', ?, ?) FROM dual
2033 union all
2034 SELECT DBMS_METADATA.GET_DEPENDENT_DDL('TRIGGER', ?, ?) FROM dual
2036 query($sqlstr, 'quiet-list', {num_rows => $num_rows, op => $op, op_text => $op_text}
2037 ,uc($object_name)
2038 ,uc($dbuser)
2039 ,uc($object_name)
2040 ,uc($dbuser)
2041 ,uc($object_name)
2042 ,uc($dbuser)
2043 ,uc($object_name)
2044 ,uc($dbuser)
2046 }elsif (
2047 $object_type eq 'SYNONYM'
2048 or $object_type eq 'VIEW'
2049 or $object_type eq 'TRIGGER'
2050 or $object_type eq 'SEQUENCE'
2051 or $object_type eq 'INDEX'
2052 or $object_type eq 'PROCEDURE'
2053 or $object_type eq 'FUNCTION'
2055 my $sqlstr = q{
2056 SELECT DBMS_METADATA.GET_DDL(?, ?, ?) FROM dual
2058 query($sqlstr, 'quiet-list', {num_rows => $num_rows, op => $op, op_text => $op_text}
2059 ,uc($object_type)
2060 ,uc($object_name)
2061 ,uc($dbuser)
2063 }else{
2064 query_err("show dll", "Unsupported object type ($object_name is a $object_type)", $input);
2067 $dbh->{LongReadLen} = $prev_LongReadLen;
2068 } else {
2069 query_err("show", "Unsupported show type", $input);
2071 } elsif($input =~ /^\s*show\s+invalid\s+objects\s*$/) {
2073 my $sqlstr = q{
2074 select
2075 object_name "Object Name",
2076 object_type "Type",
2077 status "Status"
2078 from user_objects WHERE status = 'INVALID'
2080 query($sqlstr, 'table', {num_rows => $num_rows, op => $op, op_text => $op_text});
2082 } elsif($input =~ /^\s*show\s+all\s+([a-zA-Z0-9_\$\#]+)\s*([a-zA-Z0-9_\'\$\#\%\s]*)$/) {
2083 my $object = $1;
2084 my $rest = $2;
2085 my $option = '';
2086 my $option_value = '';
2087 my $opts = {
2088 num_rows => $num_rows
2089 ,op => $op
2090 ,op_text => $op_text
2092 # Workaround for materialized views
2093 if ($object eq 'materialized' and $2 =~ /views\s*([a-zA-Z0-9_\$\#\%\s]*)/ ){
2094 $object = 'materialized views';
2095 $rest = $1;
2098 if ($rest =~ /\s*(\w+)\s+[']?([a-zA-Z0-9_\$\#\%]+)[']?/){
2099 $option = lc($1);
2100 $option_value = uc($2);
2103 if($object eq 'tables') {
2105 show_all_query(
2106 q{select table_name "Table Name", 'TABLE' "Type", owner "Owner" from all_tables }
2107 ,q{ order by table_name }
2108 ,$format
2109 ,$opts
2110 ,q{}
2111 ,$option
2112 ,q{table_name}
2113 ,$option_value
2116 } elsif($object eq 'views') {
2118 show_all_query(
2119 q{select view_name "View Name", 'VIEW' "Type", owner "Owner" from all_views }
2120 ,q{ order by view_name }
2121 ,$format
2122 ,$opts
2123 ,q{}
2124 ,$option
2125 ,q{view_name}
2126 ,$option_value
2129 } elsif($object eq 'objects') {
2131 show_all_query(
2132 q{select object_name "Object Name", object_type "Type", owner "Owner" from all_objects }
2133 ,q{ order by object_name }
2134 ,$format
2135 ,$opts
2136 ,q{}
2137 ,$option
2138 ,q{object_name}
2139 ,$option_value
2142 } elsif($object eq 'sequences') {
2144 show_all_query(
2145 q{select sequence_name "Sequence Name", 'SEQUENCE' "Type", sequence_owner "Owner" from all_sequences }
2146 ,q{ order by sequence_name }
2147 ,$format
2148 ,$opts
2149 ,q{}
2150 ,$option
2151 ,q{sequence_name}
2152 ,$option_value
2155 } elsif($object eq 'clusters') {
2157 show_all_query(
2158 q{select cluster_name "Cluster Name", 'CLUSTER' "Type", owner "Owner" from all_clusters}
2159 ,q{ order by cluster_name }
2160 ,$format
2161 ,$opts
2162 ,q{}
2163 ,$option
2164 ,q{cluster_name}
2165 ,$option_value
2168 } elsif($object eq 'dimensions') {
2170 show_all_query(
2171 q{select dimension_name "Dimension Name", 'DIMENSION' "Type", owner "Owner" from all_dimensions}
2172 ,q{ order by dimension_name }
2173 ,$format
2174 ,$opts
2175 ,q{}
2176 ,$option
2177 ,q{dimension_name}
2178 ,$option_value
2181 } elsif($object eq 'functions') {
2183 show_all_query(
2184 q{select distinct name "Function Name", 'FUNCTION' "Type", owner "Owner" from all_source}
2185 ,q{ order by name }
2186 ,$format
2187 ,$opts
2188 ,q{type = 'FUNCTION'}
2189 ,$option
2190 ,q{name}
2191 ,$option_value
2194 } elsif($object eq 'procedures') {
2196 show_all_query(
2197 q{select distinct name "Procedure Name", 'PROCEDURE' "Type", owner "Owner" from all_source}
2198 ,q{ order by name }
2199 ,$format
2200 ,$opts
2201 ,q{type = 'PROCEDURE'}
2202 ,$option
2203 ,q{name}
2204 ,$option_value
2207 } elsif($object eq 'packages') {
2209 show_all_query(
2210 q{select distinct name "Package Name", 'PACKAGES' "Type", owner "Owner" from all_source}
2211 ,q{ order by name }
2212 ,$format
2213 ,$opts
2214 ,q{type = 'PACKAGE'}
2215 ,$option
2216 ,q{name}
2217 ,$option_value
2220 } elsif($object eq 'indexes') {
2222 show_all_query(
2223 q{select index_name "Index Name", 'INDEXES' "Type", owner "Owner" from all_indexes}
2224 ,q{ order by index_name }
2225 ,$format
2226 ,$opts
2227 ,q{}
2228 ,$option
2229 ,q{index_name}
2230 ,$option_value
2233 } elsif($object eq 'indextypes') {
2235 show_all_query(
2236 q{select indextype_name "Indextype Name", 'INDEXTYPE' "Type", owner "Owner" from all_indextypes}
2237 ,q{ order by indextype_name }
2238 ,$format
2239 ,$opts
2240 ,q{}
2241 ,$option
2242 ,q{indextype_name}
2243 ,$option_value
2246 } elsif($object eq 'libraries') {
2248 show_all_query(
2249 q{select library_name "library Name", 'LIBRARY' "Type", owner "Owner" from all_libraries}
2250 ,q{ order by library_name }
2251 ,$format
2252 ,$opts
2253 ,q{}
2254 ,$option
2255 ,q{library_name}
2256 ,$option_value
2259 } elsif($object eq 'materialized views') {
2261 show_all_query(
2262 q{select mview_name "Materialized View Name", 'MATERIALIZED VIEW' "Type", owner "Owner" from all_mviews}
2263 ,q{ order by mview_name }
2264 ,$format
2265 ,$opts
2266 ,q{}
2267 ,$option
2268 ,q{mview_name}
2269 ,$option_value
2272 } elsif($object eq 'snapshots') {
2274 show_all_query(
2275 q{select name "Snapshot Name", 'SNAPSHOT' "Type", owner "Owner" from all_snapshots}
2276 ,q{ order by name }
2277 ,$format
2278 ,$opts
2279 ,q{}
2280 ,$option
2281 ,q{name}
2282 ,$option_value
2285 } elsif($object eq 'synonyms') {
2287 show_all_query(
2288 q{select
2289 synonym_name "Synonym Name",
2290 'SYNONYM' "Type",
2291 owner "Owner",
2292 TABLE_OWNER "Table Owner",
2293 TABLE_NAME "Table Name",
2294 DB_LINK "DB Link"
2295 from all_synonyms}
2296 ,q{ order by synonym_name }
2297 ,$format
2298 ,$opts
2299 ,q{}
2300 ,$option
2301 ,q{synonym_name}
2302 ,$option_value
2306 } elsif($object eq 'triggers') {
2308 show_all_query(
2309 q{select trigger_name "Trigger Name", 'TRIGGER' "Type", owner "Owner" from all_triggers}
2310 ,q{ order by trigger_name }
2311 ,$format
2312 ,$opts
2313 ,q{}
2314 ,$option
2315 ,q{trigger_name}
2316 ,$option_value
2319 } elsif($object eq 'waits') {
2320 my $sqlstr = q{
2321 select vs.username "Username",
2322 vs.osuser "OS User",
2323 vsw.sid "SID",
2324 vsw.event "Event",
2325 decode(vsw.wait_time, -2, ' Unknown',
2326 to_char(vsw.seconds_in_wait,'999,999,999,999'))
2327 "Seconds Waiting"
2328 from v$session_wait vsw,
2329 v$session vs
2330 where vsw.sid = vs.sid
2331 order by vsw.wait_time desc, vsw.seconds_in_wait desc, vsw.sid
2333 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2334 op_text => $op_text});
2336 } elsif( $object eq 'constraints' ){
2338 my $sqlstr = q{
2339 select
2340 CONSTRAINT_NAME "Constraint Name"
2341 ,decode(constraint_type,
2342 'C', 'Check',
2343 'P', 'Primary Key',
2344 'R', 'Foreign Key',
2345 'U', 'Unique',
2346 '') "Type"
2347 ,TABLE_NAME "Table Name"
2348 ,INDEX_NAME "Index Name"
2349 ,STATUS "Status"
2350 from all_constraints
2352 show_all_query(
2353 $sqlstr
2354 ,q{ order by CONSTRAINT_NAME }
2355 ,$format
2356 ,$opts
2357 ,q{}
2358 ,$option
2359 ,q{CONSTRAINT_NAME}
2360 ,$option_value
2363 } else {
2364 query_err("show", "Unsupported show type", $input);
2366 } elsif($input =~ /^\s*show\s+([a-zA-Z0-9_\$\#\s]+)\s*$/) {
2367 if($1 eq 'tables') {
2368 my $sqlstr = q{
2369 select table_name "Table Name", 'TABLE' "Type", sys.login_user() "Owner"
2370 from user_tables
2371 order by table_name
2373 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2374 op_text => $op_text});
2375 } elsif($1 eq 'views') {
2376 my $sqlstr = q{
2377 select view_name "View Name", 'VIEW' "Type", sys.login_user() "Owner"
2378 from user_views
2379 order by view_name
2381 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2382 op_text => $op_text});
2383 } elsif($1 eq 'objects') {
2384 my $sqlstr = q{
2385 select object_name "Object Name", object_type "Type", sys.login_user() "Owner"
2386 from user_objects
2387 order by object_name
2389 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2390 op_text => $op_text});
2391 } elsif($1 eq 'sequences') {
2392 my $sqlstr = q{
2393 select sequence_name "Sequence Name", 'SEQUENCE' "Type", sys.login_user() "Owner"
2394 from user_sequences
2395 order by sequence_name
2397 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2398 op_text => $op_text});
2399 } elsif($1 eq 'clusters') {
2400 my $sqlstr = q{
2401 select cluster_name "Cluster Name", 'CLUSTER' "Type", sys.login_user() "Owner"
2402 from user_clusters
2403 order by cluster_name
2405 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2406 op_text => $op_text});
2407 } elsif($1 eq 'dimensions') {
2408 my $sqlstr = q{
2409 select dimension_name "Dimension Name", 'DIMENSION' "Type", sys.login_user() "Owner"
2410 from user_dimensions
2411 order by dimension_name
2413 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2414 op_text => $op_text});
2415 } elsif($1 eq 'functions') {
2416 my $sqlstr = q{
2417 select distinct name "Function Name", 'FUNCTION' "Type", sys.login_user() "Owner"
2418 from user_source
2419 where type = 'FUNCTION'
2420 order by name
2422 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2423 op_text => $op_text});
2424 } elsif($1 eq 'procedures') {
2425 my $sqlstr = q{
2426 select distinct name "Procedure Name", 'PROCEDURE' "Type", sys.login_user() "Owner"
2427 from user_source
2428 where type = 'PROCEDURE'
2429 order by name
2431 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2432 op_text => $op_text});
2433 } elsif($1 eq 'packages') {
2434 my $sqlstr = q{
2435 select distinct name "Package Name", 'PACKAGES' "Type", sys.login_user() "Owner"
2436 from user_source
2437 where type = 'PACKAGE'
2438 order by name
2440 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2441 op_text => $op_text});
2442 } elsif($1 eq 'indexes') {
2443 my $sqlstr = q{
2444 select index_name "Index Name", 'INDEXES' "Type", sys.login_user() "Owner"
2445 from user_indexes
2446 order by index_name
2448 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2449 op_text => $op_text});
2450 } elsif($1 eq 'indextypes') {
2451 my $sqlstr = q{
2452 select indextype_name "Indextype Name", 'INDEXTYPE' "Type", sys.login_user() "Owner"
2453 from user_indextypes
2454 order by indextype_name
2456 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2457 op_text => $op_text});
2458 } elsif($1 eq 'libraries') {
2459 my $sqlstr = q{
2460 select library_name "library Name", 'LIBRARY' "Type", sys.login_user() "Owner"
2461 from user_libraries
2462 order by library_name
2464 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2465 op_text => $op_text});
2466 } elsif($1 eq 'materialized views') {
2467 my $sqlstr = q{
2468 select mview_name "Materialized View Name", 'MATERIALIZED VIEW' "Type", sys.login_user() "Owner"
2469 from user_mviews
2470 order by mview_name
2472 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2473 op_text => $op_text});
2474 } elsif($1 eq 'snapshots') {
2475 my $sqlstr = q{
2476 select name "Snapshot Name", 'SNAPSHOT' "Type", sys.login_user() "Owner"
2477 from user_snapshots
2478 order by name
2480 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2481 op_text => $op_text});
2482 } elsif($1 eq 'synonyms') {
2483 my $sqlstr = q{
2484 select
2485 synonym_name "Synonym Name",
2486 'SYNONYM' "Type",
2487 sys.login_user() "Owner",
2488 TABLE_OWNER "Table Owner",
2489 TABLE_NAME "Table Name",
2490 DB_LINK "DB Link"
2491 from user_synonyms
2492 order by synonym_name
2494 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2495 op_text => $op_text});
2496 } elsif($1 eq 'triggers') {
2497 my $sqlstr = q{
2498 select trigger_name "Trigger Name", 'TRIGGER' "Type", sys.login_user() "Owner"
2499 from user_triggers
2500 order by trigger_name
2502 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2503 op_text => $op_text});
2504 } elsif($1 eq 'processes') {
2505 my $sqlstr = q{
2506 select sid,
2507 vs.username "User",
2508 vs.status "Status",
2509 vs.schemaname "Schema",
2510 vs.osuser || '@' || vs.machine "From",
2511 to_char(vs.logon_time, 'Mon DD YYYY HH:MI:SS') "Logon Time",
2512 aa.name "Command"
2513 from v$session vs, audit_actions aa
2514 where vs.command = aa.action
2515 and username is not null
2517 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2518 op_text => $op_text});
2519 } elsif($1 eq 'locks') {
2520 my $sqlstr = q{
2521 SELECT
2522 s.username "Username"
2523 ,s.osuser || '@' || s.MACHINE "User@Machine"
2524 ,s.PROGRAM "Program"
2525 ,s.sid sid
2526 ,l.LMODE || ':' ||
2527 decode(L.LMODE,
2528 1,'No Lock',
2529 2,'Row Share',
2530 3,'Row Exclusive',
2531 4,'Share',
2532 5,'Share Row Exclusive',
2533 6,'Exclusive','NONE') "LMode"
2534 ,l.type || ':' ||
2535 decode(l.type,
2536 'BL','Buffer hash table instance lock',
2537 'CF',' Control file schema global enqueue lock',
2538 'CI','Cross-instance function invocation instance lock',
2539 'CS','Control file schema global enqueue lock',
2540 'CU','Cursor bind lock',
2541 'DF','Data file instance lock',
2542 'DL','Direct loader parallel index create',
2543 'DM','Mount/startup db primary/secondary instance lock',
2544 'DR','Distributed recovery process lock',
2545 'DX','Distributed transaction entry lock',
2546 'FI','SGA open-file information lock',
2547 'FS','File set lock',
2548 'HW','Space management operations on a specific segment lock',
2549 'IN','Instance number lock',
2550 'IR','Instance recovery serialization global enqueue lock',
2551 'IS','Instance state lock',
2552 'IV','Library cache invalidation instance lock',
2553 'JQ','Job queue lock',
2554 'KK','Thread kick lock',
2555 'MB','Master buffer hash table instance lock',
2556 'MM','Mount definition gloabal enqueue lock',
2557 'MR','Media recovery lock',
2558 'PF','Password file lock',
2559 'PI','Parallel operation lock',
2560 'PR','Process startup lock',
2561 'PS','Parallel operation lock',
2562 'RE','USE_ROW_ENQUEUE enforcement lock',
2563 'RT','Redo thread global enqueue lock',
2564 'RW','Row wait enqueue lock',
2565 'SC','System commit number instance lock',
2566 'SH','System commit number high water mark enqueue lock',
2567 'SM','SMON lock',
2568 'SN','Sequence number instance lock',
2569 'SQ','Sequence number enqueue lock',
2570 'SS','Sort segment lock',
2571 'ST','Space transaction enqueue lock',
2572 'SV','Sequence number value lock',
2573 'TA','Generic enqueue lock',
2574 'TD','DDL enqueue lock',
2575 'TE','Extend-segment enqueue lock',
2576 'TM','DML enqueue lock',
2577 'TT','Temporary table enqueue lock',
2578 'TX','Transaction enqueue lock',
2579 'UL','User supplied lock',
2580 'UN','User name lock',
2581 'US','Undo segment DDL lock',
2582 'WL','Being-written redo log instance lock',
2583 'WS','Write-atomic-log-switch global enqueue lock') "Lock Type"
2584 ,CASE
2585 WHEN l.type = 'TM' THEN (
2586 SELECT OBJECT_TYPE || ' : ' || OWNER || '.' || OBJECT_NAME
2587 FROM ALL_OBJECTS
2588 where object_id = l.id1
2590 WHEN l.type = 'TX' AND l.BLOCK = 1 THEN (
2591 SELECT
2592 'Blocked Sessions: ' || max(substr(SYS_CONNECT_BY_PATH(SID, ','),2)) SID
2593 FROM (
2594 SELECT
2595 l2.id1,
2596 l2.id2,
2597 l2.SID,
2598 row_number() OVER (Partition by l2.id1 order by l2.id1 ) seq
2599 FROM
2600 v$lock l2
2601 WHERE
2602 l2.block = 0
2604 where id1 = l.id1
2605 and id2 = l.id2
2606 start with
2607 seq=1
2608 connect by prior
2609 seq+1=seq
2610 and prior
2611 id1=id1
2612 GROUP BY id1
2614 WHEN l.type = 'TX' AND l.REQUEST > 0 THEN (
2615 SELECT
2616 'Wait for Session: ' || SID
2617 FROM V$LOCK l2
2618 WHERE l.id1 = l2.id1
2619 and l.id2 = l2.id2
2620 and block = 1
2622 ELSE 'unknown'
2623 END AS "Locked object / Lock Info"
2624 ,l.CTIME
2625 FROM V$LOCK l
2626 LEFT JOIN V$SESSION s ON l.SID = s.SID
2627 WHERE l.type <> 'MR' AND s.type <> 'BACKGROUND'
2629 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2630 op_text => $op_text});
2632 } elsif($1 eq 'waits') {
2633 my $sqlstr = q{
2634 select vs.username "Username",
2635 vs.osuser "OS User",
2636 vsw.sid "SID",
2637 vsw.event "Event",
2638 decode(vsw.wait_time, -2, ' Unknown',
2639 to_char(vsw.seconds_in_wait,'999,999,999,999'))
2640 "Seconds Waiting"
2641 from v$session_wait vsw,
2642 v$session vs
2643 where vsw.sid = vs.sid
2644 and vs.status = 'ACTIVE'
2645 and vs.username is not null
2646 order by vsw.wait_time desc, vsw.seconds_in_wait desc, vsw.sid
2648 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2649 op_text => $op_text});
2650 } elsif($1 eq 'plan') {
2651 # This following query is Copyright (c) Oracle Corporation 1998, 1999. All Rights Reserved.
2652 my $sqlstr = q{
2653 select '| Operation | Name | Rows | Bytes| Cost | Pstart| Pstop |' as "Plan Table" from dual
2654 union all
2655 select '--------------------------------------------------------------------------------' from dual
2656 union all
2657 select rpad('| '||substr(lpad(' ',1*(level-1)) ||operation||
2658 decode(options, null,'',' '||options), 1, 27), 28, ' ')||'|'||
2659 rpad(substr(object_name||' ',1, 9), 10, ' ')||'|'||
2660 lpad(decode(cardinality,null,' ',
2661 decode(sign(cardinality-1000), -1, cardinality||' ',
2662 decode(sign(cardinality-1000000), -1, trunc(cardinality/1000)||'K',
2663 decode(sign(cardinality-1000000000), -1, trunc(cardinality/1000000)||'M',
2664 trunc(cardinality/1000000000)||'G')))), 7, ' ') || '|' ||
2665 lpad(decode(bytes,null,' ',
2666 decode(sign(bytes-1024), -1, bytes||' ',
2667 decode(sign(bytes-1048576), -1, trunc(bytes/1024)||'K',
2668 decode(sign(bytes-1073741824), -1, trunc(bytes/1048576)||'M',
2669 trunc(bytes/1073741824)||'G')))), 6, ' ') || '|' ||
2670 lpad(decode(cost,null,' ',
2671 decode(sign(cost-10000000), -1, cost||' ',
2672 decode(sign(cost-1000000000), -1, trunc(cost/1000000)||'M',
2673 trunc(cost/1000000000)||'G'))), 8, ' ') || '|' ||
2674 lpad(decode(partition_start, 'ROW LOCATION', 'ROWID',
2675 decode(partition_start, 'KEY', 'KEY', decode(partition_start,
2676 'KEY(INLIST)', 'KEY(I)', decode(substr(partition_start, 1, 6),
2677 'NUMBER', substr(substr(partition_start, 8, 10), 1,
2678 length(substr(partition_start, 8, 10))-1),
2679 decode(partition_start,null,' ',partition_start)))))||' ', 7, ' ')|| '|' ||
2680 lpad(decode(partition_stop, 'ROW LOCATION', 'ROW L',
2681 decode(partition_stop, 'KEY', 'KEY', decode(partition_stop,
2682 'KEY(INLIST)', 'KEY(I)', decode(substr(partition_stop, 1, 6),
2683 'NUMBER', substr(substr(partition_stop, 8, 10), 1,
2684 length(substr(partition_stop, 8, 10))-1),
2685 decode(partition_stop,null,' ',partition_stop)))))||' ', 7, ' ')||'|' as "Explain plan"
2686 from plan_table
2687 start with id=0 and timestamp = (select max(timestamp) from plan_table where id=0)
2688 connect by prior id = parent_id
2689 and prior nvl(statement_id, ' ') = nvl(statement_id, ' ')
2690 and prior timestamp <= timestamp
2691 union all
2692 select '--------------------------------------------------------------------------------' from dual
2694 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2695 op_text => $op_text});
2696 } elsif($1 eq 'errors') {
2697 my $err = $dbh->func( 'plsql_errstr' );
2698 if($err) {
2699 print "\n$err\n\n";
2700 } else {
2701 print "\nNo errors.\n\n";
2703 } elsif($1 eq 'users') {
2704 my $sqlstr = q{
2705 select username, user_id, created
2706 from all_users
2708 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2709 op_text => $op_text});
2710 } elsif($1 eq 'user') {
2711 my $sqlstr = q{
2712 select user from dual
2714 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2715 op_text => $op_text});
2716 } elsif($1 eq 'uid') {
2717 my $sqlstr = q{
2718 select uid from dual
2720 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2721 op_text => $op_text});
2722 } elsif(($1 eq 'database links') || ($1 eq 'dblinks')) {
2723 my $sqlstr = q{
2724 select db_link, host, owner from all_db_links
2726 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2727 op_text => $op_text});
2728 } else {
2729 query_err("show", "Unsupported show type", $input);
2731 } else {
2732 query_err("show", "Unsupported show type", $input);
2738 sub describe {
2739 my($input, $format, $nosynonym, $num_rows, $op, $op_text) = @_;
2740 debugmsg(3, "describe called", @_);
2741 # This describes a table, view, sequence, or synonym by listing it's
2742 # columns and their attributes
2744 # convert to lowercase for comparison operations
2745 $input = lc($input);
2747 # make sure we're still connected to the database
2748 unless(ping()) {
2749 wrn("Database connection died");
2750 db_reconnect();
2753 # parse the query to find the table that was requested to be described
2754 if($input =~ /^\s*desc\w*\s*([a-zA-Z0-9_\$\#\.\@]+)/) {
2755 my $object = $1;
2756 my $sqlstr;
2757 my $type;
2758 my @ret;
2760 my $schema;
2761 my $dblink;
2762 if($object =~ /^([a-zA-Z0-9_\$\#]+)\.([a-zA-Z0-9_\$\#]+)\@([a-zA-Z0-9_\$\#]+)$/) {
2763 $schema = $1;
2764 $object = $2;
2765 $dblink = "\@$3";
2766 } elsif($object =~ /^([a-zA-Z0-9_\$\#]+)\@([a-zA-Z0-9_\$\#]+)$/) {
2767 $schema = $dbuser;
2768 $object = $1;
2769 $dblink = "\@$2";
2770 } elsif($object =~ /^([a-zA-Z0-9_\$\#]+)\.([a-zA-Z0-9_\$\#]+)$/) {
2771 $schema = $1;
2772 $object = $2;
2773 } else {
2774 $schema = $dbuser;
2777 debugmsg(1,"schema: [$schema] object: [$object] dblink: [$dblink]");
2779 if($conf{fast_describe}) {
2780 if(my $sth = $dbh->prepare("select * from $schema.$object$dblink")) {
2781 my $fields = $sth->{NAME};
2782 my $types = $sth->{TYPE};
2783 my $type_info = $dbh->type_info($types->[0]);
2784 my $precision = $sth->{PRECISION};
2785 my $scale = $sth->{SCALE};
2786 my $nullable = $sth->{NULLABLE};
2788 debugmsg(4, "fields: [" . join(',', @$fields) . "]");
2789 debugmsg(4, "types: [" . join(',', @$types) . "]");
2790 debugmsg(4, "type_info: [" . Dumper($type_info) . "]");
2791 debugmsg(4, "precision: [" . join(',', @$precision) . "]");
2792 debugmsg(4, "scale: [" . join(',', @$scale) . "]");
2793 debugmsg(4, "nullable: [" . join(',', @$nullable) . "]");
2795 # Assemble a multidiminsional array of the output
2796 my @desc;
2797 for(my $i = 0; $i < @$fields; $i++) {
2798 my ($name, $null, $type);
2799 $name = $fields->[$i];
2800 $null = ($nullable->[$i] ? 'NULL' : 'NOT NULL');
2801 my $type_info = $dbh->type_info($types->[$i]);
2802 $type = $type_info->{'TYPE_NAME'};
2803 # convert DECIMAL to NUMBER for our purposes (some kind of DBD kludge)
2804 $type = 'NUMBER' if $type eq 'DECIMAL';
2805 if( $type eq 'VARCHAR2' || $type eq 'NVARCHAR2' ||
2806 $type eq 'CHAR' || $type eq 'NCHAR' || $type eq 'RAW' )
2808 $type .= "($precision->[$i])";
2809 } elsif($type eq 'NUMBER' && ($scale->[$i] || $precision->[$i] < 38))
2811 $type .= "($precision->[$i],$scale->[$i])";
2813 push(@desc, [$name, $null, $type]);
2816 # figure max column sizes we'll need
2817 my @widths = (4,5,4);
2818 for(my $i = 0; $i < @desc; $i++) {
2819 for(my $j = 0; $j < @{$desc[0]}; $j++) {
2820 if(length($desc[$i][$j]) > $widths[$j]) {
2821 $widths[$j] = length($desc[$i][$j]);
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 query_err('redirect',"Cannot open file '$op_text' for writing: $!", '');
2831 } elsif($op eq '|') {
2832 debugmsg(3, "Opening pipe to '$op_text' for output redirection");
2833 open(FOUT, $op . $op_text) || do query_err('pipe',"Cannot open pipe '$op_text': $!", '');
2834 } else {
2835 open(FOUT, ">&STDOUT");
2838 if($opt_headers) {
2839 # Print headers
2840 print FOUT "\n";
2841 print FOUT sprintf("%-$widths[0]s", 'Name')
2842 . ' '
2843 . sprintf("%-$widths[1]s", 'Null?')
2844 . ' '
2845 . sprintf("%-$widths[2]s", 'Type')
2846 . "\n";
2847 print FOUT '-' x $widths[0]
2848 . ' '
2849 . '-' x $widths[1]
2850 . ' '
2851 . '-' x $widths[2]
2852 . "\n";
2854 for(my $i = 0; $i < @desc; $i++) {
2855 for(my $j = 0; $j < @{$desc[$i]}; $j++) {
2856 print FOUT ' ' if $j > 0;
2857 print FOUT sprintf("%-$widths[$j]s", $desc[$i][$j]);
2859 print FOUT "\n";
2861 print FOUT "\n";
2863 close(FOUT);
2865 return();
2869 # look in all_constraints for the object first. This is because oracle
2870 # stores information about primary keys in the all_objects table as "index"s
2871 # but it doesn't have foreign keys or constraints. So we want to match
2872 # there here first
2874 # now look in all_objects
2875 my $all_object_cols = 'object_type,owner,object_name,'
2876 . 'object_id,created,last_ddl_time,'
2877 . 'timestamp,status';
2879 @ret = $dbh->selectrow_array(
2880 "select $all_object_cols from all_objects where object_name = ? "
2881 ."and owner = ?"
2882 .($nosynonym ? " and object_type != 'SYNONYM'" : ""),
2883 undef, uc($object), uc($schema)
2884 ) or
2885 @ret = $dbh->selectrow_array(
2886 "select $all_object_cols from all_objects where object_name = ? "
2887 ."and owner = 'PUBLIC'"
2888 .($nosynonym ? " and object_type != 'SYNONYM'" : ""),
2889 undef, uc($object)
2892 unless(@ret) {
2893 @ret = $dbh->selectrow_array(
2894 "select constraint_type, constraint_name from all_constraints where "
2895 ."constraint_name = ?",
2896 undef, uc($object)
2900 if($ret[0] eq 'INDEX') {
2901 # Check if this 'index' is really a primary key and is in the
2902 # all_constraints table
2904 my @temp_ret = $dbh->selectrow_array(
2905 "select constraint_type, constraint_name from all_constraints where "
2906 ."constraint_name = ?",
2907 undef, uc($object)
2910 @ret = @temp_ret if @temp_ret;
2913 $type = $ret[0];
2914 debugmsg(1,"type: [$type] ret: [@ret]");
2916 if($type eq 'SYNONYM') {
2917 # Find what this is a synonym to, then recursively call this function
2918 # again to describe whatever it points to
2919 my($table_name, $table_owner) = $dbh->selectrow_array(
2920 'select table_name, table_owner from all_synonyms '
2921 .'where synonym_name = ? and owner = ?',
2922 undef, uc($ret[2]), uc($ret[1])
2925 describe("desc $table_owner.$table_name", $format, 1);
2926 } elsif($type eq 'SEQUENCE') {
2927 my $sqlstr = q{
2928 select sequence_name "Name",
2929 min_value "Min",
2930 max_value "Max",
2931 increment_by "Inc",
2932 cycle_flag "Cycle",
2933 order_flag "Order",
2934 last_number "Last"
2935 from all_sequences
2936 where sequence_name = ?
2937 and sequence_owner = ?
2939 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2940 op_text => $op_text}, uc($ret[2]), uc($ret[1]));
2941 } elsif($type eq 'TABLE' || $type eq 'VIEW' || $type eq 'TABLE PARTITION') {
2942 my $sqlstr = q{
2943 select column_name "Name",
2944 decode(nullable,
2945 'N','NOT NULL'
2946 ) "Null?",
2947 decode(data_type,
2948 'VARCHAR2','VARCHAR2(' || TO_CHAR(data_length) || ')',
2949 'NVARCHAR2','NVARCHAR2(' || TO_CHAR(data_length) || ')',
2950 'CHAR','CHAR(' || TO_CHAR(data_length) || ')',
2951 'NCHAR','NCHAR(' || TO_CHAR(data_length) || ')',
2952 'NUMBER',
2953 decode(data_precision,
2954 NULL, 'NUMBER',
2955 'NUMBER(' || TO_CHAR(data_precision)
2956 || ',' || TO_CHAR(data_scale) || ')'
2958 'FLOAT',
2959 decode(data_precision,
2960 NULL, 'FLOAT', 'FLOAT(' || TO_CHAR(data_precision) || ')'
2962 'DATE','DATE',
2963 'LONG','LONG',
2964 'LONG RAW','LONG RAW',
2965 'RAW','RAW(' || TO_CHAR(data_length) || ')',
2966 'MLSLABEL','MLSLABEL',
2967 'ROWID','ROWID',
2968 'CLOB','CLOB',
2969 'NCLOB','NCLOB',
2970 'BLOB','BLOB',
2971 'BFILE','BFILE',
2972 data_type || ' ???'
2973 ) "Type",
2974 data_default "Default"
2975 from all_tab_columns atc
2976 where table_name = ?
2977 and owner = ?
2978 order by column_id
2980 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2981 op_text => $op_text}, uc($ret[2]), uc($ret[1]));
2982 } elsif($type eq 'R') {
2983 my $sqlstr = q{
2984 select ac.constraint_name "Name",
2985 decode(ac.constraint_type,
2986 'R', 'Foreign Key',
2987 'C', 'Check',
2988 'U', 'Unique',
2989 'P', 'Primary Key',
2990 ac.constraint_type) "Type",
2991 ac.table_name "Table Name",
2992 acc.column_name "Column Name",
2993 r_ac.table_name "Parent Table",
2994 r_acc.column_name "Parent Column",
2995 ac.delete_rule "Delete Rule"
2996 from all_constraints ac, all_cons_columns acc,
2997 all_constraints r_ac, all_cons_columns r_acc
2998 where ac.constraint_name = acc.constraint_name
2999 and ac.owner = acc.owner
3000 and ac.r_constraint_name = r_ac.constraint_name
3001 and r_ac.constraint_name = r_acc.constraint_name
3002 and r_ac.owner = r_acc.owner
3003 and ac.constraint_type = 'R'
3004 and ac.constraint_name = ?
3005 and ac.owner = ?
3006 order by ac.constraint_name, acc.position
3008 query($sqlstr, 'list_aligned', {num_rows => $num_rows, op => $op,
3009 op_text => $op_text}, uc($ret[1]),
3010 uc($schema));
3011 } elsif($type eq 'P' || $type eq 'U') {
3012 my $sqlstr = q{
3013 select ac.constraint_name "Name",
3014 decode(ac.constraint_type,
3015 'R', 'Foreign Key',
3016 'C', 'Check',
3017 'U', 'Unique',
3018 'P', 'Primary Key',
3019 ac.constraint_type) "Type",
3020 ac.table_name "Table Name",
3021 acc.column_name "Column Name"
3022 from all_constraints ac, all_cons_columns acc
3023 where ac.constraint_name = acc.constraint_name
3024 and ac.owner = acc.owner
3025 and ac.constraint_name = ?
3026 and ac.owner = ?
3027 order by ac.constraint_name, acc.position
3029 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
3030 op_text => $op_text}, uc($ret[1]), uc($schema));
3031 } elsif($type eq 'C') {
3032 my $sqlstr = q{
3033 select ac.constraint_name "Name",
3034 decode(ac.constraint_type,
3035 'R', 'Foreign Key',
3036 'C', 'Check',
3037 'U', 'Unique',
3038 'P', 'Primary Key',
3039 ac.constraint_type) "Type",
3040 ac.table_name "Table Name",
3041 ac.search_condition "Search Condition"
3042 from all_constraints ac
3043 where ac.constraint_name = ?
3044 order by ac.constraint_name
3046 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
3047 op_text => $op_text}, uc($ret[1]));
3048 } elsif($type eq 'INDEX') {
3049 my $sqlstr = q{
3050 select ai.index_name "Index Name",
3051 ai.index_type "Type",
3052 ai.table_name "Table Name",
3053 ai.uniqueness "Unique?",
3054 aic.column_name "Column Name"
3055 from all_indexes ai, all_ind_columns aic
3056 where ai.index_name = aic.index_name(+)
3057 and ai.table_owner = aic.table_owner(+)
3058 and ai.index_name = ?
3059 and ai.table_owner = ?
3060 order by aic.column_position
3062 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
3063 op_text => $op_text}, uc($ret[2]), uc($schema));
3064 } elsif($type eq 'TRIGGER') {
3065 my $sqlstr = q{
3066 select trigger_name "Trigger Name",
3067 trigger_type "Type",
3068 triggering_event "Event",
3069 table_name "Table",
3070 when_clause "When",
3071 description "Description",
3072 trigger_body "Body"
3073 from all_triggers
3074 where trigger_name = ?
3076 query($sqlstr, 'list_aligned', {num_rows => $num_rows, op => $op,
3077 op_text => $op_text}, uc($ret[2]));
3078 } elsif($type eq 'PACKAGE') {
3079 wrn("Not implemented (yet)");
3080 } elsif($type eq 'PROCEDURE') {
3081 wrn("Not implemented (yet)");
3082 } elsif($type eq 'CLUSTER') {
3083 wrn("Not implemented (yet)");
3084 } elsif($type eq 'TRIGGER') {
3085 wrn("Not implemented (yet)");
3086 } else {
3087 query_err('describe', "Object $object not found");
3091 sub let_cmd {
3092 my($input) = @_;
3093 debugmsg(3, "let_cmd called", @_);
3094 my @bool_keys = qw(
3095 sql_query_in_error auto_complete edit_history fast_describe
3096 complete_objects complete_tables extended_complete_list
3097 extended_benchmarks column_wildcards complete_columns auto_commit
3098 commit_on_exit command_complete_list long_trunc_ok
3101 if ($input =~ /^\s*let\s*(\w+)?\s*/i ){
3102 my @print_keys = keys %conf;
3103 @print_keys = grep(/$1/,@print_keys) if ($1);
3105 foreach my $key ( @print_keys ){
3106 my $print_conf = $conf{$key};
3107 $print_conf = ($conf{$key}) ? 'On' : 'Off' if ( grep(/$key/,@bool_keys) ) ;
3109 if ($key eq 'long_read_len' ){
3110 $print_conf = $dbh->{LongReadLen};
3113 printf("%25s : %1s\n",$key,$print_conf);
3115 }else{
3116 print "usage let <config name>\n";
3119 sub set_cmd {
3120 my($input) = @_;
3121 debugmsg(3, "set_cmd called", @_);
3122 # This mimics SQL*Plus set commands, or ignores them completely. For those
3123 # that are not supported, we do nothing at all, but return silently.
3125 if($input =~ /^\s*set\s+serverout(?:put)?\s+(on|off)(?:\s+size\s+(\d+))?/i) {
3126 if(lc($1) eq 'on') {
3127 my $size = $2 || 1_000_000;
3128 debugmsg(2, "calling dbms_output_enable($size)");
3129 $dbh->func( $size, 'dbms_output_enable' )
3130 or warn "dbms_output_enable($size) failed: $DBI::errstr\n";
3131 $set{serveroutput} = 1;
3132 debugmsg(2, "serveroutput set to $set{serveroutput}");
3133 } else {
3134 $set{serveroutput} = 0;
3135 debugmsg(2, "serveroutput set to $set{serveroutput}");
3137 }elsif($input =~ /^\s*set\s+(long_read_len|LongReadLen)\s+(\d+)/i){
3138 debugmsg(2, "long_read_len/LongReadLen set to $2");
3139 $dbh->{LongReadLen} = $2;
3140 $conf{long_read_len} = $2;
3141 }elsif($input =~ /^\s*set\s+fast_describe\s+(on|off)/i){
3142 $conf{fast_describe} = (lc($1) eq 'on') ? 1 : 0;
3143 print "fast_describe is now " . ($conf{fast_describe} ? 'on' : 'off') . "\n";
3145 }elsif($input =~ /^\s*set\s+(\w+)\s*/ ){
3146 print "Can't set option $1\n";
3150 sub query {
3151 my($sqlstr, $format, $opts, @bind_vars) = @_;
3152 debugmsg(3, "query called", @_);
3153 # this runs the provided query and calls format_display to display the results
3155 my $num_rows = $opts->{num_rows};
3156 my $op = $opts->{op};
3157 my $op_text = $opts->{op_text};
3158 my $result_output = ( exists $opts->{result_output}
3159 ? $opts->{result_output}
3163 my(@totalbench, @querybench, @formatbench);
3165 # Look for special query types, such as "show" and "desc" that we handle
3166 # and don't send to the database at all, since they're not really valid SQL.
3168 my ($rows_affected, $success_code);
3170 if($sqlstr =~ /^\s*desc/i) {
3171 describe($sqlstr, $format, undef, $num_rows, $op, $op_text);
3172 } elsif($sqlstr =~ /^\s*show/i) {
3173 show($sqlstr, $format, $num_rows, $op, $op_text);
3174 } else {
3175 $running_query = 1;
3177 # make sure we're still connected to the database
3178 unless(ping()) {
3179 wrn("Database connection died");
3180 db_reconnect();
3183 $sqlstr = wildcard_expand($sqlstr) if $conf{column_wildcards};
3185 # send the query on to the database
3186 push(@totalbench, get_bench()) if !$conf{extended_benchmarks};
3187 push(@querybench, get_bench()) if $conf{extended_benchmarks};
3188 debugmsg(3, "preparing", $sqlstr);
3189 my $sth = $dbh->prepare($sqlstr);
3190 unless($sth) {
3191 my $err = $DBI::errstr;
3192 $err =~ s/ \(DBD ERROR\: OCIStmtExecute\/Describe\)//;
3194 if ($err =~ m/DBD ERROR\:/) {
3195 my $indicator_offset = $DBI::errstr;
3196 $indicator_offset =~ s/(.*)(at\ char\ )(\d+)(\ .*)/$3/;
3197 if ($indicator_offset > 0) {
3198 my $i = 0;
3199 print $sqlstr, "\n";
3200 for ($i=0;$i<$indicator_offset;++$i) {
3201 print " ";
3203 print "*\n";
3207 # Output message if serveroutput is on
3208 if($set{serveroutput}) {
3209 debugmsg(3, "Calling dmbs_output_get");
3210 my @output = $dbh->func( 'dbms_output_get' );
3211 print join("\n", @output) . "\n";
3213 query_err('prepare', $err, $sqlstr), setup_sigs(), return();
3215 debugmsg(2, "sth: [$sth]");
3217 $cursth = $sth;
3219 finish_query($sth), return() if $sigintcaught; #pseudo sig handle
3221 my $ret;
3222 eval {
3223 debugmsg(3, "executing", $sqlstr);
3224 $ret = $sth->execute(@bind_vars);
3226 debugmsg(3, "ret:", $ret, "\@:", $@, "\$DBI::errstr:", $DBI::errstr);
3227 if(!$ret) {
3228 my $eval_error = $@;
3229 $eval_error =~ s/at \(eval \d+\) line \d+, <\S+> line \d+\.//;
3230 my $err = $DBI::errstr;
3231 $err =~ s/ \(DBD ERROR: OCIStmtExecute\)//;
3232 # Output message is serveroutput is on
3233 if($set{serveroutput}) {
3234 debugmsg(3, "Calling dmbs_output_get");
3235 my @output = $dbh->func( 'dbms_output_get' );
3236 print join("\n", @output) . "\n";
3238 my $errstr = ($eval_error ? $eval_error : $err);
3239 query_err('execute', $errstr, $sqlstr);
3240 setup_sigs();
3241 return();
3244 if($DBI::errstr =~ /^ORA-24344/) {
3245 print "\nWarning: Procedure created with compilation errors.\n\n";
3246 setup_sigs();
3247 return();
3250 push(@querybench, get_bench()) if $conf{extended_benchmarks};
3252 finish_query($sth), return() if $sigintcaught; #pseudo sig handle
3254 debugmsg(1, "rows returned: [" . $sth->rows() . "]");
3256 # open the redirection file
3257 if($op && $op eq '>' || $op eq '>>') {
3258 ($op_text) = glob($op_text);
3259 debugmsg(3, "Opening file '$op_text' for output redirection using [$op]");
3260 open(FOUT, $op . $op_text) || do{
3261 query_err('redirect',"Cannot open file '$op_text' for writing: $!",
3262 $sqlstr);
3263 finish_query($sth);
3264 return();
3266 } elsif($op eq '|') {
3267 debugmsg(3, "Opening pipe to '$op_text' for output redirection");
3268 open(FOUT, $op . $op_text) || do{
3269 query_err('pipe',"Cannot open pipe '$op_text': $!", $sqlstr);
3270 finish_query($sth);
3271 return();
3273 } else {
3274 open(FOUT, ">&STDOUT");
3277 # Output message is serveroutput is on
3278 if($set{serveroutput}) {
3279 debugmsg(3, "Calling dmbs_output_get");
3280 my @output = $dbh->func( 'dbms_output_get' );
3281 print join("\n", @output) . "\n";
3284 # Determine type and output accordingly
3285 if($sqlstr =~ /^\s*declare|begin/i) {
3286 print STDERR "\nPL/SQL procedure successfully completed.\n\n";
3287 } else {
3288 push(@formatbench, get_bench()) if $conf{extended_benchmarks};
3289 ($rows_affected, $success_code) = format_output($sth, $format, $num_rows,
3290 $sqlstr, $op, $op_text)
3291 or finish_query($sth), return();
3292 push(@formatbench, get_bench()) if $conf{extended_benchmarks};
3293 push(@totalbench, get_bench()) if !$conf{extended_benchmarks};
3295 finish_query($sth), return() if $sigintcaught; #pseudo sig handle
3297 # output format_affected
3298 if($result_output) {
3299 if(!$opt_batch) {
3300 print STDERR "\n" . format_affected($rows_affected, $success_code);
3303 if(!$opt_batch) {
3304 if($opt_bench || $conf{extended_benchmarks}) {
3305 print STDERR "\n\n";
3306 print STDERR ('-' x 80);
3307 print STDERR "\n";
3308 output_benchmark("Query: ", @querybench, "\n");
3309 output_benchmark("Format:", @formatbench, "\n");
3310 } else {
3311 output_benchmark(" (", @totalbench, ")");
3312 print STDERR "\n";
3314 print STDERR "\n";
3319 close(FOUT);
3321 finish_query($sth);
3323 undef($sth);
3324 undef($cursth);
3327 return($rows_affected, $success_code);
3330 sub wildcard_expand {
3331 my($sql) = @_;
3332 debugmsg(3, "wildcard_expand called", @_);
3334 my $newsql = $sql;
3335 my $fromstuff;
3336 my $wheregrouporder = $sql;
3337 $wheregrouporder =~ s/.*(where|order|group).*/\1/;
3338 if ($wheregrouporder eq $sql) {
3339 $wheregrouporder = "";
3341 ($sql,$fromstuff) = split(/order|group|where/i,$sql,2);
3342 if ($sql =~ /^select\s+(.+?)\*\s+from\s+(.+)/i) {
3343 debugmsg(1, "Match made: ($1) ($2)");
3344 my $wildcardstring = uc($1);
3345 my $tablename = uc($2);
3346 my @tlist = split(/,/,$tablename);
3347 my $tablelist = "";
3348 my %column_prefix;
3349 foreach my $table (@tlist) {
3350 $table =~ s/^ *//;
3351 $table =~ s/([^ ]+)\s+(.*)/\1/;
3352 $column_prefix{$table} = $2 ? $2 : $table;
3353 $tablelist .= ($tablelist ? "," : "") . $table;
3355 $tablelist =~ s/,/' or table_name='/g;
3356 my $qstr = "select table_name||'.'||column_name from all_tab_columns where (table_name='$tablelist') and column_name like '$wildcardstring%' escape '\\'";
3357 debugmsg(1, "qstr: [$qstr]");
3358 my $sth = $dbh->prepare($qstr);
3359 $sth->execute();
3360 setup_sigs();
3361 my $colname;
3362 my $collist;
3363 while ( ($colname) = $sth->fetchrow_array() ) {
3364 foreach my $table (keys %column_prefix) {
3365 $colname =~ s/$table\./$column_prefix{$table}\./;
3366 $colname =~ s/ //g;
3368 $collist .= ($collist ? "," : "") . $colname;
3370 $collist = $collist ? $collist : "*";
3371 $newsql = "select " . $collist . " from " . $tablename . " "
3372 . $wheregrouporder . " " . $fromstuff;
3373 debugmsg(1, "newsql: [$newsql]");
3375 $newsql;
3378 sub finish_query {
3379 my($sth) = @_;
3380 # This just finishes the query and cleans up the state info
3382 $sth->finish;
3383 undef($cursth);
3384 $running_query = 0;
3385 setup_sigs();
3388 sub get_bench {
3389 debugmsg(3, "get_bench called", @_);
3390 # returns benchmark info
3392 my($benchmark, $hires);
3393 $benchmark = new Benchmark;
3395 if($nohires) {
3396 $hires = time;
3397 } else {
3398 # use an eval to keep perl from syntax checking it unless we have the
3399 # Time::HiRes module loaded
3400 eval q{
3401 $hires = [gettimeofday]
3405 return($benchmark, $hires);
3408 sub output_benchmark {
3409 my($string, $bstart, $hrstart, $bend, $hrend, $string2) = @_;
3410 debugmsg(3, "output_benchmark called", @_);
3411 # This just outputs the benchmark info
3413 my $bench = timediff($bend, $bstart);
3415 my $time;
3416 if($nohires) {
3417 # the times will be seconds
3418 $time = $hrend - $hrstart;
3419 } else {
3420 eval q{$time = tv_interval($hrstart, $hrend)};
3421 $time = sprintf("%.2f", $time);
3424 unless($opt_bench || $conf{extended_benchmarks}) {
3425 # convert $time to something more readable
3426 $time =~ s/\.(\d+)$//;
3427 my $decimal = $1;
3428 my @tparts;
3429 my $tmp;
3430 if(($tmp = int($time / 604800)) >= 1) {
3431 push(@tparts, "$tmp week" . ($tmp != 1 && 's'));
3432 $time %= 604800;
3434 if(($tmp = int($time / 86400)) >= 1) {
3435 push(@tparts, "$tmp day" . ($tmp != 1 && 's'));
3436 $time %= 86400;
3438 if(($tmp = int($time / 3600)) >= 1) {
3439 push(@tparts, "$tmp hour" . ($tmp != 1 && 's'));
3440 $time %= 3600;
3442 if(($tmp = int($time / 60)) >= 1) {
3443 push(@tparts, "$tmp minute" . ($tmp != 1 && 's'));
3444 $time %= 60;
3446 $time ||= '0';
3447 $decimal ||= '00';
3448 $time .= ".$decimal";
3449 push(@tparts, "$time second" . ($time != 1 && 's'));
3450 $time = join(", ", @tparts);
3453 if($opt_bench || $conf{extended_benchmarks}) {
3454 print STDERR "$string\[ $time second" . ($time != 1 && 's')
3455 . " ] [" . timestr($bench) . " ]$string2";
3456 } else {
3457 print STDERR "$string$time$string2";
3461 sub format_output {
3462 my($sth, $format, $num_rows, $sqlstr, $op, $op_text) = @_;
3463 debugmsg(3, "format_output called", @_);
3464 # Formats the output according to the query terminator. If it was a ';' or
3465 # a '/' then a normal table is output. If it was a '\g' then all the columns # and rows are output put line by line.
3466 # input: $sth $format
3467 # sth is the statement handler
3468 # format can be either 'table', 'list', or 'list_aligned'
3469 # output: returns 0 on error, ($success_code, $rows_affected) on success
3470 # $success_code = ('select', 'affected');
3472 debugmsg(3,"type: [" . Dumper($sth->{TYPE}) . "]");
3474 # Is this query a select?
3475 my $isselect = 1 if $sqlstr =~ /^\s*select/i;
3477 if($format eq 'table') {
3478 my $count = 0;
3479 my $res = [];
3480 my $overflow = 0;
3481 while(my @res = $sth->fetchrow_array()) {
3482 push(@$res, \@res);
3483 $count++;
3484 if($count > 1000) {
3485 debugmsg(1,"overflow in table output, switching to serial mode");
3486 $overflow = 1;
3487 last;
3489 debugmsg(1,"num_rows hit on fetch") if $num_rows && $count >= $num_rows;
3490 last if $num_rows && $count >= $num_rows;
3491 return(0) if $sigintcaught; #pseudo sig handle
3494 # If we didn't get any rows back, then the query was probably an insert or
3495 # update, so we call format_affected
3496 if(@$res <= 0 && !$isselect) {
3497 return($sth->rows(), 'affected');
3500 return(0) if $sigintcaught; #pseudo sig handle
3502 # First go through all the return data to determine column widths
3503 my @widths;
3504 for( my $i = 0; $i < @{$res}; $i++ ) {
3505 for( my $j = 0; $j < @{$res->[$i]}; $j++ ) {
3506 if(length($res->[$i]->[$j]) > $widths[$j]) {
3507 $widths[$j] = length($res->[$i]->[$j]);
3510 return(0) if $sigintcaught; #pseudo sig handle
3511 debugmsg(1,"num_rows hit on calc") if $num_rows && $i >= $num_rows-1;
3512 last if $num_rows && $i >= $num_rows-1;
3515 return(0) if $sigintcaught; #pseudo sig handle
3517 my $fields = $sth->{NAME};
3518 my $types = $sth->{TYPE};
3519 my $nullable = $sth->{NULLABLE};
3521 debugmsg(4, "fields: [" . Dumper($fields) . "]");
3522 debugmsg(4, "types: [" . Dumper($types) . "]");
3523 debugmsg(4, "nullable: [" . Dumper($nullable) . "]");
3525 return(0) if $sigintcaught; #pseudo sig handle
3527 # Extend the column widths if the column name is longer than any of the
3528 # data, so that it doesn't truncate the column name
3529 for( my $i = 0; $i < @$fields; $i++ ) {
3530 if(length($fields->[$i]) > $widths[$i]) {
3531 debugmsg(3, "Extending $fields->[$i] for name width");
3532 $widths[$i] = length($fields->[$i]);
3534 return(0) if $sigintcaught; #pseudo sig handle
3537 return(0) if $sigintcaught; #pseudo sig handle
3539 # Extend the column widths if the column is NULLABLE so that we'll
3540 # have room for 'NULL'
3541 for( my $i = 0; $i < @$nullable; $i++ ) {
3542 if($nullable->[$i] && $widths[$i] < 4) {
3543 debugmsg(3, "Extending $fields->[$i] for null");
3544 $widths[$i] = 4;
3546 return(0) if $sigintcaught; #pseudo sig handle
3549 return(0) if $sigintcaught; #pseudo sig handle
3551 my $sumwidths;
3552 foreach(@widths) {
3553 $sumwidths += $_;
3556 return(0) if $sigintcaught; #pseudo sig handle
3558 debugmsg(2,"fields: [" . join("|", @$fields) . "] sumwidths: [$sumwidths] widths: [" . join("|", @widths) . "]\n");
3560 return(0) if $sigintcaught; #pseudo sig handle
3562 # now do the actual outputting, starting with the header
3563 my $rows_selected = 0;
3564 if(@$res) {
3565 if(!$opt_batch) {
3566 print FOUT "\r\e[K" if $op eq '<';
3567 print FOUT "\n";
3568 for( my $i = 0; $i < @$fields; $i++ ) {
3569 if($opt_batch) {
3570 print FOUT "\t" if $i > 0;
3571 print FOUT sprintf("%s", $fields->[$i]);
3573 else
3575 print FOUT " " if $i > 0;
3576 if($types->[$i] == 3 || $types->[$i] == 8) {
3577 print FOUT sprintf("%$widths[$i]s", $fields->[$i]);
3578 } else {
3579 print FOUT sprintf("%-$widths[$i]s", $fields->[$i]);
3583 print FOUT "\n";
3585 for( my $i = 0; $i < @$fields; $i++ ) {
3586 print FOUT " " if $i > 0;
3587 print FOUT '-' x $widths[$i];
3589 print FOUT "\n";
3592 return(0) if $sigintcaught; #pseudo sig handle
3594 # now print the actual data rows
3595 my $count = 0;
3596 for( my $j = 0; $j < @$res; $j++ ) {
3597 $count = $j;
3598 for( my $i = 0; $i < @$fields; $i++ ) {
3599 print FOUT " " if $i > 0;
3600 my $data = $res->[$j]->[$i];
3601 # Strip out plain ole \r's since SQL*Plus seems to...
3602 $data =~ s/\r//g;
3603 $data = 'NULL' unless defined $data;
3604 if($types->[$i] == 3 || $types->[$i] == 8) {
3605 print FOUT sprintf("%$widths[$i]s", $data);
3606 } else {
3607 print FOUT sprintf("%-$widths[$i]s", $data);
3610 print FOUT "\n";
3612 $rows_selected++;
3613 debugmsg(2,"num_rows hit on output") if $num_rows && $j >= $num_rows-1;
3614 last if $num_rows && $j >= $num_rows-1;
3615 return(0) if $sigintcaught; #pseudo sig handle
3618 if($overflow) {
3619 # output the rest of the data from the statement handler
3620 while(my $res = $sth->fetch()) {
3621 $count++;
3622 for( my $i = 0; $i < @$fields; $i++ ) {
3623 print FOUT " " if $i > 0;
3624 my $data = substr($res->[$i],0,$widths[$i]);
3625 # Strip out plain ole \r's since SQL*Plus seems to...
3626 $data =~ s/\r//g;
3627 $data = 'NULL' unless defined $data;
3628 if($types->[$i] == 3 || $types->[$i] == 8) {
3629 print FOUT sprintf("%$widths[$i]s", $data);
3630 } else {
3631 print FOUT sprintf("%-$widths[$i]s", $data);
3634 print FOUT "\n";
3636 $rows_selected++;
3637 debugmsg(2,"num_rows hit on output")
3638 if $num_rows && $count >= $num_rows-1;
3639 last if $num_rows && $count >= $num_rows-1;
3640 return(0) if $sigintcaught; #pseudo sig handle
3645 return($rows_selected, 'selected');
3647 } elsif($format eq 'list' || $format eq 'quiet-list' ) {
3648 # output in a nice list format, which is where we print each row in turn,
3649 # with each column on it's own line
3650 # quiet-list doesn't display *** Row...
3651 my $quiet = ($format eq 'quiet-list') ? 1 : 0;
3652 my $fields = $sth->{NAME};
3654 print "\r\e[K" if $op eq '<';
3655 print FOUT "\n";
3657 my $count = 0;
3658 while(my $res = $sth->fetch()) {
3659 print FOUT "\n**** Row: " . ($count+1) . "\n" unless ($quiet);
3660 for( my $i = 0; $i < @$fields; $i++ ) {
3661 my $data = $res->[$i];
3662 $data = 'NULL' unless defined $data;
3663 if ($quiet) {
3664 print FOUT $data . "\n";
3665 }else{
3666 print FOUT $fields->[$i] . ": " . $data . "\n";
3669 $count++;
3670 last if $num_rows && $count >= $num_rows;
3671 return(0) if $sigintcaught; #pseudo sig handle
3674 return(0) if $sigintcaught; #pseudo sig handle
3676 # If we didn't get any rows back, then the query was probably an insert or
3677 # update, so we call format_affected
3678 if($count <= 0 && !$isselect) {
3679 return($sth->rows(), 'affected');
3682 return($count, 'selected');
3684 } elsif($format eq 'list_aligned') {
3685 # output in a nice list format, which is where we print each row in turn,
3686 # with each column on it's own line. The column names are aligned in this
3687 # one (so that the data all starts on the same column)
3689 my $fields = $sth->{NAME};
3691 print "\r\e[K" if $op eq '<';
3692 print FOUT "\n";
3694 my $maxwidth = 0;
3695 for( my $i = 0; $i < @$fields; $i++ ) {
3696 my $len = length($fields->[$i]) + 1; # +1 for the colon
3697 $maxwidth = $len if $len >= $maxwidth;
3700 return(0) if $sigintcaught; #pseudo sig handle
3702 my $count = 0;
3703 while(my $res = $sth->fetch()) {
3704 print FOUT "\n**** Row: " . ($count+1) . "\n";
3705 for( my $i = 0; $i < @$fields; $i++ ) {
3706 my $data = $res->[$i];
3707 $data = 'NULL' unless defined $data;
3708 print FOUT sprintf("%-" . $maxwidth . "s", $fields->[$i] . ":");
3709 print FOUT " " . $data . "\n";
3711 $count++;
3712 last if $num_rows && $count >= $num_rows;
3713 return(0) if $sigintcaught; #pseudo sig handle
3716 return(0) if $sigintcaught; #pseudo sig handle
3718 # If we didn't get any rows back, then the query was probably an insert or
3719 # update, so we call format_affected
3720 if($count <= 0 && !$isselect) {
3721 return($sth->rows(), 'affected');
3724 return($count, 'selected');
3726 } elsif($format eq 'single_output') {
3727 # Outputs a single return column/row without any labeling
3729 print FOUT "\n";
3731 my $res = $sth->fetchrow_array();
3732 print FOUT "$res\n";
3734 my $count = ($res ? 1 : 0);
3736 return(0) if $sigintcaught; #pseudo sig handle
3738 return($count, 'selected');
3740 } elsif($format eq 'csv' || $format eq 'csv_no_header') {
3741 # output in a comma seperated values format. fields with a ',' are quoted
3742 # with '"' quotes, and rows are seperated by '\n' newlines
3744 print "\r\e[K" if $op eq '<';
3745 #print FOUT "\n";
3747 # check that Text::CSV_XS was included ok, if not output an error
3748 if($notextcsv) {
3749 soft_err("You must install Text::CSV_XS from CPAN to use this feature");
3750 return(0);
3751 } else {
3752 my $fields = $sth->{NAME};
3754 if($format eq 'csv') {
3755 # Print the column headers
3756 for(my $i = 0; $i < @$fields; $i++) {
3757 print FOUT "," if $i > 0;
3758 print FOUT $fields->[$i];
3760 print FOUT "\n";
3763 my $count = 0;
3764 while(my $res = $sth->fetch()) {
3765 $count++;
3767 $csv->combine(@$res);
3768 print FOUT $csv->string() . "\n";
3770 last if $num_rows && $count >= $num_rows;
3771 return(0) if $sigintcaught; #pseudo sig handle
3774 return(0) if $sigintcaught; #pseudo sig handle
3776 # If we didn't get any rows back, then the query was probably an insert or
3777 # update, so we call format_affected
3778 if($count <= 0 && !$isselect) {
3779 return($sth->rows(), 'affected');
3782 return($count, 'selected');
3784 } elsif($format eq 'sql') {
3785 # Produce SQL insert statements.
3786 print "\r" if $op eq '<';
3787 print FOUT "\n";
3789 my $cols = lc join(', ', @{$sth->{NAME}});
3790 my @types = map { scalar $dbh->type_info($_)->{TYPE_NAME} } @{ $sth->{TYPE} };
3791 my %warned_unknown_type;
3793 my $count = 0;
3794 while(my $res = $sth->fetch()) {
3795 $count++;
3796 die if @$res != @types;
3797 print FOUT "insert into TABLE ($cols) values (";
3798 foreach (0 .. $#$res) {
3799 my $t = $types[$_];
3800 my $v = $res->[$_];
3801 if (not defined $v) {
3802 print FOUT 'null';
3803 } else {
3804 if ($t eq 'DOUBLE' or $t eq 'DOUBLE PRECISION' or
3805 $t eq 'NUMBER' or $t eq 'DECIMAL') {
3806 die "bad number: $v" if $v !~ /\d/;
3807 print FOUT $v;
3808 } elsif ($t eq 'VARCHAR2' or $t eq 'CHAR' or $t eq 'CLOB') {
3809 $v =~ s/['']/''/g;
3810 print FOUT "'$v'";
3811 } elsif ($t eq 'DATE') {
3812 print FOUT "'$v'";
3813 } else {
3814 warn "don't know how to handle SQL type $t"
3815 unless $warned_unknown_type{$t}++;
3816 print FOUT "(unknown type $t: $v)";
3819 print FOUT ', ' unless $_ eq $#$res;
3821 print FOUT ");\n";
3822 last if $num_rows && $count >= $num_rows;
3823 return(0) if $sigintcaught; #pseudo sig handle
3825 return(0) if $sigintcaught; #pseudo sig handle
3827 # If we didn't get any rows back, then the query was probably an insert or
3828 # update, so we call format_affected
3829 if($count <= 0 && !$isselect) {
3830 return($sth->rows(), 'affected');
3832 return($count, 'selected');
3833 } else {
3834 die("Invalid format: $format");
3838 sub format_affected {
3839 my($rows_affected, $success_code) = @_;
3840 debugmsg(3, "format_affected called", @_);
3841 # This just outputs the given number
3843 return("$rows_affected row" . ($rows_affected == 1 ? '' : 's')
3844 ." $success_code");
3847 sub statusline {
3848 my($num, $max) = @_;
3849 debugmsg(3, "statusline called", @_);
3850 my $linewidth;
3851 eval q{
3852 use Term::ReadKey;
3853 (\$linewidth) = GetTerminalSize();
3855 if($@) {
3856 $linewidth = 80;
3858 my $numwidth = length($num);
3859 my $maxwidth = length($max);
3860 my $width = $linewidth - $numwidth - $maxwidth - 9;
3862 my $fillnum = (($num / $max) * $width);
3863 my $spacenum = ((($max - $num) / $max) * $width);
3865 if($fillnum =~ /\./) {
3866 $fillnum = int($fillnum) + 1;
3869 if($spacenum =~ /\./) {
3870 $spacenum = int($spacenum);
3873 my $fill = ('*' x $fillnum);
3874 my $space = ('-' x $spacenum);
3875 my $pcnt = sprintf("%.0d", ($num / $max * 100));
3877 return(sprintf("%-" . $linewidth . "s", "$num/$max [" . $fill . $space . "] $pcnt\%") . "\r");
3880 sub statusprint {
3881 my($string) = @_;
3883 return("\r\e[K$string\n");
3886 sub ping {
3887 debugmsg(3, "ping called", @_);
3888 if(!$dbh) {
3889 return(0);
3890 } else {
3891 # install alarm signal handle
3892 $SIG{ALRM} = \&sighandle;
3893 debugmsg(2, "Setting alarm for ping ($conf{connection_timeout} seconds)");
3894 alarm($conf{connection_timeout});
3896 debugmsg(2, "Pinging...");
3897 if($dbh->ping()) {
3898 debugmsg(2, "Ping successfull");
3899 alarm(0); # cancel alarm
3900 return(1);
3901 } else {
3902 debugmsg(2, "Ping failed");
3903 alarm(0); # cancel alarm
3904 db_reconnect();
3905 return(0);
3908 alarm(0); # cancel alarm
3911 sub query_err {
3912 my($query_type, $msg, $query) = @_;
3913 debugmsg(3, "query_err called", @_);
3914 # outputs a standard query error. does not exit
3915 # input: $query_type, $msg, $query
3917 chomp($query_type);
3918 chomp($msg);
3919 chomp($query);
3921 print STDERR "\n";
3922 print STDERR "$msg\n";
3923 print STDERR "Query: $query\n" if $query && $conf{sql_query_in_error};
3924 print STDERR "\n";
3927 sub lerr {
3928 my($msg) = @_;
3929 debugmsg(3, "err called", @_);
3930 # outputs an error message and exits
3932 print "Error: $msg\n";
3933 quit(1);
3936 sub soft_err {
3937 my($msg) = @_;
3938 debugmsg(3, "soft_err called", @_);
3939 # outputs a error, but doesn't exit
3941 print "\nError: $msg\n\n";
3944 sub wrn {
3945 my($msg) = @_;
3946 debugmsg(3, "wrn called", @_);
3947 # outputs a warning
3949 print STDERR "Warning: $msg\n";
3952 sub quit {
3953 my($exitcode, $force_quit, $msg) = @_;
3954 debugmsg(3, "quit called", @_);
3955 # just quits
3956 $exitcode ||= 0;
3957 $force_quit ||= 0; # Set this to 1 to try a smoother force quit
3958 $msg ||= '';
3960 setup_sigs();
3962 print "$msg" if $msg && $msg != "";
3963 $quitting = 1;
3965 if($force_quit) {
3966 exit($exitcode);
3969 commit_on_exit();
3971 # disconnect the database
3972 debugmsg(1, "disconnecting from database");
3973 if (defined $dbh) {
3974 $dbh->disconnect()
3975 or warn "Disconnect failed: $DBI::errstr\n";
3978 debugmsg(1, "exiting with exitcode: [$exitcode]");
3979 exit($exitcode);
3982 sub commit_on_exit {
3983 debugmsg(3, "commit_on_exit called", @_);
3985 # Commit... or not
3986 if($conf{commit_on_exit} && defined $dbh && !$dbh->{AutoCommit}) {
3987 # do nothing, oracle commits on disconnect
3988 } elsif(defined $dbh && !$dbh->{AutoCommit}) {
3989 print "Rolling back any outstanding transaction...\n";
3990 $dbh->rollback()
3991 or warn "Rollback failed: $DBI::errstr\n";
3995 sub debugmsg {
3996 my($debuglevel, @msgs) = @_;
3997 if($opt_debug >= $debuglevel ) {
3998 my @time = localtime();
3999 my $time = sprintf("%.4i-%.2i-%.2i %.2i:%.2i:%.2i", $time[5] + 1900,
4000 $time[4] + 1, $time[3], $time[2], $time[1], $time[0]);
4001 print STDERR "$time $debuglevel [" . join("] [", @msgs) . "]\n";
4005 sub usage {
4006 my($exit) = @_;
4007 debugmsg(3, "usage called", @_);
4009 $exit ||= 0;
4011 print <<_EOM_;
4012 Usage: yasql [options] [logon] [AS {SYSDBA|SYSOPER}] [@<file>[.ext]
4013 [<param1> <param2> ...]]
4014 Logon: <username>[/<password>][@<connect_string>] | /
4015 Options:
4016 -d, --debug=LEVEL Turn debugging on to LEVEL
4017 -H, --host=HOST Host to connect to
4018 -p, --port=PORT Host port to connect to
4019 -s, --sid=SID Oracle SID to connect to
4020 -h, -?, --help This help information
4021 -A, --nocomp Turn off building the auto-completion list
4022 -b, --bench, --benchmark Display extra benchmarking info
4023 -v, --version Print version and exit
4024 -B, --batch Batch mode (no headers, etc.)
4026 See the man pages for more help.
4027 _EOM_
4029 exit($exit);
4032 sub help {
4033 debugmsg(3, "help called", @_);
4034 # This just outputs online help
4036 my $help = <<_EOM_;
4038 Commands:
4039 help This screen
4040 quit, exit, \\q Exit the program.
4041 !<cmd>, host <cmd> Sends the command directly to a shell.
4042 \\A Regenerate the auto-completion list.
4043 connect [logon] [AS {SYSDBA|SYSOPER}]
4044 Open new connection.
4045 login = <username>[/<password>][@<connect_string>] | /
4046 reconnect, \\r Reconnect to the database
4047 desc[ribe] <object> Describe table, view, index, sequence, primary key,
4048 foreign key, constraint or trigger
4049 object = [<schema>.]<object>[\@dblink]
4050 show [all] <string> { like <name> }
4051 Shows [all] objects of a certain type
4052 string = tables, views, objects, sequences, clusters,
4053 dimensions, functions, procedures, packages,
4054 indexes, indextypes, libraries, snapshots,
4055 materialized views, synonyms, triggers,
4056 constraints
4057 name : use % for wildcard
4058 show <string> on|for <object>
4059 Shows properties for a particular object
4060 string = indexes, constraints, keys, checks, triggers,
4061 query, deps, ddl
4062 show invalid objects
4063 Shows all objects with status 'invalid'
4064 show processes Shows logged in users
4065 show locks Shows locks
4066 show [all] waits Shows [all] waits
4067 show plan Shows the last EXPLAIN PLAN ran
4068 show errors Shows errors from PL/SQL object creation
4069 l[ist], \\l, \\p List the contents of the current buffer
4070 cl[ear] [buffer], \\c
4071 Clear the current buffer
4072 ed[it] [filename], \\e [filename]
4073 Will open a text editor as defined by the EDITOR
4074 environment variable. If a file is given as the
4075 argument, then the editor will be opened with that
4076 file. If the given file does not exist then it will be
4077 created. In both cases the file will not be deleted,
4078 and the current buffer will be overwritten by the
4079 contents of the file. If no file is given, then the
4080 editor will be opened with a temporary file, which will
4081 contain the current contents of the buffer, or the last
4082 execute query if the buffer is empty. After the editor
4083 quits, the file will be read into the buffer. The
4084 contents will be parsed and executed just as if you had
4085 typed them all in by hand. You can have multiple
4086 commands and/or queries. If the last command is not
4087 terminated them you will be able to add furthur lines
4088 or input a terminator to execute the query.
4089 \@scriptname Execute all the commands in <filename> as if they were
4090 typed in directly. All CLI commands and queries are
4091 supported. yasql will quit after running all
4092 commands in the script.
4093 debug [num] Toggle debuggin on/off or if <num> is specified, then
4094 set debugging to that level
4095 autocommit Toggle AutoCommit on/off
4096 set <string> Set options
4097 string = [
4098 [long_read_len <size>]
4099 || [ fast_describe [on|off]]
4100 || [ serverout{put} [on|off] {size <size>} ]
4102 let <search string> Display all configurations
4104 Queries:
4105 All other input is treated as a query, and is sent straight to the database.
4107 All queries must be terminated by one of the following characters:
4108 ; - Returns data in table form
4109 / - Returns data in table form
4110 \\g - Returns data in non-aligned list form
4111 \\G - Returns data in aligned list form
4112 \\s - Returns data in CSV form. The first line is the column names
4113 \\S - Returns data in CSV form, but no column names
4114 \\i - Returns data in sql select commands form
4116 You may re-run the last query by typing the terminator by itself.
4118 Example:
4119 user\@ORCL> select * from table;
4120 user\@ORCL> \\g
4122 Return limit:
4123 You may add a number after the terminator, which will cause only the
4124 first <num> rows to be returned. e.g. 'select * from table;10' will run
4125 the query and return the first 10 rows in table format. This will also work
4126 if you just type the terminator to rerun the last query.
4128 Examples:
4129 The following will run the query, then run it again with different settings:
4130 user\@ORCL> select * from table;10
4131 user\@ORCL> \G50
4133 Redirection:
4134 You can add a shell like redirection operator after a query to pipe the output
4135 to or from a file.
4137 Output:
4138 You can use either '>' or '>>' to output to a file. '>' will overwrite the
4139 file and '>>' will append to the end of the file. The file will be created
4140 if it does not exist.
4142 Examples:
4143 user\@ORCL> select * from table; > table.dump
4144 user\@ORCL> select * from table\S > table.csv
4146 Input:
4147 You can use '<' to grab data from a CSV file. The file must be formatted
4148 with comma delimiters, quoted special fields, and rows seperated by
4149 newlines. When you use this operator with a query, the query will be ran
4150 for every line in the file. Put either '?' or ':n' (n being a number)
4151 placeholders where you want the data from the CSV file to be interpolated.
4152 The number of placeholders must match the number of columns in the CSV file.
4153 Each query is run as if you had typed it in, so the AutoCommit setting
4154 applies the same. If there is an error then the process will stop, but no
4155 rollback or anything will be done.
4157 Examples:
4158 user\@ORCL> insert into table1 values (?,?,?); < table1.csv
4159 user\@ORCL> update table2 set col1 = :1, col3 = :3, col2 = :2; < table2.csv
4161 Piping
4162 You can pipe the output from a query to the STDIN of any program you wish.
4164 Examples:
4165 user\@ORCL> select * from table; | less
4166 user\@ORCL> select * from table; | sort -n
4168 Please see 'man yasql' or 'perldoc yasql' for more help
4169 _EOM_
4171 my $ret = open(PAGER, "|$conf{pager}");
4172 if($ret) {
4173 print PAGER $help;
4174 close(PAGER);
4175 } else {
4176 print $help;
4180 sub get_object_type {
4181 debugmsg(3, "get_object_type", @_);
4182 my $object_name = shift;
4183 my $source = shift || 'ALL_OBJECTS';
4185 my $sqlstr = q{};
4186 my @data ;
4187 if (uc($source) eq 'ALL_OBJECTS'){
4188 $sqlstr = q{SELECT OBJECT_TYPE FROM all_objects WHERE OBJECT_NAME = ? AND OWNER= ? };
4189 @data = $dbh->selectrow_array($sqlstr, undef, uc($object_name), uc($dbuser));
4190 }elsif (uc($source) eq 'USER_OBJECTS' ) {
4191 $sqlstr = q{SELECT OBJECT_TYPE FROM USER_OBJECTS WHERE OBJECT_NAME = ? };
4192 @data = $dbh->selectrow_array($sqlstr, undef, uc($object_name));
4193 }elsif (uc($source) eq 'DBA_OBJECTS' ){
4194 query_err("internal", "get_object_type function doesn't support DBA_OBJECTS as source table!", "SELECT OBJECT_TYPE FROM DBA_OBJECTS.." );
4197 return shift @data
4200 __END__
4202 =head1 NAME
4204 yasql - Yet Another SQL*Plus replacement
4206 =head1 SYNOPSIS
4208 B<yasql> [options] [logon] [@<file>[.ext] [<param1> <param2>]
4210 =over 4
4212 =item logon
4214 <I<username>>[/<I<password>>][@<I<connect_string>>] | /
4216 =item options
4218 =over 4
4220 =item -d I<debuglevel>, --debug=I<debuglevel>
4222 Turn debuggin on to I<debuglevel> level. Valid levels: 1,2,3,4
4224 =item -H I<hostaddress>, --host=I<hostaddress>
4226 Host to connect to
4228 =item -p I<hostport>, --port=I<hostport>
4230 Host port to connect to
4232 =item -s I<SID>, --sid=I<SID>
4234 Oracle SID to connect to
4236 =item -h, -?, --help
4238 Output usage information and quit.
4240 =item -A, --nocomp
4242 Turn off the generation of the auto-completion list at startup. Use This if
4243 it takes too long to generate the list with a large database.
4245 =item -b, --bench, --benchmark
4247 Turn on extended benchmark info, which includes times and CPU usages for both
4248 queries and formatting.
4250 =item -v, --version
4252 Print version and exit
4254 =back
4256 =item Examples
4258 =over 4
4260 =item Connect to local database
4262 =over 4
4264 =item yasql
4266 =item yasql user
4268 =item yasql user/password
4270 =item yasql user@LOCAL
4272 =item yasql user/password@LOCAL
4274 =item yasql -h localhost
4276 =item yasql -h localhost -p 1521
4278 =item yasql -h localhost -p 1521 -s ORCL
4280 =back
4282 =item Connect to remote host
4284 =over 4
4286 =item yasql user@REMOTE
4288 =item yasql user/password@REMOTE
4290 =item yasql -h remote.domain.com
4292 =item yasql -h remote.domain.com -p 1512
4294 =item yasql -h remote.domain.com -p 1512 -s ORCL
4296 =back
4298 =back
4300 =back
4302 If no connect_string or a hostaddress is given, then will attempt to connect to
4303 the local default database.
4305 =head1 DESCRIPTION
4307 YASQL is an open source Oracle command line interface. YASQL features a much
4308 kinder alternative to SQL*Plus's user interface. This is meant to be a
4309 complete replacement for SQL*Plus when dealing with ad hoc queries and general
4310 database interfacing. It's main features are:
4312 =over 4
4314 =item Full ReadLine support
4316 Allows the same command line style editing as other ReadLine enabled programs
4317 such as BASH and the Perl Debugger. You can edit the command line as well as
4318 browse your command history. The command
4319 history is saved in your home directory in a file called .yasql_history. You
4320 can also use tab completion on all table and column names.
4322 =item Alternate output methods
4324 A different style of output suited to each type of need. There are currently
4325 table, list and CSV output styles. Table style outputs in the same manner as
4326 SQL*Plus, except the column widths are set based on the width of the data in
4327 the column, and not the column length defined in the table schema. List outputs
4328 each row on it's own line, column after column for easier viewing of wide return
4329 results. CSV outputs the data in Comma Seperated Values format, for easy
4330 import into many other database/spreadsheet programs.
4332 =item Output of query results
4334 You can easily redirect the output of any query to an external file
4336 =item Data Input and Binding
4338 YASQL allows you to bind data in an external CSV file to any query, using
4339 standard DBI placeholders. This is the ultimate flexibility when inserting or
4340 updating data in the database.
4342 =item Command pipes
4344 You can easily pipe the output of any query to an external program.
4346 =item Tab completion
4348 All tables, columns, and other misc objects can be completed using tab, much
4349 like you can with bash.
4351 =item Easy top rownum listings
4353 You can easily put a number after a terminator, which will only output those
4354 number of lines. No more typing "where rownum < 10" after every query. Now
4355 you can type 'select * from table;10' instead.
4357 =item Enhanced Data Dictionary commands
4359 Special commands like 'show tables', 'desc <table>', 'show indexes on <table>',
4360 'desc <sequence>', and many many more so that you can easily see your schema.
4362 =item Query editing
4364 You can open and edit queries in your favorite text editor.
4366 =item Query chaining
4368 You can put an abitrary number of queries on the same line, and each will be
4369 executed in turn.
4371 =item Basic scripting
4373 You can put basic SQL queries in a script and execute them from YASQL.
4375 =item Config file
4377 You can create a config file of options so that you don't have to set them
4378 everytime you run it.
4380 =item Future extensibility
4382 We, the community, can modify and add to this whatever we want, we can't do that
4383 with SQL*Plus.
4385 =back
4387 =head1 REQUIREMENTS
4389 =over 4
4391 =item Perl 5
4393 This was developed with Perl 5.6, but is known to work on 5.005_03 and above.
4394 Any earlier version of Perl 5 may or may not work. Perl 4 will definately not
4395 work.
4397 =item Unix environment
4399 YASQL was developed under GNU/Linux, and aimed at as many Unix installations as
4400 possible. Known to be compatible with GNU/Linux, AIX and Sun Solaris.
4401 Please send me an email (qzy@users.sourceforge.net) if it works for other platforms.
4402 I'd be especially interested if it worked on Win32.
4404 =item Oracle Server
4406 It has been tested and developed for Oracle8 and Oracle8i. There is atleast
4407 one issue with Oracle7 that I know of (see ISSUES below) and I have not tested
4408 it with Oracle9i yet.
4410 =item Oracle client libraries
4412 The Oracle client libraries must be installed for DBD::Oracle. Of course you
4413 can't install DBD::Oracle without them...
4415 =item DBD::Oracle
4417 DBD::Oracle must be installed since this uses DBI for database connections.
4419 =item ORACLE_HOME
4421 The ORACLE_HOME environment variable must be set if you use a connection
4422 descriptor to connect so that YASQL can translate the descriptor into
4423 usefull connection information to make the actual connection.
4425 =item ORACLE_SID
4427 The ORACLE_SID environment variable must be set unless you specify one with the
4428 -s option (see options above).
4430 =item Term::ReadLine
4432 Term::ReadLine must be installed (it is with most Perl installations), but more
4433 importantly, installing Term::ReadLine::Gnu from CPAN will greatly enhance the
4434 usability.
4436 =item Time::HiRes
4438 This is used for high resolution benchmarking. It is optional.
4440 =item Text::CSV_XS
4442 This perl module is required if you want to output CSV or input from CSV files.
4443 If you don't plan on using this features, then you don't need to install this
4444 module.
4446 =item Term::ReadKey
4448 This module is used for better input and output control. Right now it isn't
4449 required, but some parts of YASQL will look and function better with this
4450 installed.
4452 =back
4454 =head1 CONFIG
4456 YASQL will look for a config file first in ~/.yasqlrc then
4457 /etc/yasql.conf. The following options are available:
4459 =over 4
4461 =item connection_timeout = <seconds>
4463 Timeout for connection attempts
4465 Default: 20
4467 =item max_connection_attempts = <num>
4469 The amount of times to attempt the connection if the username/password are wrong
4471 Default: 3
4473 =item history_file = <file>
4475 Where to save the history file. Shell metachars will be globbed (expanded)
4477 Default: ~/.yasql_history
4479 =item pager = <file>
4481 Your favorite pager for extended output. (right now only the help command)
4483 Default: /bin/more
4485 =item auto_commit = [0/1]
4487 Autocommit any updates/inserts etc
4489 Default: 0
4491 =item commit_on_exit = [0/1]
4493 Commit any pending transactions on exit. Errors or crashes will still cause
4494 the current transaction to rollback. But with this on a commit will occur
4495 when you explicitly exit.
4497 Default: 0
4499 =item long_trunc_ok = [0/1]
4501 Long truncation OK. If set to 1 then when a row contains a field that is
4502 set to a LONG time, such as BLOB, CLOB, etc will be truncated to long_read_len
4503 length. If 0, then the row will be skipped and not outputted.
4505 Default: 1
4507 =item long_read_len = <num_chars>
4509 Long Read Length. This is the length of characters to truncate to if
4510 long_trunc_ok is on
4512 Default: 80
4514 =item edit_history = [0/1]
4516 Whether or not to put the query edited from the 'edit' command into the
4517 command history.
4519 Default: 1
4521 =item auto_complete = [0/1]
4523 Whether or not to generate the autocompletion list on connection. If connecting
4524 to a large database (in number of tables/columns sense), the generation process
4525 could take a bit. For most databases it shouldn't take long at all though.
4527 Default: 1
4529 =item extended_complete_list = [0/1]
4531 extended complete list will cause the possible matches list to be filled by
4532 basicly any and all objects. With it off the tab list will be restricted to
4533 only tables, columns, and objects owned by the current user.
4535 Default: 0
4537 =item complete_tables = [0/1]
4539 This controls whether or not to add tables to the completion list. This does
4540 nothing if auto_complete is set to 0.
4542 Default: 1
4544 =item complete_columns = [0/1]
4546 This controls whether or not to add columns to the completion list. This does
4547 nothing if auto_complete is set to 0.
4549 Default: 1
4551 =item complete_objects = [0/1]
4553 This controls whether or not to add all other objects to the completion list.
4554 This does nothing if auto_complete is set to 0. (Hint... depending on your
4555 schema this will include tables and columns also, so you could turn the other
4556 two off)
4558 Default: 1
4560 =item extended_benchmarks = [0/1]
4562 Whether or not to include extended benchmarking info after queries. Will
4563 include both execution times and CPU loads for both the query and formatting
4564 parts of the process.
4566 Default: 0
4568 =item prompt
4570 A string to include in the prompt. The prompt will always be suffixed by a
4571 '>' string. Interpolated variables:
4572 %H = connected host. will be prefixed with a '@'
4573 %U = current user
4575 Default: %U%H
4577 =item column_wildcards = [0/1]
4579 Column wildcards is an extremely experimental feature that is still being
4580 hashed out due to the complex nature of it. This should affect only select
4581 statements and expands any wildcards (*) in the column list. such as
4582 'select col* from table;'.
4584 Default: 0
4586 =item sql_query_in_error = [0/1]
4588 This this on to output the query in the error message.
4590 Default: 0
4592 =item nls_date_format = <string>
4594 Set the preferred NLS_DATE_FORMAT. This effects both date input and output
4595 formats. The default is ISO standard (YYYY-MM-DD HH24:MI:SS', not oracle
4596 default (YYYY-MM-DD).
4598 Default: YYYY-MM-DD HH24:MI:SS
4600 =item fast_describe
4602 Turn on fast describes. These are much faster than the old style of desc
4603 <table>, however non-built in datatypes may not be returned properly. i.e. a
4604 FLOAT will be returned as a NUMBER type. Internally FLOATs really are just
4605 NUMBERs, but this might present problems for you. If so, set this to 0
4607 Default: 1
4609 =back
4611 =head1 ISSUES
4613 =over 4
4615 =item Oracle7
4617 DBD::Oracle for Oracle8 may have issues connecting to an Oracle7 database. The
4618 one problem I have seen is that the use of placeholders in a query will cause
4619 oracle to issue an error "ORA-01008: not all variables bound". This will affect
4620 all of the hard-coded queries that I use such as the ones for the 'desc' and
4621 'show' commands. The queries that you type in on the command line may still
4622 work. The DBD::Oracle README mentions the use of the '-8' option to the
4623 'perl Makefile.PL' command to use the older Oracle7 OCI. This has not been
4624 tested.
4626 =back
4628 =head1 AUTHOR
4630 Originaly written by Nathan Shafer (B<nshafer@ephibian.com>) with support from
4631 Ephibian, Inc. http://www.ephibian.com
4632 Now it is mostly developed and maintained by Balint Kozman
4633 (B<qzy@users.sourceforge.net>). http://www.imind.hu
4635 =head1 THANKS
4637 Thanks to everyone at Ephibian that helped with testing, and a special thanks
4638 to Tom Renfro at Ephibian who did a lot of testing and found quite a few
4639 doozies.
4640 Also a lot of thanks goes to the mates at iMind.dev who keep suffering from
4641 testing new features on them.
4643 The following people have also contributed to help make YASQL what it is:
4644 Allan Peda, Lance Klein, Scott Kister, Mark Dalphin, Matthew Walsh
4646 And always a big thanks to all those who report bugs and problems, especially
4647 on other platforms.
4649 =head1 COPYRIGHT
4651 Copyright (C) 2000-2002 Ephibian, Inc., 2005 iMind.dev.
4654 =head1 LICENSE
4656 This program is free software; you can redistribute it and/or
4657 modify it under the terms of the GNU General Public License
4658 as published by the Free Software Foundation; either version 2
4659 of the License, or (at your option) any later version.
4661 This program is distributed in the hope that it will be useful,
4662 but WITHOUT ANY WARRANTY; without even the implied warranty of
4663 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
4664 GNU General Public License for more details.
4666 You should have received a copy of the GNU General Public License
4667 along with this program; if not, write to the Free Software
4668 Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
4670 =head1 TODO
4672 =over 4
4674 =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
4676 =item allow history to be saved based on host (as an option)
4678 =item make stifle_history a configurable option
4680 =item a row is printed after "Attempting to cancel query"
4682 =item reading from a script will not change prompt properly (for a script with no terminator)
4684 =item NULL stops printing after table goes into overflow or something
4686 =item extra space in \G... maybe others
4688 =item bug: tag completion doesn't work with caps anymore
4690 =item Add support for /NOLOG
4692 =item allow dblinks in show blah on blah commands
4694 =item show query doesn't work with schemas and db links
4696 =item add save and get buffer commands
4698 =item add R[UN] command (/ equivilent)
4700 =item add support for just 'connect' and prompt for username and password
4702 =item add PASSW[ORD] command for changing password
4704 =item add -s[ilent] command line to suppress all startup output and command prompts
4706 =item add 'start' command for scripting
4708 =item add 'run' synonum for '/'
4710 =item add 'show parameters <filter>' support
4712 =item fix segfaults when cancelling large outputs
4714 =item Add a 'SPOOL' command
4716 =item fix 'set...' commands
4718 =item Add variable bindings, prompting, control structures, etc.
4720 =item be able to describe any kind of object
4722 =item Add 'startup queries' in config file or support glogin.sql and login.sql
4724 =item fix case sensitive object names
4726 =item make win32 compliant
4728 =item add better error messages when the user can't access a data dictionary
4729 table
4731 =item add better error output, with line/col numbers and maybe a pointer.
4733 =item add chained ops, exactly like bash
4735 =item add plugins and hooks for all aspects.
4737 =item Add smarter tables and wrapping in columns. Also add configurable max
4738 column widths and max table width.
4740 =item Add a curses interface option for easy viewing and scrolling, etc. This
4741 will require some research to determine if it's even worth it.
4743 =item Add HTML output option
4745 =back
4747 =head1 CHANGELOG
4749 $Log: yasql,v $
4750 Revision 1.83 2005/05/09 16:57:13 qzy
4751 Fixed the 'DECIMAL' problem with describe command.
4752 Added sql mode with \i (patch by Ed Avis).
4753 Added redirectors (>, >>, |) to describe.
4754 Added 'show user' command.
4755 Added 'show uid' command.
4756 Added new makefile targets: clean, check. (patch by Ed Avis)
4757 Added "and owner = ?" to some show targets (patch by anonymous).
4758 Added command_complete_list feature and config option.
4759 Added disconnect command
4760 Added command completion: select, update, insert, delete, execute, etc.
4761 Added table.column name completion.
4762 Added feature to run tty-less (patch by Michael Kroell).
4763 Added a workaround for SunOS's alarm() bug (patch by Ed Avis).
4764 Fixed some minor issues in parser code.
4766 Revision 1.82 2005/02/18 16:57:13 qzy
4767 Added batch mode (ewl patch).
4768 Allow connections AS SYSDBA, AS SYSOPER and internal (sysdba patch by Derek Whayman).
4769 Added server_output to config options.
4770 Changed script execution to only add script lines to the query buffer (and not to history).
4772 Revision 1.81 2002/03/06 21:55:13 nshafer
4773 Fixed bug with password prompt.
4774 Added 'show plan' for outputting last explain plan results.
4775 Added 'show query' for viewing queries for views and materialized views.
4776 Optimized describes to be as fast as describes in SQL*Plus.
4777 Added new option 'fast_describe' on by default for new describe method.
4778 Added single_output as a formatting option for internal use.
4779 Fixed problem with password, quit, exit, \q getting added to the history list.
4780 Changed history to not add duplicate entries right next to each other.
4781 Added support for basic (non-returning) PL/SQL commands.
4782 Added support for create function, package, package body, prodedure, trigger.
4783 Added 'show errors' command
4784 Added 'conn' shortcut for 'connection'.
4785 Added 'exec[ute]' command.
4786 Added 'set serverout[put] on|off' command to mimic SQL*Plus's.
4787 Added alarms to pings in cases where DB connection is dropped and ping hangs.
4788 Cleaned up error messages.
4789 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.
4790 Changed quote escaping to be '' and "" instead of \' and \".
4791 Added full support for comments: rem[ark], --, and /* */.
4792 Right-justify works for the '8' datatype as well as '3' now.
4793 Re-worked debug output levels.
4794 Optimized query for completion lists a bit.
4795 Added completion-list limiting based on location in some DML statements (select, update, insert).
4796 Fixed up the display of '...' when generating tab completion list. Should work a lot better when hitting tab in the middle of the line.
4797 Added show views, objects, sequences, clusters, dimensions, functions, procedures, packages, indexes, indextypes, libraries, materialized views, snapshots, synonyms, triggers.
4798 Added show all <objects> command.
4799 Added type and owner columns to show commands.
4800 Fixed commit_on_exit logic.
4801 Added ability to use external authentication ('yasql /').
4802 The .sql extension for the scripting and editing commands are now optional.
4803 Fixed up editor execution to hopefully find the editor better.
4804 Added "Command" entry to "show processes".
4805 Added "show waits" and "show all waits" commands.
4806 Re-organized command line usage in anticipation for script parameters.
4807 Removed all uses of 'stty'.
4808 Added processing of STDIN, so redirects and pipes to YASQL work now.
4809 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
4810 Updated documentation.
4811 Fixed up alarm() calls.
4812 Fixed setting of NLS_DATE_FORMAT to apply on reconnects.
4813 Broke commands into 2 sets... ones that exectute any time, and ones that execute only when nothing is in the buffer
4814 Fixed printing of text read in from an edit command. It now echoes all of it.
4815 Now ignoring most SET commands so we don't tack them onto queries
4816 Fixed permissions in tarball
4818 Revision 1.80 2001/08/01 18:06:27 nshafer
4819 Fixed bug with delayed $term initialization\e\b
4821 Revision 1.79 2001/08/01 17:52:35 nshafer
4822 Fixed compatibility issues with the data dictionary in Oracle 7. Fixed ordering
4823 of indexes for compound indexes. Fixed display of objects from other schemas
4824 in some data dictionary commands such as 'show indexes on table'. (Thanks Nix)
4825 Fixed matching of declare and end in query string. Will not only match if on
4826 blank line. Fixed matching of '/' terminator in middle of queries. Will now
4827 only match if at end of line (Thanks Wesley Hertlein). Temp file for editing
4828 now appends '.sql' to end of temp file so that editors, like vim, automatically
4829 turn on syntax highlighting. Added searching of environment variable SQLPATH
4830 when looking for scripts. Terminal setup is now after script parsing, so that
4831 it will work when run under cron (Thanks David Zverina).
4833 Revision 1.78 2001/07/05 13:52:56 nshafer
4834 Fixed bug where parens were matching improperly.
4836 Revision 1.77 2001/07/04 02:57:08 nshafer
4837 Fixed bug where terminators wouldn't match if they were the next character
4838 after a quote character.
4840 Revision 1.76 2001/06/28 04:17:53 nshafer
4841 Term::ReadLine::Perl now supported, for what little functionality it does
4842 provide. Fixed segfault when hitting up when history is empty. Fixed bug
4843 when providing script names on command line (Thanks to Dave Zverina.)
4844 Rewrote the query parser to fix a bug, caused by the multiple-queries-on-one-
4845 line feature, that causes terminators, such as ';' and '/' to match when in
4846 quotes. When hitting tab on a line starting with a '@' for scripts, tab will
4847 now complete filenames and not database objects. Fixed DB timeout when
4848 prompting for username and password. Added support for 'DECLARE' keyword,
4849 however this does not mean that variable binding in PL/SQL blocks works yet.
4850 Sped up startup time a bit more (hopefully).
4852 Revision 1.75 2001/06/19 16:02:16 nshafer
4853 Fixed typo in error message for Term::ReadLine::Gnu
4854 Fixed crash when tab hit at username or password prompt
4855 Added -- as a comment type and fixed case where comment in quotes would
4856 match. (Mark Dalphin)
4857 Fixed 'desc' to also describe partitioned tables (Erik)
4859 Revision 1.74 2001/06/18 21:07:55 nshafer
4860 Fixed bug where / would not rerun last query (thanks Scott Kister)
4862 Revision 1.73 2001/05/23 18:35:17 nshafer
4863 Got rid of "Prototype mismatch" errors. Fixed typo in extended benchmarks
4865 Revision 1.72 2001/05/22 16:06:36 nshafer
4866 Fixed bug with error messages not displaying first time, and fixed bug with
4867 tab completion output
4869 Revision 1.71 2001/05/17 21:28:40 nshafer
4870 New CSV output format. Added CSV file input on any query. Added ability to
4871 pipe query results to any program. Added ability for multiple queries on one
4872 line. Changed tab completion generator to run first time you hit tab instead
4873 of on startup, which speeds up database connection. Now using SelfLoader to
4874 speed up loading and minimize memory use. Added a 'show plan for ____' command
4875 for easy display of explain plan output. Query times are now more readable
4876 and will split into weeks, days, hours, minutes, and seconds. Hopefully fixed
4877 some problems with stty and Solaris 2.4. Added support for 'rem' comments in
4878 scripts. Redirection output files are now shell expanded.
4880 Revision 1.70 2001/05/08 17:49:51 nshafer
4881 Fixed all places where a non-alphanumeric object name would break or not
4882 match.
4883 Added code for autoconf style installs.
4885 Revision 1.69 2001/05/07 23:47:47 nshafer
4886 fixed type
4888 Revision 1.68 2001/05/07 22:26:20 nshafer
4889 Fixed tab completion problems when completing objects with a $ in their name.
4890 Added config options complete_tables, complete_columns, and complete_objects,
4891 Added redirection of query output to file. Hopefully sped up exiting.
4892 Updated documentation.
4894 Revision 1.67 2001/05/04 17:35:04 nshafer
4895 YASQL will now suspend properly back to the shell when SIGTSTP is sent, as in
4896 when you hit ctrl-z on most systems. Added NLS_DATE_FORMAT setting in config
4897 file to support alter date views. Defaults to ISO standard. YASQL will now
4898 attempt to change it's process name, such as when viewed in ps or top. This
4899 will not work on all systems, nor is it a complete bullet proof way to hide
4900 your password if you provide it on the command line. But it helps to not
4901 make it so obvious to regular users. Scripts entered on the command line are
4902 now checked to be readable before attempting connection. A failed 'connect
4903 command will no long alter the prompt. Added \p option for printing the
4904 current buffer, ala psql. Large query results (over 1000 rows) are now
4905 handled MUCH better. YASQL will no longer try to hold more than 1000 rows in
4906 memory, which keeps it from sucking memory, and also improves the speed.
4907 When a query does return more than 1000 rows in table mode, those first 1000
4908 will determine the column widths, and all rows after that will get truncated.
4909 AIX has been reported to run YASQL perfectly.
4911 Revision 1.66 2001/03/13 21:34:58 nshafer
4912 There are no longer any references to termcap, so yasql should now work on
4913 termcap-less systems such as Debian Linux and AIX
4915 Revision 1.65 2001/03/12 17:44:31 nshafer
4916 Restoring the terminal is hopefully more robust and better now. YASQL now
4917 tries to use the 'stty' program to dump the settings of the terminal on
4918 startup so that it can restore it back to those settings. It requires that
4919 stty is installed in the path, but that should be the case with most systems.
4920 Also made the output of the query in the error message an option that is off
4921 by default. I had never meant to include that in the final release, but kept
4922 on forgetting to take it out.
4924 Revision 1.64 2001/03/06 16:00:33 nshafer
4925 Fixed bug where desc would match anytime, even in middle of query, which is
4926 bad.
4928 Revision 1.63 2001/03/01 17:30:26 nshafer
4929 Refined the ctrl-c process for not-so-linuxy OS's, namely solaris. Now
4930 stripping out Dos carriage returns since SQL*Plus seems to.
4932 Revision 1.62 2001/02/26 22:39:12 nshafer
4933 Fixed bug where prompt would reset itself when a blank line was entered.
4934 Added script argument on command line (Lance Klein)
4935 Added support for any command line commands in the script (Lance Klein)
4936 The 'desc' and 'show' commands no longer require a terminator (like ;) as long as the whole statement is on one line (Lance Klein)
4937 Added option 'extended_tab_list' for a much bigger, more complete tab listing (Lance Klein)
4938 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.
4939 cleaned up documentation a bit
4941 Revision 1.61 2001/01/31 19:56:22 nshafer
4942 changed CommitOnExit to be 1 by default, to emulate SQL*Plus behavior, and
4943 at popular request
4945 Revision 1.60 2001/01/29 16:38:17 nshafer
4946 got rid of (tm)
4948 Revision 1.59 2001/01/29 16:28:22 nshafer
4949 Modified docs a little with the new scope of open source now in the mix.
4951 Revision 1.58 2001/01/24 15:27:00 nshafer
4952 cleanup_after_signals is not in the Term::ReadLine::Stub, so it would
4953 output error messages on systems without Term::ReadLine::Gnu. Fixed
4955 Revision 1.57 2001/01/17 23:26:53 nshafer
4956 Added Tom Renfro's column_wildcard expansion code. New conf variable:
4957 column_wildcards. 0 by default until this code is expanded on a bit more.
4959 Revision 1.56 2001/01/17 23:00:25 nshafer
4960 Added CommitOnExit config, 0 by default. Added info output at startup and
4961 when a new connection is initiated about the state of AutoCommit and
4962 CommitOnExit. Also added statement about explicit rollback or commit when
4963 disconnecting. Added warning message to commit_cmd and rollback_cmd if
4964 AutoCommit is on. Now explicitly committing or rolling back on disconnect,
4965 it is no longer left up to the DBI's discretion... except in abnormal
4966 termination.
4968 Revision 1.55 2001/01/11 18:05:12 nshafer
4969 Added trap for regex errors in tab completion (like if you put 'blah[' then
4970 hit tab)
4972 Revision 1.54 2001/01/10 17:07:22 nshafer
4973 added output to those last 2 commands
4975 Revision 1.53 2001/01/10 17:03:58 nshafer
4976 added commit and rollback commands so that you don't have to send them to the
4977 backend
4979 Revision 1.52 2001/01/10 16:00:08 nshafer
4980 fixed bug with prompt where on each call get_prompt would add another '@'.
4981 Thanks Tom
4983 Revision 1.51 2001/01/09 21:16:12 nshafer
4984 dar... fixed another bug where the %H would stay if there was no prompt_host
4986 Revision 1.50 2001/01/09 21:12:13 nshafer
4987 fixed bug with that last update. Now it only interpolates the %H variable
4988 if there is something to interpolate it with
4990 Revision 1.49 2001/01/09 21:09:56 nshafer
4991 changed the %H variable to be prefixed with a @
4993 Revision 1.48 2001/01/09 21:04:36 nshafer
4994 changed 'default' to '' for the prompt's hostname when no connect_string is
4995 used
4997 Revision 1.47 2001/01/09 20:55:11 nshafer
4998 added configurable prompt and changed the default prompt
5000 Revision 1.46 2001/01/09 18:50:50 nshafer
5001 updated todo list
5003 Revision 1.45 2001/01/09 18:32:35 nshafer
5004 Added 'connect <connect_string>' command. I may add the ability to specify
5005 options like on the command line (like '-H blah.com')
5007 Revision 1.44 2001/01/08 22:08:49 nshafer
5008 more documentation changes
5010 Revision 1.43 2001/01/08 20:51:31 nshafer
5011 added some documentation
5013 Revision 1.42 2001/01/08 20:09:35 nshafer
5014 Added debug and autocommit commands
5016 Revision 1.41 2001/01/08 18:12:43 nshafer
5017 added END handler to hopefully clean up the terminal better
5019 Revision 1.40 2001/01/05 23:29:38 nshafer
5020 new name!
5022 Revision 1.39 2001/01/05 18:00:16 nshafer
5023 Added config file options for auto completion generation and extended
5024 benchmark info
5026 Revision 1.38 2001/01/05 16:39:47 nshafer
5027 Fixed error where calling edit a second time would not open the file properly
5028 because of the way glob() works.
5030 Revision 1.37 2001/01/04 23:52:30 nshafer
5031 changed the version string to parse it out of the revision string (duh...)
5032 moved the prompting of username and password so that the check for the
5033 oracle_home variable happens before. Before if you didn't have the environment
5034 variable set then it will prompt you for username and password, then die
5035 with the error, which is annoying
5036 fixed the quit calls so taht they properly erase the quit line from the
5037 history. I had broken this a long time ago when I added the exit status
5038 param to the quit function
5039 Outputting in full table format (';' terminator) with a num_rows number
5040 (like ';100') would still cause the entire result set to be pulled into
5041 memory, which was really slow and could take a lot of memory if the table
5042 was large. Fixed it so that it only pulls in num_rows number of rows when
5043 using the digit option
5045 Revision 1.36 2000/12/22 22:12:18 nshafer
5046 fixed a wrong-quote-type in the debug messages
5048 Revision 1.35 2000/12/22 22:07:06 nshafer
5049 forgot version... you know the drill...
5051 Revision 1.34 2000/12/22 21:57:01 nshafer
5052 Added config file support, queries from the 'edit' command are now entered
5053 into the command history (configurable), cleaned up the SIGINT actions quite
5054 a bit so they should work better now, added LongReadLen and LongTruncOk
5055 options so that LONG columns types won't mess up, added the number after terminator
5056 feature to limit how many rows are returned.
5058 Revision 1.33 2000/12/20 22:56:03 nshafer
5059 version number.... again.... sigh
5061 Revision 1.32 2000/12/20 22:55:32 nshafer
5062 added todo item, now in rpms
5064 Revision 1.31 2000/12/20 17:07:52 nshafer
5065 added the reprompt for username/password on error 1005 null password given
5067 Revision 1.30 2000/12/20 17:04:18 nshafer
5068 Refined the shadow_redisplay stuff. Now I will only use my builtin function
5069 if the terminal type is set to "xterm" because that terminal type has a
5070 broken termcap entry. Also set it to not echo when entering password if
5071 Term::ReadLine::Gnu is not installed
5073 Revision 1.29 2000/12/20 15:47:56 nshafer
5074 trying a new scheme for the shadow_redisplay. Clear to EOL wasn't working
5075 Also fixed a few problems in the documentation
5078 Revision 1.28 2000/12/19 23:55:03 nshafer
5079 I need to stop forgetting the revision number...
5081 Revision 1.27 2000/12/19 23:48:49 nshafer
5082 cleaned up debugging
5084 Revision 1.26 2000/12/19 23:10:18 nshafer
5085 Lotsa new stuff... tab completion of table, column, and object names,
5086 improved signal handling, the edit command now accepts a filename parameter,
5087 new command 'show processes' which shows you info on who's connected,
5088 improved benchmark info, and a lot of other cleanup/tweaks
5090 Revision 1.25 2000/12/13 16:58:26 nshafer
5091 oops forgot documentation again
5093 Revision 1.24 2000/12/13 16:54:42 nshafer
5094 added desc <trigger>
5096 Revision 1.23 2000/12/12 17:52:15 nshafer
5097 updated todo list (oops, forgot)
5099 Revision 1.22 2000/12/12 17:51:39 nshafer
5100 added desc <index>
5102 Revision 1.21 2000/12/12 17:15:28 nshafer
5103 fixed bug when connecting using a host string (-H option)
5104 added a few more types to the 'show' and 'desc' commands
5106 Revision 1.20 2000/12/08 22:13:43 nshafer
5107 many little fixes and tweaks here and there
5109 Revision 1.19 2000/12/06 20:50:03 nshafer
5110 added scripting ability with "@<filename>" command
5111 changed all tabs to spaces!
5113 Revision 1.18 2000/12/06 19:30:38 nshafer
5114 added clear command
5115 refined connection process. if invalid username/password entered then prompt again
5117 Revision 1.17 2000/12/05 22:20:58 nshafer
5118 Tightened up outputs. Doesn't show column names if no rows selected, if
5119 it's not a select, then show number of rows affected
5121 Revision 1.16 2000/12/04 18:04:53 nshafer
5122 *** empty log message ***
5124 Revision 1.15 2000/12/04 18:03:14 nshafer
5125 fixed bug where the -H option was interpreted as -h or help. All command
5126 line options are now case sensitive
5128 Revision 1.14 2000/12/04 17:54:38 nshafer
5129 Added list command (and \l and l)
5131 Revision 1.13 2000/12/04 17:34:18 nshafer
5132 fixed a formatting issue if Time::HiRes isn't installed
5134 Revision 1.12 2000/12/04 17:29:41 nshafer
5135 Added benchmark options to view the extended benchmark info. Now it displays
5136 just the time in a more friendly format. The old style is only active if the
5137 benchmark option is specified.
5138 Cleaned up some formatting issues
5139 Brought the usage and POD documentation up to date
5140 Added some items to the TODO
5142 Revision 1.11 2000/11/30 22:54:38 nshafer
5143 Fixed bug with the edit command where if you were 'inquotes' then you would
5144 stay in quotes even after editing the file
5146 Revision 1.10 2000/11/30 22:01:38 nshafer
5147 Fixed bug where username and password were added to the command history.
5148 Set it so that the quit commands are not added to the command history either.
5149 Added the 'edit' command and modified it's todo list item, as well as added
5150 it to the 'help' command
5152 Revision 1.9 2000/11/29 17:55:35 nshafer
5153 changed version from .21 to 1.0 beta 9. I'll follow the revision numbers now
5155 Revision 1.8 2000/11/29 17:46:31 nshafer
5156 added a few items to the todo list
5158 Revision 1.7 2000/11/29 15:50:56 nshafer
5159 got rid of SID output at startup
5161 Revision 1.6 2000/11/29 15:49:51 nshafer
5162 moved revision info to $revision and added Id output
5164 Revision 1.5 2000/11/29 15:46:41 nshafer
5165 fixed revision number
5167 Revision 1.4 2000/11/29 15:44:23 nshafer
5168 fixed issue where environment variable ORACLE_SID overwrote explicit set
5169 on the command line. now whatever you put on the command line will overwrite
5170 the environment variable
5172 =cut