path: root/archiveIMAP.pl

#!/usr/bin/perl

use strict;
use warnings;
use Mail::IMAPClient;
use IO::Socket::SSL;
use Data::Dumper;
use DateTime;
use DateTime::Format::Strptime;
use Config::IniFiles;

# possible values are currently -- zimbra, localhost, pobox
my $account = "zimbra";

# How many months before today the cut date should be?
my $howManyMonths = 3;

# get configuration for the account
my $conf = new Config::IniFiles ( -file => "/home/matej/.bugzillarc");
die "No configuration for account $account" unless $conf->SectionExists($account);
my $hostname = $conf->val($account,'host');
my $login = $conf->val($account,'name');
my $password = $conf->val($account,'password');
my $ssl= $conf->val($account,'ssl');

sub getTargetFolder {
	my $source = shift;
	my $year = shift;
	
	$source =~ s/^\/*(.*)\/*$/$1/;
	return "/INBOX/Archiv/" . $year . '/' . $source; 
}

our $Strp = new DateTime::Format::Strptime(
	pattern     => '%a, %d %b %Y %H:%M:%S %z'
);
our $StrpNoTZ = new DateTime::Format::Strptime(
	pattern     => '%a, %d %b %Y %H:%M:%S'
);

sub getMessageYear {
	my $msgStr = shift;
	my $msgDt = $Strp->parse_datetime($msgStr);

	if (!$msgDt) {
			$msgDt = $StrpNoTZ->parse_datetime($msgStr); 
	}
	if (!$msgDt) {
		print "Date EMPTY.\n";
		return ""; # TODO: message without Date:
				   # not sure what to do about it
		      	   # Currently just do nothing and
		      	   # return empty string.
		}
	my $year = $msgDt->year;
	print "\$msgStr = $msgStr, \$msgDt = $msgDt, year = $year\n";
		
	return $year;
}

my $imap = Mail::IMAPClient->new();
if ($ssl) {
	my $sslSocket=new IO::Socket::SSL("$hostname:imaps");
	die ("Error connecting - $@") unless defined $sslSocket;
	$sslSocket->autoflush(1);
	
	$imap = Mail::IMAPClient->new(
		Server => $hostname,
		Socket => $sslSocket,
		User => $login,
		Debug => 1,
		Password => $password,
		UID => 1
	) or die "Cannot connect to localhost as matej: $@";
} else {
	$imap = Mail::IMAPClient->new(
		Server => $hostname,
		User => $login,
		Debug => 1,
		Password => $password,
		UID => 1
	) or die "Cannot connect to localhost as matej: $@";	
}

my $cutDate = DateTime->now();
$cutDate->add( months => -$howManyMonths );

my @sourceFolders = grep(!/^INBOX\/Archiv/,$imap->folders());
my $msgDateInStr;
my $msgYear;
my $msgDateStr;
my $targetFolder;

foreach my $folder (@sourceFolders) {
	$imap->select($folder);
	my @msgsProc = $imap->search(" UNDELETED BEFORE " . $cutDate->strftime("%d-%b-%Y"));
	if ($#msgsProc > 0) {
		print "Move $#msgsProc in $folder.\n";
		foreach my $msg (@msgsProc) {
			$msgDateInStr = $imap->date($msg);
			$msgYear = getMessageYear($msgDateInStr);
			if ($msgYear !~ /^\s*$/) {
				$targetFolder = getTargetFolder($folder,$msgYear);
				print "Move message $msg from the folder $folder to $targetFolder.\n"; 
				#$imap->move($targetFolder,$msg);				
			}
		}
	}
}
$imap->close();