package DBIShell::dr::Pg;

#  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 OGREP_FN SGREP_FN FGREP_FN);
use DBIShell::UTIL qw/:context :sql_types _NULLS/;

use vars qw^@EXPORT @EXPORT_OK @ISA $VERSION %EXPORT_TAGS^;
use constant VARHDRSZ => 4;

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

use constant TABLES_QUERY => <<TableQuery;
select tablename as OBJ_NAME from pg_tables
TableQuery

use constant VIEWS_QUERY => <<ViewQuery;
select viewname as OBJ_NAME from pg_views
ViewQuery

use constant PROCS_QUERY => <<ProcsQuery;
select proname as OBJ_NAME from pg_proc
ProcsQuery

use constant TRIGGERS_QUERY => <<TrigQuery;
select tgname as OBJ_NAME from pg_trigger
TrigQuery

use constant USERS_QUERY => <<UserQuery;
select usename as OBJ_NAME from pg_user
UserQuery

use constant KEYWDS =>
  qw(
     abort absolute access action add after aggregate all allocate analyze and
     any are as asc assertion at authorization avg backward before begin
     between binary bit bit_length both by cache cascade cascaded case cast
     catalog char char_length character character_length check close cluster
     coalesce collate collation column comment committed connect connection
     constraint constraints continue convert copy corresponding count createdb
     createuser cross current current_date current_session current_time
     current_timestamp current_user cursor cycle database date day deallocate
     dec decimal declare default deferrable deferred delimiters desc descriptor
     diagnostics disconnect distinct do domain each else encoding end escape
     except exception exclusive exec execute exists extend external extract
     false fetch first float for force foreign forward found from full function
     get global go goto group handler having hour identity immediate in
     increment index indicator inherits initially inner input insensitive
     instead intersect interval into is isnull isolation join key lancompiler
     language last leading left level like listen load local location lower
     match max maxvalue min minute minvalue mode module month move names
     national natural nchar new next no nocreatedb nocreateuser none not
     nothing notify notnull null nullif numeric octet_length of offset oids on
     only open operator option or order outer output overlaps partial password
     pendant position precision prepare preserve primary prior privileges
     procedural procedure public recipe references reindex relative reset
     restrict returns right row rows rule schema scroll second section sequence
     serial serializable session session_user set setof share size some sql
     sqlcode sqlerror sqlstate start statement stdin stdout substring sum
     system_user table temp temporary then time timestamp timezone_hour
     timezone_minute to trailing transaction translate translation trigger
     trim true trusted type union unique unknown unlisten until upper usage
     user using vacuum valid value values varchar varying verbose version view
     when whenever where with work write year zone
    );

use constant DBI_ATTRIB => DBIShell::dr::DEFAULT::DBI_ATTRIB;

use constant CMNDS =>
  qw(alter
     cd
     commit
     create
     delete
     describe
     drop
     explain
     grant
     insert
     lock
     noaudit
     optimize
     read
     rename
     revoke
     rollback
     select
     show
     truncate
     unlock
     update
    );

use constant CREATABLE =>
  qw(aggregate
     constraint
     database
     function
     group
     index
     operator
     procedural
     rule
     sequence
     table
     temp
     temporary
     trigger
     trusted
     type
     unique
     user
     view
    );

use constant TRANSACTION => qw(work transaction);

use constant PRIVILEGES => qw(select insert update delete rule all);

use constant COMPLETION_MAP =>
  (
   from        => TGREP_FN,
   help        => HGREP_FN,
   into        => TGREP_FN,
   join        => TGREP_FN,
   read        => FGREP_FN,
   show        => qw(tables procs views triggers users), #SGREP_FN,
   table       => TGREP_FN,
   update      => TGREP_FN,
   cd          => FGREP_FN,
   describe    => OGREP_FN,
   unlock      => [ qw(table) ],
   select      => [ KEYWDS    ],
   delete      => [ qw(from)  ],
   create      => [ CREATABLE ],
   drop        => [ CREATABLE ],
   insert      => [ qw(into)  ],
   not         => [ qw(null)  ],
   is          => [ qw(null not) ],
   alter       => [ qw(table group user)],
   abort       => [ TRANSACTION ],
   begin       => [ TRANSACTION ],
   commit      => [ TRANSACTION ],
   end         => [ TRANSACTION ],
   rollback    => [ TRANSACTION ],
   constraint  => [ qw(trigger) ],
   grant       => [ PRIVILEGES  ],
   revoke      => [ PRIVILEGES  ],
   procedural  => [ qw(language) ],
   reindex     => [ qw(table database index)],
   temporary   => [ qw(table) ],
   unique      => [ qw(index) ],
   vacuum      => [ qw(analyze verbose) ],
  );

<<'PIQT_COMPLETION_MAP';
    analyze     => [qw(&cmpl_dbs)],
    copy        => [qw(binary &cmpl_tables)],
    database    => ['&cmpl_dbs'],
    describe    => ['&cmpl_tables'],
    from        => ['&cmpl_tables'],
    group       => ['&cmpl_groups'],
    index       => ['&cmpl_indexes'],
    into        => ['&cmpl_tables'],
    join        => ['&cmpl_tables'],
    select      => ['@sqlkeywords'],
    sequence    => ['&cmpl_sequences'],
    show        => ['&cmpl_tables'],
    table       => ['&cmpl_tables'],
    update      => ['&cmpl_tables'],
    user        => ['&cmpl_users'],
    vacuum      => [qw(verbose analyze &cmpl_dbs)],
    verbose     => [qw(analyze &cmpl_dbs)],
    view        => ['&cmpl_views'],
PIQT_COMPLETION_MAP

sub DEBUG (@) {warn(@_)}

sub new ($$$)
{
    my $package = ref($_[0]) ? ref(shift()) : shift();
    my $driver  = shift() || 'Pg';
    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});

    #bless($engine, $package);

    #use Data::Dumper;
    #DEBUG(Data::Dumper->Dump([$engine],["*OBJ"]),"\n");

    return $engine;
}

sub showables ($)
{
    return (qw(tables procs views triggers users),
	    $_[0]->procs(),
	    $_[0]->views()
	   )
}

sub _tables ($)
{
    my @tables;
    my $engine = $_[0];
    my $dbh    = $engine->dbh();

    eval
    {
	my %data;
	my $sth = $dbh->prepare(TABLES_QUERY)
	  || die("prepare(TABLES_QUERY) failed: ",$dbh->errstr(),"\n");
	$sth->execute()
	  || die("execute(TABLES_QUERY) failed: ",$sth->errstr(),"\n");
	$sth->bind_columns(undef, \@data{ @{ $sth->{NAME_uc} } })
	  || die("bind_cols(TABLES_QUERY) failed: ",$sth->errstr(),"\n");
	while($sth->fetchrow_arrayref())
	{
	    #
	    #warn('KEYS: ',join(',',keys(%data)),"\n");
	    push(@tables, $data{OBJ_NAME});
	}
	$sth->finish();
    };

    if($@)
    {
	chomp($engine->{ERROR} = $@);
	return ();
    }

    return @tables;
}

sub _views ($)
{
    my @views;
    my $engine = $_[0];
    my $dbh    = $engine->dbh();

    eval
    {
	my %data;
	my $sth = $dbh->prepare(VIEWS_QUERY)
	  || die("prepare(VIEWS_QUERY) failed: ",$dbh->errstr(),"\n");

	$sth->execute()
	  || die("execute(VIEWS_QUERY) failed: ",$sth->errstr(),"\n");
	$sth->bind_columns(undef, \@data{ @{ $sth->{NAME_uc} } })
	  || die("bind_cols(VIEWS_QUERY) failed: ",$sth->errstr(),"\n");
	while($sth->fetchrow_arrayref()) { push(@views, $data{OBJ_NAME}) }
	$sth->finish();
    };

    if($@)
    {
	chomp($engine->{ERROR} = $@);
	return ();
    }

    return @views;
}

sub _procs ($)
{
    my @procs;
    my $engine = $_[0];
    my $dbh    = $engine->dbh();

    eval
    {
	my %data;
	my $sth = $dbh->prepare(PROCS_QUERY)
	  || die("prepare(PROCS_QUERY) failed: ",$dbh->errstr(),"\n");
	$sth->execute()
	  || die("execute(PROCS_QUERY) failed: ",$sth->errstr(),"\n");
	$sth->bind_columns(undef, \@data{ @{ $sth->{NAME_uc} } })
	  || die("bind_cols(PROCS_QUERY) failed: ",$sth->errstr(),"\n");
	while($sth->fetchrow_arrayref()) { push(@procs, $data{OBJ_NAME}) }
	$sth->finish();
    };

    if($@)
    {
	chomp($engine->{ERROR} = $@);
	return ();
    }

    return @procs;
}

#::

sub _triggers ($)
{
    my @triggers;
    my $engine = $_[0];
    my $dbh    = $engine->dbh();

    eval
    {
	my %data;
	my $sth = $dbh->prepare(TRIGGERS_QUERY)
	  || die("prepare(TRIGGERS_QUERY) failed: ",$dbh->errstr(),"\n");
	$sth->execute()
	  || die("execute(TRIGGERS_QUERY) failed: ",$sth->errstr(),"\n");
	$sth->bind_columns(undef, \@data{ @{ $sth->{NAME_uc} } })
	  || die("bind_cols(TRIGGERS_QUERY) failed: ",$sth->errstr(),"\n");
	while($sth->fetchrow_arrayref()) { push(@triggers, $data{OBJ_NAME}) }
	$sth->finish();
    };

    if($@)
    {
	chomp($engine->{ERROR} = $@);
	return ();
    }

    return @triggers;
}

sub _users ($)
{
    my @users;
    my $engine = $_[0];
    my $dbh    = $engine->dbh();

    eval
    {
	my %data;
	my $sth = $dbh->prepare(USERS_QUERY)
	  || die("prepare(USERS_QUERY) failed: ",$dbh->errstr(),"\n");
	$sth->execute()
	  || die("execute(USERS_QUERY) failed: ",$sth->errstr(),"\n");
	$sth->bind_columns(undef, \@data{ @{ $sth->{NAME_uc} } })
	  || die("bind_cols(USERS_QUERY) failed: ",$sth->errstr(),"\n");
	while($sth->fetchrow_arrayref()) { push(@users, $data{OBJ_NAME}) }
	$sth->finish();
    };

    if($@)
    {
	chomp($engine->{ERROR} = $@);
	return ();
    }

    return @users;
}



sub show ($$$)
{
    my $rv;
    my $engine = shift(@_);
    my $sh     = shift(@_);
    my $target = shift(@_);

    #warn("0: $engine\-\>($sh, $target)\n");

    if(0)
    {
	# any Pg specific showables should be intercepted here
    }
    else
    {
	return $engine->DBIShell::dr::DEFAULT::show($sh, $target);
    }
}



sub describe ($$$)
{
    use constant DESCRIBE_QUERY => <<DQ_SQL;
select a.attnum      as ATTR_NUM,
       a.attname     as ATTR_NAME,
       t.typname     as ATTR_TYPE,
       a.attlen      as ATTR_LEN,
       a.atttypmod   as ATTR_MOD,
       a.attnotnull  as ATTR_NNL,
       a.atthasdef   as ATTR_DEF,
       d.adsrc       as ATTR_DVAL
FROM   pg_class     c,
       pg_type      t,
       pg_attribute a,
       pg_attrdef   d
WHERE  c.relname   = ?
and    a.attnum    > 0
and    a.atthasdef
and    a.attrelid  = c.oid
and    d.adrelid   = c.oid
and    a.atttypid  = t.oid
and    d.adnum     = a.attnum

UNION

select a.attnum      as ATTR_NUM,
       a.attname     as ATTR_NAME,
       t.typname     as ATTR_TYPE,
       a.attlen      as ATTR_LEN,
       a.atttypmod   as ATTR_MOD,
       a.attnotnull  as ATTR_NNL,
       a.atthasdef   as ATTR_DEF,
       NULL::text    as ATTR_DVAL
FROM   pg_class     c,
       pg_type      t,
       pg_attribute a
WHERE  c.relname  = ?
and    a.attnum   > 0
and    a.attrelid  = c.oid
and    a.atttypid  = t.oid
and    not a.atthasdef
DQ_SQL

    use constant D_POS   => 0;
    use constant D_NAM   => 1;
    use constant D_TYP   => 2;
    use constant D_LEN   => 3;
    use constant D_MOD   => 4;
    use constant D_NNL   => 5;
    use constant D_DEF   => 6;
    use constant D_DVL   => 7;
    use constant D_PLIST => (D_NAM, D_TYP, D_DEF, D_NNL);

    my($i,$dbh,$dqd);
    my $engine = shift(@_);
    my $sh     = shift(@_);
    my $target = shift(@_);
    my @desc;
    my @l;
    my $sth;
    my $csep;
    $csep = $sh->getvar('FIELD_SEPARATOR');
    $csep = defined($csep) ? $csep : '|';

    $i = 0;
    $dbh = $engine->dbh();

    eval
    {
	$sth = $dbh->prepare(DESCRIBE_QUERY)
	  || die($dbh->errstr,"\n");

	$sth->bind_param(1, $target,   SQL_VARCHAR_T)
	  || die($sth->errstr,"\n");

	$sth->bind_param(2, $target,   SQL_VARCHAR_T)
	  || die($sth->errstr,"\n");

	$sth->execute()
	  || die($sth->errstr,"\n");

	$dqd = $sth->fetchall_arrayref()
	  || die($sth->errstr,"\n");

	$sth->finish();
    };

    if ($@)
    {
	$engine->{ERRNO} = $!;
	$engine->{ERROR} = $@;
	chomp($engine->{ERROR});
	$sth && $sth->finish();
	return 0;
    }

    unless (@$dqd)
    {
	$engine->{ERRNO} = 0;
	$engine->{ERROR} = "No such object [$target] found";
	$sth && $sth->finish();
	return 0;
    }

    foreach my $row (@{$dqd})
    {
	use integer;

	my @rdsc;
	$rdsc[D_NAM] = $row->[D_NAM];
	$rdsc[D_TYP] = $engine->_type2str($row);
	$rdsc[D_DEF] = $row->[D_DEF] ? $row->[D_DVL] : '';
	$rdsc[D_NNL] = $row->[D_NNL] ? 'not null' : 'null';

	push(@desc, \@rdsc);

	for my $p (D_PLIST)
	{
	    my $s = length($rdsc[$p]) || 4;
	    ($l[$p] < $s) && ($l[$p] = $s);
	}
    }

    my $format =
      join($csep, (map { sprintf("%%-%d.%ds", $_, $_) } (@l[D_PLIST])), "\n");

    $sh->errputf(CONTEXT_NIL, " \n");
    $sh->start_pager(scalar($#{$dqd}+2));
    $sh->outputf(CONTEXT_NIL, "Table/View: %s:\n", $target);
    $sh->outputf(CONTEXT_NIL, $format, qw(NAME TYPE DEFAULT NULL));
    foreach my $r (@desc)
    {
	$sh->outputf(CONTEXT_NIL, $format, _NULLS(@{$r}[D_PLIST]));
    }
    $sh->stop_pager();
    $sth->finish();
    return 1;
}

sub _type2str ($$)
{
    my $engine = $_[0];
    my $row    = $_[1];
    my $type_spec;
    my $type_prec;
    my $type_xtra;

    $type_spec = $row->[D_TYP];
    $type_prec = '';
    $type_xtra = '';
    # following the logic in psql.c:

    $type_spec =~ s/bpchar/char/;

    if ($type_spec =~ s/^_//) { $type_xtra .= '[]' }

    if($row->[D_TYP] =~ /^_?(?:bp|var)char$/)
    {
	$type_prec =
	  ($row->[D_MOD] == -1) ?
	    '' :
	      sprintf('(%d)', $row->[D_MOD] - VARHDRSZ);
    }
    elsif ($row->[D_TYP] eq 'numeric')
    {
	use integer;
	my $mod    = int($row->[D_MOD] - VARHDRSZ);
	$type_prec =
	  sprintf("(%d.%d)", ($mod >> 16) & 0xffff, $mod & 0xffff);
    }

    return join('', $type_spec, $type_prec, $type_xtra);
}

__END__