home *** CD-ROM | disk | FTP | other *** search
/ ftp.cse.unsw.edu.au / 2014.06.ftp.cse.unsw.edu.au.tar / ftp.cse.unsw.edu.au / pub / doc / languages / perl / nutshell / ch6 / nfinger < prev    next >
Encoding:
Text File  |  1992-10-18  |  1.3 KB  |  68 lines
  1. #!/usr/bin/perl
  2.  
  3. # Usage: finger [fingeroptions] [names]
  4.  
  5.     # Bind %ALIAS to the aliases database.
  6.  
  7. dbmopen(ALIAS,'/usr/lib/aliases',undef)
  8.     || die "can't dbmopen aliases";
  9.  
  10.     # Strip finger switches.
  11.  
  12. while ($ARGV[0] =~ /^-/) { 
  13.     push(@fingerargs, shift); 
  14. } 
  15.  
  16.     # Process user names.
  17.  
  18. while ($user = shift) { 
  19.     push(@finger, &resolve($user)); 
  20. }
  21.  
  22.     # Uniquify names.
  23.  
  24. @finger = grep(!$seen{$_}++, @finger);
  25.  
  26.     # And run finger.
  27.  
  28. exec 'finger', @fingerargs, @finger if @finger;
  29.  
  30. die "Couldn't run finger: $!\n";
  31.  
  32. ##############################################################
  33.  
  34. sub resolve {
  35.     local($home,$addr,$alias,@list);
  36.  
  37.     while ($addr = shift) {
  38.     if (defined $ALIAS{$addr."\0"}) {  # In dbm file.
  39.         chop($alias = $ALIAS{$addr."\0"});
  40.     }
  41.     else {
  42.         $home = (getpwnam($addr))[7];
  43.         if (defined($home) && -r "$home/.forward") {
  44.         open(FORWARD,"$home/.forward");
  45.         chop($alias = <FORWARD>);
  46.         close FORWARD;
  47.         }
  48.         else {
  49.         push(@list, $addr);         # Not aliased.
  50.         next;
  51.         } 
  52.     }
  53.  
  54.     $alias =~ s/"\|[^"]*",?//g;
  55.     $alias =~ s/^\s*(.*)\s*$/$1/;
  56.     if ($alias eq '') {             # Oops, only pipes.
  57.         push(@list, $addr);         # So back out alias.
  58.         next;
  59.     }
  60.     $alias =~ s/([^!]*)!(.*)/$2@$1/;  # A uucp addr?
  61.  
  62.     # Now call ourselves recursively.
  63.  
  64.     push(@list,&resolve(split(/[\s,]+/,$alias)));
  65.     } 
  66.     return @list;
  67. }
  68.