default color: lavender w/red vlinks)
change to: default, lav, whi, gra, ora

Mail-Penguin::Main: Fetch Mail

last updated: Sunday, 24-Jan-1999 02:50:13 EST
[an error occurred while processing this directive]   visit to this page
[ write to Jeff ]

################################################
sub fetch_waiting_mail_if_any {
    local $num;
    local $bodystart;
    local $an_email;
    local $line;
    
	# Using POP3.pm's features, we'll ask the
        # server for a list of our waiting emails.
        # POP3.pm will pass back to us a -reference-
        # to a hash that we'll store in $damail

    print "Sending LIST...\n\n";
    $damail = $pop3->list;  # returns HASH(0x....)

	# Next, a run-limiting switch (that could be
    	# placed in a setup file or at the top of the
	# script).  This is specifically to provide a
    	# control that's useful when Internet's got a
    	# touch of stomach flu and keeps disappearing
        # on us during the retrieval of a large batch
        # of mail, forcing us to start again "from the
        # beginning" at the next polling.
        #
        # On most POP servers, any emails we've said we
        # want to delete will -not- be deleted, unless
        # we also say "goodbye" at the end of a session.
        # When Internet or the server has problems, however,
        # we usually don't get to say "goodbye" and might
        # end up downloading the -same- emails 3 or 4
        # times before things straighten out because of
        # that.
        #
        # Sometimes limiting the number we'll try to
        # retrieve is a good solution to that problem,
        # and the program can be set to re-poll in a very
        # short time, so there's little human-experienced
        # delay incurred by approaching it this way.

    if ($waiting_mail_count > 12) {$waiting_mail_count = 12;}

	# We'll then tell the user at the console which
        # of our waiting emails we're now retrieving

    for ($num = 1; $num <= $waiting_mail_count; $num++)
    {
        print "Getting $num (@$damail{$num} bytes)...";
        $body = "";
        %header = ();
        $bodystart = 0;

    # RETRieve whole message and store to disk. (Note
    # that POP3.pm understands the TOP command, which
    # retrieves message headers without sending the
    # body of the message.  I haven't quite found a
    # use for that, myself, but the capability's there.)
    #
    # POP3.pm returns a -reference- to an array here,
    # the beginning location for an array of message lines.

	        ###$a_top =$pop3->top($num); # full header, without body
        	###print $a_top; # an array reference

	$an_email = $pop3->get($num);

    # Write RETR'd message to sequentially numbered
    # file, and name companion files we'll be using, too.
    # &get_next_file_number will be used also for
    # sequential numbering of local users' mail files, so
    # we'll pass it the work_dir here to make sure it's
    # peering into the right place for what we're doing.

        &get_next_file_number($work_dir_path); # simple sequential number
        $incoming = "$newcount.inc"; # original, as received
        $outgoing = "$newcount.out"; # rewrite, to be sent

		###$topfile = "$newcount.top";

	&queue_incoming; # write original to disk

    # Let the user at the console know we've
    # succeeded to this point in the mission:

	print "saved as $newcount.inc.\n";
        sleep 2;

    # Here using '@$an_email', with both 'at' and
    # 'dollar' signs because it's a hash -reference-; it
    # needs this or a similar form to de-reference it.

        foreach $line (@$an_email)
        {

    # A single period at start of line signals the
    # ending of an email message, so if we've already
    # started receiving the body text and encounter
    # a lonely dot at line-start, we'll discover on
    # 'next' that there are no more lines and we're done.
            
            if ($bodystart == 1)
            {
                $line =~ /^\.\s*$/ or $body .= "$line";
                next;
            }

    # The first blank line in an email signals the end
    # of header info and the start of body text. (We're
    # not saving the blank line to $body here, but
    # we'll make sure $body has one before we're done.)
    #
    # This regex says, "If only special chars from start
    # of line (^) to end of line ($), you've found it."
    
            if ($line =~ /^\s*$/)
            {
                $bodystart = 1;
                next;
            }

    # The 'for' line of the header is sometimes more
    # reliable for delivery purposes than the 'To:' line;
    # 'for' appears usually to contain a properly formed
    # email address enclosed in angle brackets, followed
    # by semicolon, space, and Date information. We'll
    # strip off everything but the address itself, making
    # sure, too, that we grab only the topmost 'for' in
    # case there's more than one, as sometimes occurs.
            
            if (($bodystart == 0) && (!defined $header{"for"}) &&
                ($line =~ /\sfor <(.*)>; .*/))
            {
                $header{"for"} = "$1";
                next;
            }

    # Stash selected header info in @header array while
    # omitting (hopefully) extraneous routing info...
    #
    # (Note: there apparently is something about email
    # header formatting that I'm unaware of.  If so,
    # these next few lines are probably where it makes
    # a non-trivial difference.  Is there a requisite
    # non-visible character at the start of every line
    # of the header?  If so, what is it?)

            if (($bodystart == 0) &&
                ($line =~ /^\s?(From:|To:|Subject:|Date:|
                       MIME-Version:|Content-Type:|
                       CC:|Cc:|cc:|BCC:|Bcc:|bcc:|
                       In-Reply-To:|Content-Transfer-Encoding:|
                       X-Mailer:|Reply-To:) (.*)/))
            {

                $header{$1} = "$2";
            }
        }

    # ...and then analyze and rewrite the header according to
    # 'for', 'To:', 'Cc:', 'Bcc:', and also 'From:' fields

        &redirect; # write rewritten one to disk, and -send-

    # Then DELE this piece of mail from the Pop server.

        print "\nSending DELE...";
        if( $pop3->delete( $num ) ) { print "accepted\n\n"; }
        else { print "not deleted: $_\n\n"; }

    }# end of for ($num = 1; ...

# Say QUIT so Pop server can enter Update mode, delete mails, etc.
# and we close our side of the previously opened connection

    $pop3->quit or die "close: $!";
        
} # end of sub fetch_waiting_mail_if_any

[ back to Main | to sub get_next_file_number ]