loncom/lonr - diff

Return to lonr CVS log

Up to [LON-CAPA] / loncom

Diff for /loncom/lonr between versions 1.4 and 1.13

version 1.4, 2009/04/18 16:03:14	version 1.13, 2018/12/05 23:02:38
Line 156 my $wwwid=getpwnam('www');	Line 156 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 269 sub make_new_child {	Line 269 sub make_new_child {
};	};

$command->log_stdout(0);	$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++) {	for (my $i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) {
&status('Accepting connections');	&status('Accepting connections');
my $client = $server->accept() or last;	my $client = $server->accept() or last;
&sync($command);	&sync($command);
# print $command ("display2d:false;simp:true;kill(all);\n");	print $command ("library(phpSerialize);\n");
# &getroutput($command,2);	&getroutput($command);
# &sync($command);	&sync($command);
my $syntaxerr = 0;	my $syntaxerr = 0;
while (my $cmd=<$client>) {	while (my $cmd=<$client>) {
&status('Processing command');	&status('Processing command');
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 329 sub make_new_child {	Line 334 sub make_new_child {

sub getroutput {	sub getroutput {
my ($command)=@_;	my ($command)=@_;
my $regexp = '>';	my $regexp = '>\s+$';
my $syntaxerr=0;	my $syntaxerr=0;
my $timeout = 20;	my $timeout = 20;
my (undef,$error,$matched,$output) =	my (undef,$error,$matched,$output) =
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);

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.4
changed lines
	Added in v.1.13