--- loncom/lonr 2014/11/13 20:09:08 1.8 +++ loncom/lonr 2018/12/05 23:02:38 1.13 @@ -3,7 +3,7 @@ # The LearningOnline Network with CAPA # Connect to R CAS # -# $Id: lonr,v 1.8 2014/11/13 20:09:08 raeburn Exp $ +# $Id: lonr,v 1.13 2018/12/05 23:02:38 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.' |". + " mail -s '$subj' $emailto > /dev/null"); exit 1; } @@ -316,12 +316,12 @@ sub make_new_child { sub sync { my ($command)=@_; $counter++; - my $expect=$counter; - if (length($expect) > 10) { + my $digits = length($counter); + if ($digits > 10) { $counter = 1; - $expect = $counter; } - print $command "print($expect,digits=10);\n"; + my $expect=$counter; + print $command "print($expect,digits=$digits);\n"; while (1) { my $output=&getroutput($command); chomp($output); @@ -351,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=~/^\s*\[\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);