--- loncom/homework/lonr.pm	2009/08/12 20:09:02	1.8
+++ loncom/homework/lonr.pm	2014/11/19 21:14:47	1.11
@@ -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.11 2014/11/19 21:14:47 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -33,11 +33,8 @@ use IO::Socket;
 use Apache::lonnet;
 use Apache::response();
 use LONCAPA;
-
-### You need to install the libraries below for this to work!
-
-###use Tie::IxHash::Easy; # autoties all subhashes to keep index order
-###use Data::Dumper;  # used to output hash contents
+use Tie::IxHash::Easy; # autoties all subhashes to keep index order
+use Data::Dumper;  # used to output hash contents
 
 my $errormsg='';
 
@@ -56,18 +53,18 @@ sub Rcroak {
 #
 sub Rpeel {
         my $x = $_[0];  # the string containing the serialized R object(s)
-        if ($x =~ /^((?:i|d):(.+?);)(.*)$/) {
+        if ($x =~ /^N\;(.*)$/) {
+            return ('',$1);
+        } elsif ($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) {
@@ -152,6 +149,8 @@ sub Rreturn {
         }
         if ($errormsg) { return $errormsg; }
         return \%h;  # return a reference to the hash
+    } elsif ($x eq '') {
+        return '';
     } else {
         return 'Unrecognized output';
     }
@@ -260,23 +259,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 +290,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));
 }