14 |
rodolico |
1 |
#! /usr/bin/perl -w
|
|
|
2 |
|
|
|
3 |
# archiveIMAP: moves old messages from one IMAP account to another
|
|
|
4 |
# maintaining hierarchy.
|
|
|
5 |
# see http://wiki.linuxservertech.com for additional information
|
|
|
6 |
# Copyright (C) 2014 R. W. Rodolico
|
|
|
7 |
#
|
|
|
8 |
# version 1.0, 20140818
|
|
|
9 |
# Initial Release
|
|
|
10 |
#
|
|
|
11 |
# version 1.0.1 20140819
|
|
|
12 |
# Removed dependancy on Email::Simple
|
|
|
13 |
# Allowed 'separator' as an element in either source or target
|
|
|
14 |
#
|
50 |
rodolico |
15 |
# version 2.0.0 20190817 RWR
|
|
|
16 |
# Major revision.
|
|
|
17 |
# Config is now YAML
|
|
|
18 |
# Default section which will fill in the blanks for anything not filled in on an account, so creating a lot of accounts
|
|
|
19 |
# with common values is easier to set up an maintain
|
|
|
20 |
# Target folder is configurable on a per account basis, using tags <folder>, <year>, <month> (called hierachy)
|
|
|
21 |
#
|
54 |
rodolico |
22 |
# version 2.1.0 20190822 RWR
|
|
|
23 |
# Added sleeptime parameter to target which makes process sleep a number of seconds between each mail transfer
|
|
|
24 |
# We use HiRes, so this can be a decimal number (ie, 0.5 for half a second).
|
|
|
25 |
#
|
|
|
26 |
#
|
14 |
rodolico |
27 |
# This program is free software: you can redistribute it and/or modify
|
|
|
28 |
# it under the terms of the GNU General Public License as published by
|
|
|
29 |
# the Free Software Foundation, either version 3 of the License, or
|
|
|
30 |
# (at your option) any later version.
|
|
|
31 |
#
|
|
|
32 |
# This program is distributed in the hope that it will be useful,
|
|
|
33 |
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
34 |
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
35 |
# GNU General Public License for more details.
|
|
|
36 |
#
|
|
|
37 |
# You should have received a copy of the GNU General Public License
|
|
|
38 |
# along with this program. If not, see <http://www.gnu.org/licenses/>.
|
40 |
rodolico |
39 |
#
|
|
|
40 |
# for required libraries
|
42 |
rodolico |
41 |
# apt-get -y install libnet-imap-simple-ssl-perl libyaml-tiny-perl libhash-merge-simple-perl libclone-perl libdate-manip-perl libemail-simple-perl
|
14 |
rodolico |
42 |
|
|
|
43 |
use strict;
|
|
|
44 |
use warnings;
|
|
|
45 |
use Net::IMAP::Simple; # libnet-imap-simple-ssl-perl
|
|
|
46 |
use POSIX; # to get floor and ceil
|
40 |
rodolico |
47 |
use YAML::Tiny; # apt-get libyaml-tiny-perl under debian
|
|
|
48 |
use Clone 'clone'; # libclone-perl
|
|
|
49 |
use Hash::Merge::Simple qw/ merge clone_merge /; # libhash-merge-simple-perl
|
42 |
rodolico |
50 |
use Date::Manip; # libdate-manip-perl
|
|
|
51 |
use Email::Simple; # libemail-simple-perl
|
|
|
52 |
use Date::Parse;
|
54 |
rodolico |
53 |
use Time::HiRes;
|
14 |
rodolico |
54 |
|
42 |
rodolico |
55 |
|
40 |
rodolico |
56 |
use Data::Dumper;
|
|
|
57 |
|
14 |
rodolico |
58 |
# globals
|
40 |
rodolico |
59 |
my $CONFIG_FILE_NAME = 'archiveIMAP.yaml';
|
14 |
rodolico |
60 |
|
40 |
rodolico |
61 |
# the default values for everything. These are overridden
|
|
|
62 |
# by default values in the conf file (.yaml) or by individual
|
|
|
63 |
# accounts entries.
|
|
|
64 |
my $config = {
|
|
|
65 |
'default' => {
|
|
|
66 |
# where the mail is going to
|
|
|
67 |
'target' => {
|
|
|
68 |
# these have no defaults. They should be in the configuration file
|
|
|
69 |
# 'password' => 'password',
|
|
|
70 |
# 'username' => 'username',
|
|
|
71 |
# hierarchy can be any combination of <path>, <month> and <year>
|
|
|
72 |
'hierarchy' => '<path>',
|
|
|
73 |
# default target server
|
|
|
74 |
'server' => 'localhost',
|
54 |
rodolico |
75 |
# amount of time to sleep between messages, in seconds (float)
|
|
|
76 |
'sleeptime' => 0.5,
|
40 |
rodolico |
77 |
},
|
|
|
78 |
# where the mail is coming from
|
|
|
79 |
'source' => {
|
|
|
80 |
# these have no defaults. They should be in the configuration file
|
|
|
81 |
# 'password' => 'password',
|
|
|
82 |
# 'username' => 'username',
|
|
|
83 |
# Anything older than this is archived
|
|
|
84 |
# number of days unless followed by 'M' or 'Y', in which case it is
|
|
|
85 |
# multiplied by the number of days in a year (365.2425) or days in a month (30.5)
|
|
|
86 |
# may be a float, ie 1.25Y is the same as 15M
|
|
|
87 |
'age' => '1Y',
|
|
|
88 |
# if set to 1, any folders emptied out will be deleted EXCEPT system folders
|
|
|
89 |
'deleteEmptyFolders' => 0,
|
|
|
90 |
# default source server
|
|
|
91 |
'server' => 'localhost',
|
|
|
92 |
# these folders are considered system folders and never deleted, case insensitive
|
|
|
93 |
'system' => [
|
|
|
94 |
'Outbox',
|
|
|
95 |
'Sent Items',
|
|
|
96 |
'INBOX'
|
|
|
97 |
],
|
|
|
98 |
# these folders are ignored, ie not processed at all. Case insensitive
|
|
|
99 |
'ignore' => [
|
|
|
100 |
'Deleted Messages',
|
|
|
101 |
'Drafts',
|
|
|
102 |
'Junk E-mail',
|
|
|
103 |
'Junk',
|
|
|
104 |
'Trash'
|
|
|
105 |
],
|
|
|
106 |
# if 1, after successful copy to target, remove from source
|
|
|
107 |
'deleteOnSuccess' => 0
|
|
|
108 |
},
|
|
|
109 |
# if 1, does a dry run showing what would have happened
|
|
|
110 |
'testing' => 0,
|
|
|
111 |
# if 0, will not be processed
|
|
|
112 |
'enabled' => 1,
|
|
|
113 |
}
|
42 |
rodolico |
114 |
};
|
40 |
rodolico |
115 |
|
|
|
116 |
|
14 |
rodolico |
117 |
#
|
|
|
118 |
# find where the script is actually located as cfg should be there
|
|
|
119 |
#
|
|
|
120 |
sub getScriptLocation {
|
|
|
121 |
use strict;
|
|
|
122 |
use File::Spec::Functions qw(rel2abs);
|
|
|
123 |
use File::Basename;
|
|
|
124 |
return dirname(rel2abs($0));
|
|
|
125 |
}
|
|
|
126 |
|
|
|
127 |
#
|
|
|
128 |
# Read the configuration file from current location
|
|
|
129 |
# and return it as a string
|
|
|
130 |
#
|
|
|
131 |
sub readConfig {
|
|
|
132 |
my $scriptLocation = &getScriptLocation();
|
|
|
133 |
if ( -e "$scriptLocation/$CONFIG_FILE_NAME" ) {
|
40 |
rodolico |
134 |
my $yaml = YAML::Tiny->read( "$scriptLocation/$CONFIG_FILE_NAME" );
|
|
|
135 |
# use clone_merge to merge conf file into $config
|
|
|
136 |
# overwrites anything in $config if it exists in the config file
|
|
|
137 |
$config = clone_merge( $config, $yaml->[0] );
|
|
|
138 |
return 1;
|
14 |
rodolico |
139 |
}
|
40 |
rodolico |
140 |
return 0;
|
14 |
rodolico |
141 |
}
|
|
|
142 |
|
40 |
rodolico |
143 |
# merges default into current account, overwriting anything not defined in account with
|
|
|
144 |
# value from default EXCEPT arrays labeled in @tags, which will be merged together.
|
|
|
145 |
sub fixupAccount {
|
|
|
146 |
my ( $default, $account ) = @_;
|
|
|
147 |
|
|
|
148 |
# these arrays, part of source, will be appended together instead of being overwritten
|
|
|
149 |
my @tags = ( 'ignore', 'system' );
|
|
|
150 |
# merge the tags in question. NOTE: they can only be in source
|
|
|
151 |
foreach my $tag ( @tags) {
|
|
|
152 |
if ( $default->{'source'}->{$tag} && $account->{'source'}->{$tag} ) {
|
|
|
153 |
my @j = ( @{$default->{'source'}->{$tag}}, @{$account->{'source'}->{$tag}} );
|
|
|
154 |
$account->{'source'}->{$tag} = \@j;
|
|
|
155 |
}
|
|
|
156 |
}
|
|
|
157 |
# now, merge account and default, with account taking precedence.
|
|
|
158 |
return clone_merge( $default, $account );
|
|
|
159 |
#my $c = clone_merge( $default, $account );
|
|
|
160 |
#return $c;
|
|
|
161 |
}
|
|
|
162 |
|
14 |
rodolico |
163 |
#
|
|
|
164 |
# Open an IMAP connection
|
|
|
165 |
#
|
|
|
166 |
sub openIMAPConnection {
|
|
|
167 |
my ( $server, $username, $password ) = @_;
|
|
|
168 |
my $imap = Net::IMAP::Simple->new( $server ) ||
|
|
|
169 |
die "Unable to connect to IMAP: $Net::IMAP::Simple::errstr\n";
|
|
|
170 |
# Log on
|
|
|
171 |
if(!$imap->login( $username, $password )){
|
|
|
172 |
die "Login failed: " . $imap->errstr . "\n";
|
|
|
173 |
}
|
|
|
174 |
return $imap;
|
|
|
175 |
}
|
|
|
176 |
|
|
|
177 |
#
|
|
|
178 |
# returns a string in proper format for RFC which is $age days ago
|
40 |
rodolico |
179 |
# $age is a float, possibly followed by a single character modifier
|
14 |
rodolico |
180 |
#
|
|
|
181 |
sub getDate {
|
|
|
182 |
my $age = shift;
|
40 |
rodolico |
183 |
# allow modifier to age which contains 'Y' (years) or 'M' (months)
|
|
|
184 |
# Simply set multiplier to the correct value, then multiply the value
|
|
|
185 |
$age = lc( $age );
|
|
|
186 |
if ( $age =~ m/([0-9.]+)([a-z])/ ) {
|
42 |
rodolico |
187 |
# ~0 is the maximum integer which can be stored. Shifting right one gives max unsigned integer
|
|
|
188 |
my $multiplier = ($2 eq 'y' ? 365.2425 : ( $2 eq 'm' ? 30.5 : ~0 >> 1) );
|
40 |
rodolico |
189 |
$age = floor( $1 * $multiplier);
|
|
|
190 |
}
|
14 |
rodolico |
191 |
my @months = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
|
|
|
192 |
my @now = localtime(time - 24 * 60 * 60 * $age);
|
|
|
193 |
$now[4] = @months[$now[4]];
|
|
|
194 |
$now[5] += 1900;
|
|
|
195 |
my $date = sprintf( "%d-%s-%d", $now[3],$now[4],$now[5] ) ; # '1-Jan-2014';
|
|
|
196 |
return $date;
|
|
|
197 |
}
|
|
|
198 |
|
42 |
rodolico |
199 |
|
|
|
200 |
# calculateTargetFolder
|
|
|
201 |
# we are passed the target and the message
|
|
|
202 |
# pattern is carot (^) separated and may contain
|
|
|
203 |
# special placeholders <path>, <year>, <month>
|
|
|
204 |
# anything else is inserted directly
|
|
|
205 |
sub calculateTargetFolder {
|
|
|
206 |
my ( $message, $source, $target ) = @_;
|
|
|
207 |
# we may be sorting by date
|
|
|
208 |
my $email = Email::Simple->new( join( '', @$message ) );
|
|
|
209 |
my $msgDate = $email->header('Date');
|
|
|
210 |
my @t = strptime( $msgDate );
|
|
|
211 |
my $month = $t[4]+1;
|
|
|
212 |
$month = '0' . $month if $month < 10;
|
|
|
213 |
my $year = $t[5]+1900;
|
50 |
rodolico |
214 |
# also, may need the source hierarchy
|
|
|
215 |
my $sourceFolder = join ( $target->{'separator'}, @{ $source->{'source folder list'} } );
|
42 |
rodolico |
216 |
# now, build the path on the new machine
|
|
|
217 |
my $targetPattern = join( $target->{'separator'}, @{ $target->{'hierachy pattern'} } );
|
|
|
218 |
$targetPattern =~ s/<path>/$sourceFolder/gi;
|
|
|
219 |
$targetPattern =~ s/<month>/$month/gi;
|
|
|
220 |
$targetPattern =~ s/<year>/$year/gi;
|
|
|
221 |
# return the string we created, separated by
|
|
|
222 |
# the delimiters for the target
|
|
|
223 |
return $targetPattern;
|
|
|
224 |
}
|
|
|
225 |
|
|
|
226 |
|
|
|
227 |
# If folder has messages that match the criteria, move them to target
|
|
|
228 |
# creates the target folder if necessary
|
14 |
rodolico |
229 |
#
|
42 |
rodolico |
230 |
sub processFolder {
|
|
|
231 |
my ( $source, $target, $folder, $TESTING ) = @_;
|
|
|
232 |
#$dateBefore, $sourceDelimiter, $targetDelimiter, $deleteOnSuccess
|
|
|
233 |
print "\n=== Processing $folder\n";
|
|
|
234 |
my $sourceAccount = $source->{'connection'};
|
|
|
235 |
my $targetAccount = $target->{'connection'};
|
|
|
236 |
my $numMessages = 0;
|
|
|
237 |
$sourceAccount->expunge_mailbox( $folder ); # clean it up so we don't copy deleted messages
|
|
|
238 |
$sourceAccount->select( $folder ) or die "Could not connect to folder $folder\n"; # move into the correct folder for the source
|
|
|
239 |
my @ids = $sourceAccount->search_sent_before( $source->{'before date'} ); # use sent_before to get the sent date from message
|
55 |
rodolico |
240 |
print "Found " . scalar( @ids ) . " messages to process\n";
|
42 |
rodolico |
241 |
return 0 unless @ids; # we have nothing to copy, so exit
|
|
|
242 |
# make life easier by precalculating some paths as array pointers
|
|
|
243 |
my @sourceFolders = split( '\\' . $source->{'separator'}, $folder );
|
|
|
244 |
my @pattern = split '\\^', $target->{'hierarchy'};
|
|
|
245 |
$source->{'source folder list'} = \@sourceFolders;
|
|
|
246 |
$target->{'hierachy pattern'} = \@pattern;
|
|
|
247 |
|
|
|
248 |
# process each message to be done
|
56 |
rodolico |
249 |
while ( my $id = shift ( @ids ) ) {
|
42 |
rodolico |
250 |
# get the flags
|
|
|
251 |
my @flags = $sourceAccount->msg_flags( $id );
|
|
|
252 |
# get the message
|
|
|
253 |
my $message = $sourceAccount->get( $id ) or die $sourceAccount->errstr;
|
|
|
254 |
# calculate where we are going to move this to
|
|
|
255 |
my $targetFolder = &calculateTargetFolder( $message, $source, $target );
|
|
|
256 |
if ( $TESTING ) {
|
50 |
rodolico |
257 |
print "Would have " . ( $source->{'deleteOnSuccess'} ? 'moved' : 'copied' ) . " message to $targetFolder\n";
|
42 |
rodolico |
258 |
next;
|
|
|
259 |
}
|
50 |
rodolico |
260 |
if ( $target->{'connection'}->select( $targetFolder ) || &makeFolder( $target->{'connection'}, $targetFolder, $target->{'separator'} ) ) {
|
|
|
261 |
if ( $target->{'connection'}->put( $targetFolder, $message, @flags ) ) {
|
42 |
rodolico |
262 |
$source->{'connection'}->delete( $id ) if ( $source->{'deleteOnSuccess'} ) ;
|
54 |
rodolico |
263 |
Time::HiRes::sleep( $target->{'sleeptime'} ) if $target->{'sleeptime'};
|
42 |
rodolico |
264 |
$numMessages++;
|
|
|
265 |
} else {
|
50 |
rodolico |
266 |
die "Could not write to target, aborting\n$targetFolder->{'connection'}->errstr\n";
|
42 |
rodolico |
267 |
}
|
|
|
268 |
} else {
|
50 |
rodolico |
269 |
warn "\t\t$targetFolder not found in target and could not create it\n";
|
42 |
rodolico |
270 |
}
|
|
|
271 |
|
|
|
272 |
}
|
|
|
273 |
return $numMessages;
|
|
|
274 |
}
|
|
|
275 |
|
|
|
276 |
|
|
|
277 |
|
|
|
278 |
#
|
14 |
rodolico |
279 |
# Get a list of all folders to be processed
|
|
|
280 |
# currently, it just weeds out items in the ignore list
|
|
|
281 |
#
|
|
|
282 |
sub getFolders {
|
|
|
283 |
my ($imap, $ignore, $separator) = @_;
|
|
|
284 |
$separator = '\\' . $separator;
|
|
|
285 |
# build a regex that will be used to filter the input
|
|
|
286 |
# assuming Trash, Drafts and Junk are in the ignore list
|
|
|
287 |
# and a period is the separator, the generated regex is
|
|
|
288 |
# (^|(\.))((Trash)|(Drafts)|(Junk))((\.)|$)
|
|
|
289 |
# which basically says ignore those folders, but not substrings of them
|
|
|
290 |
# ie, Junk02 would not be filtered but Junk would
|
|
|
291 |
my $ignoreRegex = "(^|($separator))((" . join( ")\|(", @$ignore ) . "))(($separator)|\$)";
|
|
|
292 |
# read all mailboxes and filter them with above regex into @boxes
|
42 |
rodolico |
293 |
my @boxes = grep{ ! /$ignoreRegex/i } $imap->mailboxes;
|
14 |
rodolico |
294 |
return \@boxes;
|
|
|
295 |
}
|
|
|
296 |
|
|
|
297 |
#
|
|
|
298 |
# make a folder on the IMAP account. The folder is assumed to be the
|
|
|
299 |
# fully qualified path with the correct delimiters
|
|
|
300 |
#
|
|
|
301 |
sub makeFolder {
|
|
|
302 |
my ($imap, $folder, $delimiter) = @_;
|
|
|
303 |
|
|
|
304 |
print "\n\t\tCreating folder $folder";
|
|
|
305 |
# you must create the parent folder before creating the children
|
|
|
306 |
my $escapedDelimiter = '\\' . $delimiter;
|
|
|
307 |
my @folders = split( $escapedDelimiter, $folder );
|
|
|
308 |
$folder = '';
|
|
|
309 |
# take them from the left and, if they don't exist, create it
|
|
|
310 |
while ( my $subdir = shift @folders ) {
|
|
|
311 |
$folder .= $delimiter if $folder;
|
|
|
312 |
$folder .= $subdir;
|
|
|
313 |
next if $imap->select( $folder ); # already created, so look deeper in hierachy
|
|
|
314 |
print "\n\t\t\tCreating subfolder $folder";
|
|
|
315 |
$imap->create_mailbox( $folder ) || warn $imap->errstr();
|
|
|
316 |
$imap->folder_subscribe( $folder ) || die $imap->errstr();
|
|
|
317 |
unless ( $imap->select( $folder ) ) { # verify it was created
|
|
|
318 |
warn "Unable to create $folder on target account\n";
|
|
|
319 |
return 0;
|
|
|
320 |
} # unless
|
|
|
321 |
} # while
|
|
|
322 |
return $folder;
|
|
|
323 |
}
|
|
|
324 |
|
|
|
325 |
#
|
|
|
326 |
# Delete an IMAP folder
|
|
|
327 |
#
|
|
|
328 |
sub deleteAFolder {
|
42 |
rodolico |
329 |
my ($source, $folder, $TESTING ) = @_;
|
|
|
330 |
my $sourceAccount = $source->{'connection'};
|
|
|
331 |
my $separator = $source->{'separator'};
|
14 |
rodolico |
332 |
return 1 if $folder eq 'INBOX'; # do NOT mess with INBOX
|
|
|
333 |
return 2 if $sourceAccount->select($folder) > 0; # do not mess with it if it still has messages in it
|
|
|
334 |
return 3 if $sourceAccount->mailboxes( $folder . $separator . '*' ); # do not mess with it if it has subfolders
|
42 |
rodolico |
335 |
return 4 if $source->{'system folders'}->{lc $folder}; # do not mess with system folders
|
|
|
336 |
print "\n\t\tDeleting empty folder $folder" . ( $TESTING ? ' Dry Run' : '' );
|
|
|
337 |
return if $TESTING;
|
14 |
rodolico |
338 |
$sourceAccount->folder_unsubscribe($folder);
|
|
|
339 |
$sourceAccount->delete_mailbox( $folder );
|
|
|
340 |
}
|
|
|
341 |
|
|
|
342 |
|
40 |
rodolico |
343 |
# main process loop to handle one account
|
14 |
rodolico |
344 |
#
|
|
|
345 |
sub processAccount {
|
40 |
rodolico |
346 |
my $account = shift;
|
|
|
347 |
|
53 |
rodolico |
348 |
return 0 unless $account->{'enabled'}; # blow it off if it is not enabled
|
42 |
rodolico |
349 |
my $TESTING = $account->{'testing'}; # create mini global if we should test this account
|
50 |
rodolico |
350 |
|
|
|
351 |
print "========= Test Mode ========\n" if $TESTING;
|
14 |
rodolico |
352 |
|
|
|
353 |
# open and log into both source and target, and get the separator used
|
42 |
rodolico |
354 |
foreach my $acct ( 'target','source' ) {
|
|
|
355 |
$account->{$acct}->{'connection'} = &openIMAPConnection( $account->{$acct}->{'server'}, $account->{$acct}->{'username'}, $account->{$acct}->{'password'} );
|
|
|
356 |
unless ( $account->{$acct}->{'connection'} ) {
|
|
|
357 |
warn "Unable to open $acct for $account->{$acct}->{username}, aborting move: $!\n";
|
|
|
358 |
return -1;
|
|
|
359 |
}
|
|
|
360 |
$account->{$acct}->{'separator'} = $account->{$acct}->{'connection'}->separator unless $account->{$acct}->{'separator'};
|
|
|
361 |
}
|
14 |
rodolico |
362 |
|
42 |
rodolico |
363 |
# just being set up for convenience and readability
|
|
|
364 |
my $source = $account->{'source'};
|
|
|
365 |
my $target = $account->{'target'};
|
|
|
366 |
|
|
|
367 |
my %temp = map{ lc($_) => 1 } @{$source->{'system'}};
|
|
|
368 |
$source->{'system folders'} = \%temp;
|
|
|
369 |
|
50 |
rodolico |
370 |
$source->{'before date'} = &getDate( $source->{'age'} );
|
42 |
rodolico |
371 |
print "\t" . ( $source->{'deleteOnSuccess'} ? 'Moving' : 'Copying' ) . " all messages before $source->{'before date'}\n";
|
|
|
372 |
|
14 |
rodolico |
373 |
# get a list of all folders to be processed on the source
|
42 |
rodolico |
374 |
$source->{'folders'} = &getFolders( $source->{'connection'}, $source->{'ignore'}, $source->{'separator'} );
|
|
|
375 |
|
50 |
rodolico |
376 |
if ( $TESTING ) {
|
|
|
377 |
print Dumper( $source );
|
|
|
378 |
print "Source above, press enter to continue: "; my $j = <STDIN>;
|
|
|
379 |
print Dumper( $target );
|
|
|
380 |
print "Target above, Press enter to continue: "; $j = <STDIN>;
|
|
|
381 |
}
|
42 |
rodolico |
382 |
|
|
|
383 |
my $folderList = $source->{'folders'};
|
14 |
rodolico |
384 |
my $count = 0; # count the number of messages processed
|
|
|
385 |
my $processedCount = 0; # count the number of folders processed
|
|
|
386 |
foreach my $folder ( @$folderList ) {
|
38 |
rodolico |
387 |
my $messages;
|
42 |
rodolico |
388 |
$messages = &processFolder( $source, $target, $folder, $TESTING ); #, $date, $$source{'separator'}, $$target{'separator'}, $deleteOnSuccess );
|
|
|
389 |
|
|
|
390 |
$TESTING ? print "Would expunge $folder\n" : $source->{'connection'}->expunge_mailbox( $folder );
|
14 |
rodolico |
391 |
# delete folder if empty and client has requested it.
|
50 |
rodolico |
392 |
&deleteAFolder( $source, $folder, $TESTING ) if $account->{'source'}->{'deleteEmptyFolders'};
|
14 |
rodolico |
393 |
print "\n\t\t$messages processed\n";
|
|
|
394 |
$count += $messages;
|
|
|
395 |
$processedCount++;
|
|
|
396 |
# next line used only for testing. Dies after 5 folders on first account
|
50 |
rodolico |
397 |
last if $processedCount > 5 and $TESTING;
|
14 |
rodolico |
398 |
}
|
42 |
rodolico |
399 |
|
|
|
400 |
$source->{'connection'}->quit;
|
|
|
401 |
$target->{'connection'}->quit;
|
14 |
rodolico |
402 |
return $count;
|
|
|
403 |
}
|
|
|
404 |
|
40 |
rodolico |
405 |
|
|
|
406 |
|
14 |
rodolico |
407 |
#######################################################################
|
|
|
408 |
# Main #
|
|
|
409 |
#######################################################################
|
|
|
410 |
|
|
|
411 |
# read and evaluate configuration file
|
40 |
rodolico |
412 |
&readConfig() || die "could not load config file\n";
|
|
|
413 |
#print Dumper( $config ); die;
|
|
|
414 |
foreach my $account ( keys %{$config->{'accounts'}} ) {
|
|
|
415 |
$config->{'accounts'}->{$account} = &fixupAccount( $config->{'default'}, $config->{'accounts'}->{$account} );
|
14 |
rodolico |
416 |
}
|
|
|
417 |
|
40 |
rodolico |
418 |
#print Dumper( $config ) ; die;
|
14 |
rodolico |
419 |
|
40 |
rodolico |
420 |
# just a place to gather some stats
|
14 |
rodolico |
421 |
my %processed;
|
|
|
422 |
$processed{'Accounts'} = 0;
|
|
|
423 |
$processed{'Messages'} = 0;
|
|
|
424 |
|
40 |
rodolico |
425 |
# grab only the accounts for simplicity
|
|
|
426 |
my $accounts = $config->{'accounts'};
|
42 |
rodolico |
427 |
|
50 |
rodolico |
428 |
#die Dumper( $accounts );
|
42 |
rodolico |
429 |
|
40 |
rodolico |
430 |
# now, process each in turn
|
|
|
431 |
foreach my $account ( keys %$accounts ) {
|
14 |
rodolico |
432 |
# talk to user
|
|
|
433 |
print "Processing account $account\n";
|
40 |
rodolico |
434 |
# do the account. This is the main worker bee
|
|
|
435 |
$accounts->{$account}->{'processed'} = &processAccount( $accounts->{$account} );
|
|
|
436 |
print "Done, $accounts->{$account}->{'processed'} messages copied\n";
|
14 |
rodolico |
437 |
$processed{'Accounts'}++;
|
40 |
rodolico |
438 |
$processed{'Messages'} += $accounts->{$account}->{'processed'};
|
42 |
rodolico |
439 |
# free up space we allocated since we stored a bunch of stuff in there, and we don't need it anymore
|
|
|
440 |
$accounts->{$account} = undef;
|
14 |
rodolico |
441 |
} # foreach loop
|
|
|
442 |
|
|
|
443 |
print "$processed{'Accounts'} accounts processed, $processed{'Messages'} messages\n";
|
|
|
444 |
|
40 |
rodolico |
445 |
|
14 |
rodolico |
446 |
1;
|
|
|
447 |
|