# This script checks a certain account and forwards all new mail
# to a specific address, based on the size of it.
# (< 100 kb = OK)
#
# v0.0 - 04/04/2001 First functional version
# v0.1 - 04/04/2001 Logging function added
# v1.0 - 04/04/2001 Small correction regarding headers 
# v1.1 - 05/04/2001 Cleaned up script and removed various trappings
#                   Program doesn't have any output anymore, save
#                   for the logfiles.

# The script is designed to run with Exchange 5.5 from a Win9x client.
# I have no other way of testing it.

use strict;
use Mail::POP3Client;
use Mail::Sender;

use vars qw($pop $number @msglst @oldlist @newlist);

# odd storage file names
my $last_time_data = 'LASTTIME.DAT';
my $last_time_hash = 'LASTTIME.HSH';

my $debug = 3;

logit ("Session start.");

$pop = Mail::POP3Client->new("username",
                             "password",
                             "mail.server.com",
                             110, );

my $d = $pop->Alive();
if ($d != 1) {
    logit ("Connection failed - End script.");
    exit 0;
    }

logit ("Retrieving mailbox data.");

$number = $pop->Count;
@msglst = $pop->List();

logit ("Messages: $number .");

# not sure of the format, so split may need \s \s+ or / /
# if they are in order
# push @newlist, split(/ /,$element,2)[$[+1]
# might be better
# it seems like its a zero based number as that's how old list works.
foreach my $element(@msglst) {
        my ($left, $right) = split(" ", $element, 2);
        $left  = $left+0;
        $newlist[$left] = $right;
        }

# If an older file exists, open it and get the number of mails present
# last time.

if ( -e $last_time_data) {
   open(DATA,"$last_time_data")
     or die "can't re-open DATA: $last_time_data: $!";
   my $lasttime = <DATA>;
   chomp $lasttime;
   close(DATA);
   logit ("Last time: $lasttime messages.");
} else {
   logit ("No DAT-file present.\nAll messages marked as new.");
}    # if ( -e $last_time_data) 

# Save current number of messages...

open(DATA,">$last_time_data") 
  or die "can't open DATA: $last_time_data: $!";
print DATA "$number";
close(DATA);

# Retrieve the previous message numbers and sizes
# (Assumption is message numbers don't change if nothing is ever alter
+ed)

if ( -e $last_time_hash) {
   open(DATA, "$last_time_hash")
     or die "can't re-open DATA: $last_time_hash: $!";
   while (my $size = <DATA>) {
          chomp $size;
          push @oldlist, $size;
          }
   close(DATA);
   } 

# Now compare the two arrays element-for-element.

my $hit = 0;

for (my $msgnum ; $msgnum <= $number; $msgnum++) {

    # Compare the size of two messages
    if ($newlist[$msgnum] != $oldlist[$msgnum]) {
       # If sizes are different, and new message < 100 kB, then
       # forward it to the other account.

       $hit++;
       print STDERR "Message number $d is new." if $debug > 3;

       my $myheaders = $pop->Head($msgnum);
       my $mymessage = $pop->Body($msgnum);

       # Remove original To: and Cc:-tags (KLUDGE ALERT!)

       $myheaders =~ s/To:(.*)\n//m;
       $myheaders =~ s/Cc:(.*)\n//m;
       
       if (length $mymessage <= 102400) {

           my $sender = new Mail::Sender {smtp => 'mail.server.com', f
+rom => 'administrator@mail.server.com'};

           $sender->MailMsg({to  => 'otheraccount@mail.server.com', he
+aders => "$myheaders",
                             from =>'administrator@mail.server.com',
                             msg => "$mymessage",
                             });

           $sender->Close;

           logit ("Message $msgnum sent.");

           # Yeah, I know, there should be some error trapping here [s
+hrugs]

          } else {
            logit ("Message $msgnum too large");
          }

   }    # if length mymessage <= 102400
}       # for ($d ; $d <= $number; $d++) 

   # No hits on differences, so nop
logit ("No new messages.") unless ($hit);

# Save new list of messages to file.

open(DATA, ">$last_time_hash")
     or die "can't open DATA: $last_time_hash: $!";
foreach my $element (@newlist) {
        if (length $element > 0) {
## this can't be right - is the size always 1 char????
           my $dummy = substr $element,1;
##         my ($dummy) =~ split(/ /, $element);
##         my ($dummy = $element) =~ s/^\s*(\d+)\s+.*/$1/;
##         my ($dummy) = $element =~ /^\s*(\d+)\s+/;
           print DATA "$dummy\n";
           }
        }    # foreach my $element (@newlist) {
close(DATA);

# Explicitly tell the swerver not to delete anything (with Exchange yo
+u
# never know). And it's by the rules, too.

$pop->Reset();

# Close the connection cleanly. 
$pop->Close;

logit("Session closed.");


# ====================================================================
+====
# Subroutine section
#


# Logging sub. Doesn't return anything. Simply logs array to file.

sub logit() {
             my $now = localtime;
             #($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = 
+localtime(time);
             my ($mday,$mon,$year,) = (localtime(time))[3,4,5];
             # $year is no. of years since 1900. Correct it.
             #my $year += 1900;
             # Day is day number in month, base 0. Correct it.
             #my $day  += 1;
             # Month is number of month in year, base 0. Correct it.
             #$mon = sprintf("%02d", $mon  += 1);
             #$mday = sprintf("%02d", $mday);

             # Month is number of month in year, base 0. 
             # $year is no. of years since 1900. 
             my $myfilename = sprintf("USR%02d%02d%4d.LOG", $mday, $mo
+n +1, $year + 1900);

             open(LOG,">>$myfilename")
               or die "can't open LOG $myfilename: $!";
             print LOG $now."\t".$_[0]."\n";
             close(LOG);
            }      #  sub logit
[download]

a

Yep, as you say, I did not use strict - yet. I inserted that into my live code, and guess what ? It broke. I was still testing it, and was planning to post an updated copy, but now I'll just try out your changes first, and see if I understand them. Thank you, and as soon as I have 'polished' the code (or can make it run...) I will update this. Regards, Gertjan