Seems like the script is almost done. Perl seems to

be really working really well for me! :)

2 files changed, 94 insertions, 0 deletions

diff --git a/.project b/.project
index 0c38634..1538fce 100644
--- a/.project
+++ b/.project
@@ -6,6 +6,11 @@
 	</projects>
 	<buildSpec>
 		<buildCommand>
+			<name>org.python.pydev.PyDevBuilder</name>
+			<arguments>
+			</arguments>
+		</buildCommand>
+		<buildCommand>
 			<name>org.epic.perleditor.perlbuilder</name>
 			<arguments>
 			</arguments>
@@ -13,5 +18,6 @@
 	</buildSpec>
 	<natures>
 		<nature>org.epic.perleditor.perlnature</nature>
+		<nature>org.python.pydev.pythonNature</nature>
 	</natures>
 </projectDescription>
diff --git a/archiveIMAP.pl b/archiveIMAP.pl
new file mode 100644
index 0000000..c432443
--- /dev/null
+++ b/archiveIMAP.pl
@@ -0,0 +1,88 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Mail::IMAPClient;
+use Data::Dumper;
+use DateTime;
+use DateTime::Format::Strptime;
+
+my $hostname = "localhost";
+my $login = "matej";
+my $passwd = "lubdkc";
+
+# How many months before today the cut date should be?
+my $howManyMonths = 3;
+
+my $folder;
+my $msg;
+my $msgYear;
+my $msgDateStr;
+my $targetFolder;
+
+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($msgDateStr); 
+	}
+	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();
+$imap = Mail::IMAPClient->new(
+	Server => $hostname,
+	User => $login,
+	Password => $passwd,
+	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;
+
+LINE: foreach $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 $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();
\ No newline at end of file