Smile

R-server for PHP & Perl interface to R, web driven

In case you are not familiar with R (website), it is an open-source project for statistical computing similar to S. It is easy to install and use. It generates beautiful png & vector graphics, which are really nice to include on a website that does a lot of statistical analysis, say for instance… StudentsReview.

Unfortunately (at the time of this writing), it doesn’t have an easy way to be used as a standalone, or as a web-driven server to connect to some front end web-app. So I wrote one. As always, it’s 80-20 with me, so 80% got it working until it did what I needed it to, and then I switched to something else. If you have a contribution/improvement to make, please email it to me!

#!/usr/bin/perl
# require 5.002;
# use strict;
qq^
By Beracah Yankama beracah@studentsreview.com  beracah mit edu(2002)
For StudentsReview www.StudentsReview.com
MIT License, I suppose.
^;

use Socket;
use Carp;

# BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }

# try several other sockets, if this one is already in use.


# change to tmp/R directory to create the plots
chdir "/tmp/R";

my $NAME = '/tmp/rsvr_1';
my $lock = $NAME . ".lock";
my $uaddr = sockaddr_un($NAME);
my $proto = getprotobyname('tcp');

socket(Server,PF_UNIX,SOCK_STREAM,0)        || die "socket: $!";
unlink($NAME);
bind  (Server, $uaddr)                      || die "bind: $!";
listen(Server,SOMAXCONN)                    || die "listen: $!";

# starting server

# allow anyone to access the R server (huge hole!)
chmod 0777, $NAME;



# we should redirect stdout to /dev/null
# pid is global...

# keep 2 restarts from running simultaneously
$Rrestart_running = 0;


$pid = start_R();
print "#process: $pid\n";
# we prevent other clients from connecting
# but accept new client once done.
while (my $client = accept(Client,Server))
{

        # set a lockfile so that we can go on.
                # !!! remember to put in the R processid into the lock
        $l = `touch $lock`;

        # capture R's output.

        while ()        # read everything from client.
        {

                # if the command tells us a message pipe, we connect to it and capture the output.

                print R "$_\n"; # if R died, restart it on the same handle.
                # print "$_\n";

                # if r dies or is told to die, then disconnect.
                # if it is a quit, allow the server to die and exit gracefully?

                # there is only one R connection at a time, so we don't have to worry about too many
                # unready connections.

                # if r dies in the middle of a command, the signal handler
                # will kill the client connection, and take care of restarting R (and re-establishing the R connection)
        }

        # R is dying slower than this loop.
        sleep(1);               # allow R to die if it was going to.

        # send back capture'd output, release capture
        # do not close the client & release the lock UNTIL
        # R has completed the commands.
        # we could probably block, waiting for for the __DONE__ message.



        # if R is dead or defunct.
        $status = `ps --no-headers $pid`;
        if ($status =~ m/defunct/gi || (length($status) < 5))
        { cleanup_restart(); }

        else {
        # close and cleanup gracefully.
        # if the pipe is broken, then restart the R server.
        close(Client);

        # cleanup; if multiple commands need to be run, then connection can stay open.
        # this makes sure the memory is empty for the next connection.
        print R qq^rm(list = objects())\n^;
        }

        $l = `rm -f $lock`;
}

close R;

# remove our socket.
rm $NAME;

#########################################
sub cleanup_restart()
{
        if ($Rrestart_running) { return; }
        $Rrestart_running = 1;

        $SIG{PIPE} = sub { };   # briefly turn off the broken pipe messages.
        close(Client);                  # shut down the client, if open
        close(R);

        $l = `touch $lock`;             # make sure we are locked, no connections until R is alive again.

        # R is probably already dead...
        if (`ps $pid`) { `kill -9 $pid`;}

        $pid = start_R();

        unlink($lock);                  # remove the lockfile, ready to go.

        $Rrestart_running = 0;
}

# we start an unbuffered session of R
# so that we can pass commands into it
# setup all the necessary settings.
sub start_R()
{
        # start R
        # open(R,"|-") || exec 'cat', '-n'; # for testing.
        $pid = open(R,"|-") || exec '/usr/local/bin/R', '--vanilla', '--slave';

        select(R); $| = 1;      # unbuffered

        # make sure R is started & running.
        print R "5+5\n";        # simple test

        # load all the necessary packages for our operations
        print R qq^require("graphics")\n^;
        print R qq^require("ade4")\n^;
        print R qq^require("cclust")\n^;
        print R qq^require("cluster")\n^;
        print R qq^require("knncat")\n^;
        print R qq^require("knnTree")\n^;
        print R qq^require("mclust")\n^;
        print R qq^require("mva")\n^;
        print R qq^require("norm")\n^;
        print R qq^require("normalp")\n^;
        print R qq^require("PTAk")\n^;
        print R qq^require("RColorBrewer")\n^;
        print R qq^require("scatterplot3d")\n^;
        print R qq^require("fields")\n^;

        # turn off error handling, so we stay running
        print R qq^options("warn"=1, "echo"=TRUE,"error"=expression(NULL),"show.error.messages"=FALSE)\n^;


        # set the default graphics output mode
        print R qq^postscript()\n^;


        # setup the R crash cleanup recover
        $SIG{PIPE} = sub { cleanup_restart(); };

        sleep(1);               # give R time to start before continuing.

        return $pid;
}




# remember to write data conversion & plot libs
# and cleanup funcs.

exit;