aboutsummaryrefslogtreecommitdiffstats
path: root/archiveIMAP.pl
blob: a33cf23658813eabe42307b9dd876ba96ebfb09d (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
#!/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;
my $debug = 1;

# get configuration for the account
my $conf = Config::IniFiles->new( -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=IO::Socket::SSL->new("$hostname:imaps");
	die ("Error connecting - $@") unless defined $sslSocket;
	$sslSocket->autoflush(1);
	
	$imap = Mail::IMAPClient->new(
		Server => $hostname,
		Socket => $sslSocket,
		User => $login,
		Debug => $debug,
		Password => $password,
		UID => 1
	) or die "Cannot connect to localhost as matej: $@";
} else {
	$imap = Mail::IMAPClient->new(
		Server => $hostname,
		User => $login,
		Debug => $debug,
		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();