listFolders just works, expireIMAP is in the alpha version.

2 files changed, 118 insertions, 0 deletions

diff --git a/expireIMAP.pl b/expireIMAP.pl
new file mode 100644
index 0000000..153a99f
--- /dev/null
+++ b/expireIMAP.pl
@@ -0,0 +1,95 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Mail::IMAPClient;
+use Data::Dumper;
+use DateTime::Format::Strptime;
+
+my $msg;
+my $hostname = "localhost";
+my $login = "matej";
+my $passwd = "lubdkc";
+
+die "Just one name of the folder, please." unless $#ARGV == 0;
+
+# How many months before today the cut date should be?
+my $howManyMonths = 3;
+
+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 $Strp = new DateTime::Format::Strptime(
+	pattern     => '%a, %d %b %Y %H:%M:%S %z'
+);
+my $StrpNoTZ = new DateTime::Format::Strptime(
+	pattern     => '%a, %d %b %Y %H:%M:%S'
+);
+
+$imap->select($ARGV[0]);
+my $hash = $imap->fetch_hash("INTERNALDATE","FLAGS");
+
+my @flags;
+my $isDeleted;
+my $msgDateStr;
+my $msgDate;
+
+my $cutDate = DateTime->now();
+$cutDate->add( months => -$howManyMonths );
+
+# FIXME: Wrong -- USE $imap->before(RFC2060 date)
+# SEARCH UNDELETED BEFORE 
+foreach $msg (keys(%$hash)) {
+	@flags = $imap->flags($msg);
+	$isDeleted = grep(/\\Deleted/,@flags);
+	if (!$isDeleted) {
+		$msgDateStr = $imap->date($msg);
+		$msgDate = $Strp->parse_datetime($msgDateStr);
+		if (!$msgDate) {
+			$msgDate = $StrpNoTZ->parse_datetime($msgDateStr); 
+		}
+		if (!$msgDate) {
+			next; # TODO: message without Date:
+			      # not sure what to do about it
+			      # Currently just do nothing and let it rot there.
+		}
+		die "WARNING: \$msgDate = $msgDate" if $@;
+
+		if ($msgDate < $cutDate) { 
+			print "Msg $msg with date $msgDate is to be deleted.\n";
+		}
+	}
+}
+
+#	print "\@flags = @flags, \$isDeleted = $isDeleted\n";
+#	$msgID = $imap->get_header($msg,"Message-Id");
+#	print "\$msg ID = $msg\nMESSAGE-ID = $msgID\n";
+#	$headers = $imap->parse_headers($msg,"Date","Received","Subject","To");
+#	print "Headers = " . Data::Dumper->Dumpxs([$headers],['$headers']) . "\n";
+
+## Get a list of messages in the current folder:
+#my @msgs = $imap->messages or die "Could not messages: $@\n";
+## Get a reference to an array of messages in the current folder:
+#my $msgs = $imap->messages or die "Could not messages: $@\n";
+
+#use Mail::IMAPClient;
+#               my $imap = Mail::IMAPClient->new( Server => $imaphost,
+#                                                 User   => $login,
+#                                                 Password=> $pass,
+#                                                 Uid => 1,             # optional
+#               );
+#
+#               $imap->select("World Domination");
+#               # get the flags for every message in my 'World Domination' folder
+#               $flaghash = $imap->flags( scalar($imap->search("ALL"))) ;
+#
+#               # pump through sorted hash keys to print results:
+#               for my $k (sort { $flaghash->{$a} <=> $flaghash->{$b} } keys %$flaghash) {
+#                       # print: Message 1: \Flag1, \Flag2, \Flag3
+#                       print "Message $k:\t",join(", ",@{$flaghash->{$k}}),"\n";
+#               }
diff --git a/listFolders.pl b/listFolders.pl
new file mode 100644
index 0000000..16f26d4
--- /dev/null
+++ b/listFolders.pl
@@ -0,0 +1,23 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Mail::IMAPClient;
+use Data::Dumper;
+
+my $msg;
+my $hostname = "localhost";
+my $login = "matej";
+my $passwd = "lubdkc";
+
+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: $@";
+
+print "\n===============================\n";
+my @folders = $imap->folders;
+print join("\n",@folders),".\n";
\ No newline at end of file