#!/usr/bin/perl
#
# Rcgi main file...  see documentation for licencing.

my($home,$temp,$Rbin);

$home = "/home/markj/files/stats200/R/cgi";
$temp = "/usr/local/lib/Rcgi/out";
$Rbin = "/usr/bin/R";

#### That's all, folks.

use CGI;

my($results, $in);
my($q)= new CGI;

# Reconstruct any inputs
if ($results=$q->param('CALLER')) {
    $results='<INPUT TYPE=HIDDEN NAME="CALLER" VALUE="'.$results.'">';
    }
#@input = $q->param('INPUT');
$in=join("\n",$q->param('INPUT'));

# Print input form
print $q->header,
'
<HTML><HEAD><TITLE>Rcgi</TITLE>
</HEAD><BODY BGCOLOR="#FFFFFF" TEXT="#000000" LINK="#0000C0" VLINK="#0000C0">
<H1><IMG SRC="/Rdoc/doc/html/logo.jpg">Rcgi</H1>
<H4>Release 3 - "Cardiff"</H4>
<B>Program Input</B><BR>
<FORM METHOD=POST ACTION="'.$q->url.'">
<TEXTAREA NAME="INPUT" ROWS=5 COLS=64>
'.$in.'</TEXTAREA><BR><INPUT TYPE=SUBMIT VALUE="Go!">
'.$results.'</FORM>';


if ($in) {

# Give our input (if any) to R
    chdir($temp); 
    open(R, "| tee $temp/$$.Rin | $Rbin --no-save >$temp/$$.Rout");
    print R "postscript(\"$temp/$$.Rps\")\n";
    $in =~ s/\r//g;
    $in =~ s/(unlink|postscript|system)[^\n]*//g;
    # I think they're the only really nasty things to trap...
    print R $in."\n"; # End it politely (not an EOF at the end of a command)
    close R;

# Saving CPU at expense of disk space (note in .gif script)
    `gzip $$.Rps`; 

# Read the output
    open(IN, "$temp/$$.Rout");

# Tidy it up for HTML
    $results =  join(" ",<IN>);
    $results =~ s/&/&amp;/g;
    $results =~ s/</&lt;/g;
    $results =~ s/>/&gt;/g;
    close(IN);

# Print it out
    print '
<HR><B>Program Output</B><PRE>*** Rcgi reference '.$$.':'
.`date +%Y%m%d%H%M%S`."\n".$results
.'</PRE>
<HR><B>Graphical Output</B>:
    <A HREF="'.$q->url.'.ps?'.$$.'">High Quality PostScript</A> (fast) 
    or
    <A HREF="'.$q->url.'.gif?'.$$.'" TARGET="_new">Low Quality GIF</A> (slow)
    <BR>
    PostScript may need an application or plugin to be installed to view.
    GIF should be viewable by most browsers.';

# Have we got a call-back name?
    if ($in=$q->param('CALLER')) {
        print '<HR><A HREF="'.$in.'">Return to '.$in.'</A>';
    }

    }

print '<HR><A HREF="/Rdoc/doc/html/">R language help</A></BODY></HTML>';
    
