package DBIShell::dr::Oracle;

#  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 qw|:sql_types|;
use Exporter ();
use DBIShell::dr::DEFAULT qw(TGREP_FN HGREP_FN OGREP_FN SGREP_FN FGREP_FN);
use DBIShell::UTIL qw/:context IFDEBUG _NULLS/;

use constant SQL_VARCHAR_T => { TYPE => SQL_VARCHAR };

use constant TABLES_QUERY => <<TableQuery;
select owner || '.' || object_name as TABLE_NAME,
       object_type                 as TABLE_TYPE
from   all_objects
where  object_type  in ('TABLE',  'VIEW')
TableQuery

use constant PACKAGES_QUERY => <<PkgQuery;
select owner || '.' || object_name as PACKAGE_NAME
from   all_objects
where  object_type  = 'PACKAGE'
PkgQuery

use constant TRIGGERS_QUERY => <<TrigQuery;
select owner || '.' || object_name as TRIGGER_NAME
from   all_objects
where  object_type  = 'TRIGGER'
TrigQuery

use constant PROCS_QUERY => <<ProcsQuery;
select owner || '.' || object_name
from   all_objects
where  object_type  in ('PROCEDURE', 'FUNCTION')
ProcsQuery

use constant COUNT_SCHEMA_DOT_OBJECT => <<ISDOQuery;
select count(*)
from   all_objects
where  owner       = ?
and    object_name = ?
ISDOQuery

use constant COUNT_PACKAGE_DOT_MEMBER => <<IPDMQuery;
select count(distinct aa.object_name)
from   all_arguments aa
where  aa.package_name = ?
and    aa.object_name  = ?
IPDMQuery

use constant PMEMBERS_QUERY => <<PMQuery;
select owner || '.' || package_name || '.' || object_name as PMEMBER_NAME
from   all_arguments
where  NVL(package_name, 'ø') != 'ø'
PMQuery

use constant DESC_EXEC => <<DescExec;
select argument_name  as  D_NAME   ,
       data_type      as  D_TYPE   ,
       data_length    as  D_SIZE   ,
       data_precision as  D_PREC   ,
       data_scale     as  D_SCALE  ,
       in_out         as  D_INOUT  ,
       package_name   as  D_PACK   ,
       overload       as  D_OVRLD  ,
       position       as  D_POS    ,
       '         '    as  D_FNPROC
from   all_arguments
where  owner                  = ?
and    object_name            = ?
and    NVL(package_name, 'ø') = NVL(?, 'ø')
order by package_name, overload, position
DescExec


use constant  DESC_TABLE => <<DescTable;
select column_name,
       data_type,
       data_length,
       data_precision,
       data_scale,
       nullable,
       data_default
from   all_tab_columns
where  owner      = ?
and    table_name = ?
order by column_id
DescTable

sub _ROW2TYPE ($);

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

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

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

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

use constant CREATABLE =>
  qw(table tablespace index trigger directory package library);

use constant KEYWDS =>
  # basic stuff:
  (qw^into    from   where    like   in  and      or       not
      null    is     order    group  by  distinct table    tables
      varchar char   numeric  integer    between  varchar2 unique^,
   # CHAR functions:
   'ascii()',     # CHAR
   'chr()',       # INTEGER
   'concat()',    # STR0, STR1
   'initcap()',   # STR
   'instr()',     # STR, SUBSTR[, START, [NTH]],
   'length()',    # STR
   'lower()',     # STR
   'lpad()',      # STR, LEN, [PADSTR]
   'ltrim()',     # STR[, TRIM_CHAR_CLASS_STR]
   'replace()',   # STR, MATCH_STR[, REPLACE_STR]
   'rpad()',      # STR, LEN, [PADSTR]
   'rtrim()',     # STR[, TRIM_CHAR_CLASS_STR]
   'soundex()',   # STR
   'substr()',    # STR, START[0idx=1], LEN
   'translate()', # STR, MATCH_CHAR_CLASS_STR, REPLACE_CHAR_CLASS_STR
   'upper()',     # STR
   # date functions:
   'add_months()',     # DATE, MONTH_SHIFT || MONTH_SHIFT, DATE
   'last_day()',       # DATE
   'months_between()', # DATE0, DATE1
   'new_time()',       # DATE, ZONE_IN, ZONE_OUT [useless outside the US]
   'next_day()',       # DATE, DAY_NAME_STR
   #   'round()',          # DATE, DATE_FMT_MASK
   'sysdate()',        # -
   #   'trunc()',          # DATE, DATE_FMT_MASK
   # numeric functions:
   'abs()',   # NUMBER
   'acos()',  # NUMBER :: -1 <  NUMBER < 1
   'asin()',  # NUMBER :: -1 <  NUMBER < 1
   'atan()',  # NUMBER
   'atan2()', # NUMBER, NUMBER
   'ceil()',  # NUMBER
   'cos()',   # ANGLE  :: radians
   'cosh()',  # NUMBER
   'exp()',   # NUMBER
   'floor()', # NUMBER
   'ln()',    # NUMBER :: NUMBER >= 0
   'log()',   # NUMBER, BASE :: NUMBER >= 0, BASE > 1
   'mod()',   # NUMBER, DIVISOR
   'power()', # BASE, POWER :: IF (BASE < 0) { INT(POWER) == POWER }
   'round()', # NUMBER, N_DEC_PLACES
   'sign()',  # NUMBER
   'sin()',   # ANGLE  :: radians
   'sinh()',  # NUMBER
   'sqrt()',  # NUMBER :: NUMBER >= 0
   'tan()',   # ANGLE  :: radians
   'tanh()',  # NUMBER
   'trunc',   # NUMBER, N_DEC_PLACES
   # LOB functions:
   'bfilename()',   # DIR_ALIAS, FILE
   'empty_blob()',  # -
   'empty_clob()',  # -
   # misc functions:
   'dump()',     # various
   'greatest()', # thing0, thing1[, thing2 ...]
   'least()',    # thing0, thing1[, thing2 ...]
   'nvl()',      # thing, non_null_replacemant_value
   'sqlcode()',  # -
   'sqlerrm()',  # INTEGER SQLCODE
   'uid()',      # -
   'user()',     # -
   'userenv()',  # THING_STR
   'vsize()',    # THING
   # conversion functions:
   'chartorowid()', # STRING_ROWID
   'convert()',     # STR, TO_CHARSET_STR[, FROM_CHARSET_STR]
   'hextoraw()',    # HEX_STRING
   'rawtohex()',    # RAW
   'rowidtochar()', # ROWID
   'to_char()',     # DATE[, FMT_STR[, NLS_LANG_STR]]
   'to_date()',     # THING[, FMT_STR[, NLS_LANG_STR]]
   'to_number()'    # THING[, FMT_STR[, NLS_LANG_STR]]
  );



use constant COMPLETION_MAP =>
  (
   select   => [ KEYWDS ],
   from     => TGREP_FN,
   update   => TGREP_FN,
   into     => TGREP_FN,
   describe => OGREP_FN,
   join     => TGREP_FN,
   help     => HGREP_FN,
   show     => SGREP_FN,
   read     => FGREP_FN,
   cd       => FGREP_FN,
   grant    => [qw(all alter create drop delete execute insert select update)],
   create   => [ CREATABLE ],
   drop     => [ CREATABLE ],
   alter    => [ qw(table)],
   delete   => [ qw(from) ],
   insert   => [ qw(into) ],
   is       => [ qw(null not) ],
   not      => [ qw(null) ]
  );

use constant D_NAME  => 0;
use constant D_TYPE  => 1;
use constant D_SIZE  => 2;
use constant D_PREC  => 3;
use constant D_SCALE => 4;
use constant D_NULL  => 5;
use constant D_INOUT => 5;
use constant D_DFLT  => 6;
use constant D_PACK  => 6;
use constant D_OVRLD => 7;
use constant D_POS   => 8;
use constant D_FNPROC=> 9;
use constant D_EXEC_PRINT => (D_NAME, D_TYPE, D_INOUT);

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

    $engine->{PACKAGES} = undef();

    $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 obj_types ($)
{
    qw(tables views procs triggers sequences users packages package_members);
}

sub packages ($)
{
    if(!$_[0]->{PACKAGES} && $_[0]->UNIVERSAL::can('load_packages'))
    {
	$_[0]->load_packages();
    }

    (ref($_[0]->{PACKAGES}) eq 'ARRAY') ? @{ $_[0]->{PACKAGES} } :
      (ref($_[0]->{PACKAGES}) eq 'HASH') ? keys(%{$_[0]->{PACKAGES}}) :
	map { s/\"(\w+)\"\./${1}./g; $_ } (eval { $_[0]->_packages() });
}

sub load_packages ($)
{
    my @packages;
    my $engine = shift(@_);
    my $cache;

    eval
    {
	$cache  = $engine->{PACKAGES};
	$engine->{PACKAGES} = undef();
	@packages = $engine->_packages();
    };

    if ($@)
    {
	#warn("Loading packages: ERROR!\n");
	$engine->{PACKAGES} = $cache;
	$engine->{ERROR}    = $@;
	return undef();
    }
    else
    {
	#warn("Loading packages: OK\n");
	$engine->{PACKAGES} = \@packages;
	return 1;
    }
}

sub load_package_members ($)
{
    my $cache;
    my $engine = shift(@_);
    my @members;

    eval
    {
	$cache = $engine->{DR_DATA}{PACKAGE_MEMBERS};
	$engine->{DR_DATA}{PACKAGE_MEMBERS} = undef();
	@members = $engine->_package_members();
    };

    if ($@)
    {
	$engine->{DR_DATA}{PACKAGE_MEMBERS} = $cache;
	$engine->{ERROR}                    = $@;
	return undef();
    }
    else
    {
	my $new_cache = {};

	foreach my $pmem (@members)
	{
	    my $pos = rindex($pmem, '.');
	    my $pkg = substr($pmem, 0, $pos);
	    my $mem = substr($pmem, $pos + 1);

	    $new_cache->{$pkg} ||= [];

	    push(@{$new_cache->{$pkg}},$mem);
	}

	$engine->{DR_DATA}{PACKAGE_MEMBERS} = $new_cache;
	return 1;
    }
}

sub package_members ($)
{
    my $cache;
    my @rv;
    my @members;

    if($_[0]->{DR_DATA}
       && (!$_[0]->{DR_DATA}{PACKAGE_MEMBERS}
	   && $_[0]->UNIVERSAL::can('load_package_members')
	  )
      )
    {
	IFDEBUG("Calling load_package_members()\n");
	$_[0]->load_package_members();
    }

    $cache = $_[0]->{DR_DATA}{PACKAGE_MEMBERS};

    my $found = 0;
    foreach my $pkg ($_[0]->packages())
    {
	@members =
	  (ref($cache->{$pkg}) eq 'ARRAY') ? @{ $cache->{$pkg} } :
	    (ref($cache->{$pkg}) eq 'HASH') ? keys(%{$cache->{$pkg}}) :
	      ();
	
	if(@members)
	{
	    $found += @members;
	    push(@rv, (map { join('.',$pkg,$_) } @members));
	}
    }

    if(!$found)
    {
	IFDEBUG("Calling _package_members()\n");
	@rv = 
	  map { s/\"(\w+)\"\./${1}./g; $_ }
	    (eval { $_[0]->_package_members() });
    }

    return @rv;
}

sub showables ($)
{
    return (errors    =>
	    views     =>
	    procs     =>
	    triggers  =>
	    sequences =>
	    users     =>
	    packages  =>
	    package_members =>
	    $_[0]->procs(),
	    $_[0]->views(),
	    $_[0]->packages()
	   )
}

sub _decompose_name ($$)
{
    my $engine = shift(@_);
    my $target = shift(@_);

    my @id  = map { uc($_) }split(/\./, $target);

    my $sch;
    my $pkg;
    my $nam;

    # unambiguous cases:
    # 1 unadorned name -
    # must be directly visible in our schema, or in the public schema
    # 3 schema.package.name

    if   (@id == 1) { ($sch,$pkg,$nam) = (undef(), undef(), $id[0]) }
    elsif(@id == 3) { ($sch,$pkg,$nam) = ($id[0] , $id[1] , $id[2]) }
    elsif(@id == 2)
    {
	# bugger. ambiguity: could be package.object or schema.object
	# have to try and figure out which:
	my $csh;
	my $cph;
	my $csc;
	my $cpc;

	my $dbh = $engine->dbh();

	eval
	{
	    ##########################################################
	    # how many schema.object entries match
	    ##########################################################
	    $csh = $dbh->prepare(COUNT_SCHEMA_DOT_OBJECT)
	      || die("prepare(COUNT_SCHEMA_DOT_OBJECT) failed: ",
		     $dbh->errstr(),
		     "\n"
		    );

	    $csh->bind_param(1, $id[0], SQL_VARCHAR_T)
	      || die("bind_param(COUNT_SCHEMA_DOT_OBJECT) failed: ",
		     $csh->errstr(),
		     "\n"
		    );

	    $csh->bind_param(2, $id[1], SQL_VARCHAR_T)
	      || die("bind_param(COUNT_SCHEMA_DOT_OBJECT) failed: ",
		     $csh->errstr(),
		     "\n"
		    );

	    $csc = $dbh->selectrow_array($csh);

	    defined($csc)
	      || die("COUNT_SCHEMA_DOT_OBJECT failed: ", $csh->errstr(),"\n");
	    ##########################################################
	    # how many package.member entries match
	    ##########################################################
	    $cph = $dbh->prepare(COUNT_PACKAGE_DOT_MEMBER)
	      || die("prepare(COUNT_PACKAGE_DOT_MEMBER) failed: ",
		     $dbh->errstr(),
		     "\n"
		    );

	    $cph->bind_param(1, $id[0], SQL_VARCHAR_T)
	      || die("bind_param(COUNT_PACKAGE_DOT_MEMBER) failed: ",
		     $cph->errstr(),
		     "\n"
		    );

	    $cph->bind_param(2, $id[1], SQL_VARCHAR_T)
	      || die("bind_param(COUNT_PACKAGE_DOT_MEMBER) failed: ",
		     $cph->errstr(),
		     "\n"
		    );

	    $cpc = $dbh->selectrow_array($cph);

	    defined($cpc)
	      || die("COUNT_PACKAGE_DOT_MEMBER failed: ",$cph->errstr(),"\n");
	};

	$csh && $csh->finish();
	$cph && $cph->finish();

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

	if ($csc && $cpc)
	{
	    $engine->{ERROR} =
	      "Ambiguity: $id[0].$id[1]: $id[0] could be owner or package";
	}
	elsif ($csc)
	{
	    ($sch,$pkg,$nam) = ($id[0], undef(), $id[1]);
	}
	elsif ($cpc)
	{
	    ($sch,$pkg,$nam) = (undef(), $id[0], $id[1]);
	}
	else
	{
	    $engine->{ERROR} =
	      "No such object $id[0].$id[1] found";
	    return ();
	}
    }
}

sub describe ($$$)
{
    my $r;
    my @l;
    my $engine = shift(@_);
    my $sh     = shift(@_);
    my $target = shift(@_);

    my $err = undef();
    my $pkg = undef();
    my $sch = undef();
    my $nam = undef();
    my $typ = undef();

    # $nam is guaranteed to be set if _decompose_name succeeded
    # if not, it will have set the error field, so just return failure
    ($sch,$pkg,$nam) = $engine->_decompose_name($target);

    unless ($nam) { return 0 }

    ($sch,$pkg,$nam,$typ) = $engine->_resolve_object($sch,$pkg,$nam);

    unless($sch && $nam && $typ)
    {
	$engine->{ERROR} = "No such object $target found";
	return 0;
    }

    if   ($typ eq 'TABLE'    ){ $r = $engine->_desc_tble($sh,$sch,$nam,$typ) }
    elsif($typ eq 'VIEW'     ){ $r = $engine->_desc_tble($sh,$sch,$nam,$typ) }
    elsif($typ eq 'SEQUENCE' ){ $r = $engine->_desc_seqn($sh,$sch,$nam,$typ) }
    elsif($typ eq 'PROCEDURE'){ $r = $engine->_desc_exec($sh,$sch,$nam,$typ) }
    elsif($typ eq 'FUNCTION' ){ $r = $engine->_desc_exec($sh,$sch,$nam,$typ) }
    elsif($typ eq 'TRIGGER'  ){ $r = $engine->_desc_trig($sh,$sch,$nam,$typ) }
    elsif($typ eq 'PACKAGE'  ){ $r = $engine->_desc_pack($sh,$sch,$nam,$typ) }
    elsif($typ eq '__PXEC__' ){ $r = $engine->_desc_pxec($sh,$sch,$nam,$pkg) }
    else # a thing we don't yet know how to describe
    {
	$engine->{ERROR} =
	  "Sorry: Can't describe '$typ' objects (yet): Tell vivek\@etla.org";
	$engine->{ERRNO} = 0;
	return 0;
    }

    return $r;
}

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

    my $sch = undef();
    my $pkg = undef();
    my $nam = undef();
    my $typ = undef();

    if ($target =~ /\./) { ($sch,$nam) = split(/\./,$target,2) }
    else                 { $nam        = $target               }

    ($sch,$pkg,$nam,$typ) = $engine->_resolve_object($sch,$pkg,$nam);

    unless($sch && $nam && $typ) { return 0 }

    if   ($typ eq 'VIEW')     {return $engine->_dump_view($sh,$sch,$nam,$typ)}
    elsif($typ eq 'PROCEDURE'){return $engine->_dump_exec($sh,$sch,$nam,$typ)}
    elsif($typ eq 'FUNCTION') {return $engine->_dump_exec($sh,$sch,$nam,$typ)}
    elsif($typ eq 'PACKAGE')  {return $engine->_dump_exec($sh,$sch,$nam,$typ)}
#   elsif($typ eq 'SEQUENCE') {return $engine->_dump_seqn($sh,$sch,$nam,$typ)}
    elsif($typ eq 'TABLE')    {return $engine->_dump_tble($sh,$sch,$nam,$typ)}
#   elsif($typ eq 'TRIGGER')  {return $engine->_dump_trig($sh,$sch,$nam,$typ)}
    else
    {
	$engine->{ERRNO} = 22;
	$engine->{ERROR} =
	  join('',__PACKAGE__," doesn't know how to deal with ${typ}S yet");
	return 0;
    }
}

sub _dump_tble ($$$$$)
{
    my $sth;
    my @def;
    my $dqd;
    my $engine = shift(@_);
    my $sh     = shift(@_);
    my $schema = shift(@_);
    my $name   = shift(@_);
    my $type   = shift(@_);

    my @colspec;

    my $dbh = $engine->dbh();

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

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

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

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

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

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

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

    foreach my $r (@{$dqd})
    {
	my $buf = [];

	$buf->[D_NAME] = $r->[D_NAME];
	$buf->[D_TYPE] = _ROW2TYPE($r);
	$buf->[D_NULL] = ($r->[D_NULL] eq 'N')? ' NOT NULL' : '';
	$buf->[D_DFLT] =
	  $r->[D_DFLT] ?
	    join(''," default '",$r->[D_DFLT],"'") : '';

	push(@def, $buf)
    }

    # Solaris seems to want to chew the first character when we've been
    # quiescent for a while: Don't where the bug lies: Perl? Readline?
    # Termcap/Terminfo? Solaris? Xterm? Anyway, feed it a decoy:
    $sh->errputf(CONTEXT_NIL, " \n");
    $sh->start_pager(scalar($#{$dqd}+2));

    # emit the header:
    $sh->outputf(CONTEXT_NIL, "-- %s: %s.%s:\n", $type, $schema, $name);

    # emit the head of the create:
    $sh->outputf(CONTEXT_NIL, "create table %s \n(\n", $name);

    for (my $x = 0; $x <= $#def; $x++)
    {
	$sh->outputf(CONTEXT_NIL,
		     "    %s    %s%s%s%c\n",
		     $def[$x][D_NAME],
		     $def[$x][D_TYPE],
		     $def[$x][D_DFLT],
		     $def[$x][D_NULL],
		     ($x == $#def) ? ord(' ') : ord(',')
		    );
    }

    $sh->outputf(CONTEXT_NIL, ")\n");
    $sh->stop_pager();
    $sth->finish();

    return 1;
}

sub _dump_exec ($$$$$)
{
    my $sth;
    my $dbh;
    my %data;
    my $engine = shift(@_);
    my $sh     = shift(@_);
    my $schema = shift(@_);
    my $name   = shift(@_);
    my $type   = shift(@_);

    use constant DESC_EXEC_QUERY => <<DescExecQ;
select line as LINE,
       type as TYPE,
       text as TEXT
from all_source
where owner = ?
and   name  = ?
order by type, line asc
DescExecQ

    $dbh = $engine->dbh();

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

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

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

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

	$sth->bind_columns(undef, \@data{ @{$sth->{NAME}} })
	  || die($sth->errstr(),"\n");
    };

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

    $sh->errputf(CONTEXT_NIL, " \n");

    if($sh->getvar('PRESCAN_ROWS',0))
    {
	my $data = $sth->fetchall_arrayref();
	$sh->start_pager($#{$data}+1);
	$sh->outputf(CONTEXT_NIL, "%s: %s.%s\n", $type, $schema, $name);
	foreach my $row (@$data) { $sh->outputf(CONTEXT_NIL, '%s', $row->[2]) }
	$sh->stop_pager();
    }
    else
    {
	$sh->start_pager($sth->rows());
	$sh->outputf(CONTEXT_NIL, "%s: %s.%s\n", $type, $schema, $name);
	while($sth->fetchrow_arrayref())
	{
	    $sh->outputf(CONTEXT_NIL, "%s", $data{TEXT});
	}
	$sh->stop_pager();
    }

    $sth->finish();

    return $data{LINE} || '0E0';
}

sub _dump_view ($$$$$)
{
    my $n;
    my $sth;
    my $dbh;
    my %data;
    my $engine = shift(@_);
    my $sh     = shift(@_);
    my $schema = shift(@_);
    my $name   = shift(@_);
    my $type   = shift(@_);

    use constant DUMP_VIEW_LENGTH => <<DumpViewQ0;
select text_length as DESC_LEN
from all_views
where owner      = ?
and   view_name  = ?
DumpViewQ0

    use constant DUMP_VIEW_TEXT => <<DumpViewQ1;
select text as DESC_TXT
from all_views
where owner      = ?
and   view_name  = ?
DumpViewQ1

    $dbh = $engine->dbh();

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

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

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

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

	$sth->bind_columns(undef, \@data{ @{$sth->{NAME}} })
	  || die($sth->errstr(),"\n");

	$sth->fetchrow_arrayref();

	$sth->finish();

	#########################################################

	($data{DESC_LEN} > 0)
	  || die("No definition available");
	$sth = undef;

	#########################################################

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

	$sth->{LongTruncOk} = 0;
	$sth->{LongReadLen} = $data{DESC_LEN};

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

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

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

	$sth->bind_columns(undef, \@data{ @{$sth->{NAME}} })
	  || die($sth->errstr(),"\n");

	$sth->fetchrow_arrayref()
	  || die("Failed to fetch a description: ",$sth->errstr(),"\n");

	$sth->finish();

	#########################################################
    };

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

    $sh->errputf(CONTEXT_NIL, " \n");
    $n = ($data{DESC_TXT} =~ tr/\n/\n/) + 5;
    $sh->start_pager($n);
    $sh->outputf(CONTEXT_NIL, "%s: %s.%s\n", $type, $schema, $name);
    $sh->outputf(CONTEXT_NIL, "%s\n", $data{DESC_TXT});
    $sh->outputf(CONTEXT_NIL, "%d lines retrieved\n", $n);
    $sh->stop_pager();
    return 1;
}

sub _desc_pack ($$$$$)
{
    my $dqd;
    my $sth;
    my $dbh;
    my %data;
    my $engine = shift();
    my $sh     = shift();
    my $schema = shift();
    my $name   = shift();
    my $type   = shift();

    use constant DESC_PACK => <<DescPkgH;
select line as LINE,
       text as TEXT,
       type as TYPE
from   all_source
where  owner = ?
and    name  = ?
and    type  = 'PACKAGE'
order by line asc
DescPkgH

    $dbh = $engine->dbh();

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

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

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

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

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

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

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

    $sh->errputf(CONTEXT_NIL, " \n");
    $sh->start_pager($#{$dqd} + 2);
    foreach my $src (@$dqd)
    {
	$sh->outputf(CONTEXT_NIL, '%s', _NULLS($src->[1]));
    }
    $sh->stop_pager();
    $sth->finish();
    return 1;
}

sub _desc_seqn ($$$$$)
{
    my $sth;
    my $dbh;
    my %data;
    my $engine = shift(@_);
    my $sh     = shift(@_);
    my $schema = shift(@_);
    my $name   = shift(@_);
    my $type   = shift(@_);

    use constant DESC_SEQN_QUERY => <<DescSeqnQ;
select sequence_owner                                   as OWNER,
       sequence_name                                    as SNAME,
       min_value                                        as SSTART,
       max_value                                        as SFINISH,
       increment_by                                     as SINCR,
       decode(cycle_flag, 'Y', 'repeats', 'terminates') as SCYCLE,
       decode(order_flag, 'Y', 'ordered', 'unordered')  as SORDER,
       cache_size                                       as SCACHE_SIZE,
       last_number                                      as SLAST_VALUE
from   all_sequences
where  sequence_owner = ?
and    sequence_name  = ?
DescSeqnQ

    $dbh = $engine->dbh();

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

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

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

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

	$sth->bind_columns(undef, \@data{ @{$sth->{NAME}} })
	  || die($sth->errstr(),"\n");

	$sth->fetchrow_arrayref()
	  || die("No such sequence: $schema.$name\n");
    };

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

    $sh->errputf(CONTEXT_NIL, " \n");
    $sh->outputf(CONTEXT_NIL,
		 "%s.%s: %d -> %d [%+d] [%s, %s, cache: %d] == %d\n",
		 $data{OWNER},
		 $data{SNAME},
		 $data{SSTART},
		 $data{SFINISH},
		 $data{SINCR},
		 $data{SCYCLE},
		 $data{SORDER},
		 $data{SCACHE_SIZE},
		 $data{SLAST_VALUE}
		);

    $sth->finish();
    return 1;
}

sub _ROW2TYPE ($)
{
    my $r = $_[0];

    ($$r[D_TYPE] eq 'DATE')? 'DATE':
      $$r[D_SCALE] ?
	sprintf('%s(%d,%d)',$$r[D_TYPE], $$r[D_PREC],$$r[D_SCALE]) :
	  ($$r[D_PREC] || $$r[D_SIZE]) ?
	    sprintf('%s(%d)', $$r[D_TYPE], $$r[D_PREC] || $$r[D_SIZE]):
	      $$r[D_TYPE];
}


sub _desc_tble ($$$$$)
{
    my @l;
    my $dqd;
    my $sth;
    my $engine = shift(@_);
    my $sh     = shift(@_);
    my $schema = shift(@_);
    my $name   = shift(@_);
    my $type   = shift(@_);

    my $csep;
    $csep = $sh->getvar('FIELD_SEPARATOR');
    $csep = defined($csep) ? $csep : '|';

    my $dbh = $engine->dbh();

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

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

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

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

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

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

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

    foreach my $r (@$dqd)
    {
	my $type_decl = _ROW2TYPE($r);

	$$r[D_NULL] = ($$r[D_NULL] eq 'N')? 'NOT NULL' : '        ';

	splice(@$r, D_TYPE, 4, $type_decl);

	for (my $p = 0; $p <= $#$r; $p++)
	{
	    my $l = defined($$r[$p])?length($$r[$p]):4;
	    ($l > $l[$p]) && ($l[$p] = $l);
	}
    }

    my $format = join('',join($csep,(map { " %-$_.${_}s " } @l)),"\n");

    $sh->errputf(CONTEXT_NIL, " \n");
    $sh->start_pager(scalar($#{$dqd}+2));
    $sh->outputf(CONTEXT_NIL, "-- %s: %s.%s:\n", $type, $schema, $name);
    $sh->outputf(CONTEXT_NIL, $format, qw(NAME TYPE NULLABLE));
    foreach (@$dqd) { $sh->outputf(CONTEXT_NIL,  $format, _NULLS(@$_)) }
    $sh->stop_pager();
    $sth->finish();
    return 1;
}

sub _desc_pxec ($$$$$)
{
    my @l;
    my $n;
    my $sth;
    my $dqd;
    my $last_signature;
    my $engine = shift(@_);
    my $sh     = shift(@_);
    my $schema = shift(@_);
    my $name   = shift(@_);
    my $pkg    = shift(@_);

    my $csep;
    $csep = $sh->getvar('FIELD_SEPARATOR');
    $csep = defined($csep) ? $csep : '|';

    my $dbh = $engine->dbh();

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

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

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

	$sth->bind_param(3, $pkg,    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 [$schema.$pkg.$name] found";
	$sth && $sth->finish();
	return 0;
    }


    $last_signature = -999;
    
    foreach my $r (@$dqd)
    {
	if($r->[D_OVRLD] != $last_signature)
	{
	    $n++;
	    if(!$r->[D_NAME])
	    {
		$r->[D_FNPROC] = 'FUNCTION';
		$r->[D_NAME]   = 'RETVAL';
	    }
	    else
	    {
		$r->[D_FNPROC] = 'PROCEDURE';
	    }
	}

	$r->[D_TYPE]  = $engine->_type2str($r);
	$r->[D_INOUT] = $engine->_io2str($r);

	foreach my $p (D_EXEC_PRINT)
	{
	    my $l = defined($r->[$p]) ? length($r->[$p]) : 4;
	    ($l > $l[$p]) && ($l[$p] = $l);
	}

	$last_signature = $r->[D_OVRLD];
    }

    my $format =
      join('',
	   join( $csep, (map {" %-$_.${_}s "} @l[D_EXEC_PRINT]) ),
	   "\n"
	  );

    $sh->errputf(CONTEXT_NIL, " \n");
    $sh->start_pager($#{$dqd} + ($n * 3));

    $last_signature = -999;
    
    foreach my $r (@$dqd)
    {
	if($r->[D_OVRLD] != $last_signature)
	{
	    $sh->outputf(CONTEXT_NIL, "\n");
	    $sh->outputf(CONTEXT_NIL,
			 "%s.%s (%s): %s\n",
			 $schema,
			 $pkg,
			 $r->[D_FNPROC],
			 $name
			);
	    $sh->outputf(CONTEXT_NIL, $format, qw(NAME TYPE IN/OUT));
	}

	$sh->outputf(CONTEXT_NIL, $format, _NULLS(@{$r}[D_EXEC_PRINT]));
	$last_signature = $r->[D_OVRLD];
    }

    $sh->stop_pager();
    return 1;
}

sub _io2str ($$)
{
    my $engine = $_[0];
    my $r      = $_[1];

    return
      ($$r[D_INOUT] eq 'IN') ? '    IN' :
	($$r[D_INOUT] eq 'OUT') ? '   OUT' :
	  $$r[D_INOUT];
}

sub _type2str ($$)
{
    my $engine = $_[0];
    my $r      = $_[1];

    my $type_decl =
      ($r->[D_TYPE] eq 'DATE') ? 'DATE':
	$r->[D_SCALE] ?
	  sprintf('%s(%d,%d)',$r->[D_TYPE], $r->[D_PREC], $r->[D_SCALE]) :
	    ($r->[D_PREC] || $r->[D_SIZE]) ?
	      sprintf('%s(%d)', $r->[D_TYPE], $r->[D_PREC] || $r->[D_SIZE]):
		$r->[D_TYPE];

    return $type_decl;
}

sub _desc_exec ($$$$$)
{
    my @l;
    my $sth;
    my $dqd;
    my $engine = shift(@_);
    my $sh     = shift(@_);
    my $schema = shift(@_);
    my $name   = shift(@_);
    my $type   = shift(@_);

    my $csep;
    $csep = $sh->getvar('FIELD_SEPARATOR');
    $csep = defined($csep) ? $csep : '|';

    my $dbh = $engine->dbh();

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

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

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

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

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

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

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

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

    if($type eq 'FUNCTION') { $dqd->[0][D_NAME] = 'RETVAL' }

    foreach my $r (@$dqd)
    {
	$r->[D_TYPE]  = $engine->_type2str($r);
	$r->[D_INOUT] = $engine->_io2str($r);

	foreach my $p (D_EXEC_PRINT)
	{
	    my $l = defined($r->[$p]) ? length($r->[$p]) : 4;
	    ($l > $l[$p]) && ($l[$p] = $l);
	}
    }

    my $format =
      join('',
	   join( $csep, (map {" %-$_.${_}s "} @l[D_EXEC_PRINT]) ),
	   "\n"
	  );

    $sh->errputf(CONTEXT_NIL, " \n");
    $sh->start_pager($#{$dqd} + 2);
    $sh->outputf(CONTEXT_NIL, "%s: %s.%s:\n",   $type, $schema, $name);
    $sh->outputf(CONTEXT_NIL, $format, qw(NAME TYPE IN/OUT));
    foreach (@$dqd)
    {
	$sh->outputf(CONTEXT_NIL, $format, _NULLS(@{$_}[D_EXEC_PRINT]));
    }
    $sh->stop_pager();
    $sth->finish();
    return 1;
}


sub _desc_trig ($$$$$)
{
    my @l;
    my $sth;
    my %d;
    my %c;
    my @trigger_cols;
    my @value_cols;
    my $engine = shift(@_);
    my $sh     = shift(@_);
    my $schema = shift(@_);
    my $name   = shift(@_);
    my $type   = shift(@_);

    use constant DESC_TRIG => <<DescTrig;
select owner             as OWNER,
       trigger_name      as TNAME,
       trigger_type      as TTYPE,
       triggering_event  as TEVENT,
       base_object_type  as OBJ_TYPE,
       table_owner       as OBJ_OWNER,
       table_name        as OBJ_NAME,
       status            as STATUS,
       action_type       as ACT_TYPE
from   all_triggers
where  owner        = ?
and    trigger_name = ?
DescTrig

    use constant TRIG_COLUMNS => <<TrigColQ;
select table_owner                       as TABLE_OWNER,
       table_name                        as TABLE_NAME ,
       column_name                       as COLUMN_NAME,
       decode(column_list, 'YES', 1, 0)  as COLUMN_LIST,
       column_usage                      as COLUMN_USAGE
from   all_trigger_cols
where  trigger_owner = ?
and    trigger_name  = ?
TrigColQ

    use constant TRIG_FMT => <<TrigFmt;
%s.%s: %s %s trigger on %s %s.%s, occuring %s %s
TrigFmt


    my $dbh = $engine->dbh();

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

	$sth->{ChopBlanks} = 1;

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

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

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

	$sth->bind_columns(undef, \@d{ @{$sth->{NAME}} })
	  || die($sth->errstr,"\n");

        $sth->fetchrow_arrayref()
          || die("No such trigger ",$schema,".",$name,"found\n");
    };

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

    foreach my $k (keys(%d)) { $d{$k} =~ s/^\s+|\s+$//g }

    $sh->errputf(CONTEXT_NIL, " \n");
    $sh->outputf(CONTEXT_NIL,
		 TRIG_FMT,
		 $d{OWNER},
		 $d{TNAME},
		 lc($d{STATUS}),
		 $d{ACT_TYPE},
		 lc($d{OBJ_TYPE}),
		 $d{OBJ_OWNER},
		 $d{OBJ_NAME},
		 lc($d{TTYPE}),
		 lc($d{TEVENT})
		);

    $sth->finish();

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

	$sth->{ChopBlanks} = 1;

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

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

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

	$sth->bind_columns(undef, \@c{ @{$sth->{NAME}} })
	  || die($sth->errstr,"\n");

	while($sth->fetchrow_arrayref())
	{
	    if($c{COLUMN_LIST})
	    {
		push(@trigger_cols,
		     sprintf('%s.%s.%s',
			     uc($c{TABLE_OWNER}),
			     uc($c{TABLE_NAME}),
			     lc($c{COLUMN_NAME})
			    )
		    );
	    }

	    push(@value_cols,
		 sprintf("%s.%s.%s as %s %s value",
			 uc($c{TABLE_OWNER}),
			 uc($c{TABLE_NAME}),
			 lc($c{COLUMN_NAME}),
			 (($c{COLUMN_USAGE} =~ /^[AEIOU]/)? 'an': 'a'),
			 lc($c{COLUMN_USAGE})
			)
		);
	}

	$sth->finish();
    };

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

    if(@trigger_cols)
    {
	$sh->outputf(CONTEXT_NIL, " triggered by columns:\n");
	foreach my $c (@trigger_cols)
	{
	    $sh->outputf(CONTEXT_NIL, " %s\n", $c);
	}

	$sh->outputf(CONTEXT_NIL, " \n");
    }

    if(@value_cols)
    {
	$sh->outputf(CONTEXT_NIL, " using columns: \n");
	foreach my $c (@value_cols)
	{
	    $sh->outputf(CONTEXT_NIL, " %s\n", $c);
	}

	$sh->outputf(CONTEXT_NIL, " \n");
    }

    return 1;
}

sub _resolve_object ($$$$)
{
    my $sth;
    my %data;
    my $engine = shift(@_);
    my $schema = shift(@_);
    my $pkg    = shift(@_);
    my $name   = shift(@_);
    my $dbh    = $engine->dbh();

    use constant SYNQ => <<Synq;
select table_owner as T_OWNER,
       table_name  as T_NAME
from   all_synonyms
where  owner        = ?
and    synonym_name = ?
Synq

    use constant WHATQ_USER => <<WhatqUser;
select owner        as SCHEMA,
       object_name  as NAME,
       object_type  as TYPE
from   all_objects
where  owner = user
and    lower(object_name) like lower(?)
and    object_type        !=   'PACKAGE BODY'
WhatqUser

    use constant WHATQ_OWNER => <<WhatqOwner;
select owner        as SCHEMA,
       object_name  as NAME,
       object_type  as TYPE
from   all_objects
where  lower(owner)        like lower(?)
and    lower(object_name)  like lower(?)
and    object_type         !=   'PACKAGE BODY'
WhatqOwner

    if($schema && $pkg)
    {
	# although we were asked for schema.package.object, 
	# schema.package might be an alias to a package:
	($schema, undef(), $pkg, undef()) =
	  $engine->_resolve_object($schema, undef(), $pkg);

	return ($schema, $pkg, $name, '__PXEC__');
    }
    elsif ($pkg)
    {
	my($_sch,$_pkg,$_nam,$_typ) =
	  $engine->_resolve_object(undef(), undef(), $pkg);

	return ($_sch, $pkg, $name, '__PXEC__');
    }

    eval
    {
	# if we asked for an object w/o specifying the schema, assume
	# it is an object owned by us [ even if it is only a synonym ]

	if(!$schema)
	{
	    $sth = $dbh->prepare(WHATQ_USER)
	      || die($dbh->errstr,"\n");

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

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

	    $sth->bind_columns(undef, \@data{ @{$sth->{NAME}} })
	      || die($sth->errstr,"\n");

	    while($sth->fetchrow_arrayref()){}

	    $sth->finish();

	    $schema = $data{SCHEMA} ? undef : 'PUBLIC';
	}

	# if we asked for a specific schema, or there was no object
	# in our default schema, and we subsequently set the schema to
	# 'PUBLIC'
	if($schema)
	{
	    $sth = $dbh->prepare(WHATQ_OWNER)
	      || die($dbh->errstr,"\n");

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

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

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

	    $sth->bind_columns(undef, \@data{ @{$sth->{NAME}} })
	      || die($sth->errstr,"\n");

	    while($sth->fetchrow_arrayref()){}

	    $sth->finish();
	}

    };

    if($@)
    {
	chomp($@);
	$engine->{ERRNO} = '';
	$engine->{ERROR} =
	  sprintf("ERROR [0] %s while trying to ident %s",
		  $@, join('.',(grep { /\S/ } ($schema, $name)))
		 );
	return ();
    }

    # if the object was a synonym, look it up in ALL_SYNONYMS
    # and recurse into this function with the new schema/name
    if($data{TYPE} eq 'SYNONYM')
    {
	my %r_obj;

	eval
	{
	    $sth = $dbh->prepare(SYNQ)
	      || die($dbh->errstr,"\n");
	    $sth->bind_param(1, $data{SCHEMA}, SQL_VARCHAR_T)
	      || die($sth->errstr,"\n");
	    $sth->bind_param(2, $data{NAME},   SQL_VARCHAR_T)
	      || die($sth->errstr,"\n");
	    $sth->execute()
	      || die($sth->errstr,"\n");
	    $sth->bind_columns(undef, \@r_obj{@{$sth->{NAME}}})
	      || die($sth->errstr,"\n");
	    while ($sth->fetchrow_arrayref()){}
	    $sth->finish();
	};

	if($@)
	{
	    chomp($@);
	    $engine->{ERRNO} = '';
	    $engine->{ERROR} =
	      sprintf("ERROR [0] %s while trying to ident %s",
		      $@, join('.',(grep { /\S/ } ($schema, $name)))
		     );
	    return ();
	}

	return
	  $engine->_resolve_object($r_obj{T_OWNER}, undef(), $r_obj{T_NAME});
    }

    return @data{qw|SCHEMA PACKAGE NAME TYPE|};
}

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

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

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

    return @pkgs;
}

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

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

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

    return @pmember;
}

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} } })
	  || die("bind_cols(TRIGGERS_QUERY) failed: ",$sth->errstr(),"\n");
	while($sth->fetchrow_arrayref())
	{
	     push(@triggers, $data{TRIGGER_NAME});
	}
	$sth->finish();
    };

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

    return @triggers;
}

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} } })
	  || die("bind_cols(TABLES_QUERY) failed: ",$sth->errstr(),"\n");
	while($sth->fetchrow_arrayref())
	{
	    ($data{TABLE_TYPE} eq 'TABLE') 
	      && push(@tables, $data{TABLE_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(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} } })
	  || die("bind_cols(TABLES_QUERY) failed: ",$sth->errstr(),"\n");
	while($sth->fetchrow_arrayref())
	{
	    ($data{TABLE_TYPE} eq 'VIEW')
	      && push(@views, $data{TABLE_NAME});
	}
	$sth->finish();
    };

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

    return @views;
}

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

    eval
    {
	my $cols;
	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");
	$cols = $#{ $sth->{NAME} };
	$sth->bind_columns(undef(), \@data[0 .. $cols])
	  || die("bind_cols(PROCS_QUERY) failed: ",$sth->errstr(),"\n");
	while($sth->fetchrow_arrayref()){ push(@procs, $data[0]) }
	$sth->finish();
    };

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

    return @procs;
}

sub show ($$$)
{
    my $engine = shift(@_);
    my $sh     = $_[0];
    my $target = $_[1];

    #warn("$engine\-\>show(@_) called\n");

    use constant SQL_SHOW_ERRORS => <<'SqlShowErrors';
select OWNER||'.'||NAME||' ('||TYPE||'): LINE = '||LINE||', POSITION = '||POSITION as ERROR, '\n' || TEXT
from ALL_ERRORS
where owner = USER
order by SEQUENCE
SqlShowErrors

    if ($target =~ /^errors?\b/i)
    {
	return $engine->interpret($sh, SQL_SHOW_ERRORS);
    }
    elsif ($target =~ /^packages\b/i)
    {
	my @list = $engine->packages();
	$sh->errputf(CONTEXT_NIL, " \n");
	$sh->start_pager(scalar(@list) + 5);
	foreach (@list) { $sh->outputf(CONTEXT_NIL, "%s\n", $_) }
	$sh->stop_pager();
	return 1;
    }
    elsif ($target =~ /^package_members\b/)
    {
	my @list = $engine->package_members();
	$sh->errputf(CONTEXT_NIL, " \n");
	$sh->start_pager(scalar(@list) + 5);
	foreach (@list) { $sh->outputf(CONTEXT_NIL, "%s\n", $_) }
	$sh->stop_pager();
	return 1;
    }
    else
    {
	return $engine->DBIShell::dr::DEFAULT::show(@_);
    }
}


__END__

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


#  TRIGGER_OWNER|TRIGGER_NAME           |TABLE_OWNER|TABLE_NAME|COLUMN_NAME |COLUMN_LIST|COLUMN_USAGE|
#  ETUKADM      |ETUK_LOGINUPPERUSERNAME|ETUKADM    |ETUK_LOGIN|USER_NAME   |NO         |NEW IN OUT  |
#  ETUKADM      |LOG_ORDER_STATUS       |ETUKADM    |ETUK_ORDER|ACCOUNT     |NO         |NEW IN      |
#  ETUKADM      |LOG_ORDER_STATUS       |ETUKADM    |ETUK_ORDER|ORDER_NUMBER|NO         |NEW IN      |
#  ETUKADM      |LOG_ORDER_STATUS       |ETUKADM    |ETUK_ORDER|ORIGIN_CODE |NO         |NEW IN      |
#  ETUKADM      |LOG_ORDER_STATUS       |ETUKADM    |ETUK_ORDER|STATUS      |YES        |NEW IN      |
#  ETUKADM      |LOG_ORDER_STATUS       |ETUKADM    |ETUK_ORDER|STATUS_PEND |YES        |NEW IN      |