#!/usr/bin/perl # # mboxsend.pl by Davide Libenzi ( deliver mail to mbox files ) # Copyright (C) 2002 Davide Libenzi # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # # Davide Libenzi # use strict; use warnings; my($mboxpath, $LOCK_SH, $LOCK_EX, $LOCK_NB, $LOCK_UN, $ln); $mboxpath = "/var/spool/mail/$ENV{'USER'}"; if ($#ARGV >= 0) { $mboxpath = $ARGV[0]; } $LOCK_SH = 1; $LOCK_EX = 2; $LOCK_NB = 4; $LOCK_UN = 8; $ln = 0; open(MBOX, ">>$mboxpath") || die "Can't open mailbox: $!"; do_flock(); while () { if (/^From /i && $ln > 0) { print MBOX "> "; } print MBOX $_, "\n"; $ln += 1; } do_funlock(); close(MBOX); exit 0; sub do_flock { flock(MBOX, $LOCK_EX); seek(MBOX, 0, 2); } sub do_funlock { flock(MBOX, $LOCK_UN); }