#!/usr/local/bin/perl # vim: set tabstop=2 smartindent shiftwidth=2 expandtab : # # Name: yasql - Yet Another SQL*Plus replacement # # See POD documentation at end # # $Id: yasql,v 1.83 2005/05/09 16:57:13 qzy Exp qzy $ # # Copyright (C) 2000 Ephibian, Inc. # Copyright (C) 2005 iMind.dev, Inc. # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # # Yasql was originally developed by Nathan Shafer at Ephibian, Inc. # Now it is mainly developed and maintained by Balint Kozman at iMind.dev, Inc. # # email: nshafer@ephibian.com # email: qzy@users.sourceforge.net # use strict; use SelfLoader; use DBI; use Term::ReadLine; use Data::Dumper; use Benchmark; use Getopt::Long; # Load DBD::Oracle early to work around SunOS bug. See # http://article.gmane.org/gmane.comp.lang.perl.modules.dbi.general/207 # require DBD::Oracle; #Globals use vars qw( $VERSION $Id $dbh $cursth @dbparams $dbuser $dbversion $term $term_type $features $attribs $last_history $num_connects $connected $running_query @completion_list @completion_possibles $completion_built $opt_host $opt_sid $opt_port $opt_debug $opt_bench $opt_nocomp $opt_version $qbuffer $last_qbuffer $fbuffer $last_fbuffer $quote $inquotes $inplsqlblock $increate $incomment $csv_filehandle_open $csv_max_lines $nohires $notextcsv $csv $sysconf $sysconfdir $quitting $sigintcaught %conf %prompt $prompt_length @sqlpath %set $opt_batch $opt_notbatch $opt_headers ); select((select(STDOUT), $| = 1)[0]); #unbuffer STDOUT $sysconfdir = "/u/avised/etc"; $sysconf = "$sysconfdir/yasql.conf"; # try to include Time::HiRes for fine grained benchmarking eval q{ use Time::HiRes qw (gettimeofday tv_interval); }; # try to include Text::CSV_XS for input and output of CSV data eval q{ use Text::CSV_XS; }; if($@) { $notextcsv = 1; } # install signal handlers sub setup_sigs { $SIG{INT} = \&sighandle; $SIG{TSTP} = 'DEFAULT'; $SIG{TERM} = \&sighandle; } setup_sigs(); # install a filter on the __WARN__ handler so that we can get rid of # DBD::Oracle's stupid ORACLE_HOME warning. It would warn even if we don't # connect using a TNS name, which doesn't require access to the ORACLE_HOME $SIG{__WARN__} = sub{ warn(@_) unless $_[0] =~ /environment variable not set!/; }; # initialize the whole thing init(); if($@) { if(!$opt_batch) { wrn("Time::HiRes not installed. Please install if you want benchmark times " ."to include milliseconds."); } $nohires = 1; } $connected = 1; # start the interface interface(); # end ################################################################################ ########### non-self-loaded functions ######################################## sub BEGIN { $Id = '$Id: yasql,v 1.83 2005/05/09 02:07:13 nshafer Exp nshafer $'; ($VERSION) = $Id =~ /Id: \S+ (\d+\.\d+)/; } sub argv_sort { if($a =~ /^\@/ && $b !~ /^\@/) { return 1; } elsif($a !~ /^\@/ && $b =~ /^\@/) { return -1; } else { return 0; } } sub sighandle { my($sig) = @_; debugmsg(3, "sighandle called", @_); $SIG{$sig} = \&sighandle; if($sig =~ /INT|TERM|TSTP/) { if($quitting) { # then we've already started quitting and so we just try to force exit # without the graceful quit print STDERR "Attempting to force exit...\n"; exit(); } if($sigintcaught) { # the user has alrady hit INT and so we now force an exit print STDERR "Caught another SIG$sig\n"; quit(undef, 1); } else { $sigintcaught = 1; } if($running_query) { if(defined $cursth) { print STDERR "Attempting to cancel query...\n"; debugmsg(1, "canceling statement handle"); my $ret = $cursth->cancel(); $cursth->finish; } } elsif(!$connected) { quit(); if(defined $cursth) { print STDERR "Attempting to cancel query...\n"; debugmsg(1, "canceling statement handle"); my $ret = $cursth->cancel(); $cursth->finish; } } } elsif($sig eq 'ALRM') { if(defined $dbh) { wrn("Connection lost (timeout: $conf{connection_timeout})"); quit(1); } else { err("Could not connect to database, timed out. (timeout: " ."$conf{connection_timeout})"); } } } sub END { debugmsg(3, "END called", @_); # save the history buffer if($term_type && $term_type eq 'gnu' && $term->history_total_bytes()) { debugmsg(1, "Writing history"); unless($term->WriteHistory($conf{history_file})) { wrn("Could not write history file to $conf{history_file}. " ."History not saved"); } } } ################################################################################ ########### self-loaded functions ############################################## #__DATA__ sub init { # call GetOptions to parse the command line my $opt_help; Getopt::Long::Configure( qw(permute) ); $Getopt::Long::ignorecase = 0; usage(1) unless GetOptions( "debug|d:i" => \$opt_debug, "host|H=s" => \$opt_host, "port|p=s" => \$opt_port, "sid|s=s" => \$opt_sid, "help|h|?" => \$opt_help, "nocomp|A" => \$opt_nocomp, "bench|benchmark|b" => \$opt_bench, "version|V" => \$opt_version, "batch|B" => \$opt_batch, "interactive|I" => \$opt_notbatch, ); # set opt_debug to 1 if it's defined, which means the user just put -d or # --debug without an integer argument $opt_debug = 1 if !$opt_debug && defined $opt_debug; $opt_batch = 0 if $opt_notbatch; $opt_batch = 1 unless defined $opt_batch || -t STDIN; debugmsg(3, "init called", @_); # This reads the command line then initializes the DBI and Term::ReadLine # packages $sigintcaught = 0; $completion_built = 0; usage(1) if $opt_help; # Output startup string if(!$opt_batch) { print STDERR "\n"; print STDERR "YASQL version $VERSION Copyright (c) 2000-2001 Ephibian, Inc, 2005 iMind.dev.\n"; print STDERR '$Id: yasql,v 1.83 2005/05/09 02:07:13 qzy Exp qzy $' . "\n"; } if($opt_version) { print STDERR "\n"; exit(0); } if(!$opt_batch) { print STDERR "Please type 'help' for usage instructions\n"; print STDERR "\n"; } # parse the config files. We first look for ~/.yasqlrc, then # /etc/yasql.conf # first set up the defaults %conf = ( connection_timeout => 20, max_connection_attempts => 3, history_file => '~/.yasql_history', pager => '/bin/more', auto_commit => 0, commit_on_exit => 1, long_trunc_ok => 1, long_read_len => 80, edit_history => 1, auto_complete => 1, extended_benchmarks => 0, prompt => '%U%H', column_wildcards => 0, extended_complete_list => 0, command_complete_list => 1, sql_query_in_error => 0, nls_date_format => 'YYYY-MM-DD HH24:MI:SS', complete_tables => 1, complete_columns => 1, complete_objects => 1, fast_describe => 1, server_output => 2000, ); my $config_file; if(-e "$ENV{HOME}/.yasqlrc") { $config_file = "$ENV{HOME}/.yasqlrc"; } elsif(-e $sysconf) { $config_file = $sysconf; } if($config_file) { debugmsg(2, "Reading config: $config_file"); open(CONFIG, "$config_file"); while() { chomp; s/#.*//; s/^\s+//; s/\s+$//; next unless length; my($var, $value) = split(/\s*=\s*/, $_, 2); $var = 'auto_commit' if $var eq 'AutoCommit'; $var = 'commit_on_exit' if $var eq 'CommitOnExit'; $var = 'long_trunc_ok' if $var eq 'LongTruncOk'; $var = 'long_read_len' if $var eq 'LongReadLen'; $conf{$var} = $value; debugmsg(3, "Setting option [$var] to [$value]"); } } if (($conf{server_output} > 0) && ($conf{server_output} < 2000)) { $conf{server_output} = 2000; } if ($conf{server_output} > 1000000) { $conf{server_output} = 1000000; } ($conf{history_file}) = glob($conf{history_file}); debugmsg(3,"Conf: [" . Dumper(\%conf) . "]"); # Create a Text::CSV object unless($notextcsv) { $csv = new Text::CSV_XS; } # Change the process name to just 'yasql' to somewhat help with security. # This is not bullet proof, nor is it supported on all platforms. Those that # don't support this will just fail silently. debugmsg(2, "Process name: $0"); $0 = 'yasql'; # Parse the SQLPATH environment variable if it exists if($ENV{SQLPATH}) { @sqlpath = split(/;/, $ENV{SQLPATH}); } # If the user set the SID on the command line, we'll overwrite the # environment variable so that DBI sees it. #print "Using SID $opt_sid\n" if $opt_sid; $ENV{ORACLE_SID} = $opt_sid if $opt_sid; # output info about the options given print STDERR "Debugging is on\n" if $opt_debug; DBI->trace(1) if $opt_debug > 3; # Extending on from Oracle's conventions, try and obtain an early indication # of ora_session_mode from AS SYSOPER, AS SYSDBA options. Be flexible :-) my $ora_session_mode = 0; my $osmp = ''; if (lc($ARGV[-2]) eq 'as') { $ora_session_mode = 2 if lc($ARGV[-1]) eq 'sysdba'; $ora_session_mode = 4 if lc($ARGV[-1]) eq 'sysoper'; pop @ARGV; pop @ARGV; } elsif (lc($ARGV[1]) eq 'as') { $ora_session_mode = 2 if lc($ARGV[2]) eq 'sysdba'; $ora_session_mode = 4 if lc($ARGV[2]) eq 'sysoper'; @ARGV = ($ARGV[0], @ARGV[3..$#ARGV]); } # set up DBI if(@ARGV == 0) { # nothing was provided debugmsg(2, "No command line args were found"); $dbh = db_connect(1, $ora_session_mode); } else { debugmsg(2, "command line args found!"); debugmsg(2, @ARGV); # an argument was given! my $script = 0; if(substr($ARGV[0], 0, 1) eq '@') { # no logon string was given, must be a script debugmsg(2, "Found: no logon, script name"); my($script_name, @script_params) = @ARGV; $script = 1; $dbh = db_connect(1, $ora_session_mode); run_script($script_name); } elsif(substr($ARGV[0], 0, 1) ne '@' && substr($ARGV[1], 0, 1) eq '@') { # A logon string was given as well as a script file debugmsg(2, "Found: login string, script name"); my($logon_string, $script_name, @script_params) = @ARGV; $script = 1; my($ora_session_mode2, $username, $password, $connect_string) = parse_logon_string($logon_string); $ora_session_mode = $ora_session_mode2 if $ora_session_mode2; $dbh = db_connect(1, $ora_session_mode, $username, $password, $connect_string); run_script($script_name); } elsif(@ARGV == 1 && substr($ARGV[0], 0, 1) ne '@') { # only a logon string was given debugmsg(2, "Found: login string, no script name"); my($logon_string) = @ARGV; my($ora_session_mode2, $username, $password, $connect_string) = parse_logon_string($logon_string); $ora_session_mode = $ora_session_mode2 if $ora_session_mode2; $dbh = db_connect(1, $ora_session_mode, $username, $password, $connect_string); } else { usage(1); } if ($conf{server_output} > 0) { $dbh->func( $conf{server_output}, 'dbms_output_enable' ); $set{serveroutput} = 1; } # Quit if one or more scripts were given on the command-line quit(0) if $script; } if (!$opt_batch) { setup_term() unless $term; } # set up the pager $conf{pager} = $ENV{PAGER} if $ENV{PAGER}; } sub setup_term { # set up the Term::ReadLine $term = new Term::ReadLine('YASQL'); $term->ornaments(0); $term->MinLine(0); debugmsg(1, "Using " . $term->ReadLine()); if($term->ReadLine eq 'Term::ReadLine::Gnu') { # Term::ReadLine::Gnu specific setup $term_type = 'gnu'; $attribs = $term->Attribs(); $features = $term->Features(); $term->stifle_history(500); if($opt_debug >= 4) { foreach(sort keys(%$attribs)) { debugmsg(4,"[term-attrib] $_: $attribs->{$_}"); } foreach(sort keys(%$features)) { debugmsg(4,"[term-feature] $_: $features->{$_}"); } } # read in the ~/.yasql_history file if(-e $conf{history_file}) { unless($term->ReadHistory($conf{history_file})) { wrn("Could not read $conf{history_file}. History not restored"); } } else { print STDERR "Creating $conf{history_file} to store your command line history\n"; open(HISTORY, ">$conf{history_file}") or wrn("Could not create $conf{history_file}: $!"); close(HISTORY); } $last_history = $term->history_get($term->{history_length}); $attribs->{completion_entry_function} = \&complete_entry_function; my $completer_word_break_characters = $attribs->{completer_word_break_characters}; $completer_word_break_characters =~ s/[a-zA-Z0-9_\$\#]//g; $attribs->{completer_word_break_characters} = $completer_word_break_characters; #$attribs->{catch_signals} = 0; } elsif($term->ReadLine eq 'Term::ReadLine::Perl') { # Term::ReadLine::Perl specific setup $term_type = 'perl'; if($opt_debug >= 4) { foreach(sort keys(%{$term->Features()})) { debugmsg(4,"[term-feature] $_: $attribs->{$_}"); } } } if ($term->ReadLine eq 'Term::ReadLine::Stub') { wrn("Neither Term::ReadLine::Gnu or Term::ReadLine::Perl are installed.\n" . "Please install from CPAN for advanced functionality. Until then " . "YASQL will run\ncrippled. (like possibly not having command history " . "or line editing...\n"); } } sub parse_logon_string { debugmsg(3, "parse_logon_string called", @_); my($arg) = @_; my($ora_session_mode, $username, $password, $connect_string); # strip off AS SYSDBA / AS SYSOPER first if($arg =~ /^(.*)\s+as\s+sys(\w+)\s*$/i) { $ora_session_mode = 2 if lc($2) eq 'dba'; $ora_session_mode = 4 if lc($2) eq 'oper'; $arg = $1 if $ora_session_mode; $ora_session_mode = 0 unless $ora_session_mode; } if($arg =~ /^\/$/) { $username = ''; $password = ''; $connect_string = 'external'; return($ora_session_mode, $username, $password, $connect_string); } elsif($arg eq 'internal') { $username = ''; $password = ''; $connect_string = 'external'; $ora_session_mode = 2; return($ora_session_mode, $username, $password, $connect_string); } elsif($arg =~ /^([^\/]+)\/([^\@]+)\@(.*)$/) { #username/password@connect_string $username = $1; $password = $2; $connect_string = $3; return($ora_session_mode, $username, $password, $connect_string); } elsif($arg =~ /^([^\@]+)\@(.*)$/) { # username@connect_string $username = $1; $password = ''; $connect_string = $2; return($ora_session_mode, $username, $password, $connect_string); } elsif($arg =~ /^([^\/]+)\/([^\@]+)$/) { # username/password $username = $1; $password = $2; $connect_string = ''; return($ora_session_mode, $username, $password, $connect_string); } elsif($arg =~ /^([^\/\@]+)$/) { # username $username = $1; $password = $2; $connect_string = ''; return($ora_session_mode, $username, $password, $connect_string); } elsif($arg =~ /^\@(.*)$/) { # @connect_string $username = ''; $password = ''; $connect_string = $1; return($ora_session_mode, $username, $password, $connect_string); } else { return(undef,undef,undef,undef); } } sub populate_completion_list { my($inline_print, $current_table_name) = @_; debugmsg(3, "populate_completion_list called", @_); # grab all the table and column names and put them in @completion_list if($inline_print) { $| = 1; print STDERR "..."; } else { print STDERR "Generating auto-complete list...\n"; } if($conf{extended_complete_list}) { my @queries; if($conf{complete_tables}) { push(@queries, 'select table_name from all_tables'); } if($conf{complete_columns}) { push(@queries, 'select column_name from all_tab_columns'); } if($conf{complete_objects}) { push(@queries, 'select object_name from all_objects'); } my $sqlstr = join(' union ', @queries); debugmsg(3, "query: [$sqlstr]"); my $sth = $dbh->prepare($sqlstr) or query_err('prepare', $DBI::errstr, $sqlstr), setup_sigs(), return(0); $sth->execute() or query_err('execute', $DBI::errstr, $sqlstr), setup_sigs(), return(0); while(my $res = $sth->fetchrow_array()) { push(@completion_list, $res); } } else { my @queries; if($conf{complete_tables}) { push(@queries, "select 'table-' || table_name from user_tables"); } if($conf{complete_columns}) { push(@queries, "select 'column-' || column_name from user_tab_columns"); } if($conf{complete_objects}) { push(@queries, "select 'object-' || object_name from user_objects"); } my $sqlstr = join(' union ', @queries); debugmsg(3, "query: [$sqlstr]"); my $sth = $dbh->prepare($sqlstr) or query_err('prepare', $DBI::errstr, $sqlstr), setup_sigs(), return(0); $sth->execute() or query_err('execute', $DBI::errstr, $sqlstr), setup_sigs(), return(0); while(my $res = $sth->fetchrow_array()) { push(@completion_list, $res); } } if ($conf{command_complete_list}) { push(@completion_list, "command-create", "command-select", "command-insert", "command-update", "command-delete from", "command-from", "command-execute", "command-show", "command-describe", "command-drop"); } if ($current_table_name) { my @queries; #@completion_list = (); push(@queries, "select 'current_column-$current_table_name.' || column_name from user_tab_columns where table_name=\'".uc($current_table_name)."\'"); my $sqlstr = join(' union ', @queries); debugmsg(3, "query: [$sqlstr]"); my $sth = $dbh->prepare($sqlstr) or query_err('prepare', $DBI::errstr, $sqlstr), setup_sigs(), return(0); $sth->execute() or query_err('execute', $DBI::errstr, $sqlstr), setup_sigs(), return(0); while(my $res = $sth->fetchrow_array()) { push(@completion_list, $res); } } setup_sigs(); if($inline_print) { print "\r"; print ""; $| = 0; $term->forced_update_display(); } } sub complete_entry_function { my($word, $state) = @_; debugmsg(3, "complete_entry_function called", @_); # This is called by Term::ReadLine::Gnu when a list of matches needs to # be generated. It takes a string that is the word to be completed and # a state number, which should increment every time it's called. return unless $connected; my $line_buffer = $attribs->{line_buffer}; debugmsg(4, "line_buffer: [$line_buffer]"); if($line_buffer =~ /^\s*\@/) { return($term->filename_completion_function(@_)); } unless($completion_built) { unless($opt_nocomp || !$conf{auto_complete}) { populate_completion_list(1); } $completion_built = 1; } if($state == 0) { # compute all the possibilies and put them in @completion_possibles @completion_possibles = (); my $last_char = substr($word,length($word)-1,1); debugmsg(2,"last_char: [$last_char]"); my @grep = (); if ($line_buffer =~ /select(?!.*(?:from|where))[\s\w\$\#_,]*\.[\w_]*$/) { # This case is for "select mytable.mycolumn" type lines my $current_table_name = $line_buffer; $current_table_name =~ s/(select.*)(\s)([\w_]+)(\.)([\w_]*)$/$3/; debugmsg(3, "current table name: $current_table_name"); unless($opt_nocomp || !$conf{auto_complete}) { populate_completion_list(1, $current_table_name); } debugmsg(4, "select table.column"); push(@grep, '^current_column-'); } elsif($line_buffer =~ /select(?!.*(?:from|where))[\s\w\$\#_,]+$/) { debugmsg(4, "select ..."); push(@grep, '^column-', '^table-'); } elsif($line_buffer =~ /from(?!.*where)[\s\w\$\#_,]*$/) { debugmsg(4, "from ..."); push(@grep, '^table-'); } elsif($line_buffer =~ /where[\s\w\$\#_,]*$/) { debugmsg(4, "where ..."); push(@grep, '^column-'); } elsif($line_buffer =~ /update(?!.*set)[\s\w\$\#_,]*$/) { debugmsg(4, "where ..."); push(@grep, '^table-'); } elsif($line_buffer =~ /set[\s\w\$\#_,]*$/) { debugmsg(4, "where ..."); push(@grep, '^column-'); } elsif($line_buffer =~ /insert.*into(?!.*values)[\s\w\$\#_,]*$/) { debugmsg(4, "where ..."); push(@grep, '^table-'); } else { push(@grep, ''); } debugmsg(2,"grep: [@grep]"); my $use_lower; if($last_char =~ /^[A-Z]$/) { $use_lower = 0; } else { $use_lower = 1; } foreach my $grep (@grep) { foreach my $list_item (grep(/$grep/, @completion_list)) { my $item = $list_item; $item =~ s/^\w*-//; eval { #Trap errors if($item =~ /^\Q$word\E/i) { push(@completion_possibles, ($use_lower ? lc($item) : uc($item)) ); } }; debugmsg(2, "Trapped error in complete_entry_function eval: $@") if $@; } } debugmsg(3,"possibles: [@completion_possibles]"); } # return the '$state'th element of the possibles return($completion_possibles[$state] || undef); } sub db_reconnect { debugmsg(3, "db_reconnect called", @_); # This first disconnects the database, then tries to reconnect print "Reconnecting...\n"; commit_on_exit(); if (defined $dbh) { if (not $dbh->disconnect()) { # TODO error messages should always to stderr. warn "Disconnect failed: $DBI::errstr\n"; return; } } $dbh = db_connect(1, @dbparams); } sub db_connect { my($die_on_error, $ora_session_mode, $username, $password, $connect_string) = @_; debugmsg(3, "db_connect called", @_); # Tries to connect to the database, prompting for username and password # if not given. There are several cases that can happen: # connect_string is present: # ORACLE_HOME has to exist and the driver tries to make a connection to # given connect_string. # connect_string is not present: # $opt_host is set: # Connect to $opt_host on $opt_sid. Specify port only if $opt_port is # set # $opt_host is not set: # Try to make connection to the default database by not specifying any # host or connect string my($dbhandle, $dberr, $dberrstr, $this_prompt_host, $this_prompt_user); debugmsg(1,"ora_session_mode: [$ora_session_mode] username: [$username] password: [$password] connect_string: [$connect_string]"); # The first thing we're going to check is that the Oracle DBD is available # since it's a sorta required element =) my @drivers = DBI->available_drivers(); my $found = 0; foreach(@drivers) { if($_ eq "Oracle") { $found = 1; } } unless($found) { err("Could not find DBD::Oracle... please install. Available drivers: " .join(", ", @drivers) . ".\n"); } #print "drivers: [" . join("|", @drivers) . "]\n"; # Now we can attempt a connection to the database my $attributes = { RaiseError => 0, PrintError => 0, AutoCommit => $conf{auto_commit}, LongReadLen => $conf{long_read_len}, LongTruncOk => $conf{long_trunc_ok}, ora_session_mode => $ora_session_mode }; if($connect_string eq 'external') { # the user wants to connect with external authentication check_oracle_home(); # install alarm signal handle $SIG{ALRM} = \&sighandle; alarm($conf{connection_timeout}); if(!$opt_batch) { print "Attempting connection to local database\n"; } $dbhandle = DBI->connect('dbi:Oracle:',undef,undef,$attributes) or do { $dberr = $DBI::err; $dberrstr = $DBI::errstr; }; $this_prompt_host = $ENV{ORACLE_SID}; $this_prompt_user = $ENV{LOGNAME}; alarm(0); # cancel alarm } elsif($connect_string) { # We were provided with a connect string, so we can use the TNS method check_oracle_home(); ($ora_session_mode, $username, $password) = get_up($ora_session_mode, $username, $password); $attributes->{ora_session_mode} = $ora_session_mode if $ora_session_mode; my $userstring; if($username) { $userstring = $username . '@' . $connect_string; } else { $userstring = $connect_string; } # install alarm signal handle $SIG{ALRM} = \&sighandle; alarm($conf{connection_timeout}); if(!$opt_batch) { print "Attempting connection to $userstring\n"; } $dbhandle = DBI->connect('dbi:Oracle:',$userstring,$password,$attributes) or do { $dberr = $DBI::err; $dberrstr = $DBI::errstr; }; $this_prompt_host = $connect_string; $this_prompt_user = $username; alarm(0); # cancel alarm } elsif($opt_host) { # attempt a connection to $opt_host my $dsn; $dsn = "host=$opt_host"; $dsn .= ";sid=$opt_sid" if $opt_sid; $dsn .= ";port=$opt_port" if $opt_port; ($ora_session_mode, $username, $password) = get_up($ora_session_mode, $username, $password); $attributes->{ora_session_mode} = $ora_session_mode if $ora_session_mode; # install alarm signal handle $SIG{ALRM} = \&sighandle; alarm($conf{connection_timeout}); print "Attempting connection to $opt_host\n"; debugmsg(1,"dsn: [$dsn]"); $dbhandle = DBI->connect("dbi:Oracle:$dsn",$username,$password, $attributes) or do { $dberr = $DBI::err; $dberrstr = $DBI::errstr; }; $this_prompt_host = $opt_host; $this_prompt_host = "$opt_sid!" . $this_prompt_host if $opt_sid; $prompt{user} = $username; alarm(0); # cancel alarm } else { # attempt a connection without specifying a hostname or anything check_oracle_home(); ($ora_session_mode, $username, $password) = get_up($ora_session_mode, $username, $password); $attributes->{ora_session_mode} = $ora_session_mode if $ora_session_mode; # install alarm signal handle $SIG{ALRM} = \&sighandle; alarm($conf{connection_timeout}); print "Attempting connection to local database\n"; $dbhandle = DBI->connect('dbi:Oracle:',$username,$password,$attributes) or do { $dberr = $DBI::err; $dberrstr = $DBI::errstr; }; $this_prompt_host = $ENV{ORACLE_SID}; $this_prompt_user = $username; alarm(0); # cancel alarm } if($dbhandle) { # Save the parameters for reconnecting @dbparams = ($ora_session_mode, $username, $password, $connect_string); # set the $dbuser global for use elsewhere $dbuser = $username; $num_connects = 0; $prompt{host} = $this_prompt_host; $prompt{user} = $this_prompt_user; # Get the version banner debugmsg(2,"Fetching version banner"); my $banner = $dbhandle->selectrow_array( "select banner from v\$version where banner like 'Oracle%'"); if(!$opt_batch) { if($banner) { print "Connected to: $banner\n\n"; } else { print "Connection successful!\n"; } } if($banner =~ / (\d+)\.(\d+)\.([\d\.]+)/) { my ($major, $minor, $other) = ($1, $2, $3); $dbversion = $major || 8; } # Issue a warning about autocommit. It's nice to know... print STDERR "auto_commit is " . ($conf{auto_commit} ? "ON" : "OFF") . ", commit_on_exit is " . ($conf{commit_on_exit} ? "ON" : "OFF") . "\n" unless $opt_batch; } elsif( ($dberr eq '1017' || $dberr eq '1005') && ++$num_connects < $conf{max_connection_attempts}) { $dberrstr =~ s/ \(DBD ERROR: OCISessionBegin\).*//; print "Error: $dberrstr\n\n"; #@dbparams = (0,undef,undef,$connect_string); $connect_string = '' if $connect_string eq 'external'; $dbhandle = db_connect($die_on_error,$ora_session_mode,undef,undef,$connect_string); } elsif($die_on_error) { err("Could not connect to database: $dberrstr [$dberr]"); } else { wrn("Could not connect to database: $dberrstr [$dberr]"); return(0); } # set the NLS_DATE_FORMAT if($conf{nls_date_format}) { debugmsg(2, "setting NLS_DATE_FORMAT to $conf{nls_date_format}"); my $sqlstr = "alter session set nls_date_format = '" . $conf{nls_date_format} . "'"; $dbhandle->do($sqlstr) or query_err('do', $DBI::errstr, $sqlstr); } $connected = 1; return($dbhandle); } sub get_prompt { my($prompt_string) = @_; debugmsg(3, "get_prompt called", @_); # This returns a prompt. It can be passed a string which will # be manually put into the prompt. It will be padded on the left with # white space $prompt_length ||= 5; #just in case normal prompt hasn't been outputted debugmsg(2, "prompt_length: [$prompt_length]"); if($prompt_string) { my $temp_prompt = sprintf('%' . $prompt_length . 's', $prompt_string . '> '); return($temp_prompt); } else { my $temp_prompt = $conf{prompt} . '> '; my $temp_prompt_host = '@' . $prompt{host} if $prompt{host}; $temp_prompt =~ s/\%H/$temp_prompt_host/g; $temp_prompt =~ s/\%U/$prompt{user}/g; $prompt_length = length($temp_prompt); return($temp_prompt); } } sub get_up { my($ora_session_mode, $username, $password) = @_; debugmsg(3, "get_up called", @_); if(!$opt_batch) { setup_term() unless $term; # Get username/password unless($username) { # prompt for the username $username = $term->readline('Username: '); if($username =~ /^(.*)\s+as\s+sys(\w+)\s*$/i) { $ora_session_mode = 2 if lc($2) eq 'dba'; $ora_session_mode = 4 if lc($2) eq 'oper'; $username = $1; } # Take that entry off of the history list if ($term_type eq 'gnu') { $term->remove_history($term->where_history()); } } unless($password) { # prompt for the password, and disable echo my $orig_redisplay = $attribs->{redisplay_function}; $attribs->{redisplay_function} = \&shadow_redisplay; $password = $term->readline('Password: '); $attribs->{redisplay_function} = $orig_redisplay; # Take that entry off of the history list if ($term->ReadLine eq "Term::ReadLine::Gnu") { $term->remove_history($term->where_history()); } } } return($ora_session_mode, $username, $password); } sub check_oracle_home { # This checks for the ORACLE_HOME environment variable and dies if it's # not set err("Please set your ORACLE_HOME environment variable!") unless $ENV{ORACLE_HOME}; return(1); } sub shadow_redisplay { # The one provided in Term::ReadLine::Gnu was broken # debugmsg(2, "shadow_redisplay called", @_); my $OUT = $attribs->{outstream}; my $oldfh = select($OUT); $| = 1; select($oldfh); print $OUT ("\r", $attribs->{prompt}); $oldfh = select($OUT); $| = 0; select($oldfh); } sub print_non_print { my($string) = @_; my @string = unpack("C*", $string); my $ret_string; foreach(@string) { if($_ >= 40 && $_ <= 176) { $ret_string .= chr($_); } else { $ret_string .= "<$_>"; } } return($ret_string); } sub interface { debugmsg(3, "interface called", @_); # this is the main program loop that handles all the user input. my $input; my $prompt = get_prompt(); setup_sigs(); # Check if we were interactively called, or do we need to process STDIN if(-t STDIN) { while(defined($input = $term->readline($prompt))) { $sigintcaught = 0; $prompt = process_input($input, $prompt) || get_prompt(); setup_sigs(); } } else { debugmsg(3, "non-interactive", @_); debugmsg(3, "\$opt_batch=$opt_batch", @_); debugmsg(3, "\$opt_batch=$opt_batch", @_); # Send STDIN to process_input(); while() { process_input($_); } } quit(0, undef, "\n"); } sub process_input { my($input, $prompt, $add_to_history) = @_; if (!(defined($add_to_history))) { $add_to_history = 1; } debugmsg(3, "process_input called", @_); my $nprompt; SWITCH: { if(!$qbuffer) { # Commands that are only allowed if there is no current buffer $input =~ /^\s*(?:!|host)\s*(.*)\s*$/i and system($1), last SWITCH; $input =~ /^\s*\\a\s*$/i and populate_completion_list(), last SWITCH; $input =~ /^\s*\\\?\s*$/i and help(), last SWITCH; $input =~ /^\s*help\s*$/i and help(), last SWITCH; $input =~ /^\s*reconnect\s*$/i and db_reconnect(), last SWITCH; $input =~ /^\s*\\r\s*$/i and db_reconnect(), last SWITCH; $input =~ /^\s*conn(?:ect)?\s+(.*)$/i and connect_cmd($1), last SWITCH; $input =~ /^\s*disc(?:onnect)\s*$/i and disconnect_cmd($1), last SWITCH; $input =~ /^\s*\@\S+\s*$/i and $nprompt = run_script($input), last SWITCH; $input =~ /^\s*debug\s*(.*)$/i and debug_toggle($1), last SWITCH; $input =~ /^\s*autocommit\s*(.*)$/i and autocommit_toggle(), last SWITCH; $input =~ /^\s*commit/i and commit_cmd(), last SWITCH; $input =~ /^\s*rollback/i and rollback_cmd(), last SWITCH; $input =~ /^\s*(show\s*[^;\/\\]+)\s*$/i and show($1, 'table'),last SWITCH; $input =~ /^\s*(desc\s*[^;\/\\]+)\s*$/i and describe($1, 'table'), last SWITCH; $input =~ /^\s*(set\s*[^;\/\\]+)\s*$/i and set_cmd($1), last SWITCH; $input =~ /^\s*exec(?:ute)?\s*(.*)\s*$/i and exec_cmd($1), last SWITCH; $input =~ /^\s*\\d\s*$/ and show('show objects', 'table'), last SWITCH; $input =~ /^\s*\\dt\s*$/ and show('show tables', 'table'), last SWITCH; $input =~ /^\s*\\di\s*$/ and show('show indexes', 'table'), last SWITCH; $input =~ /^\s*\\ds\s*$/ and show('show sequences', 'table'), last SWITCH; $input =~ /^\s*\\dv\s*$/ and show('show views', 'table'), last SWITCH; $input =~ /^\s*\\df\s*$/ and show('show functions', 'table'), last SWITCH; } # Global commands allowed any time (even in the middle of queries) $input =~ /^\s*quit\s*$/i and quit(0), last SWITCH; $input =~ /^\s*exit\s*$/i and quit(0), last SWITCH; $input =~ /^\s*\\q\s*$/i and quit(0), last SWITCH; $input =~ /^\s*\\l\s*$/i and show_qbuffer(), last SWITCH; $input =~ /^\s*\\p\s*$/i and show_qbuffer(), last SWITCH; $input =~ /^\s*l\s*$/i and show_qbuffer(), last SWITCH; $input =~ /^\s*list\s*$/i and show_qbuffer(), last SWITCH; $input =~ /^\s*\\c\s*$/i and $nprompt = clear_qbuffer(), last SWITCH; $input =~ /^\s*clear\s*$/i and $nprompt = clear_qbuffer(), last SWITCH; $input =~ /^\s*clear buffer\s*$/i and $nprompt=clear_qbuffer(), last SWITCH; $input =~ /^\s*\\e\s*(.*)$/i and $nprompt = edit($1), last SWITCH; $input =~ /^\s*edit\s*(.*)$/i and $nprompt = edit($1), last SWITCH; $input =~ /^\s*rem(?:ark)?/i and $input = '', last SWITCH; $input =~ /[^\s]/ and $nprompt = parse_input($input) || last, last SWITCH; # default $nprompt = $prompt if ($nprompt eq ''); # use last prompt if nothing caught (blank line) } if(!$opt_batch && $term->ReadLine eq "Term::ReadLine::Gnu" && $input =~ /[^\s]/ && $input ne $last_history) { if (!$opt_batch && $add_to_history) { $term->AddHistory($input); } } $last_history = $input; return($nprompt); } sub parse_input { my($input) = @_; debugmsg(3, "parse_input called", @_); # this takes input and parses it. It looks for single quotes (') and double # quotes (") and presents prompts accordingly. It also looks for query # terminators, such as semicolon (;), forward-slash (/) and back-slash-g (\g). # If it finds a query terminator, then it pushes any text onto the query # buffer ($qbuffer) and then passes the entire query buffer, as well as the # format type, determined by the terminator type, to the query() function. It # also wipes out the qbuffer at this time. # # It returns a prompt (like 'SQL> ' or ' -> ') if successfull, 0 otherwise # now we need to check for a terminator, if we're not inquotes while( $input =~ m/ ( # ['"] # match quotes | # or ; # the ';' terminator | # or ^\s*\/\s*$ # the slash terminator at end of string | # or \\[GgsSi] # one of the complex terminators | # or (?:^|\s+)create\s+ # create | # or (?:^|\s+)function\s+ # function | # or (?:^|\s+)package\s+ # package | # or (?:^|\s+)package\s+body\s+ # package body | # or (?:^|\s+)procedure\s+ # procedure | # or (?:^|\s+)trigger\s+ # trigger | # or (?:^|\s+)declare\s+ # declare | # or (?:^|\s+)begin\s+ # begin | # or \/\* # start of multiline comment | # or \*\/ # end of multiline comment )/gix ) { my($pre, $match, $post) = ($`, $1, $'); # PREMATCH, MATCH, POSTMATCH debugmsg(1, "parse: [$pre] [$match] [$post]"); if( ($match eq '\'' || $match eq '"')) { if(!$quote || $quote eq $match) { $inquotes = ($inquotes ? 0 : 1); if($inquotes) { $quote = $match; } else { undef($quote); } } } elsif($match =~ /create/ix) { $increate = 1; } elsif(!$increate && $match =~ /function|package|package\s+body|procedure|trigger/ix) { # do nothing if we're not in a create statement } elsif(($match =~ /declare|begin/ix) || ($increate && $match =~ /function|package|package\s+body|procedure|trigger/ix)) { $inplsqlblock = 1; } elsif($match =~ /^\/\*/) { $incomment = 1; } elsif($match =~ /^\*\//) { $incomment = 0; } elsif(!$inquotes && !$incomment && $match !~ /^--/ && ($match =~ /^\s*\/\s*$/ || !$inplsqlblock)) { $qbuffer .= $pre; debugmsg(4,"qbuffer IN: [$qbuffer]"); my $terminator = $match; $post =~ / (\d*) # Match num_rows right after terminitor \s* # Optional whitespace (?: # ( >{1,2}|<|\| ) # Match redirection operators \s* # Optional whitespace ( .* ) # The redirector (include rest of line) )? # Match 0 or 1 \s* # Optional whitespace (.*) # Catch everything else $ # End-Of-Line /x; debugmsg(3,"1: [$1] 2: [$2] 3: [$3] 4: [$4]"); my($num_rows,$op,$op_text,$extra) = ($1,$2,$3,$4); if($extra =~ /--.*$/) { undef $extra; } # check that Text::CSV_XS is installed if a < redirection was given if($op eq '<' && $notextcsv) { soft_err("You must install Text::CSV_XS from CPAN to use this feature"); return(0); } # deduce the format from the terminator type my $format; $fbuffer = $terminator; if($terminator eq ';' || $terminator =~ /^\/\s*$/) { $format = 'table'; } elsif($terminator eq '\g') { $format = 'list'; } elsif($terminator eq '\G') { $format = 'list_aligned'; } elsif($terminator eq '\s') { $format = 'csv'; } elsif($terminator eq '\S') { $format = 'csv_no_header'; } elsif($terminator eq '\i') { $format = 'sql'; } $num_rows ||= 0; debugmsg(4,"fbuffer: [$fbuffer]\n"); # if there is nothing in the buffer, then we assume that the user just # wants to reexecute the last query, which we have saved in $last_qbuffer my($use_buffer, $copy_buffer); if($qbuffer) { $use_buffer = $qbuffer; $copy_buffer = 1; } elsif($last_qbuffer) { $use_buffer = $last_qbuffer; $copy_buffer = 0; } else { $use_buffer = undef; $copy_buffer = 0; } if($use_buffer) { if($op eq '<') { my $count = 0; my($max_lines, @params, $max_lines_save, @querybench, $rows_affected, $success_code); my $result_output = 1; push(@querybench, get_bench()); print STDERR "\n"; while(($max_lines, @params) = get_csv_file($op, $op_text)) { $max_lines_save = $max_lines; print statusline($count, $max_lines); my @res = query( $use_buffer, $format, {num_rows => $num_rows, op => $op, op_text => $op_text, result_output => 0}, @params); debugmsg(3, "res: [@res]"); unless(@res) { print "Error in line " . ($count + 1) . " of file '$op_text'\n"; $result_output = 0; close_csv(); last; } $rows_affected += $res[0]; $success_code = $res[1]; $count++; } push(@querybench, get_bench()); if($result_output) { print "\r"; if(!$opt_batch) { print STDERR format_affected($rows_affected, $success_code); if($opt_bench || $conf{extended_benchmarks}) { print STDERR "\n\n"; print STDERR ('-' x 80); print STDERR "\n"; output_benchmark("Query: ", @querybench, "\n"); } else { output_benchmark(" (", @querybench, ")"); print STDERR "\n"; } print STDERR "\n"; } } } else { query($use_buffer, $format, {num_rows => $num_rows, op => $op, op_text => $op_text}); } if($copy_buffer) { # copy the current qbuffer to old_qbuffer $last_qbuffer = $qbuffer; $last_fbuffer = $fbuffer; } } else { query_err('Query', 'No current query in buffer'); } undef($qbuffer); undef($fbuffer); $inplsqlblock = 0; $increate = 0; if($extra) { return(parse_input($extra)); } else { # return a 'new' prompt return(get_prompt()); } } } $qbuffer .= $input . "\n"; debugmsg(4,"qbuffer: [$qbuffer], input: [$input]"); if($inquotes) { return(get_prompt($quote)); } elsif($incomment) { return(get_prompt('DOC')); } else { return(get_prompt('-')); } } sub get_csv_file { my($op, $op_text) = @_; debugmsg(3, "get_csv_file called", @_); my @ret = (); unless($csv_max_lines) { ($op_text) = glob($op_text); debugmsg(3, "Opening file '$op_text' for line counting"); open(CSV, $op_text) || do{ query_err('redirect',"Cannot open file '$op_text' for reading: $!"); return(); }; while() { $csv_max_lines++; } close(CSV); } unless($csv_filehandle_open) { ($op_text) = glob($op_text); debugmsg(3, "Opening file '$op_text' for input"); open(CSV, $op_text) || do{ query_err('redirect',"Cannot open file '$op_text' for reading: $!"); return(); }; $csv_filehandle_open = 1; } my $line = ; while(defined($line) && $line =~ /^\s*$/) { $line = ; } unless($line) { close_csv(); return(); } debugmsg(3, "read in CSV line", $line); my @fields; if($csv->parse($line)) { @fields = $csv->fields(); debugmsg(3, "got CVS fields", @fields); } else { wrn("Parse of CSV file failed on argument, skipping to next: " . $csv->error_input()); return(get_csv_file($op, $op_text)); } return($csv_max_lines, @fields); } sub close_csv { close(CSV) || err("Could not close CSV filehandle: $!"); $csv_filehandle_open = 0; $csv_max_lines = 0; } sub connect_cmd { my($arg) = @_; debugmsg(3, "connect_cmd called", @_); unless($arg) { wrn("Invalid connect syntax. See help"); return(0); } my($ora_session_mode, $username, $password, $connect_string) = parse_logon_string($arg); my $new_dbh = db_connect(0, $ora_session_mode, $username, $password, $connect_string); if (not $new_dbh) { warn "failed to make new connection as $username to $connect_string: $DBI::errstr\n"; warn "keeping old connection\n"; return; } if (defined $dbh) { print "Closing last connection (and committing!)...\n"; commit_on_exit(); # FIXME this is Wrong $dbh->disconnect() or warn "failed to disconnect old connection, but switching anyway\n"; } $dbh = $new_dbh; $connected = 1; } sub disconnect_cmd { debugmsg(3, "disconnect_cmd called", @_); if ($connected) { print "Closing last connection...\n"; commit_on_exit(); $dbh->disconnect() if (defined $dbh); $connected = 0; } else { print "Not connected.\n"; } } sub commit_cmd { debugmsg(3, "commit_cmd called", @_); # this just called commit if(defined $dbh) { if($dbh->{AutoCommit}) { wrn("commit ineffective with AutoCommit enabled"); } else { if ($dbh->commit()) { print "Transaction committed\n"; } else { warn "Commit failed: $DBI::errstr\n"; } } } else { print "No connection\n"; } } sub rollback_cmd { debugmsg(3, "rollback_cmd called", @_); # this just called commit if(defined $dbh) { if($dbh->{AutoCommit}) { wrn("rollback ineffective with AutoCommit enabled"); } else { if ($dbh->rollback()) { print "Transaction rolled back\n"; } else { warn "Rollback failed (not sure if data was committed or not): $DBI::errstr\n"; } } } else { print "No connection\n"; } } sub exec_cmd { my($sqlstr) = @_; debugmsg(3, "exec_cmd called", @_); # Wrap the statement in BEGIN/END and execute $sqlstr = qq( BEGIN $sqlstr END; ); query($sqlstr, 'table'); } sub edit { my($filename) = @_; debugmsg(3, "edit called", @_); # This writes the current qbuffer to a file then opens up an editor on that # file... when the editor returns, we read in the file and overwrite the # qbuffer with it. If there is nothing in the qbuffer, and there is # something in the last_qbuffer, then we use the last_qbuffer. If nothing # is in either, then we just open the editor with a blank file. my $passed_file = 1 if $filename; my $filecontents; my $prompt = get_prompt(); debugmsg(2, "passed_file: [$passed_file]"); if($qbuffer) { debugmsg(2, "Using current qbuffer for contents"); $filecontents = $qbuffer; } elsif($last_qbuffer) { debugmsg(2, "Using last_qbuffer for contents"); $filecontents = $last_qbuffer . $last_fbuffer; } else { debugmsg(2, "Using blank contents"); $filecontents = ""; } debugmsg(3, "filecontents: [$filecontents]"); # determine the tmp directory my $tmpdir; if($ENV{TMP}) { $tmpdir = $ENV{TMP}; } elsif($ENV{TEMP}) { $tmpdir = $ENV{TEMP}; } elsif(-d "/tmp") { $tmpdir = "/tmp"; } else { $tmpdir = "."; } # determine the preferred editor my $editor; if($ENV{EDITOR}) { $editor = $ENV{EDITOR}; } else { $editor = "vi"; } # create the filename, if not given one $filename ||= "$tmpdir/yasql_" . int(rand(1000)) . "_$$.sql"; # expand the filename ($filename) = glob($filename); debugmsg(1, "Editing $filename with $editor"); # check for file existance. If it exists, then we open it up but don't # write the buffer to it my $file_exists; if($passed_file) { # if the file was passed, then check for it's existance if(-e $filename) { # The file was found $file_exists = 1; } elsif(-e "$filename.sql") { # the file was found with a .sql extension $filename = "$filename.sql"; $file_exists = 1; } else { wrn("$filename was not found, creating new file, which will not be ". "deleted"); } } else { # no file was specified, so just write to the the temp file, and we # don't care if it exists, since there's no way another process could # write to the same file at the same time since we use the PID in the # filename. my $ret = open(TMPFILE, ">$filename"); if(!$ret) { #if file was NOT opened successfully wrn("Could not write to $filename: $!"); } else { print TMPFILE $filecontents; close(TMPFILE); } } # now spawn the editor my($ret, @filecontents); debugmsg(2, "Executing $editor $filename"); $ret = system($editor, "$filename"); if($ret) { debugmsg(2, "Executing env $editor $filename"); $ret = system("env", $editor, "$filename"); } if($ret) { debugmsg(2, "Executing `which $editor` $filename"); $ret = system("`which $editor`", "$filename"); } if($ret) { #if the editor or system returned a positive return value wrn("Editor exited with $ret: $!"); } else { # read in the tmp file and apply it's contents to the buffer my $ret = open(TMPFILE, "$filename"); if(!$ret) { # if file was NOT opened successfully wrn("Could not read $filename: $!"); } else { # delete our qbuffer and reset the inquotes var $qbuffer = ""; $inquotes = 0; $increate = 0; $inplsqlblock = 0; $incomment = 0; while() { push(@filecontents, $_); } close(TMPFILE); } } if(@filecontents) { print "\n"; print join('', @filecontents); print "\n"; foreach my $line (@filecontents) { # chomp off newlines chomp($line); last if $sigintcaught; # now send it in to process_input # and don't add lines of the script to command history $prompt = process_input($line, '', 0); } } unless($passed_file) { # delete the tmp file debugmsg(1, "Deleting $filename"); unlink("$filename") || wrn("Could not unlink $filename: $!"); } return($prompt); } sub run_script { my($input) = @_; debugmsg(3, "run_script called", @_); # This reads in the given script and executes it's lines as if they were typed # in directly. It will NOT erase the current buffer before it runs. It # will append the contents of the file to the current buffer, basicly my $prompt; # parse input $input =~ /^\@(.*)$/; my $file = $1; ($file) = glob($file); debugmsg(2, "globbed [$file]"); my $first_char = substr($file, 0, 1); unless($first_char eq '/' or $first_char eq '.') { foreach my $path ('.', @sqlpath) { if(-e "$path/$file") { $file = "$path/$file"; last; } elsif(-e "$path/$file.sql") { $file = "$path/$file.sql"; last; } } } debugmsg(2, "Found [$file]"); # read in the tmp file and apply it's contents to the buffer my $ret = open(SCRIPT, $file); if(!$ret) { # if file was NOT opened successfully wrn("Could not read $file: $!"); $prompt = get_prompt(); } else { # read in the script while(