Newsgroups: fj.lang.perl
Path: galaxy.trc.rwcp.or.jp!coconuts.jaist!wnoc-tyo-news!news.u-tokyo.ac.jp!newssinet!news.ipc.chiba-u!news.tj.chiba-u!asada
From: asada@ics.tj.chiba-u.ac.jp (Takuya Asada)
Subject: Re: [Q] about Perl program
Message-ID: <DBp0ru.JI1@ics.tj.chiba-u.ac.jp>
Sender: usenet@ics.tj.chiba-u.ac.jp
Nntp-Posting-Host: icsj6.tj.chiba-u.ac.jp
Organization: Chiba-University
References: <DBnrL8.H1@ics.tj.chiba-u.ac.jp>
Date: Fri, 14 Jul 1995 06:31:05 GMT
Lines: 67
Xref: galaxy.trc.rwcp.or.jp fj.lang.perl:429
X-originally-archived-at: http://galaxy.rwcp.or.jp/text/cgi-bin/newsarticle2?ng=fj.lang.perl&nb=429&hd=a
X-reformat-date: Mon, 18 Oct 2004 15:18:22 +0900
X-reformat-comment: Tabs were expanded into 4 column tabstops by the Galaxy's archiver. See http://katsu.watanabe.name/ancientfj/galaxy-format.html for more info.

$B$"$5$@$J$N$G$9!#(B

> Mail-from $B%U%#!<%k%I$KF~$C$F$$$k!"$b$H$N(B UNIX From $B9T$r$b$H$KJ,N`(B
> $B$9$k$N$G$7$?$i!"$H$j$"$($:$3$s$J$H$3$G$7$g$&$+!#(B

$BE,Ev$K=q$-$J$0$C$?$i!"7k9=%^%A%,$C$F$^$7$?$G$9!#$4$a$s$J$5$$(B ^^;
$B;H$C$F$k?M$,$$$k$H$b;W$($^$;$s$,!"0l1~D{@5$7$F$*$/$G$9!#(B

> # $* $B$r;XDj$9$k$H!"$b$C$H%(%l%,%s%H$+$b$7$l$^$;$s!#(B

$/ $B$N(B typo $B$G$7$?!"<:Ni!#(B

> $B$G$b!"0lHV$F$C$H$jAa$$2r7hJ}$O!"(Brmail $B$r$d$a$F(B chain-mail $B$"$?$j$K(B
> $B>h$j49$($k$3$H$G$7$g$&(B ^^

VM $B$H$+$b%$%$$H;W$&$G$9(B ^^;

$B$"$5$@(B $B$?$/$d(B

BEGIN -- $BD{@5HG(B ------------------------------------------------------
#!/usr/local/bin/perl

# $B%a!<%k$r<}G<$9$k%G%#%l%/%H%j(B
$MBOX = "$ENV{'HOME'}/RNEWS";
(-d $MBOX) || mkdir($MBOX, 0600) || die $!;

while (<>) {
if (/^\037/) {
(defined $from) || do { undef @buf; next; };
(-f "$MBOX/$from") || &newbox("$MBOX/$from", 0700);
open(F, ">> $MBOX/$from") || die $!;
print F "\f\n";
for (@buf) { print F; }
print F "\037";
undef @buf;
undef $from;
next;
} elsif (/^Mail-from: From (\S+)/) {
$from = $1;

# If there's no Mail-from: field, i'll get it from From: field...
} elsif (!defined($from) && /^From:\s+(.*)/) {
$from = $1;
if ($from =~ /\S+\s+<(\S*)>/) { $from = $1 }
elsif ($from =~ /(\S)+\s+\(\S*\)/) { $from = $1 }
}
push(@buf, $_);
}

sub newbox {
local($fn, $mod) = @_;

open(F, "> $fn") || die $!;
chmod($mod, $fn) || die $!;
print F <<'EOH';
BABYL OPTIONS:
Version: 5
Labels:
Note:   This is the header of an rmail file.
Note:   If you are seeing it in rmail,
Note:    it means the file has no messages in it.
EOH
print F "\037";
close(F) ;
}


