--- loncom/lonr 2014/10/30 19:09:06 1.7 +++ 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.7 2014/10/30 19:09:06 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,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);