Memory problem

[uksza]

Wise Monks

I've got memory problem with my code.
But first descritpion:
I have mbox make by bcc_all with mails. I need sort this mbox to mboxes every user in our domain, i.e:
if user [e-mail] send to somebody - mail should go to abc mbox.
if user [e-mail] send mail to [e-mail] - mail should go to bcd mbox.
if user [e-mail] send mail to [e-mail], [e-mail] and [e-mail] mail should go to mboxes abc, bcd, cde.
if we have some mails not from/to users from our domains - we don't do anything.

This is my code:

#!/usr/bin/perl
use strict;
use warnings;
use File::Basename;
use Mail::Box::Manager;

### configuration ###
my @our_domain = qw /mydomain.com mail.mydomain.com/;
my $copymail     = '/home/uksza/m/copymails';
###################

### subs ###
sub compress;        #zip mail to zip-malibox
sub change_name;     #add date to name
############

my $mbm      = Mail::Box::Manager->new;
my $mbm_do   = Mail::Box::Manager->new;

my $mbox_cm = $mbm->open( folder => $copymail, access => 'rw' )
  or die "Can't open $!";
my @all = $mbox_cm->messages;
my $counter;

foreach my $mail (@all) {
    #print for tests
    print $counter++ . "/$#all\n";
    my @senders  = $mail->from;
    my @recipients = $mail->destinations;

    #@senders = push @senders, @recipients; # - DOES'N WORK :-(
    save( $mail, @senders );
    save( $mail, @recipients );
}

#compress rest in start mbox
$mbm->close($mbox_cm) or die "Can't close $mbox_cm";
compress( basename($copymail) );

#########################################

sub save {
    my $mail  = shift;
    my @persons = @_;
    foreach my $person (@persons) {
        #users without hostname
        next if ( !$person->host );

        #user not from our domains
        next unless ( grep { $person->host eq $_ } @our_domain );

        my $name     = lc $person->user;
        my $mails_to =
          $mbm_do->open( folder => "./$name", create => 1, access => '
+a' )
          or die "Can't work on mbox $name. $!";
        $mbm->moveMessage( $mails_to, $mail ) or die "Moving problem $
+!";
        $mbm_do->close($mails_to) or die "Close problem  $!";
        compress($name);
    }
}

#for archive on CD 
sub compress {
    my $box      = shift;
    my $wyj      = `gzip -c "$box" >> "$box.gz"`;
    change_name("$box.gz") if @{ [ stat("$box.gz") ] }[7] > 1024 * 102
+5*640 ;
    unlink $box or die "Unlink error. $!";
}

#add _rrr-mm-dd to file name
sub change_name {
    my $name       = shift;
    my $year       = @{ [localtime] }[5] + 1900;
    my $month      = @{ [localtime] }[4] + 1;
    my $day        = @{ [localtime] }[3];
    my $data       = sprintf "_%4d-%02d-%02d.gz", $year, $month, $day;
    my $new_name  = $name. $data;
    rename $name, $new_name;
}

Generally it works good (litle problem with bad spam mailadresses, but who cares), but it eat tons of my memory like kid icecreams (on bcc_mbox about 180MB (1300 mails) 256MB ram and 500mb swap is sometimes too less).
Can you show me where I made mistake?

Thanx, brothers and sisters,
Yours Lukasz

[ruoso]

First of all, the correct way of concatenating the arrays would be:

my @persons = (@senders, @recipients);

I don't know the module Mail::Box::Manager a lot, but it seems to be using mbox files for managing the mail. This requires that the entire mbox file to be read and parsed to search the emails, and then writing an enormous mbox file again.

I'd like to suggest you to change from mbox to maildir, so your script won't have to parse a giant file, which is probably the reason for the memory eating...

[ides]

You'll want to look at doing delayed loading of the message bodies when you do your folder opens. Based on the docs I believe it should be:

 
my $mbox_cm = $mbm->open( folder => $copymail, access => 'rw', 
                          body_delayed_type => 'Mail::Message::Body::D
+elayed')

Hope this helps.

[stonecolddevin]

I can't help you with your mail problem, I haven't worked a whole lot with perl + mail.
However with  @senders = push @sender, @recipients;, you could use   @senders = push @sender, $_ for @recipients;
That should work :-)

[chb]

The return value of push is the number of elements in the array (perldoc -f push), so a scalar is assigned to the list @senders. If you want to add the recipients to the senders, try @senders = (@senders, @recipients). The two lists will be flattened. BTW @sender (note the missing 's') in the code looks like a typo waiting for its comment sign to be removed.