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
|
#!/usr/local/bin/perl
#$Id$
++$|;
use Getopt::Std;
use Mail::IMAPClient;
use vars qw/$opt_r $opt_h $opt_t $opt_f/;
getopts("t:f:F:N:rh");
if ( $opt_h ) {
print &usage;
exit;
}
my($to_id,$to_pass,$thost) = $opt_t =~ m{
([^/]+) # everything up to / is the id
/ # then a slash
([^@]+) # then everything up to @ is pswd
@ # then an @-sign
(.*) # then everything else is the host
}x ;
my($from_id,$from_pass,$fhost) =
$opt_f =~ m{
([^/]+) # everything up to / is the id
/ # then a slash
([^@]+) # then everything up to @ is pswd
@ # then an @-sign
(.*) # then everything else is the host
}x ;
$to_id and $from_id and $to_pass and $from_pass and $thost and $fhost
or die "Error: Must specify -t and -f (to and from)\n" . &usage;
$opt_F or
die "Error: Must specify '-F folder' or how will I know what folder to copy?\n" .
&usage ;
$opt_N ||= $opt_F;
print "Copying folder $opt_F from $from_id\@$fhost to ${to_id}'s $opt_N folder on $thost.\n";
my ($from) = Mail::IMAPClient->new( Server => $fhost,
User => $from_id,
Password=> $from_pass,
Fast_IO => 1,
Uid => 1,
Debug => 0,
);
my ($to) = Mail::IMAPClient->new( Server => $thost,
User => $to_id,
Password=> $to_pass,
Fast_IO => 1,
Uid => 1,
Debug => 0,
);
my @folders = $opt_r ? @{$from->folders($opt_F)} : ( $opt_F ) ;
foreach my $fold (@folders) {
print "Processing folder $fold\n";
$from->select($fold);
if ($opt_F ne $opt_N) {
$fold =~s/^$opt_F/$opt_N/o;
}
unless ($to->exists($fold)) {
$to->create($fold) or warn "Couldn't create $fold\n" and next;
}
$to->select($fold);
my @msgs = $from->search("ALL");
# my %flaghash = $from->flags(\@msgs);
foreach $msg (@msgs) {
print "Processing message $msg in folder $fold.\n";
my $string = $from->message_string($msg);
# print "String = $string\n";
my $new_id = $to->append($fold,$string)
or warn "Couldn't append msg #$msg to target folder $fold.\n";
$to->store($new_id,"+FLAGS (" . join(" ",@{$from->flags($msg)}) . ")");
}
}
sub usage {
return "Syntax:\n\t$0 -t to_id/to_pass\@to.host -f from_id/from_pass\@from.host \\\n" .
"\t\t-F folder [-N New_Folder] [-r]\n".
"\tor\n\t$0 -h\n\n".
"\twhere:\n\t\t".
"to_id\t\tis the id to recieve the folder\n\t\t".
"to_pass\t\tis the password for to_id\n\t\t".
"from\t\tis the uid who currently has the folder\n\t\t".
"from_pass\tis the password for from_id\n\t\t".
"to.host\t\tis the optional host where the 'to' uid has a mailbox\n\t\t".
"from.host\tis the optional host where the 'from' uid has a mailbox\n\t\t".
"folder\t\tis the folder to copy from\n\t\t".
"New_Folder\tis the folder to copy to (defaults to 'folder')\n\t\t".
"-h\t\tprints this help message\n\t\t".
"-r\t\tspecifies a recursive copy (only works on systems that support the idea " .
"\n\t\t\t\tof recursive folders)\n\t\t".
"\n"
;
}
=head1 AUTHOR
David J. Kernen
The Kernen Group, Inc.
imap@kernengroup.com
=head1 COPYRIGHT
This example and Mail::IMAPClient are Copyright (c) 1999,2000,2003
by The Kernen Group, Inc. All rights reserved.
This example is distributed with Mail::IMAPClient and
subject to the same licensing requirements as Mail::IMAPClient.
imtest is a utility distributed with Cyrus IMAP server,
Copyright (c) 1994-2000 Carnegie Mellon University.
All rights reserved.
=cut
# History:
# $Log: copy_folder.pl,v $
# Revision 19991216.3 2003/06/12 21:38:30 dkernen
#
# Preparing 2.2.8
# Added Files: COPYRIGHT
# Modified Files: Parse.grammar
# Added Files: Makefile.old
# Makefile.PL Todo sample.perldb
# BodyStructure.pm
# Parse.grammar Parse.pod
# range.t
# Thread.grammar
# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt
# rfc2221.txt rfc2359.txt rfc2683.txt
#
# Revision 19991216.2 2000/12/11 21:58:51 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
#
|
