home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / usenet / altsrcs / 3 / 3377 / from
Encoding:
Text File  |  1991-05-21  |  2.2 KB  |  97 lines
  1. #!/usr/bin/perl
  2.  
  3. # This program requires perl version 3.0, patchlevel 4 or higher
  4.  
  5. # @($)@ from    1.5 - from.pl
  6.  
  7. # Show messages from a Unix mailbox. With -n: shown message numbers also.
  8. #
  9. # Usage "from [-n] MAILBOX..."
  10. #
  11. # Don't forget: perl is a Practical Extract and Report Language!
  12. #
  13. # Copyright 1989,1990 Johan Vromans <jv@mh.nl>, no rights reserved.
  14. # Usage and redistribution is free and encouraged.
  15.  
  16. # Default output format
  17. format =
  18. @<<<<<<<<<<< "@<<<<<<<<<<<<" ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<..
  19. $date,        $from,         $subj
  20. .
  21.  
  22. # Output format when sequence numbers are requested
  23. format format_n =
  24. @>: @<<<<<<<<<<< "@<<<<<<<<<<<<" ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<..
  25. $seq, $date,      $from,         $subj
  26. .
  27.  
  28. # Parse and stash away -n switch, if provided
  29. if ($#ARGV >= 0 && $ARGV[0] eq '-n') {
  30.   shift (@ARGV);
  31.   $~ = "format_n";
  32. }
  33.  
  34. # Use system mailbox if none was specified on the command line
  35. if ( $#ARGV < 0 ) {
  36.   if ( ! ($user = getlogin)) {
  37.     @a = getpwuid($<);
  38.     $user = $a[0];
  39.   }
  40.   if ( -r "/usr/mail/$user" ) {        # System V
  41.     @ARGV = ("/usr/mail/$user");
  42.   }
  43.   elsif ( -r "/usr/spool/mail" ) {    # BSD
  44.     @ARGV = ("/usr/spool/mail/$user");
  45.   }
  46.   else {
  47.     printf STDERR "No mail for $user.\n";
  48.     exit 1;
  49.   }
  50. }
  51.   
  52. $seq = 0;
  53. # Read through input file(s)
  54. while (<>) {
  55.  
  56.   # Look for a "From_" header (See RFC822 and associated documents).
  57.   next unless /^From\s+(\S+)\s+.*(\w{3}\s+\d+\s+\d+:\d+)/;
  58.  
  59.   chop;
  60.   $from = $1;  
  61.   $date = $2;
  62.   if ( $date eq "" || $from eq "" ) {
  63.     print STDERR "Possible garbage: $_\n";
  64.     next;
  65.   }
  66.  
  67.   $seq++;
  68.   # Get user name from uucp path
  69.   $from = $1 if $from =~ /.*!(.+)/;
  70.  
  71.   # Now, scan for Subject or empty line
  72.   $subj = "";
  73.   while ( <> ) {
  74.     chop ($_);
  75.  
  76.     if ( /^$/ || /^From / ) {
  77.       # force fall-though
  78.       $subj = "<none>" unless $subj;
  79.     }
  80.     else {
  81.       $subj = $1 if /^Subject\s*:\s*(.*)/i;
  82.       if ( /^From\s*:\s*/ ) {
  83.         $_ = $';
  84.         if ( /\((.+)\)/i ) { $from = $1; } 
  85.         elsif ( /^\s*(.+)\s*<.+>/i ) { $from = $1; } 
  86.         elsif ( /^<.+>\s*(.+)/i ) { $from = $1; } 
  87.       }
  88.     }
  89.  
  90.     # do we have enough info?
  91.     if ( $from && $subj ) {
  92.       write;
  93.       last;
  94.     }
  95.   }
  96. }
  97.