全部博文(1144)
分类: PERL
2014-11-27 09:40:38
#!/usr/bin/perl # # mbox2imap.pl # # Perl script to migrate a Kmail mbox store to IMAP. Change check_file for evolution # # Copyright 2005 Marco R. Gazzetta # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # contact the author directly for more information at: # marcog AT pobox com # # use File::Find; use Mail::IMAPClient; use Mail::Box::Mbox; use Mail::Message::Convert::MailInternet; my $cache = "$ENV{HOME}/.mailboxes"; my %folders = (); if (-e $cache) { open CACHE, $cache; while () { chomp; @array = split /\|/; $folders{$array[0]} = $array[1]; } } else { # First, get the local folders find(\&check_file, "$ENV{HOME}/Mail"); open CACHE, "> $cache"; for (sort keys %folders) { print CACHE "$_|$folders{$_}\n"; } } sub check_file { # the regex checks for files whose name does NOT start with a dot # notice that File::Find sets $_ to the file name, while $File::Find::name # is with path if (!/^\..*/) { my $file = $File::Find::name; my $name = $File::Find::name; # delete non-kmail part of name $name =~ s/\/[^.]+\//\//g; # now normalize the directories $name =~ s/\/\.([^\/]+)\.directory\//\/$1\//g; # replace the directory artifacts $name =~ s/\/\.([^\/]+)\.directory\//\/$1\//g; # twice, because the first regex gets only half the line $name =~ s/\//./g; # replace all slashes with dots $name =~ s/\./_/g; # replace all dots with underscores $folders{"INBOX$name"} = $file; } } # open connection my $imap = Mail::IMAPClient->new( Server => 'server.domain.com', User => 'marco', Password => 'supersecret') || die "Could not connect to IMAP server.\n"; # push all messages in all folders (sorting is only so that a folder is created before the subfolders) for $f (sort keys %folders) { my $l = $folders{$f}; if (!$imap->exists($f)) { print "WARNING: Creating folder " . $f . " since it does not exist on the server.\n"; $imap->create($f) or print "ERROR: Could not create folder.\n"; } # Now copy all files from the local store to the IMAP store my $box = Mail::Box::Mbox->new("folder" => $l); my $conv = Mail::Message::Convert::MailInternet->new; print $f . ": " . $imap->message_count($f) . "\n"; # debug output only my $count = 1; foreach ($box->messages()) { $imap->append($f, $conv->export($_)->as_string()); # as_string ensures RFC 822 format print $count++ . "\n"; } print $f . ": " . $imap->message_count($f) . "\n"; } $imap->close();