mirror of
https://github.com/imapsync/imapsync.git
synced 2024-11-16 15:52:47 +01:00
1.239
This commit is contained in:
parent
6576e43299
commit
0d91a1a20f
34
CREDITS
34
CREDITS
@ -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.
|
||||
|
36
ChangeLog
36
ChangeLog
@ -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
70
FAQ
@ -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
|
||||
|
@ -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
@ -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;
|
@ -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) ;
|
||||
}
|
File diff suppressed because it is too large
Load Diff
@ -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
|
@ -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;
|
@ -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;
|
||||
}
|
@ -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
|
||||
|
@ -1,5 +0,0 @@
|
||||
server=localhost
|
||||
user=tata@est.belle
|
||||
passed=XXXXXXXXX
|
||||
port=143
|
||||
authmechanism=LOGIN
|
@ -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.
|
||||
|
@ -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)
|
@ -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
|
@ -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
|
||||
|
File diff suppressed because it is too large
Load Diff
@ -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
|
||||
|
@ -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;
|
@ -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;
|
||||
}
|
File diff suppressed because it is too large
Load Diff
@ -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
|
@ -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' );
|
||||
}
|
||||
}
|
@ -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
20
README
@ -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
16
RECORD
@ -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
24
TODO
@ -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.
|
||||
|
||||
|
16
aa
Normal file
16
aa
Normal 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
|
||||
|
@ -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
350
imapsync
@ -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;
|
||||
}
|
||||
}
|
||||
|
4
memo
4
memo
@ -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
8
t/01_connect
Normal file → Executable 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
16
t/01_connect.229.dump
Normal 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
743
t/01_connect_2.99_02.dump
Normal 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
6540
t/01_connect_2.99_02.dump_2
Normal file
File diff suppressed because it is too large
Load Diff
54
tests.sh
54
tests.sh
@ -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
116
tools/wonko_ruby_imapsync
Normal 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'
|
||||
|
6540
tperl2.out
Normal file
6540
tperl2.out
Normal file
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue
Block a user