[BACK]Return to lonr CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom

Diff for /loncom/lonr between versions 1.2 and 1.14

version 1.2, 2009/04/17 00:34:46 version 1.14, 2024/06/22 14:29:36
Line 1 Line 1
 #!/usr/bin/perl  #!/usr/bin/perl
 #  #
 # The LearningOnline Network with CAPA  # The LearningOnline Network with CAPA
 # Connect to MAXIMA CAS  # Connect to R CAS
 #  #
 # $Id$  # $Id$
 #  #
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 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 $expect=$counter.time;          my $digits = length($counter);
  print $command "$expect;\n";          if ($digits > 10) {
               $counter = 1;
           }
    my $expect=$counter;
    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);
Removed from v.1.2  
changed lines
  Added in v.1.14

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