#!/usr/local/bin/perl

use strict;
use Mail::vpopmail;

my @users = qw/user1@example.com user2@example.com/;
my $DEBUG=1;
my $TESTMODE=1;


my($vuid,$vgid) = (getpwnam('vpopmail'))[2,3];

my $vchkpw = Mail::vpopmail->new( cache => 1,
                                  debug => $DEBUG,
                                );
foreach my $email (@users) {
    my($user,$domain) = split(/\@/, $email);
    my $maildir = $vchkpw->userinfo(email => $email, field => 'maildir') . '/Maildir';

    if(opendir(DIR, $maildir)){
        debug( "working in $maildir" );
        foreach my $subdir (grep {/^\.[a-zA-Z0-9\-]/} readdir DIR){
            # never touch the Archives or Drafts
            next if($subdir =~ /^\.Drafts/);
            next if($subdir =~ /^\.Saved/);
            next if($subdir =~ /^\.Templates/);

            if(opendir(SUBDIR, "$maildir/$subdir/cur/")){
                foreach my $file (grep {!/^\./} readdir SUBDIR){
                    my $ftime = (stat("${maildir}/${subdir}/cur/${file}"))[9];
                    my $delta = ($^T - $ftime);

                    if($subdir eq '.Trash' || $subdir eq '.Sent'){
                        # we archive these items, not delete
                        if($delta > 2592000){ # older than 30 days
                            unless(-d "${maildir}/${subdir}.Archive/cur"){
                                system("/var/qmail/bin/maildirmake ${maildir}/${subdir}.Archive");
                                system("/usr/bin/chown -R $vuid:$vgid ${maildir}/${subdir}.Archive");
                            }
                            debug( "moving ${subdir}/cur/${file} into ${subdir}.Archive" );
                            unless($TESTMODE){
                                rename("${maildir}/${subdir}/cur/${file}","${maildir}/${subdir}.Archive/cur/${file}") ||
                                 debug( "could not rename ${maildir}/${subdir}/cur/${file}: $!" );
                            }
                        }
                    }elsif($subdir =~ /^\.(?:Trash|Sent)\.Archive/){
                        # never touch archived years
                        next if($subdir =~ /\.Archive\.\d{4}$/);

                        # we sub-archive the main archive per year.
                        my ($mday,$year) = (localtime())[3,5];
                        
                        #next if($mday);

                        $year += 1900;
                        my ($fyear) = (localtime($ftime))[5];
                        $fyear += 1900;

                        # leave current year's stuff alone in Archive
                        if($fyear != $year){
                            debug( "moving ${subdir}/cur/${file} into ${subdir}.${fyear}" );
                            unless(-d "${maildir}/${subdir}.${fyear}/cur"){
                                system("/var/qmail/bin/maildirmake ${maildir}/${subdir}.${fyear}");
                                system("/usr/bin/chown -R $vuid:$vgid ${maildir}/${subdir}.${fyear}");
                            }
                            unless($TESTMODE){
                                rename("${maildir}/${subdir}/cur/${file}","${maildir}/${subdir}.${fyear}/cur/${file}") ||
                                 debug( "could not rename ${maildir}/${subdir}/cur/${file}: $!" );
                            }
                            
                        }
                    }else{
                        # we delete these items
                        if($delta > 1209600){ # older than 2 weeks
                            debug( "removing ${subdir}/cur/${file}" );
                            unlink("${maildir}/${subdir}/cur/${file}") unless($TESTMODE);
                        }
                    }
                }
                closedir SUBDIR;
            }else{
                warn "cannot open ${maildir}/${subdir}/cur/: $!\n";
            }
        }
        closedir DIR;
    }else{
        warn "cannot open $maildir: $!\n";
    }
}

sub debug {
    my $msg = join(' ', @_);
    
    warn "$msg\n" if($DEBUG);
}