#!/usr/bin/perl
# sqr.pl -- Perl wrapper to invoke SQR for CGI requests
# This script provides two mechanisms for debugging the CGI
# SQR program: adding @ after the call to sqr.pl in the URL
# and creating a file called sqr_program.debug.
#
# This program is intended as a template and is released to the public
# under the terms of the Lesser Gnu Public License.
# set STDIN, STDOUT to be unbuffered so we don't loose
# characters communicating with the spawned process
$ENV{'ORACLE_HOME'}="/path/to/oracle";
select(STDIN); $| = 1;
select(STDOUT); $| = 1;
$server_name = $ENV{'SERVER_NAME'};
$path_info = $ENV{'PATH_INFO'};
$script_name = $ENV{'SCRIPT_NAME'};
# If there is a "/@" at the beginning of the path_info then go
# into debug mode (and remove the @ from $_). (Normally,
# the SQR program generates its own Content-Type: line.)
$debug_level = 0;
if ($path_info =~ s!^/@(.*)!/$1!)
{
$debug_level = 1;
$debug_source = 'URL';
}
# If there is a second "@" then list the environment variables.
if ($path_info =~ s!^/@(.*)!/$1!)
{
$debug_level = 2;
}
if ($script_name eq "/cgi-bin/sqr.pl")
{
$_ = $path_info;
if (m!^/~username/(.*)!)
{
$sqr_dir = "/home/username/cgi-bin/" ;
$sqr_program = "$sqr_dir$1" ;
$sqr_params = "username/password\@oracle_instance -XB";
}
elsif (m!^/~other_user/(.*)!)
{
$sqr_dir = "/home/other_user/cgi-bin/" ;
$sqr_program = "$sqr_dir$1" ;
$sqr_params = "user/pass\@instance -XB";
}
else
{
$sqr_dir = "/proj/www/cgi-bin/" ;
$sqr_program = "/proj/www/cgi-bin$_" ;
$sqr_params = "scott/tiger\@lorien -XB" ;
}
}
else
{
print "Content-Type: text/html\n\n";
print "Unrecognized Context";
print "Unrecognized Context
";
print "The context \"$script_name\" is not recognized in sqr.pl.";
print "";
exit;
}
# If the requested program has an extension specified, use it. Otherwise,
# use the .sqt file if found, else try to run the .sqr.
if ($sqr_program =~ /(.*)\.sqt$/ )
{
$sqr_params = "$sqr_params -RT";
$sqr_program_base = $1;
}
elsif ( $sqr_program =~ /(.*)\.sqr$/ )
{
$sqr_program_base = $1;
}
elsif ( -r "$sqr_program.sqt" )
{
$sqr_program_base = $sqr_program;
$sqr_program = "$sqr_program.sqt";
$sqr_params = "$sqr_params -RT";
}
else
{
$sqr_program_base = $sqr_program;
$sqr_program = "$sqr_program.sqr";
}
if (! -r "$sqr_program" )
{
print "Content-Type: text/html\n\n";
print "Program Not Found";
print "Program Not Found
";
print "The program $sqr_program was not found.";
print "";
exit;
}
if (-r "$sqr_dir/sqr_down.html")
{
print "Content-Type: text/html\n\n";
open(F,"$sqr_dir/sqr_down.html");
while () { print; }
close(F);
exit;
}
if ( $debug_level == 0 )
{
if ( -f "$sqr_program_base.debug2")
{
$debug_level = 2;
$debug_source = "$sqr_program_base.debug2 found";
}
elsif ( -f "$sqr_program_base.debug1" )
{
$debug_level = 1;
$debug_source = "$sqr_program_base.debug1 found";
}
elsif ( -f "$sqr_program_base.debug" )
{
$debug_level = 1;
$debug_source = "$sqr_program_base.debug found";
}
}
if ($debug_level > 0)
{
print "Content-Type: text/plain\n\n";
print "parms: $sqr_params\n";
print "requested path: $path_info\n";
print "sqr_program: $sqr_program\n";
print "debug source: $debug_source\n\n";
}
if ($debug_level > 1)
{
system("bash -c set");
}
system("source /usr/local/sqr/ora/workbench/bin/setup_sqr; \
cd $sqr_dir; \
\$SQRDIR/sqr $sqr_program $sqr_params");