#!/usr/bin/perl

# Helper script for Makefile to install custom PL/SQL extensions
# Copyright (C) 2001 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 Term::ReadKey;
use constant READMODE_REVERT => 0; # restore to last seen mode.
use constant READMODE_NORMAL => 1; # standard 'sane' mode.
use constant READMODE_NOECHO => 2; # good for passwords.
use constant READMODE_CBREAK => 3; # fnord.
use constant READMODE_RAW    => 4; # no translation except lf<->crlf.
use constant READMODE_RAW_LF => 5; # no translation.

use constant CREATE_OR_REPLACE_LIBRARY =>
  q[CREATE or REPLACE LIBRARY %s AS '%s'];

sub get_param ($;$);

MAIN:
{
    my $dsn  = get_param("dsn: [host=localhost;sid=$ENV{ORACLE_SID}]")
      || q[host=localhost;sid=$ENV{ORACLE_SID}];
    my $user = get_param("database user [sys]: ", READMODE_NORMAL)
      || q[sys];
    my $pass = get_param("database password: ",   READMODE_NOECHO)
      || '';
    my $dbh = DBI->connect(join(':', dbi => Oracle => $dsn), $user, $pass)
      || die("connect(dbi:Oracle:$dsn) failed: $DBI::errstr\n");

    foreach my $lib (@ARGV)
    {
	if(-f($lib) && ($lib =~ m|(.*)/(\w+)(_\d+).so$|))
	{
	    my $dir  = $1;
	    my $name = join('',$2,'.so');
	    $name =~ s/\W/_/g;

	    my $sql  = sprintf(CREATE_OR_REPLACE_LIBRARY, $name, $lib);

	    $dbh->do($sql) ?
	      warn($sql, " : SUCCESS\n"):
		warn($sql, " : ",$dbh->errstr(),"\n");
	}
	else
	{
	    warn("$lib: error - ", ($! || "looks weird to me"), "\n");
	}
    }

    $dbh->disconnect();
}

sub get_param ($;$)
{
    my $lf;
    my $param;
    my ($prompt,$mode) = @_;

    length($mode) || ($mode = READMODE_NORMAL);

    Term::ReadKey::ReadMode($mode, *STDIN);
    print(STDERR $prompt);
    chomp($param = readline(*STDIN));
    if($mode == READMODE_NOECHO){ print(STDERR $/) }
    Term::ReadKey::ReadMode(READMODE_REVERT, *STDIN);

    return $param;
}

__END__