--- loncom/homework/lonr.pm 2009/08/12 20:09:02 1.8 +++ loncom/homework/lonr.pm 2009/08/14 01:58:52 1.9 @@ -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 @@ sub Rpeel { 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 r_is_allowed_library { 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 @@ sub runserializedscript { 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)); }