home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / usenet / altsrcs / 3 / 3397 < prev    next >
Encoding:
Internet Message Format  |  1991-05-22  |  4.0 KB
  1. From: gamin@ireq-robot.hydro.qc.ca (Martin Boyer)
  2. Newsgroups: comp.lang.perl,alt.sources
  3. Subject: Re: perl version of from(1)
  4. Message-ID: <GAMIN.91May21172212@pellan.ireq-robot.hydro.qc.ca>
  5. Date: 21 May 91 21:22:12 GMT
  6.     d'Hydro-Quebec
  7. Lines: 150
  8.  
  9. jv@mh.nl (Johan Vromans) writes:
  10.  
  11.    > From: subbarao@phoenix.Princeton.EDU (Kartik Subbarao)
  12.    > Subject: perl version of from(1)
  13.    > Date: 19 May 91 23:54:24 GMT
  14.    > Organization: American Chemical Society
  15.  
  16.    > Anyone know of a cooler way to do this?
  17.  
  18.    Depends on what you call 'cool'    :-) .
  19.  
  20.    [shar of from.pl 1.5 deleted]
  21.  
  22. Here's my version modified to:
  23.  
  24.     handle multiple mailboxes (default is $HOME/INBOX, created by vm)
  25.     reset message counter for each mailbox
  26.     test for presence of mailbox instead of spool directory in BSD systems
  27.  
  28.  
  29. #!/usr/bin/perl
  30. #----Le laboratoire de robotique de l'Institut de recherche d'Hydro-Quebec-----
  31. # 
  32. # Nom     : from [-n] [MAILBOX] [MAILBOX...]
  33. # Fonction: Imprime un sommaire de la boite postale,
  34. #        avec -n, imprime les numeros de message aussi.
  35. # Fichiers: from, /usr/spool/mail, ~/INBOX
  36. # Notes   : Requiert perl version 3.0, patchlevel 4 ou mieux.
  37. # 
  38. # Cree    :    1989  ------------ Johan Vromans <jv@mh.nl>
  39. # Modifie : 21 mai 91 ---------1- Martin Boyer <mboyer@ireq-robot.hydro.qc.ca>
  40. #        Copyright 1989, 1990 Johan Vromans <jv@mh.nl>, no rights reserved.
  41. # 
  42. # Historique: 
  43. # 
  44. # 21 mai 91 ---------1- Martin Boyer <mboyer@ireq-robot.hydro.qc.ca>
  45. #     Modifie la version 1.5 de Johan Vromans: ajoute INBOX
  46. #     et remis le compteur de message a zero pour chaque fichier.
  47. #------------------------------------------------------------------------------
  48.  
  49. $inbox = "$ENV{'HOME'}/INBOX";
  50.  
  51. # Default output format
  52. format =
  53. @<<<<<<<<<<< "@<<<<<<<<<<<<" ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<..
  54. $date,        $from,         $subj
  55. .
  56.  
  57. # Output format when sequence numbers are requested
  58. format format_n =
  59. @>: @<<<<<<<<<<< "@<<<<<<<<<<<<" ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<..
  60. $seq, $date,      $from,         $subj
  61. .
  62.  
  63. # Parse and stash away -n switch, if provided
  64. if ($#ARGV >= 0 && $ARGV[0] eq '-n') {
  65.   shift (@ARGV);
  66.   $~ = "format_n";
  67. }
  68.  
  69. # Use system mailbox and user INBOX 
  70. # if none was specified on the command line
  71. if ( $#ARGV < 0 ) {
  72.     if ( ! ($user = getlogin)) {
  73.     @a = getpwuid($<);
  74.     $user = $a[0];
  75.     }
  76.     if ( -r "/usr/mail/$user" ) {        # System V
  77.     @ARGV = ("/usr/mail/$user");
  78.     }
  79.     elsif ( -r "/usr/spool/mail/$user" ) {  # BSD
  80.     @ARGV = ("/usr/spool/mail/$user");
  81.     }
  82.     if ( $inbox && -r $inbox ) {
  83.     @ARGV = ($inbox, @ARGV);
  84.     }
  85.     if ($#ARGV < 0)  {
  86.     printf STDERR "No mail for $user.\n";
  87.     exit 1;
  88.     }
  89. }
  90. if ( $#ARGV < 0 ) {
  91.   if ( ! ($user = getlogin)) {
  92.     @a = getpwuid($<);
  93.     $user = $a[0];
  94.   }
  95.   if ( -r "/usr/mail/$user" ) {        
  96.     @ARGV = ("/usr/mail/$user");
  97.   }
  98.   elsif ( -r "/usr/spool/mail/$user" ) {    # BSD
  99.     @ARGV = ("/usr/spool/mail/$user");
  100.   }
  101.   else {
  102.     printf STDERR "No mail for $user.\n";
  103.     exit 1;
  104.   }
  105. }
  106.   
  107. # Read through input file(s)
  108. while (<>) {
  109.  
  110.   if (eof) {$seq = 0;}
  111.  
  112.   # Look for a "From_" header (See RFC822 and associated documents).
  113.   next unless /^From\s+(\S+)\s+.*(\w{3}\s+\d+\s+\d+:\d+)/;
  114.  
  115.   chop;
  116.   $from = $1;  
  117.   $date = $2;
  118.   if ( $date eq "" || $from eq "" ) {
  119.     print STDERR "Possible garbage: $_\n";
  120.     next;
  121.   }
  122.  
  123.   $seq++;
  124.   # Get user name from uucp path
  125.   $from = $1 if $from =~ /.*!(.+)/;
  126.  
  127.   # Now, scan for Subject or empty line
  128.   $subj = "";
  129.   while ( <> ) {
  130.     chop ($_);
  131.  
  132.     if ( /^$/ || /^From / ) {
  133.       # force fall-though
  134.       $subj = "<none>" unless $subj;
  135.     }
  136.     else {
  137.       $subj = $1 if /^Subject\s*:\s*(.*)/i;
  138.       if ( /^From\s*:\s*/ ) {
  139.         $_ = $';
  140.         if ( /\((.+)\)/i ) { $from = $1; } 
  141.         elsif ( /^\s*(.+)\s*<.+>/i ) { $from = $1; } 
  142.         elsif ( /^<.+>\s*(.+)/i ) { $from = $1; } 
  143.       }
  144.     }
  145.  
  146.     # do we have enough info?
  147.     if ( $from && $subj ) {
  148.       write;
  149.       last;
  150.     }
  151.   }
  152. }
  153.  
  154. --
  155. Martin Boyer                            mboyer@ireq-robot.hydro.qc.ca
  156. Institut de recherche d'Hydro-Quebec    mboyer@ireq-robot.uucp
  157. Varennes, QC, Canada   J3X 1S1
  158. +1 514 652-8412
  159.