The source code of DBviaCSProxy.pl :
<![CDATA[
#!/usr/bin/perl
# For use as a CGI script:
# As target of a link or form GET action to a URL like
# http://www...../cgi-bin/.../DBviaproxy.pl
# It returns an HTML document containing information fetched from
# an Oracle database.
# The line at the top is for CGI use on a Unix system.
# Connects to a nominated Oracle database via the Proxy Server
# at oracle.cs.stir.ac.uk and then does a straightforward retrieval.
#
# Customize the definitions below of variables
# $dbname, $username and $password
# with suitable strings to identify the actual database
# and give authorization info.
# Author: SB Jones June 2001, based on R Bland
use strict ;
use DBI ;
my ($dbname, # the database name
$username,# for accessing the database
$password,# for accessing the database
$dbh, # database handle
$sth, # statement handle
@row, # row (record)
%attr, # error-checking attributes for DBI
$ProxyID # machine, port, database
) ;
my ($season, $title) ;
$dbname = "cs";
# Customize these lines for username and password ###########
# As they stand, they fetch the username and password from the first two
# lines of an accompanying file. This gives security if that file
# is protected from public access, and this script runs with set-user-id mode.
# Could simplify by simply assigning two strings to $username and $password.
open AUTH, ".$dbname.auth";
$username = <AUTH>; chomp $username;
$password = <AUTH>; chomp $password;
close AUTH;
# End of username/password set-up ###########################
print "Content-Type: text/html\n";
print "\n";
%attr = (
PrintError => 0, # don't report errors through warn()
RaiseError => 1) ; # do report errors through die()
$ProxyID="hostname=oracle.cs.stir.ac.uk;port=57005;dsn=dbi:Oracle:$dbname";
$dbh = DBI->connect("dbi:Proxy:$ProxyID", $username, $password, \%attr);
$sth = $dbh->prepare("SELECT DISTINCT Season, Title FROM Panto") ;
$sth->execute ;
print "<TITLE>Retrieving information from Oracle via proxy server</TITLE>\n";
print "<TABLE BORDER=2>\n";
while (($season, $title) = $sth->fetchrow_array()) {
print "<TR><TD>$season</TD><TD>$title</TD></TR>\n" ; }
print "</TABLE>\n";
$dbh->disconnect ;
print "<HR>\n" ;
]]>