Diff for /loncom/lonr between versions 1.5 and 1.8

version 1.5, 2009/04/18 23:43:47 version 1.8, 2014/11/13 20:09:08
Line 275  sub make_new_child { Line 275  sub make_new_child {
             &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 317  sub make_new_child { Line 317  sub make_new_child {
  my ($command)=@_;   my ($command)=@_;
  $counter++;   $counter++;
  my $expect=$counter;   my $expect=$counter;
  print $command "$expect;\n";          if (length($expect) > 10) {
               $counter = 1;
               $expect = $counter;
           }
    print $command "print($expect,digits=10);\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 352  sub getroutput { Line 357  sub getroutput {
     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"; }
     }      }
     if (wantarray) {      if (wantarray) {
         return ($realoutput,$syntaxerr);          return ($realoutput,$syntaxerr);

Removed from v.1.5  
changed lines
  Added in v.1.8


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