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
45 # Load DBD::Oracle early to work around SunOS bug. See
46 # http://article.gmane.org/gmane.comp.lang.perl.modules.dbi.general/207
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
65 $sysconf = "$sysconfdir/yasql.conf";
67 # try to include Time::HiRes for fine grained benchmarking
69 use Time::HiRes qw (gettimeofday tv_interval);
72 # try to include Text::CSV_XS for input and output of CSV data
80 # install signal handlers
82 $SIG{INT
} = \
&sighandle
;
83 $SIG{TSTP
} = 'DEFAULT';
84 $SIG{TERM
} = \
&sighandle
;
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
92 warn(@_) unless $_[0] =~ /environment variable not set!/;
95 # initialize the whole thing
100 wrn
("Time::HiRes not installed. Please install if you want benchmark times "
101 ."to include milliseconds.");
109 # start the interface
114 ################################################################################
115 ########### non-self-loaded functions ########################################
118 $VERSION = 'unknown';
122 if($a =~ /^\@/ && $b !~ /^\@/) {
124 } elsif($a !~ /^\@/ && $b =~ /^\@/) {
133 debugmsg
(3, "sighandle called", @_);
135 $SIG{$sig} = \
&sighandle
;
137 if($sig =~ /INT|TERM|TSTP/) {
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";
146 # the user has alrady hit INT and so we now force an exit
147 print STDERR
"Caught another SIG$sig\n";
154 if(defined $cursth) {
155 print STDERR
"Attempting to cancel query...\n";
156 debugmsg
(1, "canceling statement handle");
157 my $ret = $cursth->cancel();
160 } elsif(!$connected) {
163 if(defined $cursth) {
164 print STDERR
"Attempting to cancel query...\n";
165 debugmsg
(1, "canceling statement handle");
166 my $ret = $cursth->cancel();
171 } elsif($sig eq 'ALRM') {
174 wrn
("Connection lost (timeout: $conf{connection_timeout})");
177 lerr
("Could not connect to database, timed out. (timeout: "
178 ."$conf{connection_timeout})");
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 ##############################################
202 # call GetOptions to parse the command line
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
232 $completion_built = 0;
234 usage
(0) if $opt_help;
236 # Output startup string
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";
249 print STDERR
"Please type 'help' for usage instructions\n";
253 # parse the config files. We first look for ~/.yasqlrc, then
255 # first set up the defaults
257 connection_timeout
=> 20,
258 max_connection_attempts
=> 3,
259 history_file
=> '~/.yasql_history',
260 pager
=> '/bin/more',
267 extended_benchmarks
=> 0,
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,
278 server_output
=> 2000,
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;
291 debugmsg
(2, "Reading config: $config_file");
292 open(CONFIG
, "$config_file");
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
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");
331 # Parse the SQLPATH environment variable if it exists
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;
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';
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]);
362 # nothing was provided
363 debugmsg
(2, "No command line args were found");
364 $dbh = db_connect
(1, $ora_session_mode);
366 debugmsg
(2, "command line args found!");
368 # an argument was given!
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;
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;
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);
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
415 setup_term
() unless $term;
419 $conf{pager
} = $ENV{PAGER
} if $ENV{PAGER
};
423 # set up the Term::ReadLine
424 $term = new Term
::ReadLine
('YASQL');
428 debugmsg
(1, "Using " . $term->ReadLine());
430 if($term->ReadLine eq 'Term::ReadLine::Gnu') {
431 # Term::ReadLine::Gnu specific setup
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");
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}: $!");
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
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", @_);
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;
503 $connect_string = 'external';
504 return($ora_session_mode, $username, $password, $connect_string);
505 } elsif($arg eq 'internal') {
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
515 $connect_string = $3;
516 return($ora_session_mode, $username, $password, $connect_string);
517 } elsif($arg =~ /^([^\@]+)\@(.*)$/) {
518 # username@connect_string
521 $connect_string = $2;
522 return($ora_session_mode, $username, $password, $connect_string);
523 } elsif($arg =~ /^([^\/]+)\
/([^\@]+)$/) {
527 $connect_string = '';
528 return($ora_session_mode, $username, $password, $connect_string);
529 } elsif($arg =~ /^([^\/\@
]+)$/) {
533 $connect_string = '';
534 return($ora_session_mode, $username, $password, $connect_string);
535 } elsif($arg =~ /^\@(.*)$/) {
539 $connect_string = $1;
540 return($ora_session_mode, $username, $password, $connect_string);
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
556 print STDERR
"Generating auto-complete list...\n";
559 if($conf{extended_complete_list
}) {
561 if($conf{complete_tables
}) {
562 push(@queries, 'select table_name from all_tables');
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);
577 or query_err
('execute', $DBI::errstr
, $sqlstr), setup_sigs
(), return(0);
578 while(my $res = $sth->fetchrow_array()) {
579 push(@completion_list, $res);
583 if($conf{complete_tables
}) {
584 push(@queries, "select 'table-' || table_name from user_tables");
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);
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) {
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);
621 or query_err
('execute', $DBI::errstr
, $sqlstr), setup_sigs
(), return(0);
622 while(my $res = $sth->fetchrow_array()) {
623 push(@completion_list, $res);
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;
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]");
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-');
704 debugmsg
(2,"grep: [@grep]");
707 if($last_char =~ /^[A-Z]$/) {
712 foreach my $grep (@grep) {
713 foreach my $list_item (grep(/$grep/, @completion_list)) {
714 my $item = $list_item;
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);
734 debugmsg
(3, "db_reconnect called", @_);
735 # This first disconnects the database, then tries to reconnect
737 print "Reconnecting...\n";
742 if (not $dbh->disconnect()) {
743 warn "Disconnect failed: $DBI::errstr\n";
748 $dbh = db_connect
(1, @dbparams);
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:
761 # Connect to $opt_host on $opt_sid. Specify port only if $opt_port is
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();
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
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
801 # install alarm signal handle
802 $SIG{ALRM
} = \
&sighandle
;
803 alarm($conf{connection_timeout
});
806 print "Attempting connection to local database\n";
808 $dbhandle = DBI
->connect('dbi:Oracle:',undef,undef,$attributes)
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
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;
826 $userstring = $username . '@' . $connect_string;
828 $userstring = $connect_string;
831 # install alarm signal handle
832 $SIG{ALRM
} = \
&sighandle
;
833 alarm($conf{connection_timeout
});
836 print "Attempting connection to $userstring\n";
838 $dbhandle = DBI
->connect('dbi:Oracle:',$userstring,$password,$attributes)
841 $dberrstr = $DBI::errstr
;
844 $this_prompt_host = $connect_string;
845 $this_prompt_user = $username;
846 alarm(0); # cancel alarm
848 # attempt a connection to $opt_host
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,
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
875 # attempt a connection without specifying a hostname or anything
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)
889 $dberrstr = $DBI::errstr
;
892 $this_prompt_host = $ENV{ORACLE_SID
};
893 $this_prompt_user = $username;
894 alarm(0); # cancel alarm
898 # Save the parameters for reconnecting
899 @dbparams = ($ora_session_mode, $username, $password, $connect_string);
901 # set the $dbuser global for use elsewhere
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%'");
913 print "Connected to: $banner\n\n";
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]");
938 wrn
("Could not connect to database: $dberrstr [$dberr]");
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);
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
961 $prompt_length ||= 5; #just in case normal prompt hasn't been outputted
962 debugmsg
(2, "prompt_length: [$prompt_length]");
965 my $temp_prompt = sprintf('%' . $prompt_length . 's', $prompt_string . '> ');
966 return($temp_prompt);
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);
979 my($ora_session_mode, $username, $password) = @_;
980 debugmsg
(3, "get_up called", @_);
984 setup_term
() unless $term;
986 # Get username/password
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';
996 # Take that entry off of the history list
997 if ($term_type eq 'gnu') {
998 $term->remove_history($term->where_history());
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
1025 lerr
("Please set your ORACLE_HOME environment variable!")
1026 unless $ENV{ORACLE_HOME
};
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
{
1042 my @string = unpack("C*", $string);
1045 if($_ >= 40 && $_ <= 176) {
1046 $ret_string .= chr($_);
1048 $ret_string .= "<$_>";
1051 return($ret_string);
1055 debugmsg
(3, "interface called", @_);
1056 # this is the main program loop that handles all the user input.
1058 my $prompt = get_prompt
();
1062 # Check if we were interactively called, or do we need to process STDIN
1064 while(defined($input = $term->readline($prompt))) {
1066 $prompt = process_input
($input, $prompt) || get_prompt
();
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();
1079 quit
(0, undef, "\n");
1083 my($input, $prompt, $add_to_history) = @_;
1084 if (!(defined($add_to_history))) {
1085 $add_to_history = 1;
1087 debugmsg
(3, "process_input called", @_);
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'),
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
;
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;
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
1166 ; # the ';' terminator
1168 ^\s*\/\s*$ # the slash terminator at end of string
1170 \\[GgsSi] # one of the complex terminators
1172 (?:^|\s+)create\s+ # create
1174 (?:^|\s+)function\s+ # function
1176 (?:^|\s+)package\s+ # package
1178 (?:^|\s+)package\s+body\s+ # package body
1180 (?:^|\s+)procedure\s+ # procedure
1182 (?:^|\s+)trigger\s+ # trigger
1184 (?:^|\s+)declare\s+ # declare
1186 (?:^|\s+)begin\s+ # begin
1188 \/\* # start of multiline comment
1190 \*\/ # end of multiline comment
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);
1207 } elsif($match =~ /create/ix) {
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))
1217 } elsif($match =~ /^\/\
*/) {
1219 } elsif($match =~ /^\*\//) {
1221 } elsif(!$inquotes && !$incomment && $match !~ /^--/ &&
1222 ($match =~ /^\s*\/\s
*$/ || !$inplsqlblock))
1225 debugmsg
(4,"qbuffer IN: [$qbuffer]");
1226 my $terminator = $match;
1227 $post =~ / (\d
*) # Match num_rows right after terminitor
1228 \s
* # Optional whitespace
1230 ( >{1,2}|<|\
| ) # Match redirection operators
1231 \s
* # Optional whitespace
1232 ( .* ) # The redirector (include rest of line)
1234 \s
* # Optional whitespace
1235 (.*) # Catch everything else
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 =~ /--.*$/) {
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");
1252 # deduce the format from the terminator type
1255 $fbuffer = $terminator;
1257 if($terminator eq ';' || $terminator =~ /^\/\s
*$/) {
1259 } elsif($terminator eq '\g') {
1261 } elsif($terminator eq '\G') {
1262 $format = 'list_aligned';
1263 } elsif($terminator eq '\s') {
1265 } elsif($terminator eq '\S') {
1266 $format = 'csv_no_header';
1267 } elsif($terminator eq '\i') {
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);
1278 $use_buffer = $qbuffer;
1280 } elsif($last_qbuffer) {
1281 $use_buffer = $last_qbuffer;
1284 $use_buffer = undef;
1291 my($max_lines, @params, $max_lines_save, @querybench,
1292 $rows_affected, $success_code);
1293 my $result_output = 1;
1294 push(@querybench, get_bench
());
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]");
1307 print "Error in line " . ($count + 1) . " of file '$op_text'\n";
1313 $rows_affected += $res[0];
1314 $success_code = $res[1];
1317 push(@querybench, get_bench
());
1319 if($result_output) {
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);
1328 output_benchmark
("Query: ", @querybench, "\n");
1330 output_benchmark
(" (", @querybench, ")");
1337 query
($use_buffer, $format, {num_rows
=> $num_rows, op
=> $op,
1338 op_text
=> $op_text});
1342 # copy the current qbuffer to old_qbuffer
1343 $last_qbuffer = $qbuffer;
1344 $last_fbuffer = $fbuffer;
1347 query_err
('Query', 'No current query in buffer');
1356 return(parse_input
($extra));
1358 # return a 'new' prompt
1359 return(get_prompt
());
1364 $qbuffer .= $input . "\n";
1366 debugmsg
(4,"qbuffer: [$qbuffer], input: [$input]");
1369 return(get_prompt
($quote));
1370 } elsif($incomment) {
1371 return(get_prompt
('DOC'));
1373 return(get_prompt
('-'));
1378 my($op, $op_text) = @_;
1379 debugmsg
(3, "get_csv_file called", @_);
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: $!");
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: $!");
1403 $csv_filehandle_open = 1;
1407 while(defined($line) && $line =~ /^\s*$/) {
1416 debugmsg
(3, "read in CSV line", $line);
1419 if($csv->parse($line)) {
1420 @fields = $csv->fields();
1421 debugmsg
(3, "got CVS fields", @fields);
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);
1432 close(CSV
) || lerr
("Could not close CSV filehandle: $!");
1433 $csv_filehandle_open = 0;
1439 debugmsg
(3, "connect_cmd called", @_);
1442 wrn
("Invalid connect syntax. See help");
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);
1450 warn "failed to make new connection as $username to $connect_string: $DBI::errstr\n";
1451 warn "keeping old connection\n";
1458 or warn "failed to disconnect old connection - switching anyway\n";
1465 sub disconnect_cmd
{
1466 debugmsg
(3, "disconnect_cmd called", @_);
1469 print "Closing last connection...\n";
1472 $dbh->disconnect() if (defined $dbh);
1475 print "Not connected.\n";
1480 debugmsg
(3, "commit_cmd called", @_);
1481 # this just called commit
1484 if($dbh->{AutoCommit
}) {
1485 wrn
("commit ineffective with AutoCommit enabled");
1487 if ($dbh->commit()) {
1488 print "Transaction committed\n";
1491 warn "Commit failed: $DBI::errstr\n";
1495 print "No connection\n";
1500 debugmsg
(3, "rollback_cmd called", @_);
1501 # this just called commit
1504 if($dbh->{AutoCommit
}) {
1505 wrn
("rollback ineffective with AutoCommit enabled");
1507 if ($dbh->rollback()) {
1508 print "Transaction rolled back\n";
1511 warn "Rollback failed: $DBI::errstr\n";
1515 print "No connection\n";
1521 debugmsg
(3, "exec_cmd called", @_);
1522 # Wrap the statement in BEGIN/END and execute
1530 query
($sqlstr, 'table');
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;
1544 my $prompt = get_prompt
();
1546 debugmsg
(2, "passed_file: [$passed_file]");
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;
1555 debugmsg
(2, "Using blank contents");
1559 debugmsg
(3, "filecontents: [$filecontents]");
1561 # determine the tmp directory
1564 $tmpdir = $ENV{TMP
};
1565 } elsif($ENV{TEMP
}) {
1566 $tmpdir = $ENV{TEMP
};
1567 } elsif(-d
"/tmp") {
1573 # determine the preferred editor
1576 $editor = $ENV{EDITOR
};
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
1593 # if the file was passed, then check for it's existance
1595 # The file was found
1597 } elsif(-e
"$filename.sql") {
1598 # the file was found with a .sql extension
1599 $filename = "$filename.sql";
1602 wrn
("$filename was not found, creating new file, which will not be ".
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
1610 my $ret = open(TMPFILE
, ">$filename");
1611 if(!$ret) { #if file was NOT opened successfully
1612 wrn
("Could not write to $filename: $!");
1614 print TMPFILE
$filecontents;
1619 # now spawn the editor
1620 my($ret, @filecontents);
1621 debugmsg
(2, "Executing $editor $filename");
1622 $ret = system($editor, "$filename");
1624 debugmsg
(2, "Executing env $editor $filename");
1625 $ret = system("env", $editor, "$filename");
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: $!");
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: $!");
1640 # delete our qbuffer and reset the inquotes var
1647 push(@filecontents, $_);
1655 print join('', @filecontents);
1658 foreach my $line (@filecontents) {
1659 # chomp off newlines
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: $!");
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
1689 $input =~ /^\@(.*)$/;
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";
1700 } elsif(-e
"$path/$file.sql") {
1701 $file = "$path/$file.sql";
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
();
1714 # read in the script
1716 # chomp off newlines
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);
1732 debugmsg
(3, "show_qbuffer called", @_);
1733 # This outputs the current buffer
1735 #print "\nBuffer:\n";
1739 print STDERR
"Buffer empty";
1745 debugmsg
(3, "clear_qbuffer called", @_);
1746 # This clears the current buffer
1753 print "Buffer cleared\n";
1754 return(get_prompt
());
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');
1770 $opt_debug = $debuglevel;
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;
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 );
1810 my $sqlstr = $select;
1811 $sqlstr .= $where if ($static_where);
1812 $sqlstr .= $order_by;
1814 query
($sqlstr , $format, $opts );
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') {
1843 if($dbversion >= 8) {
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
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') {
1873 select constraint_name "Constraint Name",
1874 decode(constraint_type,
1880 search_condition "Search Condition"
1881 from all_constraints
1882 where table_name = ?
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') {
1890 select ac.constraint_name "Name",
1891 decode(ac.constraint_type,
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 = ?
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') {
1916 select ac.constraint_name "Name",
1917 decode(ac.constraint_type,
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'
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') {
1932 select trigger_name "Trigger Name",
1933 trigger_type "Type",
1935 triggering_event "Event"
1937 where table_name = ?
1940 query
($sqlstr, $format, {num_rows
=> $num_rows, op
=> $op,
1941 op_text
=> $op_text}, uc($2), uc($dbuser));
1942 } elsif($1 eq 'query') {
1944 select count(*) from all_mviews where mview_name = ? and owner = ?
1946 my $is_mview = $dbh->selectrow_array($sqlstr, undef, uc($2), uc($dbuser));
1951 where mview_name = ?
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') {
1971 column_name "Column Name"
1973 , tablett || '(' || pk || ')' "Reference"
1974 , constraint_name "Constraint"
1980 c.owner || '.' || c.table_name tablett,
1984 from all_constraints a,
1988 where a.constraint_name = b.constraint_name
1989 and a.r_constraint_name is not null
1990 and a.r_constraint_name=c.constraint_name
1991 and c.constraint_name=d.constraint_name
1992 and a.owner = b.owner and c.owner = d.owner
1996 a.table_name parent_table,
1998 c.owner || '.' || c.table_name tablett,
2002 FROM all_constraints a,
2006 WHERE a.constraint_name = b.constraint_name
2007 AND a.constraint_name = c.r_constraint_name
2008 AND c.constraint_name = d.constraint_name
2009 and a.owner = b.owner and c.owner = d.owner
2010 ) where table_name like ?
2014 query
($sqlstr, 'table', {num_rows
=> $num_rows, op
=> $op,
2015 op_text
=> $op_text}, uc($table), uc($dbuser));
2016 } elsif($1 eq 'ddl') {
2017 my $object_name = $2;
2018 my $object_type = get_object_type
($object_name);
2020 my $prev_LongReadLen = $dbh->{LongReadLen
};
2021 $dbh->{LongReadLen
} = 16_000
;
2023 if ( $object_type eq 'TABLE'){
2025 SELECT DBMS_METADATA.GET_DDL('TABLE', ?, ?) FROM dual
2027 SELECT DBMS_METADATA.GET_DEPENDENT_DDL('INDEX', ?, ?) FROM dual
2029 SELECT DBMS_METADATA.GET_DEPENDENT_DDL ('COMMENT', ?, ?) FROM dual
2031 SELECT DBMS_METADATA.GET_DEPENDENT_DDL('TRIGGER', ?, ?) FROM dual
2033 query
($sqlstr, 'quiet-list', {num_rows
=> $num_rows, op
=> $op, op_text
=> $op_text}
2044 $object_type eq 'SYNONYM'
2045 or $object_type eq 'VIEW'
2046 or $object_type eq 'TRIGGER'
2047 or $object_type eq 'SEQUENCE'
2048 or $object_type eq 'INDEX'
2052 SELECT DBMS_METADATA.GET_DDL(?, ?, ?) FROM dual
2054 query
($sqlstr, 'quiet-list', {num_rows
=> $num_rows, op
=> $op, op_text
=> $op_text}
2060 query_err
("show dll", "Unsupported object type ($object_name is a $object_type)", $input);
2063 $dbh->{LongReadLen
} = $prev_LongReadLen;
2065 query_err
("show", "Unsupported show type", $input);
2067 } elsif($input =~ /^\s*show\s+all\s+([a-zA-Z0-9_\$\#]+)\s*([a-zA-Z0-9_\'\$\#\%\s]*)$/) {
2071 my $option_value = '';
2073 num_rows
=> $num_rows
2075 ,op_text
=> $op_text
2077 # Workaround for materialized views
2078 if ($object eq 'materialized' and $2 =~ /views\s*([a-zA-Z0-9_\$\#\%\s]*)/ ){
2079 $object = 'materialized views';
2083 if ($rest =~ /\s*(\w+)\s+[']?([a-zA-Z0-9_\$\#\%]+)[']?/){
2085 $option_value = uc($2);
2088 if($object eq 'tables') {
2091 q{select table_name "Table Name", 'TABLE' "Type", owner "Owner" from all_tables }
2092 ,q{ order by table_name }
2101 } elsif($object eq 'views') {
2104 q{select view_name "View Name", 'VIEW' "Type", owner "Owner" from all_views }
2105 ,q{ order by view_name }
2114 } elsif($object eq 'objects') {
2117 q{select object_name "Object Name", object_type "Type", owner "Owner" from all_objects }
2118 ,q{ order by object_name }
2127 } elsif($object eq 'sequences') {
2130 q{select sequence_name "Sequence Name", 'SEQUENCE' "Type", sequence_owner "Owner" from all_sequences }
2131 ,q{ order by sequence_name }
2140 } elsif($object eq 'clusters') {
2143 q{select cluster_name "Cluster Name", 'CLUSTER' "Type", owner "Owner" from all_clusters}
2144 ,q{ order by cluster_name }
2153 } elsif($object eq 'dimensions') {
2156 q{select dimension_name "Dimension Name", 'DIMENSION' "Type", owner "Owner" from all_dimensions}
2157 ,q{ order by dimension_name }
2166 } elsif($object eq 'functions') {
2169 q{select distinct name "Function Name", 'FUNCTION' "Type", owner "Owner" from all_source}
2173 ,q{type = 'FUNCTION'}
2179 } elsif($object eq 'procedures') {
2182 q{select distinct name "Procedure Name", 'PROCEDURE' "Type", owner "Owner" from all_source}
2186 ,q{type = 'PROCEDURE'}
2192 } elsif($object eq 'packages') {
2195 q{select distinct name "Package Name", 'PACKAGES' "Type", owner "Owner" from all_source}
2199 ,q{type = 'PACKAGE'}
2205 } elsif($object eq 'indexes') {
2208 q{select index_name "Index Name", 'INDEXES' "Type", owner "Owner" from all_indexes}
2209 ,q{ order by index_name }
2218 } elsif($object eq 'indextypes') {
2221 q{select indextype_name "Indextype Name", 'INDEXTYPE' "Type", owner "Owner" from all_indextypes}
2222 ,q{ order by indextype_name }
2231 } elsif($object eq 'libraries') {
2234 q{select library_name "library Name", 'LIBRARY' "Type", owner "Owner" from all_libraries}
2235 ,q{ order by library_name }
2244 } elsif($object eq 'materialized views') {
2247 q{select mview_name "Materialized View Name", 'MATERIALIZED VIEW' "Type", owner "Owner" from all_mviews}
2248 ,q{ order by mview_name }
2257 } elsif($object eq 'snapshots') {
2260 q{select name "Snapshot Name", 'SNAPSHOT' "Type", owner "Owner" from all_snapshots}
2270 } elsif($object eq 'synonyms') {
2273 q{select synonym_name "Synonym Name", 'SYNONYM' "Type", owner "Owner" from all_synonyms}
2274 ,q{ order by synonym_name }
2284 } elsif($object eq 'triggers') {
2287 q{select trigger_name "Trigger Name", 'TRIGGER' "Type", owner "Owner" from all_triggers}
2288 ,q{ order by trigger_name }
2297 } elsif($object eq 'waits') {
2299 select vs.username "Username",
2300 vs.osuser "OS User",
2303 decode(vsw.wait_time, -2, ' Unknown',
2304 to_char(vsw.seconds_in_wait,'999,999,999,999'))
2306 from v$session_wait vsw,
2308 where vsw.sid = vs.sid
2309 order by vsw.wait_time desc, vsw.seconds_in_wait desc, vsw.sid
2311 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2312 op_text => $op_text});
2314 } elsif( $object eq 'constraints' ){
2318 CONSTRAINT_NAME "Constraint Name"
2319 ,decode(constraint_type,
2325 ,TABLE_NAME "Table Name"
2326 ,INDEX_NAME "Index Name"
2328 from all_constraints
2332 ,q{ order by CONSTRAINT_NAME }
2342 query_err
("show", "Unsupported show type", $input);
2344 } elsif($input =~ /^\s*show\s+([a-zA-Z0-9_\$\#\s]+)\s*$/) {
2345 if($1 eq 'tables') {
2347 select table_name "Table Name", 'TABLE' "Type", sys.login_user() "Owner"
2351 query
($sqlstr, $format, {num_rows
=> $num_rows, op
=> $op,
2352 op_text
=> $op_text});
2353 } elsif($1 eq 'views') {
2355 select view_name "View Name", 'VIEW' "Type", sys.login_user() "Owner"
2359 query
($sqlstr, $format, {num_rows
=> $num_rows, op
=> $op,
2360 op_text
=> $op_text});
2361 } elsif($1 eq 'objects') {
2363 select object_name "Object Name", object_type "Type", sys.login_user() "Owner"
2365 order by object_name
2367 query
($sqlstr, $format, {num_rows
=> $num_rows, op
=> $op,
2368 op_text
=> $op_text});
2369 } elsif($1 eq 'sequences') {
2371 select sequence_name "Sequence Name", 'SEQUENCE' "Type", sys.login_user() "Owner"
2373 order by sequence_name
2375 query
($sqlstr, $format, {num_rows
=> $num_rows, op
=> $op,
2376 op_text
=> $op_text});
2377 } elsif($1 eq 'clusters') {
2379 select cluster_name "Cluster Name", 'CLUSTER' "Type", sys.login_user() "Owner"
2381 order by cluster_name
2383 query
($sqlstr, $format, {num_rows
=> $num_rows, op
=> $op,
2384 op_text
=> $op_text});
2385 } elsif($1 eq 'dimensions') {
2387 select dimension_name "Dimension Name", 'DIMENSION' "Type", sys.login_user() "Owner"
2388 from user_dimensions
2389 order by dimension_name
2391 query
($sqlstr, $format, {num_rows
=> $num_rows, op
=> $op,
2392 op_text
=> $op_text});
2393 } elsif($1 eq 'functions') {
2395 select distinct name "Function Name", 'FUNCTION' "Type", sys.login_user() "Owner"
2397 where type = 'FUNCTION'
2400 query
($sqlstr, $format, {num_rows
=> $num_rows, op
=> $op,
2401 op_text
=> $op_text});
2402 } elsif($1 eq 'procedures') {
2404 select distinct name "Procedure Name", 'PROCEDURE' "Type", sys.login_user() "Owner"
2406 where type = 'PROCEDURE'
2409 query
($sqlstr, $format, {num_rows
=> $num_rows, op
=> $op,
2410 op_text
=> $op_text});
2411 } elsif($1 eq 'packages') {
2413 select distinct name "Package Name", 'PACKAGES' "Type", sys.login_user() "Owner"
2415 where type = 'PACKAGE'
2418 query
($sqlstr, $format, {num_rows
=> $num_rows, op
=> $op,
2419 op_text
=> $op_text});
2420 } elsif($1 eq 'indexes') {
2422 select index_name "Index Name", 'INDEXES' "Type", sys.login_user() "Owner"
2426 query
($sqlstr, $format, {num_rows
=> $num_rows, op
=> $op,
2427 op_text
=> $op_text});
2428 } elsif($1 eq 'indextypes') {
2430 select indextype_name "Indextype Name", 'INDEXTYPE' "Type", sys.login_user() "Owner"
2431 from user_indextypes
2432 order by indextype_name
2434 query
($sqlstr, $format, {num_rows
=> $num_rows, op
=> $op,
2435 op_text
=> $op_text});
2436 } elsif($1 eq 'libraries') {
2438 select library_name "library Name", 'LIBRARY' "Type", sys.login_user() "Owner"
2440 order by library_name
2442 query
($sqlstr, $format, {num_rows
=> $num_rows, op
=> $op,
2443 op_text
=> $op_text});
2444 } elsif($1 eq 'materialized views') {
2446 select mview_name "Materialized View Name", 'MATERIALIZED VIEW' "Type", sys.login_user() "Owner"
2450 query
($sqlstr, $format, {num_rows
=> $num_rows, op
=> $op,
2451 op_text
=> $op_text});
2452 } elsif($1 eq 'snapshots') {
2454 select name "Snapshot Name", 'SNAPSHOT' "Type", sys.login_user() "Owner"
2458 query
($sqlstr, $format, {num_rows
=> $num_rows, op
=> $op,
2459 op_text
=> $op_text});
2460 } elsif($1 eq 'synonyms') {
2462 select synonym_name "Synonym Name", 'SYNONYM' "Type", sys.login_user() "Owner"
2464 order by synonym_name
2466 query
($sqlstr, $format, {num_rows
=> $num_rows, op
=> $op,
2467 op_text
=> $op_text});
2468 } elsif($1 eq 'triggers') {
2470 select trigger_name "Trigger Name", 'TRIGGER' "Type", sys.login_user() "Owner"
2472 order by trigger_name
2474 query
($sqlstr, $format, {num_rows
=> $num_rows, op
=> $op,
2475 op_text
=> $op_text});
2476 } elsif($1 eq 'processes') {
2481 vs.schemaname "Schema",
2482 vs.osuser || '@' || vs.machine "From",
2483 to_char(vs.logon_time, 'Mon DD YYYY HH:MI:SS') "Logon Time",
2485 from v$session vs, audit_actions aa
2486 where vs.command = aa.action
2487 and username is not null
2489 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2490 op_text => $op_text});
2491 } elsif($1 eq 'locks') {
2494 s.username "Username"
2495 ,s.osuser || '@' || s.MACHINE "User@Machine"
2496 ,s.PROGRAM "Program"
2504 5,'Share Row Exclusive',
2505 6,'Exclusive','NONE') "LMode"
2508 'BL','Buffer hash table instance lock',
2509 'CF',' Control file schema global enqueue lock',
2510 'CI','Cross-instance function invocation instance lock',
2511 'CS','Control file schema global enqueue lock',
2512 'CU','Cursor bind lock',
2513 'DF','Data file instance lock',
2514 'DL','Direct loader parallel index create',
2515 'DM','Mount/startup db primary/secondary instance lock',
2516 'DR','Distributed recovery process lock',
2517 'DX','Distributed transaction entry lock',
2518 'FI','SGA open-file information lock',
2519 'FS','File set lock',
2520 'HW','Space management operations on a specific segment lock',
2521 'IN','Instance number lock',
2522 'IR','Instance recovery serialization global enqueue lock',
2523 'IS','Instance state lock',
2524 'IV','Library cache invalidation instance lock',
2525 'JQ','Job queue lock',
2526 'KK','Thread kick lock',
2527 'MB','Master buffer hash table instance lock',
2528 'MM','Mount definition gloabal enqueue lock',
2529 'MR','Media recovery lock',
2530 'PF','Password file lock',
2531 'PI','Parallel operation lock',
2532 'PR','Process startup lock',
2533 'PS','Parallel operation lock',
2534 'RE','USE_ROW_ENQUEUE enforcement lock',
2535 'RT','Redo thread global enqueue lock',
2536 'RW','Row wait enqueue lock',
2537 'SC','System commit number instance lock',
2538 'SH','System commit number high water mark enqueue lock',
2540 'SN','Sequence number instance lock',
2541 'SQ','Sequence number enqueue lock',
2542 'SS','Sort segment lock',
2543 'ST','Space transaction enqueue lock',
2544 'SV','Sequence number value lock',
2545 'TA','Generic enqueue lock',
2546 'TD','DDL enqueue lock',
2547 'TE','Extend-segment enqueue lock',
2548 'TM','DML enqueue lock',
2549 'TT','Temporary table enqueue lock',
2550 'TX','Transaction enqueue lock',
2551 'UL','User supplied lock',
2552 'UN','User name lock',
2553 'US','Undo segment DDL lock',
2554 'WL','Being-written redo log instance lock',
2555 'WS','Write-atomic-log-switch global enqueue lock') "Lock Type"
2557 WHEN l.type = 'TM' THEN (
2558 SELECT OBJECT_TYPE || ' : ' || OWNER || '.' || OBJECT_NAME
2560 where object_id = l.id1
2562 WHEN l.type = 'TX' AND l.BLOCK = 1 THEN (
2564 'Blocked Sessions: ' || max(substr(SYS_CONNECT_BY_PATH(SID, ','),2)) SID
2570 row_number() OVER (Partition by l2.id1 order by l2.id1 ) seq
2586 WHEN l.type = 'TX' AND l.REQUEST > 0 THEN (
2588 'Wait for Session: ' || SID
2590 WHERE l.id1 = l2.id1
2595 END AS "Locked object / Lock Info"
2598 LEFT JOIN V$SESSION s ON l.SID = s.SID
2599 WHERE l.type <> 'MR' AND s.type <> 'BACKGROUND'
2601 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2602 op_text => $op_text});
2604 } elsif($1 eq 'waits') {
2606 select vs.username "Username",
2607 vs.osuser "OS User",
2610 decode(vsw.wait_time, -2, ' Unknown',
2611 to_char(vsw.seconds_in_wait,'999,999,999,999'))
2613 from v$session_wait vsw,
2615 where vsw.sid = vs.sid
2616 and vs.status = 'ACTIVE'
2617 and vs.username is not null
2618 order by vsw.wait_time desc, vsw.seconds_in_wait desc, vsw.sid
2620 query($sqlstr, $format, {num_rows => $num_rows, op => $op,
2621 op_text => $op_text});
2622 } elsif($1 eq 'plan') {
2623 # This following query is Copyright (c) Oracle Corporation 1998, 1999. All Rights Reserved.
2625 select '| Operation | Name | Rows | Bytes| Cost | Pstart| Pstop |' as "Plan Table" from dual
2627 select '--------------------------------------------------------------------------------' from dual
2629 select rpad('| '||substr(lpad(' ',1*(level-1)) ||operation||
2630 decode(options, null,'',' '||options), 1, 27), 28, ' ')||'|'||
2631 rpad(substr(object_name||' ',1, 9), 10, ' ')||'|'||
2632 lpad(decode(cardinality,null,' ',
2633 decode(sign(cardinality-1000), -1, cardinality||' ',
2634 decode(sign(cardinality-1000000), -1, trunc(cardinality/1000)||'K',
2635 decode(sign(cardinality-1000000000), -1, trunc(cardinality/1000000)||'M',
2636 trunc(cardinality/1000000000)||'G')))), 7, ' ') || '|' ||
2637 lpad(decode(bytes,null,' ',
2638 decode(sign(bytes-1024), -1, bytes||' ',
2639 decode(sign(bytes-1048576), -1, trunc(bytes/1024)||'K',
2640 decode(sign(bytes-1073741824), -1, trunc(bytes/1048576)||'M',
2641 trunc(bytes/1073741824)||'G')))), 6, ' ') || '|' ||
2642 lpad(decode(cost,null,' ',
2643 decode(sign(cost-10000000), -1, cost||' ',
2644 decode(sign(cost-1000000000), -1, trunc(cost/1000000)||'M',
2645 trunc(cost/1000000000)||'G'))), 8, ' ') || '|' ||
2646 lpad(decode(partition_start, 'ROW LOCATION', 'ROWID',
2647 decode(partition_start, 'KEY', 'KEY', decode(partition_start,
2648 'KEY(INLIST)', 'KEY(I)', decode(substr(partition_start, 1, 6),
2649 'NUMBER', substr(substr(partition_start, 8, 10), 1,
2650 length(substr(partition_start, 8, 10))-1),
2651 decode(partition_start,null,' ',partition_start)))))||' ', 7, ' ')|| '|' ||
2652 lpad(decode(partition_stop, 'ROW LOCATION', 'ROW L',
2653 decode(partition_stop, 'KEY', 'KEY', decode(partition_stop,
2654 'KEY(INLIST)', 'KEY(I)', decode(substr(partition_stop, 1, 6),
2655 'NUMBER', substr(substr(partition_stop, 8, 10), 1,
2656 length(substr(partition_stop, 8, 10))-1),
2657 decode(partition_stop,null,' ',partition_stop)))))||' ', 7, ' ')||'|' as "Explain plan"
2659 start with id=0 and timestamp = (select max(timestamp) from plan_table where id=0)
2660 connect by prior id = parent_id
2661 and prior nvl(statement_id, ' ') = nvl(statement_id, ' ')
2662 and prior timestamp <= timestamp
2664 select '--------------------------------------------------------------------------------' from dual
2666 query
($sqlstr, $format, {num_rows
=> $num_rows, op
=> $op,
2667 op_text
=> $op_text});
2668 } elsif($1 eq 'errors') {
2669 my $err = $dbh->func( 'plsql_errstr' );
2673 print "\nNo errors.\n\n";
2675 } elsif($1 eq 'users') {
2677 select username, user_id, created
2680 query
($sqlstr, $format, {num_rows
=> $num_rows, op
=> $op,
2681 op_text
=> $op_text});
2682 } elsif($1 eq 'user') {
2684 select user from dual
2686 query
($sqlstr, $format, {num_rows
=> $num_rows, op
=> $op,
2687 op_text
=> $op_text});
2688 } elsif($1 eq 'uid') {
2690 select uid from dual
2692 query
($sqlstr, $format, {num_rows
=> $num_rows, op
=> $op,
2693 op_text
=> $op_text});
2694 } elsif(($1 eq 'database links') || ($1 eq 'dblinks')) {
2696 select db_link, host, owner from all_db_links
2698 query
($sqlstr, $format, {num_rows
=> $num_rows, op
=> $op,
2699 op_text
=> $op_text});
2701 query_err
("show", "Unsupported show type", $input);
2704 query_err
("show", "Unsupported show type", $input);
2711 my($input, $format, $nosynonym, $num_rows, $op, $op_text) = @_;
2712 debugmsg
(3, "describe called", @_);
2713 # This describes a table, view, sequence, or synonym by listing it's
2714 # columns and their attributes
2716 # convert to lowercase for comparison operations
2717 $input = lc($input);
2719 # make sure we're still connected to the database
2721 wrn
("Database connection died");
2725 # parse the query to find the table that was requested to be described
2726 if($input =~ /^\s*desc\w*\s*([a-zA-Z0-9_\$\#\.\@]+)/) {
2734 if($object =~ /^([a-zA-Z0-9_\$\#]+)\.([a-zA-Z0-9_\$\#]+)\@([a-zA-Z0-9_\$\#]+)$/) {
2738 } elsif($object =~ /^([a-zA-Z0-9_\$\#]+)\@([a-zA-Z0-9_\$\#]+)$/) {
2742 } elsif($object =~ /^([a-zA-Z0-9_\$\#]+)\.([a-zA-Z0-9_\$\#]+)$/) {
2749 debugmsg
(1,"schema: [$schema] object: [$object] dblink: [$dblink]");
2751 if($conf{fast_describe
}) {
2752 if(my $sth = $dbh->prepare("select * from $schema.$object$dblink")) {
2753 my $fields = $sth->{NAME
};
2754 my $types = $sth->{TYPE
};
2755 my $type_info = $dbh->type_info($types->[0]);
2756 my $precision = $sth->{PRECISION
};
2757 my $scale = $sth->{SCALE
};
2758 my $nullable = $sth->{NULLABLE
};
2760 debugmsg
(4, "fields: [" . join(',', @
$fields) . "]");
2761 debugmsg
(4, "types: [" . join(',', @
$types) . "]");
2762 debugmsg
(4, "type_info: [" . Dumper
($type_info) . "]");
2763 debugmsg
(4, "precision: [" . join(',', @
$precision) . "]");
2764 debugmsg
(4, "scale: [" . join(',', @
$scale) . "]");
2765 debugmsg
(4, "nullable: [" . join(',', @
$nullable) . "]");
2767 # Assemble a multidiminsional array of the output
2769 for(my $i = 0; $i < @
$fields; $i++) {
2770 my ($name, $null, $type);
2771 $name = $fields->[$i];
2772 $null = ($nullable->[$i] ?
'NULL' : 'NOT NULL');
2773 my $type_info = $dbh->type_info($types->[$i]);
2774 $type = $type_info->{'TYPE_NAME'};
2775 # convert DECIMAL to NUMBER for our purposes (some kind of DBD kludge)
2776 $type = 'NUMBER' if $type eq 'DECIMAL';
2777 if( $type eq 'VARCHAR2' || $type eq 'NVARCHAR2' ||
2778 $type eq 'CHAR' || $type eq 'NCHAR' || $type eq 'RAW' )
2780 $type .= "($precision->[$i])";
2781 } elsif($type eq 'NUMBER' && ($scale->[$i] || $precision->[$i] < 38))
2783 $type .= "($precision->[$i],$scale->[$i])";
2785 push(@desc, [$name, $null, $type]);
2788 # figure max column sizes we'll need
2789 my @widths = (4,5,4);
2790 for(my $i = 0; $i < @desc; $i++) {
2791 for(my $j = 0; $j < @
{$desc[0]}; $j++) {
2792 if(length($desc[$i][$j]) > $widths[$j]) {
2793 $widths[$j] = length($desc[$i][$j]);
2798 # open the redirection file
2799 if($op && $op eq '>' || $op eq '>>') {
2800 ($op_text) = glob($op_text);
2801 debugmsg
(3, "Opening file '$op_text' for output redirection using [$op]");
2802 open(FOUT
, $op . $op_text) || do query_err
('redirect',"Cannot open file '$op_text' for writing: $!", '');
2803 } elsif($op eq '|') {
2804 debugmsg
(3, "Opening pipe to '$op_text' for output redirection");
2805 open(FOUT
, $op . $op_text) || do query_err
('pipe',"Cannot open pipe '$op_text': $!", '');
2807 open(FOUT
, ">&STDOUT");
2813 print FOUT
sprintf("%-$widths[0]s", 'Name')
2815 . sprintf("%-$widths[1]s", 'Null?')
2817 . sprintf("%-$widths[2]s", 'Type')
2819 print FOUT
'-' x
$widths[0]
2826 for(my $i = 0; $i < @desc; $i++) {
2827 for(my $j = 0; $j < @
{$desc[$i]}; $j++) {
2828 print FOUT
' ' if $j > 0;
2829 print FOUT
sprintf("%-$widths[$j]s", $desc[$i][$j]);
2841 # look in all_constraints for the object first. This is because oracle
2842 # stores information about primary keys in the all_objects table as "index"s
2843 # but it doesn't have foreign keys or constraints. So we want to match
2846 # now look in all_objects
2847 my $all_object_cols = 'object_type,owner,object_name,'
2848 . 'object_id,created,last_ddl_time,'
2849 . 'timestamp,status';
2851 @ret = $dbh->selectrow_array(
2852 "select $all_object_cols from all_objects where object_name = ? "
2854 .($nosynonym ?
" and object_type != 'SYNONYM'" : ""),
2855 undef, uc($object), uc($schema)
2857 @ret = $dbh->selectrow_array(
2858 "select $all_object_cols from all_objects where object_name = ? "
2859 ."and owner = 'PUBLIC'"
2860 .($nosynonym ?
" and object_type != 'SYNONYM'" : ""),
2865 @ret = $dbh->selectrow_array(
2866 "select constraint_type, constraint_name from all_constraints where "
2867 ."constraint_name = ?",
2872 if($ret[0] eq 'INDEX') {
2873 # Check if this 'index' is really a primary key and is in the
2874 # all_constraints table
2876 my @temp_ret = $dbh->selectrow_array(
2877 "select constraint_type, constraint_name from all_constraints where "
2878 ."constraint_name = ?",
2882 @ret = @temp_ret if @temp_ret;
2886 debugmsg
(1,"type: [$type] ret: [@ret]");
2888 if($type eq 'SYNONYM') {
2889 # Find what this is a synonym to, then recursively call this function
2890 # again to describe whatever it points to
2891 my($table_name, $table_owner) = $dbh->selectrow_array(
2892 'select table_name, table_owner from all_synonyms '
2893 .'where synonym_name = ? and owner = ?',
2894 undef, uc($ret[2]), uc($ret[1])
2897 describe
("desc $table_owner.$table_name", $format, 1);
2898 } elsif($type eq 'SEQUENCE') {
2900 select sequence_name "Name",
2908 where sequence_name = ?
2909 and sequence_owner = ?
2911 query
($sqlstr, $format, {num_rows
=> $num_rows, op
=> $op,
2912 op_text
=> $op_text}, uc($ret[2]), uc($ret[1]));
2913 } elsif($type eq 'TABLE' || $type eq 'VIEW' || $type eq 'TABLE PARTITION') {
2915 select column_name "Name",
2920 'VARCHAR2','VARCHAR2(' || TO_CHAR(data_length) || ')',
2921 'NVARCHAR2','NVARCHAR2(' || TO_CHAR(data_length) || ')',
2922 'CHAR','CHAR(' || TO_CHAR(data_length) || ')',
2923 'NCHAR','NCHAR(' || TO_CHAR(data_length) || ')',
2925 decode(data_precision,
2927 'NUMBER(' || TO_CHAR(data_precision)
2928 || ',' || TO_CHAR(data_scale) || ')'
2931 decode(data_precision,
2932 NULL, 'FLOAT', 'FLOAT(' || TO_CHAR(data_precision) || ')'
2936 'LONG RAW','LONG RAW',
2937 'RAW','RAW(' || TO_CHAR(data_length) || ')',
2938 'MLSLABEL','MLSLABEL',
2946 data_default "Default"
2947 from all_tab_columns atc
2948 where table_name = ?
2952 query
($sqlstr, $format, {num_rows
=> $num_rows, op
=> $op,
2953 op_text
=> $op_text}, uc($ret[2]), uc($ret[1]));
2954 } elsif($type eq 'R') {
2956 select ac.constraint_name "Name",
2957 decode(ac.constraint_type,
2962 ac.constraint_type) "Type",
2963 ac.table_name "Table Name",
2964 acc.column_name "Column Name",
2965 r_ac.table_name "Parent Table",
2966 r_acc.column_name "Parent Column",
2967 ac.delete_rule "Delete Rule"
2968 from all_constraints ac, all_cons_columns acc,
2969 all_constraints r_ac, all_cons_columns r_acc
2970 where ac.constraint_name = acc.constraint_name
2971 and ac.owner = acc.owner
2972 and ac.r_constraint_name = r_ac.constraint_name
2973 and r_ac.constraint_name = r_acc.constraint_name
2974 and r_ac.owner = r_acc.owner
2975 and ac.constraint_type = 'R'
2976 and ac.constraint_name = ?
2978 order by ac.constraint_name, acc.position
2980 query
($sqlstr, 'list_aligned', {num_rows
=> $num_rows, op
=> $op,
2981 op_text
=> $op_text}, uc($ret[1]),
2983 } elsif($type eq 'P' || $type eq 'U') {
2985 select ac.constraint_name "Name",
2986 decode(ac.constraint_type,
2991 ac.constraint_type) "Type",
2992 ac.table_name "Table Name",
2993 acc.column_name "Column Name"
2994 from all_constraints ac, all_cons_columns acc
2995 where ac.constraint_name = acc.constraint_name
2996 and ac.owner = acc.owner
2997 and ac.constraint_name = ?
2999 order by ac.constraint_name, acc.position
3001 query
($sqlstr, $format, {num_rows
=> $num_rows, op
=> $op,
3002 op_text
=> $op_text}, uc($ret[1]), uc($schema));
3003 } elsif($type eq 'C') {
3005 select ac.constraint_name "Name",
3006 decode(ac.constraint_type,
3011 ac.constraint_type) "Type",
3012 ac.table_name "Table Name",
3013 ac.search_condition "Search Condition"
3014 from all_constraints ac
3015 where ac.constraint_name = ?
3016 order by ac.constraint_name
3018 query
($sqlstr, $format, {num_rows
=> $num_rows, op
=> $op,
3019 op_text
=> $op_text}, uc($ret[1]));
3020 } elsif($type eq 'INDEX') {
3022 select ai.index_name "Index Name",
3023 ai.index_type "Type",
3024 ai.table_name "Table Name",
3025 ai.uniqueness "Unique?",
3026 aic.column_name "Column Name"
3027 from all_indexes ai, all_ind_columns aic
3028 where ai.index_name = aic.index_name(+)
3029 and ai.table_owner = aic.table_owner(+)
3030 and ai.index_name = ?
3031 and ai.table_owner = ?
3032 order by aic.column_position
3034 query
($sqlstr, $format, {num_rows
=> $num_rows, op
=> $op,
3035 op_text
=> $op_text}, uc($ret[2]), uc($schema));
3036 } elsif($type eq 'TRIGGER') {
3038 select trigger_name "Trigger Name",
3039 trigger_type "Type",
3040 triggering_event "Event",
3043 description "Description",
3046 where trigger_name = ?
3048 query
($sqlstr, 'list_aligned', {num_rows
=> $num_rows, op
=> $op,
3049 op_text
=> $op_text}, uc($ret[2]));
3050 } elsif($type eq 'PACKAGE') {
3051 wrn
("Not implemented (yet)");
3052 } elsif($type eq 'PROCEDURE') {
3053 wrn
("Not implemented (yet)");
3054 } elsif($type eq 'CLUSTER') {
3055 wrn
("Not implemented (yet)");
3056 } elsif($type eq 'TRIGGER') {
3057 wrn
("Not implemented (yet)");
3059 query_err
('describe', "Object $object not found");
3065 debugmsg
(3, "let_cmd called", @_);
3066 my @bool_keys = qw
/sql_query_in_error auto_complete edit_history fast_describe complete_objects complete_tables extended_complete_list extended_benchmarks column_wildcards complete_columns auto_commit commit_on_exit command_complete_list long_trunc_ok/;
3068 if ($input =~ /^\s*let\s*(\w+)?\s*/i ){
3069 my @print_keys = keys %conf;
3070 @print_keys = grep(/$1/,@print_keys) if ($1);
3072 foreach my $key ( @print_keys ){
3073 my $print_conf = $conf{$key};
3074 $print_conf = ($conf{$key}) ?
'On' : 'Off' if ( grep(/$key/,@bool_keys) ) ;
3076 if ($key eq 'long_read_len' ){
3077 $print_conf = $dbh->{LongReadLen
};
3080 printf("%25s : %1s\n",$key,$print_conf);
3083 print "usage let <config name>\n";
3088 debugmsg
(3, "set_cmd called", @_);
3089 # This mimics SQL*Plus set commands, or ignores them completely. For those
3090 # that are not supported, we do nothing at all, but return silently.
3092 if($input =~ /^\s*set\s+serverout(?:put)?\s+(on|off)(?:\s+size\s+(\d+))?/i) {
3093 if(lc($1) eq 'on') {
3094 my $size = $2 || 1_000_000
;
3095 debugmsg
(2, "calling dbms_output_enable($size)");
3096 $dbh->func( $size, 'dbms_output_enable' )
3097 or warn "dbms_output_enable($size) failed: $DBI::errstr\n";
3098 $set{serveroutput
} = 1;
3099 debugmsg
(2, "serveroutput set to $set{serveroutput}");
3101 $set{serveroutput
} = 0;
3102 debugmsg
(2, "serveroutput set to $set{serveroutput}");
3104 }elsif($input =~ /^\s*set\s+(long_read_len|LongReadLen)\s+(\d+)/i){
3105 debugmsg
(2, "long_read_len/LongReadLen set to $2");
3106 $dbh->{LongReadLen
} = $2;
3107 $conf{long_read_len
} = $2;
3108 }elsif($input =~ /^\s*set\s+fast_describe\s+(on|off)/i){
3109 $conf{fast_describe
} = (lc($1) eq 'on') ?
1 : 0;
3110 print "fast_describe is now " . ($conf{fast_describe
} ?
'on' : 'off') . "\n";
3112 }elsif($input =~ /^\s*set\s+(\w+)\s*/ ){
3113 print "Can't set option $1\n";
3118 my($sqlstr, $format, $opts, @bind_vars) = @_;
3119 debugmsg
(3, "query called", @_);
3120 # this runs the provided query and calls format_display to display the results
3122 my $num_rows = $opts->{num_rows
};
3123 my $op = $opts->{op
};
3124 my $op_text = $opts->{op_text
};
3125 my $result_output = ( exists $opts->{result_output
}
3126 ?
$opts->{result_output
}
3130 my(@totalbench, @querybench, @formatbench);
3132 # Look for special query types, such as "show" and "desc" that we handle
3133 # and don't send to the database at all, since they're not really valid SQL.
3135 my ($rows_affected, $success_code);
3137 if($sqlstr =~ /^\s*desc/i) {
3138 describe
($sqlstr, $format, undef, $num_rows, $op, $op_text);
3139 } elsif($sqlstr =~ /^\s*show/i) {
3140 show
($sqlstr, $format, $num_rows, $op, $op_text);
3144 # make sure we're still connected to the database
3146 wrn
("Database connection died");
3150 $sqlstr = wildcard_expand
($sqlstr) if $conf{column_wildcards
};
3152 # send the query on to the database
3153 push(@totalbench, get_bench
()) if !$conf{extended_benchmarks
};
3154 push(@querybench, get_bench
()) if $conf{extended_benchmarks
};
3155 debugmsg
(3, "preparing", $sqlstr);
3156 my $sth = $dbh->prepare($sqlstr);
3158 my $err = $DBI::errstr
;
3159 $err =~ s/ \(DBD ERROR\: OCIStmtExecute\/Describe\)//;
3161 if ($err =~ m/DBD ERROR\:/) {
3162 my $indicator_offset = $DBI::errstr
;
3163 $indicator_offset =~ s/(.*)(at\ char\ )(\d+)(\ .*)/$3/;
3164 if ($indicator_offset > 0) {
3166 print $sqlstr, "\n";
3167 for ($i=0;$i<$indicator_offset;++$i) {
3174 # Output message if serveroutput is on
3175 if($set{serveroutput
}) {
3176 debugmsg
(3, "Calling dmbs_output_get");
3177 my @output = $dbh->func( 'dbms_output_get' );
3178 print join("\n", @output) . "\n";
3180 query_err
('prepare', $err, $sqlstr), setup_sigs
(), return();
3182 debugmsg
(2, "sth: [$sth]");
3186 finish_query
($sth), return() if $sigintcaught; #pseudo sig handle
3190 debugmsg
(3, "executing", $sqlstr);
3191 $ret = $sth->execute(@bind_vars);
3193 debugmsg
(3, "ret:", $ret, "\@:", $@
, "\$DBI::errstr:", $DBI::errstr
);
3195 my $eval_error = $@
;
3196 $eval_error =~ s/at \(eval \d+\) line \d+, <\S+> line \d+\.//;
3197 my $err = $DBI::errstr
;
3198 $err =~ s/ \(DBD ERROR: OCIStmtExecute\)//;
3199 # Output message is serveroutput is on
3200 if($set{serveroutput
}) {
3201 debugmsg
(3, "Calling dmbs_output_get");
3202 my @output = $dbh->func( 'dbms_output_get' );
3203 print join("\n", @output) . "\n";
3205 my $errstr = ($eval_error ?
$eval_error : $err);
3206 query_err
('execute', $errstr, $sqlstr);
3211 if($DBI::errstr
=~ /^ORA-24344/) {
3212 print "\nWarning: Procedure created with compilation errors.\n\n";
3217 push(@querybench, get_bench
()) if $conf{extended_benchmarks
};
3219 finish_query
($sth), return() if $sigintcaught; #pseudo sig handle
3221 debugmsg
(1, "rows returned: [" . $sth->rows() . "]");
3223 # open the redirection file
3224 if($op && $op eq '>' || $op eq '>>') {
3225 ($op_text) = glob($op_text);
3226 debugmsg
(3, "Opening file '$op_text' for output redirection using [$op]");
3227 open(FOUT
, $op . $op_text) || do{
3228 query_err
('redirect',"Cannot open file '$op_text' for writing: $!",
3233 } elsif($op eq '|') {
3234 debugmsg
(3, "Opening pipe to '$op_text' for output redirection");
3235 open(FOUT
, $op . $op_text) || do{
3236 query_err
('pipe',"Cannot open pipe '$op_text': $!", $sqlstr);
3241 open(FOUT
, ">&STDOUT");
3244 # Output message is serveroutput is on
3245 if($set{serveroutput
}) {
3246 debugmsg
(3, "Calling dmbs_output_get");
3247 my @output = $dbh->func( 'dbms_output_get' );
3248 print join("\n", @output) . "\n";
3251 # Determine type and output accordingly
3252 if($sqlstr =~ /^\s*declare|begin/i) {
3253 print STDERR
"\nPL/SQL procedure successfully completed.\n\n";
3255 push(@formatbench, get_bench
()) if $conf{extended_benchmarks
};
3256 ($rows_affected, $success_code) = format_output
($sth, $format, $num_rows,
3257 $sqlstr, $op, $op_text)
3258 or finish_query
($sth), return();
3259 push(@formatbench, get_bench
()) if $conf{extended_benchmarks
};
3260 push(@totalbench, get_bench
()) if !$conf{extended_benchmarks
};
3262 finish_query
($sth), return() if $sigintcaught; #pseudo sig handle
3264 # output format_affected
3265 if($result_output) {
3267 print STDERR
"\n" . format_affected
($rows_affected, $success_code);
3271 if($opt_bench || $conf{extended_benchmarks
}) {
3272 print STDERR
"\n\n";
3273 print STDERR
('-' x
80);
3275 output_benchmark
("Query: ", @querybench, "\n");
3276 output_benchmark
("Format:", @formatbench, "\n");
3278 output_benchmark
(" (", @totalbench, ")");
3294 return($rows_affected, $success_code);
3297 sub wildcard_expand
{
3299 debugmsg
(3, "wildcard_expand called", @_);
3303 my $wheregrouporder = $sql;
3304 $wheregrouporder =~ s/.*(where|order|group).*/\1/;
3305 if ($wheregrouporder eq $sql) {
3306 $wheregrouporder = "";
3308 ($sql,$fromstuff) = split(/order|group|where/i,$sql,2);
3309 if ($sql =~ /^select\s+(.+?)\*\s+from\s+(.+)/i) {
3310 debugmsg
(1, "Match made: ($1) ($2)");
3311 my $wildcardstring = uc($1);
3312 my $tablename = uc($2);
3313 my @tlist = split(/,/,$tablename);
3316 foreach my $table (@tlist) {
3318 $table =~ s/([^ ]+)\s+(.*)/\1/;
3319 $column_prefix{$table} = $2 ?
$2 : $table;
3320 $tablelist .= ($tablelist ?
"," : "") . $table;
3322 $tablelist =~ s/,/' or table_name='/g;
3323 my $qstr = "select table_name||'.'||column_name from all_tab_columns where (table_name='$tablelist') and column_name like '$wildcardstring%' escape '\\'";
3324 debugmsg
(1, "qstr: [$qstr]");
3325 my $sth = $dbh->prepare($qstr);
3330 while ( ($colname) = $sth->fetchrow_array() ) {
3331 foreach my $table (keys %column_prefix) {
3332 $colname =~ s/$table\./$column_prefix{$table}\./;
3335 $collist .= ($collist ?
"," : "") . $colname;
3337 $collist = $collist ?
$collist : "*";
3338 $newsql = "select " . $collist . " from " . $tablename . " "
3339 . $wheregrouporder . " " . $fromstuff;
3340 debugmsg
(1, "newsql: [$newsql]");
3347 # This just finishes the query and cleans up the state info
3356 debugmsg
(3, "get_bench called", @_);
3357 # returns benchmark info
3359 my($benchmark, $hires);
3360 $benchmark = new Benchmark
;
3365 # use an eval to keep perl from syntax checking it unless we have the
3366 # Time::HiRes module loaded
3368 $hires = [gettimeofday]
3372 return($benchmark, $hires);
3375 sub output_benchmark {
3376 my($string, $bstart, $hrstart, $bend, $hrend, $string2) = @_;
3377 debugmsg(3, "output_benchmark called", @_);
3378 # This just outputs the benchmark info
3380 my $bench = timediff($bend, $bstart);
3384 # the times will be seconds
3385 $time = $hrend - $hrstart;
3387 eval q{$time = tv_interval($hrstart, $hrend)};
3388 $time = sprintf("%.2f", $time);
3391 unless($opt_bench || $conf{extended_benchmarks}) {
3392 # convert $time to something more readable
3393 $time =~ s/\.(\d+)$//;
3397 if(($tmp = int($time / 604800)) >= 1) {
3398 push(@tparts, "$tmp week" . ($tmp != 1 && 's'));
3401 if(($tmp = int($time / 86400)) >= 1) {
3402 push(@tparts, "$tmp day" . ($tmp != 1 && 's'));
3405 if(($tmp = int($time / 3600)) >= 1) {
3406 push(@tparts, "$tmp hour" . ($tmp != 1 && 's'));
3409 if(($tmp = int($time / 60)) >= 1) {
3410 push(@tparts, "$tmp minute" . ($tmp != 1 && 's'));
3415 $time .= ".$decimal";
3416 push(@tparts, "$time second" . ($time != 1 && 's'));
3417 $time = join(", ", @tparts);
3420 if($opt_bench || $conf{extended_benchmarks}) {
3421 print STDERR "$string\[ $time second" . ($time != 1 && 's')
3422 . " ] [" . timestr($bench) . " ]$string2";
3424 print STDERR "$string$time$string2";
3429 my($sth, $format, $num_rows, $sqlstr, $op, $op_text) = @_;
3430 debugmsg(3, "format_output called", @_);
3431 # Formats the output according to the query terminator. If it was a ';' or
3432 # a '/' then a normal table is output. If it was a '\g' then all the columns # and rows are output put line by line.
3433 # input: $sth $format
3434 # sth is the statement handler
3435 # format can be either 'table', 'list', or 'list_aligned'
3436 # output: returns 0 on error, ($success_code, $rows_affected) on success
3437 # $success_code = ('select', 'affected');
3439 debugmsg(3,"type: [" . Dumper($sth->{TYPE}) . "]");
3441 # Is this query a select?
3442 my $isselect = 1 if $sqlstr =~ /^\s*select/i;
3444 if($format eq 'table') {
3448 while(my @res = $sth->fetchrow_array()) {
3452 debugmsg(1,"overflow in table output, switching to serial mode");
3456 debugmsg(1,"num_rows hit on fetch") if $num_rows && $count >= $num_rows;
3457 last if $num_rows && $count >= $num_rows;
3458 return(0) if $sigintcaught; #pseudo sig handle
3461 # If we didn't get any rows back, then the query was probably an insert or
3462 # update, so we call format_affected
3463 if(@$res <= 0 && !$isselect) {
3464 return($sth->rows(), 'affected');
3467 return(0) if $sigintcaught; #pseudo sig handle
3469 # First go through all the return data to determine column widths
3471 for( my $i = 0; $i < @{$res}; $i++ ) {
3472 for( my $j = 0; $j < @{$res->[$i]}; $j++ ) {
3473 if(length($res->[$i]->[$j]) > $widths[$j]) {
3474 $widths[$j] = length($res->[$i]->[$j]);
3477 return(0) if $sigintcaught; #pseudo sig handle
3478 debugmsg(1,"num_rows hit on calc") if $num_rows && $i >= $num_rows-1;
3479 last if $num_rows && $i >= $num_rows-1;
3482 return(0) if $sigintcaught; #pseudo sig handle
3484 my $fields = $sth->{NAME};
3485 my $types = $sth->{TYPE};
3486 my $nullable = $sth->{NULLABLE};
3488 debugmsg(4, "fields: [" . Dumper($fields) . "]");
3489 debugmsg(4, "types: [" . Dumper($types) . "]");
3490 debugmsg(4, "nullable: [" . Dumper($nullable) . "]");
3492 return(0) if $sigintcaught; #pseudo sig handle
3494 # Extend the column widths if the column name is longer than any of the
3495 # data, so that it doesn't truncate the column name
3496 for( my $i = 0; $i < @$fields; $i++ ) {
3497 if(length($fields->[$i]) > $widths[$i]) {
3498 debugmsg(3, "Extending $fields->[$i] for name width");
3499 $widths[$i] = length($fields->[$i]);
3501 return(0) if $sigintcaught; #pseudo sig handle
3504 return(0) if $sigintcaught; #pseudo sig handle
3506 # Extend the column widths if the column is NULLABLE so that we'll
3507 # have room for 'NULL'
3508 for( my $i = 0; $i < @$nullable; $i++ ) {
3509 if($nullable->[$i] && $widths[$i] < 4) {
3510 debugmsg(3, "Extending $fields->[$i] for null");
3513 return(0) if $sigintcaught; #pseudo sig handle
3516 return(0) if $sigintcaught; #pseudo sig handle
3523 return(0) if $sigintcaught; #pseudo sig handle
3525 debugmsg(2,"fields: [" . join("|", @$fields) . "] sumwidths: [$sumwidths] widths: [" . join("|", @widths) . "]\n");
3527 return(0) if $sigintcaught; #pseudo sig handle
3529 # now do the actual outputting, starting with the header
3530 my $rows_selected = 0;
3533 print FOUT "\r\e[K" if $op eq '<';
3535 for( my $i = 0; $i < @$fields; $i++ ) {
3537 print FOUT "\t" if $i > 0;
3538 print FOUT sprintf("%s", $fields->[$i]);
3542 print FOUT " " if $i > 0;
3543 if($types->[$i] == 3 || $types->[$i] == 8) {
3544 print FOUT sprintf("%$widths[$i]s", $fields->[$i]);
3546 print FOUT sprintf("%-$widths[$i]s", $fields->[$i]);
3552 for( my $i = 0; $i < @$fields; $i++ ) {
3553 print FOUT " " if $i > 0;
3554 print FOUT '-' x $widths[$i];
3559 return(0) if $sigintcaught; #pseudo sig handle
3561 # now print the actual data rows
3563 for( my $j = 0; $j < @$res; $j++ ) {
3565 for( my $i = 0; $i < @$fields; $i++ ) {
3566 print FOUT " " if $i > 0;
3567 my $data = $res->[$j]->[$i];
3568 # Strip out plain ole \r's since SQL*Plus seems to...
3570 $data = 'NULL' unless defined $data;
3571 if($types->[$i] == 3 || $types->[$i] == 8) {
3572 print FOUT sprintf("%$widths[$i]s", $data);
3574 print FOUT sprintf("%-$widths[$i]s", $data);
3580 debugmsg(2,"num_rows hit on output") if $num_rows && $j >= $num_rows-1;
3581 last if $num_rows && $j >= $num_rows-1;
3582 return(0) if $sigintcaught; #pseudo sig handle
3586 # output the rest of the data from the statement handler
3587 while(my $res = $sth->fetch()) {
3589 for( my $i = 0; $i < @$fields; $i++ ) {
3590 print FOUT " " if $i > 0;
3591 my $data = substr($res->[$i],0,$widths[$i]);
3592 # Strip out plain ole \r's since SQL*Plus seems to...
3594 $data = 'NULL' unless defined $data;
3595 if($types->[$i] == 3 || $types->[$i] == 8) {
3596 print FOUT sprintf("%$widths[$i]s", $data);
3598 print FOUT sprintf("%-$widths[$i]s", $data);
3604 debugmsg(2,"num_rows hit on output")
3605 if $num_rows && $count >= $num_rows-1;
3606 last if $num_rows && $count >= $num_rows-1;
3607 return(0) if $sigintcaught; #pseudo sig handle
3612 return($rows_selected, 'selected');
3614 } elsif($format eq 'list' || $format eq 'quiet-list' ) {
3615 # output in a nice list format, which is where we print each row in turn,
3616 # with each column on it's own line
3617 # quiet-list doesn't display *** Row...
3618 my $quiet = ($format eq 'quiet-list') ? 1 : 0;
3619 my $fields = $sth->{NAME};
3621 print "\r\e[K" if $op eq '<';
3625 while(my $res = $sth->fetch()) {
3626 print FOUT "\n**** Row: " . ($count+1) . "\n" unless ($quiet);
3627 for( my $i = 0; $i < @$fields; $i++ ) {
3628 my $data = $res->[$i];
3629 $data = 'NULL' unless defined $data;
3631 print FOUT $data . "\n";
3633 print FOUT $fields->[$i] . ": " . $data . "\n";
3637 last if $num_rows && $count >= $num_rows;
3638 return(0) if $sigintcaught; #pseudo sig handle
3641 return(0) if $sigintcaught; #pseudo sig handle
3643 # If we didn't get any rows back, then the query was probably an insert or
3644 # update, so we call format_affected
3645 if($count <= 0 && !$isselect) {
3646 return($sth->rows(), 'affected');
3649 return($count, 'selected');
3651 } elsif($format eq 'list_aligned') {
3652 # output in a nice list format, which is where we print each row in turn,
3653 # with each column on it's own line. The column names are aligned in this
3654 # one (so that the data all starts on the same column)
3656 my $fields = $sth->{NAME};
3658 print "\r\e[K" if $op eq '<';
3662 for( my $i = 0; $i < @$fields; $i++ ) {
3663 my $len = length($fields->[$i]) + 1; # +1 for the colon
3664 $maxwidth = $len if $len >= $maxwidth;
3667 return(0) if $sigintcaught; #pseudo sig handle
3670 while(my $res = $sth->fetch()) {
3671 print FOUT "\n**** Row: " . ($count+1) . "\n";
3672 for( my $i = 0; $i < @$fields; $i++ ) {
3673 my $data = $res->[$i];
3674 $data = 'NULL' unless defined $data;
3675 print FOUT sprintf("%-" . $maxwidth . "s", $fields->[$i] . ":");
3676 print FOUT " " . $data . "\n";
3679 last if $num_rows && $count >= $num_rows;
3680 return(0) if $sigintcaught; #pseudo sig handle
3683 return(0) if $sigintcaught; #pseudo sig handle
3685 # If we didn't get any rows back, then the query was probably an insert or
3686 # update, so we call format_affected
3687 if($count <= 0 && !$isselect) {
3688 return($sth->rows(), 'affected');
3691 return($count, 'selected');
3693 } elsif($format eq 'single_output') {
3694 # Outputs a single return column/row without any labeling
3698 my $res = $sth->fetchrow_array();
3699 print FOUT "$res\n";
3701 my $count = ($res ? 1 : 0);
3703 return(0) if $sigintcaught; #pseudo sig handle
3705 return($count, 'selected');
3707 } elsif($format eq 'csv' || $format eq 'csv_no_header') {
3708 # output in a comma seperated values format. fields with a ',' are quoted
3709 # with '"' quotes, and rows are seperated by '\n' newlines
3711 print "\r\e[K" if $op eq '<';
3714 # check that Text::CSV_XS was included ok, if not output an error
3716 soft_err("You must install Text::CSV_XS from CPAN to use this feature");
3719 my $fields = $sth->{NAME};
3721 if($format eq 'csv') {
3722 # Print the column headers
3723 for(my $i = 0; $i < @$fields; $i++) {
3724 print FOUT "," if $i > 0;
3725 print FOUT $fields->[$i];
3731 while(my $res = $sth->fetch()) {
3734 $csv->combine(@$res);
3735 print FOUT $csv->string() . "\n";
3737 last if $num_rows && $count >= $num_rows;
3738 return(0) if $sigintcaught; #pseudo sig handle
3741 return(0) if $sigintcaught; #pseudo sig handle
3743 # If we didn't get any rows back, then the query was probably an insert or
3744 # update, so we call format_affected
3745 if($count <= 0 && !$isselect) {
3746 return($sth->rows(), 'affected');
3749 return($count, 'selected');
3751 } elsif($format eq 'sql') {
3752 # Produce SQL insert statements.
3753 print "\r" if $op eq '<';
3756 my $cols = lc join(', ', @{$sth->{NAME}});
3757 my @types = map { scalar $dbh->type_info($_)->{TYPE_NAME} } @{ $sth->{TYPE} };
3758 my %warned_unknown_type;
3761 while(my $res = $sth->fetch()) {
3763 die if @$res != @types;
3764 print FOUT "insert into TABLE ($cols) values (";
3765 foreach (0 .. $#$res) {
3768 if (not defined $v) {
3771 if ($t eq 'DOUBLE' or $t eq 'DOUBLE PRECISION' or
3772 $t eq 'NUMBER' or $t eq 'DECIMAL') {
3773 die "bad number: $v" if $v !~ /\d/;
3775 } elsif ($t eq 'VARCHAR2' or $t eq 'CHAR' or $t eq 'CLOB') {
3778 } elsif ($t eq 'DATE') {
3781 warn "don't know how to handle SQL type $t"
3782 unless $warned_unknown_type{$t}++;
3783 print FOUT "(unknown type $t: $v)";
3786 print FOUT ', ' unless $_ eq $#$res;
3789 last if $num_rows && $count >= $num_rows;
3790 return(0) if $sigintcaught; #pseudo sig handle
3792 return(0) if $sigintcaught; #pseudo sig handle
3794 # If we didn't get any rows back, then the query was probably an insert or
3795 # update, so we call format_affected
3796 if($count <= 0 && !$isselect) {
3797 return($sth->rows(), 'affected');
3799 return($count, 'selected');
3801 die("Invalid format: $format");
3805 sub format_affected {
3806 my($rows_affected, $success_code) = @_;
3807 debugmsg(3, "format_affected called", @_);
3808 # This just outputs the given number
3810 return("$rows_affected row" . ($rows_affected == 1 ? '' : 's')
3815 my($num, $max) = @_;
3816 debugmsg(3, "statusline called", @_);
3820 (\$linewidth) = GetTerminalSize();
3825 my $numwidth = length($num);
3826 my $maxwidth = length($max);
3827 my $width = $linewidth - $numwidth - $maxwidth - 9;
3829 my $fillnum = (($num / $max) * $width);
3830 my $spacenum = ((($max - $num) / $max) * $width);
3832 if($fillnum =~ /\./) {
3833 $fillnum = int($fillnum) + 1;
3836 if($spacenum =~ /\./) {
3837 $spacenum = int($spacenum);
3840 my $fill = ('*' x $fillnum);
3841 my $space = ('-' x $spacenum);
3842 my $pcnt = sprintf("%.0d", ($num / $max * 100));
3844 return(sprintf("%-" . $linewidth . "s", "$num/$max [" . $fill . $space . "] $pcnt\%") . "\r");
3850 return("\r\e[K$string\n");
3854 debugmsg(3, "ping called", @_);
3858 # install alarm signal handle
3859 $SIG{ALRM} = \&sighandle;
3860 debugmsg(2, "Setting alarm for ping ($conf{connection_timeout} seconds)");
3861 alarm($conf{connection_timeout});
3863 debugmsg(2, "Pinging...");
3865 debugmsg(2, "Ping successfull");
3866 alarm(0); # cancel alarm
3869 debugmsg(2, "Ping failed");
3870 alarm(0); # cancel alarm
3875 alarm(0); # cancel alarm
3879 my($query_type, $msg, $query) = @_;
3880 debugmsg(3, "query_err called", @_);
3881 # outputs a standard query error. does not exit
3882 # input: $query_type, $msg, $query
3889 print STDERR "$msg\n";
3890 print STDERR "Query: $query\n" if $query && $conf{sql_query_in_error};
3896 debugmsg(3, "err called", @_);
3897 # outputs an error message and exits
3899 print "Error: $msg\n";
3905 debugmsg(3, "soft_err called", @_);
3906 # outputs a error, but doesn't exit
3908 print "\nError: $msg\n\n";
3913 debugmsg(3, "wrn called", @_);
3916 print STDERR "Warning: $msg\n";
3920 my($exitcode, $force_quit, $msg) = @_;
3921 debugmsg(3, "quit called", @_);
3924 $force_quit ||= 0; # Set this to 1 to try a smoother force quit
3929 print "$msg" if $msg && $msg != "";
3938 # disconnect the database
3939 debugmsg(1, "disconnecting from database");
3942 or warn "Disconnect failed: $DBI::errstr\n";
3945 debugmsg(1, "exiting with exitcode: [$exitcode]");
3949 sub commit_on_exit {
3950 debugmsg(3, "commit_on_exit called", @_);
3953 if($conf{commit_on_exit} && defined $dbh && !$dbh->{AutoCommit}) {
3954 # do nothing, oracle commits on disconnect
3955 } elsif(defined $dbh && !$dbh->{AutoCommit}) {
3956 print "Rolling back any outstanding transaction...\n";
3958 or warn "Rollback failed: $DBI::errstr\n";
3963 my($debuglevel, @msgs) = @_;
3964 if($opt_debug >= $debuglevel ) {
3965 my @time = localtime();
3966 my $time = sprintf("%.4i-%.2i-%.2i %.2i:%.2i:%.2i", $time[5] + 1900,
3967 $time[4] + 1, $time[3], $time[2], $time[1], $time[0]);
3968 print STDERR "$time $debuglevel [" . join("] [", @msgs) . "]\n";
3974 debugmsg(3, "usage called", @_);
3979 Usage: yasql [options] [logon] [AS {SYSDBA|SYSOPER}] [@<file>[.ext]
3980 [<param1> <param2> ...]]
3981 Logon: <username>[/<password>][@<connect_string>] | /
3983 -d, --debug=LEVEL Turn debugging on to LEVEL
3984 -H, --host=HOST Host to connect to
3985 -p, --port=PORT Host port to connect to
3986 -s, --sid=SID Oracle SID to connect to
3987 -h, -?, --help This help information
3988 -A, --nocomp Turn off building the auto-completion list
3989 -b, --bench, --benchmark Display extra benchmarking info
3990 -v, --version Print version and exit
3991 -B, --batch Batch mode (no headers, etc.)
3993 See the man pages for more help.
4000 debugmsg(3, "help called", @_);
4001 # This just outputs online help
4007 quit, exit, \\q Exit the program.
4008 !<cmd>, host <cmd> Sends the command directly to a shell.
4009 \\A Regenerate the auto-completion list.
4010 connect [logon] [AS {SYSDBA|SYSOPER}]
4011 Open new connection.
4012 login = <username>[/<password>][@<connect_string>] | /
4013 reconnect, \\r Reconnect to the database
4014 desc[ribe] <object> Describe table, view, index, sequence, primary key,
4015 foreign key, constraint or trigger
4016 object = [<schema>.]<object>[\@dblink]
4017 show [all] <string> { like <name> }
4018 Shows [all] objects of a certain type
4019 string = tables, views, objects, sequences, clusters,
4020 dimensions, functions, procedures, packages,
4021 indexes, indextypes, libraries, snapshots,
4022 materialized views, synonyms, triggers,
4024 name : use % for wildcard
4025 show <string> on|for <object>
4026 Shows properties for a particular object
4027 string = indexes, constraints, keys, checks, triggers,
4029 show processes Shows logged in users
4030 show locks Shows locks
4031 show [all] waits Shows [all] waits
4032 show plan Shows the last EXPLAIN PLAN ran
4033 show errors Shows errors from PL/SQL object creation
4034 l[ist], \\l, \\p List the contents of the current buffer
4035 cl[ear] [buffer], \\c
4036 Clear the current buffer
4037 ed[it] [filename], \\e [filename]
4038 Will open a text editor as defined by the EDITOR
4039 environment variable. If a file is given as the
4040 argument, then the editor will be opened with that
4041 file. If the given file does not exist then it will be
4042 created. In both cases the file will not be deleted,
4043 and the current buffer will be overwritten by the
4044 contents of the file. If no file is given, then the
4045 editor will be opened with a temporary file, which will
4046 contain the current contents of the buffer, or the last
4047 execute query if the buffer is empty. After the editor
4048 quits, the file will be read into the buffer. The
4049 contents will be parsed and executed just as if you had
4050 typed them all in by hand. You can have multiple
4051 commands and/or queries. If the last command is not
4052 terminated them you will be able to add furthur lines
4053 or input a terminator to execute the query.
4054 \@scriptname Execute all the commands in <filename> as if they were
4055 typed in directly. All CLI commands and queries are
4056 supported. yasql will quit after running all
4057 commands in the script.
4058 debug [num] Toggle debuggin on/off or if <num> is specified, then
4059 set debugging to that level
4060 autocommit Toggle AutoCommit on/off
4061 set <string> Set options
4063 [long_read_len <size>]
4064 || [ fast_describe [on|off]]
4065 || [ serverout{put} [on|off] {size <size>} ]
4067 let <search string> Display all configurations
4070 All other input is treated as a query, and is sent straight to the database.
4072 All queries must be terminated by one of the following characters:
4073 ; - Returns data in table form
4074 / - Returns data in table form
4075 \\g - Returns data in non-aligned list form
4076 \\G - Returns data in aligned list form
4077 \\s - Returns data in CSV form. The first line is the column names
4078 \\S - Returns data in CSV form, but no column names
4079 \\i - Returns data in sql select commands form
4081 You may re-run the last query by typing the terminator by itself.
4084 user\@ORCL> select * from table;
4088 You may add a number after the terminator, which will cause only the
4089 first <num> rows to be returned. e.g. 'select * from table;10' will run
4090 the query and return the first 10 rows in table format. This will also work
4091 if you just type the terminator to rerun the last query.
4094 The following will run the query, then run it again with different settings:
4095 user\@ORCL> select * from table;10
4099 You can add a shell like redirection operator after a query to pipe the output
4103 You can use either '>' or '>>' to output to a file. '>' will overwrite the
4104 file and '>>' will append to the end of the file. The file will be created
4105 if it does not exist.
4108 user\@ORCL> select * from table; > table.dump
4109 user\@ORCL> select * from table\S > table.csv
4112 You can use '<' to grab data from a CSV file. The file must be formatted
4113 with comma delimiters, quoted special fields, and rows seperated by
4114 newlines. When you use this operator with a query, the query will be ran
4115 for every line in the file. Put either '?' or ':n' (n being a number)
4116 placeholders where you want the data from the CSV file to be interpolated.
4117 The number of placeholders must match the number of columns in the CSV file.
4118 Each query is run as if you had typed it in, so the AutoCommit setting
4119 applies the same. If there is an error then the process will stop, but no
4120 rollback or anything will be done.
4123 user\@ORCL> insert into table1 values (?,?,?); < table1.csv
4124 user\@ORCL> update table2 set col1 = :1, col3 = :3, col2 = :2; < table2.csv
4127 You can pipe the output from a query to the STDIN of any program you wish.
4130 user\@ORCL> select * from table; | less
4131 user\@ORCL> select * from table; | sort -n
4133 Please see 'man yasql' or 'perldoc yasql' for more help
4136 my $ret = open(PAGER, "|$conf{pager}");
4145 sub get_object_type {
4146 debugmsg(3, "get_object_type", @_);
4147 my $object_name = shift;
4148 my $source = shift || 'ALL_OBJECTS';
4152 if (uc($source) eq 'ALL_OBJECTS'){
4153 $sqlstr = q{SELECT OBJECT_TYPE FROM all_objects WHERE OBJECT_NAME = ? AND OWNER= ? };
4154 @data = $dbh->selectrow_array($sqlstr, undef, uc($object_name), uc($dbuser));
4155 }elsif (uc($source) eq 'USER_OBJECTS' ) {
4156 $sqlstr = q{SELECT OBJECT_TYPE FROM USER_OBJECTS WHERE OBJECT_NAME = ? };
4157 @data = $dbh->selectrow_array($sqlstr, undef, uc($object_name));
4158 }elsif (uc($source) eq 'DBA_OBJECTS' ){
4159 query_err
("internal", "get_object_type function doesn't support DBA_OBJECTS as source table!", "SELECT OBJECT_TYPE FROM DBA_OBJECTS.." );
4169 yasql - Yet Another SQL*Plus replacement
4173 B<yasql> [options] [logon] [@<file>[.ext] [<param1> <param2>]
4179 <I<username>>[/<I<password>>][@<I<connect_string>>] | /
4185 =item -d I<debuglevel>, --debug=I<debuglevel>
4187 Turn debuggin on to I<debuglevel> level. Valid levels: 1,2,3,4
4189 =item -H I<hostaddress>, --host=I<hostaddress>
4193 =item -p I<hostport>, --port=I<hostport>
4195 Host port to connect to
4197 =item -s I<SID>, --sid=I<SID>
4199 Oracle SID to connect to
4201 =item -h, -?, --help
4203 Output usage information and quit.
4207 Turn off the generation of the auto-completion list at startup. Use This if
4208 it takes too long to generate the list with a large database.
4210 =item -b, --bench, --benchmark
4212 Turn on extended benchmark info, which includes times and CPU usages for both
4213 queries and formatting.
4217 Print version and exit
4225 =item Connect to local database
4233 =item yasql user/password
4235 =item yasql user@LOCAL
4237 =item yasql user/password@LOCAL
4239 =item yasql -h localhost
4241 =item yasql -h localhost -p 1521
4243 =item yasql -h localhost -p 1521 -s ORCL
4247 =item Connect to remote host
4251 =item yasql user@REMOTE
4253 =item yasql user/password@REMOTE
4255 =item yasql -h remote.domain.com
4257 =item yasql -h remote.domain.com -p 1512
4259 =item yasql -h remote.domain.com -p 1512 -s ORCL
4267 If no connect_string or a hostaddress is given, then will attempt to connect to
4268 the local default database.
4272 YASQL is an open source Oracle command line interface. YASQL features a much
4273 kinder alternative to SQL*Plus's user interface. This is meant to be a
4274 complete replacement for SQL*Plus when dealing with ad hoc queries and general
4275 database interfacing. It's main features are:
4279 =item Full ReadLine support
4281 Allows the same command line style editing as other ReadLine enabled programs
4282 such as BASH and the Perl Debugger. You can edit the command line as well as
4283 browse your command history. The command
4284 history is saved in your home directory in a file called .yasql_history. You
4285 can also use tab completion on all table and column names.
4287 =item Alternate output methods
4289 A different style of output suited to each type of need. There are currently
4290 table, list and CSV output styles. Table style outputs in the same manner as
4291 SQL*Plus, except the column widths are set based on the width of the data in
4292 the column, and not the column length defined in the table schema. List outputs
4293 each row on it's own line, column after column for easier viewing of wide return
4294 results. CSV outputs the data in Comma Seperated Values format, for easy
4295 import into many other database/spreadsheet programs.
4297 =item Output of query results
4299 You can easily redirect the output of any query to an external file
4301 =item Data Input and Binding
4303 YASQL allows you to bind data in an external CSV file to any query, using
4304 standard DBI placeholders. This is the ultimate flexibility when inserting or
4305 updating data in the database.
4309 You can easily pipe the output of any query to an external program.
4311 =item Tab completion
4313 All tables, columns, and other misc objects can be completed using tab, much
4314 like you can with bash.
4316 =item Easy top rownum listings
4318 You can easily put a number after a terminator, which will only output those
4319 number of lines. No more typing "where rownum < 10" after every query. Now
4320 you can type 'select * from table;10' instead.
4322 =item Enhanced Data Dictionary commands
4324 Special commands like 'show tables', 'desc <table>', 'show indexes on <table>',
4325 'desc <sequence>', and many many more so that you can easily see your schema.
4329 You can open and edit queries in your favorite text editor.
4331 =item Query chaining
4333 You can put an abitrary number of queries on the same line, and each will be
4336 =item Basic scripting
4338 You can put basic SQL queries in a script and execute them from YASQL.
4342 You can create a config file of options so that you don't have to set them
4343 everytime you run it.
4345 =item Future extensibility
4347 We, the community, can modify and add to this whatever we want, we can't do that
4358 This was developed with Perl 5.6, but is known to work on 5.005_03 and above.
4359 Any earlier version of Perl 5 may or may not work. Perl 4 will definately not
4362 =item Unix environment
4364 YASQL was developed under GNU/Linux, and aimed at as many Unix installations as
4365 possible. Known to be compatible with GNU/Linux, AIX and Sun Solaris.
4366 Please send me an email (qzy@users.sourceforge.net) if it works for other platforms.
4367 I'd be especially interested if it worked on Win32.
4371 It has been tested and developed for Oracle8 and Oracle8i. There is atleast
4372 one issue with Oracle7 that I know of (see ISSUES below) and I have not tested
4373 it with Oracle9i yet.
4375 =item Oracle client libraries
4377 The Oracle client libraries must be installed for DBD::Oracle. Of course you
4378 can't install DBD::Oracle without them...
4382 DBD::Oracle must be installed since this uses DBI for database connections.
4386 The ORACLE_HOME environment variable must be set if you use a connection
4387 descriptor to connect so that YASQL can translate the descriptor into
4388 usefull connection information to make the actual connection.
4392 The ORACLE_SID environment variable must be set unless you specify one with the
4393 -s option (see options above).
4395 =item Term::ReadLine
4397 Term::ReadLine must be installed (it is with most Perl installations), but more
4398 importantly, installing Term::ReadLine::Gnu from CPAN will greatly enhance the
4403 This is used for high resolution benchmarking. It is optional.
4407 This perl module is required if you want to output CSV or input from CSV files.
4408 If you don't plan on using this features, then you don't need to install this
4413 This module is used for better input and output control. Right now it isn't
4414 required, but some parts of YASQL will look and function better with this
4421 YASQL will look for a config file first in ~/.yasqlrc then
4422 /etc/yasql.conf. The following options are available:
4426 =item connection_timeout = <seconds>
4428 Timeout for connection attempts
4432 =item max_connection_attempts = <num>
4434 The amount of times to attempt the connection if the username/password are wrong
4438 =item history_file = <file>
4440 Where to save the history file. Shell metachars will be globbed (expanded)
4442 Default: ~/.yasql_history
4444 =item pager = <file>
4446 Your favorite pager for extended output. (right now only the help command)
4450 =item auto_commit = [0/1]
4452 Autocommit any updates/inserts etc
4456 =item commit_on_exit = [0/1]
4458 Commit any pending transactions on exit. Errors or crashes will still cause
4459 the current transaction to rollback. But with this on a commit will occur
4460 when you explicitly exit.
4464 =item long_trunc_ok = [0/1]
4466 Long truncation OK. If set to 1 then when a row contains a field that is
4467 set to a LONG time, such as BLOB, CLOB, etc will be truncated to long_read_len
4468 length. If 0, then the row will be skipped and not outputted.
4472 =item long_read_len = <num_chars>
4474 Long Read Length. This is the length of characters to truncate to if
4479 =item edit_history = [0/1]
4481 Whether or not to put the query edited from the 'edit' command into the
4486 =item auto_complete = [0/1]
4488 Whether or not to generate the autocompletion list on connection. If connecting
4489 to a large database (in number of tables/columns sense), the generation process
4490 could take a bit. For most databases it shouldn't take long at all though.
4494 =item extended_complete_list = [0/1]
4496 extended complete list will cause the possible matches list to be filled by
4497 basicly any and all objects. With it off the tab list will be restricted to
4498 only tables, columns, and objects owned by the current user.
4502 =item complete_tables = [0/1]
4504 This controls whether or not to add tables to the completion list. This does
4505 nothing if auto_complete is set to 0.
4509 =item complete_columns = [0/1]
4511 This controls whether or not to add columns to the completion list. This does
4512 nothing if auto_complete is set to 0.
4516 =item complete_objects = [0/1]
4518 This controls whether or not to add all other objects to the completion list.
4519 This does nothing if auto_complete is set to 0. (Hint... depending on your
4520 schema this will include tables and columns also, so you could turn the other
4525 =item extended_benchmarks = [0/1]
4527 Whether or not to include extended benchmarking info after queries. Will
4528 include both execution times and CPU loads for both the query and formatting
4529 parts of the process.
4535 A string to include in the prompt. The prompt will always be suffixed by a
4536 '>' string. Interpolated variables:
4537 %H = connected host. will be prefixed with a '@'
4542 =item column_wildcards = [0/1]
4544 Column wildcards is an extremely experimental feature that is still being
4545 hashed out due to the complex nature of it. This should affect only select
4546 statements and expands any wildcards (*) in the column list. such as
4547 'select col* from table;'.
4551 =item sql_query_in_error = [0/1]
4553 This this on to output the query in the error message.
4557 =item nls_date_format = <string>
4559 Set the preferred NLS_DATE_FORMAT. This effects both date input and output
4560 formats. The default is ISO standard (YYYY-MM-DD HH24:MI:SS', not oracle
4561 default (YYYY-MM-DD).
4563 Default: YYYY-MM-DD HH24:MI:SS
4567 Turn on fast describes. These are much faster than the old style of desc
4568 <table>, however non-built in datatypes may not be returned properly. i.e. a
4569 FLOAT will be returned as a NUMBER type. Internally FLOATs really are just
4570 NUMBERs, but this might present problems for you. If so, set this to 0
4582 DBD::Oracle for Oracle8 may have issues connecting to an Oracle7 database. The
4583 one problem I have seen is that the use of placeholders in a query will cause
4584 oracle to issue an error "ORA-01008: not all variables bound". This will affect
4585 all of the hard-coded queries that I use such as the ones for the 'desc' and
4586 'show' commands. The queries that you type in on the command line may still
4587 work. The DBD::Oracle README mentions the use of the '-8' option to the
4588 'perl Makefile.PL' command to use the older Oracle7 OCI. This has not been
4595 Originaly written by Nathan Shafer (B<nshafer@ephibian.com>) with support from
4596 Ephibian, Inc. http://www.ephibian.com
4597 Now it is mostly developed and maintained by Balint Kozman
4598 (B<qzy@users.sourceforge.net>). http://www.imind.hu
4602 Thanks to everyone at Ephibian that helped with testing, and a special thanks
4603 to Tom Renfro at Ephibian who did a lot of testing and found quite a few
4605 Also a lot of thanks goes to the mates at iMind.dev who keep suffering from
4606 testing new features on them.
4608 The following people have also contributed to help make YASQL what it is:
4609 Allan Peda, Lance Klein, Scott Kister, Mark Dalphin, Matthew Walsh
4611 And always a big thanks to all those who report bugs and problems, especially
4616 Copyright (C) 2000-2002 Ephibian, Inc., 2005 iMind.dev.
4621 This program is free software; you can redistribute it and/or
4622 modify it under the terms of the GNU General Public License
4623 as published by the Free Software Foundation; either version 2
4624 of the License, or (at your option) any later version.
4626 This program is distributed in the hope that it will be useful,
4627 but WITHOUT ANY WARRANTY; without even the implied warranty of
4628 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
4629 GNU General Public License for more details.
4631 You should have received a copy of the GNU General Public License
4632 along with this program; if not, write to the Free Software
4633 Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
4639 =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
4641 =item allow history to be saved based on host (as an option)
4643 =item make stifle_history a configurable option
4645 =item a row is printed after "Attempting to cancel query"
4647 =item reading from a script will not change prompt properly (for a script with no terminator)
4649 =item NULL stops printing after table goes into overflow or something
4651 =item extra space in \G... maybe others
4653 =item bug: tag completion doesn't work with caps anymore
4655 =item Add support for /NOLOG
4657 =item allow dblinks in show blah on blah commands
4659 =item show query doesn't work with schemas and db links
4661 =item add save and get buffer commands
4663 =item add R[UN] command (/ equivilent)
4665 =item add support for just 'connect' and prompt for username and password
4667 =item add PASSW[ORD] command for changing password
4669 =item add -s[ilent] command line to suppress all startup output and command prompts
4671 =item add 'start' command for scripting
4673 =item add 'run' synonum for '/'
4675 =item add 'show parameters <filter>' support
4677 =item fix segfaults when cancelling large outputs
4679 =item Add a 'SPOOL' command
4681 =item fix 'set...' commands
4683 =item Add variable bindings, prompting, control structures, etc.
4685 =item be able to describe any kind of object
4687 =item Add 'startup queries' in config file or support glogin.sql and login.sql
4689 =item fix case sensitive object names
4691 =item make win32 compliant
4693 =item add better error messages when the user can't access a data dictionary
4696 =item add better error output, with line/col numbers and maybe a pointer.
4698 =item add chained ops, exactly like bash
4700 =item add plugins and hooks for all aspects.
4702 =item Add smarter tables and wrapping in columns. Also add configurable max
4703 column widths and max table width.
4705 =item Add a curses interface option for easy viewing and scrolling, etc. This
4706 will require some research to determine if it's even worth it.
4708 =item Add HTML output option
4715 Revision 1.83 2005/05/09 16:57:13 qzy
4716 Fixed the 'DECIMAL' problem with describe command.
4717 Added sql mode with \i (patch by Ed Avis).
4718 Added redirectors (>, >>, |) to describe.
4719 Added 'show user' command.
4720 Added 'show uid' command.
4721 Added new makefile targets: clean, check. (patch by Ed Avis)
4722 Added "and owner = ?" to some show targets (patch by anonymous).
4723 Added command_complete_list feature and config option.
4724 Added disconnect command
4725 Added command completion: select, update, insert, delete, execute, etc.
4726 Added table.column name completion.
4727 Added feature to run tty-less (patch by Michael Kroell).
4728 Added a workaround for SunOS's alarm() bug (patch by Ed Avis).
4729 Fixed some minor issues in parser code.
4731 Revision 1.82 2005/02/18 16:57:13 qzy
4732 Added batch mode (ewl patch).
4733 Allow connections AS SYSDBA, AS SYSOPER and internal (sysdba patch by Derek Whayman).
4734 Added server_output to config options.
4735 Changed script execution to only add script lines to the query buffer (and not to history).
4737 Revision 1.81 2002/03/06 21:55:13 nshafer
4738 Fixed bug with password prompt.
4739 Added 'show plan' for outputting last explain plan results.
4740 Added 'show query' for viewing queries for views and materialized views.
4741 Optimized describes to be as fast as describes in SQL*Plus.
4742 Added new option 'fast_describe' on by default for new describe method.
4743 Added single_output as a formatting option for internal use.
4744 Fixed problem with password, quit, exit, \q getting added to the history list.
4745 Changed history to not add duplicate entries right next to each other.
4746 Added support for basic (non-returning) PL/SQL commands.
4747 Added support for create function, package, package body, prodedure, trigger.
4748 Added 'show errors' command
4749 Added 'conn' shortcut for 'connection'.
4750 Added 'exec[ute]' command.
4751 Added 'set serverout[put] on|off' command to mimic SQL*Plus's.
4752 Added alarms to pings in cases where DB connection is dropped and ping hangs.
4753 Cleaned up error messages.
4754 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.
4755 Changed quote escaping to be '' and "" instead of \' and \".
4756 Added full support for comments: rem[ark], --, and /* */.
4757 Right-justify works for the '8' datatype as well as '3' now.
4758 Re-worked debug output levels.
4759 Optimized query for completion lists a bit.
4760 Added completion-list limiting based on location in some DML statements (select, update, insert).
4761 Fixed up the display of '...' when generating tab completion list. Should work a lot better when hitting tab in the middle of the line.
4762 Added show views, objects, sequences, clusters, dimensions, functions, procedures, packages, indexes, indextypes, libraries, materialized views, snapshots, synonyms, triggers.
4763 Added show all <objects> command.
4764 Added type and owner columns to show commands.
4765 Fixed commit_on_exit logic.
4766 Added ability to use external authentication ('yasql /').
4767 The .sql extension for the scripting and editing commands are now optional.
4768 Fixed up editor execution to hopefully find the editor better.
4769 Added "Command" entry to "show processes".
4770 Added "show waits" and "show all waits" commands.
4771 Re-organized command line usage in anticipation for script parameters.
4772 Removed all uses of 'stty'.
4773 Added processing of STDIN, so redirects and pipes to YASQL work now.
4774 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
4775 Updated documentation.
4776 Fixed up alarm() calls.
4777 Fixed setting of NLS_DATE_FORMAT to apply on reconnects.
4778 Broke commands into 2 sets... ones that exectute any time, and ones that execute only when nothing is in the buffer
4779 Fixed printing of text read in from an edit command. It now echoes all of it.
4780 Now ignoring most SET commands so we don't tack them onto queries
4781 Fixed permissions in tarball
4783 Revision 1.80 2001/08/01 18:06:27 nshafer
4784 Fixed bug with delayed $term initialization\e\b
4786 Revision 1.79 2001/08/01 17:52:35 nshafer
4787 Fixed compatibility issues with the data dictionary in Oracle 7. Fixed ordering
4788 of indexes for compound indexes. Fixed display of objects from other schemas
4789 in some data dictionary commands such as 'show indexes on table'. (Thanks Nix)
4790 Fixed matching of declare and end in query string. Will not only match if on
4791 blank line. Fixed matching of '/' terminator in middle of queries. Will now
4792 only match if at end of line (Thanks Wesley Hertlein). Temp file for editing
4793 now appends '.sql' to end of temp file so that editors, like vim, automatically
4794 turn on syntax highlighting. Added searching of environment variable SQLPATH
4795 when looking for scripts. Terminal setup is now after script parsing, so that
4796 it will work when run under cron (Thanks David Zverina).
4798 Revision 1.78 2001/07/05 13:52:56 nshafer
4799 Fixed bug where parens were matching improperly.
4801 Revision 1.77 2001/07/04 02:57:08 nshafer
4802 Fixed bug where terminators wouldn't match if they were the next character
4803 after a quote character.
4805 Revision 1.76 2001/06/28 04:17:53 nshafer
4806 Term::ReadLine::Perl now supported, for what little functionality it does
4807 provide. Fixed segfault when hitting up when history is empty. Fixed bug
4808 when providing script names on command line (Thanks to Dave Zverina.)
4809 Rewrote the query parser to fix a bug, caused by the multiple-queries-on-one-
4810 line feature, that causes terminators, such as ';' and '/' to match when in
4811 quotes. When hitting tab on a line starting with a '@' for scripts, tab will
4812 now complete filenames and not database objects. Fixed DB timeout when
4813 prompting for username and password. Added support for 'DECLARE' keyword,
4814 however this does not mean that variable binding in PL/SQL blocks works yet.
4815 Sped up startup time a bit more (hopefully).
4817 Revision 1.75 2001/06/19 16:02:16 nshafer
4818 Fixed typo in error message for Term::ReadLine::Gnu
4819 Fixed crash when tab hit at username or password prompt
4820 Added -- as a comment type and fixed case where comment in quotes would
4821 match. (Mark Dalphin)
4822 Fixed 'desc' to also describe partitioned tables (Erik)
4824 Revision 1.74 2001/06/18 21:07:55 nshafer
4825 Fixed bug where / would not rerun last query (thanks Scott Kister)
4827 Revision 1.73 2001/05/23 18:35:17 nshafer
4828 Got rid of "Prototype mismatch" errors. Fixed typo in extended benchmarks
4830 Revision 1.72 2001/05/22 16:06:36 nshafer
4831 Fixed bug with error messages not displaying first time, and fixed bug with
4832 tab completion output
4834 Revision 1.71 2001/05/17 21:28:40 nshafer
4835 New CSV output format. Added CSV file input on any query. Added ability to
4836 pipe query results to any program. Added ability for multiple queries on one
4837 line. Changed tab completion generator to run first time you hit tab instead
4838 of on startup, which speeds up database connection. Now using SelfLoader to
4839 speed up loading and minimize memory use. Added a 'show plan for ____' command
4840 for easy display of explain plan output. Query times are now more readable
4841 and will split into weeks, days, hours, minutes, and seconds. Hopefully fixed
4842 some problems with stty and Solaris 2.4. Added support for 'rem' comments in
4843 scripts. Redirection output files are now shell expanded.
4845 Revision 1.70 2001/05/08 17:49:51 nshafer
4846 Fixed all places where a non-alphanumeric object name would break or not
4848 Added code for autoconf style installs.
4850 Revision 1.69 2001/05/07 23:47:47 nshafer
4853 Revision 1.68 2001/05/07 22:26:20 nshafer
4854 Fixed tab completion problems when completing objects with a $ in their name.
4855 Added config options complete_tables, complete_columns, and complete_objects,
4856 Added redirection of query output to file. Hopefully sped up exiting.
4857 Updated documentation.
4859 Revision 1.67 2001/05/04 17:35:04 nshafer
4860 YASQL will now suspend properly back to the shell when SIGTSTP is sent, as in
4861 when you hit ctrl-z on most systems. Added NLS_DATE_FORMAT setting in config
4862 file to support alter date views. Defaults to ISO standard. YASQL will now
4863 attempt to change it's process name, such as when viewed in ps or top. This
4864 will not work on all systems, nor is it a complete bullet proof way to hide
4865 your password if you provide it on the command line. But it helps to not
4866 make it so obvious to regular users. Scripts entered on the command line are
4867 now checked to be readable before attempting connection. A failed 'connect
4868 command will no long alter the prompt. Added \p option for printing the
4869 current buffer, ala psql. Large query results (over 1000 rows) are now
4870 handled MUCH better. YASQL will no longer try to hold more than 1000 rows in
4871 memory, which keeps it from sucking memory, and also improves the speed.
4872 When a query does return more than 1000 rows in table mode, those first 1000
4873 will determine the column widths, and all rows after that will get truncated.
4874 AIX has been reported to run YASQL perfectly.
4876 Revision 1.66 2001/03/13 21:34:58 nshafer
4877 There are no longer any references to termcap, so yasql should now work on
4878 termcap-less systems such as Debian Linux and AIX
4880 Revision 1.65 2001/03/12 17:44:31 nshafer
4881 Restoring the terminal is hopefully more robust and better now. YASQL now
4882 tries to use the 'stty' program to dump the settings of the terminal on
4883 startup so that it can restore it back to those settings. It requires that
4884 stty is installed in the path, but that should be the case with most systems.
4885 Also made the output of the query in the error message an option that is off
4886 by default. I had never meant to include that in the final release, but kept
4887 on forgetting to take it out.
4889 Revision 1.64 2001/03/06 16:00:33 nshafer
4890 Fixed bug where desc would match anytime, even in middle of query, which is
4893 Revision 1.63 2001/03/01 17:30:26 nshafer
4894 Refined the ctrl-c process for not-so-linuxy OS's, namely solaris. Now
4895 stripping out Dos carriage returns since SQL*Plus seems to.
4897 Revision 1.62 2001/02/26 22:39:12 nshafer
4898 Fixed bug where prompt would reset itself when a blank line was entered.
4899 Added script argument on command line (Lance Klein)
4900 Added support for any command line commands in the script (Lance Klein)
4901 The 'desc' and 'show' commands no longer require a terminator (like ;) as long as the whole statement is on one line (Lance Klein)
4902 Added option 'extended_tab_list' for a much bigger, more complete tab listing (Lance Klein)
4903 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.
4904 cleaned up documentation a bit
4906 Revision 1.61 2001/01/31 19:56:22 nshafer
4907 changed CommitOnExit to be 1 by default, to emulate SQL*Plus behavior, and
4910 Revision 1.60 2001/01/29 16:38:17 nshafer
4913 Revision 1.59 2001/01/29 16:28:22 nshafer
4914 Modified docs a little with the new scope of open source now in the mix.
4916 Revision 1.58 2001/01/24 15:27:00 nshafer
4917 cleanup_after_signals is not in the Term::ReadLine::Stub, so it would
4918 output error messages on systems without Term::ReadLine::Gnu. Fixed
4920 Revision 1.57 2001/01/17 23:26:53 nshafer
4921 Added Tom Renfro's column_wildcard expansion code. New conf variable:
4922 column_wildcards. 0 by default until this code is expanded on a bit more.
4924 Revision 1.56 2001/01/17 23:00:25 nshafer
4925 Added CommitOnExit config, 0 by default. Added info output at startup and
4926 when a new connection is initiated about the state of AutoCommit and
4927 CommitOnExit. Also added statement about explicit rollback or commit when
4928 disconnecting. Added warning message to commit_cmd and rollback_cmd if
4929 AutoCommit is on. Now explicitly committing or rolling back on disconnect,
4930 it is no longer left up to the DBI's discretion... except in abnormal
4933 Revision 1.55 2001/01/11 18:05:12 nshafer
4934 Added trap for regex errors in tab completion (like if you put 'blah[' then
4937 Revision 1.54 2001/01/10 17:07:22 nshafer
4938 added output to those last 2 commands
4940 Revision 1.53 2001/01/10 17:03:58 nshafer
4941 added commit and rollback commands so that you don't have to send them to the
4944 Revision 1.52 2001/01/10 16:00:08 nshafer
4945 fixed bug with prompt where on each call get_prompt would add another '@'.
4948 Revision 1.51 2001/01/09 21:16:12 nshafer
4949 dar... fixed another bug where the %H would stay if there was no prompt_host
4951 Revision 1.50 2001/01/09 21:12:13 nshafer
4952 fixed bug with that last update. Now it only interpolates the %H variable
4953 if there is something to interpolate it with
4955 Revision 1.49 2001/01/09 21:09:56 nshafer
4956 changed the %H variable to be prefixed with a @
4958 Revision 1.48 2001/01/09 21:04:36 nshafer
4959 changed 'default' to '' for the prompt's hostname when no connect_string is
4962 Revision 1.47 2001/01/09 20:55:11 nshafer
4963 added configurable prompt and changed the default prompt
4965 Revision 1.46 2001/01/09 18:50:50 nshafer
4968 Revision 1.45 2001/01/09 18:32:35 nshafer
4969 Added 'connect <connect_string>' command. I may add the ability to specify
4970 options like on the command line (like '-H blah.com')
4972 Revision 1.44 2001/01/08 22:08:49 nshafer
4973 more documentation changes
4975 Revision 1.43 2001/01/08 20:51:31 nshafer
4976 added some documentation
4978 Revision 1.42 2001/01/08 20:09:35 nshafer
4979 Added debug and autocommit commands
4981 Revision 1.41 2001/01/08 18:12:43 nshafer
4982 added END handler to hopefully clean up the terminal better
4984 Revision 1.40 2001/01/05 23:29:38 nshafer
4987 Revision 1.39 2001/01/05 18:00:16 nshafer
4988 Added config file options for auto completion generation and extended
4991 Revision 1.38 2001/01/05 16:39:47 nshafer
4992 Fixed error where calling edit a second time would not open the file properly
4993 because of the way glob() works.
4995 Revision 1.37 2001/01/04 23:52:30 nshafer
4996 changed the version string to parse it out of the revision string (duh...)
4997 moved the prompting of username and password so that the check for the
4998 oracle_home variable happens before. Before if you didn't have the environment
4999 variable set then it will prompt you for username and password, then die
5000 with the error, which is annoying
5001 fixed the quit calls so taht they properly erase the quit line from the
5002 history. I had broken this a long time ago when I added the exit status
5003 param to the quit function
5004 Outputting in full table format (';' terminator) with a num_rows number
5005 (like ';100') would still cause the entire result set to be pulled into
5006 memory, which was really slow and could take a lot of memory if the table
5007 was large. Fixed it so that it only pulls in num_rows number of rows when
5008 using the digit option
5010 Revision 1.36 2000/12/22 22:12:18 nshafer
5011 fixed a wrong-quote-type in the debug messages
5013 Revision 1.35 2000/12/22 22:07:06 nshafer
5014 forgot version... you know the drill...
5016 Revision 1.34 2000/12/22 21:57:01 nshafer
5017 Added config file support, queries from the 'edit' command are now entered
5018 into the command history (configurable), cleaned up the SIGINT actions quite
5019 a bit so they should work better now, added LongReadLen and LongTruncOk
5020 options so that LONG columns types won't mess up, added the number after terminator
5021 feature to limit how many rows are returned.
5023 Revision 1.33 2000/12/20 22:56:03 nshafer
5024 version number.... again.... sigh
5026 Revision 1.32 2000/12/20 22:55:32 nshafer
5027 added todo item, now in rpms
5029 Revision 1.31 2000/12/20 17:07:52 nshafer
5030 added the reprompt for username/password on error 1005 null password given
5032 Revision 1.30 2000/12/20 17:04:18 nshafer
5033 Refined the shadow_redisplay stuff. Now I will only use my builtin function
5034 if the terminal type is set to "xterm" because that terminal type has a
5035 broken termcap entry. Also set it to not echo when entering password if
5036 Term::ReadLine::Gnu is not installed
5038 Revision 1.29 2000/12/20 15:47:56 nshafer
5039 trying a new scheme for the shadow_redisplay. Clear to EOL wasn't working
5040 Also fixed a few problems in the documentation
5043 Revision 1.28 2000/12/19 23:55:03 nshafer
5044 I need to stop forgetting the revision number...
5046 Revision 1.27 2000/12/19 23:48:49 nshafer
5047 cleaned up debugging
5049 Revision 1.26 2000/12/19 23:10:18 nshafer
5050 Lotsa new stuff... tab completion of table, column, and object names,
5051 improved signal handling, the edit command now accepts a filename parameter,
5052 new command 'show processes' which shows you info on who's connected,
5053 improved benchmark info, and a lot of other cleanup/tweaks
5055 Revision 1.25 2000/12/13 16:58:26 nshafer
5056 oops forgot documentation again
5058 Revision 1.24 2000/12/13 16:54:42 nshafer
5059 added desc <trigger>
5061 Revision 1.23 2000/12/12 17:52:15 nshafer
5062 updated todo list (oops, forgot)
5064 Revision 1.22 2000/12/12 17:51:39 nshafer
5067 Revision 1.21 2000/12/12 17:15:28 nshafer
5068 fixed bug when connecting using a host string (-H option)
5069 added a few more types to the 'show' and 'desc' commands
5071 Revision 1.20 2000/12/08 22:13:43 nshafer
5072 many little fixes and tweaks here and there
5074 Revision 1.19 2000/12/06 20:50:03 nshafer
5075 added scripting ability with "@<filename>" command
5076 changed all tabs to spaces!
5078 Revision 1.18 2000/12/06 19:30:38 nshafer
5080 refined connection process. if invalid username/password entered then prompt again
5082 Revision 1.17 2000/12/05 22:20:58 nshafer
5083 Tightened up outputs. Doesn't show column names if no rows selected, if
5084 it's not a select, then show number of rows affected
5086 Revision 1.16 2000/12/04 18:04:53 nshafer
5087 *** empty log message ***
5089 Revision 1.15 2000/12/04 18:03:14 nshafer
5090 fixed bug where the -H option was interpreted as -h or help. All command
5091 line options are now case sensitive
5093 Revision 1.14 2000/12/04 17:54:38 nshafer
5094 Added list command (and \l and l)
5096 Revision 1.13 2000/12/04 17:34:18 nshafer
5097 fixed a formatting issue if Time::HiRes isn't installed
5099 Revision 1.12 2000/12/04 17:29:41 nshafer
5100 Added benchmark options to view the extended benchmark info. Now it displays
5101 just the time in a more friendly format. The old style is only active if the
5102 benchmark option is specified.
5103 Cleaned up some formatting issues
5104 Brought the usage and POD documentation up to date
5105 Added some items to the TODO
5107 Revision 1.11 2000/11/30 22:54:38 nshafer
5108 Fixed bug with the edit command where if you were 'inquotes' then you would
5109 stay in quotes even after editing the file
5111 Revision 1.10 2000/11/30 22:01:38 nshafer
5112 Fixed bug where username and password were added to the command history.
5113 Set it so that the quit commands are not added to the command history either.
5114 Added the 'edit' command and modified it's todo list item, as well as added
5115 it to the 'help' command
5117 Revision 1.9 2000/11/29 17:55:35 nshafer
5118 changed version from .21 to 1.0 beta 9. I'll follow the revision numbers now
5120 Revision 1.8 2000/11/29 17:46:31 nshafer
5121 added a few items to the todo list
5123 Revision 1.7 2000/11/29 15:50:56 nshafer
5124 got rid of SID output at startup
5126 Revision 1.6 2000/11/29 15:49:51 nshafer
5127 moved revision info to $revision and added Id output
5129 Revision 1.5 2000/11/29 15:46:41 nshafer
5130 fixed revision number
5132 Revision 1.4 2000/11/29 15:44:23 nshafer
5133 fixed issue where environment variable ORACLE_SID overwrote explicit set
5134 on the command line. now whatever you put on the command line will overwrite
5135 the environment variable