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
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
|
#!/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 = "localhost";
# How many months before today the cut date should be?
my $howManyMonths = 3;
my $debug = 0;
# 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;
}
# makes sure that the folder including its parents
# RFC2060 says in 6.3.3 that server SHOULD create
# parents, so just to be sure if it doesn't.
sub assureFolder {
my $imaphandle = shift;
my $fullfoldername = shift;
if ($imaphandle->exists($fullfoldername)) {
return 1;
}
}
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;
if ($debug) {
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 %targetedMessages;
my ($msgYear,$msgDateStr,$targetFolder);
foreach my $folder (@sourceFolders) {
$imap->select($folder);
die "Cannot select folder $folder\n" if $@;
my @msgsProc = $imap->search(" UNDELETED BEFORE " . $cutDate->strftime("%d-%b-%Y"));
if ($#msgsProc > 0) {
print "Move $#msgsProc in $folder.\n";
foreach my $msg (@msgsProc) {
$msgYear = getMessageYear($imap->date($msg));
if ($msgYear !~ /^\s*$/) {
$targetFolder = getTargetFolder($folder,$msgYear);
if ($debug) {
print "Move message $msg from the folder $folder to $targetFolder.\n";
}
push ( @{ $targetedMessages{$folder} } , $msg);
}
}
}
foreach my $tFolder (keys %targetedMessages) {
# FIXME: check the situation when the parent folder(s) don't exist
# what about different folder separators? (i.e., can we put
# "Archiv/2007/Pratele/PCF" as an argument of $imap->create?)
# RFC says (in 6.3.3) that server SHOULD create parent folders
#
if (!($imap->exists($tFolder))) {
$imap->create($tFolder)
or die "Could not create $tFolder: $@\n";
}
$imap->move($tFolder,$targetedMessages{$tFolder});
}
}
$imap->close();
|
