home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / perl / scripts-convex / uulock < prev    next >
Encoding:
Text File  |  1990-03-02  |  644 b   |  34 lines
  1. #!/usr/local/bin/perl
  2.  
  3.  
  4. foreach $lock ( </usr/spool/uucp/LCK..*> )  {
  5.     die "no locks\n" if ($lock =~ /\*/);
  6.  
  7.     next if $lock =~ /cua\d+$/;
  8.  
  9.     if (!open(od,"od -d $lock |") ) {
  10.     printf stderr "cannot open od PIPE for %s\n", $lock;
  11.     next;
  12.     } 
  13.  
  14.     $_ = <od>;
  15.     next unless $_;
  16.     chop;
  17.     split;
  18.     $lock =~ s|.*\.\.||;
  19.     $pid = $_[2];
  20.  
  21.     if ( $seen{$pid} ) {
  22.     printf "lock on %s held by %s (already checked pid %d)\n", 
  23.         $lock, $seen{$pid}, $pid;
  24.     next;
  25.     } else {
  26.     $seen{$pid} = $lock;
  27.     } 
  28.  
  29.     printf "lock on %s held by pid %d... checking process status\n", 
  30.     $lock, $pid;
  31.     system "ps u$pid";
  32.     close(od);
  33. } 
  34.