home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / perl / tutorial / eg / nw < prev    next >
Encoding:
Text File  |  1990-05-02  |  1.6 KB  |  50 lines
  1. #!/usr/bin/perl
  2. #
  3. # program to merge who and w output to add a whence column.
  4. # for example
  5. #
  6. # % perl nw
  7. #    8:43am  up 13 days, 11:18,  55 users,  load average: 0.93, 0.74, 0.62
  8. #  User     tty     whence     login@  idle   JCPU   PCPU  what
  9. #  bianchi  ttyp0   sherlock  12:50pm 38:56  25:28     21  -ksh
  10. #  daboub   ttyp1   triton    12:56pm 17:57     48      6  -tcsh[daboub]
  11. #  aage     ttyp2   daffy      5:18pm 15:25   7:39   7:39  -tcsh[aage]
  12. #  eharbin  ttyp3   priam      6:34pm    18     47     36  -tcsh[eharbin]
  13. #  feaux    ttyp4   adagio     8:51pm  9:41   2:15      3  gnumacs llib-lc.c
  14. #  eharbin  ttyp6   priam      8:34am     3                -tcsh[eharbin]
  15. #  bianchi  ttyp7   sherlock   5:20pm 46:18      1      1  -ksh
  16. #  watson   ttypa   balihai    8:49am 19:02      6      3  adb -k vmunix mm.core
  17. # (etc)
  18. #
  19.  
  20. $cols = ($ENV{"TERMCAP"} =~ /:co#(\d+):/) ? $1 : 80;
  21.  
  22. $PIPE = "/bin/who|";
  23. open PIPE || die "$0: can't open $PIPE: $!\n";
  24.  
  25. while (<PIPE>) {
  26.     chop; split;
  27.     $users{$_[1]} = $_[0];
  28.     next unless $#_ > 4;
  29.     ( $whence = $_[5] ) =~ s/^\((.*)\)$/\1/;
  30.     $whence =~ s/(.*):.*/$1/;
  31.     $whence =~ s/(................).*/$1/;
  32.     $whence{$_[1]} = $whence;
  33. } 
  34.  
  35. $PIPE = "/usr/ucb/w @ARGV|"; open PIPE || die "$0: can't open $PIPE: $!\n";
  36. $_ = <PIPE>; print;
  37.  
  38. $_ = <PIPE>; 
  39. s/^(.................).(.*)$/$1whence    $2/;
  40. print;
  41.  
  42. while (<PIPE>) {
  43.     chop; split;
  44.     $whence = ($users{$_[1]} eq $_[0]) ? $whence{$_[1]} : "(new login)";
  45.     /(.................).(.*)/;
  46.     $line = sprintf ("%s%-10s%s", $1, $whence, $2);
  47.     eval '$line =~ s/^(' . ('.' x $cols) . ').*/$1/';
  48.     print $line,"\n";
  49. } 
  50.