1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154
|
#!/usr/bin/perl
# (c) 1999 Thomas Stromberg, Research Triangle Commerce, Inc.
# This software is protected by the BSD License. No rights reserved anyhow.
# <tstromberg@rtci.com>
# DESC: Reads a users IMAP folders, and converts them to mbox
# Good for an interim switch-over from say, Exchange to Cyrus IMAP.
# $Header: /usr/CvsRepository/Mail/IMAPClient/examples/imap_to_mbox.pl,v 19991216.7 2002/08/23 13:29:48 dkernen Exp $
# TODO:
# -----
# lsub instead of list option
# correct header printing From
use Mail::IMAPClient; # a nice set of perl libs for imap
use Getopt::Std; # for the command-line overrides. good for user
use File::Path; # create full file paths. (yummy!)
use File::Basename; # find a nice basename for a folder.
$| = 1;
# Config for the imap migration kit.
getopts('u:p:P:s:i:f::b:dh');
if ($opt_h) {
# print help here
}
$SERVER = $opt_s || 'mailhost';
$USER = $opt_u || 'userid';
$PASSWORD = $opt_p || 'password';
$PORT = $opt_P || '143';
$INBOX_PATH = $opt_i || "./mail/$USER";
$FOLDERS_PATH = $opt_f || "./folders/$USER";
$DONT_MOVE = $opt_m || '.mailboxlist|Trash|INBOXIIMAP|mlbxl';
$READ_DELIMITER = $opt_r || '/';
$WRITE_DELIMITER= $opt_w || '/';
$BANNED_CHARS = $opt_b || '.|^|%';
$DEBUG = $opt_d || "0";
## do our magic tricks ######################################
&connect_imap;
&find_folders;
sub connect_imap {
$imap = Mail::IMAPClient->new(
Server => "$SERVER",
User => "$USER",
Password => "$PASSWORD",
Port => "$PORT",
Debug => "$DEBUG",
Uid => '0',
Clear => '1',
)
|| die ("Could not connect to $SERVER:$PORT with $USER: $! $?\n");
};
sub find_folders {
my (@folders, $folder, $message_count, $new_folder, $path);
@folders = $imap->folders;
push(@folders, "INBOX");
foreach $folder (@folders) {
$message_count = $imap->message_count($folder);
if (! $message_count) {
print("* $folder is empty, skipping.\n");
next;
}
if ($folder =~ /$DONT_MOVE/) {
print("! $folder matches DONT_MOVE ruleset, skipping\n");
next;
}
$new_folder = $folder;
$new_folder =~ s/\./_/g;
$new_folder =~ s/$READ_DELIMITER/$WRITE_DELIMITER/g;
if ($new_folder eq "INBOX") {
$path = "$INBOX_PATH";
} else {
$path = "$FOLDERS_PATH/$new_folder";
}
printf("x %4i %-45.45s => %s", $message_count, $folder, $path);
&write_folder($folder, $path, 1, $message_count);
}
}
sub write_folder {
my($folder, $newpath, $first_message, $last_message) = @_;
my($msg_header, $msg_body);
$imap->select($folder) || print("Could not examine $folder: $!");
$new_dir = dirname($newpath);
$new_file = basename($newpath);
mkpath("$new_dir", 0700) unless -d "$new_dir";
open(mbox, ">$newpath");
for ($i=$first_message; $i<$last_message+1; ++$i) {
if ( ($i / 25) == int($i / 25) ) { print("."); }
$msg_header = $imap->fetch($i, "FAST") || print("Could not fetch header $i from $folder\n");
$msg_rfc822 = $imap->fetch($i, "RFC822") || print("Could not fetch RFC822 $i from $folder\n");
undef $start;
foreach (@$msg_rfc822) {
if (($_ =~ /: /) && (! $message)) { ++$message; print(mbox "From imap\@to.mbox Wed Oct 27 17:02:53 1999\n");}
if (/^\)\r/) { undef $message; print(mbox "\n\n");}
next unless $message;
$_ =~ s/\r$//;
print(mbox "$_");
}
}
close(mbox);
print("\n");
}
# $Id: imap_to_mbox.pl,v 19991216.7 2002/08/23 13:29:48 dkernen Exp $
# $Log: imap_to_mbox.pl,v $
# Revision 19991216.7 2002/08/23 13:29:48 dkernen
#
# Modified Files: Changes IMAPClient.pm INSTALL MANIFEST Makefile Makefile.PL README Todo test.txt
# Made changes to create version 2.1.6.
# Modified Files:
# imap_to_mbox.pl populate_mailbox.pl
# Added Files:
# cleanTest.pl migrate_mbox.pl
#
# Revision 19991216.6 2000/12/11 21:58:52 dkernen
#
# Modified Files:
# build_dist.pl build_ldif.pl copy_folder.pl find_dup_msgs.pl
# imap_to_mbox.pl populate_mailbox.pl
# to add CVS data
#
# Revision 19991216.5 1999/12/16 17:19:12 dkernen
# Bring up to same level
#
# Revision 19991124.3 1999/12/16 17:14:25 dkernen
# Incorporate changes for exists method performance enhancement
#
# Revision 19991124.02 1999/11/24 17:46:19 dkernen
# More fixes to t/basic.t
#
# Revision 19991124.01 1999/11/24 16:51:49 dkernen
# Changed t/basic.t to test for UIDPLUS before trying UID cmds
#
# Revision 1.3 1999/11/23 17:51:06 dkernen
# Committing version 1.06 distribution copy
#
|