#!/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;
}
[download]