jv@mh.nl (Johan Vromans) (01/06/90)
A number of people have asked me for a (re)post of the perl 'from' program. So here is a new version of it. I added an optional -n switch to show message numbers, to use with Elm's 'readmsg' program. Have fun, Johan >>> Note this article is being cross-posted to alt.sources. Please >>> followup to alt.sources.d for bugs and remarks, and to >>> comp.lang.perl for perl related topics. ------ begin of from.pl -- ascii -- complete ------ #!/usr/bin/perl # This program requires perl version 3.0, patchlevel 4 or higher # @($)@ from 1.5 - from.pl # Show messages from a Unix mailbox. With -n: shown message numbers also. # # Usage "from [-n] MAILBOX..." # # Don't forget: perl is a Practical Extract and Report Language! # # Copyright 1989,1990 Johan Vromans <jv@mh.nl>, no rights reserved. # Usage and redistribution is free and encouraged. # Default output format format = @<<<<<<<<<<< "@<<<<<<<<<<<<" ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<.. $date, $from, $subj . # Output format when sequence numbers are requested format format_n = @>: @<<<<<<<<<<< "@<<<<<<<<<<<<" ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<.. $seq, $date, $from, $subj . # Parse and stash away -n switch, if provided if ($#ARGV >= 0 && $ARGV[0] eq '-n') { shift (@ARGV); $~ = "format_n"; } # Use system mailbox if none was specified on the command line if ( $#ARGV < 0 ) { if ( ! ($user = getlogin)) { @a = getpwuid($<); $user = $a[0]; } if ( -r "/usr/mail/$user" ) { # System V @ARGV = ("/usr/mail/$user"); } elsif ( -r "/usr/spool/mail" ) { # BSD @ARGV = ("/usr/spool/mail/$user"); } else { printf STDERR "No mail for $user.\n"; exit 1; } } $seq = 0; # Read through input file(s) while (<>) { # Look for a "From_" header (See RFC822 and associated documents). next unless /^From\s+(\S+)\s+.*(\w{3}\s+\d+\s+\d+:\d+)/; chop; $from = $1; $date = $2; if ( $date eq "" || $from eq "" ) { print STDERR "Possible garbage: $_\n"; next; } $seq++; # Get user name from uucp path $from = $1 if $from =~ /.*!(.+)/; # Now, scan for Subject or empty line $subj = ""; while ( <> ) { chop ($_); if ( /^$/ || /^From / ) { # force fall-though $subj = "<none>" unless $subj; } else { $subj = $1 if /^Subject\s*:\s*(.*)/i; if ( /^From\s*:\s*/ ) { $_ = $'; if ( /\((.+)\)/i ) { $from = $1; } elsif ( /^\s*(.+)\s*<.+>/i ) { $from = $1; } elsif ( /^<.+>\s*(.+)/i ) { $from = $1; } } } # do we have enough info? if ( $from && $subj ) { write; last; } } } ------ end of from.pl -- ascii -- complete ------ -- Johan Vromans jv@mh.nl via internet backbones Multihouse Automatisering bv uucp: ..!{uunet,hp4nl}!mh.nl!jv Doesburgweg 7, 2803 PL Gouda, The Netherlands phone/fax: +31 1820 62944/62500 ------------------------ "Arms are made for hugging" -------------------------