mirror of
https://github.com/imapsync/imapsync.git
synced 2025-07-23 02:35:54 +02:00
1.404
This commit is contained in:
Nick Bebout
parent
d88bf4b46a
commit
02322d6ed1
73 changed files with 19532 additions and 23747 deletions
2142
Mail-IMAPClient-3.27/Changes
Normal file
2142
Mail-IMAPClient-3.27/Changes
Normal file
File diff suppressed because it is too large
Load diff
39
Mail-IMAPClient-3.27/MANIFEST
Normal file
39
Mail-IMAPClient-3.27/MANIFEST
Normal file
|
|
@ -0,0 +1,39 @@
|
|||
Changes
|
||||
MANIFEST
|
||||
Makefile.PL
|
||||
README
|
||||
examples/build_dist.pl
|
||||
examples/build_ldif.pl
|
||||
examples/cleanTest.pl
|
||||
examples/copy_folder.pl
|
||||
examples/cyrus_expire.pl
|
||||
examples/cyrus_expunge.pl
|
||||
examples/find_dup_msgs.pl
|
||||
examples/idle.pl
|
||||
examples/imap_to_mbox.pl
|
||||
examples/imtestExample.pl
|
||||
examples/migrate_mail2.pl
|
||||
examples/migrate_mbox.pl
|
||||
examples/populate_mailbox.pl
|
||||
examples/sharedFolder.pl
|
||||
lib/Mail/IMAPClient.pm
|
||||
lib/Mail/IMAPClient.pod
|
||||
lib/Mail/IMAPClient/BodyStructure.pm
|
||||
lib/Mail/IMAPClient/BodyStructure/Parse.grammar
|
||||
lib/Mail/IMAPClient/BodyStructure/Parse.pm
|
||||
lib/Mail/IMAPClient/BodyStructure/Parse.pod
|
||||
lib/Mail/IMAPClient/MessageSet.pm
|
||||
lib/Mail/IMAPClient/Thread.grammar
|
||||
lib/Mail/IMAPClient/Thread.pm
|
||||
lib/Mail/IMAPClient/Thread.pod
|
||||
prepare_dist
|
||||
t/basic.t
|
||||
t/body_string.t
|
||||
t/bodystructure.t
|
||||
t/fetch_hash.t
|
||||
t/messageset.t
|
||||
t/pod.t
|
||||
t/simple.t
|
||||
t/thread.t
|
||||
test_template.txt
|
||||
META.yml Module meta-data (added by MakeMaker)
|
||||
34
Mail-IMAPClient-3.27/META.yml
Normal file
34
Mail-IMAPClient-3.27/META.yml
Normal file
|
|
@ -0,0 +1,34 @@
|
|||
--- #YAML:1.0
|
||||
name: Mail-IMAPClient
|
||||
version: 3.27
|
||||
abstract: IMAP4 client library
|
||||
author:
|
||||
- Phil Pearl (Lobbes) <phil@zimbra.com>
|
||||
license: unknown
|
||||
distribution_type: module
|
||||
configure_requires:
|
||||
ExtUtils::MakeMaker: 0
|
||||
build_requires:
|
||||
ExtUtils::MakeMaker: 0
|
||||
requires:
|
||||
Carp: 0
|
||||
Errno: 0
|
||||
Fcntl: 0
|
||||
File::Temp: 0
|
||||
IO::File: 0
|
||||
IO::Select: 0
|
||||
IO::Socket: 0
|
||||
IO::Socket::INET: 1.26
|
||||
List::Util: 0
|
||||
MIME::Base64: 0
|
||||
Parse::RecDescent: 1.94
|
||||
perl: 5.008
|
||||
Test::More: 0
|
||||
no_index:
|
||||
directory:
|
||||
- t
|
||||
- inc
|
||||
generated_by: ExtUtils::MakeMaker version 6.55_02
|
||||
meta-spec:
|
||||
url: http://module-build.sourceforge.net/META-spec-v1.4.html
|
||||
version: 1.4
|
||||
155
Mail-IMAPClient-3.27/Makefile.PL
Normal file
155
Mail-IMAPClient-3.27/Makefile.PL
Normal file
|
|
@ -0,0 +1,155 @@
|
|||
use ExtUtils::MakeMaker;
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
use 5.008_001;
|
||||
|
||||
my @missing;
|
||||
my %optional = (
|
||||
"Authen::NTLM" => { for => "Authmechanism 'NTLM'" },
|
||||
"Authen::SASL" => { for => "Authmechanism 'DIGEST-MD5'" },
|
||||
"Digest::HMAC_MD5" => { for => "Authmechanism 'CRAM-MD5'" },
|
||||
"Digest::MD5" => { for => "Authmechanism 'DIGEST-MD5'" },
|
||||
"IO::Socket::SSL" => { for => "SSL enabled connections (Ssl => 1)" },
|
||||
"Test::Pod" => { for => "Pod tests", ver => "1.00" },
|
||||
);
|
||||
|
||||
foreach my $mod ( sort keys %optional ) {
|
||||
my $for = $optional{$mod}->{"for"} || "";
|
||||
my $ver = $optional{$mod}->{"ver"} || "";
|
||||
eval "use $mod $ver ();";
|
||||
push @missing, $mod . ( $for ? " for $for" : "" ) if $@;
|
||||
}
|
||||
|
||||
# similar message to one used in DBI:
|
||||
if (@missing) {
|
||||
print( "The following optional modules were not found:",
|
||||
map( "\n\t" . $_, @missing ), "\n" );
|
||||
|
||||
print <<'MSG';
|
||||
Optional modules are available from any CPAN mirror, reference:
|
||||
http://search.cpan.org/
|
||||
http://www.perl.com/CPAN/modules/by-module
|
||||
http://www.perl.org/CPAN/modules/by-module
|
||||
|
||||
MSG
|
||||
sleep 3;
|
||||
}
|
||||
|
||||
WriteMakefile(
|
||||
NAME => 'Mail::IMAPClient',
|
||||
AUTHOR => 'Phil Pearl (Lobbes) <phil@zimbra.com>',
|
||||
ABSTRACT => 'IMAP4 client library',
|
||||
VERSION_FROM => 'lib/Mail/IMAPClient.pm',
|
||||
MIN_PERL_VERSION => '5.008',
|
||||
PREREQ_PM => {
|
||||
'Carp' => 0,
|
||||
'Errno' => 0,
|
||||
'Fcntl' => 0,
|
||||
'IO::File' => 0,
|
||||
'IO::Select' => 0,
|
||||
'IO::Socket' => 0,
|
||||
'IO::Socket::INET' => 1.26,
|
||||
'List::Util' => 0,
|
||||
'MIME::Base64' => 0,
|
||||
'Parse::RecDescent' => 1.94,
|
||||
'Test::More' => 0,
|
||||
'File::Temp' => 0,
|
||||
},
|
||||
clean => { FILES => 'test.txt' },
|
||||
);
|
||||
|
||||
set_test_data();
|
||||
|
||||
exit 0;
|
||||
|
||||
###
|
||||
### HELPERS
|
||||
###
|
||||
|
||||
sub set_test_data {
|
||||
unless ( -f "lib/Mail/IMAPClient.pm" ) {
|
||||
warn "ERROR: not in installation directory\n";
|
||||
return;
|
||||
}
|
||||
|
||||
return if -s "./test.txt";
|
||||
|
||||
print <<'__INTRO';
|
||||
You have the option of running an extended suite of tests during
|
||||
'make test'. This requires an IMAP server name, user account, and
|
||||
password to test with.
|
||||
|
||||
Note: this prompt will automatically timeout after 60 seconds.
|
||||
|
||||
__INTRO
|
||||
|
||||
# HACK: alarm() allows broken interfaces to timeout gracefully...
|
||||
# - rt.cpan.org#57659: install fails when using cPanel GUI
|
||||
my $yes;
|
||||
eval {
|
||||
local $SIG{ALRM} = sub { die "alarm\n" };
|
||||
alarm(60);
|
||||
$yes = prompt "Do you want to run the extended tests? (n/y)";
|
||||
alarm(0);
|
||||
};
|
||||
print "\n" if $@;
|
||||
return unless ( $yes and $yes =~ /^y(?:es)?$/i );
|
||||
|
||||
unless ( open TST, '>', "./test.txt" ) {
|
||||
warn "ERROR: couldn't open ./test.txt: $!\n";
|
||||
return;
|
||||
}
|
||||
|
||||
my $server = "";
|
||||
until ($server) {
|
||||
$server =
|
||||
prompt "\nPlease provide the hostname or IP address of "
|
||||
. "a host running an\nIMAP server (or QUIT to skip "
|
||||
. "the extended tests)";
|
||||
chomp $server;
|
||||
return if $server =~ /^\s*quit\s*$/i;
|
||||
}
|
||||
|
||||
print TST "server=$server\n";
|
||||
|
||||
my $user = "";
|
||||
until ($user) {
|
||||
$user =
|
||||
prompt "\nProvide the username of an account on $server (or QUIT)";
|
||||
chomp $user;
|
||||
return if $user =~ /^\s*quit\s*$/i;
|
||||
}
|
||||
print TST "user=$user\n";
|
||||
|
||||
my $passed = "";
|
||||
until ($passed) {
|
||||
$passed = prompt "\nProvide the password for $user (or QUIT)";
|
||||
chomp $passed;
|
||||
return if $passed =~ /^\s+$|^quit$/i;
|
||||
}
|
||||
|
||||
print TST "passed=$passed\n";
|
||||
|
||||
my $port = prompt "\nPlease provide the port to connect to on $server "
|
||||
. "to run the test\n(default is 143)";
|
||||
chomp $port;
|
||||
$port ||= 143;
|
||||
print TST "port=$port\n";
|
||||
|
||||
my $authmech = prompt "\nProvide the authentication mechanism to use "
|
||||
. "on $server to\nrun the test (default is LOGIN)";
|
||||
|
||||
chomp $authmech;
|
||||
$authmech ||= 'LOGIN';
|
||||
print TST "authmechanism=$authmech\n";
|
||||
close TST;
|
||||
|
||||
print <<'__THANKS';
|
||||
|
||||
The information you provided (including the password!) has been stored
|
||||
in test.txt and SHOULD BE REMOVED (either by hand or by 'make clean')
|
||||
after testing.
|
||||
__THANKS
|
||||
|
||||
}
|
||||
76
Mail-IMAPClient-3.27/README
Normal file
76
Mail-IMAPClient-3.27/README
Normal file
|
|
@ -0,0 +1,76 @@
|
|||
Mail::IMAPClient
|
||||
================
|
||||
Mail::IMAPClient is a Perl module that provides an interface for
|
||||
communicating with an IMAP server as an IMAP client.
|
||||
|
||||
DEPENDENCIES
|
||||
============
|
||||
The following are the minimum requirements for using Mail::IMAPClient:
|
||||
|
||||
- Perl 5.8
|
||||
http://www.perl.org/
|
||||
- Perl modules from CPAN:
|
||||
http://search.cpan.org/
|
||||
Required:
|
||||
List::Util
|
||||
MIME::Base64
|
||||
Parse::RecDescent
|
||||
Optional:
|
||||
Authen::NTLM
|
||||
Authen::SASL
|
||||
Digest::HMAC_MD5
|
||||
Digest::MD5
|
||||
IO::Socket::SSL
|
||||
- RFC 3501 (IMAP4REV1) compatible IMAP server
|
||||
http://www.faqs.org/rfcs/rfc3501.html
|
||||
- Mail::IMAPClient (this package)
|
||||
|
||||
INSTALLATION
|
||||
============
|
||||
1. Download Mail::IMAPClient module
|
||||
http://search.cpan.org/dist/Mail-IMAPClient/
|
||||
|
||||
2. Read this README
|
||||
|
||||
3. This module has a number of dependencies on other Perl modules
|
||||
available from CPAN. If any modules are missing, appropriate
|
||||
warnings will be generated in the following step.
|
||||
|
||||
4. Prepare to build this module and install any prerequisite modules:
|
||||
|
||||
perl Makefile.PL
|
||||
|
||||
5. Build, test and install this module:
|
||||
|
||||
make
|
||||
make test
|
||||
(sudo) make install
|
||||
|
||||
6. Read the documentation to become familiar with this module.
|
||||
|
||||
Project Links
|
||||
=============
|
||||
- Bugs/tickets:
|
||||
http://rt.cpan.org/Public/Dist/Display.html?Name=Mail-IMAPClient
|
||||
- Source code repository (git):
|
||||
http://sourceforge.net/p/mail-imapclient/git/
|
||||
- CPAN releases:
|
||||
http://search.cpan.org/dist/Mail-IMAPClient/
|
||||
- Project website
|
||||
http://mail-imapclient.sf.net/
|
||||
|
||||
COPYRIGHT AND LICENSE
|
||||
=====================
|
||||
Copyright (C) 1999-2003 The Kernen Group, Inc.
|
||||
Copyright (C) 2007-2009 Mark Overmeer
|
||||
Copyright (C) 2010-2011 Phil Pearl (Lobbes)
|
||||
All rights reserved.
|
||||
|
||||
This library is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself, either Perl version 5.8.0 or,
|
||||
at your option, any later version of Perl 5 you may have available.
|
||||
|
||||
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 either the
|
||||
GNU General Public License or the Artistic License for more details.
|
||||
172
Mail-IMAPClient-3.27/examples/build_dist.pl
Executable file
172
Mail-IMAPClient-3.27/examples/build_dist.pl
Executable file
|
|
@ -0,0 +1,172 @@
|
|||
#!/usr/local/bin/perl
|
||||
#$Id$
|
||||
|
||||
use Mail::IMAPClient;
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
B<build_dist.pl> accepts the name of a target folder as an argument. It
|
||||
then opens that folder and rummages through all the mail files in it, looking
|
||||
for "Reply-to:" headers (or "From:" headers, where there is no "Reply-to:").
|
||||
It then appends a message into the folder containing all of the addresses in
|
||||
thus found as a list of recipients. This message can be used to conveniently
|
||||
drag and drop names into an address book, distribution list, or e-mail message,
|
||||
using the GUI client of choice.
|
||||
|
||||
The email appended to the folder specified in the I<-f> option will have the
|
||||
subject "buid_dist.pl I<folder> Output".
|
||||
|
||||
=head1 SYNTAX
|
||||
|
||||
b<build_dist.pl> I<-h>
|
||||
|
||||
b<build_dist.pl> I<-s servername -u username -p password -f folder [ -d ]>
|
||||
|
||||
=over 4
|
||||
|
||||
=item -f The folder name to process.
|
||||
|
||||
=item -s The servername of the IMAP server
|
||||
|
||||
=item -u The user to log in as
|
||||
|
||||
=item -p The password for the user specified in the I<-u> option
|
||||
|
||||
=item -d Tells the IMAP client to turn on debugging info
|
||||
|
||||
=item -h Prints out this document
|
||||
|
||||
=back
|
||||
|
||||
B<NOTE:> You can supply defaults for the above options by updating the script.
|
||||
|
||||
=cut
|
||||
|
||||
use Getopt::Std;
|
||||
|
||||
getopts('s:u:p:f:d');
|
||||
|
||||
# Update the following to supply defaults:
|
||||
|
||||
$opt_f ||= "default folder";
|
||||
$opt_s ||= "default server";
|
||||
$opt_u ||= "default user";
|
||||
$opt_p ||= "default password"; # security risk: use with caution!
|
||||
|
||||
# Let the compiler know we're serious about these two variables:
|
||||
$opt_h = $opt_h or $opt_d = $opt_d ;
|
||||
|
||||
exec "perldoc $0" if $opt_h;
|
||||
|
||||
my $imap = Mail::IMAPClient->new(
|
||||
Server => $opt_s ,
|
||||
User => $opt_u ,
|
||||
Password=> $opt_p ,
|
||||
Debug => $opt_d||0 ,
|
||||
) or die "can't connect to server\n";
|
||||
|
||||
$imap->select($opt_f);
|
||||
|
||||
my @msgs = $imap->search("NOT SUBJECT",qq("buid_dist.pl $opt_f Output"));
|
||||
my %list;
|
||||
foreach my $m (@msgs) {
|
||||
|
||||
my $ref = $imap->parse_headers($m,"Reply-to","From");
|
||||
|
||||
warn "Couldn't get recipient address from msg#$m\n"
|
||||
unless scalar(@{$ref->{'Reply-to'}}) ||
|
||||
scalar(@{$ref->{'From'}}) ;
|
||||
|
||||
my $from = scalar(@{$ref->{'Reply-to'}}) ?
|
||||
$ref->{'Reply-to'}[0] :
|
||||
$ref->{'From'}[0] ;
|
||||
|
||||
my $addr = $from;
|
||||
$addr =~ s/.*<//;
|
||||
$addr =~ s/[\<\>]//g;
|
||||
$list{$addr} = $from unless exists $list{$addr};
|
||||
}
|
||||
|
||||
$append = <<"EOMSG";
|
||||
To: ${\(join(",",values %list))}
|
||||
From: $opt_u\@$opt_s
|
||||
Date: ${\($imap->Rfc822_date(time))}
|
||||
Subject: build_dist.pl $opt_f Output
|
||||
|
||||
The above note was never actually sent to the following people:
|
||||
|
||||
${\(join("\n",keys %list))}
|
||||
|
||||
Interesting, eh?
|
||||
|
||||
Love,
|
||||
$opt_u
|
||||
|
||||
EOMSG
|
||||
|
||||
$imap->append($opt_f,$append) or warn "Couldn't append the message.";
|
||||
|
||||
$imap->logout;
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
David J. Kernen
|
||||
|
||||
The Kernen Group, Inc.
|
||||
|
||||
imap@kernengroup.com
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
This example and Mail::IMAPClient are Copyright (c) 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
|
||||
|
||||
|
||||
# $Id$
|
||||
# $Log: build_dist.pl,v $
|
||||
# Revision 19991216.7 2003/06/12 21:38:29 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.6 2000/12/11 21:58:50 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:09 dkernen
|
||||
# Bring up to same level
|
||||
#
|
||||
# Revision 19991124.3 1999/12/16 17:14:22 dkernen
|
||||
# Incorporate changes for exists method performance enhancement
|
||||
#
|
||||
# Revision 19991124.02 1999/11/24 17:46:16 dkernen
|
||||
# More fixes to t/basic.t
|
||||
#
|
||||
# Revision 19991124.01 1999/11/24 16:51:46 dkernen
|
||||
# Changed t/basic.t to test for UIDPLUS before trying UID cmds
|
||||
#
|
||||
# Revision 1.8 1999/11/23 17:51:05 dkernen
|
||||
# Committing version 1.06 distribution copy
|
||||
#
|
||||
235
Mail-IMAPClient-3.27/examples/build_ldif.pl
Executable file
235
Mail-IMAPClient-3.27/examples/build_ldif.pl
Executable file
|
|
@ -0,0 +1,235 @@
|
|||
#!/usr/local/bin/perl
|
||||
#$Id$
|
||||
use Mail::IMAPClient;
|
||||
use MIME::Lite;
|
||||
use Data::Dumper;
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
B<build_ldif.pl> accepts the name of a target folder as an argument. It
|
||||
then opens that folder and rummages through all the mail files in it, looking
|
||||
for "Reply-to:" headers (or "From:" headers, where there is no "Reply-to:").
|
||||
It then prints to STDOUT a file in ldif format containing entries for all of
|
||||
the addresses that it finds. It also appends a message into the specified folder containing
|
||||
all of the addresses in both the B<To:> field of the message header and in an
|
||||
LDIF-format attachment.
|
||||
|
||||
B<build_ldif.pl> requires B<MIME::Lite>.
|
||||
|
||||
=head1 SYNTAX
|
||||
|
||||
B<build_ldif.pl> I<-h>
|
||||
|
||||
B<build_ldif.pl> I<-s servername -u username -p password -f folder [ -d ]>
|
||||
|
||||
=over 4
|
||||
|
||||
=item -f The folder name to process.
|
||||
|
||||
=item -s The servername of the IMAP server
|
||||
|
||||
=item -t Include "To" and "Cc" fields as well as "From"
|
||||
|
||||
=item -u The user to log in as
|
||||
|
||||
=item -p The password for the user specified in the I<-u> option
|
||||
|
||||
=item -d Tells the IMAP client to turn on debugging info
|
||||
|
||||
=item -n Suppress delivering message to folder
|
||||
|
||||
=item -h Prints out this document
|
||||
|
||||
=back
|
||||
|
||||
B<NOTE:> You can supply defaults for the above options by updating the script.
|
||||
|
||||
=cut
|
||||
|
||||
use Getopt::Std;
|
||||
|
||||
getopts('hs:u:p:f:dtn');
|
||||
|
||||
# Update the following to supply defaults:
|
||||
|
||||
$opt_f ||= "default folder";
|
||||
$opt_s ||= "default server";
|
||||
$opt_u ||= "default user";
|
||||
$opt_p ||= "default password"; # security risk: use with caution!
|
||||
|
||||
# Let the compiler know we're serious about these variables:
|
||||
$opt_0 = ( $opt_h or $opt_d or $opt_t or $opt_n or $opt_0);
|
||||
|
||||
exec "perldoc $0" if $opt_h;
|
||||
|
||||
my $imap = Mail::IMAPClient->new(
|
||||
Server => $opt_s ,
|
||||
User => $opt_u ,
|
||||
Password=> $opt_p ,
|
||||
Debug => $opt_d||0 ,
|
||||
) or die "can't connect to server\n";
|
||||
|
||||
$imap->select($opt_f); $imap->expunge;
|
||||
|
||||
my @msgs = $imap->search("NOT SUBJECT",qq("buid_ldif.pl $opt_f Output"));
|
||||
my %list;
|
||||
foreach my $m (@msgs) {
|
||||
|
||||
my $ref = $imap->parse_headers($m,"Reply-to","From");
|
||||
|
||||
warn "Couldn't get recipient address from msg#$m\n"
|
||||
unless scalar(@{$ref->{'Reply-to'}}) ||
|
||||
scalar(@{$ref->{'From'}}) ;
|
||||
|
||||
my $from = scalar(@{$ref->{'Reply-to'}}) ?
|
||||
$ref->{'Reply-to'}[0] :
|
||||
$ref->{'From'}[0] ;
|
||||
my $name = $from ;
|
||||
|
||||
$name =~ s/<.*// ;
|
||||
if ($name =~ /\@/) {
|
||||
$name = $from ;
|
||||
$name =~ s/\@.*//; ;
|
||||
}
|
||||
$name =~ s/\"//g ;
|
||||
$name =~ s/^\s+|\s+$//g ;
|
||||
my $addr = $from ;
|
||||
$addr =~ s/.*<// ;
|
||||
$addr =~ s/[\<\>]//g ;
|
||||
$list{lc($addr)} = [ $addr, $name ]
|
||||
unless exists $list{lc($addr)} ;
|
||||
if ($opt_t) { # Do "To" and "Cc", too
|
||||
my $ref = $imap->parse_headers($m,"To","Cc") ;
|
||||
my @array = ( @{$ref->{To}} , @{$ref->{Cc}} ) ;
|
||||
my @members = () ;
|
||||
foreach my $text (@array) {
|
||||
while ( $text =~ / "([^"\\]*(\\.[^"\\]*)*"[^,]*),? |
|
||||
([^",]+),? |
|
||||
,
|
||||
/gx
|
||||
) {
|
||||
push @members, defined($1)?$1:$3 ;
|
||||
}
|
||||
}
|
||||
foreach my $to (@members) {
|
||||
|
||||
my $name = $to ;
|
||||
|
||||
$name =~ s/<.*// ;
|
||||
if ($name =~ /\@/) {
|
||||
$name = $to ;
|
||||
$name =~ s/\@.*//; ;
|
||||
}
|
||||
$name =~ s/\"//g ;
|
||||
$name =~ s/^\s+|\s+$//g ;
|
||||
my $addr = $to ;
|
||||
$addr =~ s/.*<// ;
|
||||
$addr =~ s/[\<\>]//g ;
|
||||
$list{lc($addr)} = [ $addr, $name ]
|
||||
unless exists $list{lc($addr)} ;
|
||||
}
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
my $text = join "",map {
|
||||
qq{dn: cn="} . $list{$_}[1] .
|
||||
qq{", mail=$list{$_}[0]\n} .
|
||||
qq{cn: } . $list{$_}[1] . qq{\n} .
|
||||
qq{mail: $list{$_}[0]\n} .
|
||||
qq{objectclass: top\nobjectclass: person\n\n};
|
||||
} keys %list ;
|
||||
|
||||
# Create a new multipart message:
|
||||
my $msg = MIME::Lite->new(
|
||||
From => $opt_u,
|
||||
map({ ("To" => $list{$_}[0]) } keys %list),
|
||||
Subject => "LDIF file from $opt_f",
|
||||
Type =>'TEXT',
|
||||
Data =>"Attached is the LDIF file of addresses from folder $opt_f."
|
||||
);
|
||||
$msg->attach( Type =>'text/ldif',
|
||||
Filename => "$opt_f.ldif",
|
||||
Data => $text ,
|
||||
);
|
||||
print $text;
|
||||
$imap->append($opt_f, $msg->as_string) unless $opt_n;
|
||||
print Dumper($imap) if $opt_d;
|
||||
$imap->logout;
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
David J. Kernen
|
||||
|
||||
The Kernen Group, Inc.
|
||||
|
||||
imap@kernengroup.com
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
This example and Mail::IMAPClient are Copyright (c) 1999,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
|
||||
|
||||
# $Id$
|
||||
# $Log: build_ldif.pl,v $
|
||||
# Revision 19991216.11 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.10 2002/05/24 15:47:18 dkernen
|
||||
# Misc fixes
|
||||
#
|
||||
# Revision 19991216.9 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
|
||||
#
|
||||
# Revision 19991216.8 2000/03/02 19:57:13 dkernen
|
||||
#
|
||||
# Modified Files: build_ldif.pl -- to support new option to all "To:" and "Cc:" to be included in ldif file
|
||||
#
|
||||
# Revision 19991216.7 2000/02/21 16:16:10 dkernen
|
||||
#
|
||||
# Modified Files: build_ldif.pl -- to allow for "To:" and "Cc:" header handling and
|
||||
# to handle quoted names in headers
|
||||
#
|
||||
# Revision 19991216.6 1999/12/28 13:56:59 dkernen
|
||||
# Fixed -h option (help).
|
||||
#
|
||||
# Revision 19991216.5 1999/12/16 17:19:10 dkernen
|
||||
# Bring up to same level
|
||||
#
|
||||
# Revision 19991124.3 1999/12/16 17:14:24 dkernen
|
||||
# Incorporate changes for exists method performance enhancement
|
||||
#
|
||||
# Revision 19991124.02 1999/11/24 17:46:18 dkernen
|
||||
# More fixes to t/basic.t
|
||||
#
|
||||
# Revision 19991124.01 1999/11/24 16:51:48 dkernen
|
||||
# Changed t/basic.t to test for UIDPLUS before trying UID cmds
|
||||
#
|
||||
# Revision 1.8 1999/11/23 17:51:05 dkernen
|
||||
# Committing version 1.06 distribution copy
|
||||
#
|
||||
64
Mail-IMAPClient-3.27/examples/cleanTest.pl
Executable file
64
Mail-IMAPClient-3.27/examples/cleanTest.pl
Executable file
|
|
@ -0,0 +1,64 @@
|
|||
#!/usr/local/bin/perl
|
||||
|
||||
use Mail::IMAPClient;
|
||||
use IO::File;
|
||||
#
|
||||
# Example that will also clean out your test account if interrupted 'make test'
|
||||
# runs have left junk folders there. Run from installation dir, installation/examples
|
||||
# subdir, or supply full path to the test.txt file (created during 'perl Makefile.PL'
|
||||
# and left in the installation dir until 'make clean').
|
||||
# If you 've already run 'make clean' or said no to extended tests,
|
||||
# then you don't have the file anyway; re-run 'perl Makefile.PL', reply 'y' to the
|
||||
# extended tests prompt, then supply the test account's credentials as prompted.
|
||||
# Then try this again.
|
||||
#
|
||||
if ( -f "./test.txt" ) {
|
||||
$configFile = "./test.txt"
|
||||
} elsif ( -f "../test.txt" ) {
|
||||
$configFile = "../test.txt"
|
||||
} elsif ( $ARGV[0] and -f "$ARGV[0]" ) {
|
||||
$configFile = $ARGV[0];
|
||||
} else {
|
||||
print STDERR "Can't find test.txt. Please run this from the installation directory ",
|
||||
"or supply the full path to test.txt as an argument on the command line.\n";
|
||||
}
|
||||
my $fh = IO::File->new("./test.txt") or die "./test.txt: $!\n";
|
||||
while (my $input = <$fh>) {
|
||||
chomp $input;
|
||||
my($k,$v) = split(/=/,$input,2);
|
||||
$conf{$k}=$v;
|
||||
}
|
||||
my $imap = Mail::IMAPClient->new(Server=>$conf{server},User=>$conf{user},
|
||||
Password=>$conf{passed}) or die "Connecting to $conf{server}: $! $@\n";
|
||||
|
||||
for my $f ( grep(/^IMAPClient_/,$imap->folders) ) {
|
||||
print "Deleting $f\n";
|
||||
$imap->select($f);
|
||||
$imap->delete_messages(@{$imap->messages}) ;
|
||||
$imap->close($f);
|
||||
$imap->delete($f);
|
||||
}
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
David J. Kernen
|
||||
|
||||
The Kernen Group, Inc.
|
||||
|
||||
imap@kernengroup.com
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
This example and Mail::IMAPClient are Copyright (c) 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
|
||||
|
||||
147
Mail-IMAPClient-3.27/examples/copy_folder.pl
Executable file
147
Mail-IMAPClient-3.27/examples/copy_folder.pl
Executable file
|
|
@ -0,0 +1,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
|
||||
#
|
||||
111
Mail-IMAPClient-3.27/examples/cyrus_expire.pl
Executable file
111
Mail-IMAPClient-3.27/examples/cyrus_expire.pl
Executable file
|
|
@ -0,0 +1,111 @@
|
|||
#!/usr/local/bin/perl
|
||||
#$Id
|
||||
|
||||
use Mail::IMAPClient; # available from http://search.cpan.org/search?mode=module&query=IMAPClient
|
||||
use IO::File;
|
||||
use Getopt::Std;
|
||||
use vars qw/ $opt_d $opt_s $opt_p $opt_u $opt_P $opt_h /;
|
||||
|
||||
&getopts('d:s:u:p:P:h'); # -d days_to_keep -u cyrys_user -p cyrus_pswd -s cyrus_server -P port
|
||||
|
||||
my $days_to_keep = $opt_d||365; # Delete msgs older than -d arg or 365 days
|
||||
my $cutoff = time - ( $days_to_keep * 24 * 60 * 60 ) ; # time - arg * 24 * 60 * 60 = cutoff date in seconds
|
||||
|
||||
# Change the following line (or replace it with something better):
|
||||
$opt_h and die help()."\n";
|
||||
my $h = $opt_s || "localhost" ;
|
||||
my $u = $opt_u || "cyrys" ;
|
||||
my $p = $opt_p or die "Unable to continue. No password provided.\n" . help();
|
||||
|
||||
my $imap = Mail::IMAPClient->new(
|
||||
Server => "$h",
|
||||
User => "$u", # $u,
|
||||
Password=> "$p", # $p,
|
||||
Uid => 1, # True value
|
||||
Port => $opt_P||143, # imapd
|
||||
Debug => 0, # Make true to debug
|
||||
Buffer => 4096*10, # True value; decrease on machines w/little memory
|
||||
Fast_io => 1, # True value
|
||||
Timeout => 30, # True value
|
||||
# Debug_fh=> IO::File->new(">out.db"), # fhandle
|
||||
)
|
||||
or die "$@";
|
||||
my $mcnt = my $fcnt = 0;
|
||||
print "Deleting messages older than ",$imap->Rfc2060_date($cutoff),"\n";
|
||||
for my $f ( $imap->folders ) {
|
||||
print "Expiring $f\n";
|
||||
unless ($imap->select($f) ) {
|
||||
$imap->setacl($f,$u,"lrswipcda") or warn "Cannot setacl for $f: $@\n" and next;
|
||||
$imap->select($f) or warn "Cannot select $f: $@" and next;
|
||||
}
|
||||
my @expired = $imap->search("SENTBEFORE",$imap->Rfc2060_date($cutoff));
|
||||
next unless @expired;
|
||||
$mcnt += scalar(@expired); $fcnt ++;
|
||||
print "Deleting ",scalar(@expired)," messages from $f\n";
|
||||
$imap->delete_message(@expired);
|
||||
$imap->expunge;
|
||||
$imap->close;
|
||||
}
|
||||
$imap->logout;
|
||||
print "Deleted a total of $mcnt messages in $fcnt folders.\n";
|
||||
exit;
|
||||
|
||||
|
||||
sub help {
|
||||
return <<"EOHELP";
|
||||
|
||||
Usage:
|
||||
|
||||
$0 [ -d days_to_keep ] [ -s mail_server ] [ -u cyrus_admin_id ] -p cyrus_password
|
||||
$0 -h
|
||||
|
||||
-h -- prints this here help message
|
||||
-d days_to_keep -- $0 will delete messages older than "days_to_keep". (Default is 365)
|
||||
-s mail_server -- hostname or IP Address of IMAP mail server (defaults to "localhost")
|
||||
-u cyrus_admin_id -- user name of Unix account that owns Cyrus server (defaults to "cyrus")
|
||||
-p cyrus_password -- password for the "cyrus_admin_id" user account (no default)
|
||||
-P cyrus_port -- port where the cyrus imapd daemon is listening (defaults to value from
|
||||
/etc/services or '143')
|
||||
|
||||
EOHELP
|
||||
|
||||
}
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
David J. Kernen
|
||||
|
||||
The Kernen Group, Inc.
|
||||
|
||||
imap@kernengroup.com
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
This example and Mail::IMAPClient are Copyright (c) 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
|
||||
|
||||
#$Log: cyrus_expire.pl,v $
|
||||
#Revision 19991216.2 2003/06/12 21:38:31 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
|
||||
#
|
||||
85
Mail-IMAPClient-3.27/examples/cyrus_expunge.pl
Executable file
85
Mail-IMAPClient-3.27/examples/cyrus_expunge.pl
Executable file
|
|
@ -0,0 +1,85 @@
|
|||
#!/usr/local/bin/perl
|
||||
#$Id$
|
||||
|
||||
use Mail::IMAPClient;
|
||||
use IO::File;
|
||||
|
||||
# Change the following line (or replace it with something better):
|
||||
my($h,$u,$p) = ('cyrus_host','cyrus_admin_id','cyrus_admin_pswd');
|
||||
|
||||
my $imap = Mail::IMAPClient->new( Server => "$h", # imap host
|
||||
User => "$u", # $u,
|
||||
Password=> "$p", # $p,
|
||||
Uid => 1, # True value
|
||||
Port => 143, # Cyrus
|
||||
Debug => 0, # True value
|
||||
Buffer => 4096*10, # True value
|
||||
Fast_io => 1, # True value
|
||||
Timeout => 30, # True value
|
||||
# Debug_fh=> IO::File->new(">out.db"), # fhandle
|
||||
)
|
||||
or die "$@";
|
||||
|
||||
for my $f ( $imap->folders ) {
|
||||
print "Expunging $f\n";
|
||||
unless ($imap->select($f) ) {
|
||||
$imap->setacl($f,$u,"lrswipcda") or warn "Cannot setacl for $f: $@\n" and next;
|
||||
$imap->select($f) or warn "Cannot select $f: $@" and next;
|
||||
}
|
||||
$imap->expunge;
|
||||
}
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
David J. Kernen
|
||||
|
||||
The Kernen Group, Inc.
|
||||
|
||||
imap@kernengroup.com
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
This example and Mail::IMAPClient are Copyright (c) 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
|
||||
|
||||
#
|
||||
#$Log: cyrus_expunge.pl,v $
|
||||
#Revision 19991216.3 2003/06/12 21:38:31 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 1.1 2003/06/12 21:38:14 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
|
||||
#
|
||||
#
|
||||
217
Mail-IMAPClient-3.27/examples/find_dup_msgs.pl
Executable file
217
Mail-IMAPClient-3.27/examples/find_dup_msgs.pl
Executable file
|
|
@ -0,0 +1,217 @@
|
|||
#!/usr/local/bin/perl
|
||||
# $Id$
|
||||
|
||||
use Mail::IMAPClient;
|
||||
use Mozilla::LDAP::Conn;
|
||||
use Getopt::Std;
|
||||
use vars qw/$rootdn $opt_a/;
|
||||
use Data::Dumper;
|
||||
|
||||
# It then connects to a user's mailhost and rummages around,
|
||||
# looking for duplicate messages.
|
||||
# It will optionally delete messages that are duplicates (based on
|
||||
# msg-id header and number of bytes).
|
||||
# For help, enter:
|
||||
# find_dup_msgs.pl -h
|
||||
#
|
||||
|
||||
getopts('ahdtvf:F:u:s:p:P:');
|
||||
|
||||
if ( $opt_h ) {
|
||||
print STDERR &usage;
|
||||
exit;
|
||||
}
|
||||
|
||||
my $uid = $opt_u or die &usage;
|
||||
$opt_s||='localhost';
|
||||
$opt_p or die &usage;
|
||||
$opt_P||=143;
|
||||
|
||||
$opt_t and
|
||||
$opt_d and
|
||||
die "ERROR: Don't specify -d and -t together.\n" . &usage;
|
||||
|
||||
|
||||
my($pu,$pp) = get_admin();
|
||||
|
||||
print "Connecting to $host:$opt_P\n" if $opt_v;
|
||||
my $imap = Imap->new( Server => $opt_s,
|
||||
User => $opt_u,
|
||||
Password=> $opt_p,
|
||||
Port => $opt_P,
|
||||
Fast_io => 1,
|
||||
) or die "couldn't connect to $host port $opt_P: $!\n";
|
||||
|
||||
my %folders; my %counts;
|
||||
|
||||
FOLDER: foreach my $f ( $opt_F ? $opt_F : $imap->folders ) {
|
||||
next if $opt_t and $f eq 'Trash';
|
||||
$folders{$f} = 0;
|
||||
$counts{$f} = $imap->message_count($f);
|
||||
print "Processing folder $f\n" if $opt_v;
|
||||
unless ( $imap->select($f)) {
|
||||
warn "Error selecting $f: " . $imap->LastError . "\n";
|
||||
next FOLDER;
|
||||
}
|
||||
my @msgs = $imap->search("ALL");
|
||||
my %hash = ();
|
||||
MESSAGE: foreach my $m (@msgs) {
|
||||
my $mid;
|
||||
if ($opt_a) {
|
||||
my $h = $imap->parse_headers(
|
||||
$m,"Date","Subject","From","Message-ID"
|
||||
) or next MESSAGE;
|
||||
$mid = "$h->{'Date'}[0]$;$h->{'Subject'}[0]$;".
|
||||
"$h->{'From'}[0]$;$h->{'Message-ID'}[0]";
|
||||
|
||||
} else {
|
||||
$mid = $imap->parse_headers(
|
||||
$m,
|
||||
"Message-ID"
|
||||
)->{'Message-ID'}[0]
|
||||
or next MESSAGE;
|
||||
}
|
||||
my $size = $imap->size($m);
|
||||
if ( exists $hash{$mid} and $hash{$mid} == $size ) {
|
||||
if ($opt_f) {
|
||||
open F,">>$opt_f" or
|
||||
die "can't open $opt_f: $!\n";
|
||||
print F $imap->message_string($m),
|
||||
"___END OF SAVED MESSAGE___","\n";
|
||||
close F;
|
||||
}
|
||||
$imap->move("Trash",$m) if $opt_t;
|
||||
$imap->delete_message($m) if $opt_d;
|
||||
$folders{$f}++;
|
||||
print "Found a duplicate in ${f}; key = $mid\n" if $opt_v;
|
||||
|
||||
} else {
|
||||
|
||||
$hash{$mid} = $size;
|
||||
}
|
||||
}
|
||||
print "$f hash:\n",Data::Dumper::Dumper(\%hash) if $opt_v;
|
||||
$imap->expunge if ($opt_t or $opt_d);
|
||||
}
|
||||
|
||||
my $total; my $totms;
|
||||
map { $total += $_} values %folders;
|
||||
map { $totms += $_ } values %counts;
|
||||
print "Found $total duplicate messages in ${uid}'s mailbox. ",
|
||||
"The breakdown is:\n",
|
||||
"\tFolder\tNumber of Duplicates\tNumber of Msgs in Folder\n",
|
||||
"\t------\t--------------------\t------------------------\n",
|
||||
map { "\t$_\t$folders{$_}\t$counts{$_}\n" } keys %folders,
|
||||
"\tTOTAL\t$total\t$totms\n"
|
||||
;
|
||||
|
||||
|
||||
sub usage {
|
||||
return "Usage:\n" .
|
||||
"\t$0 [-d|-t] [-v] [-f filename] [-a] [-P port] \\\n".
|
||||
"\t\t-s server -u user -p password\n\n" .
|
||||
"\t-a\t\tdo an especially aggressive search for duplicates\n".
|
||||
"\t-d\t\tdelete duplicates (default is to just report them)\n".
|
||||
"\t-f file\t\tsave deleted messages in file named 'file'\n" .
|
||||
"\t-F fldr\t\tOnly check the folder named 'fldr' (default is to check all folders)\n" .
|
||||
"\t-h\t\tprint this help message (all other options are ignored)\n" .
|
||||
"\t-p password\tspecify the target user's password\n" .
|
||||
"\t-P port\t\tspecify the port to connect to (default is 143)\n" .
|
||||
"\t-s server\tspecify the target mail server\n" .
|
||||
"\t-u uid\t\tspecify the target user\n" .
|
||||
"\t-t\t\tmove deleted messages to trash folder\n" .
|
||||
"\t-v\t\tprint verbose status messages while processing\n".
|
||||
"\n" ;
|
||||
}
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
David J. Kernen
|
||||
|
||||
The Kernen Group, Inc.
|
||||
|
||||
imap@kernengroup.com
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
This example and Mail::IMAPClient are Copyright (c) 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: find_dup_msgs.pl,v $
|
||||
# Revision 19991216.5 2003/06/12 21:38:32 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 1.1 2003/06/12 21:38:14 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.4 2002/08/23 14:34:51 dkernen
|
||||
#
|
||||
# Modified Files: Changes IMAPClient.pm Makefile Makefile.PL test.txt for version 2.2.0
|
||||
# Added Files: Makefile Makefile.PL Parse.grammar Parse.pm Parse.pod version 2.2.0
|
||||
# Added Files: parse.t for version 2.2.0
|
||||
# Added Files: bodystructure.t for 2.2.0
|
||||
# Modified Files: find_dup_msgs.pl for v2.2.0
|
||||
#
|
||||
# Revision 1.6 2001/03/08 19:00:35 dkernen
|
||||
#
|
||||
# ----------------------------------------------------------------------
|
||||
# Modified Files:
|
||||
# copy_folder.pl delete_mailbox.pl find_dup_msgs.pl
|
||||
# mbox_check.pl process_orphans.pl rename_id.pl
|
||||
# scratch_indexes.pl
|
||||
# to get ready for nsusmsg02 upgrade
|
||||
# ----------------------------------------------------------------------
|
||||
#
|
||||
# Revision 1.5 2000/11/01 15:51:58 dkernen
|
||||
#
|
||||
# Modified Files: copy_folder.pl find_dup_msgs.pl restore_mbox.pl
|
||||
#
|
||||
# Revision 1.4 2000/04/13 21:17:18 dkernen
|
||||
#
|
||||
# Modified Files: find_dup_msgs.pl - to add -a switch (for aggressive dup search)
|
||||
# Added Files: copy_folder.pl - a utility for copying a folder from one user's
|
||||
# mailbox to another's
|
||||
#
|
||||
# Revision 1.3 2000/03/14 16:40:21 dkernen
|
||||
#
|
||||
# Modified Files: find_dup_msgs.pl -- to skip msgs with no message-id
|
||||
#
|
||||
# Revision 1.2 2000/03/13 19:05:50 dkernen
|
||||
#
|
||||
# Modified Files:
|
||||
# delete_mailbox.pl find_dup_msgs.pl restore_mbox.pl -- to add cvs comments
|
||||
# find_dup_msgs.pl -- to fix bug that occurred when -t (move-to-trash) switch is used
|
||||
#
|
||||
231
Mail-IMAPClient-3.27/examples/idle.pl
Executable file
231
Mail-IMAPClient-3.27/examples/idle.pl
Executable file
|
|
@ -0,0 +1,231 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
=head1 NAME
|
||||
|
||||
idle.pl - example using IMAP idle
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
idle.pl [options]
|
||||
|
||||
Options: [*] == Required, [+] == Multiple vals OK, (val) == Default
|
||||
--o Server=<server> *IMAP server name/IP
|
||||
--o User=<user> *User account to login to
|
||||
--o Password=<passwd> *Password to use for the User account
|
||||
(see security note below)
|
||||
--o Port=<port> port on Server to connect to
|
||||
--o Ssl=<bool> use SSL on this connection
|
||||
--o Starttls=<bool> call STARTTLS on this connection
|
||||
--o Debug=<int> enable debugging in Mail::IMAPClient
|
||||
--o ImapclientKey=Val any other Mail::IMAPClient attribute/value pair
|
||||
--folder <folder> folder (mailbox) to IMAP SELECT (INBOX)
|
||||
--maxidle <sec> maximum time to idle without receiving data (300)
|
||||
--help display a brief help message
|
||||
--man display the entire man page
|
||||
--debug enable script debugging
|
||||
|
||||
=head1 NOTES
|
||||
|
||||
=head2 --o Password=<password>
|
||||
|
||||
A password specified as a command-line option may be visible
|
||||
to other users via the system process table. It may alternately be
|
||||
given in the PASSWORD environment variable.
|
||||
|
||||
=head2 --maxidle <sec>
|
||||
|
||||
RFC 2177 states, "The server MAY consider a client inactive if it has
|
||||
an IDLE command running, and if such a server has an inactivity
|
||||
timeout it MAY log the client off implicitly at the end of its timeout
|
||||
period. Because of that, clients using IDLE are advised to terminate
|
||||
the IDLE and re-issue it at least every 29 minutes to avoid being
|
||||
logged off."
|
||||
|
||||
The default of --maxidle 300 is used to allow the client to notice
|
||||
when a connection has silently been closed upstream due to network or
|
||||
firewall issue or configuration without missing too many idle events.
|
||||
|
||||
=cut
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use File::Basename qw(basename);
|
||||
use Getopt::Long qw(GetOptions);
|
||||
use Mail::IMAPClient qw();
|
||||
use Pod::Usage qw(pod2usage);
|
||||
use POSIX qw();
|
||||
|
||||
use constant {
|
||||
FOLDER => "INBOX",
|
||||
MAXIDLE => 300,
|
||||
};
|
||||
|
||||
$| = 1; # set autoflush
|
||||
|
||||
my $DEBUG = 0; # GLOBAL set by process_options()
|
||||
my $QUIT = 0;
|
||||
my $VERSION = "1.00";
|
||||
my $Prog = basename($0);
|
||||
|
||||
###
|
||||
# main program
|
||||
main();
|
||||
|
||||
sub main {
|
||||
my %Opt = process_options();
|
||||
|
||||
pout("started $Prog\n");
|
||||
|
||||
my $imap = Mail::IMAPClient->new( %{ $Opt{opt} } )
|
||||
or die("$Prog: error: Mail::IMAPClient->new: $@\n");
|
||||
|
||||
my ( $folder, $chkseen, $tag ) = ( $Opt{folder}, 1, undef );
|
||||
|
||||
$imap->select($folder)
|
||||
or die("$Prog: error: select '$folder': $@\n");
|
||||
|
||||
$SIG{'INT'} = \&sigint_handler;
|
||||
|
||||
until ($QUIT) {
|
||||
unless ( $imap->IsConnected ) {
|
||||
warn("$Prog: reconnecting due to error: $@\n") if $imap->LastError;
|
||||
$imap->connect or last;
|
||||
$imap->select($folder) or last;
|
||||
$tag = undef;
|
||||
}
|
||||
|
||||
my $ret;
|
||||
if ($chkseen) {
|
||||
$chkseen = 0;
|
||||
|
||||
# end idle if necessary
|
||||
if ($tag) {
|
||||
$tag = undef;
|
||||
$ret = $imap->done or last;
|
||||
}
|
||||
|
||||
my $unseen = $imap->unseen_count;
|
||||
last if $@;
|
||||
pout("$unseen unseen/new message(s) in '$folder'\n") if $unseen;
|
||||
}
|
||||
|
||||
# idle for X seconds unless data was returned by done
|
||||
unless ($ret) {
|
||||
$tag ||= $imap->idle
|
||||
or die("$Prog: error: idle: $@\n");
|
||||
|
||||
warn( "$Prog: DEBUG: ", _ts(), " do idle_data($Opt{maxidle})\n" )
|
||||
if $DEBUG;
|
||||
$ret = $imap->idle_data( $Opt{maxidle} ) or last;
|
||||
|
||||
# connection can go stale so we exit/re-enter of idle state
|
||||
# - RFC 2177 mentions 29m but firewalls may be more strict
|
||||
unless (@$ret) {
|
||||
warn( "$Prog: DEBUG: ", _ts(), " force exit of idle\n" )
|
||||
if $DEBUG;
|
||||
$tag = undef;
|
||||
|
||||
# restarted lost connections on next iteration
|
||||
$ret = $imap->done or next;
|
||||
}
|
||||
}
|
||||
|
||||
local ( $1, $2, $3 );
|
||||
foreach my $resp (@$ret) {
|
||||
$resp =~ s/\015?\012$//;
|
||||
|
||||
warn("$Prog: DEBUG: server response: $resp\n") if $DEBUG;
|
||||
|
||||
# ignore:
|
||||
# - DONE command
|
||||
# - <tag> OK IDLE...
|
||||
next if ( $resp eq "DONE" );
|
||||
next if ( $resp =~ /^\w+\s+OK\s+IDLE\b/ );
|
||||
|
||||
if ( $resp =~ /^\*\s+(\d+)\s+(EXISTS)\b/ ) {
|
||||
my ( $num, $what ) = ( $1, $2 );
|
||||
pout("$what: $num message(s) in '$folder'\n");
|
||||
$chkseen++;
|
||||
}
|
||||
elsif ( $resp =~ /^\*\s+(\d+)\s+(EXPUNGE)\b/ ) {
|
||||
my ( $num, $what ) = ( $1, $2 );
|
||||
pout("$what: message $num from '$folder'\n");
|
||||
}
|
||||
|
||||
# * 83 FETCH (FLAGS (\Seen))
|
||||
elsif ( $resp =~ /^\*\s+(\d+)\s+(FETCH)\s+(.*)/ ) {
|
||||
my ( $num, $what, $info ) = ( $1, $2, $3 );
|
||||
$chkseen++ if ( $info =~ /[\(|\s]\\Seen[\)|\s]/ );
|
||||
pout("$what: message $num from '$folder': $info\n");
|
||||
}
|
||||
else {
|
||||
pout("server response: $resp\n");
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
my $rc = 0;
|
||||
if ($@) {
|
||||
if ($QUIT) {
|
||||
warn("$Prog: caught signal\n");
|
||||
}
|
||||
else {
|
||||
$rc = 1;
|
||||
}
|
||||
warn("$Prog: imap error: $@\n") if ( !$QUIT || $DEBUG );
|
||||
}
|
||||
exit($rc);
|
||||
}
|
||||
|
||||
###
|
||||
# supporting routines
|
||||
|
||||
sub pout {
|
||||
print( _ts(), " ", @_ );
|
||||
}
|
||||
|
||||
sub process_options {
|
||||
my ( %Opt, @err );
|
||||
|
||||
GetOptions( \%Opt, "opt=s%", "debug:1", "help", "man", "folder=s",
|
||||
"maxidle:i" )
|
||||
or pod2usage( -verbose => 0 );
|
||||
|
||||
pod2usage( -message => "$Prog: version $VERSION\n", -verbose => 1 )
|
||||
if ( $Opt{help} );
|
||||
pod2usage( -verbose => 2 ) if ( $Opt{man} );
|
||||
|
||||
# set global DEBUG
|
||||
$DEBUG = $Opt{debug} || 0;
|
||||
|
||||
# folder (mailbox) to watch
|
||||
$Opt{folder} = FOLDER unless ( exists $Opt{folder} );
|
||||
|
||||
# restart idle when no idle_data seen for this long
|
||||
$Opt{maxidle} = MAXIDLE unless ( exists $Opt{maxidle} );
|
||||
|
||||
$Opt{opt}->{Password} = $ENV{PASSWORD}
|
||||
if ( !exists $Opt{opt}->{Password} && defined $ENV{PASSWORD} );
|
||||
|
||||
foreach my $arg (qw(Server User Password)) {
|
||||
push( @err, "-o $arg=<val> is required" ) if !exists $Opt{opt}->{$arg};
|
||||
}
|
||||
|
||||
pod2usage(
|
||||
-verbose => 1,
|
||||
-message => join( "", map( "$Prog: $_\n", @err ) )
|
||||
) if (@err);
|
||||
|
||||
return %Opt;
|
||||
}
|
||||
|
||||
# example: 2005-10-02 07:50:32
|
||||
sub _ts {
|
||||
my %opt = @_;
|
||||
my $fmt = $opt{fmt} || "%Y-%m-%d %T";
|
||||
return POSIX::strftime( $fmt, localtime(time) );
|
||||
}
|
||||
|
||||
sub sigint_handler {
|
||||
$QUIT = 1;
|
||||
}
|
||||
266
Mail-IMAPClient-3.27/examples/imap_to_mbox.pl
Executable file
266
Mail-IMAPClient-3.27/examples/imap_to_mbox.pl
Executable file
|
|
@ -0,0 +1,266 @@
|
|||
#!/usr/local/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$
|
||||
|
||||
# History:
|
||||
# --------
|
||||
# 2008/08/07 - Added SSL support, fixed From header printing, and CR
|
||||
# elimination (sobek)
|
||||
|
||||
# TODO:
|
||||
# -----
|
||||
# lsub instead of list option
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
use Mail::IMAPClient; # a nice set of perl libs for imap
|
||||
use IO::Socket::SSL; # for SSL support
|
||||
|
||||
use vars qw($opt_h $opt_u $opt_p $opt_P $opt_s $opt_i $opt_f $opt_m $opt_b
|
||||
$opt_c $opt_r $opt_w $opt_W $opt_S $opt_D $opt_U $opt_d $opt_I
|
||||
$opt_n);
|
||||
|
||||
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.
|
||||
use Date::Manip; # to create From header date
|
||||
$| = 1;
|
||||
|
||||
sub connect_imap();
|
||||
sub find_folders();
|
||||
sub write_folder($$$$);
|
||||
sub help();
|
||||
|
||||
# Config for the imap migration kit.
|
||||
|
||||
getopts('u:p:P:s:i:f:m:b:c:r:w:W:SDUdhIn:') or
|
||||
$opt_h = 1;
|
||||
|
||||
my $SSL = $opt_S || 0;
|
||||
my $SERVER = $opt_s || 'machine';
|
||||
my $USER = $opt_u || 'userid';
|
||||
my $PASSWORD = $opt_p || 'password';
|
||||
my $PORT = $opt_P || '143';
|
||||
my $INBOX_PATH = $opt_i || "/var/mail/$USER";
|
||||
my $DOINBOX = $opt_I ? 0 : 1 || 1;
|
||||
my $FOLDERS_PATH = $opt_f || "./folders/$USER";
|
||||
my $DONT_MOVE = $opt_m || '.mailboxlist|Trash|INBOXIIMAP|mlbxl';
|
||||
my $READ_DELIMITER = $opt_r || '/';
|
||||
my $WRITE_DELIMITER = $opt_w || '/';
|
||||
my $WRITE_MODE = $opt_W || '>';
|
||||
my $BANNED_CHARS = $opt_b || '.|^|%';
|
||||
my $CR = $opt_c || "\r";
|
||||
my $NUMBER = $opt_n || "";
|
||||
my $DELETE = $opt_D || 0;
|
||||
my $DEBUG = $opt_d || "0";
|
||||
my $UNSEEN = $opt_U || 0;
|
||||
my $FAIL = 0;
|
||||
|
||||
my $imap; # definition for IMAP structure
|
||||
|
||||
if ($opt_h) {
|
||||
# print help here
|
||||
help();
|
||||
}
|
||||
|
||||
sub help() {
|
||||
print "imap_to_mbox.pl - with the following optional arguments\:
|
||||
-S Use an SSL connection (default $SSL)
|
||||
-s <s> Server specification (default $SERVER)
|
||||
-u <u> User login (default $USER)
|
||||
-p <p> User password
|
||||
-P <p> Server Port (default $PORT)
|
||||
-i <i> INBOX save path (default $INBOX_PATH)
|
||||
-I skip INBOX (default $DOINBOX)
|
||||
-f <f> Save path for other folders (default $FOLDERS_PATH)
|
||||
-m <r> Regexp for IMAP folders not to be saved:
|
||||
$DONT_MOVE
|
||||
-r <r> Read delimiter (default \"$READ_DELIMITER\")
|
||||
-w <w> Write Delimiter (default \"$WRITE_DELIMITER\")
|
||||
-b <b> Banned chars (default \"$BANNED_CHARS\")
|
||||
-c <c> Strip CRs from saved files [for Unix] (default \"$CR\")
|
||||
-n <n> Receive only <n> messages (Default ".($NUMBER ? "$NUMBER" : "all").")
|
||||
-U Unseen messages Only
|
||||
-D Delete downloaded files on server
|
||||
-d Debug mode (default $DEBUG)\n";
|
||||
exit 1;
|
||||
}
|
||||
|
||||
## do our magic tricks ######################################
|
||||
connect_imap();
|
||||
find_folders();
|
||||
|
||||
|
||||
sub connect_imap()
|
||||
{
|
||||
# Open an SSL session to the IMAP server
|
||||
# Handles the SSL setup, and gives us back a socket
|
||||
my $ssl;
|
||||
if ($opt_S) {
|
||||
$ssl=IO::Socket::SSL->new(
|
||||
PeerHost => "$SERVER:imaps"
|
||||
# , SSL_version => 'SSLv2' # for older versions of openssl
|
||||
);
|
||||
|
||||
defined $ssl
|
||||
or die "Error connecting to $SERVER:imaps - $@";
|
||||
|
||||
$ssl->autoflush(1);
|
||||
}
|
||||
|
||||
$imap = Mail::IMAPClient->new(
|
||||
Socket => ($opt_S ? $ssl : 0),
|
||||
Server => $SERVER,
|
||||
User => $USER,
|
||||
Password => $PASSWORD,
|
||||
Port => $PORT,
|
||||
Debug => $DEBUG,
|
||||
Uid => 0,
|
||||
Clear => 1,
|
||||
)
|
||||
or die ("Could not connect to $SERVER:$PORT with $USER: $! $?\n");
|
||||
}
|
||||
|
||||
sub find_folders()
|
||||
{
|
||||
my @folders = $imap->folders;
|
||||
# push(@folders, "INBOX");
|
||||
|
||||
foreach my $folder (@folders) {
|
||||
my $message_count;
|
||||
|
||||
if ($folder eq "INBOX" and $DOINBOX == 0) {
|
||||
print "* $folder is unwanted, skipping.\n";
|
||||
next;
|
||||
}
|
||||
if (!$UNSEEN) {
|
||||
$message_count = $imap->message_count($folder);
|
||||
} else {
|
||||
$message_count = $imap->unseen_count($folder) || 0;
|
||||
}
|
||||
if(! $message_count) {
|
||||
print "* $folder is empty, skipping.\n";
|
||||
next;
|
||||
}
|
||||
if($folder =~ /$DONT_MOVE/) {
|
||||
warn "! $folder matches DONT_MOVE ruleset, skipping\n";
|
||||
next;
|
||||
}
|
||||
|
||||
my $new_folder = $folder;
|
||||
$new_folder =~ s/\./_/g;
|
||||
$new_folder =~ s/\Q$READ_DELIMITER/$WRITE_DELIMITER/g;
|
||||
my $path
|
||||
= $new_folder eq "INBOX" ? "$INBOX_PATH"
|
||||
: "$FOLDERS_PATH/$new_folder";
|
||||
|
||||
if ($NUMBER && $NUMBER < $message_count) {
|
||||
printf "x %4i %-45.45s => %s", $NUMBER, $folder, $path;
|
||||
write_folder $folder, $path, 1, $NUMBER;
|
||||
} else {
|
||||
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) = @_;
|
||||
|
||||
$imap->select($folder)
|
||||
or warn "Could not examine $folder: $!";
|
||||
|
||||
my $new_dir = dirname $newpath;
|
||||
my $new_file = basename $newpath;
|
||||
|
||||
-d $new_dir
|
||||
or mkpath($new_dir, 0700)
|
||||
or die "Cannot create $new_dir:$!\n";
|
||||
|
||||
open my $mbox, $WRITE_MODE, $newpath
|
||||
or die "Cannot create file $newpath: $!\n";
|
||||
|
||||
my @msgs = $imap->unseen if $UNSEEN;
|
||||
|
||||
for (my $i=$first_message; $i<$last_message+1; ++$i)
|
||||
{ my $m = ($UNSEEN ? shift @msgs : $i);
|
||||
my $date = UnixDate(ParseDate($imap->internaldate($m)),
|
||||
"%a %b %e %T %Y");
|
||||
my $user = $imap->get_envelope($m)->from_addresses;
|
||||
$user =~ s/^.*<([^>]*)>/$1/;
|
||||
$user = '-' unless $user;
|
||||
print '.' if $m%25 == 0;
|
||||
|
||||
my $msg_header = $imap->fetch($m, "FAST")
|
||||
or warn "Could not fetch header $m from $folder\n";
|
||||
|
||||
my $msg_rfc822 = $imap->fetch($m, "RFC822");
|
||||
unless($msg_rfc822)
|
||||
{ warn "Could not fetch RFC822 $m from $folder\n";
|
||||
$FAIL=1
|
||||
}
|
||||
|
||||
undef my $start;
|
||||
foreach (@$msg_rfc822)
|
||||
{ my $message;
|
||||
if($_ =~ /\: / && !$message)
|
||||
{ ++$message;
|
||||
print $mbox "From $user $date\n";
|
||||
}
|
||||
|
||||
if(/^\)\r/)
|
||||
{ undef $message;
|
||||
print $mbox "\n\n";
|
||||
}
|
||||
next unless $message;
|
||||
$_ =~ s/\r$//;
|
||||
$_ = $imap->Strip_cr($_) if $CR;
|
||||
print $mbox "$_";
|
||||
|
||||
}
|
||||
if($DELETE && ! $FAIL)
|
||||
{ $imap->delete_message($m)
|
||||
or warn "Could not delete_message: $@\n";
|
||||
$FAIL = 0;
|
||||
}
|
||||
}
|
||||
|
||||
close $mbox
|
||||
or die "Write errors to $newpath: $!\n";
|
||||
|
||||
if($DELETE)
|
||||
{ $imap->expunge($folder)
|
||||
or warn "Could not expunge: $@\n";
|
||||
}
|
||||
|
||||
print "\n";
|
||||
}
|
||||
|
||||
# 2008/08/07 - Added SSL support, fixed From header printing, and CR
|
||||
# elimination (sobek)
|
||||
#
|
||||
# Revision 19991216.7 2002/08/23 13:29:48 dkernen
|
||||
#
|
||||
# Revision 19991216.6 2000/12/11 21:58:52 dkernen
|
||||
#
|
||||
# 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
|
||||
226
Mail-IMAPClient-3.27/examples/imtestExample.pl
Executable file
226
Mail-IMAPClient-3.27/examples/imtestExample.pl
Executable file
|
|
@ -0,0 +1,226 @@
|
|||
#!/usr/local/bin/perl
|
||||
|
||||
use Sys::Hostname;
|
||||
use Mail::IMAPClient;
|
||||
use IPC::Open3;
|
||||
use IO::Socket::UNIX;
|
||||
use IO::Socket;
|
||||
use Socket;
|
||||
use Getopt::Std;
|
||||
&getopts('ha:df:i:o:p:r:m:u:x:w:p:s:');
|
||||
|
||||
if ($opt_h) {
|
||||
print <<" HELP";
|
||||
$0 -- uses imtest to connect and authenticate to imap server
|
||||
|
||||
Options:
|
||||
-h print this help message
|
||||
|
||||
-a auth authenticate as user 'auth'. This value is passed as the '-a' value
|
||||
to imtest and defaults to whatever you supplied for -u.
|
||||
-d turn on Mail::IMAPClient debugging
|
||||
-f file write Mail::IMAPClient debugging info to file 'file'
|
||||
-m mech use authentication mechanism "mech"; default is to not supply -m to
|
||||
imtest
|
||||
-i path path to imtest executable; default is to let your shell find it via the
|
||||
PATH environmental variable.
|
||||
-p port port on mail server to connect to (default is 143)
|
||||
-r rlm Use realm 'rlm' (default is name of mail server)
|
||||
-s srvr Name of IMAP mail server (default is the localhost's hostname)
|
||||
-u usr Use 'usr' as the user id (required)
|
||||
-w pswd Use 'pswd' as the password for 'usr' (required)
|
||||
-x path Path to Unix socket (fifo). Default is '/tmp/$0.sock'.
|
||||
-o 'ops' Pass the string 'ops' directy to imtest as additional options.
|
||||
This is how you get "other" imtest options passed to imtest. (I only
|
||||
included switches for options that are either really common or useful
|
||||
to the IMAPClient object as well as to imtest.)
|
||||
|
||||
Many of these switches have the same function here as with imtest. I added a
|
||||
few extras though!
|
||||
|
||||
Example:
|
||||
$0 -o '-k 128 -l 128' -s imapmail -u test -w testpswd \
|
||||
-i /usr/local/src/cyrus/cyrus-imapd-2.1.11/imtest/ \
|
||||
-m DIGEST-MD5
|
||||
|
||||
It's a good idea to test your options by running imtest from the command line
|
||||
(but without the -x switch) first. Once you have it working by hand you should
|
||||
be able to get it to work from this script (or one remarkably like it) without
|
||||
too much bloodshed.
|
||||
|
||||
HELP
|
||||
exit;
|
||||
}
|
||||
|
||||
$opt_u and $opt_w or die "No userid/password credentials supplied. I hate that.\n";
|
||||
$opt_a ||= $opt_u;
|
||||
|
||||
if ($opt_i ) {
|
||||
$opt_i =~ m#^[/\.]# or $opt_i = "./$opt_i";
|
||||
$opt_i =~ m#imtest$# or ( -x $opt_i and -f $opt_i )
|
||||
or $opt_i .= ( $opt_i =~ m#/$# ? "imtest" : "/imtest") ;
|
||||
-x $opt_i and -f $opt_i or die "Cannot find executable $opt_i\n";
|
||||
}
|
||||
|
||||
|
||||
$opt_p ||= 143;
|
||||
$opt_s ||= hostname;
|
||||
$opt_r ||= $opt_s;
|
||||
$opt_x ||= "/tmp/$0.sock";
|
||||
|
||||
|
||||
my($rfh,$wfh,$efh) ;
|
||||
|
||||
|
||||
my($imt) = ($opt_i ? "$opt_i " : "imtest ") .
|
||||
($opt_m ? "-m $opt_m ":"" ) .
|
||||
qq(-r $opt_r -a $opt_a -u $opt_u ).
|
||||
qq(-x $opt_x -w $opt_w -p $opt_p $opt_s);
|
||||
|
||||
open3($wfh,$rfh,$efh,$imt);
|
||||
|
||||
my $line;
|
||||
|
||||
until ($line =~ /^Security strength factor:/i ) {
|
||||
$line = <$rfh> or die "EOF\n";
|
||||
print STDERR "Prolog: $line" if $opt_d;
|
||||
}
|
||||
sleep 5;
|
||||
my $sock = IO::Socket::UNIX->new("$opt_x")
|
||||
or warn "No socket: $!\n" and exit;
|
||||
|
||||
print STDERR "<<<END OF PROLOG>>>\n" if $opt_d;
|
||||
my $imap = Mail::IMAPClient->new;
|
||||
$imap->Prewritemethod(\&Mail::IMAPClient::Strip_cr);
|
||||
$imap->User("$opt_u");
|
||||
$imap->Server("$opt_s");
|
||||
$imap->Port("$opt_p");
|
||||
$imap->Debug($opt_d);
|
||||
$imap->Debug_fh($opt_f||\*STDERR);
|
||||
$imap->State($imap->Connected);
|
||||
$imap->Socket($sock);
|
||||
|
||||
# Your code goes here:
|
||||
|
||||
$imap->Select("INBOX");
|
||||
for my $m (@{$imap->search("TEXT SUBJECT")} ) {
|
||||
print "Message $m:\t",$imap->subject($m),"\n";
|
||||
}
|
||||
# You should have finished your code by about here
|
||||
$imap->logout;
|
||||
|
||||
print STDERR "<<<END>>>\n" if $opt_d;
|
||||
|
||||
exit;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
imtestExample.pl -- uses imtest to connect and authenticate to imap server
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
|
||||
=head2 Options
|
||||
|
||||
=over 4
|
||||
|
||||
=item -h
|
||||
|
||||
print this help message
|
||||
|
||||
=item -a auth
|
||||
|
||||
authenticate as user 'auth'. This value is passed as the '-a' value
|
||||
to imtest and defaults to whatever you supplied for -u.
|
||||
|
||||
=item -d
|
||||
|
||||
turn on Mail::IMAPClient debugging
|
||||
|
||||
=item -f file
|
||||
|
||||
write Mail::IMAPClient debugging info to file 'file'
|
||||
|
||||
=item -m mech
|
||||
|
||||
use authentication mechanism "mech"; default is to not supply -m to
|
||||
imtest
|
||||
|
||||
=item -i path
|
||||
|
||||
path to imtest executable; default is to let your shell find it via the
|
||||
PATH environmental variable.
|
||||
|
||||
=item -p port
|
||||
|
||||
port on mail server to connect to (default is 143)
|
||||
|
||||
=item -r rlm
|
||||
|
||||
Use realm 'rlm' (default is name of mail server)
|
||||
|
||||
=item -s srvr
|
||||
|
||||
Name of IMAP mail server (default is the localhost's hostname)
|
||||
|
||||
=item -u usr
|
||||
|
||||
Use 'usr' as the user id (required)
|
||||
|
||||
=item -w pswd
|
||||
|
||||
Use 'pswd' as the password for 'usr' (required)
|
||||
|
||||
=item -x path
|
||||
|
||||
Path to Unix socket (fifo). Default is '/tmp/$0.sock'.
|
||||
|
||||
=item -o 'ops'
|
||||
|
||||
Pass the string 'ops' directy to imtest as additional options.
|
||||
This is how you get "other" imtest options passed to imtest. (I only
|
||||
included switches for options that are either really common or useful
|
||||
to the IMAPClient object as well as to imtest.)
|
||||
|
||||
Many of these switches have the same function here as with imtest. I added a
|
||||
few extras though!
|
||||
|
||||
=back
|
||||
|
||||
Example:
|
||||
|
||||
imtestExample.pl -o '-k 128 -l 128' -s imapmail -u test -w testpswd \
|
||||
-i /usr/local/src/cyrus/cyrus-imapd-2.1.11/imtest/ \
|
||||
-m DIGEST-MD5
|
||||
|
||||
It's a good idea to test your options by running imtest from the command line
|
||||
(but without the -x switch) first. Once you have it working by hand you should
|
||||
be able to get it to work from this script (or one remarkably like it) without
|
||||
too much bloodshed.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
David J. Kernen
|
||||
|
||||
The Kernen Group, Inc.
|
||||
|
||||
imap@kernengroup.com
|
||||
|
||||
Based on a suggestion by Tara L. Andrews.
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
This example and Mail::IMAPClient are Copyright (c) 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
|
||||
|
||||
326
Mail-IMAPClient-3.27/examples/migrate_mail2.pl
Executable file
326
Mail-IMAPClient-3.27/examples/migrate_mail2.pl
Executable file
|
|
@ -0,0 +1,326 @@
|
|||
#!/usr/local/bin/perl
|
||||
#$Id$
|
||||
#
|
||||
# An example of how to migrate from a Netscape server
|
||||
# (which uses a slash as a separator and which does
|
||||
# not allow subfolders under the INBOX, only next to it)
|
||||
# to a Cyrus server (which uses a dot (.) as a separator
|
||||
# and which requires subfolders to be under "INBOX").
|
||||
# There are also some allowed-character differences taken
|
||||
# into account but this is by no means complete AFAIK.
|
||||
#
|
||||
# This is an example. If you are doing mail migrations
|
||||
# then this may in fact be a very helpful example but
|
||||
# it is unlikely to work 100% correctly as-is.
|
||||
# A good place to start is by testing a rather large-volume
|
||||
# transfer of actual mail from the source server with the
|
||||
# -v option turned on and redirect output to a file for
|
||||
# perusal. Examine the output carefully for unexpected
|
||||
# results, such as a number of messages being skipped because
|
||||
# they're already in the target folder when you know darn
|
||||
# well this is the first time you ran the script. This
|
||||
# would indicate an incompatibility with the logic for
|
||||
# detecting duplicates, unless for some reason the source
|
||||
# mailbox contains a lot of duplicate messages to begin with.
|
||||
# (The latter case is an example of why you should use an
|
||||
# actual mailbox stuffed with actual mail for test; if you
|
||||
# generate test messages and then test migrating those you
|
||||
# will only prove that your test messages are migratable.
|
||||
#
|
||||
# Also, you may need to play with the rules
|
||||
# for translating folder names based on what kind of
|
||||
# names your target server and source server support.
|
||||
#
|
||||
# You may also need to play with the logic that determines
|
||||
# whether or not a message has already been migrated,
|
||||
# especially if your source server has messages that
|
||||
# did not come from an SMTP gateway or something like that.
|
||||
#
|
||||
# Some servers allow folders to contain mail and subfolders,
|
||||
# some allow folders to only contain either mail or subfolders.
|
||||
# If you are migrating from a "mixed use" type to a "single use"
|
||||
# type server then you'll have to figure out how to deal
|
||||
# with this. (This script deals with this by creating folders like
|
||||
# "/blah_mail", "/blah/blah_mail", and "/blah/blah/blah_mail"
|
||||
# to hold mail if the source folder contains mail and subfolders
|
||||
# and the target server supports only single-use folders.
|
||||
# You may not choose a different strategy.)
|
||||
#
|
||||
# Finally, it's possible that in some server-to-server
|
||||
# copies, the source server supports messages that the
|
||||
# target server considers unacceptable. For example, some
|
||||
# but not all IMAP servers flat out refuse to accept
|
||||
# messages with "base newlines", which is to say messages
|
||||
# whose lines are match the pattern /[^\r]\n$/. There is
|
||||
# no logic in this script that deals with the situation;
|
||||
# you will have to identify it if it exists and figure
|
||||
# out how you want to handle it.
|
||||
#
|
||||
# This is probably not an exhaustive list of issues you'll
|
||||
# face in a migration, but it's a start.
|
||||
#
|
||||
# If you're just migrating from an old version to a newer
|
||||
# version of the same server then you'll probably have
|
||||
# a much easier time of it.
|
||||
#
|
||||
#
|
||||
|
||||
use Mail::IMAPClient;
|
||||
use Data::Dumper;
|
||||
use IO::File;
|
||||
use File::Basename ;
|
||||
use Getopt::Std;
|
||||
use strict;
|
||||
use vars qw/ $opt_B $opt_D $opt_T $opt_U
|
||||
$opt_W $opt_b $opt_d $opt_h
|
||||
$opt_t $opt_u $opt_w $opt_v
|
||||
$opt_s $opt_S $opt_W $opt_p
|
||||
$opt_P $opt_f $opt_F $opt_m
|
||||
$opt_M
|
||||
/;
|
||||
|
||||
getopts('vs:S:u:U:dDb:B:f:F:w:W:p:P:t:T:hm:M:');
|
||||
|
||||
if ( $opt_h ) {
|
||||
print STDERR <<"HELP";
|
||||
|
||||
$0 - an example script demonstrating the use of the Mail::IMAPClient's
|
||||
migrate method.
|
||||
|
||||
Syntax:
|
||||
$0 -s source_server -u source_user -w source_password -p source_port \
|
||||
-d debug_source -f source_debugging_file -b source_buffsize \
|
||||
-t source_timeout -m source_auth_mechanism \
|
||||
-S target_server -U target_user -W target_password -P target_port \
|
||||
-D debug_target -F target_debugging_file -B target_buffsize \
|
||||
-T target_timeout -M target_auth_mechanism \
|
||||
-v
|
||||
|
||||
where "source" refers to the "copied from" mailbox, target is the
|
||||
"copied to" mailbox, and -v turns on verbose output.
|
||||
Authentication mechanisms default to "PLAIN".
|
||||
|
||||
HELP
|
||||
exit;
|
||||
}
|
||||
$opt_v and ++$|;
|
||||
print "$0: Started at ",scalar(localtime),"\n" if $opt_v;
|
||||
|
||||
$opt_p||=143;
|
||||
$opt_P||=143;
|
||||
|
||||
# Make a connection to the source mailbox:
|
||||
my $imap = Mail::IMAPClient->new(
|
||||
Server => $opt_s,
|
||||
User => $opt_u,
|
||||
Password=> $opt_w,
|
||||
Uid => 1,
|
||||
Port => $opt_p,
|
||||
Debug => $opt_d||0,
|
||||
Buffer => $opt_b||4096,
|
||||
Fast_io => 1,
|
||||
( $opt_m ? ( Authmechanism => $opt_m) : () ),
|
||||
Timeout => $opt_t,
|
||||
($opt_f ? ( Debug_fh=>IO::File->new(">$opt_f" )) : ()),
|
||||
) or die "$@";
|
||||
|
||||
# Make a connection to the target mailbox:
|
||||
my $imap2 = Mail::IMAPClient->new(
|
||||
Server => $opt_S,
|
||||
User => $opt_U,
|
||||
Password=> $opt_W,
|
||||
Port => $opt_P,
|
||||
Uid => 1,
|
||||
Debug => $opt_D||0,
|
||||
( $opt_M ? ( Authmechanism => $opt_M) : () ),
|
||||
($opt_F ? ( Debug_fh=>IO::File->new(">$opt_F")) : ()),
|
||||
Buffer => $opt_B||4096,
|
||||
Fast_io => 1,
|
||||
Timeout => $opt_T, # True value
|
||||
) or die "$@";
|
||||
|
||||
# Turn off buffering on debug files:
|
||||
$imap->Debug_fh->autoflush;
|
||||
$imap2->Debug_fh->autoflush;
|
||||
|
||||
# Get folder hierarchy separator characters from source and target:
|
||||
my $sep1 = $imap->separator;
|
||||
my $sep2 = $imap2->separator;
|
||||
|
||||
# Find out if source and target support subfolders inside INBOX:
|
||||
my $inferiorFlag1 = $imap->is_parent("INBOX");
|
||||
my $inferiorFlag2 = $imap2->is_parent("INBOX");
|
||||
|
||||
# Set up a test folders to see if the source and target support mixed-use
|
||||
# folders (i.e. folders with both subfolders and mail messages):
|
||||
my $testFolder1 = "Migrate_Test_$$" ; # Ex: Migrate_Test_1234
|
||||
$testFolder1 = $inferiorFlag2 ?
|
||||
"INBOX" . $sep2 . $testFolder1 :
|
||||
$testFolder1 ;
|
||||
|
||||
# The following folder will be a subfolder of $testFolder1:
|
||||
my $testFolder2 = "Migrate_Test_$$" . $sep2 . "Migrate_test_subfolder_$$" ;
|
||||
$testFolder2 = $inferiorFlag2 ? "INBOX" . $sep2 . $testFolder2 : $testFolder2 ;
|
||||
|
||||
$imap2->create($testFolder2) ; # Create the subfolder first; RFC2060 dictates that
|
||||
# the parent folder should be created at the same time
|
||||
|
||||
|
||||
# The following line inspired the selectable method. It was also made obsolete by it,
|
||||
# but I'm leaving it as is to demonstrate use of lower-level method calls:
|
||||
my $mixedUse2 = grep(/NoSelect/i,$imap2->list("",$testFolder1))? 0 : 1;
|
||||
|
||||
# Repeat the above with the source mailbox:
|
||||
$testFolder2 = "Migrate_Test_$$" . $sep1 . "Migrate_test_subfolder_$$" ;
|
||||
$testFolder2 = $inferiorFlag1 ? "INBOX" . $sep1 . $testFolder1 : $testFolder1 ;
|
||||
|
||||
$imap->create($testFolder2) ;
|
||||
|
||||
my $mixedUse1 = grep(/NoSelect/i,$imap->list("",$testFolder1))? 0 : 1;
|
||||
|
||||
print "Imap host $opt_s:$opt_p uses a '$sep1' as a separator and ",
|
||||
( defined($inferiorFlag1) ? "allows " : "does not allow "),
|
||||
"children in the INBOX. It supports ",
|
||||
($mixedUse1?"mixed use ":"single use "), "folders.\n" if $opt_v;
|
||||
|
||||
print "Imap host $opt_S:$opt_P uses a '$sep2' as a separator and ",
|
||||
( defined($inferiorFlag2) ? "allows " : "does not allow "),
|
||||
"children in the INBOX. It supports ",
|
||||
($mixedUse2?"mixed use ":"single use "), "folders.\n" if $opt_v;
|
||||
|
||||
for ($testFolder1,$testFolder2) {$imap->delete($_); $imap2->delete($_);}
|
||||
|
||||
my($totalMsgs, $totalBytes) = (0,0);
|
||||
|
||||
# Now we will migrate the folder. Here we are doing one message at a time
|
||||
# so that we can do more granular status reporting and error checking.
|
||||
# A lazier way would be to do all the messages in one migrate method call
|
||||
# (specifying "ALL" as the message number) but then we wouldn't be able
|
||||
# to print out which message we were migrating and it would be a little
|
||||
# bit tougher to control checking for duplicates and stuff like that.
|
||||
# We could also check the size of the message on the target right after
|
||||
# the migrate as an extra safety check if we wanted to but I didn't bother
|
||||
# here. (I saved as an exercise for the reader. Yeah! That's it! An exercise!)
|
||||
|
||||
# Iterate over all the folders in the source mailbox:
|
||||
for my $f ($imap->folders) {
|
||||
# Select the folder on the source side:
|
||||
$imap->select($f) ;
|
||||
|
||||
# Massage the foldername into an acceptable target-side foldername:
|
||||
my $targF = "";
|
||||
my $srcF = $f;
|
||||
$srcF =~ s/^INBOX$sep1//i;
|
||||
if ( $inferiorFlag2 ) {
|
||||
$targF = $srcF eq "INBOX" ? "INBOX" : "INBOX.$f" ;
|
||||
} else {
|
||||
$targF = $srcF ;
|
||||
}
|
||||
|
||||
$targF =~ s/$sep1/$sep2/go unless $sep1 eq $sep2;
|
||||
$targF =~ tr/#\$\& '"/\@\@+_/;
|
||||
if ( $imap->is_parent($f) and !$mixedUse2 ) {
|
||||
$targF .= "_mail" ;
|
||||
}
|
||||
print "Migrating folder $f to $targF\n" if $opt_v;
|
||||
|
||||
# Create the (massaged) folder on the target side:
|
||||
unless ( $imap2->exists($targF) ) {
|
||||
$imap2->create($imap2->Massage($targF))
|
||||
or warn "Cannot create $targF on " . $imap2->Server . ": $@\n" and next;
|
||||
}
|
||||
|
||||
# ... and select it
|
||||
$imap2->select($imap2->Massage($targF))
|
||||
or warn "Cannot select $targF on " . $imap2->Server . ": $@\n" and next;
|
||||
|
||||
# now that we know the target folder is selectable, we can close it again:
|
||||
$imap2->close;
|
||||
my $count = 0;
|
||||
my $expectedTotal = $imap->message_count($f) ;
|
||||
|
||||
# Now start iterating over all the messages on the source side...
|
||||
for my $msg ($imap->messages) {
|
||||
++$count;
|
||||
my $h = "";
|
||||
# Get some basic info about the message:
|
||||
eval { $h = ($imap->parse_headers($msg,"Message-id")||{})->{'Message-id'}[0]};
|
||||
my $tsize = $imap->size($msg);
|
||||
my $ret = 0 ; my $h2 = [];
|
||||
|
||||
# Make sure we didn't already migrate the message in a previous pass:
|
||||
$imap2->select($targF);
|
||||
if ( $tsize and $h and $h2 = $imap2->search(
|
||||
HEADER => 'Message-id' => $imap2->Quote($h),
|
||||
NOT => SMALLER => $tsize,
|
||||
NOT => LARGER => $tsize
|
||||
)
|
||||
) {
|
||||
print
|
||||
"Skipping $f/$msg to $targF. ",
|
||||
"One or more messages (" ,join(", ",@$h2),
|
||||
") with the same size and message id ($h) ",
|
||||
"is already on the server. ",
|
||||
"\n"
|
||||
if $opt_v;
|
||||
$imap2->close;
|
||||
|
||||
} else {
|
||||
|
||||
print
|
||||
"Migrating $f/$msg to $targF. ",
|
||||
"Message #$count of $expectedTotal has ",
|
||||
$tsize , " bytes.",
|
||||
"\n" if $opt_v;
|
||||
$imap2->close;
|
||||
|
||||
# Migrate the message:
|
||||
my $ret = $imap->migrate($imap2,$msg,"$targF") ;
|
||||
$ret and ( $totalMsgs++ , $totalBytes += $tsize);
|
||||
$ret or warn "Cannot migrate $f/$msg to $targF on " . $imap2->Server . ": $@\n" ;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
print "$0: Finished migrating $totalMsgs messages and $totalBytes bytes at ",scalar(localtime),"\n"
|
||||
if $opt_v;
|
||||
exit;
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
David J. Kernen
|
||||
|
||||
The Kernen Group, Inc.
|
||||
|
||||
imap@kernengroup.com
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
This example and Mail::IMAPClient are Copyright (c) 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
|
||||
|
||||
#$Log: migrate_mail2.pl,v $
|
||||
#Revision 19991216.4 2003/06/12 21:38:33 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
|
||||
#
|
||||
131
Mail-IMAPClient-3.27/examples/migrate_mbox.pl
Executable file
131
Mail-IMAPClient-3.27/examples/migrate_mbox.pl
Executable file
|
|
@ -0,0 +1,131 @@
|
|||
#!/usr/local/bin/perl
|
||||
#
|
||||
# This is an example demonstrating the use of the migrate method.
|
||||
# Note that the migrate method is considered experimental and should
|
||||
# be used with caution.
|
||||
#
|
||||
#$Id$
|
||||
#
|
||||
|
||||
use Mail::IMAPClient;
|
||||
use IO::File;
|
||||
use File::Basename ;
|
||||
use Getopt::Std;
|
||||
use warnings;
|
||||
use vars qw/$opt_h $opt_H
|
||||
$opt_s $opt_u $opt_p $opt_d $opt_b $opt_o
|
||||
$opt_S $opt_U $opt_P $opt_D $opt_B $opt_O
|
||||
/;
|
||||
|
||||
getopts('Hhs:S:u:U:p:P:d:D:b:B:o:O:');
|
||||
if ($opt_h or $opt_H ) {
|
||||
print << "HELP";
|
||||
|
||||
|
||||
Usage:
|
||||
|
||||
$0 -[h|H] -- prints this message
|
||||
|
||||
Lower-case options are for source server; upper-case options are for the target server.
|
||||
|
||||
$0 -s server -S server -u uid -U uid -p passwd -P passwd \
|
||||
-b buffersize -B buffersize -o debugFile -O debugFile > error_file
|
||||
|
||||
All uppercase options except -O default to the lowercase option that was specified.
|
||||
If you don't specify any uppercase options at all then God help you, I don't know
|
||||
what will happen.
|
||||
|
||||
Always capture STDERR so that you'll be able to resolve any problems that come up.
|
||||
|
||||
|
||||
HELP
|
||||
|
||||
exit;
|
||||
}
|
||||
|
||||
my $imap = Mail::IMAPClient->new(
|
||||
Server => $opt_s,
|
||||
User => $opt_u,
|
||||
Password=> $opt_p,
|
||||
Uid => 1,
|
||||
Debug => $opt_d,
|
||||
Buffer => $opt_b||4096,
|
||||
Fast_io => 1,
|
||||
Timeout => 160, # True value
|
||||
Debug_fh=> (
|
||||
$opt_o ? IO::File->new(">$opt_o")||die "can't open $opt_o: $!\n" : undef )
|
||||
) or die "Error opening source connection: $@\n";
|
||||
|
||||
my $imap2 = Mail::IMAPClient->new(
|
||||
Server => $opt_S||$opt_s,
|
||||
User => $opt_U||$opt_u,
|
||||
Password=> $opt_P||$opt_p,
|
||||
Uid => 1,
|
||||
Debug => $opt_D||$opt_d,
|
||||
Buffer => $opt_B||$opt_b||4096,
|
||||
Fast_io => 1,
|
||||
Timeout => 160,
|
||||
Debug_fh=> (
|
||||
$opt_O ? IO::File->new(">$opt_O")||die "can't open $opt_O: $!\n" : undef )
|
||||
) or die "Error opening target connection: $@\n";
|
||||
|
||||
|
||||
$imap->Debug_fh->autoflush;
|
||||
$imap2->Debug_fh->autoflush;
|
||||
|
||||
for my $f ($imap->folders) { $imap->select($f) ; $imap->migrate($imap2,"ALL") ;}
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
David J. Kernen
|
||||
|
||||
The Kernen Group, Inc.
|
||||
|
||||
imap@kernengroup.com
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
This example and Mail::IMAPClient are Copyright (c) 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
|
||||
|
||||
#
|
||||
#$Log: migrate_mbox.pl,v $
|
||||
#Revision 19991216.2 2003/06/12 21:38:33 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 1.1 2003/06/12 21:38:15 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
|
||||
#
|
||||
#
|
||||
319
Mail-IMAPClient-3.27/examples/populate_mailbox.pl
Executable file
319
Mail-IMAPClient-3.27/examples/populate_mailbox.pl
Executable file
|
|
@ -0,0 +1,319 @@
|
|||
#!/usr/local/bin/perl
|
||||
#$Id$ #
|
||||
use Time::Local ;
|
||||
use FileHandle ;
|
||||
use File::Copy ;
|
||||
use Mail::IMAPClient;
|
||||
use Sys::Hostname ;
|
||||
#
|
||||
my $default_user = 'default' ;
|
||||
my $default_pswd = 'default' ;
|
||||
#
|
||||
#########################################################################
|
||||
# ARGS: DATE = YYYYMMDDHHMM (defaults to current system date) #
|
||||
# UID = IMAP account id (defaults to $default_user) #
|
||||
# PSWD = uid's password (defaults to $default_pswd) #
|
||||
# HOST = Target host (defaults to localhost) #
|
||||
# CLEAN = 1 (defaults to 0; used to clean out mailbox 1st) #
|
||||
# CLEANONLY= 1 (defaults to 0; if 1 then only CLEAN is done) #
|
||||
# DOMAIN = x.com (no default) the mail domain for UID's address #
|
||||
# #
|
||||
# EG: populate_mailbox.pl DATE=200001010100 UID=testuser #
|
||||
# #
|
||||
#########################################################################
|
||||
#
|
||||
(my($x)= join(" ",@ARGV)) ;
|
||||
$x=~s~=~ ~g ;
|
||||
chomp($x) ;
|
||||
#
|
||||
my %hash = split(/\s+/, $x) if $x ;
|
||||
#
|
||||
while (my ($k,$v) = each %hash ) {
|
||||
$hash{uc $k} = $v ;
|
||||
}
|
||||
|
||||
while (my ($k,$v) = each %hash ) {
|
||||
delete $hash{$k} if $k =~ tr/[a-z]// ;
|
||||
}
|
||||
;
|
||||
$hash{UID} ||= "$default_user" ;
|
||||
$hash{PSWD} ||= "$default_pswd" ;
|
||||
$hash{HOST} ||= hostname ;
|
||||
#
|
||||
while (my ($k,$v) = each %hash ) {
|
||||
print "Running with $k set to $v\n" ;
|
||||
}
|
||||
#
|
||||
my $domain = $hash{DOMAIN} or die "No mail domain provided.\n" ;
|
||||
my $now = seconds($hash{DATE}) || time ;
|
||||
#
|
||||
my $six = $now - ( 6 * 24 * 60 * 60 ) ;
|
||||
my $seven = $now - ( 7 * 24 * 60 * 60 ) ;
|
||||
my $notthirty = $now - ( 29 * 24 * 60 * 60 ) ;
|
||||
my $thirty = $now - ( 30 * 24 * 60 * 60 ) ;
|
||||
my $notsixty = $now - ( 59 * 24 * 60 * 60 ) ;
|
||||
my $sixty = $now - ( 60 * 24 * 60 * 60 ) ;
|
||||
my $notd365 = $now - ( 364 * 24 * 60 * 60 ) ;
|
||||
my $d365 = $now - ( 365 * 24 * 60 * 60 ) ;
|
||||
#
|
||||
$hash{SUBJECTS} = [ "Sixty days old", "Less than sixty days old" ,
|
||||
"365 days old", "Less than 365 days old" ,
|
||||
"Trash/Incinerator -- 7 days old" ,
|
||||
"Sent -- 29 days old" ,
|
||||
"Sent -- 30 days old" ,
|
||||
"Trash -- 6 days old" ,
|
||||
] ;
|
||||
$hash{FOLDERS} = [ "Sent", "INBOX", "Trash" ,
|
||||
"365_folder", "Trash/Incinerator" ,
|
||||
"not_365_folder" ,
|
||||
] ;
|
||||
#
|
||||
&clean_mailbox if $hash{CLEANONLY} || $hash{CLEAN} ;
|
||||
exit if $hash{CLEANONLY} ;
|
||||
#
|
||||
#send to: date: subject: #
|
||||
#-------- --- ----- --------- #
|
||||
sendmail( $hash{UID}, $sixty, "Sixty days old" ) ;
|
||||
sendmail( $hash{UID}, $notsixty, "Less than sixty days old") ;
|
||||
sendmail( $hash{UID}, $d365, "365 days old" ) ;
|
||||
sendmail( $hash{UID}, $notd365, "Less than 365 days old" ) ;
|
||||
#
|
||||
populate_trash("Trash/Incinerator",$hash{UID}, $seven, 7 ) ;
|
||||
populate_trash( "Trash" , $hash{UID}, $six, 6 ) ;
|
||||
populate_trash( "Sent" , $hash{UID}, $thirty, 30 ) ;
|
||||
populate_trash( "Sent" , $hash{UID}, $notthirty, 29 ) ;
|
||||
#
|
||||
movemail( "365 days old" ,
|
||||
"365_folder" ) ;
|
||||
#
|
||||
movemail( "Less than 365 days old" ,
|
||||
"not_365_folder" ) ;
|
||||
#
|
||||
exit ;
|
||||
#
|
||||
#
|
||||
sub seconds {
|
||||
my $d = shift or return undef ;
|
||||
my($yy,$moy,$dom,$hr,$min) =
|
||||
#
|
||||
$d =~ m! ^ # anchor at start #
|
||||
(\d\d\d\d) # year #
|
||||
(\d\d) # month #
|
||||
(\d\d) # day #
|
||||
(\d\d) # hour #
|
||||
(\d\d) # minute #
|
||||
!x ;
|
||||
#
|
||||
return timegm(0,$min,$hr,$dom,$moy-1,($yy>99?$yy-1900:$yy)) ;
|
||||
}
|
||||
#
|
||||
sub sendmail {
|
||||
#
|
||||
my($to,$date,$subject) = @_ ;
|
||||
my $text = <<EOTEXT ;
|
||||
To: $to\@$hash{DOMAIN}
|
||||
Date: @{[&rfc822_date($date)]}
|
||||
Subject: $subject
|
||||
|
||||
Dear mail tester,
|
||||
|
||||
This is a test message to test mail for messages \l$subject.
|
||||
|
||||
I hope you like it!
|
||||
|
||||
Love,
|
||||
The E-Mail Engineering Team
|
||||
|
||||
EOTEXT
|
||||
#
|
||||
for (my $x = 0; $x < 10 ; $x ++ ) {
|
||||
my $imap = Mail::IMAPClient->new (
|
||||
Server => $hash{HOST} ,
|
||||
User => $hash{UID} ,
|
||||
Password=> $hash{PSWD} )
|
||||
or die "can't connect: $!\n" ;
|
||||
#
|
||||
$imap->append("INBOX",$text) ;
|
||||
$imap->logout ;
|
||||
}
|
||||
}
|
||||
#
|
||||
sub populate_trash {
|
||||
my $where = shift ;
|
||||
my $to = shift ;
|
||||
my $date = shift ;
|
||||
my $d = shift ;
|
||||
#
|
||||
my($ss,$min,$hr,$day,$mon,$year)=gmtime($date) ;
|
||||
$mon++ ;
|
||||
$year += 1900 ;
|
||||
my $fn =sprintf("%4.4d%2.2d%2.2d%2.2d%2.2d%2.2d" ,
|
||||
$year,$mon,$day,$hr,$min,$ss ) ;
|
||||
my $x = 0 ;
|
||||
my $subject = "$where -- $d days old" ;
|
||||
while ($x++ < 10) {
|
||||
my $fh ;
|
||||
$fh .= "Date: @{[&rfc822_date($date)]}\n" ;
|
||||
$fh .= <<EOTRAH ;
|
||||
Subject: $subject
|
||||
|
||||
This note was put in the $where folder $d days ago. (My how time flies!)
|
||||
I hope you enjoyed testing with it!
|
||||
|
||||
EOTRAH
|
||||
my $imap = Mail::IMAPClient->new (
|
||||
Server => $hash{HOST} ,
|
||||
User => $hash{UID} ,
|
||||
Password=> $hash{PSWD} )
|
||||
or die "can't connect: $!\n" ;
|
||||
$imap->append($where, $fh) ;
|
||||
#
|
||||
}
|
||||
#
|
||||
}
|
||||
#
|
||||
sub movemail {
|
||||
#
|
||||
my ($subj,$fold) = @_ ;
|
||||
my $fh = Mail::IMAPClient->new (
|
||||
Debug => 0 ,
|
||||
Server => $hash{HOST} ,
|
||||
User => $hash{UID} ,
|
||||
Password => $hash{PSWD} ,
|
||||
)
|
||||
;
|
||||
#
|
||||
$fh->select("inbox") or die "cannot open inbox: $!\n" ;
|
||||
#
|
||||
foreach my $f ($fh->search(qq(SUBJECT "$subj")) ) {
|
||||
#
|
||||
$fh->move($fold,$f) ;
|
||||
#
|
||||
}
|
||||
#
|
||||
}
|
||||
#
|
||||
sub clean_mailbox {
|
||||
#
|
||||
my $fh =Mail::IMAPClient->new (
|
||||
Debug => 0 ,
|
||||
Server => $hash{HOST} ,
|
||||
User => $hash{UID} ,
|
||||
Password => $hash{PSWD} ,
|
||||
)
|
||||
;
|
||||
for my $x (@{$hash{FOLDERS}}) {
|
||||
my @msgs ;
|
||||
$fh->create($x) unless $fh->exists($x) ;
|
||||
$fh->select($x) ;
|
||||
for my $s (@{$hash{SUBJECTS}}) {
|
||||
push @msgs, $fh->search(qq(SUBJECT "$s")) ;
|
||||
}
|
||||
$fh->delete_message(@msgs) if scalar(@msgs) ;
|
||||
$fh->expunge ;
|
||||
}
|
||||
}
|
||||
#
|
||||
sub rfc822_date {
|
||||
#Date: Fri, 09 Jul 1999 13:10:55 -0400 #
|
||||
my $date = shift ;
|
||||
my @date = localtime($date) ;
|
||||
my @dow = qw{ Sun Mon Tue Wed Thu Fri Sat } ;
|
||||
my @mnt = qw{ Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec} ;
|
||||
#
|
||||
return sprintf (
|
||||
"%s, %2.2d %s %4.4s %2.2d:%2.2d:%2.2d -0400" ,
|
||||
$dow[$date[6]] ,
|
||||
$date[3] ,
|
||||
$mnt[$date[4]] ,
|
||||
$date[5]+=1900 ,
|
||||
$date[2] ,
|
||||
$date[1] ,
|
||||
$date[0] )
|
||||
;
|
||||
}
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
David J. Kernen
|
||||
|
||||
The Kernen Group, Inc.
|
||||
|
||||
imap@kernengroup.com
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
This example and Mail::IMAPClient are Copyright (c) 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
|
||||
|
||||
# $Id$
|
||||
# $Log: populate_mailbox.pl,v $
|
||||
# Revision 19991216.8 2003/06/12 21:38:34 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 1.1 2003/06/12 21:38:16 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.7 2002/08/23 13:29:49 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:53 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:15 dkernen
|
||||
# Bring up to same level
|
||||
#
|
||||
# Revision 19991124.3 1999/12/16 17:14:26 dkernen
|
||||
# Incorporate changes for exists method performance enhancement
|
||||
#
|
||||
# Revision 19991124.02 1999/11/24 17:46:21 dkernen
|
||||
# More fixes to t/basic.t
|
||||
#
|
||||
# Revision 19991124.01 1999/11/24 16:51:51 dkernen
|
||||
# Changed t/basic.t to test for UIDPLUS before trying UID cmds
|
||||
#
|
||||
# Revision 1.4 1999/11/23 17:51:06 dkernen
|
||||
# Committing version 1.06 distribution copy
|
||||
#
|
||||
88
Mail-IMAPClient-3.27/examples/sharedFolder.pl
Executable file
88
Mail-IMAPClient-3.27/examples/sharedFolder.pl
Executable file
|
|
@ -0,0 +1,88 @@
|
|||
#!/usr/local/bin/perl
|
||||
#$Id$
|
||||
|
||||
use Mail::IMAPClient;
|
||||
use Getopt::Std;
|
||||
use File::Basename;
|
||||
getopts('s:u:p:f:dh');
|
||||
|
||||
if ($opt_h) {
|
||||
|
||||
print STDERR "$0 -- example of how to select shared folder\n",
|
||||
"\n\nUsage:\n",
|
||||
"\t-s server -- specify name or ip address of mail server\n",
|
||||
"\t-u userid -- specify login name of authenticating user\n",
|
||||
"\t-p passwd -- specify login password of authenticating user\n",
|
||||
"\t-f folder -- specify shared folder to access (i.e. '-f frank/INBOX')\n",
|
||||
"\t-h display this help message\n\n";
|
||||
"\t-d turn on debugging output\n\n";
|
||||
exit;
|
||||
}
|
||||
|
||||
my $server = $opt_s or die "No server name specified\n";
|
||||
my $user = $opt_u or die "No user name specified\n";
|
||||
my $pass = $opt_p or die "No password specified\n";
|
||||
my $folder = $opt_f or die "No shared folder specified\n";
|
||||
|
||||
chomp $pass;
|
||||
my $imap = Mail::IMAPClient->new(Server=>$server,User=>$user,Password=>$pass,Debug=>$opt_d)
|
||||
or die "Can't connect to $user\@$server: $@ $!\n";
|
||||
|
||||
my($prefix,$prefSep) = @{$imap->namespace->[1][0]}
|
||||
or die "Can't get shared folder namespace or separator: $@\n";
|
||||
|
||||
|
||||
my $target = $prefix .
|
||||
( $prefix =~ /\Q$prefSep\E$/ || $opt_f =~ /^\Q$prefSep/ ? "" : $prefSep ) .
|
||||
$opt_f ;
|
||||
|
||||
print "Selecting $target\n";
|
||||
|
||||
$imap->select($target)
|
||||
or die "Cannot select $target: $@\n";
|
||||
|
||||
print "Ok: $target has ", $imap->message_count($target)," messages.\n";
|
||||
|
||||
$imap->logout;
|
||||
exit;
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
David J. Kernen
|
||||
|
||||
The Kernen Group, Inc.
|
||||
|
||||
imap@kernengroup.com
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
This example and Mail::IMAPClient are Copyright (c) 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
|
||||
|
||||
#
|
||||
#$Log: sharedFolder.pl,v $
|
||||
#Revision 19991216.1 2003/06/12 21:38:35 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
|
||||
#
|
||||
#
|
||||
3287
Mail-IMAPClient-3.27/lib/Mail/IMAPClient.pm
Normal file
3287
Mail-IMAPClient-3.27/lib/Mail/IMAPClient.pm
Normal file
File diff suppressed because it is too large
Load diff
3737
Mail-IMAPClient-3.27/lib/Mail/IMAPClient.pod
Normal file
3737
Mail-IMAPClient-3.27/lib/Mail/IMAPClient.pod
Normal file
File diff suppressed because it is too large
Load diff
580
Mail-IMAPClient-3.27/lib/Mail/IMAPClient/BodyStructure.pm
Normal file
580
Mail-IMAPClient-3.27/lib/Mail/IMAPClient/BodyStructure.pm
Normal file
|
|
@ -0,0 +1,580 @@
|
|||
use warnings;
|
||||
use strict;
|
||||
|
||||
package Mail::IMAPClient::BodyStructure;
|
||||
use Mail::IMAPClient::BodyStructure::Parse;
|
||||
|
||||
# BUG?: old code used name "HEAD" instead of "HEADER", change?
|
||||
my $HEAD = "HEAD";
|
||||
|
||||
# my has file scope, not limited to package!
|
||||
my $parser = Mail::IMAPClient::BodyStructure::Parse->new
|
||||
or die "Cannot parse rules: $@\n"
|
||||
. "Try remaking Mail::IMAPClient::BodyStructure::Parse.\n";
|
||||
|
||||
sub new
|
||||
{ my $class = shift;
|
||||
my $bodystructure = shift;
|
||||
|
||||
my $self = $parser->start($bodystructure)
|
||||
or return undef;
|
||||
|
||||
$self->{_prefix} = "";
|
||||
$self->{_id} = exists $self->{bodystructure} ? $HEAD : 1;
|
||||
$self->{_top} = 1;
|
||||
|
||||
bless $self, ref($class)||$class;
|
||||
}
|
||||
|
||||
sub _get_thingy
|
||||
{ my $thingy = shift;
|
||||
my $object = shift || (ref $thingy ? $thingy : undef);
|
||||
|
||||
unless ($object && ref $object)
|
||||
{ warn $@ = "No argument passed to $thingy method.";
|
||||
return undef;
|
||||
}
|
||||
|
||||
unless(UNIVERSAL::isa($object, 'HASH') && exists $object->{$thingy})
|
||||
{ my $a = $thingy =~ /^[aeiou]/i ? 'an' : 'a';
|
||||
my $has = ref $object eq 'HASH' ? join(", ",keys %$object) : '';
|
||||
warn $@ = ref($object)." $object does not have $a $thingy. "
|
||||
. ($has ? "It has $has" : '');
|
||||
return undef;
|
||||
}
|
||||
|
||||
my $value = $object->{$thingy};
|
||||
$value =~ s/\\ ( [\\\(\)"\x0d\x0a] )/$1/gx;
|
||||
$value =~ s/^"(.*)"$/$1/;
|
||||
$value;
|
||||
}
|
||||
|
||||
BEGIN
|
||||
{ no strict 'refs';
|
||||
foreach my $datum (
|
||||
qw/ bodytype bodysubtype bodyparms bodydisp bodyid bodydesc bodyenc
|
||||
bodysize bodylang envelopestruct textlines / )
|
||||
{ *$datum = sub { _get_thingy($datum, @_) };
|
||||
}
|
||||
}
|
||||
|
||||
sub parts
|
||||
{ my $self = shift;
|
||||
return wantarray ? @{$self->{PartsList}} : $self->{PartsList}
|
||||
if exists $self->{PartsList};
|
||||
|
||||
my @parts;
|
||||
$self->{PartsList} = \@parts;
|
||||
|
||||
# BUG?: should this default to ($HEAD, TEXT)
|
||||
unless(exists $self->{bodystructure})
|
||||
{ $self->{PartsIndex}{1} = $self;
|
||||
@parts = ($HEAD, 1);
|
||||
return wantarray ? @parts : \@parts;
|
||||
}
|
||||
|
||||
foreach my $p ($self->bodystructure)
|
||||
{ my $id = $p->id;
|
||||
push @parts, $id;
|
||||
$self->{PartsIndex}{$id} = $p ;
|
||||
my $type = uc $p->bodytype || '';
|
||||
|
||||
push @parts, "$id.$HEAD"
|
||||
if $type eq 'MESSAGE';
|
||||
}
|
||||
|
||||
wantarray ? @parts : \@parts;
|
||||
}
|
||||
|
||||
sub bodystructure
|
||||
{ my $self = shift;
|
||||
my $partno = 0;
|
||||
my @parts;
|
||||
|
||||
if($self->{_top})
|
||||
{ $self->{_id} ||= $HEAD;
|
||||
$self->{_prefix} ||= $HEAD;
|
||||
$partno = 0;
|
||||
foreach my $b ( @{$self->{bodystructure}} )
|
||||
{ $b->{_id} = ++$partno;
|
||||
$b->{_prefix} = $partno;
|
||||
push @parts, $b, $b->bodystructure;
|
||||
}
|
||||
return wantarray ? @parts : \@parts;
|
||||
}
|
||||
|
||||
my $prefix = $self->{_prefix} || "";
|
||||
$prefix =~ s/\.?$/./;
|
||||
|
||||
foreach my $p ( @{$self->{bodystructure}} )
|
||||
{ $partno++;
|
||||
|
||||
# BUG?: old code didn't add .TEXT sections, should we skip these?
|
||||
# - This code needs to be generalised (maybe it belongs in parts()?)
|
||||
# - Should every message should have HEAD (actually MIME) and TEXT?
|
||||
# at least dovecot and iplanet appear to allow this even for
|
||||
# non-multipart sections
|
||||
my $pno = $partno;
|
||||
my $stype = $self->{bodytype} || "";
|
||||
my $ptype = $p->{bodytype} || "";
|
||||
|
||||
# a message and the multipart inside of it "collapse together"
|
||||
if ($partno == 1 and $stype eq 'MESSAGE' and $ptype eq 'MULTIPART') {
|
||||
$pno = "TEXT";
|
||||
$p->{_prefix} = "$prefix";
|
||||
}
|
||||
else {
|
||||
$p->{_prefix} = "$prefix$partno";
|
||||
}
|
||||
$p->{_id} ||= "$prefix$pno";
|
||||
|
||||
push @parts, $p, $p->{bodystructure} ? $p->bodystructure : ();
|
||||
}
|
||||
|
||||
wantarray ? @parts : \@parts;
|
||||
}
|
||||
|
||||
sub id
|
||||
{ my $self = shift;
|
||||
return $self->{_id}
|
||||
if exists $self->{_id};
|
||||
|
||||
return $HEAD
|
||||
if $self->{_top};
|
||||
|
||||
# BUG?: can this be removed? ... seems wrong
|
||||
if ($self->{bodytype} eq 'MULTIPART')
|
||||
{ my $p = $self->{_id} || $self->{_prefix};
|
||||
$p =~ s/\.$//;
|
||||
return $p;
|
||||
}
|
||||
else
|
||||
{ return $self->{_id} ||= 1;
|
||||
}
|
||||
}
|
||||
|
||||
package Mail::IMAPClient::BodyStructure::Part;
|
||||
our @ISA = qw/Mail::IMAPClient::BodyStructure/;
|
||||
|
||||
package Mail::IMAPClient::BodyStructure::Envelope;
|
||||
our @ISA = qw/Mail::IMAPClient::BodyStructure/;
|
||||
|
||||
sub new
|
||||
{ my ($class, $envelope) = @_;
|
||||
$parser->envelope($envelope);
|
||||
}
|
||||
|
||||
sub from_addresses { shift->_addresses(from => 1) }
|
||||
sub sender_addresses { shift->_addresses(sender => 1) }
|
||||
sub replyto_addresses { shift->_addresses(replyto => 1) }
|
||||
sub to_addresses { shift->_addresses(to => 0) }
|
||||
sub cc_addresses { shift->_addresses(cc => 0) }
|
||||
sub bcc_addresses { shift->_addresses(bcc => 0) }
|
||||
|
||||
sub _addresses($$$)
|
||||
{ my ($self, $name, $isSender) = @_;
|
||||
ref $self->{$name} eq 'ARRAY'
|
||||
or return ();
|
||||
|
||||
my @list;
|
||||
foreach ( @{$self->{$name}} )
|
||||
{ my $pn = $_->personalname;
|
||||
my $name = $pn && $pn ne 'NIL' ? "$pn " : '';
|
||||
push @list, $name . '<' . $_->mailboxname . '@' . $_->hostname . '>';
|
||||
}
|
||||
|
||||
wantarray ? @list
|
||||
: $isSender ? $list[0]
|
||||
: \@list;
|
||||
}
|
||||
|
||||
BEGIN
|
||||
{ no strict 'refs';
|
||||
for my $datum ( qw(subject inreplyto from messageid bcc date
|
||||
replyto to sender cc))
|
||||
{ *$datum = sub { @_ > 1 ? $_[0]->{$datum} = $_[1] : $_[0]->{$datum} }
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
package Mail::IMAPClient::BodyStructure::Address;
|
||||
our @ISA = qw/Mail::IMAPClient::BodyStructure/;
|
||||
|
||||
for my $datum ( qw(personalname mailboxname hostname sourcename) )
|
||||
{ no strict 'refs';
|
||||
*$datum = sub { shift->{$datum}; };
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Mail::IMAPClient::BodyStructure - parse fetched results
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use Mail::IMAPClient::BodyStructure;
|
||||
use Mail::IMAPClient;
|
||||
|
||||
my $imap = Mail::IMAPClient->new(Server=>$serv,User=>$usr,Password=>$pwd);
|
||||
$imap->select("INBOX") or die "cannot select the inbox for $usr: $@\n";
|
||||
|
||||
my @recent = $imap->search("recent");
|
||||
|
||||
foreach my $id (@recent)
|
||||
{ my $fetched = $imap->fetch($id, "bodystructure");
|
||||
my $struct = Mail::IMAPClient::BodyStructure->new($fetched);
|
||||
|
||||
my $mime = $struct->bodytype."/".$struct->bodysubtype;
|
||||
my $parts =join "\n\t", $struct->parts;
|
||||
print "Msg $id (Content-type: $mime) contains these parts:\n\t$parts\n";
|
||||
}
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This extension will parse the result of an IMAP FETCH BODYSTRUCTURE
|
||||
command into a perl data structure. It also provides helper methods that
|
||||
will help you pull information out of the data structure.
|
||||
|
||||
Use of this extension requires Parse::RecDescent. If you don't have
|
||||
Parse::RecDescent then you must either get it or refrain from using
|
||||
this module.
|
||||
|
||||
=head2 EXPORT
|
||||
|
||||
Nothing is exported by default. C<$parser> is exported upon
|
||||
request. C<$parser> is the BodyStucture object's Parse::RecDescent object,
|
||||
which you'll probably only need for debugging purposes.
|
||||
|
||||
=head1 Class Methods
|
||||
|
||||
The following class method is available:
|
||||
|
||||
=head2 new
|
||||
|
||||
This class method is the constructor method for instantiating new
|
||||
Mail::IMAPClient::BodyStructure objects. The B<new> method accepts one
|
||||
argument, a string containing a server response to a FETCH BODYSTRUCTURE
|
||||
directive. Only one message's body structure should be described in this
|
||||
string, although that message may contain an arbitrary number of parts.
|
||||
|
||||
If you know the messages sequence number or unique ID (UID)
|
||||
but haven't got its body structure, and you want to get the body
|
||||
structure and parse it into a B<Mail::IMAPClient::BodyStructure>
|
||||
object, then you might as well save yourself some work and use
|
||||
B<Mail::IMAPClient>'s B<get_bodystructure> method, which accepts
|
||||
a message sequence number (or UID if I<Uid> is true) and returns a
|
||||
B<Mail::IMAPClient::BodyStructure> object. It's functionally equivalent
|
||||
to issuing the FETCH BODYSTRUCTURE IMAP client command and then passing
|
||||
the results to B<Mail::IMAPClient::BodyStructure>'s B<new> method but
|
||||
it does those things in one simple method call.
|
||||
|
||||
=head1 Object Methods
|
||||
|
||||
The following object methods are available:
|
||||
|
||||
=head2 bodytype
|
||||
|
||||
The B<bodytype> object method requires no arguments. It returns the
|
||||
bodytype for the message whose structure is described by the calling
|
||||
B<Mail::IMAPClient::Bodystructure> object.
|
||||
|
||||
=head2 bodysubtype
|
||||
|
||||
The B<bodysubtype> object method requires no arguments. It returns the
|
||||
bodysubtype for the message whose structure is described by the calling
|
||||
B<Mail::IMAPClient::Bodystructure> object.
|
||||
|
||||
=head2 bodyparms
|
||||
|
||||
The B<bodyparms> object method requires no arguments. It returns the
|
||||
bodyparms for the message whose structure is described by the calling
|
||||
B<Mail::IMAPClient::Bodystructure> object.
|
||||
|
||||
=head2 bodydisp
|
||||
|
||||
The B<bodydisp> object method requires no arguments. It returns the
|
||||
bodydisp for the message whose structure is described by the calling
|
||||
B<Mail::IMAPClient::Bodystructure> object.
|
||||
|
||||
=head2 bodyid
|
||||
|
||||
The B<bodyid> object method requires no arguments. It returns the
|
||||
bodyid for the message whose structure is described by the calling
|
||||
B<Mail::IMAPClient::Bodystructure> object.
|
||||
|
||||
=head2 bodydesc
|
||||
|
||||
The B<bodydesc> object method requires no arguments. It returns the
|
||||
bodydesc for the message whose structure is described by the calling
|
||||
B<Mail::IMAPClient::Bodystructure> object.
|
||||
|
||||
=head2 bodyenc
|
||||
|
||||
The B<bodyenc> object method requires no arguments. It returns the
|
||||
bodyenc for the message whose structure is described by the calling
|
||||
B<Mail::IMAPClient::Bodystructure> object.
|
||||
|
||||
=head2 bodysize
|
||||
|
||||
The B<bodysize> object method requires no arguments. It returns the
|
||||
bodysize for the message whose structure is described by the calling
|
||||
B<Mail::IMAPClient::Bodystructure> object.
|
||||
|
||||
=head2 bodylang
|
||||
|
||||
The B<bodylang> object method requires no arguments. It returns the
|
||||
bodylang for the message whose structure is described by the calling
|
||||
B<Mail::IMAPClient::Bodystructure> object.
|
||||
|
||||
=head2 bodystructure
|
||||
|
||||
The B<bodystructure> object method requires no arguments. It returns
|
||||
the bodystructure for the message whose structure is described by the
|
||||
calling B<Mail::IMAPClient::Bodystructure> object.
|
||||
|
||||
=head2 envelopestruct
|
||||
|
||||
The B<envelopestruct> object method requires no arguments. It returns
|
||||
the envelopestruct for the message whose structure is described by the
|
||||
calling B<Mail::IMAPClient::Bodystructure> object. This envelope structure
|
||||
is blessed into the B<Mail::IMAPClient::BodyStructure::Envelope> subclass,
|
||||
which is explained more fully below.
|
||||
|
||||
=head2 textlines
|
||||
|
||||
The B<textlines> object method requires no arguments. It returns the
|
||||
textlines for the message whose structure is described by the calling
|
||||
B<Mail::IMAPClient::Bodystructure> object.
|
||||
|
||||
=head1 Envelopes and the Mail::IMAPClient::BodyStructure::Envelope Subclass
|
||||
|
||||
The IMAP standard specifies that output from the IMAP B<FETCH
|
||||
ENVELOPE> command will be an RFC2060 envelope structure. It further
|
||||
specifies that output from the B<FETCH BODYSTRUCTURE> command may also
|
||||
contain embedded envelope structures (if, for example, a message's
|
||||
subparts contain one or more included messages). Objects belonging to
|
||||
B<Mail::IMAPClient::BodyStructure::Envelope> are Perl representations
|
||||
of these envelope structures, which is to say the nested parenthetical
|
||||
lists of RFC2060 translated into a Perl datastructure.
|
||||
|
||||
Note that all of the fields relate to the specific part to which they
|
||||
belong. In other words, output from a FETCH nnnn ENVELOPE command (or,
|
||||
in B<Mail::IMAPClient>, C<$imap->fetch($msgid,"ENVELOPE")> or C<my $env =
|
||||
$imap->get_envelope($msgid)>) are for the message, but fields from within
|
||||
a bodystructure relate to the message subpart and not the parent message.
|
||||
|
||||
An envelope structure's B<Mail::IMAPClient::BodyStructure::Envelope>
|
||||
representation is a hash of thingies that looks like this:
|
||||
|
||||
{
|
||||
subject => "subject",
|
||||
inreplyto => "reference_message_id",
|
||||
from => [ addressStruct1 ],
|
||||
messageid => "message_id",
|
||||
bcc => [ addressStruct1, addressStruct2 ],
|
||||
date => "Tue, 09 Jul 2002 14:15:53 -0400",
|
||||
replyto => [ adressStruct1, addressStruct2 ],
|
||||
to => [ adressStruct1, addressStruct2 ],
|
||||
sender => [ adressStruct1 ],
|
||||
cc => [ adressStruct1, addressStruct2 ],
|
||||
}
|
||||
|
||||
The B<...::Envelope> object also has methods for accessing data in the
|
||||
structure. They are:
|
||||
|
||||
=over 4
|
||||
|
||||
=item date
|
||||
|
||||
Returns the date of the message.
|
||||
|
||||
=item inreplyto
|
||||
|
||||
Returns the message id of the message to which this message is a reply.
|
||||
|
||||
=item subject
|
||||
|
||||
Returns the subject of the message.
|
||||
|
||||
=item messageid
|
||||
|
||||
Returns the message id of the message.
|
||||
|
||||
=back
|
||||
|
||||
You can also use the following methods to get addressing
|
||||
information. Each of these methods returns an array of
|
||||
B<Mail::IMAPClient::BodyStructure::Address> objects, which are perl
|
||||
data structures representing RFC2060 address structures. Some of these
|
||||
arrays would naturally contain one element (such as B<from>, which
|
||||
normally contains a single "From:" address); others will often contain
|
||||
more than one address. However, because RFC2060 defines all of these as
|
||||
"lists of address structures", they are all translated into arrays of
|
||||
B<...::Address> objects.
|
||||
|
||||
See the section on B<Mail::IMAPClient::BodyStructure::Address>", below,
|
||||
for alternate (and preferred) ways of accessing these data.
|
||||
|
||||
The methods available are:
|
||||
|
||||
=over 4
|
||||
|
||||
=item bcc
|
||||
|
||||
Returns an array of blind cc'ed recipients' address structures. (Don't
|
||||
expect much in here unless the message was sent from the mailbox you're
|
||||
poking around in, by the way.)
|
||||
|
||||
=item cc
|
||||
|
||||
Returns an array of cc'ed recipients' address structures.
|
||||
|
||||
=item from
|
||||
|
||||
Returns an array of "From:" address structures--usually just one.
|
||||
|
||||
=item replyto
|
||||
|
||||
Returns an array of "Reply-to:" address structures. Once again there is
|
||||
usually just one address in the list.
|
||||
|
||||
=item sender
|
||||
|
||||
Returns an array of senders' address structures--usually just one and
|
||||
usually the same as B<from>.
|
||||
|
||||
=item to
|
||||
|
||||
Returns an array of recipients' address structures.
|
||||
|
||||
=back
|
||||
|
||||
Each of the methods that returns a list of address structures (i.e. a
|
||||
list of B<Mail::IMAPClient::BodyStructure::Address> arrays) also has an
|
||||
analagous method that will return a list of E-Mail addresses instead. The
|
||||
addresses are in the format C<personalname E<lt>mailboxname@hostnameE<gt>>
|
||||
(see the section on B<Mail::IMAPClient::BodyStructure::Address>,
|
||||
below) However, if the personal name is 'NIL' then it is omitted from
|
||||
the address.
|
||||
|
||||
These methods are:
|
||||
|
||||
=over 4
|
||||
|
||||
=item bcc_addresses
|
||||
|
||||
Returns a list (or an array reference if called in scalar context)
|
||||
of blind cc'ed recipients' email addresses. (Don't expect much in here
|
||||
unless the message was sent from the mailbox you're poking around in,
|
||||
by the way.)
|
||||
|
||||
=item cc_addresses
|
||||
|
||||
Returns a list of cc'ed recipients' email addresses. If called in a scalar
|
||||
context it returns a reference to an array of email addresses.
|
||||
|
||||
=item from_addresses
|
||||
|
||||
Returns a list of "From:" email addresses. If called in a scalar context
|
||||
it returns the first email address in the list. (It's usually a list of just
|
||||
one anyway.)
|
||||
|
||||
=item replyto_addresses
|
||||
|
||||
Returns a list of "Reply-to:" email addresses. If called in a scalar context
|
||||
it returns the first email address in the list.
|
||||
|
||||
=item sender_addresses
|
||||
|
||||
Returns a list of senders' email addresses. If called in a scalar context
|
||||
it returns the first email address in the list.
|
||||
|
||||
=item to_addresses
|
||||
|
||||
Returns a list of recipients' email addresses. If called in a scalar context
|
||||
it returns a reference to an array of email addresses.
|
||||
|
||||
=back
|
||||
|
||||
Note that context affects the behavior of all of the above methods.
|
||||
|
||||
Those fields that will commonly contain multiple entries (i.e. they are
|
||||
recipients) will return an array reference when called in scalar context.
|
||||
You can use this behavior to optimize performance.
|
||||
|
||||
Those fields that will commonly contain just one address (the sender's) will
|
||||
return the first (and usually only) address. You can use this behavior to
|
||||
optimize your development time.
|
||||
|
||||
=head1 Addresses and the Mail::IMAPClient::BodyStructure::Address
|
||||
|
||||
Several components of an envelope structure are address
|
||||
structures. They are each parsed into their own object,
|
||||
B<Mail::IMAPClient::BodyStructure::Address>, which looks like this:
|
||||
|
||||
{ mailboxname => 'somebody.special'
|
||||
, hostname => 'somplace.weird.com'
|
||||
, personalname => 'Somebody Special
|
||||
, sourceroute => 'NIL'
|
||||
}
|
||||
|
||||
RFC2060 specifies that each address component of a bodystructure is a
|
||||
list of address structures, so B<Mail::IMAPClient::BodyStructure> parses
|
||||
each of these into an array of B<Mail::IMAPClient::BodyStructure::Address>
|
||||
objects.
|
||||
|
||||
Each of these objects has the following methods available to it:
|
||||
|
||||
=over 4
|
||||
|
||||
=item mailboxname
|
||||
|
||||
Returns the "mailboxname" portion of the address, which is the part to
|
||||
the left of the '@' sign.
|
||||
|
||||
=item hostname
|
||||
|
||||
Returns the "hostname" portion of the address, which is the part to the
|
||||
right of the '@' sign.
|
||||
|
||||
=item personalname
|
||||
|
||||
Returns the "personalname" portion of the address, which is the part of
|
||||
the address that's treated like a comment.
|
||||
|
||||
=item sourceroute
|
||||
|
||||
Returns the "sourceroute" portion of the address, which is typically "NIL".
|
||||
|
||||
=back
|
||||
|
||||
Taken together, the parts of an address structure form an address that will
|
||||
look something like this:
|
||||
|
||||
C<personalname E<lt>mailboxname@hostnameE<gt>>
|
||||
|
||||
Note that because the B<Mail::IMAPClient::BodyStructure::Address>
|
||||
objects come in arrays, it's generally easier to use the methods
|
||||
available to B<Mail::IMAPClient::BodyStructure::Envelope> to obtain
|
||||
all of the addresses in a particular array in one operation. These
|
||||
methods are provided, however, in case you'd rather do things
|
||||
the hard way. (And also because the aforementioned methods from
|
||||
B<Mail::IMAPClient::BodyStructure::Envelope> need them anyway.)
|
||||
|
||||
=cut
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
David J. Kernen
|
||||
|
||||
Reworked and maintained by Mark Overmeer.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
perl(1), Mail::IMAPClient, and RFC2060. See also Parse::RecDescent if you
|
||||
want to understand the internals of this module.
|
||||
|
||||
=cut
|
||||
|
|
@ -0,0 +1,189 @@
|
|||
# Directives
|
||||
# ( none)
|
||||
# Start-up Actions
|
||||
|
||||
{
|
||||
my $mibs = "Mail::IMAPClient::BodyStructure";
|
||||
my $subpartCount = 0;
|
||||
my $partCount = 0;
|
||||
|
||||
sub take_optional_items($$@)
|
||||
{ my ($r, $items) = (shift, shift);
|
||||
foreach (@_)
|
||||
{ my $opt = $_ .'(?)';
|
||||
exists $items->{$opt} or next;
|
||||
$r->{$_} = UNIVERSAL::isa($items->{$opt}, 'ARRAY')
|
||||
? $items->{$opt}[0] : $items->{$opt};
|
||||
}
|
||||
}
|
||||
|
||||
sub merge_hash($$)
|
||||
{ my $to = shift;
|
||||
my $from = shift or return;
|
||||
while( my($k,$v) = each %$from) { $to->{$k} = $v }
|
||||
}
|
||||
}
|
||||
|
||||
# Atoms
|
||||
|
||||
TEXT: /^"TEXT"|^TEXT/i { $return = "TEXT" }
|
||||
PLAIN: /^"PLAIN"|^PLAIN/i { $return = "PLAIN" }
|
||||
HTML: /"HTML"|HTML/i { $return = "HTML" }
|
||||
MESSAGE: /^"MESSAGE"|^MESSAGE/i { $return = "MESSAGE"}
|
||||
RFC822: /^"RFC822"|^RFC822/i { $return = "RFC822" }
|
||||
NIL: /^NIL/i { $return = "NIL" }
|
||||
RFCNONCOMPLY: /^\(\)/i { $return = "NIL" }
|
||||
NUMBER: /^(\d+)/ { $return = $item[1] }
|
||||
|
||||
# Strings:
|
||||
|
||||
SINGLE_QUOTED_STRING: "'" /(?:\\'|[^'])*/ "'" { $return = $item{__PATTERN1__} }
|
||||
DOUBLE_QUOTED_STRING: '"' /(?:\\"|[^"])*/ '"' { $return = $item{__PATTERN1__} }
|
||||
|
||||
BARESTRING: ...!/^[)('"]/ /^(?!\(|\))(?:\\ |\S)+/
|
||||
{ $return = $item{__PATTERN1__} }
|
||||
|
||||
STRING: DOUBLE_QUOTED_STRING | SINGLE_QUOTED_STRING | BARESTRING
|
||||
|
||||
STRINGS: "(" STRING(s) ")" { $return = $item{'STRING(s)'} }
|
||||
|
||||
textlines: NIL | NUMBER
|
||||
|
||||
rfc822message: MESSAGE RFC822 { $return = "MESSAGE RFC822" }
|
||||
|
||||
bodysubtype: PLAIN | HTML | NIL | STRING
|
||||
|
||||
key: STRING
|
||||
value: NIL | NUMBER | STRING | KVPAIRS
|
||||
|
||||
kvpair: ...!")" key value
|
||||
{ $return = { $item{key} => $item{value} } }
|
||||
|
||||
KVPAIRS: "(" kvpair(s) ")"
|
||||
{ $return = { map { (%$_) } @{$item{'kvpair(s)'}} } }
|
||||
|
||||
bodytype: STRING
|
||||
bodyparms: NIL | KVPAIRS
|
||||
bodydisp: NIL | KVPAIRS
|
||||
bodyid: ...!/[()]/ NIL | STRING
|
||||
bodydesc: ...!/[()]/ NIL | STRING
|
||||
bodysize: ...!/[()]/ NIL | NUMBER
|
||||
bodyenc: NIL | STRING | KVPAIRS
|
||||
bodyMD5: NIL | STRING
|
||||
bodylang: NIL | STRING | STRINGS
|
||||
bodyextra: NIL | STRING | STRINGS
|
||||
bodyloc: NIL | STRING
|
||||
|
||||
personalname: NIL | STRING
|
||||
sourceroute: NIL | STRING
|
||||
mailboxname: NIL | STRING
|
||||
hostname: NIL | STRING
|
||||
|
||||
addressstruct: "(" personalname sourceroute mailboxname hostname ")"
|
||||
{ bless { personalname => $item{personalname}
|
||||
, sourceroute => $item{sourceroute}
|
||||
, mailboxname => $item{mailboxname}
|
||||
, hostname => $item{hostname}
|
||||
}, 'Mail::IMAPClient::BodyStructure::Address';
|
||||
}
|
||||
|
||||
subject: NIL | STRING
|
||||
inreplyto: NIL | STRING
|
||||
messageid: NIL | STRING
|
||||
date: NIL | STRING
|
||||
|
||||
ADDRESSES: NIL | RFCNONCOMPLY
|
||||
| "(" addressstruct(s) ")" { $return = $item{'addressstruct(s)'} }
|
||||
|
||||
cc: ADDRESSES
|
||||
bcc: ADDRESSES
|
||||
from: ADDRESSES
|
||||
replyto: ADDRESSES
|
||||
sender: ADDRESSES
|
||||
to: ADDRESSES
|
||||
|
||||
envelopestruct: "(" date subject from sender replyto to cc
|
||||
bcc inreplyto messageid ")"
|
||||
{ $return = bless {}, "Mail::IMAPClient::BodyStructure::Envelope";
|
||||
$return->{$_} = $item{$_}
|
||||
for qw/date subject from sender replyto to cc/
|
||||
, qw/bcc inreplyto messageid/;
|
||||
1;
|
||||
}
|
||||
|
||||
basicfields: bodysubtype bodyparms(?) bodyid(?)
|
||||
bodydesc(?) bodyenc(?) bodysize(?)
|
||||
{ $return = { bodysubtype => $item{bodysubtype} };
|
||||
take_optional_items($return, \%item,
|
||||
qw/bodyparms bodyid bodydesc bodyenc bodysize/);
|
||||
1;
|
||||
}
|
||||
|
||||
textmessage: TEXT <commit> basicfields textlines(?) bodyMD5(?)
|
||||
bodydisp(?) bodylang(?) bodyextra(?)
|
||||
{
|
||||
$return = $item{basicfields} || {};
|
||||
$return->{bodytype} = 'TEXT';
|
||||
take_optional_items($return, \%item
|
||||
, qw/textlines bodyMD5 bodydisp bodylang bodyextra/);
|
||||
1;
|
||||
}
|
||||
|
||||
othertypemessage: bodytype basicfields bodyMD5(?) bodydisp(?)
|
||||
bodylang(?) bodyextra(?)
|
||||
{ $return = { bodytype => $item{bodytype} };
|
||||
take_optional_items($return, \%item
|
||||
, qw/bodyMD5 bodydisp bodylang bodyextra/ );
|
||||
merge_hash($return, $item{basicfields});
|
||||
1;
|
||||
}
|
||||
|
||||
nestedmessage: rfc822message <commit> bodyparms bodyid bodydesc bodyenc
|
||||
# bodysize envelopestruct bodystructure textlines
|
||||
bodysize envelopestruct(?) bodystructure(?) textlines(?)
|
||||
bodyMD5(?) bodydisp(?) bodylang(?) bodyextra(?)
|
||||
{
|
||||
$return = {};
|
||||
$return->{$_} = $item{$_}
|
||||
for qw/bodyparms bodyid bodydesc bodyenc bodysize/;
|
||||
# envelopestruct bodystructure textlines/;
|
||||
|
||||
take_optional_items($return, \%item
|
||||
, qw/envelopestruct bodystructure textlines/
|
||||
, qw/bodyMD5 bodydisp bodylang bodyextra/);
|
||||
|
||||
merge_hash($return, $item{bodystructure}[0]);
|
||||
merge_hash($return, $item{basicfields});
|
||||
$return->{bodytype} = "MESSAGE" ;
|
||||
$return->{bodysubtype} = "RFC822" ;
|
||||
1;
|
||||
}
|
||||
|
||||
multipart: subpart(s) <commit> bodysubtype
|
||||
bodyparms(?) bodydisp(?) bodylang(?) bodyloc(?) bodyextra(?)
|
||||
<defer: $subpartCount = 0>
|
||||
{ $return =
|
||||
{ bodysubtype => $item{bodysubtype}
|
||||
, bodytype => 'MULTIPART'
|
||||
, bodystructure => $item{'subpart(s)'}
|
||||
};
|
||||
take_optional_items($return, \%item
|
||||
, qw/bodyparms bodydisp bodylang bodyloc bodyextra/);
|
||||
1;
|
||||
}
|
||||
|
||||
subpart: "(" part ")" {$return = $item{part}} <defer: ++$subpartCount;>
|
||||
|
||||
part: multipart { $return = bless $item{multipart}, $mibs }
|
||||
| textmessage { $return = bless $item{textmessage}, $mibs }
|
||||
| nestedmessage { $return = bless $item{nestedmessage}, $mibs }
|
||||
| othertypemessage { $return = bless $item{othertypemessage}, $mibs }
|
||||
|
||||
bodystructure: "(" part(s) ")"
|
||||
{ $return = $item{'part(s)'} }
|
||||
|
||||
start: /.*?\(.*?BODYSTRUCTURE \(/i part(1) /\).*\)\r?\n?/
|
||||
{ $return = $item{'part(1)'}[0] }
|
||||
|
||||
envelope: /.*?\(.*?ENVELOPE/ envelopestruct /.*\)/
|
||||
{ $return = $item{envelopestruct} }
|
||||
16801
Mail-IMAPClient-3.27/lib/Mail/IMAPClient/BodyStructure/Parse.pm
Normal file
16801
Mail-IMAPClient-3.27/lib/Mail/IMAPClient/BodyStructure/Parse.pm
Normal file
File diff suppressed because it is too large
Load diff
|
|
@ -0,0 +1,15 @@
|
|||
=head1 NAME
|
||||
|
||||
Mail::IMAPClient::BodyStructure::Parse - used internally by Mail::IMAPClient::BodyStructure
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module is used internally by L<Mail::IMAPClient::BodyStructure>
|
||||
and is generated using L<Parse::RecDescent>. It is not meant to be used
|
||||
directly by other scripts nor is there much point in debugging it.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This module is used internally by L<Mail::IMAPClient::BodyStructure>
|
||||
and is not meant to be used or called directly from applications. So
|
||||
don't do that.
|
||||
280
Mail-IMAPClient-3.27/lib/Mail/IMAPClient/MessageSet.pm
Normal file
280
Mail-IMAPClient-3.27/lib/Mail/IMAPClient/MessageSet.pm
Normal file
|
|
@ -0,0 +1,280 @@
|
|||
use warnings;
|
||||
use strict;
|
||||
|
||||
package Mail::IMAPClient::MessageSet;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Mail::IMAPClient::MessageSet - ranges of message sequence nummers
|
||||
|
||||
=cut
|
||||
|
||||
use overload
|
||||
'""' => "str"
|
||||
, '.=' => sub {$_[0]->cat($_[1])}
|
||||
, '+=' => sub {$_[0]->cat($_[1])}
|
||||
, '-=' => sub {$_[0]->rem($_[1])}
|
||||
, '@{}' => "unfold"
|
||||
, fallback => 1;
|
||||
|
||||
sub new
|
||||
{ my $class = shift;
|
||||
my $range = $class->range(@_);
|
||||
bless \$range, $class;
|
||||
}
|
||||
|
||||
sub str { overload::StrVal( ${$_[0]} ) }
|
||||
|
||||
sub _unfold_range($)
|
||||
# { my $x = shift; return if $x =~ m/[^0-9,:]$/; $x =~ s/\:/../g; eval $x; }
|
||||
{ map { /(\d+)\s*\:\s*(\d+)/ ? ($1..$2) : $_ }
|
||||
split /\,/, shift;
|
||||
}
|
||||
|
||||
sub rem
|
||||
{ my $self = shift;
|
||||
my %delete = map { ($_ => 1) } map { _unfold_range $_ } @_;
|
||||
$$self = $self->range(grep {not $delete{$_}} $self->unfold);
|
||||
$self;
|
||||
}
|
||||
|
||||
sub cat
|
||||
{ my $self = shift;
|
||||
$$self = $self->range($$self, @_);
|
||||
$self;
|
||||
}
|
||||
|
||||
sub range
|
||||
{ my $self = shift;
|
||||
|
||||
my @msgs;
|
||||
foreach my $m (@_)
|
||||
{ defined $m && length $m
|
||||
or next;
|
||||
|
||||
foreach my $mm (ref $m eq 'ARRAY' ? @$m : $m)
|
||||
{ push @msgs, _unfold_range $mm;
|
||||
}
|
||||
}
|
||||
|
||||
@msgs
|
||||
or return undef;
|
||||
|
||||
@msgs = sort {$a <=> $b} @msgs;
|
||||
my $low = my $high = shift @msgs;
|
||||
|
||||
my @ranges;
|
||||
foreach my $m (@msgs)
|
||||
{ next if $m == $high; # double
|
||||
|
||||
if($m == $high + 1) { $high = $m }
|
||||
else
|
||||
{ push @ranges, $low == $high ? $low : "$low:$high";
|
||||
$low = $high = $m;
|
||||
}
|
||||
}
|
||||
|
||||
push @ranges, $low == $high ? $low : "$low:$high" ;
|
||||
join ",", @ranges;
|
||||
}
|
||||
|
||||
sub unfold
|
||||
{ my $self = shift;
|
||||
wantarray ? ( _unfold_range $$self ) : [ _unfold_range $$self ];
|
||||
}
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
my @msgs = $imap->search("SUBJECT","Virus"); # returns 1,3,4,5,6,9,10
|
||||
my $msgset = Mail::IMAPClient::MessageSet->new(@msgs);
|
||||
print $msgset; # prints "1,3:6,9:10"
|
||||
|
||||
# add message 14 to the set:
|
||||
$msgset += 14;
|
||||
print $msgset; # prints "1,3:6,9:10,14"
|
||||
|
||||
# add messages 16,17,18,19, and 20 to the set:
|
||||
$msgset .= "16,17,18:20";
|
||||
print $msgset; # prints "1,3:6,9:10,14,16:20"
|
||||
|
||||
# Hey, I didn't really want message 17 in there; let's take it out:
|
||||
$msgset -= 17;
|
||||
print $msgset; # prints "1,3:6,9:10,14,16,18:20"
|
||||
|
||||
# Now let's iterate over each message:
|
||||
for my $msg (@$msgset)
|
||||
{ print "$msg\n"; # Prints: "1\n3\n4\n5\n6..16\n18\n19\n20\n"
|
||||
}
|
||||
print join("\n", @$msgset)."\n"; # same simpler
|
||||
local $" = "\n"; print "@$msgset\n"; # even more simple
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
The B<Mail::IMAPClient::MessageSet> module is designed to make life easier
|
||||
for programmers who need to manipulate potentially large sets of IMAP
|
||||
message UID's or sequence numbers.
|
||||
|
||||
This module presents an object-oriented interface into handling your
|
||||
message sets. The object reference returned by the L<new> method is an
|
||||
overloaded reference to a scalar variable that contains the message set's
|
||||
compact RFC2060 representation. The object is overloaded so that using
|
||||
it like a string returns this compact message set representation. You
|
||||
can also add messages to the set (using either a '.=' operator or a '+='
|
||||
operator) or remove messages (with the '-=' operator). And if you use
|
||||
it as an array reference, it will humor you and act like one by calling
|
||||
L<unfold> for you.
|
||||
|
||||
RFC2060 specifies that multiple messages can be provided to certain IMAP
|
||||
commands by separating them with commas. For example, "1,2,3,4,5" would
|
||||
specify messages 1, 2, 3, 4, and (you guessed it!) 5. However, if you are
|
||||
performing an operation on lots of messages, this string can get quite long.
|
||||
So long that it may slow down your transaction, and perhaps even cause the
|
||||
server to reject it. So RFC2060 also permits you to specifiy a range of
|
||||
messages, so that messages 1, 2, 3, 4 and 5 can also be specified as
|
||||
"1:5".
|
||||
|
||||
This is where B<Mail::IMAPClient::MessageSet> comes in. It will convert
|
||||
your message set into the shortest correct syntax. This could potentially
|
||||
save you tons of network I/O, as in the case where you want to fetch the
|
||||
flags for all messages in a 10000 message folder, where the messages
|
||||
are all numbered sequentially. Delimited as commas, and making the
|
||||
best-case assumption that the first message is message "1", it would take
|
||||
48893 bytes to specify the whole message set using the comma-delimited
|
||||
method. To specify it as a range, it takes just seven bytes (1:10000).
|
||||
|
||||
Note that the L<Mail::IMAPClient> B<Range> method can be used as
|
||||
a short-cut to specifying C<Mail::IMAPClient::MessageSet-E<gt>new(@etc)>.)
|
||||
|
||||
=head1 CLASS METHODS
|
||||
|
||||
The only class method you need to worry about is B<new>. And if you create
|
||||
your B<Mail::IMAPClient::MessageSet> objects via L<Mail::IMAPClient>'s
|
||||
B<Range> method then you don't even need to worry about B<new>.
|
||||
|
||||
=head2 new
|
||||
|
||||
Example:
|
||||
|
||||
my $msgset = Mail::IMAPClient::MessageSet->new(@msgs);
|
||||
|
||||
The B<new> method requires at least one argument. That argument can be
|
||||
either a message, a comma-separated list of messages, a colon-separated
|
||||
range of messages, or a combination of comma-separated messages and
|
||||
colon-separated ranges. It can also be a reference to an array of messages,
|
||||
comma-separated message lists, and colon separated ranges.
|
||||
|
||||
If more then one argument is supplied to B<new>, then those arguments should
|
||||
be more message numbers, lists, and ranges (or references to arrays of them)
|
||||
just as in the first argument.
|
||||
|
||||
The message numbers passed to B<new> can really be any kind of number at
|
||||
all but to be useful in a L<Mail::IMAPClient> session they should be either
|
||||
message UID's (if your I<Uid> parameter is true) or message sequence numbers.
|
||||
|
||||
The B<new> method will return a reference to a B<Mail::IMAPClient::MessageSet>
|
||||
object. That object, when double quoted, will act just like a string whose
|
||||
value is the message set expressed in the shortest possible way, with the
|
||||
message numbers sorted in ascending order and with duplicates removed.
|
||||
|
||||
=head1 OBJECT METHODS
|
||||
|
||||
The only object method currently available to a B<Mail::IMAPClient::MessageSet>
|
||||
object is the L<unfold> method.
|
||||
|
||||
=head2 unfold
|
||||
|
||||
Example:
|
||||
|
||||
my $msgset = $imap->Range( $imap->messages ) ;
|
||||
my @all_messages = $msgset->unfold;
|
||||
|
||||
The B<unfold> method returns an array of messages that belong to the
|
||||
message set. If called in a scalar context it returns a reference to the
|
||||
array instead.
|
||||
|
||||
=head1 OVERRIDDEN OPERATIONS
|
||||
|
||||
B<Mail::IMAPClient::MessageSet> overrides a number of operators in order
|
||||
to make manipulating your message sets easier. The overridden operations are:
|
||||
|
||||
=head2 stringify
|
||||
|
||||
Attempts to stringify a B<Mail::IMAPClient::MessageSet> object will result in
|
||||
the compact message specification being returned, which is almost certainly
|
||||
what you will want.
|
||||
|
||||
=head2 Auto-increment
|
||||
|
||||
Attempts to autoincrement a B<Mail::IMAPClient::MessageSet> object will
|
||||
result in a message (or messages) being added to the object's message set.
|
||||
|
||||
Example:
|
||||
|
||||
$msgset += 34;
|
||||
# Message #34 is now in the message set
|
||||
|
||||
=head2 Concatenate
|
||||
|
||||
Attempts to concatenate to a B<Mail::IMAPClient::MessageSet> object will
|
||||
result in a message (or messages) being added to the object's message set.
|
||||
|
||||
Example:
|
||||
|
||||
$msgset .= "34,35,36,40:45";
|
||||
# Messages 34,35,36,40,41,42,43,44,and 45 are now in the message set
|
||||
|
||||
The C<.=> operator and the C<+=> operator can be used interchangeably, but
|
||||
as you can see by looking at the examples there are times when use of one
|
||||
has an aesthetic advantage over use of the other.
|
||||
|
||||
=head2 Autodecrement
|
||||
|
||||
Attempts to autodecrement a B<Mail::IMAPClient::MessageSet> object will
|
||||
result in a message being removed from the object's message set.
|
||||
|
||||
Examples:
|
||||
|
||||
$msgset -= 34;
|
||||
# Message #34 is no longer in the message set
|
||||
$msgset -= "1:10";
|
||||
# Messages 1 through 10 are no longer in the message set
|
||||
|
||||
If you attempt to remove a message that was not in the original message set
|
||||
then your resulting message set will be the same as the original, only more
|
||||
expensive. However, if you attempt to remove several messages from the message
|
||||
set and some of those messages were in the message set and some were not,
|
||||
the additional overhead of checking for the messages that were not there
|
||||
is negligable. In either case you get back the message set you want regardless
|
||||
of whether it was already like that or not.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
David J. Kernen
|
||||
The Kernen Consulting Group, Inc
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright 1999, 2000, 2001, 2002 The Kernen Group, Inc.
|
||||
All rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify it
|
||||
under the terms of either:
|
||||
|
||||
=over 4
|
||||
|
||||
=item a) the "Artistic License" which comes with this Kit, or
|
||||
|
||||
=item b) the GNU General Public License as published by the Free Software
|
||||
Foundation; either version 1, or (at your option) any later version.
|
||||
|
||||
=back
|
||||
|
||||
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 either the GNU
|
||||
General Public License or the Artistic License for more details. All your
|
||||
base are belong to us.
|
||||
|
||||
=cut
|
||||
|
||||
1;
|
||||
18
Mail-IMAPClient-3.27/lib/Mail/IMAPClient/Thread.grammar
Normal file
18
Mail-IMAPClient-3.27/lib/Mail/IMAPClient/Thread.grammar
Normal file
|
|
@ -0,0 +1,18 @@
|
|||
# Atoms:
|
||||
|
||||
NUMBER: /\d+/
|
||||
|
||||
# Rules:
|
||||
|
||||
threadmember: NUMBER { $return = $item{NUMBER} ; } |
|
||||
thread { $return = $item{thread} ; }
|
||||
|
||||
thread: "(" threadmember(s) ")"
|
||||
{
|
||||
$return = $item{'threadmember(s)'}||undef;
|
||||
}
|
||||
|
||||
# Start:
|
||||
start: /^\* THREAD /i thread(s?) {
|
||||
$return=$item{'thread(s?)'}||undef;
|
||||
}
|
||||
1024
Mail-IMAPClient-3.27/lib/Mail/IMAPClient/Thread.pm
Normal file
1024
Mail-IMAPClient-3.27/lib/Mail/IMAPClient/Thread.pm
Normal file
File diff suppressed because it is too large
Load diff
14
Mail-IMAPClient-3.27/lib/Mail/IMAPClient/Thread.pod
Normal file
14
Mail-IMAPClient-3.27/lib/Mail/IMAPClient/Thread.pod
Normal file
|
|
@ -0,0 +1,14 @@
|
|||
=head1 NAME
|
||||
|
||||
Mail::IMAPClient::Thread - used internally by Mail::IMAPClient->thread
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module is used internally by L<Mail::IMAPClient> and is
|
||||
generated using L<Parse::RecDescent>. It is not meant to be used directly by
|
||||
other scripts nor is there much point in debugging it.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This module is used internally by L<Mail::IMAPClient> and is not meant to
|
||||
be used or called directly from applications. So don't do that.
|
||||
43
Mail-IMAPClient-3.27/prepare_dist
Executable file
43
Mail-IMAPClient-3.27/prepare_dist
Executable file
|
|
@ -0,0 +1,43 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use File::Copy qw/move/;
|
||||
use Parse::RecDescent 1.94;
|
||||
|
||||
sub read_file {
|
||||
my $file = shift;
|
||||
local ( $/, *FH );
|
||||
open( FH, $file ) or return undef;
|
||||
return <FH>;
|
||||
}
|
||||
|
||||
build_parser(
|
||||
'lib/Mail/IMAPClient/BodyStructure/Parse.grammar',
|
||||
'Mail::IMAPClient::BodyStructure::Parse'
|
||||
);
|
||||
|
||||
build_parser( 'lib/Mail/IMAPClient/Thread.grammar',
|
||||
'Mail::IMAPClient::Thread' );
|
||||
|
||||
sub build_parser {
|
||||
my ( $grammarfn, $package ) = @_;
|
||||
|
||||
print("* building $package\n");
|
||||
|
||||
my $grammar = read_file($grammarfn)
|
||||
or die("cannot read grammar from $grammarfn: $!\n");
|
||||
|
||||
Parse::RecDescent->Precompile( $grammar, $package );
|
||||
|
||||
# clumpsy output by Parse::RecDescent
|
||||
my $outfn = $package . '.pm';
|
||||
$outfn =~ s/.*\:\://;
|
||||
|
||||
my $realfn = $grammarfn;
|
||||
$realfn =~ s/\.\w+$/.pm/;
|
||||
|
||||
move( $outfn, $realfn )
|
||||
or die("cannot move $outfn to $realfn: $!\n");
|
||||
}
|
||||
431
Mail-IMAPClient-3.27/t/basic.t
Normal file
431
Mail-IMAPClient-3.27/t/basic.t
Normal file
|
|
@ -0,0 +1,431 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use IO::File qw();
|
||||
use Test::More;
|
||||
use File::Temp qw(tempfile);
|
||||
|
||||
my $debug = $ARGV[0];
|
||||
|
||||
my %parms;
|
||||
my $range = 0;
|
||||
my $uidplus = 0;
|
||||
my $fast = 1;
|
||||
|
||||
BEGIN {
|
||||
open TST, 'test.txt'
|
||||
or plan skip_all => 'test parameters not provided in test.txt';
|
||||
|
||||
while ( my $l = <TST> ) {
|
||||
chomp $l;
|
||||
my ( $p, $v ) = split /\=/, $l, 2;
|
||||
s/^\s+//, s/\s+$// for $p, $v;
|
||||
$parms{$p} = $v if $v;
|
||||
}
|
||||
|
||||
close TST;
|
||||
|
||||
my @missing;
|
||||
foreach my $p (qw/server user passed/) {
|
||||
push( @missing, $p ) unless defined $parms{$p};
|
||||
}
|
||||
|
||||
@missing
|
||||
? plan skip_all => "missing value for: @missing"
|
||||
: plan tests => 85;
|
||||
}
|
||||
|
||||
BEGIN { use_ok('Mail::IMAPClient') or exit; }
|
||||
|
||||
my %new_args = (
|
||||
Server => delete $parms{server},
|
||||
Port => delete $parms{port},
|
||||
User => delete $parms{user},
|
||||
Password => delete $parms{passed},
|
||||
Authmechanism => delete $parms{authmech},
|
||||
Clear => 0,
|
||||
Fast_IO => $fast,
|
||||
Uid => $uidplus,
|
||||
Debug => $debug,
|
||||
);
|
||||
|
||||
# allow other options to be placed in test.txt
|
||||
%new_args = ( %new_args, %parms );
|
||||
|
||||
my $imap = Mail::IMAPClient->new(
|
||||
%new_args,
|
||||
Range => $range,
|
||||
Debug_fh => ( $debug ? IO::File->new( 'imap1.debug', 'w' ) : undef )
|
||||
);
|
||||
|
||||
ok( defined $imap, 'created client' );
|
||||
$imap
|
||||
or die "Cannot log into $new_args{Server} as $new_args{User}.\n"
|
||||
. "Are server/user/password correct?\n";
|
||||
|
||||
isa_ok( $imap, 'Mail::IMAPClient' );
|
||||
|
||||
$imap->Debug_fh->autoflush() if $imap->Debug_fh;
|
||||
|
||||
my $testmsg = <<__TEST_MSG;
|
||||
Date: @{[$imap->Rfc822_date(time)]}
|
||||
To: <$new_args{User}\@$new_args{Server}>
|
||||
From: Perl <$new_args{User}\@$new_args{Server}>
|
||||
Subject: Testing from pid $$
|
||||
|
||||
This is a test message generated by $0 during a 'make test' as part of
|
||||
the installation of the Mail::IMAPClient module from CPAN.
|
||||
__TEST_MSG
|
||||
|
||||
ok( $imap->noop, "noop" );
|
||||
ok( $imap->tag_and_run("NOOP\r\n"), "tag_and_run" );
|
||||
|
||||
my $sep = $imap->separator;
|
||||
ok( defined $sep, "separator is '$sep'" );
|
||||
|
||||
{
|
||||
my $list = $imap->list();
|
||||
is( ref($list), "ARRAY", "list" );
|
||||
|
||||
my $lsub = $imap->lsub();
|
||||
is( ref($lsub), "ARRAY", "lsub" );
|
||||
}
|
||||
|
||||
my $ispar = $imap->is_parent('INBOX');
|
||||
my ( $target, $target2 ) =
|
||||
$ispar
|
||||
? ( "INBOX${sep}IMAPClient_$$", "INBOX${sep}IMAPClient_2_$$" )
|
||||
: ( "IMAPClient_$$", "IMAPClient_2_$$" );
|
||||
|
||||
ok( defined $ispar, "INBOX is_parent '$ispar' (note: target '$target')" );
|
||||
|
||||
ok( $imap->select('inbox'), "select inbox" );
|
||||
|
||||
# test append_file
|
||||
my $append_file_size;
|
||||
{
|
||||
my ( $afh, $afn ) = tempfile UNLINK => 1;
|
||||
|
||||
# write message to autoflushed file handle since we keep $afh around
|
||||
my $oldfh = select($afh);
|
||||
$| = 1;
|
||||
select($oldfh);
|
||||
print( $afh $testmsg ) or die("print testmsg failed");
|
||||
cmp_ok( -s $afn, '>', 0, "tempfile has size" );
|
||||
|
||||
ok( $imap->create($target), "create target" );
|
||||
|
||||
my $uid = $imap->append_file( $target, $afn );
|
||||
ok( defined $uid, "append_file test message to $target" );
|
||||
|
||||
ok( $imap->select($target), "select $target" );
|
||||
|
||||
my $msg = ( $uidplus and $uid ) ? $uid : ( $imap->messages )[0];
|
||||
my $size = $imap->size($msg);
|
||||
|
||||
cmp_ok( $size, '>', 0, "has size $size" );
|
||||
|
||||
my $string = $imap->message_string($msg);
|
||||
ok( defined $string, "returned string" );
|
||||
|
||||
cmp_ok( length($string), '==', $size, "string matches server size" );
|
||||
ok( $imap->delete($target), "delete folder $target" );
|
||||
|
||||
$append_file_size = $size;
|
||||
}
|
||||
|
||||
ok( $imap->create($target), "create target" );
|
||||
ok( $imap->select($target), "select $target" );
|
||||
|
||||
# Test append / append_string if we also have UID capability
|
||||
SKIP: {
|
||||
skip "UIDPLUS not supported", 3 unless $imap->has_capability("UIDPLUS");
|
||||
|
||||
my $ouid = $imap->Uid();
|
||||
$imap->Uid(1);
|
||||
|
||||
# test with date that has a leading space
|
||||
my $d = " 1-Jan-2011 01:02:03 -0500";
|
||||
my $uid = $imap->append_string( $target, $testmsg, undef, $d );
|
||||
ok( defined $uid, "append test message to $target with date (uid=$uid)" );
|
||||
ok( $imap->delete_message($uid), "delete_message $uid" );
|
||||
ok( $imap->uidexpunge($uid), "uidexpunge $uid" );
|
||||
|
||||
# multiple args joined internally in append()
|
||||
$uid = $imap->append( $target, $testmsg, "Some extra text too" );
|
||||
ok( defined $uid, "append test message to $target with date (uid=$uid)" );
|
||||
ok( $imap->delete_message($uid), "delete_message $uid" );
|
||||
ok( $imap->uidexpunge($uid), "uidexpunge $uid" );
|
||||
|
||||
$imap->Uid($ouid);
|
||||
}
|
||||
|
||||
# test append
|
||||
{
|
||||
my $uid = $imap->append( $target, $testmsg );
|
||||
ok( defined $uid, "append test message to $target" );
|
||||
|
||||
my $msg = ( $uidplus and $uid ) ? $uid : ( $imap->messages )[0];
|
||||
my $size = $imap->size($msg);
|
||||
|
||||
cmp_ok( $size, '>', 0, "has size $size" );
|
||||
|
||||
my $string = $imap->message_string($msg);
|
||||
ok( defined $string, "returned string" );
|
||||
|
||||
cmp_ok( length($string), '==', $size, "string == server size" );
|
||||
|
||||
{
|
||||
my $var;
|
||||
ok( $imap->message_to_file( \$var, $msg ), "to SCALAR ref" );
|
||||
cmp_ok( length($var), '==', $size, "correct size" );
|
||||
|
||||
my ( $fh, $fn ) = tempfile UNLINK => 1;
|
||||
ok( $imap->message_to_file( $fn, $msg ), "to file $fn" );
|
||||
|
||||
cmp_ok( -s $fn, '==', $size, "correct size" );
|
||||
}
|
||||
|
||||
cmp_ok( $size, '==', $append_file_size, "size matches string/file" );
|
||||
|
||||
# save first message/folder for use below...
|
||||
#OFF ok( $imap->delete($target), "delete folder $target" );
|
||||
}
|
||||
|
||||
#OFF ok( $imap->create($target), "create target" );
|
||||
ok( $imap->exists($target), "exists $target" );
|
||||
ok( $imap->create($target2), "create $target2" );
|
||||
ok( $imap->exists($target2), "exists $target2" );
|
||||
|
||||
{
|
||||
ok( $imap->subscribe($target), "subscribe target" );
|
||||
|
||||
my $sub1 = $imap->subscribed();
|
||||
is( ( grep( /^\Q$target\E$/, @$sub1 ) )[0], "$target", "subscribed" );
|
||||
|
||||
ok( $imap->unsubscribe($target), "unsubscribe target" );
|
||||
|
||||
my $sub2 = $imap->subscribed();
|
||||
is( ( grep( /^\Q$target\E$/, @$sub2 ) )[0], undef, "unsubscribed" );
|
||||
}
|
||||
|
||||
ok( $imap->select($target), "select $target" );
|
||||
|
||||
my $fwquotes = qq($target${sep}has "quotes");
|
||||
if ( !$imap->is_parent($target) ) {
|
||||
ok( 1, "not parent, skipping quote test 1/3" );
|
||||
ok( 1, "not parent, skipping quote test 2/3" );
|
||||
ok( 1, "not parent, skipping quote test 3/3" );
|
||||
}
|
||||
elsif ( $imap->create($fwquotes) ) {
|
||||
ok( 1, "create $fwquotes" );
|
||||
ok( $imap->select($fwquotes), 'select $fwquotes' );
|
||||
ok( $imap->close, 'close $fwquotes' );
|
||||
$imap->select('inbox');
|
||||
ok( $imap->delete($fwquotes), 'delete $fwquotes' );
|
||||
}
|
||||
else {
|
||||
if ( $imap->LastError =~ /NO Invalid.*name/ ) {
|
||||
ok( 1, "$new_args{Server} doesn't support quotes in folder names" );
|
||||
}
|
||||
else { ok( 0, "failed creation with quotes" ) }
|
||||
ok( 1, "skipping 1/2 tests" );
|
||||
ok( 1, "skipping 2/2 tests" );
|
||||
}
|
||||
|
||||
my $fields = $imap->search( "HEADER", "Message-id", "NOT_A_MESSAGE_ID" );
|
||||
is( scalar @$fields, 0, 'bogus message id does not exist' );
|
||||
|
||||
my @seen = $imap->seen;
|
||||
cmp_ok( scalar @seen, '==', 1, 'have seen 1' );
|
||||
|
||||
ok( $imap->deny_seeing( \@seen ), 'deny seeing' );
|
||||
my @unseen = $imap->unseen;
|
||||
cmp_ok( scalar @unseen, '==', 1, 'have unseen 1' );
|
||||
|
||||
ok( $imap->see( \@seen ), "let's see one" );
|
||||
cmp_ok( scalar @seen, '==', 1, 'have seen 1' );
|
||||
|
||||
$imap->deny_seeing(@seen); # reset
|
||||
|
||||
$imap->Peek(1);
|
||||
my $subject = $imap->parse_headers( $seen[0], "Subject" )->{Subject}[0];
|
||||
unlike( join( "", $imap->flags( $seen[0] ) ), qr/\\Seen/i, 'Peek==1' );
|
||||
|
||||
$imap->deny_seeing(@seen);
|
||||
$imap->Peek(0);
|
||||
$subject = $imap->parse_headers( $seen[0], "Subject" )->{Subject}[0];
|
||||
like( join( "", $imap->flags( $seen[0] ) ), qr/\\Seen/i, 'Peek==0' );
|
||||
|
||||
$imap->deny_seeing(@seen);
|
||||
$imap->Peek(undef);
|
||||
$subject = $imap->parse_headers( $seen[0], "Subject" )->{Subject}[0];
|
||||
unlike( join( "", $imap->flags( $seen[0] ) ), qr/\\Seen/i, 'Peek==undef' );
|
||||
|
||||
my $uid2 = $imap->copy( $target2, 1 );
|
||||
ok( $uid2, "copy $target2" );
|
||||
|
||||
my @res = $imap->fetch( 1, "RFC822.TEXT" );
|
||||
ok( scalar @res, "fetch rfc822" );
|
||||
|
||||
my $res1 = $imap->fetch_hash("RFC822.SIZE");
|
||||
is( ref($res1), "HASH", "fetch_hash(RFC822.SIZE)" );
|
||||
|
||||
my $res2 = $imap->fetch_hash( 1, "RFC822.SIZE" );
|
||||
is( ref($res2), "HASH", "fetch_hash(1,RFC822.SIZE)" );
|
||||
|
||||
my $h = $imap->parse_headers( 1, "Subject" );
|
||||
ok( $h, "got subject" );
|
||||
like( $h->{Subject}[0], qr/^Testing from pid/, "subject matched" );
|
||||
|
||||
ok( $imap->select($target), "select $target" );
|
||||
my @hits = $imap->search( SUBJECT => 'Testing' );
|
||||
cmp_ok( scalar @hits, '==', 1, 'hit subject Testing' );
|
||||
ok( defined $hits[0], "subject is defined" );
|
||||
|
||||
ok( $imap->delete_message(@hits), 'delete hits' );
|
||||
my $flaghash = $imap->flags( \@hits );
|
||||
my $flagflag = 0;
|
||||
foreach my $v ( values %$flaghash ) {
|
||||
$flagflag += grep /\\Deleted/, @$v;
|
||||
}
|
||||
cmp_ok( $flagflag, '==', scalar @hits, "delete verified" );
|
||||
|
||||
my @nohits = $imap->search( \qq(SUBJECT "Productioning") );
|
||||
cmp_ok( scalar @nohits, '==', 0, 'no hits expected' );
|
||||
|
||||
ok( $imap->restore_message(@hits), 'restore messages' );
|
||||
|
||||
$flaghash = $imap->flags( \@hits );
|
||||
foreach my $v ( values %$flaghash ) {
|
||||
$flagflag-- unless grep /\\Deleted/, @$v;
|
||||
}
|
||||
cmp_ok( $flagflag, '==', 0, "restore verified" );
|
||||
|
||||
$imap->select($target2);
|
||||
ok(
|
||||
$imap->delete_message( scalar( $imap->search("ALL") ) )
|
||||
&& $imap->close
|
||||
&& $imap->delete($target2),
|
||||
"delete $target2"
|
||||
);
|
||||
|
||||
$imap->select("INBOX");
|
||||
$@ = undef;
|
||||
@hits =
|
||||
$imap->search( BEFORE => Mail::IMAPClient::Rfc2060_date(time), "UNDELETED" );
|
||||
ok( !$@, "search undeleted" ) or diag( '$@:' . $@ );
|
||||
|
||||
#
|
||||
# Test migrate method
|
||||
#
|
||||
|
||||
my $im2 = Mail::IMAPClient->new(
|
||||
%new_args,
|
||||
Timeout => 30,
|
||||
Debug_fh => ( $debug ? IO::File->new(">./imap2.debug") : undef ),
|
||||
);
|
||||
ok( defined $im2, 'started second imap client' );
|
||||
|
||||
my $source = $target;
|
||||
$imap->select($source)
|
||||
or die "cannot select source $source: $@";
|
||||
|
||||
$imap->append( $source, $testmsg ) for 1 .. 5;
|
||||
$imap->close;
|
||||
$imap->select($source);
|
||||
|
||||
my $migtarget = $target . '_mirror';
|
||||
|
||||
$im2->create($migtarget)
|
||||
or die "can't create $migtarget: $@";
|
||||
|
||||
$im2->select($migtarget)
|
||||
or die "can't select $migtarget: $@";
|
||||
|
||||
$imap->migrate( $im2, scalar( $imap->search("ALL") ), $migtarget )
|
||||
or die "couldn't migrate: $@";
|
||||
|
||||
$im2->close;
|
||||
$im2->select($migtarget)
|
||||
or die "can't select $migtarget: $@";
|
||||
|
||||
ok( !$@, "LastError not set" ) or diag( '$@:' . $@ );
|
||||
|
||||
#
|
||||
my $total_bytes1 = 0;
|
||||
for ( $imap->search("ALL") ) {
|
||||
my $s = $imap->size($_);
|
||||
$total_bytes1 += $s;
|
||||
print "Size of msg $_ is $s\n" if $debug;
|
||||
}
|
||||
|
||||
my $total_bytes2 = 0;
|
||||
for ( $im2->search("ALL") ) {
|
||||
my $s = $im2->size($_);
|
||||
$total_bytes2 += $s;
|
||||
print "Size of msg $_ is $s\n" if $debug;
|
||||
}
|
||||
|
||||
ok( !$@, "LastError not set" ) or diag( '$@:' . $@ );
|
||||
cmp_ok( $total_bytes1, '==', $total_bytes2, 'size source==target' );
|
||||
|
||||
# cleanup
|
||||
$im2->select($migtarget);
|
||||
$im2->delete_message( @{ $im2->messages } )
|
||||
if $im2->message_count;
|
||||
|
||||
ok( $im2->close, "close" );
|
||||
$im2->delete($migtarget);
|
||||
|
||||
ok_relaxed_logout($im2);
|
||||
|
||||
# Test IDLE
|
||||
SKIP: {
|
||||
skip "IDLE not supported", 4 unless $imap->has_capability("IDLE");
|
||||
ok( my $idle = $imap->idle, "idle" );
|
||||
sleep 1;
|
||||
ok( $imap->idle_data, "idle_data" );
|
||||
ok( $imap->done($idle), "done" );
|
||||
ok( !$@, "LastError not set" ) or diag( '$@:' . $@ );
|
||||
}
|
||||
|
||||
$imap->select('inbox');
|
||||
if ( $imap->rename( $target, "${target}NEW" ) ) {
|
||||
ok( 1, 'rename' );
|
||||
$imap->close;
|
||||
$imap->select("${target}NEW");
|
||||
$imap->delete_message( @{ $imap->messages } ) if $imap->message_count;
|
||||
$imap->close;
|
||||
$imap->delete("${target}NEW");
|
||||
}
|
||||
else {
|
||||
ok( 0, 'rename failed' );
|
||||
$imap->delete_message( @{ $imap->messages } )
|
||||
if $imap->message_count;
|
||||
$imap->close;
|
||||
$imap->delete($target);
|
||||
}
|
||||
|
||||
$imap->_disconnect;
|
||||
ok( $imap->reconnect, "reconnect" );
|
||||
|
||||
ok_relaxed_logout($imap);
|
||||
|
||||
# Test STARTTLS - an optional feature so tests always succeed
|
||||
{
|
||||
$imap->connect( Starttls => 1 );
|
||||
ok( 1, "OPTIONAL connect(Starttls=>1)" . ( $@ ? ": (error) $@ " : "" ) );
|
||||
}
|
||||
|
||||
# LOGOUT
|
||||
# - on successful LOGOUT $code is OK (not BYE!) see RFC 3501 sect 7.1.5
|
||||
# however some servers return BYE instead so we let that pass here...
|
||||
sub ok_relaxed_logout {
|
||||
my $imap = shift;
|
||||
local ($@);
|
||||
my $rc = $imap->logout;
|
||||
my $err = $imap->LastError || "";
|
||||
ok( ( $rc or $err =~ /^\* BYE/ ), "logout" . ( $err ? ": $err" : "" ) );
|
||||
}
|
||||
76
Mail-IMAPClient-3.27/t/body_string.t
Normal file
76
Mail-IMAPClient-3.27/t/body_string.t
Normal file
|
|
@ -0,0 +1,76 @@
|
|||
#!/usr/bin/perl
|
||||
#
|
||||
# tests for body_string()
|
||||
#
|
||||
# body_string() calls fetch() internally. rather than refactor
|
||||
# body_string() just for testing, we subclass M::IC and use the
|
||||
# overidden fetch() to feed it test data.
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use IO::Socket qw(:crlf);
|
||||
use Test::More tests => 3;
|
||||
|
||||
BEGIN { use_ok('Mail::IMAPClient') or exit; }
|
||||
|
||||
my @tests = (
|
||||
[
|
||||
"simple fetch",
|
||||
[
|
||||
'12 FETCH 1 BODY[TEXT]',
|
||||
'* 1 FETCH (FLAGS (\\Seen \\Recent) BODY[TEXT]',
|
||||
"This is a test message$CRLF" . "Line Z (last line)$CRLF",
|
||||
")$CRLF",
|
||||
"12 OK Fetch completed.$CRLF",
|
||||
],
|
||||
[ 1 ],
|
||||
"This is a test message$CRLF" . "Line Z (last line)$CRLF",
|
||||
],
|
||||
|
||||
# 2010-05-27: test for bug reported by Heiko Schlittermann
|
||||
[
|
||||
"uwimap IMAP4rev1 2007b.404 fetch unseen",
|
||||
[
|
||||
'4 FETCH 1 BODY[TEXT]',
|
||||
'* 1 FETCH (BODY[TEXT]',
|
||||
"This is a test message$CRLF" . "Line Z (last line)$CRLF",
|
||||
")$CRLF",
|
||||
"* 1 FETCH (FLAGS (\\Recent \\Seen)$CRLF",
|
||||
"4 OK Fetch completed$CRLF",
|
||||
],
|
||||
[ 1 ],
|
||||
"This is a test message$CRLF" . "Line Z (last line)$CRLF",
|
||||
],
|
||||
);
|
||||
|
||||
package Test::Mail::IMAPClient;
|
||||
|
||||
use base qw(Mail::IMAPClient);
|
||||
|
||||
sub new {
|
||||
my ( $class, %args ) = @_;
|
||||
my %me = %args;
|
||||
return bless \%me, $class;
|
||||
}
|
||||
|
||||
sub fetch {
|
||||
my ( $self, @args ) = @_;
|
||||
return $self->{_next_fetch_response} || [];
|
||||
}
|
||||
|
||||
package main;
|
||||
|
||||
sub run_tests {
|
||||
my ( $imap, $tests ) = @_;
|
||||
|
||||
for my $test (@$tests) {
|
||||
my ( $comment, $fetch, $request, $response ) = @$test;
|
||||
$imap->{_next_fetch_response} = $fetch;
|
||||
my $r = $imap->body_string(@$request);
|
||||
is_deeply( $r, $response, $comment );
|
||||
}
|
||||
}
|
||||
|
||||
my $imap = Test::Mail::IMAPClient->new( Uid => 0, Debug => 0 );
|
||||
|
||||
run_tests( $imap, \@tests );
|
||||
117
Mail-IMAPClient-3.27/t/bodystructure.t
Normal file
117
Mail-IMAPClient-3.27/t/bodystructure.t
Normal file
File diff suppressed because one or more lines are too long
250
Mail-IMAPClient-3.27/t/fetch_hash.t
Normal file
250
Mail-IMAPClient-3.27/t/fetch_hash.t
Normal file
|
|
@ -0,0 +1,250 @@
|
|||
#!/usr/bin/perl
|
||||
#
|
||||
#
|
||||
# tests for fetch_hash()
|
||||
#
|
||||
# fetch_hash() calls fetch() internally. rather than refactor
|
||||
# fetch_hash() just for testing, we instead subclass M::IC and use the
|
||||
# overidden fetch() to feed it test data.
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 19;
|
||||
|
||||
BEGIN { use_ok('Mail::IMAPClient') or exit; }
|
||||
|
||||
my @tests = (
|
||||
[
|
||||
"unquoted value",
|
||||
[ q{* 1 FETCH (UNQUOTED foobar)}, ],
|
||||
[ [1], qw(UNQUOTED) ],
|
||||
{ "1" => { "UNQUOTED" => q{foobar}, } },
|
||||
],
|
||||
[
|
||||
"quoted value",
|
||||
[ q{* 1 FETCH (QUOTED "foo bar baz")}, ],
|
||||
[ [1], qw(QUOTED) ],
|
||||
{ "1" => { "QUOTED" => q{foo bar baz}, }, },
|
||||
],
|
||||
[
|
||||
"parenthesized value",
|
||||
[ q{* 1 FETCH (PARENS (foo bar))}, ],
|
||||
[ [1], qw(PARENS) ],
|
||||
{ "1" => { "PARENS" => q{foo bar}, }, },
|
||||
],
|
||||
[
|
||||
"parenthesized value with quotes",
|
||||
[ q{* 1 FETCH (PARENS (foo "bar" baz))}, ],
|
||||
[ [1], qw(PARENS) ],
|
||||
{ "1" => { "PARENS" => q{foo "bar" baz}, }, },
|
||||
],
|
||||
[
|
||||
"parenthesized value with parens at start",
|
||||
[ q{* 1 FETCH (PARENS ((foo) bar baz))}, ],
|
||||
[ [1], qw(PARENS) ],
|
||||
{ "1" => { "PARENS" => q{(foo) bar baz}, }, },
|
||||
],
|
||||
[
|
||||
"parenthesized value with parens in middle",
|
||||
[ q{* 1 FETCH (PARENS (foo (bar) baz))}, ],
|
||||
[ [1], qw(PARENS) ],
|
||||
{ "1" => { "PARENS" => q{foo (bar) baz}, }, },
|
||||
],
|
||||
[
|
||||
"parenthesized value with parens at end",
|
||||
[ q{* 1 FETCH (PARENS (foo bar (baz)))}, ],
|
||||
[ [1], qw(PARENS) ],
|
||||
{ "1" => { "PARENS" => q{foo bar (baz)}, }, },
|
||||
],
|
||||
[
|
||||
"complex parens",
|
||||
[ q{* 1 FETCH (PARENS ((((foo) "bar") baz (quux))))}, ],
|
||||
[ [1], qw(PARENS) ],
|
||||
{ "1" => { "PARENS" => q{(((foo) "bar") baz (quux))}, }, },
|
||||
],
|
||||
[
|
||||
"basic literal value",
|
||||
[ q{* 1 FETCH (LITERAL}, q{foo}, q{)}, ],
|
||||
[ [1], qw(LITERAL) ],
|
||||
{ "1" => { "LITERAL" => q{foo}, }, },
|
||||
],
|
||||
[
|
||||
"multiline literal value",
|
||||
[ q{* 1 FETCH (LITERAL}, q{foo\r\nbar\r\nbaz\r\n}, q{)}, ],
|
||||
[ [1], qw(LITERAL) ],
|
||||
{ "1" => { "LITERAL" => q{foo\r\nbar\r\nbaz\r\n}, }, },
|
||||
],
|
||||
[
|
||||
"multiple attributes",
|
||||
[ q{* 1 FETCH (FOO foo BAR bar BAZ baz)}, ],
|
||||
[ [1], qw(FOO BAR BAZ) ],
|
||||
{
|
||||
"1" => {
|
||||
"FOO" => q{foo},
|
||||
"BAR" => q{bar},
|
||||
"BAZ" => q{baz},
|
||||
},
|
||||
},
|
||||
],
|
||||
[
|
||||
"dotted attribute",
|
||||
[ q{* 1 FETCH (FOO.BAR foobar)}, ],
|
||||
[ [1], qw(FOO.BAR) ],
|
||||
{ "1" => { "FOO.BAR" => q{foobar}, }, },
|
||||
],
|
||||
[
|
||||
"complex attribute",
|
||||
[ q{* 1 FETCH (FOO.BAR[BAZ (QUUX)] quuz)}, ],
|
||||
[ [1], q{FOO.BAR[BAZ (QUUX)]} ],
|
||||
{ "1" => { q{FOO.BAR[BAZ (QUUX)]} => q{quuz}, }, },
|
||||
],
|
||||
[
|
||||
"BODY.PEEK[] requests match BODY[] responses",
|
||||
[ q{* 1 FETCH (BODY[] foo)} ],
|
||||
[ [1], qw(BODY.PEEK[]) ],
|
||||
{ "1" => { "BODY[]" => q{foo}, }, },
|
||||
],
|
||||
[
|
||||
"BODY.PEEK[] requests match BODY.PEEK[] responses also",
|
||||
[ q{* 1 FETCH (BODY.PEEK[] foo)} ],
|
||||
[ [1], qw(BODY.PEEK[]) ],
|
||||
{ "1" => { "BODY.PEEK[]" => q{foo}, }, },
|
||||
],
|
||||
[
|
||||
"escaped subject",
|
||||
[ q{* 1 FETCH (UID 1 X-SAVEDATE "28-Jan-2011 16:52:31 -0500" FLAGS (\Seen) ENVELOPE ("Fri, 28 Jan 2011 00:03:30 -0500" "foo \\"bar\\" baz\'s" (("Phil Pearl" NIL "phil" "dom.loc")) (("Phil Pearl" NIL "phil" "dom.loc")) (("Phil Pearl" NIL "phil" "dom.loc")) ((NIL NIL "phil" "dom.loc")) NIL NIL NIL "<msgid>")) } ],
|
||||
[ [1], qw(UID X-SAVEDATE FLAGS ENVELOPE) ],
|
||||
{
|
||||
"1" => {
|
||||
'X-SAVEDATE' => '28-Jan-2011 16:52:31 -0500',
|
||||
'UID' => '1',
|
||||
'FLAGS' => '\\Seen',
|
||||
'ENVELOPE' => q{"Fri, 28 Jan 2011 00:03:30 -0500" "foo \\"bar\\" baz\'s" (("Phil Pearl" NIL "phil" "dom.loc")) (("Phil Pearl" NIL "phil" "dom.loc")) (("Phil Pearl" NIL "phil" "dom.loc")) ((NIL NIL "phil" "dom.loc")) NIL NIL NIL "<msgid>"}
|
||||
},
|
||||
},
|
||||
],
|
||||
[
|
||||
"real life example",
|
||||
[
|
||||
'* 1 FETCH (UID 541 FLAGS (\\Seen) INTERNALDATE "15-Sep-2009 20:05:45 +1000" RFC822.SIZE 771 BODY[HEADER.FIELDS (TO FROM DATE SUBJECT)]',
|
||||
'Date: Tue, 15 Sep 2009 20:05:45 +1000
|
||||
To: rob@pyro
|
||||
From: rob@pyro
|
||||
Subject: test Tue, 15 Sep 2009 20:05:45 +1000
|
||||
|
||||
',
|
||||
' BODY[]',
|
||||
'Return-Path: <rob@pyro>
|
||||
X-Spam-Checker-Version: SpamAssassin 3.2.5 (2008-06-10) on pyro.home
|
||||
X-Spam-Level:
|
||||
X-Spam-Status: No, score=-0.5 required=5.0 tests=ALL_TRUSTED,BAYES_00,
|
||||
FH_FROMEML_NOTLD,TO_MALFORMED autolearn=no version=3.2.5
|
||||
X-Original-To: rob@pyro
|
||||
Delivered-To: rob@pyro
|
||||
Received: from pyro (pyro [127.0.0.1])
|
||||
by pyro.home (Postfix) with ESMTP id A5C8115A066
|
||||
for <rob@pyro>; Tue, 15 Sep 2009 20:05:45 +1000 (EST)
|
||||
Date: Tue, 15 Sep 2009 20:05:45 +1000
|
||||
To: rob@pyro
|
||||
From: rob@pyro
|
||||
Subject: test Tue, 15 Sep 2009 20:05:45 +1000
|
||||
X-Mailer: swaks v20061116.0 jetmore.org/john/code/#swaks
|
||||
Message-Id: <20090915100545.A5C8115A066@pyro.home>
|
||||
X-Bogosity: Spam, tests=bogofilter, spamicity=0.999693, version=1.2.1
|
||||
Lines: 1
|
||||
|
||||
This is a test mailing
|
||||
',
|
||||
')
|
||||
',
|
||||
],
|
||||
[
|
||||
[1],
|
||||
q{BODY.PEEK[HEADER.FIELDS (To From Date Subject)]},
|
||||
qw(FLAGS INTERNALDATE RFC822.SIZE BODY[])
|
||||
],
|
||||
{
|
||||
"1" => {
|
||||
'BODY[]' => 'Return-Path: <rob@pyro>
|
||||
X-Spam-Checker-Version: SpamAssassin 3.2.5 (2008-06-10) on pyro.home
|
||||
X-Spam-Level:
|
||||
X-Spam-Status: No, score=-0.5 required=5.0 tests=ALL_TRUSTED,BAYES_00,
|
||||
FH_FROMEML_NOTLD,TO_MALFORMED autolearn=no version=3.2.5
|
||||
X-Original-To: rob@pyro
|
||||
Delivered-To: rob@pyro
|
||||
Received: from pyro (pyro [127.0.0.1])
|
||||
by pyro.home (Postfix) with ESMTP id A5C8115A066
|
||||
for <rob@pyro>; Tue, 15 Sep 2009 20:05:45 +1000 (EST)
|
||||
Date: Tue, 15 Sep 2009 20:05:45 +1000
|
||||
To: rob@pyro
|
||||
From: rob@pyro
|
||||
Subject: test Tue, 15 Sep 2009 20:05:45 +1000
|
||||
X-Mailer: swaks v20061116.0 jetmore.org/john/code/#swaks
|
||||
Message-Id: <20090915100545.A5C8115A066@pyro.home>
|
||||
X-Bogosity: Spam, tests=bogofilter, spamicity=0.999693, version=1.2.1
|
||||
Lines: 1
|
||||
|
||||
This is a test mailing
|
||||
',
|
||||
'INTERNALDATE' => '15-Sep-2009 20:05:45 +1000',
|
||||
'FLAGS' => '\\Seen',
|
||||
'BODY[HEADER.FIELDS (TO FROM DATE SUBJECT)]' =>
|
||||
'Date: Tue, 15 Sep 2009 20:05:45 +1000
|
||||
To: rob@pyro
|
||||
From: rob@pyro
|
||||
Subject: test Tue, 15 Sep 2009 20:05:45 +1000
|
||||
|
||||
',
|
||||
'RFC822.SIZE' => '771'
|
||||
},
|
||||
},
|
||||
],
|
||||
);
|
||||
|
||||
my @uid_tests = (
|
||||
[
|
||||
"uid enabled",
|
||||
[ q{* 1 FETCH (UID 123 UNQUOTED foobar)}, ],
|
||||
[ [123], qw(UNQUOTED) ],
|
||||
{ "123" => { "UNQUOTED" => q{foobar}, } },
|
||||
],
|
||||
);
|
||||
|
||||
package Test::Mail::IMAPClient;
|
||||
|
||||
use vars qw(@ISA);
|
||||
@ISA = qw(Mail::IMAPClient);
|
||||
|
||||
sub new {
|
||||
my ( $class, %args ) = @_;
|
||||
my %me = %args;
|
||||
return bless \%me, $class;
|
||||
}
|
||||
|
||||
sub fetch {
|
||||
my ( $self, @args ) = @_;
|
||||
return $self->{_next_fetch_response} || [];
|
||||
}
|
||||
sub Escaped_results {
|
||||
my ( $self, @args ) = @_;
|
||||
return $self->{_next_fetch_response} || [];
|
||||
}
|
||||
|
||||
package main;
|
||||
|
||||
sub run_tests {
|
||||
my ( $imap, $tests ) = @_;
|
||||
|
||||
for my $test (@$tests) {
|
||||
my ( $comment, $fetch, $request, $response ) = @$test;
|
||||
$imap->{_next_fetch_response} = $fetch;
|
||||
my $r = $imap->fetch_hash(@$request);
|
||||
is_deeply( $r, $response, $comment );
|
||||
}
|
||||
}
|
||||
|
||||
my $imap = Test::Mail::IMAPClient->new( Uid => 0 );
|
||||
run_tests( $imap, \@tests );
|
||||
|
||||
$imap->Uid(1);
|
||||
run_tests( $imap, \@uid_tests );
|
||||
37
Mail-IMAPClient-3.27/t/messageset.t
Normal file
37
Mail-IMAPClient-3.27/t/messageset.t
Normal file
|
|
@ -0,0 +1,37 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 7;
|
||||
|
||||
BEGIN { use_ok('Mail::IMAPClient::MessageSet') or exit; }
|
||||
|
||||
my $one = q/1:4,3:6,10:15,20:25,2:8/;
|
||||
my $range = Mail::IMAPClient::MessageSet->new($one);
|
||||
is( $range, "1:8,10:15,20:25", 'range simplify' );
|
||||
|
||||
is(
|
||||
join( ",", $range->unfold ),
|
||||
"1,2,3,4,5,6,7,8,10,11,12,13,14,15,20,21,22,23,24,25",
|
||||
'range unfold'
|
||||
);
|
||||
|
||||
$range .= "30,31,32,31:34,40:44";
|
||||
is( $range, "1:8,10:15,20:25,30:34,40:44", 'overload concat' );
|
||||
|
||||
is(
|
||||
join( ",", $range->unfold ),
|
||||
"1,2,3,4,5,6,7,8,10,11,12,13,14,15,20,21,22,23,24,25,"
|
||||
. "30,31,32,33,34,40,41,42,43,44",
|
||||
'unfold extended'
|
||||
);
|
||||
|
||||
$range -= "1:2";
|
||||
is( $range, "3:8,10:15,20:25,30:34,40:44", 'overload subtract' );
|
||||
|
||||
is(
|
||||
join( ",", $range->unfold ),
|
||||
"3,4,5,6,7,8,10,11,12,13,14,15,20,21,22,23,24,25,"
|
||||
. "30,31,32,33,34,40,41,42,43,44",
|
||||
'subtract unfold'
|
||||
);
|
||||
10
Mail-IMAPClient-3.27/t/pod.t
Normal file
10
Mail-IMAPClient-3.27/t/pod.t
Normal file
|
|
@ -0,0 +1,10 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More;
|
||||
|
||||
eval "use Test::Pod 1.00";
|
||||
plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
|
||||
|
||||
all_pod_files_ok();
|
||||
36
Mail-IMAPClient-3.27/t/simple.t
Normal file
36
Mail-IMAPClient-3.27/t/simple.t
Normal file
|
|
@ -0,0 +1,36 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 13;
|
||||
|
||||
BEGIN { use_ok('Mail::IMAPClient') or exit; }
|
||||
|
||||
{
|
||||
my $obj = Mail::IMAPClient->new();
|
||||
|
||||
my %t = ( 0 => "01-Jan-1970" );
|
||||
foreach my $k ( sort keys %t ) {
|
||||
my $v = $t{$k};
|
||||
my $s = $v . ' 00:00:00 +0000';
|
||||
|
||||
is( Mail::IMAPClient::Rfc2060_date($k), $v, "Rfc2060_date($k)=$v" );
|
||||
is( Mail::IMAPClient::Rfc3501_date($k), $v, "Rfc3501_date($k)=$v" );
|
||||
is( Mail::IMAPClient::Rfc3501_datetime($k),
|
||||
$s, "Rfc3501_datetime($k)=$s" );
|
||||
is( Mail::IMAPClient::Rfc2060_datetime($k),
|
||||
$s, "Rfc3501_datetime($k)=$s" );
|
||||
is( $obj->Rfc3501_date($k), $v, "->Rfc3501_date($k)=$v" );
|
||||
is( $obj->Rfc2060_date($k), $v, "->Rfc2060_date($k)=$v" );
|
||||
is( $obj->Rfc3501_datetime($k), $s, "->Rfc3501_datetime($k)=$s" );
|
||||
is( $obj->Rfc2060_datetime($k), $s, "->Rfc2060_datetime($k)=$s" );
|
||||
|
||||
foreach my $z (qw(+0000 -0500)) {
|
||||
my $vz = $v . ' 00:00:00 ' . $z;
|
||||
is( Mail::IMAPClient::Rfc2060_datetime( $k, $z ),
|
||||
$vz, "Rfc2060_datetime($k)=$vz" );
|
||||
is( Mail::IMAPClient::Rfc3501_datetime( $k, $z ),
|
||||
$vz, "Rfc3501_datetime($k)=$vz" );
|
||||
}
|
||||
}
|
||||
}
|
||||
30
Mail-IMAPClient-3.27/t/thread.t
Normal file
30
Mail-IMAPClient-3.27/t/thread.t
Normal file
|
|
@ -0,0 +1,30 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 7;
|
||||
|
||||
BEGIN { use_ok('Mail::IMAPClient::Thread') or exit; }
|
||||
|
||||
my $t1 = <<'e1';
|
||||
* THREAD (166)(167)(168)(169)(172)(170)(171)(173)(174 175 176 178 181 180)(179)(177 183 182 188 184 185 186 187 189)(190)(191)(192)(193)(194 195)(196 197 198)(199)(200 202)(201)(203)(204)(205)(206 207)(208)
|
||||
e1
|
||||
|
||||
my $t2 = <<'e2';
|
||||
* THREAD (166)(167)(168)(169)(172)((170)(179))(171)(173)((174)(175)(176)(178)(181)(180))((177)(183)(182)(188 (184)(189))(185 186)(187))(190)(191)(192)(193)((194)(195 196))(197 198)(199)(200 202)(201)(203)(204)(205 206 207)(208)
|
||||
e2
|
||||
|
||||
my $parser = Mail::IMAPClient::Thread->new;
|
||||
ok( defined $parser, 'created parser' );
|
||||
|
||||
isa_ok( $parser, 'Parse::RecDescent' ); # !!!
|
||||
|
||||
my $thr1 = $parser->start($t1);
|
||||
ok( defined $thr1, 'thread1 start' );
|
||||
|
||||
cmp_ok( scalar(@$thr1), '==', 25 );
|
||||
|
||||
my $thr2 = $parser->start($t2);
|
||||
ok( defined $thr2, 'thread2 start' );
|
||||
|
||||
cmp_ok( scalar(@$thr2), '==', 23 );
|
||||
5
Mail-IMAPClient-3.27/test_template.txt
Normal file
5
Mail-IMAPClient-3.27/test_template.txt
Normal file
|
|
@ -0,0 +1,5 @@
|
|||
server=imap.server.hostname
|
||||
user=username
|
||||
passed=password
|
||||
port=143
|
||||
authmechanism=LOGIN
|
||||
Loading…
Add table
Add a link
Reference in a new issue