simple/oragetsrc/oragetsrc.pl

70 lines
1.6 KiB
Perl
Executable File

#!@@@perl@@@ -w
# $Id: oragetsrc.pl,v 1.2 2002-06-18 15:10:59 hjp Exp $
#
# print a named source (e.g, a function or procedure) from an oracle schema
#
use strict;
use DBI;
sub read_cred {
my ($fn) = @_;
open(FN, "<$fn") or die "cannot open $fn: $!";
my $line = <FN>;
close(FN);
my @cred = split(/[\s\n]/, $line);
return @cred;
}
if (@ARGV != 2) {
print STDERR "Usage: $0 credential_file source_name\n";
print STDERR "\tcredential_file is a filename relative to \$HOME/.dbi/\n";
print STDERR "\tThe file must contain a single line with three whitespace-separated fields:\n";
print STDERR "\tDBI data source, username, password.\n";
print STDERR "\te.g:\n";
print STDERR "\tdbi:Oracle:ORCL scott tiger\n";
exit 1;
}
my $db_name = $ARGV[0];
my $src_name = $ARGV[1];
my @cred = read_cred("$ENV{HOME}/.dbi/$ARGV[0]");
my $dbh = DBI->connect($cred[0], $cred[1], $cred[2],
{ RaiseError => 1, AutoCommit => 0 });
# check if it is a procedure or function
my $lines =
$dbh->selectcol_arrayref(
"select text from user_source where name=? order by line",
{},
$src_name
);
if (@$lines) {
for my $i (@$lines) {
print "$i";
}
exit(0);
}
# nope - maybe a trigger?
$dbh->{LongReadLen} = 1000000;
$dbh->{LongTruncOk} = 0;
my $sth = $dbh->prepare("select description, trigger_body from user_triggers where trigger_name=?");
$sth->execute($src_name);
my $found = 0;
while (my $r = $sth->fetchrow_hashref("NAME_lc")) {
print "TRIGGER ", $r->{description}, "\n", $r->{trigger_body}, "\n";;
$found = 1;
}
exit(0) if ($found);
$dbh->disconnect();
exit(1);