package DBIShell::dr::mysql;

#  dbishell: A generic database shell based on the Perl DBI layer
#  Copyright (C) 2000  Vivek Dasmohapatra (vivek@etla.org)

#  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.

use strict;

use DBI;
use Exporter ();
use DBIShell::dr::DEFAULT qw(TGREP_FN HGREP_FN FGREP_FN);
use DBIShell::UTIL qw/:context :param _NULLS/;

use vars qw($VERSION @EXPORT @EXPORT_OK %EXPORT_TAGS @ISA);

$VERSION     = 0.01_25;
@EXPORT      = ();
@EXPORT_OK   = ();
%EXPORT_TAGS = ();
@ISA         = qw(DBIShell::dr::DEFAULT);

use subs qw(connect);

use constant DBI_ATTRIB => {
			    PrintError  => 0,
			    RaiseError  => 0,
			    AutoCommit  => 1,
			    ChopBlanks  => 0,
			    LongReadLen => 1024,
			    LongTruncOk => 1
			    };

use constant CMNDS =>
  qw(alter
     select
     insert
     update
     delete
     create
     drop
     describe
     replace
     show
     read
     cd
    );

#     commit
#     rollback

use constant KEYWDS => qw^
into          from           where        like   in  and         or     not
null          is             order        group  by  distinct    table  tables
varchar       char           numeric      integer    bit_count   between
isnull        coalesce       interval     regexp     rlike
strcmp        binary         ifnull()     if()       case        when
abs()         sign()  mod()  floor()      ceiling()  round()     least()
greatest()    exp()   log()  log10()      pow()      sqrt()      pi()
cos()         sin()   tan()  acos()       degrees()  radians()   asin()
atan()        atan2() cot()  rand(1)      truncate() ascii()     ord()
bin()         conv()  oct()  hex()        concat()   length()    octet_length()
char()        char_length()  character_length()      locate()    position()
instr()       lpad() rpad()  left()       right()    substring() mid()
substring_index()   ltrim()  rtrim()      trim()     soundex()   space()
replace()     repeat()       reverse()    insert()   elt()       field()
find_in_set() make_set()     export_set() lcase()    lower()     ucase()
upper()       load_file()    dayofweek()  weekday()  dayofmonth()
dayofyear()   month()        dayname()    monthname()            quarter()
week()        year()         yearweek()   hour()     minute()    second()
period_add()  period_diff()  date_add()   date_sub() adddate()   subdate()
to_days()     from_days()    date_format()           time_format()
curdate()     current_date   curtime()    now()      sysdate()   current_time
unix_timestamp()             from_unixtime()         sec_to_time()
time_to_sec() database()     user()       session_user()
system_user() password()     encrypt()    encode()   decode()    md5()
last_insert_id()             format()     version()  get_lock()  release_lock()
benchmark()   count()        avg()        min()      max()       sum()
std()        stddev()        bit_or()     bit_and()  limit
^;

use constant COMPLETION_MAP =>
  (
   select   => [ KEYWDS ],
   from     => TGREP_FN,
   update   => TGREP_FN,
   into     => TGREP_FN,
   index    => [qw(from)],
   describe => TGREP_FN,
   join     => TGREP_FN,
   help     => HGREP_FN,
   read     => FGREP_FN,
   cd       => FGREP_FN,
   create   => [qw(unique table database index)],
   drop     => [qw(table database index)],
   alter    => [qw(table)],
   optimize => [qw(table)],
   check    => [qw(table)],
   lock     => [qw(tables)],
   unlock   => [qw(tables)],
   delete   => [qw(from)],
   insert   => [qw(low_priority delayed ignore into)],
   replace  => [qw(low_priority delayed ignore into)],
   load     => [qw(tables data)],
   data     => [qw(low_priority local infile)],
   flush    => [qw(hosts logs privileges tables status)],
   show     => [qw(databases tables columns processlist
                   index status variables table grants)],
   table    => TGREP_FN,
   tables   => [qw(like)],
   unique   => [qw(index)],
   grants   => [qw(for)]
  );


sub new ($$$)
{
    my $package = ref($_[0]) ? ref(shift()) : shift();
    my $driver  = shift()   || 'mysql';
    my $sh      = $_[0];
    my $engine  = $package->DBIShell::dr::DEFAULT::new($driver, @_);

    $engine->_var(COMP_MAP => { COMPLETION_MAP() }) || warn($engine->{ERROR});
    $engine->_var(KEYWORDS => [ KEYWDS()         ]) || warn($engine->{ERROR});
    $engine->_var(COMMANDS => [ CMNDS()          ]) || warn($engine->{ERROR});
    $engine->_var(DBI_ATTRIB => DBI_ATTRIB)         || warn($engine->{ERROR});

    return $engine;
}

sub set_initvars ($)
{
    my $engine = shift(@_);
    my $sh     = shift(@_);
    $sh->setvar("CASE_SENSITIVE=1");
}

sub connect			#($$)
{
    my $title;
    my $engine = shift(@_);
    my $opt    = shift(@_);
    my $attrib = shift(@_) || $engine->{DBI_ATTRIB};

   # warn("engine  = $engine\n");
   # warn("attr    = ",stringify(' ','',$opt),    "\n");
   # warn("attr    = ",stringify(' ','',$attrib), "\n");

    my $dbh;

    $dbh = $engine->DBIShell::dr::DEFAULT::connect($opt,$attrib)
      || return undef;

    $engine->{DR_DATA}{dsn} ||= {};

    foreach my $pv (split(/;/,$opt->{dsn}))
    {
	my($k,$v) = split(/=/,$pv);
	$engine->{DR_DATA}{dsn}{$k} = $v;
    }

    $engine->title($engine->_title());
    $engine->prompt(join('',$engine->title(),'>'));

    return $dbh;
}

sub interpret ($$$)
{
    my $i      = undef;

    my $nparam;
    my $engine = shift(@_);
    my $sh     = shift(@_);
    my $query  = shift(@_);

    if ($query =~ /^\s*help\s+(.*)/i)
    {
	#warn("CALLING HELP MODULE\n");
	my $thing = $1;
	$thing =~ s/\s+$//g;
	$thing =~ s/ /_/g;
	#warn("REQUESTING HELP FOR $thing\n");
	return $engine->help($sh,$thing);
    }

    if ($query =~ /^\s*load\s/si)
    {
	# we can attempt to use the H->tables functionality,
	# wrapped in an eval, just in case the DBD driver
	# implements something: SQL9X is no use - it [as usual]
	# specifies no standards or behaviours for this:
	if ($query =~ /tables/i) { $i = $engine->load_tables() }

	# we can use describe functionality to accomplish this one:
	# as DBI will allow us to describe tables by doing a select
	# that will never return rows [where 1 = 0 clause, for example]
	if ($query =~ /fields(?:\s+(.*))?/i)
	{
	    my $tbl = $1;
	    my @tbl = split(/\s+/, $tbl);

	    unless (@tbl) { @tbl = $engine->tables() }
	    $i = $engine->_load_columns(@tbl);
	}
    }
    else
    {
	my(@cols,@parm,%row,$sth);
	my $dbh = $engine->dbh();

	#xwarn("Attempting to INTERPRET SQL [$dbh]\n");

	$query = $engine->map_inout_parameters($sh,$query);

	unless($sth = $dbh->prepare($query))
	{
	    $engine->{ERROR} = $dbh->errstr;
	    return 0;
	}

	if ($nparam = $sth->{NUM_OF_PARAMS})
	{
	    $engine->bind_parameters($sh, $sth);
	}

	unless($sth->execute())
	{
	    $engine->{ERROR} = $sth->errstr;
	    return 0;
	}

	#xwarn("QUERY executed");

	# are we in a select type query?
	# NB: Unlike other SQL engines, mysql explicitly implements describe
	# as part of it's SQL syntax, so we don't need to do anything special
	# with it, other than ensure we use the space stripped 'rescan_format'
	# since the fields it returns are potentially very large, and almost
	# always only a few bytes are used:
	if ($sth->{NUM_OF_FIELDS})
	{
	    if($query =~ /^\s*describe\s|^\s*show\s|^\s*explain\s/i
	       || $sh->getvar('PRESCAN_ROWS'))
	    {
		# fetchall arrayref seems to invalidate a whole bunch of
		# handle attributes, so we have to precache them:
		my $dummy_sth = DBIShell::UTIL::cache_sth_attr($sth);
		my $data      = $sth->fetchall_arrayref();
		my $fmt  =
		  $engine->prescan_format($sh,$dummy_sth,$data);

		$sh->start_pager($#{$data}+1);
		$sh->outputf(CONTEXT_HEAD, $fmt, @{ $dummy_sth->{NAME} });
		for (my $x = 0; $x <= $#{$data}; $x++)
		{
		    $sh->outputf(CONTEXT_DATA, $fmt, _NULLS(@{ $data->[$x] }));
		}
		$sh->stop_pager();
	    }
	    else
	    {
		my @fmt;

		unless($sth->bind_columns(undef, \@row{@{ $sth->{NAME} }}))
		{
		    $engine->{ERROR} = $sth->errstr();
		    return 0;
		}

		my $fmt = $engine->noscan_format($sh,$sth);

		$sh->start_pager($sth->rows());
		$sh->outputf(CONTEXT_HEAD, $fmt, @{ $sth->{NAME} });
		while ($sth->fetchrow_arrayref())
		{
		    $sh->outputf(CONTEXT_DATA,
				 $fmt,
				 _NULLS(@row{@{ $sth->{NAME} }})
				);
		}
		$sh->stop_pager();
	    }
	    $i++;
	}
	else			# or is this a non-row returning thing?
	{
	    my $n = $sth->rows();
	    my $nstr =
	      (defined($n) && ($n >= 0))?
		(($n == 1)?"$n row":"$n rows"):
		  'unknown number of rows';

	    # again. mysql implements database reconnection as
	    # an implicit part of it's SQL syntax, [at least within the
	    # same mysql instance], so we need to catch instances when
	    # we've done this and reset the DBIShell prompt:
	    if ($query =~ /^\s*use\s+(\S+)/si)
	    {
		$engine->title($engine->_title());
		$engine->prompt(join('',$engine->title(),'>'));
	    }

	    $sh->errputf(CONTEXT_META, "Ok - [%s] affected\n", $nstr);
	    $i++;
	}

	# mysql doesn't do io parameters [or o parameters, for that matter]
	# but this does no harm, and if it ever does support it, this will
	# automagically start working...
	for (my $x = 0; $x < $nparam; $x++)
	{
	    ($sh->get_parameter_io($x) == PARAM_OUT) || next;

	    my $pname = $sh->get_parameter_name($x);
	    $sh->outputf(CONTEXT_META,
			 "Parameter [%s] == %s\n",
			 $pname,
			 _NULLS($sh->getvar($pname))
			);
	}

	$sth->finish();
    }

    return $i;
}

sub _title ($)
{
    use constant WHAT_DB_QUERY => <<'WhatDB';
select
CONCAT('mysql:',
       IF(LENGTH(USER()),
          SUBSTRING(USER(), 1, locate('@', user())),
          '-'
         )
       ),
IF(LENGTH(DATABASE()),DATABASE(),'-')
WhatDB

    my $sth;
    my @idstr;
    my $idstr;
    my $engine = shift(@_);
    my $dbh    = $engine->dbh();

    eval
    {
	$sth = $dbh->prepare(WHAT_DB_QUERY)
	  || die("Error retrieving database name: ",  $dbh->errstr(),"\n");
	$sth->execute()
	  || die("Error retrieving database name: ",  $sth->errstr(),"\n");
	$sth->bind_columns(undef, \@idstr[ 0 .. $#{$sth->{NAME}} ])
	  || die("Error retrieving database name: ",  $sth->errstr(),"\n");
	$sth->fetchrow_arrayref()
	  || die("Unable to retrieve user/db names: ",$sth->errstr(),"\n");
	$idstr = join('%s:', (map { s/%/%%/g; $_ } @idstr));
	$sth->finish();
    };

    if($@)
    {
	$engine->{ERRNO} = -1;
	$engine->{ERROR} = $@;
	return 'mysql:{ERROR!}';
    }

    return sprintf($idstr, $engine->{DR_DATA}{dsn}{hostname});
}


__END__

# TLF: Nikola Tesla died for you....