[LON-CAPA-cvs] cvs: loncom /homework lonr.pm
www
www@source.lon-capa.org
Fri, 14 Aug 2009 01:58:52 -0000
www Fri Aug 14 01:58:52 2009 EDT
Modified files:
/loncom/homework lonr.pm
Log:
Saving my work - correctly serialize only the output of the last line of a script
Index: loncom/homework/lonr.pm
diff -u loncom/homework/lonr.pm:1.8 loncom/homework/lonr.pm:1.9
--- loncom/homework/lonr.pm:1.8 Wed Aug 12 20:09:02 2009
+++ loncom/homework/lonr.pm Fri Aug 14 01:58:52 2009
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Interface routines to R CAS
#
-# $Id: lonr.pm,v 1.8 2009/08/12 20:09:02 www Exp $
+# $Id: lonr.pm,v 1.9 2009/08/14 01:58:52 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -58,16 +58,14 @@
my $x = $_[0]; # the string containing the serialized R object(s)
if ($x =~ /^((?:i|d):(.+?);)(.*)$/) {
return ($1, $+); # x starts with a number
- }
- elsif ($x =~ /^s:(\d+):/) {
+ } elsif ($x =~ /^s:(\d+):/) {
my $n = $1; # x starts with a string of length n
if ($x =~ /^(s:\d+:\"(.{$n})\";)(.*)$/) {
return ($1, $+); # x starts with a valid string
} else {
&Rcroak('invalid string detected');
}
- }
- elsif ($x =~ /^a:/) {
+ } elsif ($x =~ /^a:/) {
# x starts with an array -- need to find the closing brace
my $i = index $x, '{', 0; # position of first opening brace
if ($i < 0) {
@@ -260,23 +258,22 @@
sub runscript {
my ($socket,$fullscript,$libraries)=@_;
if (&blacklisted($fullscript)) { return 'Error: blacklisted'; }
- my $reply;
+ my $reply='';
$fullscript=~s/[\n\r\l]//gs;
if ($libraries) {
foreach my $library (split(/\s*\,\s*/,$libraries)) {
unless ($library=~/\w/) { next; }
if (&r_is_allowed_library($library)) {
- $reply=&rreply($socket,'library('.$library.');'."\n");
+ $reply=&rreply($socket,'library('.$library.');');
if ($reply=~/^Error\:/) { return $reply; }
} else {
return 'Error: blacklisted';
}
}
}
- foreach my $line (split(/[\n\r]+/s,$fullscript)) {
- if ($line=~/\w/) { $reply=&rreply($socket,$line.";\n"); }
- if ($reply=~/^Error\:/) { return $reply; }
- }
+ $fullscript=~s/\;+\s*$//s;
+ if ($fullscript=~/\w/) { $reply=&rreply($socket,$fullscript.';'); }
+ if ($reply=~/^Error\:/) { return $reply; }
$reply=~s/^\s*//gs;
$reply=~s/\s*$//gs;
&Apache::lonxml::debug("r $fullscript \n reply $reply");
@@ -292,23 +289,28 @@
foreach my $library (split(/\s*\,\s*/,$libraries)) {
unless ($library=~/\w/) { next; }
if (&r_is_allowed_library($library)) {
- $reply=&rreply($socket,'library('.$library.');'."\n");
+ $reply=&rreply($socket,'library('.$library.');');
if ($reply=~/^Error\:/) { return($reply,$reply); }
} else {
return 'Error: blacklisted';
}
}
}
- my @actuallines=();
- foreach my $line (split(/\;/s,$fullscript)) {
- if ($line=~/\w/) { push (@actuallines,$line); }
+ $fullscript=~s/\;+\s*$//s;
+ my $lastline='';
+ my $firstpart='';
+ if ($fullscript=~/\;/) {
+ ($firstpart,$lastline)=($fullscript=~/^(.*\;)([^\;]+)$/);
+ } else {
+ $lastline=$fullscript;
}
- for (my $i=0; $i<$#actuallines; $i++) {
- $reply=&rreply($socket,$actuallines[$i].";\n");
+ if ($firstpart) {
+ $firstpart=~s/\;+\s*$//s;
+ $reply=&rreply($socket,$firstpart.';');
if ($reply=~/^Error\:/) { return($reply,$reply); }
}
# The last line needs to be serialized
- $reply=&Rreturn(&rreply($socket,"phpSerialize($actuallines[-1]);\n"));
+ $reply=&Rreturn(&rreply($socket,"phpSerialize($lastline);"));
return($reply,&Dumper($reply));
}