version 1.7, 2014/10/30 19:09:06
|
version 1.14, 2024/06/22 14:29:36
|
Line 154 $SIG{USR1} = \&child_announce_death;
|
Line 154 $SIG{USR1} = \&child_announce_death;
|
# ----------------------------- Make sure this process is running from user=www |
# ----------------------------- Make sure this process is running from user=www |
my $wwwid=getpwnam('www'); |
my $wwwid=getpwnam('www'); |
if ($wwwid!=$<) { |
if ($wwwid!=$<) { |
my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}"; |
my $emailto="$perlvar{'lonAdmEMail'} $perlvar{'lonSysEMail'}"; |
my $subj="LON: User ID mismatch"; |
my $subj="LON: User ID mismatch"; |
system("echo 'User ID mismatch. lonr must be run as user www.' |\ |
system("echo 'User ID mismatch. lonr must be run as user www.' |". |
mailto $emailto -s '$subj' > /dev/null"); |
" mail -s '$subj' $emailto > /dev/null"); |
exit 1; |
exit 1; |
} |
} |
|
|
Line 316 sub make_new_child {
|
Line 316 sub make_new_child {
|
sub sync { |
sub sync { |
my ($command)=@_; |
my ($command)=@_; |
$counter++; |
$counter++; |
|
my $digits = length($counter); |
|
if ($digits > 10) { |
|
$counter = 1; |
|
} |
my $expect=$counter; |
my $expect=$counter; |
print $command "$expect;\n"; |
print $command "print($expect,digits=$digits);\n"; |
while (1) { |
while (1) { |
my $output=&getroutput($command); |
my $output=&getroutput($command); |
if (($output=~/\Q$expect\E/) || ($output=~/^Error\:/)) { |
chomp($output); |
|
if (($output=~/^\Q$expect\E/) || ($output=~/^Error\:/)) { |
return; |
return; |
} |
} |
} |
} |
Line 346 sub getroutput {
|
Line 351 sub getroutput {
|
return 'Error: '.$error; |
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=''; |
my $realoutput=''; |
foreach my $line (split(/\n/,$output)) { |
foreach my $line (split(/\n/,$output)) { |
$line=~s/\s$//gs; |
$line=~s/\s$//gs; |
if ($line=~/^Error\:/) { $syntaxerr=1; next; } |
if ($line=~/^Error\:/) { $syntaxerr=1; next; } |
if (my ($result)=($line=~/^\[?\d+\,*\]?\s*(.*)/)) { $realoutput.=$result."\n"; } |
if (my ($result)=($line=~/^\s*\[\d+\]\s*(.*)/)) { |
|
$realoutput.=$result."\n"; |
|
} elsif (($line !~ /\;$/) && (my ($result)=($line=~/^(?:\[\d+\,\]|\d+)\s*(.*)/))) { |
|
$realoutput.=$result."\n"; |
|
} |
} |
} |
if (wantarray) { |
if (wantarray) { |
return ($realoutput,$syntaxerr); |
return ($realoutput,$syntaxerr); |