view release on metacpan or  search on metacpan

examples/admin/mail2group  view on Meta::CPAN

#!/usr/bin/perl
#
#	Modigications:
#
#		25.12.1998, Jochen Wiedmann
#			Mails werden nicht mehrfach weitergeleitet;
#			zu diesem Zweck wird ein eigener Header
#			X-Mail2Group eingefuehrt.
#
use strict;
require 5.004;


require Mail::Internet;
require Mail::Util;
require Getopt::Long;
require Time::Local;
require DBI;
require Data::Dumper;
require Symbol;


my $PREFS_FILE = '/home/httpd/html/admin/var/prefs';
my $SPOOL_DIR  = '/var/spool/mail';
my $DBI_DSN    = 'DBI:mysql:user';
my $DBI_USER   = 'nobody';
#my $DBI_PASS   = '';
my $DBI_PASS   = 'my_name_is_nobody';
my $WWW_USER   = 'nobody';
#my $LOCAL_MAILS = '\@euwid\.de\b';
my $LOCAL_MAILS = '';

my %MONTHS = (
    'jan' => 0,
    'feb' => 1,
    'mar' => 2,
    'apr' => 3,
    'may' => 4,
    'jun' => 5,
    'jul' => 6,
    'aug' => 7,
    'sep' => 8,
    'oct' => 9,
    'nov' => 10,
    'dec' => 11
    );


my $options = {
    'dsn' => $DBI_DSN,
    'user' => $DBI_USER,
    'password' => $DBI_PASS,
    'verbose' => 0,
    'debug' => 0
};

Getopt::Long::GetOptions($options, 'dsn=s', 'user=s', 'password=s',
			 'verbose', 'debug');
my $debug = $options->{'debug'};
if ($debug) {
    $options->{'verbose'} = 1;
}
my $verbose = $options->{'verbose'};

my $config = do $PREFS_FILE
    || die "Error while reading prefs file $PREFS_FILE: $@";


if (!$config->{'mail2group'}->{'active'}) { exit 0 }
if (!$config->{'mail2group'}->{'weekend'}) {
    my($sec, $min, $hour, $mday, $mon, $year, $wday) = localtime(time());
    if ($wday == 0  ||  $wday == 6) { exit 0 }
}
my $cache = $config->{'mail2group'}->{'cache'} or {};
foreach my $var (keys %$cache) {
    $cache->{$var} = 0;
}


my $dbh = DBI->connect($options->{'dsn'}, $options->{'user'},
		       $options->{'password'}, { 'RaiseError' => 1 });
END { $dbh->disconnect() if $dbh; undef $dbh }

my $sth = $dbh->prepare("SELECT * FROM USERS");
$sth->execute();
while (my $ref = $sth->fetchrow_hashref()) {
    my $user = $ref->{'USER'};
    my $forward = $ref->{'CUSTOM'};
    if (!$forward) {
	print "Ignoring user $user.\n" if $verbose;
	next;
    }
    my $folder = "$SPOOL_DIR/$user";
    if (! -f $folder  ||  -z _) {
	print "Empty folder of user $user.\n" if ($verbose);
	next;
    }
    my @mails = eval { Mail::Util::read_mbox("$SPOOL_DIR/$user") };
    if ($@) {
	print STDERR "Error while reading folder $folder: $@\n";
	next;
    }
    my $i = 0;
    foreach my $mail (@mails) {
	++$i;
	my $msg = Mail::Internet->new($mail, 'MailFrom' => 'KEEP');
	my $head = $msg->head();
	if ($head->get("X-Mail2Group")) {
	    print "Ignoring mail $i of user $user: Mail2Group header found.\n"
		if ($verbose);
	    next;
	}
	my $local;
	if ($LOCAL_MAILS) {
	    foreach my $address ($head->get("reply-to"),
				 $head->get("from")) {
		if ($address =~ /$LOCAL_MAILS/oi) {
		    $local = $address;
		    last;
		}
	    }
	    if ($local) {
		print "Ignoring mail $i of user $user: Local sender $local.\n"
		    if ($verbose);
		next;
	    }