Diff for /loncom/lond between versions 1.171 and 1.175

version 1.171, 2004/01/14 01:08:31 version 1.175, 2004/02/17 20:07:25
Line 817  my $children               = 0;        # Line 817  my $children               = 0;        #
 sub REAPER {                        # takes care of dead children  sub REAPER {                        # takes care of dead children
     $SIG{CHLD} = \&REAPER;      $SIG{CHLD} = \&REAPER;
     &status("Handling child death");      &status("Handling child death");
     my $pid = wait;      my $pid;
     if (defined($children{$pid})) {      do {
  &logthis("Child $pid died");   $pid = waitpid(-1,&WNOHANG());
  $children --;   if (defined($children{$pid})) {
  delete $children{$pid};      &logthis("Child $pid died");
     } else {      $children --;
  &logthis("Unknown Child $pid died");      delete $children{$pid};
     }   } else {
       &logthis("Unknown Child $pid died");
    }
       } while ( $pid > 0 );
     &status("Finished Handling child death");      &status("Finished Handling child death");
 }  }
   
Line 1020  sub logstatus { Line 1023  sub logstatus {
     my $docdir=$perlvar{'lonDocRoot'};      my $docdir=$perlvar{'lonDocRoot'};
     {      {
     my $fh=IO::File->new(">>$docdir/lon-status/londstatus.txt");      my $fh=IO::File->new(">>$docdir/lon-status/londstatus.txt");
     print $fh $$."\t".$currenthostid."\t".$status."\t".$lastlog."\n";      print $fh $$."\t".$clientname."\t".$currenthostid."\t".$status."\t".$lastlog."\n";
     $fh->close();      $fh->close();
     }      }
     &status("Finished londstatus.txt");      &status("Finished londstatus.txt");
Line 2213  sub make_new_child { Line 2216  sub make_new_child {
  my %hash;   my %hash;
  if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) {   if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) {
     foreach my $key (@keys) {      foreach my $key (@keys) {
  delete($hash{&unescape($key)});   delete($hash{$key});
     }      }
     if (untie(%hash)) {      if (untie(%hash)) {
  print $client "ok\n";   print $client "ok\n";
Line 2724  sub make_new_child { Line 2727  sub make_new_child {
 # -------------------------------------------------------------------------- ls  # -------------------------------------------------------------------------- ls
  } elsif ($userinput =~ /^ls/) {   } elsif ($userinput =~ /^ls/) {
     if(isClient) {      if(isClient) {
    my $obs;
    my $rights;
  my ($cmd,$ulsdir)=split(/:/,$userinput);   my ($cmd,$ulsdir)=split(/:/,$userinput);
  my $ulsout='';   my $ulsout='';
  my $ulsfn;   my $ulsfn;
Line 2731  sub make_new_child { Line 2736  sub make_new_child {
     if(-d $ulsdir) {      if(-d $ulsdir) {
  if (opendir(LSDIR,$ulsdir)) {   if (opendir(LSDIR,$ulsdir)) {
     while ($ulsfn=readdir(LSDIR)) {      while ($ulsfn=readdir(LSDIR)) {
    undef $obs, $rights; 
  my @ulsstats=stat($ulsdir.'/'.$ulsfn);   my @ulsstats=stat($ulsdir.'/'.$ulsfn);
  $ulsout.=$ulsfn.'&'.   #We do some obsolete checking here
     join('&',@ulsstats).':';   if(-e $ulsdir.'/'.$ulsfn.".meta") { 
       open(FILE, $ulsdir.'/'.$ulsfn.".meta");
       my @obsolete=<FILE>;
       foreach my $obsolete (@obsolete) {
           if($obsolete =~ m|(<obsolete>)(on)|) { $obs = 1; } 
    if($obsolete =~ m|(<copyright>)(default)|) { $rights = 1; }
       }
    }
    $ulsout.=$ulsfn.'&'.join('&',@ulsstats);
    if($obs eq '1') { $ulsout.="&1"; }
    else { $ulsout.="&0"; }
    if($rights eq '1') { $ulsout.="&1:"; }
    else { $ulsout.="&0:"; }
     }      }
     closedir(LSDIR);      closedir(LSDIR);
  }   }

Removed from v.1.171  
changed lines
  Added in v.1.175


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