--- loncom/lonr 2014/10/30 19:09:06 1.7
+++ loncom/lonr 2018/10/29 02:57:30 1.12
@@ -3,7 +3,7 @@
# The LearningOnline Network with CAPA
# Connect to R CAS
#
-# $Id: lonr,v 1.7 2014/10/30 19:09:06 raeburn Exp $
+# $Id: lonr,v 1.12 2018/10/29 02:57:30 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -156,8 +156,8 @@ my $wwwid=getpwnam('www');
if ($wwwid!=$<) {
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.' |".
+ " mailto -s '$subj' $emailto > /dev/null");
exit 1;
}
@@ -316,11 +316,16 @@ sub make_new_child {
sub sync {
my ($command)=@_;
$counter++;
+ my $digits = length($counter);
+ if ($digits > 10) {
+ $counter = 1;
+ }
my $expect=$counter;
- print $command "$expect;\n";
+ 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;
}
}
@@ -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);
500 Internal Server Error
Internal Server Error
The server encountered an internal error or
misconfiguration and was unable to complete
your request.
Please contact the server administrator at
root@localhost to inform them of the time this error occurred,
and the actions you performed just before this error.
More information about this error may be available
in the server error log.