Conversion script: link fix

2015-02-26T23:48:56Z

link fix

New page

The Basic program runs a perl script that actually connects to the database. The perl script sends the results to stdout, which is captured by the Basic program and parsed into a dynamic array.

<pre>
SUBROUTINE UDTORA(RTN,COL.HEADING,SQL.STATEMENT,OPTIONS,ERRCODE)
***************************************************************************
* Program: UDTORA
* Author : MATT CARROLL
* Date :
* Edited : 08:29:36 Dec 06 2001 By MCGOWAN
* Comment: PASS SQL STATEMENT TO ORACLE DB, RETURNS DYN. ARRAY
***************************************************************************
* Date By Desc
* ---------- ---- ---------------------------------------------------------
* 04/11/2000 IAN Modified perl script to return error code as follows:
*# Return value is
*# 0 no rows selected or updated
*# 1 success, first line of rtn = col headers, second = num rows selected/update
*# 2 error, see first line of RTN for description
* 07/31/2000 IAN Escape $ chars in sql
* 04/02/2001 IAN Pass in account (sid) to perl script
* 12/06/2001 IAN Convert @am to " "

* RTN RETURNED TO CALLING PROGRAM. ARRAY OF DATA RETURNED FROM SQL.STATEMENT
* COL.HEADING RETURNED TO CALLING PROGRAM. MULTI-VALUED LIST OF FIELD NAMES OF TABLE FROM FIRST ROW
* SQL.STATEMENT A VALID SQL STATEMENT. PASSED IN.
* OPTIONS TO BE ITEM

COL.HEADING="" ; PERL.ERR=0 ; ERRCODE=0
SWAP "$" WITH "\$" IN SQL.STATEMENT
SWAP @AM WITH " " IN SQL.STATEMENT

ACCT = ""
<cut stuff about accounts>

IF ACCT="" THEN STOP "PLEASE ADD THIS ACCOUNT TO UDTORA"

E= \!/usr/local/bin/udora.pl \:ACCT:\ "\:SQL.STATEMENT:\" ; echo $?\\
EXECUTE E CAPTURING RTN
I=DCOUNT(RTN,@AM)
PERL.ERR=RTN<I-1>
DEL RTN<I>
DEL RTN<I-1>

IF PERL.ERR = 0 THEN
* No rows selected/updated
ERRCODE=0
* Still get col headings
COL.HEADING=RTN<1>
DEL RTN<1>
END

IF PERL.ERR = 1 THEN
* Get col headings
COL.HEADING=RTN<1>
DEL RTN<1>
* Get number of rows updated/selected
ERRCODE=RTN<1>
DEL RTN<1>
END

IF PERL.ERR = 2 THEN
* There was an error
ERRCODE = -1
END

SWAP \@#@\ WITH @VM IN RTN
RETURN
</pre>

And the perl script

<pre>
#!/usr/bin/perl

use POSIX;
use DBI;
use DBI::DBD; # simple test to make sure it's okay
use DBD::Oracle;

$ENV{[[ORACLE_BASE]]}="/info/app/oracle";
$ENV{[[ORACLE_HOME]]}="/info/app/oracle/product/8.1.5";
$ENV{[[NLS_LANG]]}="american_america.[[WE8ISO8859P1]]";
$ENV{[[ORA_NLS33]]}="/info/app/oracle/product/8.1.5/ocommon/nls/admin/data";
$user="oracle";
$pass="xxx";

my $db_sid='trinity';
my $rtn=0;
my $fld_delim = chr(253);
my $crlf_delim = chr(252);

if( !( $dbh = DBI->connect('dbi:Oracle:host=sunrise;sid=trinity',$user,$pass)))
{
print "Cannot connect database\n$DBI::errstr\n";
exit 2;
}

$statement=$ARGV[1];
$dbh->{[[LongReadLen]]}=4094;
if( !( $sth = $dbh->prepare("$statement") ) )
{
print "Cannot prepare statement\n$DBI::errstr\n\n";
exit 2;
}

if ($statement =~ /^select/i) {
# Select statements return rows
$rc=$sth->execute;
if( ! $rc )
{
print "Cannot process statement\n$DBI::errstr\n\n";
exit 2;
}
my $names = $sth->{NAME};

for ($i=0 ; $i <= $#$names ; $i++)
{
print $names->[$i];
if ($i != $#$names) {print $fld_delim;}
}
print "\n";

$table = $sth->fetchall_arrayref;
if( $#{$table} < 0 )
{
print "No rows returned\n";
exit 0;
}

print $#{$table}+1,"\n";

for $i ( 0 .. $#{$table} )
{
for $j ( 0 .. $#{$table->[$i]} )
{
$data = $table->[$i][$j];
$data =~ s/\r\n/$crlf_delim/g;
print $data;
if ($j != $#{$table->[$i]}) {print $fld_delim;}
}
{print "\n";}
}
} else {
# It's an update or insert statement
$rc=$dbh->do($statement);
if ($rc eq "0E0") {
print "0 rows updated\n";
exit 0;
} else {
print "\n$rc\n$rc rows updated\n";
#$dbh->commit;
}
}

# Close our connection to the db
$sth->finish;

# Return value is
# 0 no rows selected or updated
# 1 success, first line of rtn = col headers, second = num rows selected/updated# 2 error, see first line of RTN for description
exit 1;
</pre>

UdtOra - Revision history

Conversion script: link fix