File: imap_to_mbox.pl

package info (click to toggle)
libmail-imapclient-perl 2.2.9%2Bdeb-2
  • links: PTS
  • area: main
  • in suites: sarge
  • size: 680 kB
  • ctags: 179
  • sloc: perl: 3,914; makefile: 56
file content (154 lines) | stat: -rwxr-xr-x 4,419 bytes parent folder | download | duplicates (4)
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
#