--- loncom/lonr	2009/04/17 01:00:10	1.3
+++ loncom/lonr	2024/06/22 14:29:36	1.14
@@ -3,7 +3,7 @@
 # The LearningOnline Network with CAPA
 # Connect to R CAS
 #
-# $Id: lonr,v 1.3 2009/04/17 01:00:10 www Exp $
+# $Id: lonr,v 1.14 2024/06/22 14:29:36 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -154,10 +154,10 @@ $SIG{USR1} = \&child_announce_death;
 # ----------------------------- Make sure this process is running from user=www
 my $wwwid=getpwnam('www');
 if ($wwwid!=$<) {
-    my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
+    my $emailto="$perlvar{'lonAdmEMail'} $perlvar{'lonSysEMail'}";
     my $subj="LON: User ID mismatch";
-    system("echo 'User ID mismatch.  lonr must be run as user www.' |\
- mailto $emailto -s '$subj' > /dev/null");
+    system("echo 'User ID mismatch.  lonr must be run as user www.' |".
+           " mail -s '$subj' $emailto > /dev/null");
     exit 1;
 }
  
@@ -269,15 +269,15 @@ sub make_new_child {
 	};
 
 	$command->log_stdout(0);
-	$command->log_file("$execdir/logs/lonr.session.log");
+#	$command->log_file("$execdir/logs/lonr.session.log");
 
         for (my $i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) {
             &status('Accepting connections');
             my $client = $server->accept()     or last;
             &sync($command);
-#            print $command ("display2d:false;simp:true;kill(all);\n");
-#	    &getroutput($command,2);
-#            &sync($command);
+            print $command ("library(phpSerialize);\n");
+	    &getroutput($command);
+            &sync($command);
             my $syntaxerr = 0;
             while (my $cmd=<$client>) {
                 &status('Processing command');
@@ -316,11 +316,16 @@ sub make_new_child {
     sub sync {
 	my ($command)=@_;
 	$counter++;
-	my $expect=$counter.time;
-	print $command "$expect;\n";
+        my $digits = length($counter);
+        if ($digits > 10) {
+            $counter = 1;
+        }
+	my $expect=$counter;
+	print $command "print($expect,digits=$digits);\n";
 	while (1) {
 	    my $output=&getroutput($command);
-	    if (($output=~/\Q$expect\E/) || ($output=~/^Error\:/)) {
+            chomp($output);
+	    if (($output=~/^\Q$expect\E/) || ($output=~/^Error\:/)) {
 		return;
 	    }
 	}
@@ -329,7 +334,7 @@ sub make_new_child {
 
 sub getroutput {
     my ($command)=@_;
-    my $regexp = '>';
+    my $regexp = '>\s+$';
     my $syntaxerr=0;
     my $timeout = 20;
     my (undef,$error,$matched,$output) =
@@ -346,13 +351,28 @@ sub getroutput {
 	return 'Error: '.$error;
     }
 
-    my $foundoutput=0;
-    my $found_label=0;
+#
+# Extract data from lines returned by R:
+#   including: (a) indexed output, e.g., line starts with [1] etc. (index excluded)
+#              (b) support for legacy use of &cas("R") to retreve matrix and data.frame
+#                  i.e., unserialized data, in which lines may begin [1,] or 1
+#                  respectively. The approved method for retrieving these types of
+#                  data is to use &cas_hashref(), which uses phpSerialize() to 
+#                  serialize the output (thereby eliminating the need for the second
+#                  regexp in the "elsif" when looping over the lines of output.
+#   excluding: echo of actual (final) expression originally passed to R excluded by 
+#              checking for trailing semicolon. 
+#
+
     my $realoutput='';
     foreach my $line (split(/\n/,$output)) {
-       $line=~s/\s$//gs;
-       if ($line=~/^Error\:/) { $syntaxerr=1; next; }
-       if (my ($result)=($line=~/^\[\d+\,*\]\s*(.*)/)) { $realoutput.=$result."\n"; }
+        $line=~s/\s$//gs;
+        if ($line=~/^Error\:/) { $syntaxerr=1; next; }
+        if (my ($result)=($line=~/^\s*\[\d+\]\s*(.*)/)) {
+            $realoutput.=$result."\n";
+        } elsif (($line !~ /\;$/) && (my ($result)=($line=~/^(?:\[\d+\,\]|\d+)\s*(.*)/))) {
+            $realoutput.=$result."\n";
+        }
     }
     if (wantarray) {
         return ($realoutput,$syntaxerr);