1 files changed, 144 insertions, 0 deletions
diff --git a/previousAttempts/archiveIMAP.pl b/previousAttempts/archiveIMAP.pl
new file mode 100644
index 0000000..a1833de
--- /dev/null
+++ b/previousAttempts/archiveIMAP.pl
@@ -0,0 +1,144 @@
+#!/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;
+	my $sep = $imap->separator($fullfoldername);
+	
+	if ($imaphandle->exists($fullfoldername)) {
+		return 1;
+	}
+	my $parentpath = join ($sep,
+		(split /$sep/,$fullfoldername)[0,-1]
+	); 
+	assureFolder($imaphandle,$parentpath);
+	$imaphandle->create($fullfoldername) or
+		die "Unable to create folder $fullfoldername";
+}
+
+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) {
+		if (!($imap->exists($tFolder))) {
+			# Not sure how would following deal with non-existent
+			# parent folder, so rather recursively create
+			# parents.
+			#
+			#$imap->create($tFolder)
+			#	or die "Could not create $tFolder: $@\n";
+			assureFolder($imap,$tFolder);
+		}
+		$imap->move($tFolder,$targetedMessages{$tFolder});
+	}
+} 
+$imap->close();
+\ No newline at end of file