1
0
mirror of https://github.com/imapsync/imapsync.git synced 2024-11-16 15:52:47 +01:00
This commit is contained in:
Nick Bebout 2011-03-12 02:44:35 +00:00
parent 6576e43299
commit 0d91a1a20f
80 changed files with 31457 additions and 28691 deletions

34
CREDITS
View File

@ -13,6 +13,39 @@ If you want to make a donation to the author, Gilles LAMIRAL:
http://amazon.fr/gp/registry/wishlist/37RZF7PPCD7YL
(free postal cost)
Bryce Schober
Gave FAQ entry "imapsync ssl on win32".
Gave FAQ entry "synchronisation to gmail"
Arnt Gulbrandsen
Found FAQ bug "Flags have to begin with a \ character."
An imap server (archiveopteryx) coder that test imapsync,
very rare.
Wonko (http://wonko.com/)
Wrote a good ruby script doing the same thing than imapsync.
Scott Musser
Suggested the --delete2folders option.
Axel Rau
Success from courier-imap 3.0.3 to archiveopteryx 2.03
Martin Wunderli
Contributed by giving the book
"Computers and Intractability". Garey.
Huelbe Garcia
Contributed by giving the book
"The Shoelace Book" by Burkard Polster.
Miron Cuperman
Contributed by giving the book
"Beautiful Code: Leading Programmers Explain How They Think"
Demian Rootring
Failure story with dbmail 0.9 (as a "from" server)
Patrick Ben Koetter
Gave link to imapmigrate : http://sourceforge.net/projects/cyrus-utils/
Will wrote an article about imapsync, imapmigrate, offline-imap
@ -373,6 +406,7 @@ Worldmail to a Mac OS X Server running Cyrus."
Bryce Walter
Gave "OpenWave to Imail 8.12"
David Alix
Suggested transfer the ACL.
Suggested order message transfer by uid.

View File

@ -1,17 +1,45 @@
RCS file: RCS/imapsync,v
Working file: imapsync
head: 1.233
head: 1.239
branch:
locks: strict
gilles: 1.233
access list:
symbolic names:
keyword substitution: kv
total revisions: 233; selected revisions: 233
total revisions: 239; selected revisions: 239
description:
----------------------------
revision 1.233 locked by: gilles;
revision 1.239
date: 2007/12/29 02:44:10; author: gilles; state: Exp; lines: +7 -7
Typo if
----------------------------
revision 1.238
date: 2007/12/29 02:41:52; author: gilles; state: Exp; lines: +15 -10
Fixed --version exit bug with Test::More
----------------------------
revision 1.237
date: 2007/12/29 02:15:35; author: gilles; state: Exp; lines: +10 -15
check_lib_version() rewrote and reused.
----------------------------
revision 1.236
date: 2007/12/29 01:54:27; author: gilles; state: Exp; lines: +215 -38
Removed bad warning about ssl
Started to be IMAPClient 3.0.0 compliant
Fixed bad --include behavior (added already added folders)
Started unit tests.
Rockliffe Mailsite 4.5.6
Courier 4.1.1
----------------------------
revision 1.235
date: 2007/11/10 02:52:29; author: gilles; state: Exp; lines: +7 -5
wonko_imapsync link
----------------------------
revision 1.234
date: 2007/10/30 15:34:06; author: gilles; state: Exp; lines: +55 -32
Remove every else else between braces } else {
----------------------------
revision 1.233
date: 2007/10/30 03:20:53; author: gilles; state: Exp; lines: +69 -7
Added connect2() to replace buggy connect() with bad hostname.
----------------------------

70
FAQ
View File

@ -71,11 +71,18 @@ Q. imapsync fails with the following error:
flags from : [\Seen NonJunk]["10-Aug-2006 13:00:30 -0400"]
Error trying to append string: 58 NO APPEND Invalid flag list
R. Flags have to begin with a \ character.
The flag "NonJunk" is not a valid flag so use for example:
R. For some servers, flags have to begin with a \ character.
The flag "NonJunk" may be a invalid flag for your server
so use for example:
imapsync ... --regexflag 's/NonJunk//g'
Remark (thanks to Arnt Gulbrandsen):
IMAP system flags have to begin with \ character.
Any other flag must begin with another character.
System flags are just flags defined by an RFC instead of by users.
Conclusion, some imap server coders don't read the RFCs (so do I).
=======================================================================
Q. Flags are not well synchonized. Is it a bug ?
@ -158,6 +165,25 @@ b) or use stunnel :
c) or use stunnel on inetd
imaps stream tcp nowait cyrus /usr/sbin/stunnel -s cyrus -p /etc/ssl/certs/imapd.pem -r localhost:imap2
=======================================================================
Q: I'm trying to use imapsync for gmail, but it requires ssl, or at least
claims to. Imapsync appears to require io-socket-ssl, which doesn't seem
to be available on win32. Are there any other options?
R: (Q and R come as is from Bryce Walter)
I think I'm having success using cygwin perl instead of
ActiveState Perl. I wasn't able to get CPAN working and
building IO::Socket::SSL in ActiveState, but cygwin did
all right. I had to force the install of the Net::SSLeay
dependency, because it partially failed one test, but I think
it worked anyway. In order to get working in cygwin, I
installed the entire "perl" category, lynx, ncftp, and lftp
(specified as ftp program in cpan setup). I'm not sure if I
needed all those, or if cpan just kept asking because I didn't
have any installed at the time. Anyway, cpan worked, and
I installed all dependencies that imapsync complained
about until it started working.
=======================================================================
Q: Multiple copies when I run imapsync twice ore more.
@ -227,10 +253,17 @@ R. Use
Q. How to migrate from cyrus with an admin account ?
R. Use
--ssl1 --authuser1 AdminAccount ----password1 AdminAccountPassword
--authuser1 admin_user ----password1 admin_user_password \
--user1 foo_user --ssl1
In this case, --authmech1 PLAIN will be used by default since it
is the only way to go for now. So don't use --authmech1 SOMETHING
with --authuser1 admin_user, it will not work.
Same behavior with the --authuser2 option.
Do not forget the option --ssl1 since PLAIN auth is only
supported with tls encryption most of the time.
supported with ssl encryption most of the time. But it can
work without --ssl1 if PLAIN is permitted in normal use.
Here is an example:
imapsync \
@ -366,6 +399,27 @@ the other lines)
b) Run imapsync with the following option :
--regexmess 's/\AFrom \w .*\n//'
=======================================================================
Q. Synchronysing from XXX to Gmail
R. There are some details to get the special [Gmail]
sub-folders right. Here's an example of migrating an old "Sent"
folder to Gmail's structure:
imapsync --syncinternaldates \
--host1 mail.oldhost.com \
--user1 my_email@oldhost.com \
--password1 password \
--host2 imap.gmail.com --port2 993 --ssl2 \
--authmech2 LOGIN \
--user2 my_email@gmail.com \
--password2 password \
--prefix2 '[Gmail]/' \
--folder 'INBOX.Sent' \
--regextrans2 's/Sent/Sent Mail/'
The same goes for the "All Mail" archive psuedo-folder.
=======================================================================
Q. I'm migrating from WU to Cyrus, and the mail folders are
@ -532,6 +586,14 @@ Q. From GMX IMAP4 StreamProxy
R. Use:
--prefix1 INBOX and --sep1 .
======================================================================
Q. From Courier to Archiveopteryx
R. http://www.archiveopteryx.org/migration/imapsync
Use:
--useheader Message-Id --skipsize
======================================================================
Q: How can I write an .rpm with imapsync
R: I don't know but Neil Brown wrote one rpm package and you'll find

View File

@ -1,850 +0,0 @@
# This Makefile is for the Mail::IMAPClient extension to perl.
#
# It was generated automatically by MakeMaker version
# 6.30_01 (Revision: Revision: 4535 ) from the contents of
# Makefile.PL. Don't edit this file, edit Makefile.PL instead.
#
# ANY CHANGES MADE HERE WILL BE LOST!
#
# MakeMaker ARGV: ()
#
# MakeMaker Parameters:
# ABSTRACT => q[IMAP4 client library]
# NAME => q[Mail::IMAPClient]
# PREREQ_PM => { IO::File=>q[0], IO::Socket::INET=>q[1.26], Data::Dumper=>q[0], Fcntl=>q[0], Test::Pod=>q[0], Parse::RecDescent=>q[1.94], Carp=>q[0], Test::More=>q[0], Digest::HMAC_MD5=>q[0], MIME::Base64=>q[0], IO::Socket=>q[0], IO::Select=>q[0], File::Temp=>q[0.18], Errno=>q[0] }
# VERSION_FROM => q[lib/Mail/IMAPClient.pm]
# clean => { FILES=>q[test.txt] }
# --- MakeMaker post_initialize section:
# --- MakeMaker const_config section:
# These definitions are from config.sh (via /usr/lib/perl/5.8/Config.pm)
# They may have been overridden via Makefile.PL or on the command line
AR = ar
CC = cc
CCCDLFLAGS = -fPIC
CCDLFLAGS = -Wl,-E
DLEXT = so
DLSRC = dl_dlopen.xs
LD = cc
LDDLFLAGS = -shared -L/usr/local/lib
LDFLAGS = -L/usr/local/lib
LIBC = /lib/libc-2.3.6.so
LIB_EXT = .a
OBJ_EXT = .o
OSNAME = linux
OSVERS = 2.6.18.3
RANLIB = :
SITELIBEXP = /usr/local/share/perl/5.8.8
SITEARCHEXP = /usr/local/lib/perl/5.8.8
SO = so
EXE_EXT =
FULL_AR = /usr/bin/ar
VENDORARCHEXP = /usr/lib/perl5
VENDORLIBEXP = /usr/share/perl5
# --- MakeMaker constants section:
AR_STATIC_ARGS = cr
DIRFILESEP = /
DFSEP = $(DIRFILESEP)
NAME = Mail::IMAPClient
NAME_SYM = Mail_IMAPClient
VERSION = 2.99_02
VERSION_MACRO = VERSION
VERSION_SYM = 2_99_02
DEFINE_VERSION = -D$(VERSION_MACRO)=\"$(VERSION)\"
XS_VERSION = 2.99_02
XS_VERSION_MACRO = XS_VERSION
XS_DEFINE_VERSION = -D$(XS_VERSION_MACRO)=\"$(XS_VERSION)\"
INST_ARCHLIB = blib/arch
INST_SCRIPT = blib/script
INST_BIN = blib/bin
INST_LIB = blib/lib
INST_MAN1DIR = blib/man1
INST_MAN3DIR = blib/man3
MAN1EXT = 1p
MAN3EXT = 3pm
INSTALLDIRS = site
DESTDIR =
PREFIX = /usr
PERLPREFIX = $(PREFIX)
SITEPREFIX = $(PREFIX)/local
VENDORPREFIX = $(PREFIX)
INSTALLPRIVLIB = $(PERLPREFIX)/share/perl/5.8
DESTINSTALLPRIVLIB = $(DESTDIR)$(INSTALLPRIVLIB)
INSTALLSITELIB = $(SITEPREFIX)/share/perl/5.8.8
DESTINSTALLSITELIB = $(DESTDIR)$(INSTALLSITELIB)
INSTALLVENDORLIB = $(VENDORPREFIX)/share/perl5
DESTINSTALLVENDORLIB = $(DESTDIR)$(INSTALLVENDORLIB)
INSTALLARCHLIB = $(PERLPREFIX)/lib/perl/5.8
DESTINSTALLARCHLIB = $(DESTDIR)$(INSTALLARCHLIB)
INSTALLSITEARCH = $(SITEPREFIX)/lib/perl/5.8.8
DESTINSTALLSITEARCH = $(DESTDIR)$(INSTALLSITEARCH)
INSTALLVENDORARCH = $(VENDORPREFIX)/lib/perl5
DESTINSTALLVENDORARCH = $(DESTDIR)$(INSTALLVENDORARCH)
INSTALLBIN = $(PERLPREFIX)/bin
DESTINSTALLBIN = $(DESTDIR)$(INSTALLBIN)
INSTALLSITEBIN = $(SITEPREFIX)/bin
DESTINSTALLSITEBIN = $(DESTDIR)$(INSTALLSITEBIN)
INSTALLVENDORBIN = $(VENDORPREFIX)/bin
DESTINSTALLVENDORBIN = $(DESTDIR)$(INSTALLVENDORBIN)
INSTALLSCRIPT = $(PERLPREFIX)/bin
DESTINSTALLSCRIPT = $(DESTDIR)$(INSTALLSCRIPT)
INSTALLSITESCRIPT = $(SITEPREFIX)/bin
DESTINSTALLSITESCRIPT = $(DESTDIR)$(INSTALLSITESCRIPT)
INSTALLVENDORSCRIPT = $(VENDORPREFIX)/bin
DESTINSTALLVENDORSCRIPT = $(DESTDIR)$(INSTALLVENDORSCRIPT)
INSTALLMAN1DIR = $(PERLPREFIX)/share/man/man1
DESTINSTALLMAN1DIR = $(DESTDIR)$(INSTALLMAN1DIR)
INSTALLSITEMAN1DIR = $(SITEPREFIX)/man/man1
DESTINSTALLSITEMAN1DIR = $(DESTDIR)$(INSTALLSITEMAN1DIR)
INSTALLVENDORMAN1DIR = $(VENDORPREFIX)/share/man/man1
DESTINSTALLVENDORMAN1DIR = $(DESTDIR)$(INSTALLVENDORMAN1DIR)
INSTALLMAN3DIR = $(PERLPREFIX)/share/man/man3
DESTINSTALLMAN3DIR = $(DESTDIR)$(INSTALLMAN3DIR)
INSTALLSITEMAN3DIR = $(SITEPREFIX)/man/man3
DESTINSTALLSITEMAN3DIR = $(DESTDIR)$(INSTALLSITEMAN3DIR)
INSTALLVENDORMAN3DIR = $(VENDORPREFIX)/share/man/man3
DESTINSTALLVENDORMAN3DIR = $(DESTDIR)$(INSTALLVENDORMAN3DIR)
PERL_LIB = /usr/share/perl/5.8
PERL_ARCHLIB = /usr/lib/perl/5.8
LIBPERL_A = libperl.a
FIRST_MAKEFILE = Makefile
MAKEFILE_OLD = Makefile.old
MAKE_APERL_FILE = Makefile.aperl
PERLMAINCC = $(CC)
PERL_INC = /usr/lib/perl/5.8/CORE
PERL = /usr/bin/perl
FULLPERL = /usr/bin/perl
ABSPERL = $(PERL)
PERLRUN = $(PERL)
FULLPERLRUN = $(FULLPERL)
ABSPERLRUN = $(ABSPERL)
PERLRUNINST = $(PERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)"
FULLPERLRUNINST = $(FULLPERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)"
ABSPERLRUNINST = $(ABSPERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)"
PERL_CORE = 0
PERM_RW = 644
PERM_RWX = 755
MAKEMAKER = /usr/share/perl/5.8/ExtUtils/MakeMaker.pm
MM_VERSION = 6.30_01
MM_REVISION = Revision: 4535
# FULLEXT = Pathname for extension directory (eg Foo/Bar/Oracle).
# BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. (eg Oracle)
# PARENT_NAME = NAME without BASEEXT and no trailing :: (eg Foo::Bar)
# DLBASE = Basename part of dynamic library. May be just equal BASEEXT.
FULLEXT = Mail/IMAPClient
BASEEXT = IMAPClient
PARENT_NAME = Mail
DLBASE = $(BASEEXT)
VERSION_FROM = lib/Mail/IMAPClient.pm
OBJECT =
LDFROM = $(OBJECT)
LINKTYPE = dynamic
BOOTDEP =
# Handy lists of source code files:
XS_FILES =
C_FILES =
O_FILES =
H_FILES =
MAN1PODS =
MAN3PODS = lib/Mail/IMAPClient.pod \
lib/Mail/IMAPClient/BodyStructure.pm \
lib/Mail/IMAPClient/BodyStructure/Parse.pod \
lib/Mail/IMAPClient/MessageSet.pm \
lib/Mail/IMAPClient/Thread.pod
# Where is the Config information that we are using/depend on
CONFIGDEP = $(PERL_ARCHLIB)$(DFSEP)Config.pm $(PERL_INC)$(DFSEP)config.h
# Where to build things
INST_LIBDIR = $(INST_LIB)/Mail
INST_ARCHLIBDIR = $(INST_ARCHLIB)/Mail
INST_AUTODIR = $(INST_LIB)/auto/$(FULLEXT)
INST_ARCHAUTODIR = $(INST_ARCHLIB)/auto/$(FULLEXT)
INST_STATIC =
INST_DYNAMIC =
INST_BOOT =
# Extra linker info
EXPORT_LIST =
PERL_ARCHIVE =
PERL_ARCHIVE_AFTER =
TO_INST_PM = 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
PM_TO_BLIB = lib/Mail/IMAPClient/BodyStructure/Parse.pm \
blib/lib/Mail/IMAPClient/BodyStructure/Parse.pm \
lib/Mail/IMAPClient/Thread.pm \
blib/lib/Mail/IMAPClient/Thread.pm \
lib/Mail/IMAPClient/BodyStructure/Parse.grammar \
blib/lib/Mail/IMAPClient/BodyStructure/Parse.grammar \
lib/Mail/IMAPClient.pod \
blib/lib/Mail/IMAPClient.pod \
lib/Mail/IMAPClient/Thread.pod \
blib/lib/Mail/IMAPClient/Thread.pod \
lib/Mail/IMAPClient/MessageSet.pm \
blib/lib/Mail/IMAPClient/MessageSet.pm \
lib/Mail/IMAPClient/BodyStructure.pm \
blib/lib/Mail/IMAPClient/BodyStructure.pm \
lib/Mail/IMAPClient/Thread.grammar \
blib/lib/Mail/IMAPClient/Thread.grammar \
lib/Mail/IMAPClient/BodyStructure/Parse.pod \
blib/lib/Mail/IMAPClient/BodyStructure/Parse.pod \
lib/Mail/IMAPClient.pm \
blib/lib/Mail/IMAPClient.pm
# --- MakeMaker platform_constants section:
MM_Unix_VERSION = 1.50_01
PERL_MALLOC_DEF = -DPERL_EXTMALLOC_DEF -Dmalloc=Perl_malloc -Dfree=Perl_mfree -Drealloc=Perl_realloc -Dcalloc=Perl_calloc
# --- MakeMaker tool_autosplit section:
# Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto
AUTOSPLITFILE = $(ABSPERLRUN) -e 'use AutoSplit; autosplit($$ARGV[0], $$ARGV[1], 0, 1, 1)'
# --- MakeMaker tool_xsubpp section:
# --- MakeMaker tools_other section:
SHELL = /bin/sh
CHMOD = chmod
CP = cp
MV = mv
NOOP = $(SHELL) -c true
NOECHO = @
RM_F = rm -f
RM_RF = rm -rf
TEST_F = test -f
TOUCH = touch
UMASK_NULL = umask 0
DEV_NULL = > /dev/null 2>&1
MKPATH = $(ABSPERLRUN) "-MExtUtils::Command" -e mkpath
EQUALIZE_TIMESTAMP = $(ABSPERLRUN) "-MExtUtils::Command" -e eqtime
ECHO = echo
ECHO_N = echo -n
UNINST = 0
VERBINST = 0
MOD_INSTALL = $(ABSPERLRUN) -MExtUtils::Install -e 'install({@ARGV}, '\''$(VERBINST)'\'', 0, '\''$(UNINST)'\'');'
DOC_INSTALL = $(ABSPERLRUN) "-MExtUtils::Command::MM" -e perllocal_install
UNINSTALL = $(ABSPERLRUN) "-MExtUtils::Command::MM" -e uninstall
WARN_IF_OLD_PACKLIST = $(ABSPERLRUN) "-MExtUtils::Command::MM" -e warn_if_old_packlist
MACROSTART =
MACROEND =
USEMAKEFILE = -f
FIXIN = $(PERLRUN) "-MExtUtils::MY" -e "MY->fixin(shift)"
# --- MakeMaker makemakerdflt section:
makemakerdflt: all
$(NOECHO) $(NOOP)
# --- MakeMaker dist section:
TAR = tar
TARFLAGS = cvf
ZIP = zip
ZIPFLAGS = -r
COMPRESS = gzip --best
SUFFIX = .gz
SHAR = shar
PREOP = $(NOECHO) $(NOOP)
POSTOP = $(NOECHO) $(NOOP)
TO_UNIX = $(NOECHO) $(NOOP)
CI = ci -u
RCS_LABEL = rcs -Nv$(VERSION_SYM): -q
DIST_CP = best
DIST_DEFAULT = tardist
DISTNAME = Mail-IMAPClient
DISTVNAME = Mail-IMAPClient-2.99_02
# --- MakeMaker macro section:
# --- MakeMaker depend section:
# --- MakeMaker cflags section:
# --- MakeMaker const_loadlibs section:
# --- MakeMaker const_cccmd section:
# --- MakeMaker post_constants section:
# --- MakeMaker pasthru section:
PASTHRU = LIBPERL_A="$(LIBPERL_A)"\
LINKTYPE="$(LINKTYPE)"\
PREFIX="$(PREFIX)"
# --- MakeMaker special_targets section:
.SUFFIXES : .xs .c .C .cpp .i .s .cxx .cc $(OBJ_EXT)
.PHONY: all config static dynamic test linkext manifest blibdirs clean realclean disttest distdir
# --- MakeMaker c_o section:
# --- MakeMaker xs_c section:
# --- MakeMaker xs_o section:
# --- MakeMaker top_targets section:
all :: pure_all manifypods
$(NOECHO) $(NOOP)
pure_all :: config pm_to_blib subdirs linkext
$(NOECHO) $(NOOP)
subdirs :: $(MYEXTLIB)
$(NOECHO) $(NOOP)
config :: $(FIRST_MAKEFILE) blibdirs
$(NOECHO) $(NOOP)
help :
perldoc ExtUtils::MakeMaker
# --- MakeMaker blibdirs section:
blibdirs : $(INST_LIBDIR)$(DFSEP).exists $(INST_ARCHLIB)$(DFSEP).exists $(INST_AUTODIR)$(DFSEP).exists $(INST_ARCHAUTODIR)$(DFSEP).exists $(INST_BIN)$(DFSEP).exists $(INST_SCRIPT)$(DFSEP).exists $(INST_MAN1DIR)$(DFSEP).exists $(INST_MAN3DIR)$(DFSEP).exists
$(NOECHO) $(NOOP)
# Backwards compat with 6.18 through 6.25
blibdirs.ts : blibdirs
$(NOECHO) $(NOOP)
$(INST_LIBDIR)$(DFSEP).exists :: Makefile.PL
$(NOECHO) $(MKPATH) $(INST_LIBDIR)
$(NOECHO) $(CHMOD) 755 $(INST_LIBDIR)
$(NOECHO) $(TOUCH) $(INST_LIBDIR)$(DFSEP).exists
$(INST_ARCHLIB)$(DFSEP).exists :: Makefile.PL
$(NOECHO) $(MKPATH) $(INST_ARCHLIB)
$(NOECHO) $(CHMOD) 755 $(INST_ARCHLIB)
$(NOECHO) $(TOUCH) $(INST_ARCHLIB)$(DFSEP).exists
$(INST_AUTODIR)$(DFSEP).exists :: Makefile.PL
$(NOECHO) $(MKPATH) $(INST_AUTODIR)
$(NOECHO) $(CHMOD) 755 $(INST_AUTODIR)
$(NOECHO) $(TOUCH) $(INST_AUTODIR)$(DFSEP).exists
$(INST_ARCHAUTODIR)$(DFSEP).exists :: Makefile.PL
$(NOECHO) $(MKPATH) $(INST_ARCHAUTODIR)
$(NOECHO) $(CHMOD) 755 $(INST_ARCHAUTODIR)
$(NOECHO) $(TOUCH) $(INST_ARCHAUTODIR)$(DFSEP).exists
$(INST_BIN)$(DFSEP).exists :: Makefile.PL
$(NOECHO) $(MKPATH) $(INST_BIN)
$(NOECHO) $(CHMOD) 755 $(INST_BIN)
$(NOECHO) $(TOUCH) $(INST_BIN)$(DFSEP).exists
$(INST_SCRIPT)$(DFSEP).exists :: Makefile.PL
$(NOECHO) $(MKPATH) $(INST_SCRIPT)
$(NOECHO) $(CHMOD) 755 $(INST_SCRIPT)
$(NOECHO) $(TOUCH) $(INST_SCRIPT)$(DFSEP).exists
$(INST_MAN1DIR)$(DFSEP).exists :: Makefile.PL
$(NOECHO) $(MKPATH) $(INST_MAN1DIR)
$(NOECHO) $(CHMOD) 755 $(INST_MAN1DIR)
$(NOECHO) $(TOUCH) $(INST_MAN1DIR)$(DFSEP).exists
$(INST_MAN3DIR)$(DFSEP).exists :: Makefile.PL
$(NOECHO) $(MKPATH) $(INST_MAN3DIR)
$(NOECHO) $(CHMOD) 755 $(INST_MAN3DIR)
$(NOECHO) $(TOUCH) $(INST_MAN3DIR)$(DFSEP).exists
# --- MakeMaker linkext section:
linkext :: $(LINKTYPE)
$(NOECHO) $(NOOP)
# --- MakeMaker dlsyms section:
# --- MakeMaker dynamic section:
dynamic :: $(FIRST_MAKEFILE) $(INST_DYNAMIC) $(INST_BOOT)
$(NOECHO) $(NOOP)
# --- MakeMaker dynamic_bs section:
BOOTSTRAP =
# --- MakeMaker dynamic_lib section:
# --- MakeMaker static section:
## $(INST_PM) has been moved to the all: target.
## It remains here for awhile to allow for old usage: "make static"
static :: $(FIRST_MAKEFILE) $(INST_STATIC)
$(NOECHO) $(NOOP)
# --- MakeMaker static_lib section:
# --- MakeMaker manifypods section:
POD2MAN_EXE = $(PERLRUN) "-MExtUtils::Command::MM" -e pod2man "--"
POD2MAN = $(POD2MAN_EXE)
manifypods : pure_all \
lib/Mail/IMAPClient/Thread.pod \
lib/Mail/IMAPClient/MessageSet.pm \
lib/Mail/IMAPClient/BodyStructure.pm \
lib/Mail/IMAPClient/BodyStructure/Parse.pod \
lib/Mail/IMAPClient.pod \
lib/Mail/IMAPClient/Thread.pod \
lib/Mail/IMAPClient/MessageSet.pm \
lib/Mail/IMAPClient/BodyStructure.pm \
lib/Mail/IMAPClient/BodyStructure/Parse.pod \
lib/Mail/IMAPClient.pod
$(NOECHO) $(POD2MAN) --section=$(MAN3EXT) --perm_rw=$(PERM_RW) \
lib/Mail/IMAPClient/Thread.pod $(INST_MAN3DIR)/Mail::IMAPClient::Thread.$(MAN3EXT) \
lib/Mail/IMAPClient/MessageSet.pm $(INST_MAN3DIR)/Mail::IMAPClient::MessageSet.$(MAN3EXT) \
lib/Mail/IMAPClient/BodyStructure.pm $(INST_MAN3DIR)/Mail::IMAPClient::BodyStructure.$(MAN3EXT) \
lib/Mail/IMAPClient/BodyStructure/Parse.pod $(INST_MAN3DIR)/Mail::IMAPClient::BodyStructure::Parse.$(MAN3EXT) \
lib/Mail/IMAPClient.pod $(INST_MAN3DIR)/Mail::IMAPClient.$(MAN3EXT)
# --- MakeMaker processPL section:
# --- MakeMaker installbin section:
# --- MakeMaker subdirs section:
# none
# --- MakeMaker clean_subdirs section:
clean_subdirs :
$(NOECHO) $(NOOP)
# --- MakeMaker clean section:
# Delete temporary files but do not touch installed files. We don't delete
# the Makefile here so a later make realclean still has a makefile to use.
clean :: clean_subdirs
- $(RM_F) \
*$(LIB_EXT) core \
core.[0-9] $(INST_ARCHAUTODIR)/extralibs.all \
core.[0-9][0-9] $(BASEEXT).bso \
pm_to_blib.ts core.[0-9][0-9][0-9][0-9] \
$(BASEEXT).x $(BOOTSTRAP) \
perl$(EXE_EXT) tmon.out \
*$(OBJ_EXT) pm_to_blib \
$(INST_ARCHAUTODIR)/extralibs.ld blibdirs.ts \
core.[0-9][0-9][0-9][0-9][0-9] *perl.core \
core.*perl.*.? $(MAKE_APERL_FILE) \
perl $(BASEEXT).def \
core.[0-9][0-9][0-9] mon.out \
lib$(BASEEXT).def perlmain.c \
perl.exe so_locations \
$(BASEEXT).exp
- $(RM_RF) \
test.txt blib
- $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD) $(DEV_NULL)
# --- MakeMaker realclean_subdirs section:
realclean_subdirs :
$(NOECHO) $(NOOP)
# --- MakeMaker realclean section:
# Delete temporary files (via clean) and also delete dist files
realclean purge :: clean realclean_subdirs
- $(RM_F) \
$(MAKEFILE_OLD) $(FIRST_MAKEFILE)
- $(RM_RF) \
$(DISTVNAME)
# --- MakeMaker metafile section:
metafile : create_distdir
$(NOECHO) $(ECHO) Generating META.yml
$(NOECHO) $(ECHO) '# http://module-build.sourceforge.net/META-spec.html' > META_new.yml
$(NOECHO) $(ECHO) '#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#' >> META_new.yml
$(NOECHO) $(ECHO) 'name: Mail-IMAPClient' >> META_new.yml
$(NOECHO) $(ECHO) 'version: 2.99_02' >> META_new.yml
$(NOECHO) $(ECHO) 'version_from: lib/Mail/IMAPClient.pm' >> META_new.yml
$(NOECHO) $(ECHO) 'installdirs: site' >> META_new.yml
$(NOECHO) $(ECHO) 'requires:' >> META_new.yml
$(NOECHO) $(ECHO) ' Carp: 0' >> META_new.yml
$(NOECHO) $(ECHO) ' Data::Dumper: 0' >> META_new.yml
$(NOECHO) $(ECHO) ' Digest::HMAC_MD5: 0' >> META_new.yml
$(NOECHO) $(ECHO) ' Errno: 0' >> META_new.yml
$(NOECHO) $(ECHO) ' Fcntl: 0' >> META_new.yml
$(NOECHO) $(ECHO) ' File::Temp: 0.18' >> META_new.yml
$(NOECHO) $(ECHO) ' IO::File: 0' >> META_new.yml
$(NOECHO) $(ECHO) ' IO::Select: 0' >> META_new.yml
$(NOECHO) $(ECHO) ' IO::Socket: 0' >> META_new.yml
$(NOECHO) $(ECHO) ' IO::Socket::INET: 1.26' >> META_new.yml
$(NOECHO) $(ECHO) ' MIME::Base64: 0' >> META_new.yml
$(NOECHO) $(ECHO) ' Parse::RecDescent: 1.94' >> META_new.yml
$(NOECHO) $(ECHO) ' Test::More: 0' >> META_new.yml
$(NOECHO) $(ECHO) ' Test::Pod: 0' >> META_new.yml
$(NOECHO) $(ECHO) '' >> META_new.yml
$(NOECHO) $(ECHO) 'distribution_type: module' >> META_new.yml
$(NOECHO) $(ECHO) 'generated_by: ExtUtils::MakeMaker version 6.30_01' >> META_new.yml
-$(NOECHO) $(MV) META_new.yml $(DISTVNAME)/META.yml
# --- MakeMaker signature section:
signature :
cpansign -s
# --- MakeMaker dist_basics section:
distclean :: realclean distcheck
$(NOECHO) $(NOOP)
distcheck :
$(PERLRUN) "-MExtUtils::Manifest=fullcheck" -e fullcheck
skipcheck :
$(PERLRUN) "-MExtUtils::Manifest=skipcheck" -e skipcheck
manifest :
$(PERLRUN) "-MExtUtils::Manifest=mkmanifest" -e mkmanifest
veryclean : realclean
$(RM_F) *~ *.orig */*~ */*.orig
# --- MakeMaker dist_core section:
dist : $(DIST_DEFAULT) $(FIRST_MAKEFILE)
$(NOECHO) $(ABSPERLRUN) -l -e 'print '\''Warning: Makefile possibly out of date with $(VERSION_FROM)'\''' \
-e ' if -e '\''$(VERSION_FROM)'\'' and -M '\''$(VERSION_FROM)'\'' < -M '\''$(FIRST_MAKEFILE)'\'';'
tardist : $(DISTVNAME).tar$(SUFFIX)
$(NOECHO) $(NOOP)
uutardist : $(DISTVNAME).tar$(SUFFIX)
uuencode $(DISTVNAME).tar$(SUFFIX) $(DISTVNAME).tar$(SUFFIX) > $(DISTVNAME).tar$(SUFFIX)_uu
$(DISTVNAME).tar$(SUFFIX) : distdir
$(PREOP)
$(TO_UNIX)
$(TAR) $(TARFLAGS) $(DISTVNAME).tar $(DISTVNAME)
$(RM_RF) $(DISTVNAME)
$(COMPRESS) $(DISTVNAME).tar
$(POSTOP)
zipdist : $(DISTVNAME).zip
$(NOECHO) $(NOOP)
$(DISTVNAME).zip : distdir
$(PREOP)
$(ZIP) $(ZIPFLAGS) $(DISTVNAME).zip $(DISTVNAME)
$(RM_RF) $(DISTVNAME)
$(POSTOP)
shdist : distdir
$(PREOP)
$(SHAR) $(DISTVNAME) > $(DISTVNAME).shar
$(RM_RF) $(DISTVNAME)
$(POSTOP)
# --- MakeMaker distdir section:
create_distdir :
$(RM_RF) $(DISTVNAME)
$(PERLRUN) "-MExtUtils::Manifest=manicopy,maniread" \
-e "manicopy(maniread(),'$(DISTVNAME)', '$(DIST_CP)');"
distdir : create_distdir distmeta
$(NOECHO) $(NOOP)
# --- MakeMaker dist_test section:
disttest : distdir
cd $(DISTVNAME) && $(ABSPERLRUN) Makefile.PL
cd $(DISTVNAME) && $(MAKE) $(PASTHRU)
cd $(DISTVNAME) && $(MAKE) test $(PASTHRU)
# --- MakeMaker dist_ci section:
ci :
$(PERLRUN) "-MExtUtils::Manifest=maniread" \
-e "@all = keys %{ maniread() };" \
-e "print(qq{Executing $(CI) @all\n}); system(qq{$(CI) @all});" \
-e "print(qq{Executing $(RCS_LABEL) ...\n}); system(qq{$(RCS_LABEL) @all});"
# --- MakeMaker distmeta section:
distmeta : create_distdir metafile
$(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'eval { maniadd({q{META.yml} => q{Module meta-data (added by MakeMaker)}}) } ' \
-e ' or print "Could not add META.yml to MANIFEST: $${'\''@'\''}\n"'
# --- MakeMaker distsignature section:
distsignature : create_distdir
$(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'eval { maniadd({q{SIGNATURE} => q{Public-key signature (added by MakeMaker)}}) } ' \
-e ' or print "Could not add SIGNATURE to MANIFEST: $${'\''@'\''}\n"'
$(NOECHO) cd $(DISTVNAME) && $(TOUCH) SIGNATURE
cd $(DISTVNAME) && cpansign -s
# --- MakeMaker install section:
install :: all pure_install doc_install
$(NOECHO) $(NOOP)
install_perl :: all pure_perl_install doc_perl_install
$(NOECHO) $(NOOP)
install_site :: all pure_site_install doc_site_install
$(NOECHO) $(NOOP)
install_vendor :: all pure_vendor_install doc_vendor_install
$(NOECHO) $(NOOP)
pure_install :: pure_$(INSTALLDIRS)_install
$(NOECHO) $(NOOP)
doc_install :: doc_$(INSTALLDIRS)_install
$(NOECHO) $(NOOP)
pure__install : pure_site_install
$(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
doc__install : doc_site_install
$(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
pure_perl_install ::
$(NOECHO) umask 022; $(MOD_INSTALL) \
$(INST_LIB) $(DESTINSTALLPRIVLIB) \
$(INST_ARCHLIB) $(DESTINSTALLARCHLIB) \
$(INST_BIN) $(DESTINSTALLBIN) \
$(INST_SCRIPT) $(DESTINSTALLSCRIPT) \
$(INST_MAN1DIR) $(DESTINSTALLMAN1DIR) \
$(INST_MAN3DIR) $(DESTINSTALLMAN3DIR)
$(NOECHO) $(WARN_IF_OLD_PACKLIST) \
$(SITEARCHEXP)/auto/$(FULLEXT)
pure_site_install ::
$(NOECHO) umask 02; $(MOD_INSTALL) \
read $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist \
write $(DESTINSTALLSITEARCH)/auto/$(FULLEXT)/.packlist \
$(INST_LIB) $(DESTINSTALLSITELIB) \
$(INST_ARCHLIB) $(DESTINSTALLSITEARCH) \
$(INST_BIN) $(DESTINSTALLSITEBIN) \
$(INST_SCRIPT) $(DESTINSTALLSITESCRIPT) \
$(INST_MAN1DIR) $(DESTINSTALLSITEMAN1DIR) \
$(INST_MAN3DIR) $(DESTINSTALLSITEMAN3DIR)
$(NOECHO) $(WARN_IF_OLD_PACKLIST) \
$(PERL_ARCHLIB)/auto/$(FULLEXT)
pure_vendor_install ::
$(NOECHO) umask 022; $(MOD_INSTALL) \
$(INST_LIB) $(DESTINSTALLVENDORLIB) \
$(INST_ARCHLIB) $(DESTINSTALLVENDORARCH) \
$(INST_BIN) $(DESTINSTALLVENDORBIN) \
$(INST_SCRIPT) $(DESTINSTALLVENDORSCRIPT) \
$(INST_MAN1DIR) $(DESTINSTALLVENDORMAN1DIR) \
$(INST_MAN3DIR) $(DESTINSTALLVENDORMAN3DIR)
doc_perl_install ::
doc_site_install ::
$(NOECHO) $(ECHO) Appending installation info to $(DESTINSTALLSITEARCH)/perllocal.pod
-$(NOECHO) umask 02; $(MKPATH) $(DESTINSTALLSITEARCH)
-$(NOECHO) umask 02; $(DOC_INSTALL) \
"Module" "$(NAME)" \
"installed into" "$(INSTALLSITELIB)" \
LINKTYPE "$(LINKTYPE)" \
VERSION "$(VERSION)" \
EXE_FILES "$(EXE_FILES)" \
>> $(DESTINSTALLSITEARCH)/perllocal.pod
doc_vendor_install ::
uninstall :: uninstall_from_$(INSTALLDIRS)dirs
$(NOECHO) $(NOOP)
uninstall_from_perldirs ::
uninstall_from_sitedirs ::
$(NOECHO) $(UNINSTALL) $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist
uninstall_from_vendordirs ::
# --- MakeMaker force section:
# Phony target to force checking subdirectories.
FORCE:
$(NOECHO) $(NOOP)
# --- MakeMaker perldepend section:
# --- MakeMaker makefile section:
# We take a very conservative approach here, but it's worth it.
# We move Makefile to Makefile.old here to avoid gnu make looping.
$(FIRST_MAKEFILE) : Makefile.PL $(CONFIGDEP)
$(NOECHO) $(ECHO) "Makefile out-of-date with respect to $?"
$(NOECHO) $(ECHO) "Cleaning current config before rebuilding Makefile..."
-$(NOECHO) $(RM_F) $(MAKEFILE_OLD)
-$(NOECHO) $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD)
- $(MAKE) $(USEMAKEFILE) $(MAKEFILE_OLD) clean $(DEV_NULL)
$(PERLRUN) Makefile.PL
$(NOECHO) $(ECHO) "==> Your Makefile has been rebuilt. <=="
$(NOECHO) $(ECHO) "==> Please rerun the $(MAKE) command. <=="
false
# --- MakeMaker staticmake section:
# --- MakeMaker makeaperl section ---
MAP_TARGET = perl
FULLPERL = /usr/bin/perl
$(MAP_TARGET) :: static $(MAKE_APERL_FILE)
$(MAKE) $(USEMAKEFILE) $(MAKE_APERL_FILE) $@
$(MAKE_APERL_FILE) : $(FIRST_MAKEFILE) pm_to_blib
$(NOECHO) $(ECHO) Writing \"$(MAKE_APERL_FILE)\" for this $(MAP_TARGET)
$(NOECHO) $(PERLRUNINST) \
Makefile.PL DIR= \
MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \
MAKEAPERL=1 NORECURS=1 CCCDLFLAGS=
# --- MakeMaker test section:
TEST_VERBOSE=0
TEST_TYPE=test_$(LINKTYPE)
TEST_FILE = test.pl
TEST_FILES = t/*.t
TESTDB_SW = -d
testdb :: testdb_$(LINKTYPE)
test :: $(TEST_TYPE)
test_dynamic :: pure_all
PERL_DL_NONLAZY=1 $(FULLPERLRUN) "-MExtUtils::Command::MM" "-e" "test_harness($(TEST_VERBOSE), '$(INST_LIB)', '$(INST_ARCHLIB)')" $(TEST_FILES)
testdb_dynamic :: pure_all
PERL_DL_NONLAZY=1 $(FULLPERLRUN) $(TESTDB_SW) "-I$(INST_LIB)" "-I$(INST_ARCHLIB)" $(TEST_FILE)
test_ : test_dynamic
test_static :: test_dynamic
testdb_static :: testdb_dynamic
# --- MakeMaker ppd section:
# Creates a PPD (Perl Package Description) for a binary distribution.
ppd:
$(NOECHO) $(ECHO) '<SOFTPKG NAME="$(DISTNAME)" VERSION="2,99_02,0,0">' > $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' <TITLE>$(DISTNAME)</TITLE>' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' <ABSTRACT>IMAP4 client library</ABSTRACT>' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' <AUTHOR></AUTHOR>' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' <IMPLEMENTATION>' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' <DEPENDENCY NAME="Carp" VERSION="0,0,0,0" />' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' <DEPENDENCY NAME="Data-Dumper" VERSION="0,0,0,0" />' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' <DEPENDENCY NAME="Digest-HMAC_MD5" VERSION="0,0,0,0" />' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' <DEPENDENCY NAME="Errno" VERSION="0,0,0,0" />' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' <DEPENDENCY NAME="Fcntl" VERSION="0,0,0,0" />' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' <DEPENDENCY NAME="File-Temp" VERSION="0,18,0,0" />' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' <DEPENDENCY NAME="IO-File" VERSION="0,0,0,0" />' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' <DEPENDENCY NAME="IO-Select" VERSION="0,0,0,0" />' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' <DEPENDENCY NAME="IO-Socket" VERSION="0,0,0,0" />' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' <DEPENDENCY NAME="IO-Socket-INET" VERSION="1,26,0,0" />' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' <DEPENDENCY NAME="MIME-Base64" VERSION="0,0,0,0" />' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' <DEPENDENCY NAME="Parse-RecDescent" VERSION="1,94,0,0" />' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' <DEPENDENCY NAME="Test-More" VERSION="0,0,0,0" />' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' <DEPENDENCY NAME="Test-Pod" VERSION="0,0,0,0" />' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' <OS NAME="$(OSNAME)" />' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' <ARCHITECTURE NAME="i486-linux-gnu-thread-multi" />' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' <CODEBASE HREF="" />' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' </IMPLEMENTATION>' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) '</SOFTPKG>' >> $(DISTNAME).ppd
# --- MakeMaker pm_to_blib section:
pm_to_blib : $(TO_INST_PM)
$(NOECHO) $(ABSPERLRUN) -MExtUtils::Install -e 'pm_to_blib({@ARGV}, '\''$(INST_LIB)/auto'\'', '\''$(PM_FILTER)'\'')' \
lib/Mail/IMAPClient/BodyStructure/Parse.pm blib/lib/Mail/IMAPClient/BodyStructure/Parse.pm \
lib/Mail/IMAPClient/Thread.pm blib/lib/Mail/IMAPClient/Thread.pm \
lib/Mail/IMAPClient/BodyStructure/Parse.grammar blib/lib/Mail/IMAPClient/BodyStructure/Parse.grammar \
lib/Mail/IMAPClient.pod blib/lib/Mail/IMAPClient.pod \
lib/Mail/IMAPClient/Thread.pod blib/lib/Mail/IMAPClient/Thread.pod \
lib/Mail/IMAPClient/MessageSet.pm blib/lib/Mail/IMAPClient/MessageSet.pm \
lib/Mail/IMAPClient/BodyStructure.pm blib/lib/Mail/IMAPClient/BodyStructure.pm \
lib/Mail/IMAPClient/Thread.grammar blib/lib/Mail/IMAPClient/Thread.grammar \
lib/Mail/IMAPClient/BodyStructure/Parse.pod blib/lib/Mail/IMAPClient/BodyStructure/Parse.pod \
lib/Mail/IMAPClient.pm blib/lib/Mail/IMAPClient.pm
$(NOECHO) $(TOUCH) pm_to_blib
# --- MakeMaker selfdocument section:
# --- MakeMaker postamble section:
# End.

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@ -1,661 +0,0 @@
package Mail::IMAPClient::BodyStructure;
use base 'Exporter';
use Mail::IMAPClient;
use Mail::IMAPClient::BodyStructure::Parse;
our $VERSION = '0.0.3';
our @EXPORT_OK = '$parser';
our $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} = "";
if ( exists $self->{bodystructure} ) {
$self->{_id} = 'HEAD' ;
} else {
$self->{_id} = 1;
}
$self->{_top} = 1;
bless $self, ref($class)||$class;
}
sub _get_thingy {
my $thingy = shift;
my $object = shift||(ref($thingy)?$thingy:undef);
unless ( defined($object) and ref($object) ) {
$@ = "No argument passed to $thingy method." ;
$^W and print STDERR "$@\n" ;
return undef;
}
unless ( "$object" =~ /HASH/
and exists($object->{$thingy})
) {
$@ = ref($object) .
" $object does not have " .
( $thingy =~ /^[aeiou]/i ? "an " : "a " ) .
"${thingy}. " .
( ref($object) =~ /HASH/ ? "It has " . join(", ",keys(%$object)) : "") ;
$^W and print STDERR "$@\n" ;
return undef;
}
return Unwrapped($object->{$thingy});
}
BEGIN {
foreach my $datum (qw/ bodytype bodysubtype bodyparms bodydisp bodyid
bodydesc bodyenc bodysize bodylang
envelopestruct textlines
/
) {
no strict 'refs';
*$datum = sub { _get_thingy($datum, @_); };
}
}
sub parts {
my $self = shift;
if ( exists $self->{PartsList} ) {
return wantarray ? @{$self->{PartsList}} : $self->{PartsList} ;
}
my @parts = ();
$self->{PartsList} = \@parts;
unless ( exists($self->{bodystructure}) ) {
$self->{PartsIndex}{1} = $self ;
@parts = ("HEAD",1);
return wantarray ? @parts : \@parts;
}
#@parts = ( 1 );
#} else {
foreach my $p ($self->bodystructure()) {
push @parts, $p->id();
$self->{PartsIndex}{$p->id()} = $p ;
if ( uc($p->bodytype()||"") eq "MESSAGE" ) {
#print "Part $parts[-1] is a ",$p->bodytype,"\n";
push @parts,$parts[-1] . ".HEAD";
#} else {
# print "Part $parts[-1] is a ",$p->bodytype,"\n";
}
}
#}
return wantarray ? @parts : \@parts;
}
sub oldbodystructure {
my $self = shift;
if ( exists $self->{_bodyparts} ) {
return wantarray ? @{$self->{_bodyparts}} : $self->{_bodyparts} ;
}
my @bodyparts = ( $self );
$self->{_id} ||= "HEAD"; # aka "0"
my $count = 0;
#print STDERR "Analyzing a ",$self->bodytype, " part which I think is part number ",
# $self->{_id},"\n";
my $dump = Data::Dumper->new( [ $self ] , [ 'bodystructure' ] );
$dump->Indent(1);
foreach my $struct (@{$self->{bodystructure}}) {
$struct->{_prefix} ||= $self->{_prefix} . +$count . "." unless $struct->{_top};
$struct->{_id} ||= $self->{_prefix} . $count unless $struct->{_top};
#if (
# uc($struct->bodytype) eq 'MULTIPART' or
# uc($struct->bodytype) eq 'MESSAGE'
#) {
#} else {
#}
push @bodyparts, $struct,
ref($struct->{bodystructure}) ? $struct->bodystructure : () ;
}
$self->{_bodyparts} = \@bodyparts ;
return wantarray ? @bodyparts : $self->bodyparts ;
}
sub bodystructure {
my $self = shift;
my @parts = ();
my $partno = 0;
my $prefix = $self->{_prefix} || "";
#print STDERR "Analyzing a ",($self->bodytype||"unknown ") ,
# " part which I think is part number ",
# $self->{_id},"\n";
my $bs = $self;
$prefix = "$prefix." if ( $prefix and $prefix !~ /\.$/);
if ( $self->{_top} ) {
$self->{_id} ||= "HEAD";
$self->{_prefix} ||= "HEAD";
$partno = 0;
for (my $x = 0; $x < scalar(@{$self->{bodystructure}}) ; $x++) {
$self->{bodystructure}[$x]{_id} = ++$partno ;
$self->{bodystructure}[$x]{_prefix} = $partno ;
push @parts, $self->{bodystructure}[$x] ,
$self->{bodystructure}[$x]->bodystructure;
}
} else {
$partno = 0;
foreach my $p ( @{$self->{bodystructure}} ) {
$partno++;
if (
! exists $p->{_prefix}
) {
$p->{_prefix} = "$prefix$partno";
}
$p->{_prefix} = "$prefix$partno";
$p->{_id} ||= "$prefix$partno";
#my $bt = $p->bodytype;
#if ($bt eq 'MESSAGE') {
#$p->{_id} = $prefix .
#$partno = 0;
#}
push @parts, $p, $p->{bodystructure} ? $p->bodystructure : ();
}
}
return wantarray ? @parts : \@parts;
}
sub id {
my $self = shift;
return $self->{_id} if exists $self->{_id};
return "HEAD" if $self->{_top};
#if ($self->bodytype eq 'MESSAGE') {
# return
#}
if ($self->{bodytype} eq 'MULTIPART') {
my $p = $self->{_id}||$self->{_prefix} ;
$p =~ s/\.$//;
return $p;
} else {
return $self->{_id} ||= 1;
}
}
sub Unwrapped {
my $unescape = Mail::IMAPClient::Unescape(@_);
$unescape =~ s/^"(.*)"$/$1/ if defined($unescape);
return $unescape;
}
package Mail::IMAPClient::BodyStructure::Part;
@ISA = qw/Mail::IMAPClient::BodyStructure/;
package Mail::IMAPClient::BodyStructure::Envelope;
@ISA = qw/Mail::IMAPClient::BodyStructure/;
sub new {
my $class = shift;
my $envelope = shift;
my $self = $Mail::IMAPClient::BodyStructure::parser->envelope($envelope);
return $self;
}
sub _do_accessor {
my $datum = shift;
if (scalar(@_) > 1) {
return $_[0]->{$datum} = $_[1] ;
} else {
return $_[0]->{$datum};
}
}
# the following for loop sets up accessor methods for
# the object's address attributes:
sub _mk_address_method {
my $datum = shift;
my $method1 = $datum . "_addresses" ;
no strict 'refs';
*$method1 = sub {
my $self = shift;
return undef unless ref($self->{$datum}) eq 'ARRAY';
my @list = map {
my $pn = $_->personalname ;
$pn = "" if $pn eq 'NIL' ;
( $pn ? "$pn " : "" ) .
"<" .
$_->mailboxname .
'@' .
$_->hostname .
">"
} @{$self->{$datum}} ;
if ( $senderFields{$datum} ) {
return wantarray ? @list : $list[0] ;
} else {
return wantarray ? @list : \@list ;
}
};
}
BEGIN {
for my $datum (
qw( subject inreplyto from messageid bcc date replyto to sender cc )
) {
no strict 'refs';
*$datum = sub { _do_accessor($datum, @_); };
}
my %senderFields = map { ($_ => 1) } qw/from sender replyto/ ;
for my $datum (
qw( from bcc replyto to sender cc )
) {
_mk_address_method($datum);
}
}
package Mail::IMAPClient::BodyStructure::Address;
@ISA = qw/Mail::IMAPClient::BodyStructure/;
for my $datum (
qw( personalname mailboxname hostname sourcename )
) {
no strict 'refs';
*$datum = sub { return $_[0]->{$datum}; };
}
1;
__END__
=head1 NAME
Mail::IMAPClient::BodyStructure - Perl extension to Mail::IMAPClient to facilitate
the parsing of server responses to the FETCH BODYSTRUCTURE and FETCH ENVELOPE
IMAP client commands.
=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 $new (@recent) {
my $struct = Mail::IMAPClient::BodyStructure->new(
$imap->fetch($new,"bodystructure")
);
print "Msg $new (Content-type: ",$struct->bodytype,"/",$struct->bodysubtype,
") contains these parts:\n\t",join("\n\t",$struct->parts),"\n\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
=head1 SEE ALSO
perl(1), Mail::IMAPClient, and RFC2060. See also Parse::RecDescent if you want
to understand the internals of this module.
=cut
1;

View File

@ -1,288 +0,0 @@
# Directives
# ( none)
# Start-up Actions
{
my $subpartCount = 0;
my $partCount = 0;
}
#
# 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" }
NUMBER: /^(\d+)/ { $return = $item[1]; $return||defined($return);}
# Strings:
SINGLE_QUOTED_STRING: "'" /(?:\\'|[^'])*/ "'" {
$return = $item{__PATTERN1__} ;
$return||defined($return);
}
DOUBLE_QUOTED_STRING: '"' /(?:\\"|[^"])*/ '"' {
$return = $item{__PATTERN1__} ;
$return||defined($return);
}
QUOTED_STRING: DOUBLE_QUOTED_STRING | SINGLE_QUOTED_STRING {
$return = $item{DOUBLE_QUOTED_STRING}||$item{SINGLE_QUOTED_STRING} ;
$return||defined($return);
}
BARESTRING: ...!/^[)('"]/ /^(?!\(|\))(?:\\ |\S)+/ {
$return = $item{__PATTERN1__} ; $return||defined($return);
}
STRING: QUOTED_STRING | BARESTRING {
$return = $item{QUOTED_STRING}||$item{BARESTRING} ;
$return||defined($return);
}
OLDSTRING: /^"((?:[^"\\]|\\.)*)"/ | /^([^ \(\)]+)/
{ $item{__PATTERN1__} =~ s/^"(.*)"$/$1/;
$return = $item{__PATTERN1__} || $item{__PATTERN2__} ;
$return||defined($return);
}
#BARESTRING: /^[^(]+\s+(?=\()/
# { $return = $item[1] ; $return||defined($return);}
textlines: NIL | NUMBER { $return = $item[1] || $item[2]; $return||defined($return); }
rfc822message: MESSAGE RFC822 { $return = "MESSAGE RFC822" }
key: STRING { $return = $item{STRING} ; $return||defined($return);}
value: NIL | '(' <commit> kvpair(s) ')'| NUMBER | STRING
{ $return = $item{NIL} ||
$item{NUMBER} ||
$item{STRING} ||
{ map { (%$_) } @{$item{'kvpair(s)'}} } ;
$return||defined($return);
}
kvpair: ...!")" key value
{ $return = { $item{key} => $item{value} }; $return||defined($return);}
bodytype: STRING
{ $return = $item{STRING} ; $return||defined($return);}
bodysubtype: PLAIN | HTML | NIL | STRING
{ $return = $item{PLAIN}||$item{HTML}||$item{NIL}||$item{STRING} ;
$return||defined($return);
}
bodyparms: NIL | '(' kvpair(s) ')'
{
$return = $item{NIL} ||
{ map { (%$_) } @{$item{'kvpair(s)'}} };
$return || defined($return);
}
bodydisp: NIL | '(' kvpair(s) ')'
{
$return = $item{NIL} ||
{ map { (%$_) } @{$item{'kvpair(s)'}} };
$return || defined($return);
}
bodyid: ...!/[()]/ NIL | STRING
{ $return = $item{NIL} || $item{STRING} ; $return||defined($return);}
bodydesc: ...!/[()]/ NIL | STRING
{ $return = $item{NIL} || $item{STRING} ; $return||defined($return);}
bodyenc: NIL | STRING | '(' kvpair(s) ')'
{
$return = $item{NIL} ||
$item{STRING} ||
{ map { (%$_) } @{$item{'kvpair(s)'}} };
$return||defined($return);
}
bodysize: ...!/[()]/ NIL | NUMBER
{ $return = $item{NIL} || $item{NUMBER} ;$return||defined($return);}
bodyMD5: NIL | STRING
{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}
bodylang: NIL | STRING | "(" STRING(s) ")"
{ $return = $item{NIL} || $item{'STRING(s)'} ;$return||defined($return);}
personalname: NIL | STRING
{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}
sourceroute: NIL | STRING
{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}
mailboxname: NIL | STRING
{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}
hostname: NIL | STRING
{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}
addressstruct: "(" personalname sourceroute mailboxname hostname ")"
{ $return = {
personalname => $item{personalname} ,
sourceroute => $item{sourceroute} ,
mailboxname => $item{mailboxname} ,
hostname => $item{hostname} ,
} ;
bless($return, "Mail::IMAPClient::BodyStructure::Address");
}
subject: NIL | STRING
{
$return = $item{NIL} || $item{STRING} ;
$return||defined($return);
}
inreplyto: NIL | STRING
{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}
messageid: NIL | STRING
{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}
date: NIL | STRING
{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}
cc: NIL | "(" addressstruct(s) ")"
{ $return = $item{NIL} || $item{'addressstruct(s)'} }
bcc: NIL | "(" addressstruct(s) ")"
{ $return = $item{NIL} || $item{'addressstruct(s)'} }
from: NIL | "(" addressstruct(s) ")"
{ $return = $item{NIL} || $item{'addressstruct(s)'} }
replyto: NIL | "(" addressstruct(s) ")"
{ $return = $item{NIL} || $item{'addressstruct(s)'} }
sender: NIL | "(" addressstruct(s) ")"
{ $return = $item{NIL} || $item{'addressstruct(s)'} }
to: NIL | "(" addressstruct(s) ")"
{ $return = $item{NIL} || $item{'addressstruct(s)'} }
envelopestruct: "(" date subject from sender replyto to cc bcc inreplyto messageid ")"
{ $return = {};
foreach my $what (qw/date subject from sender replyto to cc bcc inreplyto messageid/) {
$return->{$what} = $item{$what};
}
bless $return, "Mail::IMAPClient::BodyStructure::Envelope";
$return||defined($return);
}
basicfields: bodysubtype bodyparms bodyid(?)
bodydesc(?) bodyenc(?)
bodysize(?) {
$return = {
bodysubtype => $item{bodysubtype} ,
bodyparms => $item{bodyparms} ,
bodyid => (ref $item{'bodyid(?)'} ?
$item{'bodyid(?)'}[0] :
$item{'bodyid(?)'} ),
'bodydesc' => (ref $item{'bodydesc(?)'} ?
$item{'bodydesc(?)'}[0] :
$item{'bodydesc(?)'} ),
'bodyenc' => (ref $item{'bodyenc(?)'} ?
$item{'bodyenc(?)'}[0] :
$item{'bodyenc(?)'} ),
'bodysize' => (ref $item{'bodysize(?)'} ?
$item{'bodysize(?)'}[0] :
$item{'bodysize(?)'} ),
};
$return;
}
textmessage: TEXT <commit> basicfields textlines(?) bodyMD5(?) bodydisp(?) bodylang(?)
{
$return = $item{basicfields}||{};
$return->{bodytype} = 'TEXT';
foreach my $what (qw/textlines(?) bodyMD5(?) bodydisp(?) bodylang(?)/) {
my $k = $what; $k =~ s/\(\?\)$//;
ref($item{$what}) and $return->{$k} = $item{$what}[0];
}
$return||defined($return);
}
othertypemessage: bodytype basicfields bodyparms(?) bodydisp(?) bodylang(?)
{ $return = {};
foreach my $what (qw/bodytype bodyparms(?) bodydisp(?) bodylang(?)/) {
my $k = $what; $k =~ s/\(\?\)$//;
$return->{$k} = ref($item{$what})? $item{$what}[0] : $item{$what} ;
}
while ( my($k,$v) = each %{$item{basicfields}} ) { $return->{$k} = $v }
$return||defined($return);
}
messagerfc822message:
rfc822message <commit> bodyparms bodyid bodydesc bodyenc bodysize
envelopestruct bodystructure textlines
bodyMD5(?) bodydisp(?) bodylang(?)
{
$return = {};
foreach my $what (qw/ bodyparms bodyid bodydesc bodyenc bodysize
envelopestruct bodystructure textlines
bodyMD5(?) bodydisp(?) bodylang(?)
/
) {
my $k = $what; $k =~ s/\(\?\)$//;
$return->{$k} = ref $item{$what} =~ 'ARRAY'?
$item{$what}[0] : $item{$what};
}
while ( my($k,$v) = each %{$item{bodystructure}[0]} ) { $return->{$k} = $v }
while ( my($k,$v) = each %{$item{basicfields}} ) { $return->{$k} = $v }
$return->{bodytype} = "MESSAGE" ;
$return->{bodysubtype}= "RFC822" ;
$return||defined($return);
}
subpart: "(" part ")"
{
$return = $item{part} ;
$return||defined($return);
} <defer: ++$subpartCount;>
part: subpart(s) <commit> basicfields
bodyparms(?) bodydisp(?) bodylang(?)
<defer: $subpartCount = 0>
{
$return = bless($item{basicfields},
"Mail::IMAPClient::BodyStructure");
$return->{bodytype} = "MULTIPART";
$return->{bodystructure} = $item{'subpart(s)'};
foreach my $b (qw/bodyparms(?) bodydisp(?) bodylang(?)/) {
my $k = $b; $k =~ s/\(\?\)$//;
$return->{$k} = ref($item{$b}) ? $item{$b}[0] : $item{$b};
}
$return||defined($return) ;
}
| textmessage
{
$return = bless $item{textmessage}, "Mail::IMAPClient::BodyStructure";
$return||defined($return);
}
| messagerfc822message
{
$return = bless $item{messagerfc822message}, "Mail::IMAPClient::BodyStructure";
$return||defined($return);
}
| othertypemessage
{
$return = bless $item{othertypemessage}, "Mail::IMAPClient::BodyStructure";
$return||defined($return);
}
bodystructure: "(" part(s) ")"
{
$return = $item{'part(s)'} ;
$return||defined($return);
}
start: /.*\(.*BODYSTRUCTURE \(/i part(1) /\).*\)\r?\n?/
{
#print STDERR "item = ",Data::Dumper->Dump([\%item],['$item']);
$return = $item{'part(1)'}[0];
$return||defined($return);
}
envelope: /.*\(.*ENVELOPE/ envelopestruct /.*\)/ {
$return = $item{envelopestruct} ;
$return||defined($return) ;
}

View File

@ -1,17 +0,0 @@
=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.
=cut

View File

@ -1,285 +0,0 @@
package Mail::IMAPClient::MessageSet;
use warnings;
use strict;
=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($)
{ map { /(\d+)\:(\d+)/ ? ($1..$2) : $_ }
split /\,/, shift;
}
sub rem
{ my $self = shift;
my %delete = map { ($_ => 1) } map { _unfold_range $_ } @_;
$$self = $self->range(map {$delete{$_} ? () : $_ } $self->unfold);
$self;
}
sub cat
{ my $self = shift;
$$self = $self->range($$self, @_);
$self;
}
sub range
{ my $class = shift;
return $_[0]
if @_== 1 && ref $_[0] eq __PACKAGE__;
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 ];
}
=head2 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
=head2 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;

View File

@ -1,18 +0,0 @@
# 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;
}

View File

@ -1,21 +0,0 @@
package Mail::IMAPClient::Thread;
$Mail::IMAPClient::Thread::VERSION = "0.0.1";
$Mail::IMAPClient::Thread::VERSION = "0.0.1";
=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.
=cut

View File

@ -1,5 +0,0 @@
server=localhost
user=tata@est.belle
passed=XXXXXXXXX
port=143
authmechanism=LOGIN

View File

@ -1,16 +1,92 @@
Revision History for Perl extension Mail::IMAPClient.
version 2.99_02:
== Revision History for Mail::IMAPClient
All changes from 2.99_01 upward are made by Mark Overmeer. The changes
before that are applied by David Kernen
version 3.00: Wed Nov 28 09:56:54 CET 2007
Fixes:
- "${peek}[]" should be "$peek\[]" for perl 5.6.1
rt.cpan.org#30900 [Gerald Richter]
version 2.99_07: Wed Nov 14 09:54:46 CET 2007
Fixes:
- forgot to update the translate grammar.
version 2.99_06: Mon Nov 12 23:21:58 CET 2007
Fixes:
- body structure can have any number of optional parameters.
Patch by [Gerald Richter].
- get_bodystructure did not take the output correctly [Gerald Richter]
- parser of body-structure did not handle optional body parameters
Patch by [Gerald Richter], rt.cpan.org#4479 [Geoffrey D. Bennet]
version 2.99_05: Mon Nov 12 00:17:42 CET 2007
Fixes:
- pod error in MessageSet.pm
- folders() without argument failed. [Gerald Richter]
Improvements:
- better use of format syntax in date formatting.
- Rfc2060_datetime also contains the time.
- append_file() now has options to pass flags and time of file
in one go. [Thomas Jarosch]
version 2.99_04: Sat Nov 10 20:55:18 CET 2007
Changes:
- Simplified initiation of IMAP object with own Socket with a new
option: RawSocket [Flavio Poletti]
Fixes:
- fixed read_line [Flavio Poletti]
- fixed test-run in t/basic.t [Flavio Poletti]
version 2.99_03: Thu Nov 1 12:36:44 CET 2007
Fixes:
- Remove note about optional Parse::RecDescent by Makefile.PL;
it is not optional anymore
Improvements:
- When syswrite() returns 0, that might be caused by an error
as well. Take the timeout/maxtemperrors track.
rt.cpan.org#4701 [C Meyer]
- add NTLM support for logging-in, cleanly intergrated. Requires
the user to install Authen::NTLM.
version 2.99_02: Fri Oct 26 11:47:35 CEST 2007
The whole Mail::IMAPClient was rewritten, hopefully without
breaking the interface. Nearly no line is untouched.
breaking the interface. Nearly no line was untouched.
The following things happened:
- use warnings, use strict everywhere
- removed many lines which were commented out, over the years
- $self->_debug if $self->Debug checked debug flag twice
- $self->LogError calls where quite inconsequent wrt $@ and carp
- consequent layout, changed sporadic tabs in blanks
- consequent calling convensions
- \0x0d\0x0a is always \r\n
- zillions of minor syntactical improvements
- a few major algorithmic rewrites to simplify the code, still
many oppotunities for improvements.
@ -19,12 +95,12 @@ version 2.99_02:
shorter, and certainly better understandable!
- fixed many potential bugs.
- labeled some weird things with #????
Over 900 lines and 25kB smaller in size.
Over 1000 lines (30%!) and 25kB smaller in size
Needs to be tested!!!! Volunteers?
Fixes:
- Exchange 2007 only works with new parameter: Ignoresizeerrors
- Exchange 2007 only works with new parameter: IgnoreSizeErrors
rt.cpan.org#28933 [Dregan], #5297 [Kevin P. Fleming]
- Passed socket did not get selected.
@ -34,7 +110,7 @@ version 2.99_02:
http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=401144
- Seperator not correctly extracted from list command.
rt.cpan.org#9236 [Eugene Koontz]
rt.cpan.org#9236 [Eugene Koontz], #4662 [Rasjid]
- migrate() Massage'd foldername twice
rt.cpan.org#20703 [Peter J. Holzer]
@ -62,6 +138,17 @@ version 2.99_02:
- overload in MessageSet treated the 3rd arg (reverse) as
message-set.
- do not send the password on a different line as the username
in LOGIN. Suggested by many people, amongst them
rt.cpan.org#4449 [Lars Uffmann]
- select() with $timeout==0 (no timeout) returns immediately.
Should be 'undef' as 4th select parameter.
rt.cpan.org#5962 [Colin Robertson] and [Jules Agee]
- examine() remembers Massage()d folder name, not the unescaped
version. rt.cpan.org#7859 [guest]
Improvements:
- PREAUTH support by rt.cpan.org#17693 [Danny Siu]
@ -81,6 +168,10 @@ version 2.99_02:
- removed Bodystructure.grammar and IMAPClient.cleanup from dist.
- reworked Bodystructure and MessageSet as well.
- EnableServerResponseInLiteral now autodetect (hence ignored)
version 2.99_01:
After 4 years of silence, Mark Overmeer took maintenance. David
@ -390,94 +481,109 @@ module will allow you to use NTML authentication with Mail::IMAPClient connectio
Also changed the authenticate method so that it will work with Authen::NTML without
the update mentioned in NTLM::Authen's README.
Added a second example on using the new migrate method, migrate_mail2.pl. This example
demonstrates more advanced techniques then the first, such as using the separator method
to massage folder names and stuff like that.
Added a second example on using the new migrate method,
migrate_mail2.pl. This example demonstrates more advanced techniques
then the first, such as using the separator method to massage folder
names and stuff like that.
Added support for the IMAP THREAD extension. Added Mail::IMAPClient::Thread.pm to support
this. (This pm file is generated during make from Thread/Thread.grammar.) This new
function should be considered experimental. Note also that this extension has nothing
to do with threaded perl or anything like that. This is still on the TODO list.
Added support for the IMAP THREAD extension. Added
Mail::IMAPClient::Thread.pm to support this. (This pm file is generated
during make from Thread/Thread.grammar.) This new function should be
considered experimental. Note also that this extension has nothing to do
with threaded perl or anything like that. This is still on the TODO list.
Updated the search, sort, and thread methods to set $@ to "" before attempting their
respective operations so that text in $@ won't be left over from some other error and
therefore always indicative of an error in search, sort, or thread, respectively.
Updated the search, sort, and thread methods to set $@ to "" before
attempting their respective operations so that text in $@ won't be left
over from some other error and therefore always indicative of an error
in search, sort, or thread, respectively.
Made many many tweaks to the documentation, including adding more examples (albeit
simple ones) and fixing some errors.
Made many many tweaks to the documentation, including adding more examples
(albeit simple ones) and fixing some errors.
Changes in version 2.2.0
------------------------
Fixed some tests so that they are less likely to give false negatives. For example, test
41 would fail if the test account happened to have an empty inbox.
Fixed some tests so that they are less likely to give false negatives. For
example, test 41 would fail if the test account happened to have an
empty inbox.
Made improvements to Mail::IMAPClient::BodyStructure and renamed Mail::IMAPClient::Parse
to Mail::IMAPClient::BodyStructure::Parse. (This should be transparent to apps since the
...Parse helper module is used by BodyStructure.pm only.) I also resumed my earlier practice
of using ...Parse.pm from within BodyStructure.pm to avoid the overhead of compiling the
grammar every time you use BodyStructure.pm. (Parse.pm is just the output from saving
the compiled Parse::RecDescent grammar.) In a related change, I've moved the grammar into
its own file (Parse.grammar) and taught Makefile.PL how to write a Makefile that converts
the .grammar file into a .pm file. This work includes a number of fixes to how a body structure
gets parsed and the parts list returned by the parts method, among other things. I was able
to successfully parse every bodystructure I could get my hands on, and that's a lot.
Made improvements to Mail::IMAPClient::BodyStructure and renamed
Mail::IMAPClient::Parse to Mail::IMAPClient::BodyStructure::Parse. (This
should be transparent to apps since the ...Parse helper module is
used by BodyStructure.pm only.) I also resumed my earlier practice of
using ...Parse.pm from within BodyStructure.pm to avoid the overhead of
compiling the grammar every time you use BodyStructure.pm. (Parse.pm is
just the output from saving the compiled Parse::RecDescent grammar.) In a
related change, I've moved the grammar into its own file (Parse.grammar)
and taught Makefile.PL how to write a Makefile that converts the .grammar
file into a .pm file. This work includes a number of fixes to how a body
structure gets parsed and the parts list returned by the parts method,
among other things. I was able to successfully parse every bodystructure
I could get my hands on, and that's a lot.
Also added a bunch of new methods to Mail::IMAPClient::BodyStructure and its child classes.
The child classes don't even have files of their own yet; they still live with
their parent class! Notable amoung these changes is support for the FETCH ENVELOPE IMAP
command (which was easy to build in once the BODYSTRUCTURE stuff was working) and some
helper modules to get at the envelope info (as well as envelope information for
MESSAGE/RFC822 attachments from the BODYSTRUCTURE output). Have a look at the
documentation for Mail::IMAPClient::BodyStructure for more information.
Also added a bunch of new methods to Mail::IMAPClient::BodyStructure
and its child classes. The child classes don't even have files of their
own yet; they still live with their parent class! Notable amoung these
changes is support for the FETCH ENVELOPE IMAP command (which was easy
to build in once the BODYSTRUCTURE stuff was working) and some helper
modules to get at the envelope info (as well as envelope information
for MESSAGE/RFC822 attachments from the BODYSTRUCTURE output). Have a
look at the documentation for Mail::IMAPClient::BodyStructure for more
information.
Fixed a bug in the folders method regarding quotes and folders with spaces in the names. The
bug must have been around for a while but rarely manifested itself because of the way
methods that take folder name arguments always try to get the quoting right anyway but
it was still there. Noticing it was the hard part (none of you guys reported it to me!).
Fixed a bug in the folders method regarding quotes and folders with
spaces in the names. The bug must have been around for a while but
rarely manifested itself because of the way methods that take folder
name arguments always try to get the quoting right anyway but it was
still there. Noticing it was the hard part (none of you guys reported
it to me!).
Fixed a bug reported by Jeremy Hinton regarding how the search method handles dates. It was
screwing it all up but it should be much better now.
Fixed a bug reported by Jeremy Hinton regarding how the search method
handles dates. It was screwing it all up but it should be much better now.
Added the get_envelope method which is like the get_bodystructure method except for in ways
in which it's different.
Added the get_envelope method which is like the get_bodystructure method
except for in ways in which it's different.
Added the messages method (a suggestion from Danny Carroll), which is functionally
equivalent to $imap->search("ALL") but easier to type.
Added the messages method (a suggestion from Danny Carroll), which is
functionally equivalent to $imap->search("ALL") but easier to type.
Added new arguments to the bodypart_string method so that you can get just a part of a part
(or a part of a subpart for that matter...) I did this so I could verify BodyStructure's
parts method by fetching the first few bytes of a part (just to prove that the part has a
valid part number).
Added new arguments to the bodypart_string method so that you can get
just a part of a part (or a part of a subpart for that matter...) I did
this so I could verify BodyStructure's parts method by fetching the first
few bytes of a part (just to prove that the part has a valid part number).
Added new tests to test the migrate function and to do more thorough testing of the
BodyStructure stuff. Also added a test to make sure that searches that come up empty handed
return an undef instead of an empty array (reference), regardless of context. Which reminds
me...
Added new tests to test the migrate function and to do more thorough
testing of the BodyStructure stuff. Also added a test to make sure that
searches that come up empty handed return an undef instead of an empty
array (reference), regardless of context. Which reminds me...
Fixed a bug in which searches that don't find any hits would return a reference to an empty
array instead of undef when called in a scalar context. This bug sounds awfully familiar,
which is why I added the test mentioned above...
Fixed a bug in which searches that don't find any hits would return a
reference to an empty array instead of undef when called in a scalar
context. This bug sounds awfully familiar, which is why I added the test
mentioned above...
Changes in version 2.1.5
------------------------
Fixed the migrate method so now it not only works, but also works as originally
planned (i.e. without requiring source messages to be read entirely into memory).
If the message is smaller than the value in the Buffer parameter (default is 4096) then
a normal $imap2->append($folder,$imap1->message_string) is done. However, if the message
is over the buffer size then it is retrieved and written a bufferful at a time until the
whole message has been read and sent. (The receiving server still expects the entire
message at once, but it will have to wait because the message is being read from the
source in smaller chunks and then written to the destination a chunk at a time.)
This needs extensive testing before I'd be willing to trust it (or at least extensive
logging so you know when something has gone terribly wrong) and I consider this method
to be in BETA in this release. (Numerous people wrote complaining that migrate didn't
work, and some even included patches to make it work, but the real bug in the last
release wasn't that migrate was broken but that I had inadvertently included the pod
for the method which I knew perfectly well was not ready to be released. My apologies
to anyone who was affected by this.) The migrate method does seem to work okay on
iPlanet (i.e. Netscape) Messenger Server 4.x. Please let me know if you have any
issues on this or any other platform.
Fixed the migrate method so now it not only works, but also works
as originally planned (i.e. without requiring source messages to
be read entirely into memory). If the message is smaller than
the value in the Buffer parameter (default is 4096) then a normal
$imap2->append($folder,$imap1->message_string) is done. However, if
the message is over the buffer size then it is retrieved and written a
bufferful at a time until the whole message has been read and sent. (The
receiving server still expects the entire message at once, but it
will have to wait because the message is being read from the source in
smaller chunks and then written to the destination a chunk at a time.)
This needs extensive testing before I'd be willing to trust it (or at
least extensive logging so you know when something has gone terribly
wrong) and I consider this method to be in BETA in this release. (Numerous
people wrote complaining that migrate didn't work, and some even included
patches to make it work, but the real bug in the last release wasn't
that migrate was broken but that I had inadvertently included the pod for
the method which I knew perfectly well was not ready to be released. My
apologies to anyone who was affected by this.) The migrate method does
seem to work okay on iPlanet (i.e. Netscape) Messenger Server 4.x. Please
let me know if you have any issues on this or any other platform.
Added a new example, migrate_mbox.pl, which will demonstrate the migrate method.

View File

@ -1,9 +1,10 @@
Changes
COPYRIGHT
Todo
Makefile.PL
Changes
INSTALL
MANIFEST
Makefile.PL
README
Todo
examples/build_dist.pl
examples/build_ldif.pl
examples/cleanTest.pl
@ -17,23 +18,22 @@ examples/migrate_mail2.pl
examples/migrate_mbox.pl
examples/populate_mailbox.pl
examples/sharedFolder.pl
INSTALL
sample.perldb
test_template.txt
prepare_dist
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/BodyStructure.pm
lib/Mail/IMAPClient/MessageSet.pm
lib/Mail/IMAPClient.pm
lib/Mail/IMAPClient.pod
lib/Mail/IMAPClient/Thread.grammar
lib/Mail/IMAPClient/Thread.pm
lib/Mail/IMAPClient/Thread.pod
prepare_dist
sample.perldb
t/basic.t
t/bodystructure.t
t/messageset.t
t/thread.t
t/pod.t
t/thread.t
test_template.txt
META.yml Module meta-data (added by MakeMaker)

View File

@ -1,9 +1,9 @@
--- #YAML:1.0
name: Mail-IMAPClient
version: 2.99_02
version: 3.00
abstract: IMAP4 client library
license: ~
generated_by: ExtUtils::MakeMaker version 6.32
generated_by: ExtUtils::MakeMaker version 6.36_01
distribution_type: module
requires:
Carp: 0

View File

@ -2,14 +2,6 @@ use ExtUtils::MakeMaker;
use warnings;
use strict;
eval "require Parse::RecDescent";
$@ and warn <<'__NO_BODY';
*** NOTE ***
Unable to find and load Parse::RecDescent.
Mail::IMAPClient will be installed without support for the
get_bodystructure() method.
__NO_BODY
WriteMakefile
( NAME => 'Mail::IMAPClient',
, ABSTRACT => 'IMAP4 client library'
@ -87,23 +79,24 @@ __INTRO
print TST "passed=$passed\n";
my $port = prompt "\nPlease provide the port to connect to on $server"
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', "
. "which uses the plain text LOGIN command)";
. "on $server to\nrun the test (default is LOGIN)";
chomp $authmech;
$authmech ||= 'LOGIN';
print TST "authmechanism=$authmech\n";
close TST;
print <<'__THANKS';
Gracias! The information you provided (including the password!) has
been stored in test.txt and should be removed (either by hand or by
been stored in test.txt and SHOULD BE REMOVED (either by hand or by
'make clean') after testing.
__THANKS

View File

@ -1,10 +1,3 @@
package Mail::IMAPClient;
# $Id: IMAPClient.pod,v 20001010.1 2003/06/12 21:35:53 dkernen Exp $
$Mail::IMAPClient::VERSION = '2.2.7';
$Mail::IMAPClient::VERSION = '2.2.7'; # do it twice to make sure it takes
=head1 NAME
Mail::IMAPClient - An IMAP Client API
@ -48,7 +41,7 @@ object's status, see the section labeled L<"Status Methods">, below.
RFC2060 defines two commands for authenticating to an IMAP server:
LOGIN for plain text authentication and AUTHENTICATE for more secure
authentication mechanisms. Currently Mail::IMAPClient supports
CRAM-MD5, LOGIN, and PLAIN (SASL) authentication.
CRAM-MD5, LOGIN, PLAIN (SASL), and NTLM authentication.
There are also a number of methods and parameters that you can use to
build your own authentication mechanism. Since this topic is a source of
@ -119,13 +112,33 @@ B<authenticate> on your behalf then you can call it yourself. Instead
of setting an I<Authmechanism> you can just pass the authmechanism as
the first argument to AUTHENTICATE.
=item Socket Parameter
=item Socket and RawSocket Parameters
The I<Socket> parameter holds a reference to the socket
connection. Normally this is set for you by the L<connect> method, but
if you are implementing an advanced authentication technique you may
choose to set up your own socket connection and then set this parameter
manually, bypassing the B<connect> method completely.
Both parameters hold a reference to the socket connection. Normally this
is set for you by the L<connect> method, but if you are implementing
an advanced authentication technique you may choose to set up your own
socket connection and then set this parameter manually, bypassing the
B<connect> method completely. This is also useful if you want to use
L<IO::Socket::INET> alternatives, like L<IO::Socket::SSL>.
The I<RawSocket> parameter simply records the socket to use for future
operations, without attempting any interaction on it. In this case, you
have to be sure to handle all the preliminar operations and to manually
set the B<Mail::IMAPClient> object in sync with its actual status with
respect to this socket (see below for additional parameters regarding
this, especially the I<State> parameter).
The I<Socket> parameter, instead, also attempts to carry on preliminar
phases if the conditions apply. If both parameters are present, this
takes the precedence over I<RawSocket>. It is primarily used to
provide an alternative socket for communications, e.g. to use
L<IO::Socket::SSL> instead of L<IO::Socket::INET> used by L<connect>
by default.
B<PLEASE NOTE>
As of version 2.99_04 of this module, the I<Socket> parameter has
changed semantics to make it more "DWIM". The I<RawSocket> parameter was
introduced as a replacement for the I<Socket> parameter in older version.
=item State, Server, Proxy, Password, and User Parameters
@ -155,8 +168,8 @@ to a subroutine. The L<login> method will use this as the callback
argument to the B<authenticate> method if the I<Authmechanism> and
I<Authcallback> parameters are both set. If you set I<Authmechanism>
but not I<Authcallback> then the default callback for your mechanism
will be used. Unfortunately only the CRAM-MD5 authentication mechanism
has a default callback; in every other case not supplying the callback
will be used. CRAM-MD5, PLAIN (SASL), and NTLM authentication mechanisms
have a default callback; in every other case not supplying the callback
results in an error.
Most advanced authentication mechanisms require a challenge-response
@ -666,8 +679,8 @@ Example:
my $new_msg_uid = $imap->append_file(
$folder,
$filename
[ , $input_record_separator ] # optional (not arrayref)
$filename,
[$input_record_separator, flags, date] # optional
) or die "Could not append_file: $@\n";
The B<append_file> method adds a message to the specified folder. It
@ -702,10 +715,9 @@ depending on whether you supplied that optional third argument).
Example:
# brackets indicate optional arguments (not array refs):
my $uid = $imap->append_string( $folder, $text [ , $flags [ , $date ] ])
or die "Could not append_string: $@\n";
# brackets indicate optional arguments (not array refs):
my $uid = $imap->append_string( $folder, $text [,$flags [,$date ] ])
or die "Could not append_string: $@\n";
The B<append_string> method adds a message to the specified folder. It
requires two arguments, the name of the folder to append the message
@ -2363,7 +2375,7 @@ will B<Mail::IMAPClient>.
If you'd like, you can use the L<Rfc2060_date> method to convert from
epoch time (as returned by L<time|perlfunc/time>) into an RFC2060 date
specification.
specification.
=cut
@ -3057,28 +3069,7 @@ to a true value.
=head2 EnableServerResponseInLiteral
Example:
$EnableServerResponseInLiteral = $imap->EnableServerResponseInLiteral();
# or:
$imap->EnableServerResponseInLiteral($new_value);
The I<EnableServerResponseInLiteral> parameter tells
B<Mail::IMAPClient> to expect server responses to be embedded in
literal strings. Usually literal strings contain only message data, not
server responses. I have seen at least one IMAP server implementation
though that includes the final <tag> OK response in the literal data.
If your server does this then your script will hang whenever you try to
read literal data, such as message text, or even output from the
L<folders> method if some of your folders have special characters such
as double quotes or sometimes spaces in the name.
I am pretty sure this behavior is not RFC2060 compliant so I am
dropping it by default. In fact, I encountered the problem a long time
ago when still new to IMAP and may have imagined the whole thing.
However, if your scripts hang running certain methods you may want to
at least try enabling this parameter by passing the eponymous method a
true value.
Removed in 2.99_01 (now autodetect)
=head2 Fast_io
@ -3250,6 +3241,46 @@ will continue to return an array reference when called in scalar context.
This parameter has no affect on the B<search> method when B<search>
is called in a list context.
=head2 RawSocket
Example:
$socket = $imap->RawSocket;
# or:
$imap->RawSocket($socketh);
The I<RawSocket> method can be used to obtain the socket handle of the
current connection (say, to do I/O on the connection that is not
otherwise supported by B<Mail::IMAPClient>) or to replace the current
socket with a new handle (for instance an SSL handle, see
L<IO::Socket::SSL>, but be sure to see the L<Socket> method as well).
If you supply a socket handle yourself, either by doing something like:
$imap=Mail::IMAPClient->new(RawSocket => $sock, User => ... );
or by doing something like:
$imap = Mail::IMAPClient->new(User => $user,
Password => $pass, Server => $host);
# blah blah blah
$imap->RawSocket($ssl);
then it will be up to you to establish the connection AND to
authenticate, either via the L<login> method, or the fancier
L<authenticate>, or, since you know so much anyway, by just doing raw
I/O against the socket until you're logged in. If you do any of this
then you should also set the L<State> parameter yourself to reflect the
current state of the object (i.e. Connected, Authenticated, etc).
Note that no operation will be attempted on the socket when this method
is called. In particular, after the TCP connections towards the IMAP
server is established, the protocol mandates the server to send an
initial greeting message, and you will have to explicitly cope with
this message before doing any other operation, e.g. trying to call
L<login>. Caveat emptor.
For a more DWIM approach to setting the socket see L<Socket>.
=head2 Readmethod IMAP, BUFFER, LENGTH, OFFSET
This parameter, if supplied, should contain a reference to a subroutine
@ -3313,6 +3344,10 @@ Example:
=head2 Socket
B<PLEASE NOT>
The semantics of this method has changed as of version 2.99_04 of this module.
If you need the old semantics, you now have to use L<RawSocket>.
Example:
$Socket = $imap->Socket();
@ -3327,20 +3362,56 @@ IO::Socket::SSL).
If you supply a socket handle yourself, either by doing something like:
$imap=Mail::IMAPClient->new(Socket=>$sock, User => ... );
$imap = Mail::IMAPClient->new(Socket => $sock, User => ... );
or by doing something like:
$imap=Mail::IMAPClient->new(User => $user, Password => $pass, Server => $host);
# blah blah blah
$imap = Mail::IMAPClient->new(User => $user,
Password => $pass, Server => $host);
$imap->Socket($ssl);
then it will be up to you to establish the connection AND to
authenticate, either via the L<login> method, or the fancier
L<authenticate>, or, since you know so much anyway, by just doing raw
I/O against the socket until you're logged in. If you do any of this
then you should also set the L<State> parameter yourself to reflect the
current state of the object (i.e. Connected, Authenticated, etc).
then it will be up to you to establish the connection, i.e. make sure
that C<$ssl> in the example is a valid and connected socket.
This method is primarily used to provide a drop-in replacement for
L<IO::Socket::INET>, used by L<connect> by default. In fact, this method
is called by L<connect> itself after having established a suitable
L<IO::Socket::INET> socket connection towards the target server; for
this reason, this method also carries the normal operations associated
with L<connect>, namely:
=over
=item *
read the initial greeting message from the server;
=item *
call L<login> if the conditions apply (see L<connect> for details);
=item *
leave the I<Mail::IMAPClient> object in a suitable state.
=back
For these reasons, the following example will work "out of the box":
use IO::Socket::SSL;
my $imap = Mail::IMAPClient->new
( User => 'your-username',
Password => 'your-password',
Socket => IO::Socket::SSL->new
( Proto => 'tcp',
PeerAddr => 'some.imap.server',
PeerPort => 993, # IMAP over SSL standard port
),
);
If you need more control over the socket, e.g. you have to implement a fancier
authentication method, see L<RawSocket>.
=cut

View File

@ -1,291 +1,196 @@
package Mail::IMAPClient::BodyStructure;
use base 'Exporter';
use warnings;
use strict;
package Mail::IMAPClient::BodyStructure;
our $VERSION = '0.0.4';
use Mail::IMAPClient;
use Mail::IMAPClient::BodyStructure::Parse;
our $VERSION = '0.0.3';
our @EXPORT_OK = '$parser';
# 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";
our $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;
sub new {
my $class = shift;
my $bodystructure = shift;
my $self = $parser->start($bodystructure) or return undef;
$self->{_prefix} = "";
my $self = $parser->start($bodystructure)
or return undef;
if ( exists $self->{bodystructure} ) {
$self->{_id} = 'HEAD' ;
} else {
$self->{_id} = 1;
}
$self->{_prefix} = "";
$self->{_id} = exists $self->{bodystructure} ? 'HEAD' : 1;
$self->{_top} = 1;
$self->{_top} = 1;
bless $self, ref($class)||$class;
bless $self, ref($class)||$class;
}
sub _get_thingy {
my $thingy = shift;
my $object = shift||(ref($thingy)?$thingy:undef);
unless ( defined($object) and ref($object) ) {
$@ = "No argument passed to $thingy method." ;
$^W and print STDERR "$@\n" ;
return undef;
}
unless ( "$object" =~ /HASH/
and exists($object->{$thingy})
) {
$@ = ref($object) .
" $object does not have " .
( $thingy =~ /^[aeiou]/i ? "an " : "a " ) .
"${thingy}. " .
( ref($object) =~ /HASH/ ? "It has " . join(", ",keys(%$object)) : "") ;
$^W and print STDERR "$@\n" ;
return undef;
}
return Unwrapped($object->{$thingy});
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 {
foreach my $datum (qw/ bodytype bodysubtype bodyparms bodydisp bodyid
bodydesc bodyenc bodysize bodylang
envelopestruct textlines
/
) {
no strict 'refs';
*$datum = sub { _get_thingy($datum, @_); };
}
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;
sub parts
{ my $self = shift;
return wantarray ? @{$self->{PartsList}} : $self->{PartsList}
if exists $self->{PartsList};
my @parts;
$self->{PartsList} = \@parts;
if ( exists $self->{PartsList} ) {
return wantarray ? @{$self->{PartsList}} : $self->{PartsList} ;
}
unless(exists $self->{bodystructure})
{ $self->{PartsIndex}{1} = $self;
@parts = ("HEAD", 1);
return wantarray ? @parts : \@parts;
}
my @parts = ();
$self->{PartsList} = \@parts;
foreach my $p ($self->bodystructure)
{ my $id = $p->id;
push @parts, $id;
$self->{PartsIndex}{$id} = $p ;
my $type = uc $p->bodytype || '';
unless ( exists($self->{bodystructure}) ) {
$self->{PartsIndex}{1} = $self ;
@parts = ("HEAD",1);
return wantarray ? @parts : \@parts;
}
#@parts = ( 1 );
#} else {
push @parts, "$id.HEAD"
if $type eq 'MESSAGE';
}
foreach my $p ($self->bodystructure()) {
push @parts, $p->id();
$self->{PartsIndex}{$p->id()} = $p ;
if ( uc($p->bodytype()||"") eq "MESSAGE" ) {
#print "Part $parts[-1] is a ",$p->bodytype,"\n";
push @parts,$parts[-1] . ".HEAD";
#} else {
# print "Part $parts[-1] is a ",$p->bodytype,"\n";
}
}
#}
return wantarray ? @parts : \@parts;
wantarray ? @parts : \@parts;
}
sub oldbodystructure {
my $self = shift;
if ( exists $self->{_bodyparts} ) {
return wantarray ? @{$self->{_bodyparts}} : $self->{_bodyparts} ;
}
my @bodyparts = ( $self );
$self->{_id} ||= "HEAD"; # aka "0"
my $count = 0;
#print STDERR "Analyzing a ",$self->bodytype, " part which I think is part number ",
# $self->{_id},"\n";
my $dump = Data::Dumper->new( [ $self ] , [ 'bodystructure' ] );
$dump->Indent(1);
foreach my $struct (@{$self->{bodystructure}}) {
$struct->{_prefix} ||= $self->{_prefix} . +$count . "." unless $struct->{_top};
$struct->{_id} ||= $self->{_prefix} . $count unless $struct->{_top};
#if (
# uc($struct->bodytype) eq 'MULTIPART' or
# uc($struct->bodytype) eq 'MESSAGE'
#) {
#} else {
#}
push @bodyparts, $struct,
ref($struct->{bodystructure}) ? $struct->bodystructure : () ;
}
$self->{_bodyparts} = \@bodyparts ;
return wantarray ? @bodyparts : $self->bodyparts ;
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++;
$p->{_prefix} = "$prefix$partno";
$p->{_id} ||= "$prefix$partno";
push @parts, $p, $p->{bodystructure} ? $p->bodystructure : ();
}
wantarray ? @parts : \@parts;
}
sub bodystructure {
my $self = shift;
my @parts = ();
my $partno = 0;
sub id
{ my $self = shift;
return $self->{_id}
if exists $self->{_id};
my $prefix = $self->{_prefix} || "";
return "HEAD"
if $self->{_top};
#print STDERR "Analyzing a ",($self->bodytype||"unknown ") ,
# " part which I think is part number ",
# $self->{_id},"\n";
my $bs = $self;
$prefix = "$prefix." if ( $prefix and $prefix !~ /\.$/);
if ( $self->{_top} ) {
$self->{_id} ||= "HEAD";
$self->{_prefix} ||= "HEAD";
$partno = 0;
for (my $x = 0; $x < scalar(@{$self->{bodystructure}}) ; $x++) {
$self->{bodystructure}[$x]{_id} = ++$partno ;
$self->{bodystructure}[$x]{_prefix} = $partno ;
push @parts, $self->{bodystructure}[$x] ,
$self->{bodystructure}[$x]->bodystructure;
}
} else {
$partno = 0;
foreach my $p ( @{$self->{bodystructure}} ) {
$partno++;
if (
! exists $p->{_prefix}
) {
$p->{_prefix} = "$prefix$partno";
}
$p->{_prefix} = "$prefix$partno";
$p->{_id} ||= "$prefix$partno";
#my $bt = $p->bodytype;
#if ($bt eq 'MESSAGE') {
#$p->{_id} = $prefix .
#$partno = 0;
#}
push @parts, $p, $p->{bodystructure} ? $p->bodystructure : ();
}
}
return wantarray ? @parts : \@parts;
}
sub id {
my $self = shift;
return $self->{_id} if exists $self->{_id};
return "HEAD" if $self->{_top};
#if ($self->bodytype eq 'MESSAGE') {
# return
#}
if ($self->{bodytype} eq 'MULTIPART') {
my $p = $self->{_id}||$self->{_prefix} ;
$p =~ s/\.$//;
return $p;
} else {
return $self->{_id} ||= 1;
}
}
sub Unwrapped {
my $unescape = Mail::IMAPClient::Unescape(@_);
$unescape =~ s/^"(.*)"$/$1/ if defined($unescape);
return $unescape;
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;
@ISA = qw/Mail::IMAPClient::BodyStructure/;
our @ISA = qw/Mail::IMAPClient::BodyStructure/;
package Mail::IMAPClient::BodyStructure::Envelope;
@ISA = qw/Mail::IMAPClient::BodyStructure/;
our @ISA = qw/Mail::IMAPClient::BodyStructure/;
sub new {
my $class = shift;
my $envelope = shift;
my $self = $Mail::IMAPClient::BodyStructure::parser->envelope($envelope);
return $self;
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 _do_accessor {
my $datum = shift;
if (scalar(@_) > 1) {
return $_[0]->{$datum} = $_[1] ;
} else {
return $_[0]->{$datum};
}
sub _address($$$)
{ 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, $pn. '<'.$_->mailboxname .'@'. $_->hostname.'>';
}
wantarray ? @list
: $isSender ? $list[0]
: \@list;
}
# the following for loop sets up accessor methods for
# the object's address attributes:
sub _mk_address_method {
my $datum = shift;
my $method1 = $datum . "_addresses" ;
no strict 'refs';
*$method1 = sub {
my $self = shift;
return undef unless ref($self->{$datum}) eq 'ARRAY';
my @list = map {
my $pn = $_->personalname ;
$pn = "" if $pn eq 'NIL' ;
( $pn ? "$pn " : "" ) .
"<" .
$_->mailboxname .
'@' .
$_->hostname .
">"
} @{$self->{$datum}} ;
if ( $senderFields{$datum} ) {
return wantarray ? @list : $list[0] ;
} else {
return wantarray ? @list : \@list ;
}
};
}
BEGIN {
for my $datum (
qw( subject inreplyto from messageid bcc date replyto to sender cc )
) {
no strict 'refs';
*$datum = sub { _do_accessor($datum, @_); };
}
my %senderFields = map { ($_ => 1) } qw/from sender replyto/ ;
for my $datum (
qw( from bcc replyto to sender cc )
) {
_mk_address_method($datum);
}
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;
@ISA = qw/Mail::IMAPClient::BodyStructure/;
for my $datum (
qw( personalname mailboxname hostname sourcename )
) {
no strict 'refs';
*$datum = sub { return $_[0]->{$datum}; };
for my $datum ( qw(personalname mailboxname hostname sourcename) )
{ no strict 'refs';
*$datum = sub { shift->{$datum}; };
}
1;
__END__
=head1 NAME
Mail::IMAPClient::BodyStructure - Perl extension to Mail::IMAPClient to facilitate
the parsing of server responses to the FETCH BODYSTRUCTURE and FETCH ENVELOPE
IMAP client commands.
Mail::IMAPClient::BodyStructure - parse fetched results
=head1 SYNOPSIS
@ -297,21 +202,15 @@ IMAP client commands.
my @recent = $imap->search("recent");
foreach my $new (@recent) {
my $struct = Mail::IMAPClient::BodyStructure->new(
$imap->fetch($new,"bodystructure")
);
print "Msg $new (Content-type: ",$struct->bodytype,"/",$struct->bodysubtype,
") contains these parts:\n\t",join("\n\t",$struct->parts),"\n\n";
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
@ -450,16 +349,16 @@ 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 ],
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
@ -477,7 +376,7 @@ Returns the message id of the message to which this message is a reply.
=item subject
Returns the subject of the message.
Returns the subject of the message.
=item messageid
@ -553,7 +452,7 @@ by the way.)
=item cc_addresses
Returns a list of cc'ed recipients' email addresses. If called in a scalar
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
@ -579,14 +478,14 @@ it returns a reference to an array of email addresses.
=back
Note that context affects the behavior of all of the above methods.
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.
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
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
@ -595,12 +494,11 @@ 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'
}
{ 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
@ -623,7 +521,7 @@ right of the '@' sign.
=item personalname
Returns the "personalname" portion of the address, which is the part of
Returns the "personalname" portion of the address, which is the part of
the address that's treated like a comment.
=item sourceroute
@ -632,7 +530,7 @@ 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
Taken together, the parts of an address structure form an address that will
look something like this:
C<personalname E<lt>mailboxname@hostnameE<gt>>
@ -651,11 +549,11 @@ B<Mail::IMAPClient::BodyStructure::Envelope> need them anyway.)
David J. Kernen
Reworked 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.
perl(1), Mail::IMAPClient, and RFC2060. See also Parse::RecDescent if you
want to understand the internals of this module.
=cut
1;

View File

@ -86,203 +86,197 @@ bodydisp: NIL | '(' kvpair(s) ')'
$return || defined($return);
}
bodyid: ...!/[()]/ NIL | STRING
{ $return = $item{NIL} || $item{STRING} ; $return||defined($return);}
{ $return = $item{NIL} || $item{STRING} ; $return||defined($return);}
bodydesc: ...!/[()]/ NIL | STRING
{ $return = $item{NIL} || $item{STRING} ; $return||defined($return);}
{ $return = $item{NIL} || $item{STRING}; $return||defined($return);}
bodyenc: NIL | STRING | '(' kvpair(s) ')'
{
$return = $item{NIL} ||
$item{STRING} ||
{ map { (%$_) } @{$item{'kvpair(s)'}} };
$return||defined($return);
}
bodysize: ...!/[()]/ NIL | NUMBER
{ $return = $item{NIL} || $item{NUMBER} ;$return||defined($return);}
{ $return = $item{NIL} || $item{NUMBER}; $return||defined($return);}
bodyMD5: NIL | STRING
{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}
{ $return = $item{NIL} || $item{STRING}; $return||defined($return);}
bodylang: NIL | STRING | "(" STRING(s) ")"
{ $return = $item{NIL} || $item{'STRING(s)'} ;$return||defined($return);}
{ $return = $item{NIL} || $item{'STRING(s)'}; $return||defined($return);}
bodyextra: NIL | STRING | "(" STRING(s) ")"
{ 0 }
personalname: NIL | STRING
{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}
{ $return = $item{NIL} || $item{STRING}; $return||defined($return);}
sourceroute: NIL | STRING
{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}
{ $return = $item{NIL} || $item{STRING}; $return||defined($return);}
mailboxname: NIL | STRING
{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}
{ $return = $item{NIL} || $item{STRING}; $return||defined($return);}
hostname: NIL | STRING
{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}
{ $return = $item{NIL} || $item{STRING}; $return||defined($return);}
addressstruct: "(" personalname sourceroute mailboxname hostname ")"
{ $return = {
{ bless {
personalname => $item{personalname} ,
sourceroute => $item{sourceroute} ,
mailboxname => $item{mailboxname} ,
hostname => $item{hostname} ,
} ;
bless($return, "Mail::IMAPClient::BodyStructure::Address");
}, 'Mail::IMAPClient::BodyStructure::Address';
}
subject: NIL | STRING
{
$return = $item{NIL} || $item{STRING} ;
$return||defined($return);
}
inreplyto: NIL | STRING
{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}
{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}
messageid: NIL | STRING
{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}
{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}
date: NIL | STRING
{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}
{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}
cc: NIL | "(" addressstruct(s) ")"
{ $return = $item{NIL} || $item{'addressstruct(s)'} }
{ $return = $item{NIL} || $item{'addressstruct(s)'} }
bcc: NIL | "(" addressstruct(s) ")"
{ $return = $item{NIL} || $item{'addressstruct(s)'} }
{ $return = $item{NIL} || $item{'addressstruct(s)'} }
from: NIL | "(" addressstruct(s) ")"
{ $return = $item{NIL} || $item{'addressstruct(s)'} }
{ $return = $item{NIL} || $item{'addressstruct(s)'} }
replyto: NIL | "(" addressstruct(s) ")"
{ $return = $item{NIL} || $item{'addressstruct(s)'} }
{ $return = $item{NIL} || $item{'addressstruct(s)'} }
sender: NIL | "(" addressstruct(s) ")"
{ $return = $item{NIL} || $item{'addressstruct(s)'} }
{ $return = $item{NIL} || $item{'addressstruct(s)'} }
to: NIL | "(" addressstruct(s) ")"
{ $return = $item{NIL} || $item{'addressstruct(s)'} }
{ $return = $item{NIL} || $item{'addressstruct(s)'} }
envelopestruct: "(" date subject from sender replyto to cc bcc inreplyto messageid ")"
{ $return = {};
foreach my $what (qw/date subject from sender replyto to cc bcc inreplyto messageid/) {
$return->{$what} = $item{$what};
}
bless $return, "Mail::IMAPClient::BodyStructure::Envelope";
$return||defined($return);
{ $return = bless {}, "Mail::IMAPClient::BodyStructure::Envelope";
$return->{$_} = $item{$_}
for qw/date subject from sender replyto to cc/
, qw/bcc inreplyto messageid/ ;
$return;
}
basicfields: bodysubtype bodyparms bodyid(?)
bodydesc(?) bodyenc(?)
bodysize(?) {
$return = {
bodysubtype => $item{bodysubtype} ,
$return =
{ bodysubtype => $item{bodysubtype}
, bodyparms => $item{bodyparms}
};
$return->{$_} = ref $item{"$_(?}"} ? $item{"$_(?}"}[0] :$item{"$_(?}"}
for qw/bodyid bodydesc bodyenc bodysize/;
$return;
}
bodyparms => $item{bodyparms} ,
bodyid => (ref $item{'bodyid(?)'} ?
$item{'bodyid(?)'}[0] :
$item{'bodyid(?)'} ),
'bodydesc' => (ref $item{'bodydesc(?)'} ?
$item{'bodydesc(?)'}[0] :
$item{'bodydesc(?)'} ),
'bodyenc' => (ref $item{'bodyenc(?)'} ?
$item{'bodyenc(?)'}[0] :
$item{'bodyenc(?)'} ),
'bodysize' => (ref $item{'bodysize(?)'} ?
$item{'bodysize(?)'}[0] :
$item{'bodysize(?)'} ),
};
$return;
}
textmessage: TEXT <commit> basicfields textlines(?) bodyMD5(?) bodydisp(?) bodylang(?)
textmessage: TEXT <commit> basicfields textlines(?) bodyMD5(?)
bodydisp(?) bodylang(?) bodyextra(?)
{
$return = $item{basicfields}||{};
$return = $item{basicfields} || {};
$return->{bodytype} = 'TEXT';
foreach my $what (qw/textlines(?) bodyMD5(?) bodydisp(?) bodylang(?)/) {
my $k = $what; $k =~ s/\(\?\)$//;
ref($item{$what}) and $return->{$k} = $item{$what}[0];
foreach my $what (qw/textlines(?) bodyMD5(?) bodydisp(?) bodylang(?)/)
{ my $k = $what; $k =~ s/\(\?\)$//;
$return->{$k} = $item{$what}[0] if ref $item{$what};
}
$return||defined($return);
$return;
}
othertypemessage: bodytype basicfields bodyparms(?) bodydisp(?) bodylang(?)
othertypemessage: bodytype basicfields bodyparms(?) bodydisp(?)
bodylang(?) bodyextra(?)
{ $return = {};
foreach my $what (qw/bodytype bodyparms(?) bodydisp(?) bodylang(?)/) {
my $k = $what; $k =~ s/\(\?\)$//;
$return->{$k} = ref($item{$what})? $item{$what}[0] : $item{$what} ;
foreach my $what ( qw/bodytype bodyparms(?) bodydisp(?)/
, qw/bodylang(?) bodyextra(?)/ )
{ my $k = $what; $k =~ s/\(\?\)$//;
$return->{$k} = ref($item{$what})? $item{$what}[0] : $item{$what} ;
}
while ( my($k,$v) = each %{$item{basicfields}} ) { $return->{$k} = $v }
$return||defined($return);
while( my($k,$v) = each %{$item{basicfields}} ) { $return->{$k} = $v }
$return;
}
messagerfc822message:
rfc822message <commit> bodyparms bodyid bodydesc bodyenc bodysize
envelopestruct bodystructure textlines
bodyMD5(?) bodydisp(?) bodylang(?)
bodyMD5(?) bodydisp(?) bodylang(?) bodyextra(?)
{
$return = {};
foreach my $what (qw/ bodyparms bodyid bodydesc bodyenc bodysize
envelopestruct bodystructure textlines
bodyMD5(?) bodydisp(?) bodylang(?)
bodyMD5(?) bodydisp(?) bodylang(?) bodyextra(?)
/
) {
my $k = $what; $k =~ s/\(\?\)$//;
$return->{$k} = ref $item{$what} =~ 'ARRAY'?
$item{$what}[0] : $item{$what};
}
while ( my($k,$v) = each %{$item{bodystructure}[0]} ) { $return->{$k} = $v }
while ( my($k,$v) = each %{$item{basicfields}} ) { $return->{$k} = $v }
$return->{bodytype} = "MESSAGE" ;
$return->{bodysubtype}= "RFC822" ;
$return||defined($return);
while(my($k,$v) = each %{$item{bodystructure}[0]}) { $return->{$k} = $v}
while(my($k,$v) = each %{$item{basicfields}}) { $return->{$k} = $v}
$return->{bodytype} = "MESSAGE" ;
$return->{bodysubtype} = "RFC822" ;
$return;
}
subpart: "(" part ")"
{
$return = $item{part} ;
$return||defined($return);
{ $return = $item{part} ;
$return||defined($return);
} <defer: ++$subpartCount;>
part: subpart(s) <commit> basicfields
bodyparms(?) bodydisp(?) bodylang(?)
bodyparms(?) bodydisp(?) bodylang(?) bodyextra(?)
<defer: $subpartCount = 0>
{
$return = bless($item{basicfields},
"Mail::IMAPClient::BodyStructure");
$return->{bodytype} = "MULTIPART";
$return->{bodystructure} = $item{'subpart(s)'};
foreach my $b (qw/bodyparms(?) bodydisp(?) bodylang(?)/) {
my $k = $b; $k =~ s/\(\?\)$//;
$return->{$k} = ref($item{$b}) ? $item{$b}[0] : $item{$b};
}
$return||defined($return) ;
{ $return = bless $item{basicfields},"Mail::IMAPClient::BodyStructure";
$return->{bodytype} = "MULTIPART";
$return->{bodystructure} = $item{'subpart(s)'};
foreach my $b (qw/bodyparms(?) bodydisp(?) bodylang(?) bodyextra(?)/)
{ my $k = $b; $k =~ s/\(\?\)$//;
$return->{$k} = ref($item{$b}) ? $item{$b}[0] : $item{$b};
}
$return;
}
| textmessage
{
$return = bless $item{textmessage}, "Mail::IMAPClient::BodyStructure";
$return||defined($return);
{ $return = bless $item{textmessage}, "Mail::IMAPClient::BodyStructure";
$return||defined($return);
}
| messagerfc822message
{
$return = bless $item{messagerfc822message}, "Mail::IMAPClient::BodyStructure";
$return||defined($return);
{ $return = bless $item{messagerfc822message}, "Mail::IMAPClient::BodyStructure";
$return||defined($return);
}
| othertypemessage
{
$return = bless $item{othertypemessage}, "Mail::IMAPClient::BodyStructure";
$return||defined($return);
{ $return = bless $item{othertypemessage}, "Mail::IMAPClient::BodyStructure";
$return||defined($return);
}
bodystructure: "(" part(s) ")"
{
$return = $item{'part(s)'} ;
$return||defined($return);
}
{ $return = $item{'part(s)'} ;
$return||defined($return);
}
start: /.*\(.*BODYSTRUCTURE \(/i part(1) /\).*\)\r?\n?/
{
#print STDERR "item = ",Data::Dumper->Dump([\%item],['$item']);
$return = $item{'part(1)'}[0];
$return||defined($return);
}
{
#print STDERR "item = ",Data::Dumper->Dump([\%item],['$item']);
$return = $item{'part(1)'}[0];
$return || defined $return;
}
envelope: /.*\(.*ENVELOPE/ envelopestruct /.*\)/ {
$return = $item{envelopestruct} ;
$return||defined($return) ;
}
envelope: /.*\(.*ENVELOPE/ envelopestruct /.*\)/
{ $return = $item{envelopestruct};
$return || defined $return;
}

View File

@ -1,9 +1,8 @@
package Mail::IMAPClient::MessageSet;
use warnings;
use strict;
package Mail::IMAPClient::MessageSet;
=head1 NAME
Mail::IMAPClient::MessageSet -- ranges of message sequence nummers
@ -27,7 +26,7 @@ sub new
sub str { overload::StrVal( ${$_[0]} ) }
sub _unfold_range($)
{ map { /(\d+)\:(\d+)/ ? ($1..$2) : $_ }
{ map { /(\d+)\s*\:\s*(\d+)/ ? ($1..$2) : $_ }
split /\,/, shift;
}
@ -45,10 +44,7 @@ sub cat
}
sub range
{ my $class = shift;
return $_[0]
if @_== 1 && ref $_[0] eq __PACKAGE__;
{ my $self = shift;
my @msgs;
foreach my $m (@_)
@ -63,7 +59,6 @@ sub range
@msgs
or return undef;
@msgs = sort {$a <=> $b} @msgs;
my $low = my $high = shift @msgs;
@ -82,13 +77,12 @@ sub range
join ",", @ranges;
}
sub unfold
{ my $self = shift;
wantarray ? ( _unfold_range $$self ) : [ _unfold_range $$self ];
}
=head2 SYNOPSIS
=head1 SYNOPSIS
my @msgs = $imap->search("SUBJECT","Virus"); # returns 1,3,4,5,6,9,10
my $msgset = Mail::IMAPClient::MessageSet->new(@msgs);
@ -113,7 +107,7 @@ sub unfold
print join("\n", @$msgset)."\n"; # same simpler
local $" = "\n"; print "@$msgset\n"; # even more simple
=head2 DESCRIPTION
=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

View File

@ -820,7 +820,7 @@ package Mail::IMAPClient::Thread; sub new { my $self = bless( {
'hashname' => '__STRING1__',
'description' => '\'(\'',
'lookahead' => 0,
'line' => 279
'line' => 274
}, 'Parse::RecDescent::InterpLit' ),
bless( {
'subrule' => 'threadmember',
@ -831,19 +831,19 @@ package Mail::IMAPClient::Thread; sub new { my $self = bless( {
'matchrule' => 0,
'repspec' => 's',
'lookahead' => 0,
'line' => 279
'line' => 274
}, 'Parse::RecDescent::Repetition' ),
bless( {
'pattern' => ')',
'hashname' => '__STRING2__',
'description' => '\')\'',
'lookahead' => 0,
'line' => 279
'line' => 274
}, 'Parse::RecDescent::InterpLit' ),
bless( {
'hashname' => '__ACTION1__',
'lookahead' => 0,
'line' => 280,
'line' => 275,
'code' => '{
$return = $item{\'threadmember(s)\'}||undef;
}'
@ -854,7 +854,7 @@ package Mail::IMAPClient::Thread; sub new { my $self = bless( {
],
'name' => 'thread',
'vars' => '',
'line' => 279
'line' => 274
}, 'Parse::RecDescent::Rule' ),
'NUMBER' => bless( {
'impcount' => 0,
@ -877,7 +877,7 @@ package Mail::IMAPClient::Thread; sub new { my $self = bless( {
'description' => '/\\\\d+/',
'lookahead' => 0,
'rdelim' => '/',
'line' => 272,
'line' => 267,
'mod' => '',
'ldelim' => '/'
}, 'Parse::RecDescent::Token' )
@ -887,7 +887,7 @@ package Mail::IMAPClient::Thread; sub new { my $self = bless( {
],
'name' => 'NUMBER',
'vars' => '',
'line' => 270
'line' => 265
}, 'Parse::RecDescent::Rule' ),
'start' => bless( {
'impcount' => 0,
@ -912,7 +912,7 @@ package Mail::IMAPClient::Thread; sub new { my $self = bless( {
'description' => '/^\\\\* THREAD /i',
'lookahead' => 0,
'rdelim' => '/',
'line' => 285,
'line' => 280,
'mod' => 'i',
'ldelim' => '/'
}, 'Parse::RecDescent::Token' ),
@ -925,12 +925,12 @@ package Mail::IMAPClient::Thread; sub new { my $self = bless( {
'matchrule' => 0,
'repspec' => 's?',
'lookahead' => 0,
'line' => 285
'line' => 280
}, 'Parse::RecDescent::Repetition' ),
bless( {
'hashname' => '__ACTION1__',
'lookahead' => 0,
'line' => 285,
'line' => 280,
'code' => '{
$return=$item{\'thread(s?)\'}||undef;
}'
@ -941,7 +941,7 @@ package Mail::IMAPClient::Thread; sub new { my $self = bless( {
],
'name' => 'start',
'vars' => '',
'line' => 284
'line' => 279
}, 'Parse::RecDescent::Rule' ),
'threadmember' => bless( {
'impcount' => 0,
@ -967,12 +967,12 @@ package Mail::IMAPClient::Thread; sub new { my $self = bless( {
'implicit' => undef,
'argcode' => undef,
'lookahead' => 0,
'line' => 276
'line' => 271
}, 'Parse::RecDescent::Subrule' ),
bless( {
'hashname' => '__ACTION1__',
'lookahead' => 0,
'line' => 276,
'line' => 271,
'code' => '{ $return = $item{NUMBER} ; }'
}, 'Parse::RecDescent::Action' )
],
@ -993,22 +993,22 @@ package Mail::IMAPClient::Thread; sub new { my $self = bless( {
'implicit' => undef,
'argcode' => undef,
'lookahead' => 0,
'line' => 277
'line' => 272
}, 'Parse::RecDescent::Subrule' ),
bless( {
'hashname' => '__ACTION1__',
'lookahead' => 0,
'line' => 277,
'line' => 272,
'code' => '{ $return = $item{thread} ; }'
}, 'Parse::RecDescent::Action' )
],
'line' => 276
'line' => 271
}, 'Parse::RecDescent::Production' )
],
'name' => 'threadmember',
'vars' => '',
'line' => 274
'line' => 269
}, 'Parse::RecDescent::Rule' )
}
}, 'Parse::RecDescent' );
}
}

View File

@ -1,7 +1,5 @@
#!/usr/bin/perl
my $uid;
use warnings;
use strict;
@ -13,7 +11,7 @@ my $debug = $ARGV[0];
my %parms;
my $range = 0;
my $uidplus = 0;
my $fast = 0;
my $fast = 1;
BEGIN
{ open TST, 'test.txt'
@ -22,7 +20,7 @@ BEGIN
while(my $l = <TST>)
{ chomp $l;
my($p,$v) = split /\=/, $l, 2;
s/(?:^\s+)|(?:\s+$)//g for $p, $v;
s/^\s+//, s/\s+$// for $p, $v;
$parms{$p} = $v if $v;
}
@ -30,10 +28,10 @@ BEGIN
foreach my $p ( qw/server user passed/ )
{ $parms{$p}
or plan skip_all => "missing value for $_"
or plan skip_all => "missing value for $p"
}
plan tests => 40;
plan tests => 49;
}
use_ok('Mail::IMAPClient');
@ -43,20 +41,19 @@ my $imap = Mail::IMAPClient->new
, Port => $parms{port}
, User => $parms{user}
, Password => $parms{passed}
, Authmechanism => $parms{authmechanism}
, Authmechanism => $parms{authmech}
, Clear => 0
, Timeout => 30
, Fast_IO => $fast
, Uid => $uidplus
, Range => $range
, Debug => 1
, Debug => $debug
, Debug_fh => ($debug ? IO::File->new('imap1.debug', 'w') : undef)
);
);
ok(defined $imap, 'created client');
die "Cannot log into $parms{server} as $parms{user}.\n"
. "Are server/user/password correct?\n" ;
$imap or die "Cannot log into $parms{server} as $parms{user}.\n"
. "Are server/user/password correct?\n" ;
isa_ok($imap, 'Mail::IMAPClient');
@ -76,7 +73,7 @@ __TEST_MSG
my $sep = $imap->separator;
ok(defined $sep, "separator is '$sep'");
my $isparent = $imap->is_parent("INBOX") || 0;
my $isparent = $imap->is_parent('INBOX');
my ($target, $target2) = $isparent
? ("INBOX${sep}IMAPClient_$$", "INBOX${sep}IMAPClient_2_$$")
: ("IMAPClient_$$", "IMAPClient_2_$$");
@ -110,27 +107,27 @@ ok($imap->exists($target), "exists $target");
ok($imap->create($target2), "create $target2");
ok($imap->exists($target2), "exists $target2");
$uid = $imap->append($target, $testmsg);
my $uid = $imap->append($target, $testmsg);
ok(defined $uid, "append test message to $target");
ok($imap->select($target), "select $target");
$target = ref $uid ? ($imap->search("ALL"))[0] : $uid;
my $size = $imap->size($target);
my $msg = ref $uid ? ($imap->search("ALL"))[0] : $uid;
my $size = $imap->size($msg);
cmp_ok($size, '>', 0, "has size $size");
my $string = $imap->message_string($target);
ok($string, "returned string");
my $string = $imap->message_string($msg);
ok(defined $string, "returned string");
cmp_ok($size, '==', length($string), "string has size");
cmp_ok(length($string), '==', $size, "string has size");
{ my ($fh, $fn) = tempfile UNLINK => 1;
ok($imap->message_to_file($fn, $target), "to file $fn");
ok($imap->message_to_file($fn, $msg), "to file $fn");
cmp_ok(-s $fn, '==', $size, "correct size");
}
my $fields = $imap->search("HEADER","Message-id","NOT_A_MESSAGE_ID");
my $fields = $imap->search("HEADER", "Message-id", "NOT_A_MESSAGE_ID");
ok(!defined $fields, 'message id does not exist');
my @seen = $imap->seen;
@ -169,14 +166,15 @@ my $h = $imap->parse_headers(1, "Subject");
ok($h, "got subject");
like($h->{Subject}[0], qr/^Testing from pid/);
$imap->select($target);
ok($imap->select($target), "select $target");
my @hits = $imap->search(SUBJECT => 'Testing');
cmp_ok(scalar @hits, '==', 1);
cmp_ok(scalar @hits, '==', 1, 'hit subject Testing');
ok(defined $hits[0]);
ok($imap->delete_message(@hits), 'delete hits');
my $flaghash = $imap->flags(\@hits);
my $flagflag = 0;
foreach my $v ( values %$flaghash )
foreach my $v (values %$flaghash)
{ $flagflag += grep /\\Deleted/, @$v;
}
cmp_ok($flagflag, '==', scalar @hits);
@ -185,23 +183,23 @@ 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);
$flagflag = 0;
foreach my $v (values(%$flaghash)){
$flagflag += grep /\\Deleted/, @$v;
foreach my $v (values %$flaghash)
{ $flagflag-- unless grep /\\Deleted/, @$v;
}
cmp_ok($flagflag, '==', scalar @hits);
cmp_ok($flagflag, '==', 0);
$imap->select($target2);
ok( $imap->delete_message(scalar($imap->search("ALL")))
&& $imap->close
&& imap->delete($target2) , "delete $target2");
&& $imap->delete($target2) , "delete $target2");
$imap->select("INBOX");
$@ = ""; # clear $@
$@ = "";
@hits = $imap->search
(BEFORE => Mail::IMAPClient::Rfc2060_date(time), "UNDELETED");
ok(!$@, 'search undeleted');
ok(!$@, "search undeleted: $@");
#
# Test migrate method
@ -264,7 +262,7 @@ for ($im2->search("ALL"))
$total_bytes2 += $s; print "Size of msg $_ is $s\n" if $debug
}
cmp_ok($@, '==', '');
cmp_ok($@, 'eq', '');
cmp_ok($total_bytes1, '==', $total_bytes2, 'size source==target');
# cleanup

20
README
View File

@ -3,7 +3,7 @@ NAME
Synchronise mailboxes between two imap servers. Good at IMAP migration.
More than 32 different IMAP server softwares supported with success.
$Revision: 1.233 $
$Revision: 1.239 $
INSTALL
imapsync works fine under any Unix OS with perl.
@ -179,6 +179,12 @@ BUGS
No known serious bug. Report any bug to the author. Before reporting
bugs, read the FAQ, this README and the TODO files.
Don't write imapsync in uppercase in the email title, I'll know you run
windows.
Make a good title, not just "imapsync" or "problem", a good title is
made of keywords summary, not too long (one visible line).
In your report, please include:
- imapsync version.
@ -209,12 +215,13 @@ IMAP SERVERS
- dkimap4 2.39
- Imail 7.04 (maybe).
Success stories reported with the following 34 imap servers (softwares
Success stories reported with the following 35 imap servers (softwares
names are in alphabetic order) :
- Archiveopteryx 2.03, 2.04 (OSL 3.0) http://www.archiveopteryx.org/
- BincImap 1.2.3 (GPL) (http://www.bincimap.org/)
- CommuniGatePro server (Redhat 8.0)
- Courier IMAP 1.5.1, 2.2.0, 2.1.1, 2.2.1, 3.0.8 (GPL)
- Courier IMAP 1.5.1, 2.2.0, 2.1.1, 2.2.1, 3.0.8, 3.0.3, 4.1.1 (GPL)
(http://www.courier-mta.org/)
- Critical Path (7.0.020)
- Cyrus IMAP 1.5, 1.6, 2.1, 2.1.15, 2.1.16, 2.1.18
@ -245,7 +252,7 @@ IMAP SERVERS
- OpenMail IMAP server B.07.00.k0 (Samsung Contact ?)
- OpenWave
- Qualcomm Worldmail (NT)
- Rockliffe Mailsite 5.3.11
- Rockliffe Mailsite 5.3.11, 4.5.6
- Samsung Contact IMAP server 8.5.0
- Scalix v10.1, 10.0.1.3, 11.0.0.431
- SmarterMail
@ -257,7 +264,7 @@ IMAP SERVERS
(http://www.washington.edu/imap/)
- UW - QMail v2.1
- Imap part of TCP/IP suite of VMS 7.3.2
- Zimbra-IMAP 3.0.1 GA 160, 3.1.0 Build 279, 4.0.5, 4.5.2, 5.5.
- Zimbra-IMAP 3.0.1 GA 160, 3.1.0 Build 279, 4.0.5, 4.5.2, 4.5.6, 5.5.
Please report to the author any success or bad story with imapsync and
don't forget to mention the IMAP server software names and version on
@ -320,9 +327,10 @@ SIMILAR SOFTWARES
imapcopy : http://home.arcor.de/armin.diehl/imapcopy/imapcopy.html
migrationtool : http://sourceforge.net/projects/migrationtool/
imapmigrate : http://sourceforge.net/projects/cyrus-utils/
wonko_imapsync: http://wonko.com/article/554
pop2imap : http://www.linux-france.org/prj/pop2imap/
Feedback (good or bad) will be always welcome.
$Id: imapsync,v 1.233 2007/10/30 03:20:53 gilles Exp gilles $
$Id: imapsync,v 1.239 2007/12/29 02:44:10 gilles Exp $

16
RECORD
View File

@ -12,6 +12,22 @@ Number of mailboxes :
Total size :
Comment :
-------------------------------------------------------------------------------
Your Name/Compagny : Thomas Hallock/Medicus Insurance Company
Time to migrate : The initial sync took about 15 hours. We mirrored the
"from" and "to" mailboxes via cron for a couple of weeks during the
transition. Each day after the initial sync, the script would run for
about 3 hours to catch up with the day-to-day changes. Our mail
server is a Dual-Core Intel Xeon XServe.
Number of mailboxes : 25
Total size : 40+ GB
Comment : It worked flawlessly,
and was even able to address issues I wouldn't have expected it
could, such as synchronizing deletions, and handling differing IMAP
path prefixes between the to and from servers.
-------------------------------------------------------------------------------
Your Name/Compagny : Olivier Morel
Time to migrate : 18 hours

24
TODO
View File

@ -1,6 +1,30 @@
TODO file for imapsync
----------------------
Normally, "no header used or found" means imapsync found a message
with no header. It may be a bad message with really no header
or it may be a imap server problem, the server gives no header
for this message. In that case imapsync gets the whole message
to see if there is the same on the other side. It slows the transfer
of course. I think I'll change imapsync behavior and let it
give up those bad messages missing an header.
Add a --delete2folders option
"When syncing mailboxes with imapsync, is there a way to delete folders in the
target account? The --delete2 option only seems to delete individual
messages, not folders."
Fix the buggy --include behavior with no --folder --folderrec or --subscribed.
make --syncinternaldates turn on by default
Add different level of output to see clearly the
problem by default.
Check imapsync with gmail (dates problem?).
Add --justlogin --justlogin1 --justlogin2 options
to check username and passwort.

View File

@ -1 +1 @@
1.233
1.239

16
aa Normal file
View File

@ -0,0 +1,16 @@
Using Mail::IMAPClient version 2.2.9 and perl version 5.8.8 (5.008008)
Read: * OK [CAPABILITY IMAP4rev1 UIDPLUS CHILDREN NAMESPACE THREAD=ORDEREDSUBJECT THREAD=REFERENCES SORT QUOTA AUTH=PLAIN CRAM-MD5 CRAM-SHA1 IDLE STARTTLS] Courier-IMAP ready. Copyright 1998-2005 Double Precision, Inc. See COPYING for distribution information.
Connect: Received this from readline: 0/OUTPUT/* OK [CAPABILITY IMAP4rev1 UIDPLUS CHILDREN NAMESPACE THREAD=ORDEREDSUBJECT THREAD=REFERENCES SORT QUOTA AUTH=PLAIN CRAM-MD5 CRAM-SHA1 IDLE STARTTLS] Courier-IMAP ready. Copyright 1998-2005 Double Precision, Inc. See COPYING for distribution information.
Sending: 1 Login "XXXXXXXX" XXXXXXXX
Sent 37 bytes
Read: 1 OK LOGIN Ok.
Sending: 2 LOGOUT
Sent 10 bytes
Read: * BYE Courier-IMAP server shutting down
2 OK LOGOUT completed

View File

@ -1,9 +1,20 @@
Project: imapsync
Version: 1.213
Version: 1.233
Release-Focus: Major bugfixes
Hide: Y
Home-Page-URL: http://www.linux-france.org/prj/imapsync/
Gzipped-Tar-URL: http://www.linux-france.org/prj/imapsync/dist/
Bug fix: rewrote the way to store messages to avoid freeze problems with some imap servers
Bug fixes:
- Avoid infinite loop with bad hostname.
- Works without patch on MSWin32 systems.
- Updated help message : avoid --authuser and --authmech1 SOMETHING
- Uppercase --authmech input.
- Date with minus %d-%b-%Y (RFC compliant)
- Added Date::Manip dependency.
- Added Dovecot 1.0.0 [dest] success.
- Added Deerfield VisNetic MailServer 5.8.6 [from] success.
- Turn to --nofastio1 --nofastio2 by default.
- Flags \Recent can be uppercase \RECENT now.

350
imapsync
View File

@ -9,7 +9,7 @@ tool. Synchronise mailboxes between two imap servers. Good
at IMAP migration. More than 32 different IMAP server softwares
supported with success.
$Revision: 1.233 $
$Revision: 1.239 $
=head1 INSTALL
@ -211,6 +211,12 @@ No known serious bug. Report any bug to the author.
Before reporting bugs, read the FAQ, this README and the
TODO files.
Don't write imapsync in uppercase in the email title, I'll
know you run windows.
Make a good title, not just "imapsync" or "problem",
a good title is made of keywords summary, not too long (one visible line).
In your report, please include:
- imapsync version.
@ -242,12 +248,13 @@ Failure stories reported with the following 4 imap servers :
- dkimap4 2.39
- Imail 7.04 (maybe).
Success stories reported with the following 34 imap servers
Success stories reported with the following 35 imap servers
(softwares names are in alphabetic order) :
- Archiveopteryx 2.03, 2.04 (OSL 3.0) http://www.archiveopteryx.org/
- BincImap 1.2.3 (GPL) (http://www.bincimap.org/)
- CommuniGatePro server (Redhat 8.0)
- Courier IMAP 1.5.1, 2.2.0, 2.1.1, 2.2.1, 3.0.8 (GPL)
- Courier IMAP 1.5.1, 2.2.0, 2.1.1, 2.2.1, 3.0.8, 3.0.3, 4.1.1 (GPL)
(http://www.courier-mta.org/)
- Critical Path (7.0.020)
- Cyrus IMAP 1.5, 1.6, 2.1, 2.1.15, 2.1.16, 2.1.18
@ -278,7 +285,7 @@ Success stories reported with the following 34 imap servers
- OpenMail IMAP server B.07.00.k0 (Samsung Contact ?)
- OpenWave
- Qualcomm Worldmail (NT)
- Rockliffe Mailsite 5.3.11
- Rockliffe Mailsite 5.3.11, 4.5.6
- Samsung Contact IMAP server 8.5.0
- Scalix v10.1, 10.0.1.3, 11.0.0.431
- SmarterMail
@ -290,7 +297,7 @@ Success stories reported with the following 34 imap servers
(http://www.washington.edu/imap/)
- UW - QMail v2.1
- Imap part of TCP/IP suite of VMS 7.3.2
- Zimbra-IMAP 3.0.1 GA 160, 3.1.0 Build 279, 4.0.5, 4.5.2, 5.5.
- Zimbra-IMAP 3.0.1 GA 160, 3.1.0 Build 279, 4.0.5, 4.5.2, 4.5.6, 5.5.
Please report to the author any success or bad story with
imapsync and don't forget to mention the IMAP server
@ -373,11 +380,13 @@ Entries for imapsync:
imapcopy : http://home.arcor.de/armin.diehl/imapcopy/imapcopy.html
migrationtool : http://sourceforge.net/projects/migrationtool/
imapmigrate : http://sourceforge.net/projects/cyrus-utils/
wonko_imapsync: http://wonko.com/article/554
pop2imap : http://www.linux-france.org/prj/pop2imap/
Feedback (good or bad) will be always welcome.
$Id: imapsync,v 1.233 2007/10/30 03:20:53 gilles Exp gilles $
$Id: imapsync,v 1.239 2007/12/29 02:44:10 gilles Exp $
@ -396,6 +405,9 @@ use English;
use POSIX qw(uname);
use Fcntl;
#use Test::Simple tests => 1;
use Test::More 'no_plan';
eval { require 'usr/include/sysexits.ph' };
@ -431,19 +443,20 @@ my(
$authuser1, $authuser2,
$authmech1, $authmech2,
$split1, $split2,
$tests, $test_builder,
);
use vars qw ($opt_G); # missing code for this will be option.
$rcs = ' $Id: imapsync,v 1.233 2007/10/30 03:20:53 gilles Exp gilles $ ';
$rcs = ' $Id: imapsync,v 1.239 2007/12/29 02:44:10 gilles Exp $ ';
$rcs =~ m/,v (\d+\.\d+)/;
$VERSION = ($1) ? $1 : "UNKNOWN";
my $VERSION_IMAPClient = $Mail::IMAPClient::VERSION;
#check_lib_version() or
# die "Upgrade perl lib Mail::IMAPClient to release 2.2.9 at least\n";
check_lib_version() or
die "imapsync needs perl lib Mail::IMAPClient release 2.2.9 exactly, future imapsync release may suppoort 3.0.x, but sorry not now\n";
$mess_size_total_trans = 0;
@ -453,18 +466,14 @@ $mess_trans = $mess_skipped = $mess_skipped_dry = 0;
sub check_lib_version {
# I know this is ugly, I should write a sort function
if ($VERSION_IMAPClient =~ m/(\d+)\.(\d+)\.(\d+)/) {
$debug and print "VERSION_IMAPClient $1 $2 $3\n";
my($major,$minor,$sub) = ($1, $2, $3);
#my($major,$minor,$sub) = ($1, $2, $3);
return(1) if($major >=3);
return(0) if($major <=1);
return(1) if($minor >=3);
return(0) if($minor <=1);
return(1) if($sub >=8);
return(0) if($sub <=7);
}else{
return(1) if($VERSION_IMAPClient eq '2.2.9');
}
else{
return 0; # don't match regex => bad
}
}
@ -473,8 +482,8 @@ $error=0;
my $banner = join("",
'$RCSfile: imapsync,v $ ',
'$Revision: 1.233 $ ',
'$Date: 2007/10/30 03:20:53 $ ',
'$Revision: 1.239 $ ',
'$Date: 2007/12/29 02:44:10 $ ',
"\n",localhost_info(),
" and the module Mail::IMAPClient version used here is ",
$VERSION_IMAPClient,"\n",
@ -552,7 +561,8 @@ $user2 || missing_option("--user2");
if(defined($authmd5) and not($authmd5)) {
$authmech1 ||= 'LOGIN';
$authmech2 ||= 'LOGIN';
}else{
}
else{
$authmech1 ||= $authuser1 ? 'PLAIN' : 'CRAM-MD5';
$authmech2 ||= $authuser2 ? 'PLAIN' : 'CRAM-MD5';
}
@ -641,7 +651,8 @@ sub login_imap {
Socket => $socssl,
Server => $host,
);
} else {
}
else {
$imap = Mail::IMAPClient->new();
}
$imap->Clear(20);
@ -656,7 +667,8 @@ sub login_imap {
if ($ssl) {
$imap->State(Mail::IMAPClient::Connected);
} else {
}
else {
$imap->connect2()
or die "Can not open imap connection on [$host] with user [$user] : $@\n";
}
@ -667,7 +679,8 @@ sub login_imap {
) {
printf("Host %s says it has CAPABILITY for AUTHENTICATE %s\n",
$imap->Server, $authmech);
} else {
}
else {
printf("Host %s says it has NO CAPABILITY for AUTHENTICATE %s\n",
$imap->Server, $authmech);
if ($authmech eq 'PLAIN') {
@ -727,43 +740,191 @@ print "To state Authenticated\n";
$split1 and $from->Split($split1);
$split2 and $to->Split($split2);
#
# Folder stuff
#
my (@f_folders, %requested_folder, @t_folders, %subscribed_folder, %t_folders);
sub tests_folder_routines {
ok( !give_requested_folders() ,"no requested folders" );
ok( !is_requested_folder('folder_foo') );
ok( add_to_requested_folders('folder_foo') );
ok( is_requested_folder('folder_foo') );
ok( !is_requested_folder('folder_NO_EXIST') );
ok( !remove_from_requested_folders('folder_foo'), "removed folder_foo");
ok( !is_requested_folder('folder_foo') );
my @f;
ok( @f = add_to_requested_folders('folder_bar', 'folder_toto'), "add result: @f");
ok( is_requested_folder('folder_bar') );
ok( is_requested_folder('folder_toto') );
ok( remove_from_requested_folders('folder_toto') );
ok( !is_requested_folder('folder_toto') );
ok( init_requested_folders() , 'empty requested folders');
ok( !give_requested_folders() , 'no requested folders' );
}
sub give_requested_folders {
return(keys(%requested_folder));
}
sub init_requested_folders {
%requested_folder = ();
return(1);
}
sub is_requested_folder {
my ( $folder ) = @_;
defined( $requested_folder{ $folder } );
}
sub add_to_requested_folders {
my @wanted_folders = @_;
foreach my $folder ( @wanted_folders ) {
++$requested_folder{ $folder };
}
return( keys( %requested_folder ) );
}
sub remove_from_requested_folders {
my @wanted_folders = @_;
foreach my $folder (@wanted_folders) {
delete $requested_folder{$folder};
}
return( keys(%requested_folder) );
}
my (@f_folders, @t_folders, %fs_folders, %t_folders);
# Make a hash of subscribed folders in source server.
map { $fs_folders{$_}=1 } $from->subscribed();
map { $subscribed_folder{$_} = 1 } $from->subscribed();
my @all_source_folders = sort $from->folders();
if (scalar(@folder) or $subscribed or scalar(@folderrec)) {
# folders given by option --folder
push(@f_folders, @folder) if scalar(@folder);
# option --subscribed
push(@f_folders, sort keys (%fs_folders)) if ($subscribed);
if (scalar(@folder)) {
add_to_requested_folders(@folder);
}
# option --subscribed
if ($subscribed) {
add_to_requested_folders(keys (%subscribed_folder));
}
# option --folderrec
if (scalar(@folderrec)) {
foreach my $folderrec (@folderrec) {
push(@f_folders, $from->folders($folderrec));
add_to_requested_folders($from->folders($folderrec));
}
}
@f_folders = sort @f_folders;
}else {
# no folder/subscribed/folderrec options => all folders
@f_folders = sort $from->folders();
}
else {
# no include, no folder/subscribed/folderrec options => all folders
if (not scalar(@include)) {
add_to_requested_folders(@all_source_folders);
}
}
# consider (optional) includes and excludes
if (scalar(@include)) {
my @f_folders_inc;
foreach my $include (@include) {
push(@f_folders_inc, grep /$include/, @f_folders);
print "Including folders matching pattern '$include'\n";
my @included_folders = grep /$include/, @all_source_folders;
add_to_requested_folders(@included_folders);
print "Including folders matching pattern '$include': @included_folders\n";
}
push(@f_folders, sort @f_folders_inc);
}
foreach my $exclude (@exclude) {
@f_folders = grep !/$exclude/,@f_folders;
print "Excluding folders matching pattern '$exclude'\n";
if (scalar(@exclude)) {
foreach my $exclude (@exclude) {
my @requested_folder = sort(keys(%requested_folder));
my @excluded_folders = grep /$exclude/, @requested_folder;
remove_to_requested_folders(@excluded_folders);
print "Excluding folders matching pattern '$exclude': @excluded_folders\n";
}
}
my @requested_folder = sort(keys(%requested_folder));
@f_folders = @requested_folder;
sub compare_lists {
my ($list_1_ref, $list_2_ref) = @_;
return(-1) if ((not defined($list_1_ref)) and defined($list_2_ref));
return(0) if (! $list_1_ref); # end if no list
return(1) if (! $list_2_ref); # end if only one list
if (not ref($list_1_ref)) {$list_1_ref = [$list_1_ref]};
if (not ref($list_2_ref)) {$list_2_ref = [$list_2_ref]};
my $last_used_indice = 0;
ELEMENT:
foreach my $indice ( 0 .. $#$list_1_ref ) {
$last_used_indice = $indice;
# End of list_2
return 1 if ($indice > $#$list_2_ref);
my $element_list_1 = $list_1_ref->[$indice];
my $element_list_2 = $list_2_ref->[$indice];
my $balance = $element_list_1 cmp $element_list_2 ;
next ELEMENT if ($balance == 0) ;
return $balance;
}
# each element equal until last indice of list_1
return -1 if ($last_used_indice < $#$list_2_ref);
# same size, each element equal
return 0
}
sub tests_compare_lists {
my $empty_list_ref = [];
ok( 0 == compare_lists() , 'compare_lists, no args');
ok( 0 == compare_lists(undef) , 'compare_lists, undef = nothing');
ok( 0 == compare_lists(undef, undef) , 'compare_lists, undef = undef');
ok(-1 == compare_lists(undef , []) , 'compare_lists, undef < []');
ok(+1 == compare_lists([]) , 'compare_lists, [] > nothing');
ok(+1 == compare_lists([], undef) , 'compare_lists, [] > undef');
ok( 0 == compare_lists([] , []) , 'compare_lists, [] = []');
ok( 0 == compare_lists([1], 1 ) , "compare_lists, [1] = 1 ") ;
ok( 0 == compare_lists( 1 , [1]) , "compare_lists, 1 = [1]") ;
ok( 0 == compare_lists( 1 , 1 ) , "compare_lists, 1 = 1 ") ;
ok(-1 == compare_lists( 1 , 2 ) , "compare_lists, 1 = 1 ") ;
ok(+1 == compare_lists( 2 , 1 ) , "compare_lists, 1 = 1 ") ;
ok( 0 == compare_lists([1,2], [1,2]) , "compare_lists, [1,2] = [1,2]") ;
ok(-1 == compare_lists([1], [1,2]) , "compare_lists, [1] < [1,2]") ;
ok(-1 == compare_lists([1], [1,1]) , "compare_lists, [1] < [1,1]") ;
ok(+1 == compare_lists([1, 1], [1]) , "compare_lists, [1, 1] > [1]") ;
ok( 0 == compare_lists([1 .. 20_000] , [1 .. 20_000])
, "compare_lists, [1..20_000] = [1..20_000]") ;
ok(-1 == compare_lists([1], [3]) , 'compare_lists, [1] < [3]') ;
ok( 0 == compare_lists([2], [2]) , 'compare_lists, [0] = [2]') ;
ok(+1 == compare_lists([3], [1]) , 'compare_lists, [3] > [1]') ;
ok(-1 == compare_lists(["a"], ["b"]) , 'compare_lists, ["a"] < ["b"]') ;
ok( 0 == compare_lists(["a"], ["a"]) , 'compare_lists, ["a"] = ["a"]') ;
ok( 0 == compare_lists(["ab"], ["ab"]) , 'compare_lists, ["ab"] = ["ab"]') ;
ok(+1 == compare_lists(["b"], ["a"]) , 'compare_lists, ["b"] > ["a"]') ;
ok(-1 == compare_lists(["a"], ["aa"]) , 'compare_lists, ["a"] < ["aa"]') ;
ok(-1 == compare_lists(["a"], ["a", "a"]), 'compare_lists, ["a"] < ["a", "a"]') ;
}
@ -801,7 +962,8 @@ sub get_prefix {
my $r_namespace = $imap->namespace();
$prefix_out = $r_namespace->[0][0][0];
return($prefix_out);
}else{
}
else{
print
"No NAMESPACE capability in imap server ",
$imap->Server(),"\n",
@ -825,7 +987,8 @@ sub get_separator {
if ($imap->has_capability("namespace")) {
$sep_out = $imap->separator();
return($sep_out);
}else{
}
else{
print
"No NAMESPACE capability in imap server ",
$imap->Server(),"\n",
@ -870,7 +1033,8 @@ sub foldersizes {
or warn "Could not find size of message $m: $@\n";
$stot += $s;
}
}else{
}
else{
my $hashref = {};
$smess = $imap->message_count();
unless ($smess == 0) {
@ -932,7 +1096,7 @@ print
print
"From subscribed folders list : ",
map("[$_] ", sort keys(%fs_folders)), "\n"
map("[$_] ", sort keys(%subscribed_folder)), "\n"
if ($subscribed);
sub separator_invert {
@ -1030,7 +1194,8 @@ FOLDER: foreach my $f_fold (@f_folders) {
$error++;
next FOLDER;
}
}else{
}
else{
next FOLDER;
}
}
@ -1051,7 +1216,7 @@ FOLDER: foreach my $f_fold (@f_folders) {
#unless($dry) { $to->expunge() };
}
if ($subscribe and exists $fs_folders{$f_fold}) {
if ($subscribe and exists $subscribed_folder{$f_fold}) {
print "Subscribing to folder $t_fold on destination server\n";
unless($dry) { $to->subscribe($t_fold) };
}
@ -1198,7 +1363,8 @@ FOLDER: foreach my $f_fold (@f_folders) {
$error++;
$mess_size_total_error += $f_size;
next MESS;
}else{
}
else{
# good
# $new_id is an id if the IMAP server has the
# UIDPLUS capability else just a ref
@ -1211,12 +1377,14 @@ FOLDER: foreach my $f_fold (@f_folders) {
$from->expunge() if ($expunge and not $dry);
}
}
}else{
}
else{
$mess_skipped_dry += 1;
}
unlink($message_file);
next MESS;
}else{
}
else{
$debug and print "Message id [$m_id] found in t:$t_fold\n";
$mess_size_total_skipped += $f_size;
$mess_skipped += 1;
@ -1279,7 +1447,8 @@ FOLDER: foreach my $f_fold (@f_folders) {
print "Deleting msg f:#$t_msg in folder $t_fold\n";
$to->delete_message($t_msg) unless ($dry);
}
}else {
}
else {
# Good
$debug and print
"Message $m_id SZ_GOOD f:$f_msg:$f_size t:$t_msg:$t_size\n";
@ -1310,6 +1479,9 @@ $timediff = $timeend - $timestart;
stats();
exit(1) if($error);
sub select_msgs {
@ -1426,12 +1598,23 @@ sub get_options
"authuser2=s" => \$authuser2,
"split1=i" => \$split1,
"split2=i" => \$split2,
"tests" => \$tests,
);
$debug and print "get options: [$opt_ret]\n";
$test_builder = Test::More->builder;
$test_builder->no_ending(1);
# just the version
print "$VERSION\n" and exit if ($version) ;
if ($tests) {
$test_builder->no_ending(0);
tests();
exit;
}
# exit with --help option or no option at all
usage() and exit if ($help or ! $numopt) ;
@ -1485,7 +1668,8 @@ sub parse_header_msg1 {
my $key;
if ($skipsize) {
$key = "$m_md5";
}else {
}
else {
$key = "$m_md5:$size";
}
$s_hash->{"$key"}{'5'} = $m_md5;
@ -1669,6 +1853,16 @@ EOF
}
sub tests {
SKIP: {
skip "No test in normal run" if (not $tests);
tests_folder_routines();
tests_compare_lists();
}
}
package Mail::IMAPClient;
@ -1748,25 +1942,25 @@ sub append_file2 {
unless ($feedback) {
$self->LastError("Error sending '$string' to IMAP: $!\n");
close $fh;
$fh->close;
return undef;
}
my ($code, $output) = ("","");
until ( $code ) {
$output = $self->_read_line or close $fh, return undef;
$output = $self->_read_line or $fh->close, return undef;
foreach my $o (@$output) {
$self->_record($count,$o); # $o is already an array ref
($code) = $o->[DATA] =~ /(^\+|^\d+\sNO|^\d+\sBAD)/i;
if ($o->[DATA] =~ /^\*\s+BYE/) {
carp $o->[DATA] if $^W;
$self->State(Unconnected);
close $fh;
$fh->close;
return undef ;
} elsif ( $o->[DATA]=~ /^\d+\s+(NO|BAD)/i ) {
carp $o->[DATA] if $^W;
close $fh;
$fh->close;
return undef;
}
}
@ -1782,7 +1976,7 @@ sub append_file2 {
unless ($feedback) {
$self->LastError("Error sending append msg text to IMAP: $!\n");
close $fh;
$fh->close;
return undef;
}
_debug $self, "control points to $$control\n" if ref($control) and $self->Debug;
@ -1796,7 +1990,7 @@ sub append_file2 {
unless ($feedback) {
$self->LastError("Error sending append msg text to IMAP: $!\n");
close $fh;
$fh->close;
return undef;
}
}
@ -1804,7 +1998,7 @@ sub append_file2 {
unless ($feedback) {
$self->LastError("Error sending append msg text to IMAP: $!\n");
close $fh;
$fh->close;
return undef;
}
}
@ -1825,16 +2019,16 @@ sub append_file2 {
if ($o->[DATA] =~ /^\*\s+BYE/) {
carp $o->[DATA] if $^W;
$self->State(Unconnected);
close $fh;
$fh->close;
return undef ;
} elsif ( $o->[DATA]=~ /^\d+\s+(NO|BAD)/i ) {
carp $o->[DATA] if $^W;
close $fh;
$fh->close;
return undef;
}
}
}
close $fh;
$fh->close;
if ($code !~ /^OK/i) {
return undef;
@ -1871,15 +2065,18 @@ sub fetch_hash2 {
next unless $uid;
if ( exists $hash->{$uid} ) {
$entry = $hash->{$uid} ;
} else {
}
else {
$hash->{$uid} ||= $entry;
}
} else {
}
else {
my($mid) = $l =~ /^\* (\d+) FETCH/i;
next unless $mid;
if ( exists $hash->{$mid} ) {
$entry = $hash->{$mid} ;
} else {
}
else {
$hash->{$mid} ||= $entry;
}
}
@ -1889,7 +2086,8 @@ sub fetch_hash2 {
$entry->{$w} = $output->[$x+1];
$entry->{$w} =~ s/(?:\x0a?\x0d)+$//g;
chomp $entry->{$w};
} else {
}
else {
$l =~ /\( # open paren followed by ...
(?:.*\s)? # ...optional stuff and a space
\Q$w\E\s # escaped fetch field<sp>
@ -1933,7 +2131,7 @@ sub login2 {
$carp =~ s/^[\S]+ ([^\x0d\x0a]*)\x0d?\x0a/$1/;
carp $carp unless defined wantarray;
return undef;
}
};
return $self;
}
@ -1969,7 +2167,7 @@ sub parse_headers2 {
".peek"
) . "[header]" ;
} else {
}else {
$string = "$msg body" .
# use ".peek" if Peek parameter is a) defined and true, or
# b) undefined, but not if it's defined and untrue:
@ -1992,10 +2190,12 @@ sub parse_headers2 {
if ( my($msgid) = $header =~ /UID\s+(\d+)/ ) {
$h = {};
$headers->{$msgid} = $h;
} else {
}
else {
$h = {};
}
} else {
}
else {
if ( my($msgid) = $header =~ /^\*\s+(\d+)/ ) {
#start of new message header:
$h = {};
@ -2104,7 +2304,8 @@ sub authenticate2 {
if ($Mail::IMAPClient::_CRAM_MD5_ERR) {
$self->LastError($Mail::IMAPClient::_CRAM_MD5_ERR);
carp $Mail::IMAPClient::_CRAM_MD5_ERR if $^W;
} else {
}
else {
$response = \&_cram_md5_2;
}
}
@ -2159,8 +2360,8 @@ sub connect2 {
and $IO::Socket::INET::VERSION eq '1.25'
and !$self->Port;
%$self = (%$self, @_);
my $sock = ($self->Ssl ? IO::Socket::SSL->new : IO::Socket::INET->new);
my $dp = ($self->Ssl ? 'imaps(993)' : 'imap(143)');
my $sock = IO::Socket::INET->new;
my $dp = 'imap(143)';
#print "i01\n";
my $ret = $sock->configure({
PeerAddr => $self->Server ,
@ -2206,7 +2407,8 @@ sub connect2 {
if ($self->User and $self->Password) {
return $self->login ;
} else {
}
else {
return $self;
}
}

2384
imapsync2 Executable file

File diff suppressed because it is too large Load Diff

4
memo
View File

@ -27,8 +27,8 @@ else
cat > $NEWS_FILE << EOF
<news date="`date '+%Y%m%d'`">
`LANG=fr date '+%A %d %B %Y'` : Synchronisez ou migrez vos boites
aux lettres avec économie et l\'outil <A
`LANG=fr_FR date '+%A %d %B %Y'` : Synchronisez ou migrez vos boites
aux lettres avec économie et l'outil <A
HREF="prj/imapsync/">imapsync $VERSION</A> (Gilles LAMIRAL)
</news>
EOF

8
t/01_connect Normal file → Executable file
View File

@ -1,12 +1,12 @@
#!/usr/bin/perl -w
use Carp;
use Mail::IMAPClient;
$imap = Mail::IMAPClient->new();
$imap = Mail::IMAPClient->new(Debug => 1);
$imap->Debug(1);
$imap->Server('Xlouloutte.dyndns.org');
$imap->connect() or die;
$imap->Server('louloutte.dyndns.org');
$imap->connect() or croak "Error connecting @!";
$imap->User('MarkOv@est.belle');
$imap->Password('emhj91ly');
$imap->login();

16
t/01_connect.229.dump Normal file
View File

@ -0,0 +1,16 @@
Using Mail::IMAPClient version 2.2.9 and perl version 5.8.8 (5.008008)
Read: * OK [CAPABILITY IMAP4rev1 UIDPLUS CHILDREN NAMESPACE THREAD=ORDEREDSUBJECT THREAD=REFERENCES SORT QUOTA AUTH=PLAIN CRAM-MD5 CRAM-SHA1 IDLE STARTTLS] Courier-IMAP ready. Copyright 1998-2005 Double Precision, Inc. See COPYING for distribution information.
Connect: Received this from readline: 0/OUTPUT/* OK [CAPABILITY IMAP4rev1 UIDPLUS CHILDREN NAMESPACE THREAD=ORDEREDSUBJECT THREAD=REFERENCES SORT QUOTA AUTH=PLAIN CRAM-MD5 CRAM-SHA1 IDLE STARTTLS] Courier-IMAP ready. Copyright 1998-2005 Double Precision, Inc. See COPYING for distribution information.
Sending: 1 Login "XXXXXXXX" XXXXXXXX
Sent 37 bytes
Read: 1 OK LOGIN Ok.
Sending: 2 LOGOUT
Sent 10 bytes
Read: * BYE Courier-IMAP server shutting down
2 OK LOGOUT completed

743
t/01_connect_2.99_02.dump Normal file
View File

@ -0,0 +1,743 @@
82$ perl -d -I Mail-IMAPClient-2.99_02/lib t/01_connect
Loading DB routines from perl5db.pl version 1.28
Editor support available.
Enter h or `h h' for help, or `man perldebug' for more help.
main::(t/01_connect:6): $imap = Mail::IMAPClient->new(Debug => 1);
DB<1> t
Trace = on
DB<1> c
Mail::IMAPClient::new(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:171):
171: { my $class = shift;
Mail::IMAPClient::new(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:172):
172: my $self =
173: { LastError => "",
174: , Uid => 1
175: , Count => 0
176: , Fast_io => 1
177: , Clear => 5
178: , Maxtemperrors => 'unlimited'
179: , State => Unconnected
Mail::IMAPClient::new(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:181):
181: while(@_)
Mail::IMAPClient::new(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:182):
182: { my $k = ucfirst lc shift;
Mail::IMAPClient::new(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:183):
183: $self->{$k} = shift;
Mail::IMAPClient::new(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:185):
185: bless $self, ref($class)||$class;
Mail::IMAPClient::new(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:187):
187: if($self->{Supportedflags}) # unpack into case-less HASH
Mail::IMAPClient::new(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:192):
192: $self->{Debug_fh} ||= \*STDERR;
Mail::IMAPClient::new(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:193):
193: select((select($self->{Debug_fh}),$|++)[0]);
Mail::IMAPClient::new(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:195):
195: $self->_debug("Using Mail::IMAPClient version $Mail::IMAPClient::VERSION " .
196: "and perl version " . (defined $^V ? join(".",unpack("CCC",$^V)) : "") .
197: " ($])\n") if $self->Debug;
Mail::IMAPClient::CODE(0x850ebc0)(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:55):
55: *$datum = sub { @_ > 1 ? $_[0]->{$datum} = $_[1] : $_[0]->{$datum} };
Mail::IMAPClient::_debug(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:40):
40: { my $self = shift;
Mail::IMAPClient::_debug(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:41):
41: return unless $self->Debug;
Mail::IMAPClient::CODE(0x850ebc0)(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:55):
55: *$datum = sub { @_ > 1 ? $_[0]->{$datum} = $_[1] : $_[0]->{$datum} };
Mail::IMAPClient::_debug(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:42):
42: my $fh = $self->{Debug_fh} || \*STDERR;
Mail::IMAPClient::_debug(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:43):
43: print $fh @_;
Using Mail::IMAPClient version 2.99_02 and perl version 5.8.8 (5.008008)
Mail::IMAPClient::new(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:199):
199: if($self->{Socket}) { $self->Socket($self->{Socket}) }
Mail::IMAPClient::new(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:202):
202: $self;
main::(t/01_connect:7): $imap->Debug(1);
Mail::IMAPClient::CODE(0x850ebc0)(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:55):
55: *$datum = sub { @_ > 1 ? $_[0]->{$datum} = $_[1] : $_[0]->{$datum} };
main::(t/01_connect:8): $imap->Server('louloutte.dyndns.org');
Mail::IMAPClient::CODE(0x850e878)(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:55):
55: *$datum = sub { @_ > 1 ? $_[0]->{$datum} = $_[1] : $_[0]->{$datum} };
main::(t/01_connect:9): $imap->connect() or croak "Error connecting @!";
Mail::IMAPClient::connect(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:206):
206: { my $self = shift;
Mail::IMAPClient::connect(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:207):
207: %$self = (%$self, @_);
Mail::IMAPClient::connect(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:209):
209: my $sock = IO::Socket::INET->new
210: ( PeerAddr => $self->Server
211: , PeerPort => ( $self->Port || 'imap(143)')
212: , Timeout => ($self->Timeout || 0)
213: , Proto => 'tcp'
214: , Debug => $self->Debug
215: );
Mail::IMAPClient::CODE(0x850e878)(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:55):
55: *$datum = sub { @_ > 1 ? $_[0]->{$datum} = $_[1] : $_[0]->{$datum} };
Mail::IMAPClient::CODE(0x850e800)(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:55):
55: *$datum = sub { @_ > 1 ? $_[0]->{$datum} = $_[1] : $_[0]->{$datum} };
Mail::IMAPClient::CODE(0x850ead0)(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:55):
55: *$datum = sub { @_ > 1 ? $_[0]->{$datum} = $_[1] : $_[0]->{$datum} };
Mail::IMAPClient::CODE(0x850ebc0)(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:55):
55: *$datum = sub { @_ > 1 ? $_[0]->{$datum} = $_[1] : $_[0]->{$datum} };
IO::Socket::INET::new(/usr/lib/perl/5.8/IO/Socket/INET.pm:30):
30: my $class = shift;
IO::Socket::INET::new(/usr/lib/perl/5.8/IO/Socket/INET.pm:31):
31: unshift(@_, "PeerAddr") if @_ == 1;
IO::Socket::INET::new(/usr/lib/perl/5.8/IO/Socket/INET.pm:32):
32: return $class->SUPER::new(@_);
IO::Socket::new(/usr/lib/perl/5.8/IO/Socket.pm:41):
41: my($class,%arg) = @_;
IO::Socket::new(/usr/lib/perl/5.8/IO/Socket.pm:42):
42: my $sock = $class->SUPER::new();
IO::Handle::new(/usr/lib/perl/5.8/IO/Handle.pm:53):
53: my $class = ref($_[0]) || $_[0] || "IO::Handle";
IO::Handle::new(/usr/lib/perl/5.8/IO/Handle.pm:54):
54: @_ == 1 or croak "usage: new $class";
IO::Handle::new(/usr/lib/perl/5.8/IO/Handle.pm:55):
55: my $io = gensym;
Symbol::gensym(/usr/share/perl/5.8/Symbol.pm:23):
23: my $name = "GEN" . $genseq++;
Symbol::gensym(/usr/share/perl/5.8/Symbol.pm:24):
24: my $ref = \*{$genpkg . $name};
Symbol::gensym(/usr/share/perl/5.8/Symbol.pm:24):
24: my $ref = \*{$genpkg . $name};
Symbol::gensym(/usr/share/perl/5.8/Symbol.pm:25):
25: delete $$genpkg{$name};
Symbol::gensym(/usr/share/perl/5.8/Symbol.pm:26):
26: $ref;
IO::Handle::new(/usr/lib/perl/5.8/IO/Handle.pm:56):
56: bless $io, $class;
IO::Socket::new(/usr/lib/perl/5.8/IO/Socket.pm:44):
44: $sock->autoflush(1);
IO::Handle::autoflush(/usr/lib/perl/5.8/IO/Handle.pm:213):
213: my $old = new SelectSaver qualify($_[0], caller);
Symbol::qualify(/usr/share/perl/5.8/Symbol.pm:39):
39: my ($name) = @_;
Symbol::qualify(/usr/share/perl/5.8/Symbol.pm:40):
40: if (!ref($name) && index($name, '::') == -1 && index($name, "'") == -1) {
Symbol::qualify(/usr/share/perl/5.8/Symbol.pm:53):
53: $name;
SelectSaver::new(/usr/share/perl/5.8/SelectSaver.pm:10):
10: @_ >= 1 && @_ <= 2 or croak 'usage: new SelectSaver [FILEHANDLE]';
SelectSaver::new(/usr/share/perl/5.8/SelectSaver.pm:11):
11: my $fh = select;
SelectSaver::new(/usr/share/perl/5.8/SelectSaver.pm:12):
12: my $self = bless \$fh, $_[0];
SelectSaver::new(/usr/share/perl/5.8/SelectSaver.pm:13):
13: select qualify($_[1], caller) if @_ > 1;
Symbol::qualify(/usr/share/perl/5.8/Symbol.pm:39):
39: my ($name) = @_;
Symbol::qualify(/usr/share/perl/5.8/Symbol.pm:40):
40: if (!ref($name) && index($name, '::') == -1 && index($name, "'") == -1) {
Symbol::qualify(/usr/share/perl/5.8/Symbol.pm:53):
53: $name;
SelectSaver::new(/usr/share/perl/5.8/SelectSaver.pm:14):
14: $self;
IO::Handle::autoflush(/usr/lib/perl/5.8/IO/Handle.pm:214):
214: my $prev = $|;
IO::Handle::autoflush(/usr/lib/perl/5.8/IO/Handle.pm:215):
215: $| = @_ > 1 ? $_[1] : 1;
IO::Handle::autoflush(/usr/lib/perl/5.8/IO/Handle.pm:216):
216: $prev;
SelectSaver::DESTROY(/usr/share/perl/5.8/SelectSaver.pm:18):
18: my $self = $_[0];
SelectSaver::DESTROY(/usr/share/perl/5.8/SelectSaver.pm:19):
19: select $$self;
IO::Socket::new(/usr/lib/perl/5.8/IO/Socket.pm:46):
46: ${*$sock}{'io_socket_timeout'} = delete $arg{Timeout};
IO::Socket::new(/usr/lib/perl/5.8/IO/Socket.pm:46):
46: ${*$sock}{'io_socket_timeout'} = delete $arg{Timeout};
IO::Socket::new(/usr/lib/perl/5.8/IO/Socket.pm:48):
48: return scalar(%arg) ? $sock->configure(\%arg)
49: : $sock;
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:104):
104: my($sock,$arg) = @_;
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:105):
105: my($lport,$rport,$laddr,$raddr,$proto,$type);
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:107):
107: $arg->{LocalAddr} = $arg->{LocalHost}
108: if exists $arg->{LocalHost} && !exists $arg->{LocalAddr};
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:110):
110: ($laddr,$lport,$proto) = _sock_info($arg->{LocalAddr},
111: $arg->{LocalPort},
112: $arg->{Proto})
113: or return _error($sock, $!, $@);
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:36):
36: my($addr,$port,$proto) = @_;
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:37):
37: my $origport = $port;
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:38):
38: my @proto = ();
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:39):
39: my @serv = ();
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:41):
41: $port = $1
42: if(defined $addr && $addr =~ s,:([\w\(\)/]+)$,,);
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:44):
44: if(defined $proto && $proto =~ /\D/) {
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:45):
45: if(@proto = getprotobyname($proto)) {
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:46):
46: $proto = $proto[2] || undef;
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:54):
54: if(defined $port) {
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:71):
71: return ($addr || undef,
72: $port || undef,
73: $proto || undef
74: );
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:115):
115: $laddr = defined $laddr ? inet_aton($laddr)
116: : INADDR_ANY;
Socket::AUTOLOAD(/usr/lib/perl/5.8/Socket.pm:216):
216: my($constname);
Socket::AUTOLOAD(/usr/lib/perl/5.8/Socket.pm:217):
217: ($constname = $AUTOLOAD) =~ s/.*:://;
Socket::AUTOLOAD(/usr/lib/perl/5.8/Socket.pm:218):
218: croak "&Socket::constant not defined" if $constname eq 'constant';
Socket::AUTOLOAD(/usr/lib/perl/5.8/Socket.pm:219):
219: my ($error, $val) = constant($constname);
Socket::AUTOLOAD(/usr/lib/perl/5.8/Socket.pm:220):
220: if ($error) {
Socket::AUTOLOAD(/usr/lib/perl/5.8/Socket.pm:223):
223: *$AUTOLOAD = sub { $val };
Socket::AUTOLOAD(/usr/lib/perl/5.8/Socket.pm:224):
224: goto &$AUTOLOAD;
Socket::__ANON__[/usr/lib/perl/5.8/Socket.pm:223](/usr/lib/perl/5.8/Socket.pm:223):
223: *$AUTOLOAD = sub { $val };
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:118):
118: return _error($sock, $EINVAL, "Bad hostname '",$arg->{LocalAddr},"'")
119: unless(defined $laddr);
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:121):
121: $arg->{PeerAddr} = $arg->{PeerHost}
122: if exists $arg->{PeerHost} && !exists $arg->{PeerAddr};
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:124):
124: unless(exists $arg->{Listen}) {
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:125):
125: ($raddr,$rport,$proto) = _sock_info($arg->{PeerAddr},
126: $arg->{PeerPort},
127: $proto)
128: or return _error($sock, $!, $@);
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:36):
36: my($addr,$port,$proto) = @_;
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:37):
37: my $origport = $port;
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:38):
38: my @proto = ();
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:39):
39: my @serv = ();
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:41):
41: $port = $1
42: if(defined $addr && $addr =~ s,:([\w\(\)/]+)$,,);
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:44):
44: if(defined $proto && $proto =~ /\D/) {
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:54):
54: if(defined $port) {
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:55):
55: my $defport = ($port =~ s,\((\d+)\)$,,) ? $1 : undef;
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:56):
56: my $pnum = ($port =~ m,^(\d+)$,)[0];
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:58):
58: @serv = getservbyname($port, $proto[0] || "")
59: if ($port =~ m,\D,);
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:61):
61: $port = $serv[2] || $defport || $pnum;
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:62):
62: unless (defined $port) {
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:67):
67: $proto = (getprotobyname($serv[3]))[2] || undef
68: if @serv && !$proto;
IO::Socket::INET::_sock_info(/usr/lib/perl/5.8/IO/Socket/INET.pm:71):
71: return ($addr || undef,
72: $port || undef,
73: $proto || undef
74: );
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:131):
131: $proto ||= (getprotobyname('tcp'))[2];
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:133):
133: my $pname = (getprotobynumber($proto))[0];
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:134):
134: $type = $arg->{Type} || $socket_type{lc $pname};
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:136):
136: my @raddr = ();
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:138):
138: if(defined $raddr) {
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:139):
139: @raddr = $sock->_get_addr($raddr, $arg->{MultiHomed});
IO::Socket::INET::_get_addr(/usr/lib/perl/5.8/IO/Socket/INET.pm:92):
92: my($sock,$addr_str, $multi) = @_;
IO::Socket::INET::_get_addr(/usr/lib/perl/5.8/IO/Socket/INET.pm:93):
93: my @addr;
IO::Socket::INET::_get_addr(/usr/lib/perl/5.8/IO/Socket/INET.pm:94):
94: if ($multi && $addr_str !~ /^\d+(?:\.\d+){3}$/) {
IO::Socket::INET::_get_addr(/usr/lib/perl/5.8/IO/Socket/INET.pm:97):
97: my $h = inet_aton($addr_str);
IO::Socket::INET::_get_addr(/usr/lib/perl/5.8/IO/Socket/INET.pm:98):
98: push(@addr, $h) if defined $h;
IO::Socket::INET::_get_addr(/usr/lib/perl/5.8/IO/Socket/INET.pm:100):
100: @addr;
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:140):
140: return _error($sock, $EINVAL, "Bad hostname '",$arg->{PeerAddr},"'")
141: unless @raddr;
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:144):
144: while(1) {
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:146):
146: $sock->socket(AF_INET, $type, $proto) or
147: return _error($sock, $!, "$!");
Socket::CODE(0x84615a4)(/usr/lib/perl/5.8/Socket.pm:223):
223: *$AUTOLOAD = sub { $val };
IO::Socket::socket(/usr/lib/perl/5.8/IO/Socket.pm:77):
77: @_ == 4 or croak 'usage: $sock->socket(DOMAIN, TYPE, PROTOCOL)';
IO::Socket::socket(/usr/lib/perl/5.8/IO/Socket.pm:78):
78: my($sock,$domain,$type,$protocol) = @_;
IO::Socket::socket(/usr/lib/perl/5.8/IO/Socket.pm:80):
80: socket($sock,$domain,$type,$protocol) or
81: return undef;
IO::Socket::socket(/usr/lib/perl/5.8/IO/Socket.pm:83):
83: ${*$sock}{'io_socket_domain'} = $domain;
IO::Socket::socket(/usr/lib/perl/5.8/IO/Socket.pm:83):
83: ${*$sock}{'io_socket_domain'} = $domain;
IO::Socket::socket(/usr/lib/perl/5.8/IO/Socket.pm:84):
84: ${*$sock}{'io_socket_type'} = $type;
IO::Socket::socket(/usr/lib/perl/5.8/IO/Socket.pm:84):
84: ${*$sock}{'io_socket_type'} = $type;
IO::Socket::socket(/usr/lib/perl/5.8/IO/Socket.pm:85):
85: ${*$sock}{'io_socket_proto'} = $protocol;
IO::Socket::socket(/usr/lib/perl/5.8/IO/Socket.pm:85):
85: ${*$sock}{'io_socket_proto'} = $protocol;
IO::Socket::socket(/usr/lib/perl/5.8/IO/Socket.pm:87):
87: $sock;
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:149):
149: if (defined $arg->{Blocking}) {
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:154):
154: if ($arg->{Reuse} || $arg->{ReuseAddr}) {
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:159):
159: if ($arg->{ReusePort}) {
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:164):
164: if ($arg->{Broadcast}) {
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:169):
169: if($lport || ($laddr ne INADDR_ANY) || exists $arg->{Listen}) {
Socket::CODE(0x86a3604)(/usr/lib/perl/5.8/Socket.pm:223):
223: *$AUTOLOAD = sub { $val };
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:174):
174: if(exists $arg->{Listen}) {
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:181):
181: last unless exists($arg->{PeerAddr});
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:183):
183: $raddr = shift @raddr;
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:185):
185: return _error($sock, $EINVAL, 'Cannot determine remote port')
186: unless($rport || $type == SOCK_DGRAM || $type == SOCK_RAW);
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:189):
189: unless($type == SOCK_STREAM || defined $raddr);
Socket::CODE(0x8476f40)(/usr/lib/perl/5.8/Socket.pm:223):
223: *$AUTOLOAD = sub { $val };
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:191):
191: return _error($sock, $EINVAL, "Bad hostname '",$arg->{PeerAddr},"'")
192: unless defined $raddr;
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:197):
197: undef $@;
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:198):
198: if ($sock->connect(pack_sockaddr_in($rport, $raddr))) {
IO::Socket::INET::connect(/usr/lib/perl/5.8/IO/Socket/INET.pm:220):
220: @_ == 2 || @_ == 3 or
221: croak 'usage: $sock->connect(NAME) or $sock->connect(PORT, ADDR)';
IO::Socket::INET::connect(/usr/lib/perl/5.8/IO/Socket/INET.pm:222):
222: my $sock = shift;
IO::Socket::INET::connect(/usr/lib/perl/5.8/IO/Socket/INET.pm:223):
223: return $sock->SUPER::connect(@_ == 1 ? shift : pack_sockaddr_in(@_));
IO::Socket::connect(/usr/lib/perl/5.8/IO/Socket.pm:106):
106: @_ == 2 or croak 'usage: $sock->connect(NAME)';
IO::Socket::connect(/usr/lib/perl/5.8/IO/Socket.pm:107):
107: my $sock = shift;
IO::Socket::connect(/usr/lib/perl/5.8/IO/Socket.pm:108):
108: my $addr = shift;
IO::Socket::connect(/usr/lib/perl/5.8/IO/Socket.pm:109):
109: my $timeout = ${*$sock}{'io_socket_timeout'};
IO::Socket::connect(/usr/lib/perl/5.8/IO/Socket.pm:109):
109: my $timeout = ${*$sock}{'io_socket_timeout'};
IO::Socket::connect(/usr/lib/perl/5.8/IO/Socket.pm:110):
110: my $err;
IO::Socket::connect(/usr/lib/perl/5.8/IO/Socket.pm:111):
111: my $blocking;
IO::Socket::connect(/usr/lib/perl/5.8/IO/Socket.pm:113):
113: $blocking = $sock->blocking(0) if $timeout;
IO::Socket::connect(/usr/lib/perl/5.8/IO/Socket.pm:114):
114: if (!connect($sock, $addr)) {
IO::Socket::connect(/usr/lib/perl/5.8/IO/Socket.pm:137):
137: $sock->blocking(1) if $blocking;
IO::Socket::connect(/usr/lib/perl/5.8/IO/Socket.pm:139):
139: $! = $err if $err;
IO::Socket::connect(/usr/lib/perl/5.8/IO/Socket.pm:141):
141: $err ? undef : $sock;
IO::Socket::INET::configure(/usr/lib/perl/5.8/IO/Socket/INET.pm:200):
200: return $sock;
Mail::IMAPClient::connect(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:217):
217: unless($sock)
Mail::IMAPClient::connect(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:222):
222: $self->Socket($sock);
Mail::IMAPClient::Socket(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:97):
97: { my ($self, $sock) = @_;
Mail::IMAPClient::Socket(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:98):
98: defined $sock
99: or return $self->{Socket};
Mail::IMAPClient::Socket(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:101):
101: delete $self->{_fcntl};
Mail::IMAPClient::Socket(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:103):
103: $self->{_select} = IO::Select->new($_[1]);
IO::Select::new(/usr/lib/perl/5.8/IO/Select.pm:24):
24: my $self = shift;
IO::Select::new(/usr/lib/perl/5.8/IO/Select.pm:25):
25: my $type = ref($self) || $self;
IO::Select::new(/usr/lib/perl/5.8/IO/Select.pm:27):
27: my $vec = bless [undef,0], $type;
IO::Select::new(/usr/lib/perl/5.8/IO/Select.pm:29):
29: $vec->add(@_)
30: if @_;
IO::Select::add(/usr/lib/perl/5.8/IO/Select.pm:37):
37: shift->_update('add', @_);
IO::Select::_update(/usr/lib/perl/5.8/IO/Select.pm:63):
63: my $vec = shift;
IO::Select::_update(/usr/lib/perl/5.8/IO/Select.pm:64):
64: my $add = shift eq 'add';
IO::Select::_update(/usr/lib/perl/5.8/IO/Select.pm:66):
66: my $bits = $vec->[VEC_BITS];
IO::Select::_update(/usr/lib/perl/5.8/IO/Select.pm:67):
67: $bits = '' unless defined $bits;
IO::Select::_update(/usr/lib/perl/5.8/IO/Select.pm:69):
69: my $count = 0;
IO::Select::_update(/usr/lib/perl/5.8/IO/Select.pm:70):
70: my $f;
IO::Select::_update(/usr/lib/perl/5.8/IO/Select.pm:71):
71: foreach $f (@_)
72: {
IO::Select::_update(/usr/lib/perl/5.8/IO/Select.pm:73):
73: my $fn = $vec->_fileno($f);
IO::Select::_fileno(/usr/lib/perl/5.8/IO/Select.pm:55):
55: my($self, $f) = @_;
IO::Select::_fileno(/usr/lib/perl/5.8/IO/Select.pm:56):
56: return unless defined $f;
IO::Select::_fileno(/usr/lib/perl/5.8/IO/Select.pm:57):
57: $f = $f->[0] if ref($f) eq 'ARRAY';
IO::Select::_fileno(/usr/lib/perl/5.8/IO/Select.pm:58):
58: ($f =~ /^\d+$/) ? $f : fileno($f);
IO::Select::_update(/usr/lib/perl/5.8/IO/Select.pm:74):
74: next unless defined $fn;
IO::Select::_update(/usr/lib/perl/5.8/IO/Select.pm:75):
75: my $i = $fn + FIRST_FD;
IO::Select::_update(/usr/lib/perl/5.8/IO/Select.pm:76):
76: if ($add) {
IO::Select::_update(/usr/lib/perl/5.8/IO/Select.pm:77):
77: if (defined $vec->[$i]) {
IO::Select::_update(/usr/lib/perl/5.8/IO/Select.pm:81):
81: $vec->[FD_COUNT]++;
IO::Select::_update(/usr/lib/perl/5.8/IO/Select.pm:82):
82: vec($bits, $fn, 1) = 1;
IO::Select::_update(/usr/lib/perl/5.8/IO/Select.pm:83):
83: $vec->[$i] = $f;
IO::Select::_update(/usr/lib/perl/5.8/IO/Select.pm:90):
90: $count++;
IO::Select::_update(/usr/lib/perl/5.8/IO/Select.pm:92):
92: $vec->[VEC_BITS] = $vec->[FD_COUNT] ? $bits : undef;
IO::Select::_update(/usr/lib/perl/5.8/IO/Select.pm:93):
93: $count;
IO::Select::new(/usr/lib/perl/5.8/IO/Select.pm:32):
32: $vec;
Mail::IMAPClient::connect(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:223):
223: $self->State(Connected);
Mail::IMAPClient::CODE(0x850e764)(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:55):
55: *$datum = sub { @_ > 1 ? $_[0]->{$datum} = $_[1] : $_[0]->{$datum} };
Mail::IMAPClient::connect(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:224):
224: $sock->autoflush(1);
IO::Handle::autoflush(/usr/lib/perl/5.8/IO/Handle.pm:213):
213: my $old = new SelectSaver qualify($_[0], caller);
Symbol::qualify(/usr/share/perl/5.8/Symbol.pm:39):
39: my ($name) = @_;
Symbol::qualify(/usr/share/perl/5.8/Symbol.pm:40):
40: if (!ref($name) && index($name, '::') == -1 && index($name, "'") == -1) {
Symbol::qualify(/usr/share/perl/5.8/Symbol.pm:53):
53: $name;
SelectSaver::new(/usr/share/perl/5.8/SelectSaver.pm:10):
10: @_ >= 1 && @_ <= 2 or croak 'usage: new SelectSaver [FILEHANDLE]';
SelectSaver::new(/usr/share/perl/5.8/SelectSaver.pm:11):
11: my $fh = select;
SelectSaver::new(/usr/share/perl/5.8/SelectSaver.pm:12):
12: my $self = bless \$fh, $_[0];
SelectSaver::new(/usr/share/perl/5.8/SelectSaver.pm:13):
13: select qualify($_[1], caller) if @_ > 1;
Symbol::qualify(/usr/share/perl/5.8/Symbol.pm:39):
39: my ($name) = @_;
Symbol::qualify(/usr/share/perl/5.8/Symbol.pm:40):
40: if (!ref($name) && index($name, '::') == -1 && index($name, "'") == -1) {
Symbol::qualify(/usr/share/perl/5.8/Symbol.pm:53):
53: $name;
SelectSaver::new(/usr/share/perl/5.8/SelectSaver.pm:14):
14: $self;
IO::Handle::autoflush(/usr/lib/perl/5.8/IO/Handle.pm:214):
214: my $prev = $|;
IO::Handle::autoflush(/usr/lib/perl/5.8/IO/Handle.pm:215):
215: $| = @_ > 1 ? $_[1] : 1;
IO::Handle::autoflush(/usr/lib/perl/5.8/IO/Handle.pm:216):
216: $prev;
SelectSaver::DESTROY(/usr/share/perl/5.8/SelectSaver.pm:18):
18: my $self = $_[0];
SelectSaver::DESTROY(/usr/share/perl/5.8/SelectSaver.pm:19):
19: select $$self;
Mail::IMAPClient::connect(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:226):
226: my $code;
227: LINE:
Mail::IMAPClient::connect(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:228):
228: while(my $output = $self->_read_line)
Mail::IMAPClient::_read_line(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:1274):
1274: { my ($self, $literal_callback, $output_callback) = @_;
Mail::IMAPClient::_read_line(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:1276):
1276: my $sh = $self->Socket;
Mail::IMAPClient::Socket(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:97):
97: { my ($self, $sock) = @_;
Mail::IMAPClient::Socket(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:98):
98: defined $sock
99: or return $self->{Socket};
Mail::IMAPClient::_read_line(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:1277):
1277: unless($self->IsConnected && $self->Socket)
Mail::IMAPClient::IsConnected(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:2816):
2816: sub IsConnected { shift->State >= Connected }
Mail::IMAPClient::CODE(0x850e764)(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:55):
55: *$datum = sub { @_ > 1 ? $_[0]->{$datum} = $_[1] : $_[0]->{$datum} };
Mail::IMAPClient::Socket(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:97):
97: { my ($self, $sock) = @_;
Mail::IMAPClient::Socket(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:98):
98: defined $sock
99: or return $self->{Socket};
Mail::IMAPClient::_read_line(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:1278):
1278: { $self->LastError("NO Not connected.");
Mail::IMAPClient::LastError(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:60):
60: { my $self = shift;
Mail::IMAPClient::LastError(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:61):
61: $self->{LastError} = shift if @_;
Mail::IMAPClient::LastError(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:62):
62: $@ = $self->{LastError};
Mail::IMAPClient::_read_line(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:1279):
1279: return undef;
Mail::IMAPClient::connect(Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm:238):
238: $code or return undef;
Carp::croak(/usr/share/perl/5.8/Carp.pm:102):
102: sub croak { die shortmess @_ }
Carp::shortmess(/usr/share/perl/5.8/Carp.pm:86):
86: local($@, $!);
Carp::shortmess(/usr/share/perl/5.8/Carp.pm:86):
86: local($@, $!);
Carp::shortmess(/usr/share/perl/5.8/Carp.pm:89):
89: require Carp::Heavy unless $INC{"Carp/Heavy.pm"};
Carp::shortmess(/usr/share/perl/5.8/Carp.pm:92):
92: my $call_pack = caller();
Carp::shortmess(/usr/share/perl/5.8/Carp.pm:93):
93: local @CARP_NOT = caller();
Carp::shortmess(/usr/share/perl/5.8/Carp.pm:94):
94: shortmess_heavy(@_);
Carp::shortmess_heavy(/usr/share/perl/5.8/Carp/Heavy.pm:177):
177: return longmess_heavy(@_) if $Verbose;
Carp::shortmess_heavy(/usr/share/perl/5.8/Carp/Heavy.pm:178):
178: return @_ if ref($_[0]); # don't break references as exceptions
Carp::shortmess_heavy(/usr/share/perl/5.8/Carp/Heavy.pm:179):
179: my $i = short_error_loc();
Carp::short_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:160):
160: my $cache;
Carp::short_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:161):
161: my $i = 1;
Carp::short_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:162):
162: my $lvl = $CarpLevel;
163: {
Carp::short_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:164):
164: my $called = caller($i++);
Carp::short_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:164):
164: my $called = caller($i++);
Carp::short_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:165):
165: my $caller = caller($i);
Carp::short_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:166):
166: return 0 unless defined($caller); # What happened?
Carp::short_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:167):
167: redo if $Internal{$caller};
Carp::short_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:168):
168: redo if $CarpInternal{$called};
Carp::short_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:164):
164: my $called = caller($i++);
Carp::short_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:165):
165: my $caller = caller($i);
Carp::short_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:166):
166: return 0 unless defined($caller); # What happened?
Carp::short_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:167):
167: redo if $Internal{$caller};
Carp::short_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:168):
168: redo if $CarpInternal{$called};
Carp::short_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:164):
164: my $called = caller($i++);
Carp::short_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:165):
165: my $caller = caller($i);
Carp::short_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:166):
166: return 0 unless defined($caller); # What happened?
Carp::shortmess_heavy(/usr/share/perl/5.8/Carp/Heavy.pm:180):
180: if ($i) {
Carp::shortmess_heavy(/usr/share/perl/5.8/Carp/Heavy.pm:184):
184: longmess_heavy(@_);
Carp::longmess_heavy(/usr/share/perl/5.8/Carp/Heavy.pm:115):
115: return @_ if ref($_[0]); # don't break references as exceptions
Carp::longmess_heavy(/usr/share/perl/5.8/Carp/Heavy.pm:116):
116: my $i = long_error_loc();
Carp::long_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:91):
91: my $i;
Carp::long_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:92):
92: my $lvl = $CarpLevel;
93: {
Carp::long_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:94):
94: my $pkg = caller(++$i);
Carp::long_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:94):
94: my $pkg = caller(++$i);
Carp::long_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:95):
95: unless(defined($pkg)) {
Carp::long_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:107):
107: redo if $CarpInternal{$pkg};
Carp::long_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:94):
94: my $pkg = caller(++$i);
Carp::long_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:95):
95: unless(defined($pkg)) {
Carp::long_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:107):
107: redo if $CarpInternal{$pkg};
Carp::long_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:94):
94: my $pkg = caller(++$i);
Carp::long_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:95):
95: unless(defined($pkg)) {
Carp::long_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:107):
107: redo if $CarpInternal{$pkg};
Carp::long_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:94):
94: my $pkg = caller(++$i);
Carp::long_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:95):
95: unless(defined($pkg)) {
Carp::long_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:107):
107: redo if $CarpInternal{$pkg};
Carp::long_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:108):
108: redo unless 0 > --$lvl;
Carp::long_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:109):
109: redo if $Internal{$pkg};
Carp::long_error_loc(/usr/share/perl/5.8/Carp/Heavy.pm:111):
111: return $i - 1;
Carp::longmess_heavy(/usr/share/perl/5.8/Carp/Heavy.pm:117):
117: return ret_backtrace($i, @_);
Carp::ret_backtrace(/usr/share/perl/5.8/Carp/Heavy.pm:123):
123: my ($i, @error) = @_;
Carp::ret_backtrace(/usr/share/perl/5.8/Carp/Heavy.pm:124):
124: my $mess;
Carp::ret_backtrace(/usr/share/perl/5.8/Carp/Heavy.pm:125):
125: my $err = join '', @error;
Carp::ret_backtrace(/usr/share/perl/5.8/Carp/Heavy.pm:126):
126: $i++;
Carp::ret_backtrace(/usr/share/perl/5.8/Carp/Heavy.pm:128):
128: my $tid_msg = '';
Carp::ret_backtrace(/usr/share/perl/5.8/Carp/Heavy.pm:129):
129: if (defined &Thread::tid) {
Carp::ret_backtrace(/usr/share/perl/5.8/Carp/Heavy.pm:134):
134: my %i = caller_info($i);
Carp::caller_info(/usr/share/perl/5.8/Carp/Heavy.pm:12):
12: my $i = shift(@_) + 1;
13: package DB;
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
Carp::caller_info(/usr/share/perl/5.8/Carp/Heavy.pm:73):
73: my $info = shift;
Carp::caller_info(/usr/share/perl/5.8/Carp/Heavy.pm:74):
74: if (defined($info->{evaltext})) {
Carp::caller_info(/usr/share/perl/5.8/Carp/Heavy.pm:85):
85: return ($info->{sub} eq '(eval)') ? 'eval {...}' : $info->{sub};
Carp::caller_info(/usr/share/perl/5.8/Carp/Heavy.pm:39):
39: my $arg = shift;
Carp::caller_info(/usr/share/perl/5.8/Carp/Heavy.pm:40):
40: if (ref($arg)) {
Carp::caller_info(/usr/share/perl/5.8/Carp/Heavy.pm:45):
45: $arg =~ s/'/\\'/g;
Carp::caller_info(/usr/share/perl/5.8/Carp/Heavy.pm:46):
46: $arg = str_len_trim($arg, $MaxArgLen);
Carp::str_len_trim(/usr/share/perl/5.8/Carp/Heavy.pm:190):
190: my $str = shift;
Carp::str_len_trim(/usr/share/perl/5.8/Carp/Heavy.pm:191):
191: my $max = shift || 0;
Carp::str_len_trim(/usr/share/perl/5.8/Carp/Heavy.pm:192):
192: if (2 < $max and $max < length($str)) {
Carp::str_len_trim(/usr/share/perl/5.8/Carp/Heavy.pm:195):
195: return $str;
Carp::caller_info(/usr/share/perl/5.8/Carp/Heavy.pm:49):
49: $arg = "'$arg'" unless $arg =~ /^-?[\d.]+\z/;
Carp::caller_info(/usr/share/perl/5.8/Carp/Heavy.pm:55):
55: or $arg =~ s/([[:cntrl:]]|[[:^ascii:]])/sprintf("\\x{%x}",ord($1))/eg;
Carp::caller_info(/usr/share/perl/5.8/Carp/Heavy.pm:56):
56: return $arg;
Carp::ret_backtrace(/usr/share/perl/5.8/Carp/Heavy.pm:135):
135: $mess = "$err at $i{file} line $i{line}$tid_msg\n";
Carp::ret_backtrace(/usr/share/perl/5.8/Carp/Heavy.pm:137):
137: while (my %i = caller_info(++$i)) {
Carp::caller_info(/usr/share/perl/5.8/Carp/Heavy.pm:12):
12: my $i = shift(@_) + 1;
13: package DB;
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
Carp::ret_backtrace(/usr/share/perl/5.8/Carp/Heavy.pm:141):
141: return $mess;
Error connecting @! at t/01_connect line 9
at t/01_connect line 9
Debugged program terminated. Use q to quit or R to restart,
use o inhibit_exit to avoid stopping after program termination,
h q, h R or h o to get additional info.
DB<1> q
IO::Handle::DESTROY(/usr/lib/perl/5.8/IO/Handle.pm:75):
75: sub DESTROY {}
IO::Handle::DESTROY(/usr/lib/perl/5.8/IO/Handle.pm:75):
75: sub DESTROY {}
Config::DESTROY(/usr/lib/perl/5.8/Config.pm:62):
62: sub DESTROY { }
IO::Handle::DESTROY(/usr/lib/perl/5.8/IO/Handle.pm:75):
75: sub DESTROY {}
IO::Handle::DESTROY(/usr/lib/perl/5.8/IO/Handle.pm:75):
75: sub DESTROY {}
83$

6540
t/01_connect_2.99_02.dump_2 Normal file

File diff suppressed because it is too large Load Diff

View File

@ -1,6 +1,6 @@
#!/bin/sh
# $Id: tests.sh,v 1.64 2007/10/30 03:20:32 gilles Exp gilles $
# $Id: tests.sh,v 1.68 2007/12/29 02:40:06 gilles Exp gilles $
#### Shell pragmas
@ -80,8 +80,34 @@ sendtestmessage() {
}
zzzz() {
$CMD_PERL -V
}
option_version() {
$CMD_PERL ./imapsync --version
}
option_tests() {
$CMD_PERL ./imapsync --tests
}
first_sync_dry() {
$CMD_PERL ./imapsync \
--host1 localhost --user1 toto@est.belle \
--passfile1 /var/tmp/secret1 \
--host2 localhost --user2 titi@est.belle \
--passfile2 /var/tmp/secret.titi \
--noauthmd5 --dry
}
first_sync() {
./imapsync \
$CMD_PERL ./imapsync \
--host1 localhost --user1 toto@est.belle \
--passfile1 /var/tmp/secret1 \
--host2 localhost --user2 titi@est.belle \
@ -94,7 +120,7 @@ locallocal() {
if test X`hostname` = X"plume"; then
echo3 Here is plume
sendtestmessage
./imapsync \
$CMD_PERL ./imapsync \
--host1 localhost --user1 tata@est.belle \
--passfile1 /var/tmp/secret.tata \
--host2 localhost --user2 titi@est.belle \
@ -109,7 +135,7 @@ locallocal() {
ll_folder() {
if test X`hostname` = X"plume"; then
echo3 Here is plume
./imapsync \
$CMD_PERL ./imapsync \
--host1 localhost --user1 tata@est.belle \
--passfile1 /var/tmp/secret.tata \
--host2 localhost --user2 titi@est.belle \
@ -123,7 +149,7 @@ ll_folder() {
ll_folderrec() {
if test X`hostname` = X"plume"; then
echo3 Here is plume
./imapsync \
$CMD_PERL ./imapsync \
--host1 localhost --user1 tata@est.belle \
--passfile1 /var/tmp/secret.tata \
--host2 localhost --user2 titi@est.belle \
@ -139,7 +165,7 @@ ll_folderrec() {
ll_buffersize() {
if test X`hostname` = X"plume"; then
echo3 Here is plume
./imapsync \
$CMD_PERL ./imapsync \
--host1 localhost --user1 tata@est.belle \
--passfile1 /var/tmp/secret.tata \
--host2 localhost --user2 titi@est.belle \
@ -155,7 +181,7 @@ ll_buffersize() {
ll_justfolders() {
if test X`hostname` = X"plume"; then
echo3 Here is plume
./imapsync \
$CMD_PERL ./imapsync \
--host1 localhost --user1 tata@est.belle \
--passfile1 /var/tmp/secret.tata \
--host2 localhost --user2 titi@est.belle \
@ -170,7 +196,7 @@ ll_justfolders() {
ll_prefix12() {
if test X`hostname` = X"plume"; then
echo3 Here is plume
./imapsync \
$CMD_PERL ./imapsync \
--host1 localhost --user1 tata@est.belle \
--passfile1 /var/tmp/secret.tata \
--host2 localhost --user2 titi@est.belle \
@ -658,6 +684,13 @@ ll_bigmail() {
}
msw() {
sendtestmessage toto@est.belle
scp imapsync Admin@192.168.68.77:'C:/msys/1.0/home/Admin/imapsync/imapsync'
ssh Admin@192.168.68.77 'C:/msys/1.0/home/Admin/imapsync/test.bat'
}
##########################
# specific tests
##########################
@ -885,6 +918,8 @@ run_tests perl_syntax
test $# -eq 0 && run_tests \
no_args \
option_version \
option_tests \
first_sync \
locallocal \
ll_folder \
@ -921,7 +956,8 @@ test $# -eq 0 && run_tests \
ll_authuser \
ll_delete2 \
ll_folderrec \
ll_bigmail
ll_bigmail \
msw

116
tools/wonko_ruby_imapsync Normal file
View File

@ -0,0 +1,116 @@
#!/usr/bin/env ruby
require 'net/imap'
#
# http://wonko.com/article/554
#
# Gilles LAMIRAL: Your Ruby code is nice. Is it GPL? Can I make a reference
# to it in the imapsync distribution?
#
# Wonko : Please consider this code public domain (and unsupported).
# You're more than welcome to refer to it if you'd like.
#
#
# Source server connection info.
SOURCE_HOST = 'mail.example.com'
SOURCE_PORT = 143
SOURCE_SSL = false
SOURCE_USER = 'username'
SOURCE_PASS = 'password'
# Destination server connection info.
DEST_HOST = 'imap.gmail.com'
DEST_PORT = 993
DEST_SSL = true
DEST_USER = 'username@gmail.com'
DEST_PASS = 'password'
# Mapping of source folders to destination folders. The key is the name of the
# folder on the source server, the value is the name on the destination server.
# Any folder not specified here will be ignored. If a destination folder does
# not exist, it will be created.
FOLDERS = {
'INBOX' => 'INBOX',
'sourcefolder' => 'gmailfolder'
}
# Utility methods.
def dd(message)
puts "[#{DEST_HOST}] #{message}"
end
def ds(message)
puts "[#{SOURCE_HOST}] #{message}"
end
# Connect and log into both servers.
ds 'connecting...'
source = Net::IMAP.new(SOURCE_HOST, SOURCE_PORT, SOURCE_SSL)
ds 'logging in...'
source.login(SOURCE_USER, SOURCE_PASS)
dd 'connecting...'
dest = Net::IMAP.new(DEST_HOST, DEST_PORT, DEST_SSL)
dd 'logging in...'
dest.login(DEST_USER, DEST_PASS)
# Loop through folders and copy messages.
FOLDERS.each do |source_folder, dest_folder|
# Open source folder in read-only mode.
begin
ds "selecting folder '#{source_folder}'..."
source.examine(source_folder)
rescue => e
ds "error: select failed: #{e}"
next
end
# Open (or create) destination folder in read-write mode.
begin
dd "selecting folder '#{dest_folder}'..."
dest.select(dest_folder)
rescue => e
begin
dd "folder not found; creating..."
dest.create(dest_folder)
dest.select(dest_folder)
rescue => ee
dd "error: could not create folder: #{e}"
next
end
end
# Build a lookup hash of all message ids present in the destination folder.
dest_info = {}
dd 'analyzing existing messages...'
dest.uid_fetch(dest.uid_search(['ALL']), ['ENVELOPE']).each do |data|
dest_info[data.attr['ENVELOPE'].message_id] = true
end
# Loop through all messages in the source folder.
source.uid_fetch(source.uid_search(['ALL']), ['ENVELOPE']).each do |data|
mid = data.attr['ENVELOPE'].message_id
# If this message is already in the destination folder, skip it.
next if dest_info[mid]
# Download the full message body from the source folder.
ds "downloading message #{mid}..."
msg = source.uid_fetch(data.attr['UID'], ['RFC822', 'FLAGS',
'INTERNALDATE']).first
# Append the message to the destination folder, preserving flags and
# internal timestamp.
dd "storing message #{mid}..."
dest.append(dest_folder, msg.attr['RFC822'], msg.attr['FLAGS'],
msg.attr['INTERNALDATE'])
end
source.close
dest.close
end
puts 'done'

12455
tperl.out Normal file

File diff suppressed because it is too large Load Diff

6540
tperl2.out Normal file

File diff suppressed because it is too large Load Diff