#!/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 "<HTML><TITLE>Unrecognized Context</TITLE>";
   print "<BODY bgcolor=\"white\"><h1>Unrecognized Context</h1>";
   print "The context \"$script_name\" is not recognized in sqr.pl.";
   print "</BODY></HTML>";
   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 "<HTML><TITLE>Program Not Found</TITLE>";
  print "<BODY bgcolor=\"white\"><h1>Program Not Found</h1>";
  print "The program $sqr_program was not found.";
  print "</BODY></HTML>";
  exit;
  }

if (-r "$sqr_dir/sqr_down.html")
  {
  print "Content-Type: text/html\n\n";
  open(F,"$sqr_dir/sqr_down.html");
  while (<F>) { 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");
