diff options
Diffstat (limited to 'archiveIMAP.pl')
| -rw-r--r-- | archiveIMAP.pl | 144 |
1 files changed, 0 insertions, 144 deletions
diff --git a/archiveIMAP.pl b/archiveIMAP.pl deleted file mode 100644 index a1833de..0000000 --- a/archiveIMAP.pl +++ /dev/null @@ -1,144 +0,0 @@ -#!/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 |