[Rpad-commits] r4 - in pkg/Rpad: . inst inst/basehtml inst/basehtml/server man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Jan 4 11:15:39 CET 2014
Author: jedick
Date: 2014-01-04 11:15:39 +0100 (Sat, 04 Jan 2014)
New Revision: 4
Modified:
pkg/Rpad/DESCRIPTION
pkg/Rpad/inst/NEWS
pkg/Rpad/inst/basehtml/ServerNotes.html
pkg/Rpad/inst/basehtml/index.html
pkg/Rpad/inst/basehtml/server/R_process.pl
pkg/Rpad/man/Rpad-package.Rd
Log:
improve timeout in R_process.pl
Modified: pkg/Rpad/DESCRIPTION
===================================================================
--- pkg/Rpad/DESCRIPTION 2014-01-02 15:39:42 UTC (rev 3)
+++ pkg/Rpad/DESCRIPTION 2014-01-04 10:15:39 UTC (rev 4)
@@ -1,6 +1,6 @@
Package: Rpad
Title: Workbook-style, web-based interface to R
-Version: 1.3.99.1
+Version: 1.3.99.2
Author: Tom Short (EPRI), Philippe Grosjean (UMH EcoNum), Jeffrey Dick
Description: A workbook-style user interface to R through a web
browser. Provides convenient interaction with an R process
Modified: pkg/Rpad/inst/NEWS
===================================================================
--- pkg/Rpad/inst/NEWS 2014-01-02 15:39:42 UTC (rev 3)
+++ pkg/Rpad/inst/NEWS 2014-01-04 10:15:39 UTC (rev 4)
@@ -1,4 +1,4 @@
-CHANGES IN Rpad 1.3.99.1 (2014-01-02)
+CHANGES IN Rpad 1.3.99.2 (2014-01-04)
-------------------------------------
- Restore Perl files related to server version of Rpad
@@ -12,8 +12,8 @@
- Major revision of R_process.pl. Now uses a recent Statistics::R
(tested with version 0.32), forks a background Perl process,
- uses Linux:Inotify to become aware of R commands and Time:Out
- to self-destruct.
+ uses Linux:Inotify to become aware of R commands, and attempts to
+ to self-destruct after 10 minutes.
CHANGES IN Rpad 1.3.99.0 (2013-12-31)
-------------------------------------
Modified: pkg/Rpad/inst/basehtml/ServerNotes.html
===================================================================
--- pkg/Rpad/inst/basehtml/ServerNotes.html 2014-01-02 15:39:42 UTC (rev 3)
+++ pkg/Rpad/inst/basehtml/ServerNotes.html 2014-01-04 10:15:39 UTC (rev 4)
@@ -70,8 +70,6 @@
<li>Linux::Inotify2 (and its dependency, common:sense). Used to monitor file changes
so that incoming R commands can be executed by a backgrounded Perl/R bridge.</li>
- <li>Time::Out. Used to time out waiting for R results (10 seconds), and to destroy the background
- Perl/R bridge (10 minutes, after which the temporary directory is cleared and the R and Perl processes exit).</li>
</ul>
Modified: pkg/Rpad/inst/basehtml/index.html
===================================================================
--- pkg/Rpad/inst/basehtml/index.html 2014-01-02 15:39:42 UTC (rev 3)
+++ pkg/Rpad/inst/basehtml/index.html 2014-01-04 10:15:39 UTC (rev 4)
@@ -124,14 +124,7 @@
</textarea>
</div>
-<p>The date and time:</p>
-<div data-dojo-type="Rpad" rpadRun="all">
-<pre>
-date()
-</pre>
-</div>
-
</td><td> </td> <td width="25%">
<p>Help</p>
Modified: pkg/Rpad/inst/basehtml/server/R_process.pl
===================================================================
--- pkg/Rpad/inst/basehtml/server/R_process.pl 2014-01-02 15:39:42 UTC (rev 3)
+++ pkg/Rpad/inst/basehtml/server/R_process.pl 2014-01-04 10:15:39 UTC (rev 4)
@@ -1,176 +1,198 @@
-#!/usr/bin/perl -w
-#!c:/apps/perl/bin/perl.exe
-
-# The following line is a test script to see if it works.
-# http://localhost/Rpad/server/R_process.pl?&ID=/tmp/ddNTlmHSvWZF&command=R_commands&R_commands=print('hello')
-
-use strict;
-use warnings;
-
-use Statistics::R;
-use Linux::Inotify2;
-use File::Path qw(remove_tree);
-use Time::Out qw(timeout);
-use CGI qw/:standard send_http_header/;
-
-# chdir to temporary directory
-#my $Rpad_ID = '/home/jedick/tmp/rtmp'; ## testing
-my $Rpad_ID = param('ID');
-chomp($Rpad_ID);
-chdir $Rpad_ID;
-
-#my $p_command = 'login'; ## testing
-#my $p_command = 'R_commands'; ## testing
-my $p_command = param('command');
-chomp $p_command ;
-
-my @output_value = "";
-
-if ($p_command eq 'login') {
-
- # fork this process
- my $pid = fork();
- die "Fork failed: $!" if !defined $pid;
-
- if ($pid == 0) {
-
- # do this in the child
- open STDOUT, ">/dev/null";
- open STDERR, ">/dev/null";
-
- # start R and load Rpad
- my $R = "";
- sub startR{
- $R = Statistics::R->new( shared => 1 );
- $R->start();
- $R->run(q`require(Rpad)`);
- # from ?stop: "don't stop on stop(.)"
- # this way the R process behaves more like the interactive session - it isn't halted when an error occurs
- # but errors still hang up the perl so we can't use it...
- #$R->run(q`options(error = expression(NULL))`);
- }
- &startR();
-
- # subroutine to clean up temporary directory
- sub cleanup{
- chdir ".." or die "Failed to go to parent directory: $!";
- remove_tree($Rpad_ID);
- }
-
- # set up inotify watch on temporary directory
- my $inotify = new Linux::Inotify2
- or die "Unable to create new inotify object: $!";
- $inotify->watch("$Rpad_ID", IN_CLOSE_WRITE, sub {
- my $event = shift;
- my $name = $event->name;
- # run the input.R when it appears
- if ( $name eq "input.R" ) {
- # read R command from the input file
- # $R->run_from_file would be cleaner, but it's a source(), so doesn't echo like the interactive session
- #my $output_value = eval { $R->run_from_file($name); };
- open(my $fh, '<', $name) or die "Could not open file '$name' $!";
- # Slurp into a scalar
- my $R_commands;
- { local $/ = undef; $R_commands = <$fh>; }
- close $fh;
- my $output_value = eval { $R->run($R_commands); };
-
- # convert any errors from R into the output text
- if ( $@ ) {
- $output_value = "$@";
- # remove first 3 lines for a cleaner error message
- $output_value =~ s/^(?:.*\n){1,3}//;
- # restart R (probably should test if really did stop)
- &startR();
- }
- # save output to file
- my $filename = "output";
- open($fh, '>', $filename) or die "Could not open file '$filename' $!";
- print $fh "$output_value\n";
- close $fh;
- }
- elsif ( $name eq "theend" ) {
- &cleanup();
- die "watch process terminated by request";
- }
- }) or die "watch creation failed: $!";
-
- # put a limit of 10 minutes on our process
- timeout 600 => sub {
- 1 while $inotify->poll;
- } ;
- if ($@){
- &cleanup();
- # operation timed-out
- die "watch process reached timeout limit";
- }
- }
-
- # wait a second for R to start and to begin watch of
- # input file before any R commands are sent
- sleep 1;
-
-}
-
-elsif ($p_command eq 'logout') {
-
- # this creates a file signalling the end of Perl child process
- my $filename = "theend";
- open(my $fh, '>', $filename) or die "Could not open file '$filename' $!";
- print $fh "\n";
- close $fh;
-
-}
-
-elsif ($p_command eq 'R_commands') {
-
- # process R commands
- #my $R_commands = "print('abcxyz') \n\ndate()\n\n \n Sys.sleep(10)"; ## testing
- my $R_commands = param('R_commands');
- # replace non-breaking spaces with regular spaces
- $R_commands =~ s/\xA0/ /g;
-
- # save commands to the input file that is being watched by the child process
- my $filename = "input.R";
- open(my $fh, '>', $filename) or die "Could not open file '$filename' $!";
- # split the string of commands on newlines
- my @lines = split /\n/, $R_commands;
- foreach my $line (@lines) {
- # remove the trailing space(s), which seem to cause problems
- $line =~ s/\ *$//g;
- # blank lines also cause problems; remove them too
- if ( $line ne "" ) {
- print $fh "$line\n";
- }
- }
- close $fh;
-
- # set up inotify watch to grab output file
- my $inotify = new Linux::Inotify2
- or die "Unable to create new inotify object: $!";
- $inotify->watch("$Rpad_ID", IN_CLOSE_WRITE, sub {
- my $event = shift;
- my $name = $event->name;
- if ( $name eq "output" ) {
- # read contents of output file into output_value
- my $filename = "output";
- open(my $fh, '<', $filename) or die "Could not open file '$filename' $!";
- @output_value=<$fh>;
- close $fh;
- }
- }) or die "watch creation failed: $!";
-
- # interrupt the watch if it runs for more than 10 seconds.
- timeout 10 => sub {
- $inotify->poll;
- } ;
- if ($@){
- # operation timed-out
- @output_value = "10 seconds passed with no output from R ... back to you!\n";
- }
-
-}
-
-CGI::initialize_globals();
-print header;
-print @output_value;
+#!/usr/bin/perl
+#!c:/apps/perl/bin/perl.exe
+
+# The following line is a test script to see if it works.
+# http://localhost/Rpad/server/R_process.pl?&ID=/tmp/ddNTlmHSvWZF&command=R_commands&R_commands=print('hello')
+
+use strict;
+use warnings;
+
+use Statistics::R;
+use Linux::Inotify2;
+use File::Path qw(remove_tree);
+use CGI qw/:standard send_http_header/;
+use Time::HiRes qw(time sleep);
+
+CGI::initialize_globals();
+
+# get name of temporary directory
+#my $Rpad_ID = '/home/jedick/tmp/rtmp'; ## testing
+my $Rpad_ID = param('ID');
+chomp($Rpad_ID);
+
+#my $p_command = 'login'; ## testing
+#my $p_command = 'R_commands'; ## testing
+my $p_command = param('command');
+chomp $p_command ;
+
+my @output_value = "";
+
+if ($p_command eq 'login') {
+
+ # fork this process
+ my $pid = fork();
+ die "Fork failed: $!" if !defined $pid;
+
+ if ($pid == 0) {
+
+ # do this in the child
+ open STDOUT, ">/dev/null";
+ open STDERR, ">/dev/null";
+
+ # start R and load Rpad
+ my $R = "";
+ sub startR{
+ chdir $Rpad_ID;
+ $R = Statistics::R->new( shared => 1 );
+ $R->start();
+ $R->run(q`require(Rpad)`);
+ # from ?stop: "don't stop on stop(.)"
+ # this way the R process behaves more like the interactive session - it isn't halted when an error occurs
+ # but errors still hang up the perl so we can't use it...
+ #$R->run(q`options(error = expression(NULL))`);
+ chdir ".." or die "Failed to go to parent directory: $!";
+ }
+ &startR();
+
+ # subroutine to clean up temporary directory
+ sub cleanup{
+ remove_tree($Rpad_ID);
+ }
+
+ # set up inotify watch on temporary directory
+ my $inotify = new Linux::Inotify2
+ or die "Unable to create new inotify object: $!";
+ $inotify->watch($Rpad_ID, IN_CLOSE_WRITE, sub {
+ my $event = shift;
+ my $name = $event->name;
+ my $fullname = $event->fullname;
+ # run the input.R when it appears
+ if ( $name eq "input.R" ) {
+ # read R command from the input file
+ # $R->run_from_file would be cleaner, but it's a source(), so doesn't echo like the interactive session
+ #my $output_value = eval { $R->run_from_file($name); };
+ open(my $fh, '<', $fullname) or die "Could not open file '$fullname' $!";
+ # Slurp into a scalar
+ my $R_commands;
+ { local $/ = undef; $R_commands = <$fh>; }
+ close $fh;
+ my $output_value = eval { $R->run($R_commands); };
+
+ # convert any errors from R into the output text
+ if ( $@ ) {
+ $output_value = "$@";
+ # remove first 3 lines for a cleaner error message
+ $output_value =~ s/^(?:.*\n){1,3}//;
+ # restart R (probably should test if really did stop)
+ &startR();
+ }
+ # save output to file
+ my $filename = $Rpad_ID . "/output";
+ open($fh, '>', $filename) or die "Could not open file '$filename' $!";
+ print $fh "$output_value\n";
+ close $fh;
+ }
+ elsif ( $name eq "theend" ) {
+ &cleanup();
+ die "watch process terminated by request";
+ }
+ }) or die "watch creation failed: $!";
+
+ # time out after 5 minutes
+ # Sys::SigAction or Time::Out work when script is run from commandline, but don't timeout under CGI
+ # instead, turn off blocking on inotify and use Time::HiRes
+ # http://www.perlmonks.org/?node_id=859287
+ $inotify->blocking(0);
+ my $timelimit = 20;
+ my $end = time() + $timelimit;
+ while( time() < $end ) {
+ $inotify->poll;
+ sleep 0.1;
+ }
+ &cleanup();
+ die "watch process reached timeout limit";
+
+ }
+
+ # wait a second for R to start and to begin watch of
+ # input file before any R commands are sent
+ sleep 1;
+
+}
+
+elsif ($p_command eq 'logout') {
+
+ # this creates a file signalling the end of Perl child process
+ my $filename = "theend";
+ open(my $fh, '>', $filename) or die "Could not open file '$filename' $!";
+ print $fh "\n";
+ close $fh;
+
+}
+
+elsif ($p_command eq 'R_commands') {
+
+ # process R commands
+ #my $R_commands = "print('abcxyz') \n\ndate()\n\n \n Sys.sleep(10)"; ## testing
+ my $R_commands = param('R_commands');
+ # replace non-breaking spaces with regular spaces
+ $R_commands =~ s/\xA0/ /g;
+
+ # save commands to the input file that is being watched by the child process
+ my $filename = $Rpad_ID . "/input.R";
+ sub not_writable{
+ @output_value="Input file not writable; timeout may have occurred.\nTry starting a new session by reloading the page.\n";
+ print header;
+ print @output_value;
+ exit 1;
+ }
+ open(my $fh, '>', $filename) or ¬_writable();
+ # split the string of commands on newlines
+ my @lines = split /\n/, $R_commands;
+ foreach my $line (@lines) {
+ # remove the trailing space(s), which seem to cause problems
+ $line =~ s/\ *$//g;
+ # blank lines also cause problems; remove them too
+ if ( $line ne "" ) {
+ print $fh "$line\n";
+ }
+ }
+ close $fh;
+
+ # set up inotify watch to grab output file or create message if tmpdir (Rpad_ID) was deleted while running R command
+ my $inotify = new Linux::Inotify2
+ or die "Unable to create new inotify object: $!";
+ # set up a watcher on an output file
+ $inotify->watch($Rpad_ID, IN_DELETE_SELF | IN_CLOSE_WRITE, sub {
+ my $event = shift;
+ my $name = $event->name;
+ my $fullname = $event->fullname;
+ if ( $event->IN_DELETE_SELF ) {
+ # TODO: test this, do we ever get here?
+ @output_value="Temporary directory was deleted while running R command; timeout may have occurred.\nTry starting a new session by reloading the page.\n";
+ }
+ elsif ( $name eq "output" ) {
+ # read contents of output file into output_value
+ open(my $fh, '<', $fullname) or die "Could not open file '$fullname' $!";
+ @output_value=<$fh>;
+ close $fh;
+ }
+ }) or die "watch creation failed: $!";
+
+ $inotify->poll;
+
+# this slows down response time considerably, so for now running of R commands is blocking
+# # return a default message if the R process doesn't finish within 10 seconds
+# @output_value = "10 seconds passed with no output from R ... back to you!\n";
+# $inotify->blocking(0);
+# my $timelimit = 10;
+# my $end = time() + $timelimit;
+# while( time() < $end ) {
+# $inotify->poll;
+# sleep 0.01;
+# }
+
+}
+
+print header;
+print @output_value;
Modified: pkg/Rpad/man/Rpad-package.Rd
===================================================================
--- pkg/Rpad/man/Rpad-package.Rd 2014-01-02 15:39:42 UTC (rev 3)
+++ pkg/Rpad/man/Rpad-package.Rd 2014-01-04 10:15:39 UTC (rev 4)
@@ -1,6 +1,5 @@
\docType{package}
\name{Rpad-package}
-\alias{Rpad}
\alias{Rpad-package}
\title{Rpad}
\description{
@@ -9,8 +8,8 @@
\details{
This manual describes the R functions that support the web interface.
Other documentation is in the \dQuote{basehtml} directory.
-The example below will launch a local web browser where you can read the documentation and view the demos.
-You can continue to interact with the R console when the local HTTP server starts.
+The example below will launch a browser where you can read that documentation and view the demos.
+You can continue to use the R console after the local HTTP server starts.
}
\examples{
\dontrun{
More information about the Rpad-commits
mailing list