From 0d91a1a20fdaf9023526b7f6275cc4718a4b065e Mon Sep 17 00:00:00 2001 From: Nick Bebout Date: Sat, 12 Mar 2011 02:44:35 +0000 Subject: [PATCH] 1.239 --- CREDITS | 34 + ChangeLog | 36 +- FAQ | 70 +- Mail-IMAPClient-2.99_02/Makefile | 850 - Mail-IMAPClient-2.99_02/blib/arch/.exists | 0 .../blib/arch/auto/Mail/IMAPClient/.exists | 0 Mail-IMAPClient-2.99_02/blib/bin/.exists | 0 Mail-IMAPClient-2.99_02/blib/lib/Mail/.exists | 0 .../blib/lib/Mail/IMAPClient/Thread.pm | 1014 - .../blib/lib/auto/Mail/IMAPClient/.exists | 0 Mail-IMAPClient-2.99_02/blib/man1/.exists | 0 Mail-IMAPClient-2.99_02/blib/man3/.exists | 0 Mail-IMAPClient-2.99_02/blib/script/.exists | 0 .../lib/Mail/IMAPClient.pm | 2856 --- .../lib/Mail/IMAPClient.pod | 3746 ---- .../lib/Mail/IMAPClient/BodyStructure.pm | 661 - .../IMAPClient/BodyStructure/Parse.grammar | 288 - .../Mail/IMAPClient/BodyStructure/Parse.pm | 17245 ---------------- .../Mail/IMAPClient/BodyStructure/Parse.pod | 17 - .../lib/Mail/IMAPClient/MessageSet.pm | 285 - .../lib/Mail/IMAPClient/Thread.grammar | 18 - .../lib/Mail/IMAPClient/Thread.pod | 21 - Mail-IMAPClient-2.99_02/pm_to_blib | 0 Mail-IMAPClient-2.99_02/test.txt | 5 - .../COPYRIGHT | 0 .../Changes | 256 +- .../INSTALL | 0 .../MANIFEST | 22 +- .../META.yml | 4 +- .../Makefile.PL | 17 +- .../README | 0 .../Todo | 0 .../examples/build_dist.pl | 0 .../examples/build_ldif.pl | 0 .../examples/cleanTest.pl | 0 .../examples/copy_folder.pl | 0 .../examples/cyrus_expire.pl | 0 .../examples/cyrus_expunge.pl | 0 .../examples/find_dup_msgs.pl | 0 .../examples/imap_to_mbox.pl | 0 .../examples/imtestExample.pl | 0 .../examples/migrate_mail2.pl | 0 .../examples/migrate_mbox.pl | 0 .../examples/populate_mailbox.pl | 0 .../examples/sharedFolder.pl | 0 .../lib/Mail/IMAPClient.pm | 1104 +- .../lib/Mail/IMAPClient.pod | 179 +- .../lib/Mail/IMAPClient/BodyStructure.pm | 460 +- .../IMAPClient/BodyStructure/Parse.grammar | 204 +- .../Mail/IMAPClient/BodyStructure/Parse.pm | 1337 +- .../Mail/IMAPClient/BodyStructure/Parse.pod | 0 .../lib/Mail/IMAPClient/MessageSet.pm | 18 +- .../lib/Mail/IMAPClient/Thread.grammar | 0 .../lib/Mail/IMAPClient/Thread.pm | 36 +- .../lib/Mail/IMAPClient/Thread.pod | 0 .../prepare_dist | 0 .../sample.perldb | 0 .../t/basic.t | 62 +- .../t/bodystructure.t | 0 .../t/messageset.t | 0 .../t/pod.t | 0 .../t/thread.t | 0 .../test_template.txt | 0 README | 20 +- RECORD | 16 + TODO | 24 + VERSION | 2 +- aa | 16 + freshmeat_submition.out | 15 +- imapsync | 350 +- imapsync2 | 2384 +++ memo | 4 +- t/01_connect | 8 +- t/01_connect.229.dump | 16 + t/01_connect_2.99_02.dump | 743 + t/01_connect_2.99_02.dump_2 | 6540 ++++++ tests.sh | 54 +- tools/wonko_ruby_imapsync | 116 + tperl.out | 12455 +++++++++++ tperl2.out | 6540 ++++++ 80 files changed, 31457 insertions(+), 28691 deletions(-) delete mode 100644 Mail-IMAPClient-2.99_02/Makefile delete mode 100644 Mail-IMAPClient-2.99_02/blib/arch/.exists delete mode 100644 Mail-IMAPClient-2.99_02/blib/arch/auto/Mail/IMAPClient/.exists delete mode 100644 Mail-IMAPClient-2.99_02/blib/bin/.exists delete mode 100644 Mail-IMAPClient-2.99_02/blib/lib/Mail/.exists delete mode 100644 Mail-IMAPClient-2.99_02/blib/lib/Mail/IMAPClient/Thread.pm delete mode 100644 Mail-IMAPClient-2.99_02/blib/lib/auto/Mail/IMAPClient/.exists delete mode 100644 Mail-IMAPClient-2.99_02/blib/man1/.exists delete mode 100644 Mail-IMAPClient-2.99_02/blib/man3/.exists delete mode 100644 Mail-IMAPClient-2.99_02/blib/script/.exists delete mode 100644 Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm delete mode 100644 Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pod delete mode 100755 Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/BodyStructure.pm delete mode 100755 Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/BodyStructure/Parse.grammar delete mode 100644 Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/BodyStructure/Parse.pm delete mode 100755 Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/BodyStructure/Parse.pod delete mode 100644 Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/MessageSet.pm delete mode 100644 Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/Thread.grammar delete mode 100755 Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/Thread.pod delete mode 100644 Mail-IMAPClient-2.99_02/pm_to_blib delete mode 100644 Mail-IMAPClient-2.99_02/test.txt rename {Mail-IMAPClient-2.99_02 => Mail-IMAPClient-3.00}/COPYRIGHT (100%) rename {Mail-IMAPClient-2.99_02 => Mail-IMAPClient-3.00}/Changes (90%) rename {Mail-IMAPClient-2.99_02 => Mail-IMAPClient-3.00}/INSTALL (100%) rename {Mail-IMAPClient-2.99_02 => Mail-IMAPClient-3.00}/MANIFEST (100%) rename {Mail-IMAPClient-2.99_02 => Mail-IMAPClient-3.00}/META.yml (90%) rename {Mail-IMAPClient-2.99_02 => Mail-IMAPClient-3.00}/Makefile.PL (87%) rename {Mail-IMAPClient-2.99_02 => Mail-IMAPClient-3.00}/README (100%) rename {Mail-IMAPClient-2.99_02 => Mail-IMAPClient-3.00}/Todo (100%) rename {Mail-IMAPClient-2.99_02 => Mail-IMAPClient-3.00}/examples/build_dist.pl (100%) rename {Mail-IMAPClient-2.99_02 => Mail-IMAPClient-3.00}/examples/build_ldif.pl (100%) rename {Mail-IMAPClient-2.99_02 => Mail-IMAPClient-3.00}/examples/cleanTest.pl (100%) rename {Mail-IMAPClient-2.99_02 => Mail-IMAPClient-3.00}/examples/copy_folder.pl (100%) rename {Mail-IMAPClient-2.99_02 => Mail-IMAPClient-3.00}/examples/cyrus_expire.pl (100%) rename {Mail-IMAPClient-2.99_02 => Mail-IMAPClient-3.00}/examples/cyrus_expunge.pl (100%) rename {Mail-IMAPClient-2.99_02 => Mail-IMAPClient-3.00}/examples/find_dup_msgs.pl (100%) rename {Mail-IMAPClient-2.99_02 => Mail-IMAPClient-3.00}/examples/imap_to_mbox.pl (100%) rename {Mail-IMAPClient-2.99_02 => Mail-IMAPClient-3.00}/examples/imtestExample.pl (100%) rename {Mail-IMAPClient-2.99_02 => Mail-IMAPClient-3.00}/examples/migrate_mail2.pl (100%) rename {Mail-IMAPClient-2.99_02 => Mail-IMAPClient-3.00}/examples/migrate_mbox.pl (100%) rename {Mail-IMAPClient-2.99_02 => Mail-IMAPClient-3.00}/examples/populate_mailbox.pl (100%) rename {Mail-IMAPClient-2.99_02 => Mail-IMAPClient-3.00}/examples/sharedFolder.pl (100%) rename {Mail-IMAPClient-2.99_02/blib => Mail-IMAPClient-3.00}/lib/Mail/IMAPClient.pm (74%) rename {Mail-IMAPClient-2.99_02/blib => Mail-IMAPClient-3.00}/lib/Mail/IMAPClient.pod (96%) rename {Mail-IMAPClient-2.99_02/blib => Mail-IMAPClient-3.00}/lib/Mail/IMAPClient/BodyStructure.pm (60%) rename {Mail-IMAPClient-2.99_02/blib => Mail-IMAPClient-3.00}/lib/Mail/IMAPClient/BodyStructure/Parse.grammar (53%) rename {Mail-IMAPClient-2.99_02/blib => Mail-IMAPClient-3.00}/lib/Mail/IMAPClient/BodyStructure/Parse.pm (94%) rename {Mail-IMAPClient-2.99_02/blib => Mail-IMAPClient-3.00}/lib/Mail/IMAPClient/BodyStructure/Parse.pod (100%) rename {Mail-IMAPClient-2.99_02/blib => Mail-IMAPClient-3.00}/lib/Mail/IMAPClient/MessageSet.pm (98%) rename {Mail-IMAPClient-2.99_02/blib => Mail-IMAPClient-3.00}/lib/Mail/IMAPClient/Thread.grammar (100%) rename {Mail-IMAPClient-2.99_02 => Mail-IMAPClient-3.00}/lib/Mail/IMAPClient/Thread.pm (98%) rename {Mail-IMAPClient-2.99_02/blib => Mail-IMAPClient-3.00}/lib/Mail/IMAPClient/Thread.pod (100%) rename {Mail-IMAPClient-2.99_02 => Mail-IMAPClient-3.00}/prepare_dist (100%) rename {Mail-IMAPClient-2.99_02 => Mail-IMAPClient-3.00}/sample.perldb (100%) rename {Mail-IMAPClient-2.99_02 => Mail-IMAPClient-3.00}/t/basic.t (85%) rename {Mail-IMAPClient-2.99_02 => Mail-IMAPClient-3.00}/t/bodystructure.t (100%) rename {Mail-IMAPClient-2.99_02 => Mail-IMAPClient-3.00}/t/messageset.t (100%) rename {Mail-IMAPClient-2.99_02 => Mail-IMAPClient-3.00}/t/pod.t (100%) rename {Mail-IMAPClient-2.99_02 => Mail-IMAPClient-3.00}/t/thread.t (100%) rename {Mail-IMAPClient-2.99_02 => Mail-IMAPClient-3.00}/test_template.txt (100%) create mode 100644 aa create mode 100755 imapsync2 mode change 100644 => 100755 t/01_connect create mode 100644 t/01_connect.229.dump create mode 100644 t/01_connect_2.99_02.dump create mode 100644 t/01_connect_2.99_02.dump_2 create mode 100644 tools/wonko_ruby_imapsync create mode 100644 tperl.out create mode 100644 tperl2.out diff --git a/CREDITS b/CREDITS index a8747bb..8296306 100644 --- a/CREDITS +++ b/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. diff --git a/ChangeLog b/ChangeLog index efe23e4..a196083 100644 --- a/ChangeLog +++ b/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. ---------------------------- diff --git a/FAQ b/FAQ index 108cdec..1d59eff 100644 --- a/FAQ +++ b/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 diff --git a/Mail-IMAPClient-2.99_02/Makefile b/Mail-IMAPClient-2.99_02/Makefile deleted file mode 100644 index a24ca3d..0000000 --- a/Mail-IMAPClient-2.99_02/Makefile +++ /dev/null @@ -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) '' > $(DISTNAME).ppd - $(NOECHO) $(ECHO) ' $(DISTNAME)' >> $(DISTNAME).ppd - $(NOECHO) $(ECHO) ' IMAP4 client library' >> $(DISTNAME).ppd - $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd - $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd - $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd - $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd - $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd - $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd - $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd - $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd - $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd - $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd - $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd - $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd - $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd - $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd - $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd - $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd - $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd - $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd - $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd - $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd - $(NOECHO) $(ECHO) '' >> $(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. diff --git a/Mail-IMAPClient-2.99_02/blib/arch/.exists b/Mail-IMAPClient-2.99_02/blib/arch/.exists deleted file mode 100644 index e69de29..0000000 diff --git a/Mail-IMAPClient-2.99_02/blib/arch/auto/Mail/IMAPClient/.exists b/Mail-IMAPClient-2.99_02/blib/arch/auto/Mail/IMAPClient/.exists deleted file mode 100644 index e69de29..0000000 diff --git a/Mail-IMAPClient-2.99_02/blib/bin/.exists b/Mail-IMAPClient-2.99_02/blib/bin/.exists deleted file mode 100644 index e69de29..0000000 diff --git a/Mail-IMAPClient-2.99_02/blib/lib/Mail/.exists b/Mail-IMAPClient-2.99_02/blib/lib/Mail/.exists deleted file mode 100644 index e69de29..0000000 diff --git a/Mail-IMAPClient-2.99_02/blib/lib/Mail/IMAPClient/Thread.pm b/Mail-IMAPClient-2.99_02/blib/lib/Mail/IMAPClient/Thread.pm deleted file mode 100644 index 477246c..0000000 --- a/Mail-IMAPClient-2.99_02/blib/lib/Mail/IMAPClient/Thread.pm +++ /dev/null @@ -1,1014 +0,0 @@ -package Mail::IMAPClient::Thread; -use Parse::RecDescent; - -{ my $ERRORS; - - -package Parse::RecDescent::Mail::IMAPClient::Thread; -use strict; -use vars qw($skip $AUTOLOAD ); -$skip = '\s*'; - - -{ -local $SIG{__WARN__} = sub {0}; -# PRETEND TO BE IN Parse::RecDescent NAMESPACE -*Parse::RecDescent::Mail::IMAPClient::Thread::AUTOLOAD = sub -{ - no strict 'refs'; - $AUTOLOAD =~ s/^Parse::RecDescent::Mail::IMAPClient::Thread/Parse::RecDescent/; - goto &{$AUTOLOAD}; -} -} - -push @Parse::RecDescent::Mail::IMAPClient::Thread::ISA, 'Parse::RecDescent'; -# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) -sub Parse::RecDescent::Mail::IMAPClient::Thread::thread -{ - my $thisparser = $_[0]; - use vars q{$tracelevel}; - local $tracelevel = ($tracelevel||0)+1; - $ERRORS = 0; - my $thisrule = $thisparser->{"rules"}{"thread"}; - - Parse::RecDescent::_trace(q{Trying rule: [thread]}, - Parse::RecDescent::_tracefirst($_[1]), - q{thread}, - $tracelevel) - if defined $::RD_TRACE; - - - my $err_at = @{$thisparser->{errors}}; - - my $score; - my $score_return; - my $_tok; - my $return = undef; - my $_matched=0; - my $commit=0; - my @item = (); - my %item = (); - my $repeating = defined($_[2]) && $_[2]; - my $_noactions = defined($_[3]) && $_[3]; - my @arg = defined $_[4] ? @{ &{$_[4]} } : (); - my %arg = ($#arg & 01) ? @arg : (@arg, undef); - my $text; - my $lastsep=""; - my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); - $expectation->at($_[1]); - - my $thisline; - tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; - - - - while (!$_matched && !$commit) - { - - Parse::RecDescent::_trace(q{Trying production: ['(' threadmember ')']}, - Parse::RecDescent::_tracefirst($_[1]), - q{thread}, - $tracelevel) - if defined $::RD_TRACE; - my $thisprod = $thisrule->{"prods"}[0]; - $text = $_[1]; - my $_savetext; - @item = (q{thread}); - %item = (__RULE__ => q{thread}); - my $repcount = 0; - - - Parse::RecDescent::_trace(q{Trying terminal: ['(']}, - Parse::RecDescent::_tracefirst($text), - q{thread}, - $tracelevel) - if defined $::RD_TRACE; - $lastsep = ""; - $expectation->is(q{})->at($text); - - - unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and do { $_tok = "("; 1 } and - substr($text,0,length($_tok)) eq $_tok and - do { substr($text,0,length($_tok)) = ""; 1; } - ) - { - - $expectation->failed(); - Parse::RecDescent::_trace(q{<>}, - Parse::RecDescent::_tracefirst($text)) - if defined $::RD_TRACE; - last; - } - Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} - . $_tok . q{])}, - Parse::RecDescent::_tracefirst($text)) - if defined $::RD_TRACE; - push @item, $item{__STRING1__}=$_tok; - - - Parse::RecDescent::_trace(q{Trying repeated subrule: [threadmember]}, - Parse::RecDescent::_tracefirst($text), - q{thread}, - $tracelevel) - if defined $::RD_TRACE; - $expectation->is(q{threadmember})->at($text); - - unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::Thread::threadmember, 1, 100000000, $_noactions,$expectation,undef))) - { - Parse::RecDescent::_trace(q{<>}, - Parse::RecDescent::_tracefirst($text), - q{thread}, - $tracelevel) - if defined $::RD_TRACE; - last; - } - Parse::RecDescent::_trace(q{>>Matched repeated subrule: [threadmember]<< (} - . @$_tok . q{ times)}, - - Parse::RecDescent::_tracefirst($text), - q{thread}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{threadmember(s)}} = $_tok; - push @item, $_tok; - - - - Parse::RecDescent::_trace(q{Trying terminal: [')']}, - Parse::RecDescent::_tracefirst($text), - q{thread}, - $tracelevel) - if defined $::RD_TRACE; - $lastsep = ""; - $expectation->is(q{')'})->at($text); - - - unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and do { $_tok = ")"; 1 } and - substr($text,0,length($_tok)) eq $_tok and - do { substr($text,0,length($_tok)) = ""; 1; } - ) - { - - $expectation->failed(); - Parse::RecDescent::_trace(q{<>}, - Parse::RecDescent::_tracefirst($text)) - if defined $::RD_TRACE; - last; - } - Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} - . $_tok . q{])}, - Parse::RecDescent::_tracefirst($text)) - if defined $::RD_TRACE; - push @item, $item{__STRING2__}=$_tok; - - - Parse::RecDescent::_trace(q{Trying action}, - Parse::RecDescent::_tracefirst($text), - q{thread}, - $tracelevel) - if defined $::RD_TRACE; - - - $_tok = ($_noactions) ? 0 : do { - $return = $item{'threadmember(s)'}||undef; - }; - unless (defined $_tok) - { - Parse::RecDescent::_trace(q{<> (return value: [undef])}) - if defined $::RD_TRACE; - last; - } - Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} - . $_tok . q{])}, - Parse::RecDescent::_tracefirst($text)) - if defined $::RD_TRACE; - push @item, $_tok; - $item{__ACTION1__}=$_tok; - - - - Parse::RecDescent::_trace(q{>>Matched production: ['(' threadmember ')']<<}, - Parse::RecDescent::_tracefirst($text), - q{thread}, - $tracelevel) - if defined $::RD_TRACE; - $_matched = 1; - last; - } - - - unless ( $_matched || defined($return) || defined($score) ) - { - - - $_[1] = $text; # NOT SURE THIS IS NEEDED - Parse::RecDescent::_trace(q{<>}, - Parse::RecDescent::_tracefirst($_[1]), - q{thread}, - $tracelevel) - if defined $::RD_TRACE; - return undef; - } - if (!defined($return) && defined($score)) - { - Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", - q{thread}, - $tracelevel) - if defined $::RD_TRACE; - $return = $score_return; - } - splice @{$thisparser->{errors}}, $err_at; - $return = $item[$#item] unless defined $return; - if (defined $::RD_TRACE) - { - Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . - $return . q{])}, "", - q{thread}, - $tracelevel); - Parse::RecDescent::_trace(q{(consumed: [} . - Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, - Parse::RecDescent::_tracefirst($text), - , q{thread}, - $tracelevel) - } - $_[1] = $text; - return $return; -} - -# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) -sub Parse::RecDescent::Mail::IMAPClient::Thread::NUMBER -{ - my $thisparser = $_[0]; - use vars q{$tracelevel}; - local $tracelevel = ($tracelevel||0)+1; - $ERRORS = 0; - my $thisrule = $thisparser->{"rules"}{"NUMBER"}; - - Parse::RecDescent::_trace(q{Trying rule: [NUMBER]}, - Parse::RecDescent::_tracefirst($_[1]), - q{NUMBER}, - $tracelevel) - if defined $::RD_TRACE; - - - my $err_at = @{$thisparser->{errors}}; - - my $score; - my $score_return; - my $_tok; - my $return = undef; - my $_matched=0; - my $commit=0; - my @item = (); - my %item = (); - my $repeating = defined($_[2]) && $_[2]; - my $_noactions = defined($_[3]) && $_[3]; - my @arg = defined $_[4] ? @{ &{$_[4]} } : (); - my %arg = ($#arg & 01) ? @arg : (@arg, undef); - my $text; - my $lastsep=""; - my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); - $expectation->at($_[1]); - - my $thisline; - tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; - - - - while (!$_matched && !$commit) - { - - Parse::RecDescent::_trace(q{Trying production: [/\\d+/]}, - Parse::RecDescent::_tracefirst($_[1]), - q{NUMBER}, - $tracelevel) - if defined $::RD_TRACE; - my $thisprod = $thisrule->{"prods"}[0]; - $text = $_[1]; - my $_savetext; - @item = (q{NUMBER}); - %item = (__RULE__ => q{NUMBER}); - my $repcount = 0; - - - Parse::RecDescent::_trace(q{Trying terminal: [/\\d+/]}, Parse::RecDescent::_tracefirst($text), - q{NUMBER}, - $tracelevel) - if defined $::RD_TRACE; - $lastsep = ""; - $expectation->is(q{})->at($text); - - - unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:\d+)//) - { - - $expectation->failed(); - Parse::RecDescent::_trace(q{<>}, - Parse::RecDescent::_tracefirst($text)) - if defined $::RD_TRACE; - - last; - } - Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} - . $& . q{])}, - Parse::RecDescent::_tracefirst($text)) - if defined $::RD_TRACE; - push @item, $item{__PATTERN1__}=$&; - - - - Parse::RecDescent::_trace(q{>>Matched production: [/\\d+/]<<}, - Parse::RecDescent::_tracefirst($text), - q{NUMBER}, - $tracelevel) - if defined $::RD_TRACE; - $_matched = 1; - last; - } - - - unless ( $_matched || defined($return) || defined($score) ) - { - - - $_[1] = $text; # NOT SURE THIS IS NEEDED - Parse::RecDescent::_trace(q{<>}, - Parse::RecDescent::_tracefirst($_[1]), - q{NUMBER}, - $tracelevel) - if defined $::RD_TRACE; - return undef; - } - if (!defined($return) && defined($score)) - { - Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", - q{NUMBER}, - $tracelevel) - if defined $::RD_TRACE; - $return = $score_return; - } - splice @{$thisparser->{errors}}, $err_at; - $return = $item[$#item] unless defined $return; - if (defined $::RD_TRACE) - { - Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . - $return . q{])}, "", - q{NUMBER}, - $tracelevel); - Parse::RecDescent::_trace(q{(consumed: [} . - Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, - Parse::RecDescent::_tracefirst($text), - , q{NUMBER}, - $tracelevel) - } - $_[1] = $text; - return $return; -} - -# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) -sub Parse::RecDescent::Mail::IMAPClient::Thread::start -{ - my $thisparser = $_[0]; - use vars q{$tracelevel}; - local $tracelevel = ($tracelevel||0)+1; - $ERRORS = 0; - my $thisrule = $thisparser->{"rules"}{"start"}; - - Parse::RecDescent::_trace(q{Trying rule: [start]}, - Parse::RecDescent::_tracefirst($_[1]), - q{start}, - $tracelevel) - if defined $::RD_TRACE; - - - my $err_at = @{$thisparser->{errors}}; - - my $score; - my $score_return; - my $_tok; - my $return = undef; - my $_matched=0; - my $commit=0; - my @item = (); - my %item = (); - my $repeating = defined($_[2]) && $_[2]; - my $_noactions = defined($_[3]) && $_[3]; - my @arg = defined $_[4] ? @{ &{$_[4]} } : (); - my %arg = ($#arg & 01) ? @arg : (@arg, undef); - my $text; - my $lastsep=""; - my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); - $expectation->at($_[1]); - - my $thisline; - tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; - - - - while (!$_matched && !$commit) - { - - Parse::RecDescent::_trace(q{Trying production: [/^\\* THREAD /i thread]}, - Parse::RecDescent::_tracefirst($_[1]), - q{start}, - $tracelevel) - if defined $::RD_TRACE; - my $thisprod = $thisrule->{"prods"}[0]; - $text = $_[1]; - my $_savetext; - @item = (q{start}); - %item = (__RULE__ => q{start}); - my $repcount = 0; - - - Parse::RecDescent::_trace(q{Trying terminal: [/^\\* THREAD /i]}, Parse::RecDescent::_tracefirst($text), - q{start}, - $tracelevel) - if defined $::RD_TRACE; - $lastsep = ""; - $expectation->is(q{})->at($text); - - - unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:^\* THREAD )//i) - { - - $expectation->failed(); - Parse::RecDescent::_trace(q{<>}, - Parse::RecDescent::_tracefirst($text)) - if defined $::RD_TRACE; - - last; - } - Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} - . $& . q{])}, - Parse::RecDescent::_tracefirst($text)) - if defined $::RD_TRACE; - push @item, $item{__PATTERN1__}=$&; - - - Parse::RecDescent::_trace(q{Trying repeated subrule: [thread]}, - Parse::RecDescent::_tracefirst($text), - q{start}, - $tracelevel) - if defined $::RD_TRACE; - $expectation->is(q{thread})->at($text); - - unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::Thread::thread, 0, 100000000, $_noactions,$expectation,undef))) - { - Parse::RecDescent::_trace(q{<>}, - Parse::RecDescent::_tracefirst($text), - q{start}, - $tracelevel) - if defined $::RD_TRACE; - last; - } - Parse::RecDescent::_trace(q{>>Matched repeated subrule: [thread]<< (} - . @$_tok . q{ times)}, - - Parse::RecDescent::_tracefirst($text), - q{start}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{thread(s?)}} = $_tok; - push @item, $_tok; - - - - Parse::RecDescent::_trace(q{Trying action}, - Parse::RecDescent::_tracefirst($text), - q{start}, - $tracelevel) - if defined $::RD_TRACE; - - - $_tok = ($_noactions) ? 0 : do { - $return=$item{'thread(s?)'}||undef; -}; - unless (defined $_tok) - { - Parse::RecDescent::_trace(q{<> (return value: [undef])}) - if defined $::RD_TRACE; - last; - } - Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} - . $_tok . q{])}, - Parse::RecDescent::_tracefirst($text)) - if defined $::RD_TRACE; - push @item, $_tok; - $item{__ACTION1__}=$_tok; - - - - Parse::RecDescent::_trace(q{>>Matched production: [/^\\* THREAD /i thread]<<}, - Parse::RecDescent::_tracefirst($text), - q{start}, - $tracelevel) - if defined $::RD_TRACE; - $_matched = 1; - last; - } - - - unless ( $_matched || defined($return) || defined($score) ) - { - - - $_[1] = $text; # NOT SURE THIS IS NEEDED - Parse::RecDescent::_trace(q{<>}, - Parse::RecDescent::_tracefirst($_[1]), - q{start}, - $tracelevel) - if defined $::RD_TRACE; - return undef; - } - if (!defined($return) && defined($score)) - { - Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", - q{start}, - $tracelevel) - if defined $::RD_TRACE; - $return = $score_return; - } - splice @{$thisparser->{errors}}, $err_at; - $return = $item[$#item] unless defined $return; - if (defined $::RD_TRACE) - { - Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . - $return . q{])}, "", - q{start}, - $tracelevel); - Parse::RecDescent::_trace(q{(consumed: [} . - Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, - Parse::RecDescent::_tracefirst($text), - , q{start}, - $tracelevel) - } - $_[1] = $text; - return $return; -} - -# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) -sub Parse::RecDescent::Mail::IMAPClient::Thread::threadmember -{ - my $thisparser = $_[0]; - use vars q{$tracelevel}; - local $tracelevel = ($tracelevel||0)+1; - $ERRORS = 0; - my $thisrule = $thisparser->{"rules"}{"threadmember"}; - - Parse::RecDescent::_trace(q{Trying rule: [threadmember]}, - Parse::RecDescent::_tracefirst($_[1]), - q{threadmember}, - $tracelevel) - if defined $::RD_TRACE; - - - my $err_at = @{$thisparser->{errors}}; - - my $score; - my $score_return; - my $_tok; - my $return = undef; - my $_matched=0; - my $commit=0; - my @item = (); - my %item = (); - my $repeating = defined($_[2]) && $_[2]; - my $_noactions = defined($_[3]) && $_[3]; - my @arg = defined $_[4] ? @{ &{$_[4]} } : (); - my %arg = ($#arg & 01) ? @arg : (@arg, undef); - my $text; - my $lastsep=""; - my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); - $expectation->at($_[1]); - - my $thisline; - tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; - - - - while (!$_matched && !$commit) - { - - Parse::RecDescent::_trace(q{Trying production: [NUMBER]}, - Parse::RecDescent::_tracefirst($_[1]), - q{threadmember}, - $tracelevel) - if defined $::RD_TRACE; - my $thisprod = $thisrule->{"prods"}[0]; - $text = $_[1]; - my $_savetext; - @item = (q{threadmember}); - %item = (__RULE__ => q{threadmember}); - my $repcount = 0; - - - Parse::RecDescent::_trace(q{Trying subrule: [NUMBER]}, - Parse::RecDescent::_tracefirst($text), - q{threadmember}, - $tracelevel) - if defined $::RD_TRACE; - if (1) { no strict qw{refs}; - $expectation->is(q{})->at($text); - unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::Thread::NUMBER($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) - { - - Parse::RecDescent::_trace(q{<>}, - Parse::RecDescent::_tracefirst($text), - q{threadmember}, - $tracelevel) - if defined $::RD_TRACE; - $expectation->failed(); - last; - } - Parse::RecDescent::_trace(q{>>Matched subrule: [NUMBER]<< (return value: [} - . $_tok . q{]}, - - Parse::RecDescent::_tracefirst($text), - q{threadmember}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{NUMBER}} = $_tok; - push @item, $_tok; - - } - - Parse::RecDescent::_trace(q{Trying action}, - Parse::RecDescent::_tracefirst($text), - q{threadmember}, - $tracelevel) - if defined $::RD_TRACE; - - - $_tok = ($_noactions) ? 0 : do { $return = $item{NUMBER} ; }; - unless (defined $_tok) - { - Parse::RecDescent::_trace(q{<> (return value: [undef])}) - if defined $::RD_TRACE; - last; - } - Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} - . $_tok . q{])}, - Parse::RecDescent::_tracefirst($text)) - if defined $::RD_TRACE; - push @item, $_tok; - $item{__ACTION1__}=$_tok; - - - - Parse::RecDescent::_trace(q{>>Matched production: [NUMBER]<<}, - Parse::RecDescent::_tracefirst($text), - q{threadmember}, - $tracelevel) - if defined $::RD_TRACE; - $_matched = 1; - last; - } - - - while (!$_matched && !$commit) - { - - Parse::RecDescent::_trace(q{Trying production: [thread]}, - Parse::RecDescent::_tracefirst($_[1]), - q{threadmember}, - $tracelevel) - if defined $::RD_TRACE; - my $thisprod = $thisrule->{"prods"}[1]; - $text = $_[1]; - my $_savetext; - @item = (q{threadmember}); - %item = (__RULE__ => q{threadmember}); - my $repcount = 0; - - - Parse::RecDescent::_trace(q{Trying subrule: [thread]}, - Parse::RecDescent::_tracefirst($text), - q{threadmember}, - $tracelevel) - if defined $::RD_TRACE; - if (1) { no strict qw{refs}; - $expectation->is(q{})->at($text); - unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::Thread::thread($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) - { - - Parse::RecDescent::_trace(q{<>}, - Parse::RecDescent::_tracefirst($text), - q{threadmember}, - $tracelevel) - if defined $::RD_TRACE; - $expectation->failed(); - last; - } - Parse::RecDescent::_trace(q{>>Matched subrule: [thread]<< (return value: [} - . $_tok . q{]}, - - Parse::RecDescent::_tracefirst($text), - q{threadmember}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{thread}} = $_tok; - push @item, $_tok; - - } - - Parse::RecDescent::_trace(q{Trying action}, - Parse::RecDescent::_tracefirst($text), - q{threadmember}, - $tracelevel) - if defined $::RD_TRACE; - - - $_tok = ($_noactions) ? 0 : do { $return = $item{thread} ; }; - unless (defined $_tok) - { - Parse::RecDescent::_trace(q{<> (return value: [undef])}) - if defined $::RD_TRACE; - last; - } - Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} - . $_tok . q{])}, - Parse::RecDescent::_tracefirst($text)) - if defined $::RD_TRACE; - push @item, $_tok; - $item{__ACTION1__}=$_tok; - - - - Parse::RecDescent::_trace(q{>>Matched production: [thread]<<}, - Parse::RecDescent::_tracefirst($text), - q{threadmember}, - $tracelevel) - if defined $::RD_TRACE; - $_matched = 1; - last; - } - - - unless ( $_matched || defined($return) || defined($score) ) - { - - - $_[1] = $text; # NOT SURE THIS IS NEEDED - Parse::RecDescent::_trace(q{<>}, - Parse::RecDescent::_tracefirst($_[1]), - q{threadmember}, - $tracelevel) - if defined $::RD_TRACE; - return undef; - } - if (!defined($return) && defined($score)) - { - Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", - q{threadmember}, - $tracelevel) - if defined $::RD_TRACE; - $return = $score_return; - } - splice @{$thisparser->{errors}}, $err_at; - $return = $item[$#item] unless defined $return; - if (defined $::RD_TRACE) - { - Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . - $return . q{])}, "", - q{threadmember}, - $tracelevel); - Parse::RecDescent::_trace(q{(consumed: [} . - Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, - Parse::RecDescent::_tracefirst($text), - , q{threadmember}, - $tracelevel) - } - $_[1] = $text; - return $return; -} -} -package Mail::IMAPClient::Thread; sub new { my $self = bless( { - '_AUTOTREE' => undef, - 'localvars' => '', - 'startcode' => '', - '_check' => { - 'thisoffset' => '', - 'itempos' => '', - 'prevoffset' => '', - 'prevline' => '', - 'prevcolumn' => '', - 'thiscolumn' => '' - }, - 'namespace' => 'Parse::RecDescent::Mail::IMAPClient::Thread', - '_AUTOACTION' => undef, - 'rules' => { - 'thread' => bless( { - 'impcount' => 0, - 'calls' => [ - 'threadmember' - ], - 'changed' => 0, - 'opcount' => 0, - 'prods' => [ - bless( { - 'number' => '0', - 'strcount' => 2, - 'dircount' => 0, - 'uncommit' => undef, - 'error' => undef, - 'patcount' => 0, - 'actcount' => 1, - 'items' => [ - bless( { - 'pattern' => '(', - 'hashname' => '__STRING1__', - 'description' => '\'(\'', - 'lookahead' => 0, - 'line' => 279 - }, 'Parse::RecDescent::InterpLit' ), - bless( { - 'subrule' => 'threadmember', - 'expected' => undef, - 'min' => 1, - 'argcode' => undef, - 'max' => 100000000, - 'matchrule' => 0, - 'repspec' => 's', - 'lookahead' => 0, - 'line' => 279 - }, 'Parse::RecDescent::Repetition' ), - bless( { - 'pattern' => ')', - 'hashname' => '__STRING2__', - 'description' => '\')\'', - 'lookahead' => 0, - 'line' => 279 - }, 'Parse::RecDescent::InterpLit' ), - bless( { - 'hashname' => '__ACTION1__', - 'lookahead' => 0, - 'line' => 280, - 'code' => '{ - $return = $item{\'threadmember(s)\'}||undef; - }' - }, 'Parse::RecDescent::Action' ) - ], - 'line' => undef - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'thread', - 'vars' => '', - 'line' => 279 - }, 'Parse::RecDescent::Rule' ), - 'NUMBER' => bless( { - 'impcount' => 0, - 'calls' => [], - 'changed' => 0, - 'opcount' => 0, - 'prods' => [ - bless( { - 'number' => '0', - 'strcount' => 0, - 'dircount' => 0, - 'uncommit' => undef, - 'error' => undef, - 'patcount' => 1, - 'actcount' => 0, - 'items' => [ - bless( { - 'pattern' => '\\d+', - 'hashname' => '__PATTERN1__', - 'description' => '/\\\\d+/', - 'lookahead' => 0, - 'rdelim' => '/', - 'line' => 272, - 'mod' => '', - 'ldelim' => '/' - }, 'Parse::RecDescent::Token' ) - ], - 'line' => undef - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'NUMBER', - 'vars' => '', - 'line' => 270 - }, 'Parse::RecDescent::Rule' ), - 'start' => bless( { - 'impcount' => 0, - 'calls' => [ - 'thread' - ], - 'changed' => 0, - 'opcount' => 0, - 'prods' => [ - bless( { - 'number' => '0', - 'strcount' => 0, - 'dircount' => 0, - 'uncommit' => undef, - 'error' => undef, - 'patcount' => 1, - 'actcount' => 1, - 'items' => [ - bless( { - 'pattern' => '^\\* THREAD ', - 'hashname' => '__PATTERN1__', - 'description' => '/^\\\\* THREAD /i', - 'lookahead' => 0, - 'rdelim' => '/', - 'line' => 285, - 'mod' => 'i', - 'ldelim' => '/' - }, 'Parse::RecDescent::Token' ), - bless( { - 'subrule' => 'thread', - 'expected' => undef, - 'min' => 0, - 'argcode' => undef, - 'max' => 100000000, - 'matchrule' => 0, - 'repspec' => 's?', - 'lookahead' => 0, - 'line' => 285 - }, 'Parse::RecDescent::Repetition' ), - bless( { - 'hashname' => '__ACTION1__', - 'lookahead' => 0, - 'line' => 285, - 'code' => '{ - $return=$item{\'thread(s?)\'}||undef; -}' - }, 'Parse::RecDescent::Action' ) - ], - 'line' => undef - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'start', - 'vars' => '', - 'line' => 284 - }, 'Parse::RecDescent::Rule' ), - 'threadmember' => bless( { - 'impcount' => 0, - 'calls' => [ - 'NUMBER', - 'thread' - ], - 'changed' => 0, - 'opcount' => 0, - 'prods' => [ - bless( { - 'number' => '0', - 'strcount' => 0, - 'dircount' => 0, - 'uncommit' => undef, - 'error' => undef, - 'patcount' => 0, - 'actcount' => 1, - 'items' => [ - bless( { - 'subrule' => 'NUMBER', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 276 - }, 'Parse::RecDescent::Subrule' ), - bless( { - 'hashname' => '__ACTION1__', - 'lookahead' => 0, - 'line' => 276, - 'code' => '{ $return = $item{NUMBER} ; }' - }, 'Parse::RecDescent::Action' ) - ], - 'line' => undef - }, 'Parse::RecDescent::Production' ), - bless( { - 'number' => '1', - 'strcount' => 0, - 'dircount' => 0, - 'uncommit' => undef, - 'error' => undef, - 'patcount' => 0, - 'actcount' => 1, - 'items' => [ - bless( { - 'subrule' => 'thread', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 277 - }, 'Parse::RecDescent::Subrule' ), - bless( { - 'hashname' => '__ACTION1__', - 'lookahead' => 0, - 'line' => 277, - 'code' => '{ $return = $item{thread} ; }' - }, 'Parse::RecDescent::Action' ) - ], - 'line' => 276 - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'threadmember', - 'vars' => '', - 'line' => 274 - }, 'Parse::RecDescent::Rule' ) - } - }, 'Parse::RecDescent' ); -} diff --git a/Mail-IMAPClient-2.99_02/blib/lib/auto/Mail/IMAPClient/.exists b/Mail-IMAPClient-2.99_02/blib/lib/auto/Mail/IMAPClient/.exists deleted file mode 100644 index e69de29..0000000 diff --git a/Mail-IMAPClient-2.99_02/blib/man1/.exists b/Mail-IMAPClient-2.99_02/blib/man1/.exists deleted file mode 100644 index e69de29..0000000 diff --git a/Mail-IMAPClient-2.99_02/blib/man3/.exists b/Mail-IMAPClient-2.99_02/blib/man3/.exists deleted file mode 100644 index e69de29..0000000 diff --git a/Mail-IMAPClient-2.99_02/blib/script/.exists b/Mail-IMAPClient-2.99_02/blib/script/.exists deleted file mode 100644 index e69de29..0000000 diff --git a/Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm b/Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm deleted file mode 100644 index 58d943b..0000000 --- a/Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm +++ /dev/null @@ -1,2856 +0,0 @@ - -package Mail::IMAPClient; -our $VERSION = '2.99_02'; - -use Mail::IMAPClient::MessageSet; - -use Socket(); -use IO::Socket(); -use IO::Select(); -use IO::File(); -use Carp qw(carp); - -use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK); -use Errno qw/EAGAIN/; -use List::Util qw/first min max sum/; -use Digest::HMAC_MD5 qw/hmac_md5_hex/; -use MIME::Base64; - -use constant Unconnected => 0; -use constant Connected => 1; # connected; not logged in -use constant Authenticated => 2; # logged in; no mailbox selected -use constant Selected => 3; # mailbox selected - -use constant INDEX => 0; # Array index for output line number -use constant TYPE => 1; # Array index for line type - # (either OUTPUT, INPUT, or LITERAL) -use constant DATA => 2; # Array index for output line data - -use constant NonFolderArg => 1; # Value to pass to Massage to - # indicate non-folder argument - -my %SEARCH_KEYS = map { ( $_ => 1 ) } qw/ - ALL ANSWERED BCC BEFORE BODY CC DELETED DRAFT FLAGGED - FROM HEADER KEYWORD LARGER NEW NOT OLD ON OR RECENT - SEEN SENTBEFORE SENTON SENTSINCE SINCE SMALLER SUBJECT - TEXT TO UID UNANSWERED UNDELETED UNDRAFT UNFLAGGED - UNKEYWORD UNSEEN/; - -sub _debug -{ my $self = shift; - return unless $self->Debug; - my $fh = $self->{Debug_fh} || \*STDERR; - print $fh @_; -} - -BEGIN { - # set-up accessors - foreach my $datum ( - qw(State Port Server Folder Peek User Password Timeout Buffer - Debug Count Uid Debug_fh Maxtemperrors - EnableServerResponseInLiteral Authmechanism Authcallback Ranges - Readmethod Showcredentials Prewritemethod Ignoresizeerrors - Supportedflags Proxy)) - { no strict 'refs'; - *$datum = sub { @_ > 1 ? $_[0]->{$datum} = $_[1] : $_[0]->{$datum} }; - } -} - -sub LastError -{ my $self = shift; - $self->{LastError} = shift if @_; - $@ = $self->{LastError}; -} - -sub Fast_io(;$) -{ my ($self, $use) = @_; - defined $use - or return $self->{File_io}; - - my $socket = $self->{Socket} - or return; - - unless($use) - { eval { fcntl($socket, F_SETFL, delete $self->{_fcntl}) } - if exists $self->{_fcntl}; - $@ = ''; - $self->{Fast_io} = 0; - return; - } - - my $fcntl = eval { fcntl($Socket, F_GETFL, 0) }; - if($@) - { $self->{Fast_io} = 0; - $self->_debug("not using Fast_IO; not available on this platform") - unless $self->{_fastio_warning_}++; - $@ = ''; - return; - } - - $self->{Fast_io} = 1; - my $newflags = $self->{_fcntl} = $fcntl; - $newflags |= O_NONBLOCK; - fcntl($socket, F_SETFL, $newflags); -} - -sub Socket(;$) -{ my ($self, $sock) = @_; - defined $sock - or return $self->{Socket}; - - delete $self->{_fcntl}; - # Register this handle in a select vector: - $self->{_select} = IO::Select->new($_[1]); -} - -sub Wrap { shift->Clear(@_) } - -# The following class method is for creating valid dates in appended msgs: - -my @dow = qw/Sun Mon Tue Wed Thu Fri Sat/; -my @mnt = qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/; - -sub Rfc822_date -{ my $class = shift; #Date: Fri, 09 Jul 1999 13:10:55 -0000# - my $date = $class =~ /^\d+$/ ? $class : shift; # method or function? - my @date = gmtime $date; - - sprintf "%s, %2.2d %s %4.4s %2.2d:%2.2d:%2.2d -%4.4d" - , $dow[$date[6]], $date[3], $mnt[$date[4]], $date[5]+=1900 - , $date[2], $date[1], $date[0], $date[8]; -} - -# The following class method is for creating valid dates for use -# in IMAP search strings: - -sub Rfc2060_date -{ my $class = shift; # 11-Jan-2000 - my $date = $class =~ /^\d+$/ ? $class : shift; # method or function - my @date = gmtime $date; - - sprintf "%2.2d-%s-%4.4s", $date[3], $mnt[$date[4]], $date[5]+=1900; -} - -# Change CRLF into \n - -sub Strip_cr -{ my $class = shift; - if( !ref $_[0] && @_==1 ) - { (my $string = $_[0]) =~ s/\x0d\x0a/\n/g; - return $string; - } - - wantarray - ? map { s/\x0d\x0a/\n/gm; $_ } (ref $_[0] ? @{$_[0]} : @_) - : [ map { s/\x0d\x0a/\n/gm; $_ } (ref $_[0] ? @{$_[0]} : @_) ]; -} - -# The following defines a special method to deal with the Clear parameter: - -sub Clear -{ my ($self, $clear) = @_; - defined $clear or return $self->{Clear}; - - my $oldclear = $self->{Clear}; - $self->{Clear} = $clear; - - my @keys = reverse $self->_trans_index; - - for(my $i = $clear; $i < @keys ; $i++ ) - { delete $self->{History}{$keys[$i]}; - } - - $oldclear; -} - -# read-only access to the transaction number: -sub Transaction { shift->Count }; - -# the constructor: -sub new -{ my $class = shift; - my $self = - { LastError => "", - , Uid => 1 - , Count => 0 - , Fast_io => 1 - , Clear => 5 - , Maxtemperrors => 'unlimited' - , State => Unconnected - }; - while(@_) - { my $k = ucfirst lc shift; - $self->{$k} = shift; - } - bless $self, ref($class)||$class; - - if($self->{Supportedflags}) # unpack into case-less HASH - { my %sup = map { m/^\\?(\S+)/ ? lc $1 : () } @$sup; - $self->{Supportedflags} = \%sup; - } - - $self->{Debug_fh} ||= \*STDERR; - select((select($self->{Debug_fh}),$|++)[0]); - - $self->_debug("Using Mail::IMAPClient version $Mail::IMAPClient::VERSION " . - "and perl version " . (defined $^V ? join(".",unpack("CCC",$^V)) : "") . - " ($])\n") if $self->Debug; - - if($self->{Socket}) { $self->Socket($self->{Socket}) } - elsif($self->{Server}) { $self->connect } - - $self; -} - -sub connect -{ my $self = shift; - %$self = (%$self, @_); - - my $sock = IO::Socket::INET->new - ( PeerAddr => $self->Server - , PeerPort => ( $self->Port || 'imap(143)') - , Timeout => ($self->Timeout || 0) - , Proto => 'tcp' - , Debug => $self->Debug - ); - - unless($sock) - { $self->LastError("Unable to connect to $self->{Server}: $!"); - return undef; - } - - $self->Socket($sock); - $self->State(Connected); - $sock->autoflush(1); - - my $code; - LINE: - while(my $output = $self->_read_line) - { foreach my $o (@$output) - { $self->_debug("Connect: Received this from readline: @$o\n"); - $self->_record($self->Count, $o); - next unless $o->[TYPE] eq "OUTPUT"; - - my $code = $o->[DATA] =~ /^\*\s+(OK|BAD|NO|PREAUTH)/i ? $1 : undef; - last LINE; - } - } - $code or return undef; - - if($code =~ /BYE|NO /) - { $self->State(Unconnected); - return undef; - } - - if($code =~ /PREAUTH/ ) - { $self->State(Authenticated); - return $self; - } - - $self->User && $self->Password ? $self->login : $self; -} - -sub login -{ my $self = shift; - return $self->authenticate($self->Authmechanism, $self->Authcallback) - if $self->{Authmechanism} && $self->{Authmechanism} ne 'LOGIN'; - - my $passwd = $self->Password; - my $id = $self->User; - $id = qq{"$id"} if $id !~ /^".*"$/; - - unless($self->_imap_command("LOGIN $id $passwd\r\n")) - { my $carp = $self->LastError; - $carp =~ s/^[\S]+ ([^\x0d\x0a]*)\x0d?\x0a/$1/; - carp $carp unless defined wantarray; - return undef; - } - - $self->State(Authenticated); - $self; -} - -sub separator -{ my ($self, $target) = @_; - unless(defined($target)) - { # separator is namespace's 1st thing's 1st thing's 2nd thing: - my $sep = eval { $self->namespace->[0][0][1] }; - return $sep if $sep; - } - - $target ||= '""'; - - # The fact that the response might end with {123} doesn't matter here: - - my $targetsep = $target. $; .'SEPARATOR'; - unless($self->{$targetset}) - { my $list = $self->list(undef, $target) || 'NO'; - my $s = $list =~ /^\*\s+LIST\s+(\S+)/ ? $1 : qq("/"); - $self->{$targetset} = $s eq 'NIL' ? 'NIL' : substr($s,1,length($s)-2) - if defined $s; - } - $self->{$targetsep}; -} - -sub sort -{ my ($self, $crit, @a) = @_; - - $crit =~ /^\(.*\)$/ # wrap criteria in parens - or $crit = "($crit)"; - - $self->_imap_uid_command(SORT => $crit, @a) - or return wantarray ? () : []; - - my @results = $self->History; - my @hits; - foreach (@results) - { chomp; - s/\r$//; - s/^\*\s+SORT\s+// or next; - push @hits, grep /\d/, split; - } - wantarray ? @hits : \@hits; -} - -sub list -{ my ($self, $reference, $target) = @_; - defined $reference or $reference = ""; - defined $target or $target = '*'; - length $target or $target = '""'; - - $target eq '*' || $target eq '""' - or $target = $self->Massage($target); -; - $self->_imap_command( qq[LIST "$reference" $target] ) - or return undef; - - wantarray ? $self->History : $self->Results; -} - -sub lsub -{ my ($self, $reference, $target) = @_; - defined $reference or $reference = ""; - defined $target or $target = '*'; - $target = $self->Massage($target); - - my $string = - $self->_imap_command( qq[LSUB "$reference" $target] ) - or return undef; - - wantarray ? $self->History : $self->Results; -} - -sub subscribed -{ my ($self, $what) = @_; - my $known = $what ? $what.$self->separator($what)."*" : undef; - - my @list = $self->lsub(undef, $known); - push @list, $self->lsub(undef, $what) if $what && $self->exists($what); - - my @folders; - for(my $m = 0; $m < @list; $m++ ) - { $list[$m] or next; - - if($list[$m] !~ /\x0d\x0a$/) - { $list[$m] .= $list[$m+1]; - $list[$m+1] = ""; - } - - # $self->_debug("Subscribed: examining $list[$m]\n"); - - push @folders, $1||$2 - if $list[$m] =~ - m/ ^ \* \s+ LSUB # * LSUB - \s+ \( [^\)]* \) \s+ # (Flags) - (?:"[^"]*"|NIL)\s+ # "delimiter" or NIL - (?:"([^"]*)"|(.*))\x0d\x0a$ # Name or "Folder name" - /ix; - } - - # for my $f (@folders) { $f =~ s/^\\FOLDER LITERAL:://;} - # remove doubles - my @clean; my %memory; - foreach (@folders) { push @clean, $_ unless $memory{$_}++ } - wantarray ? @clean : \@clean; -} - -sub deleteacl -{ my ($self, $target, $user) = @_; - $target = $self->Massage($target); - $user =~ s/^"(.*)"$/$1/; - $user =~ s/"/\\"/g; - - $self->_imap_command( qq[DELETEACL $target "$user"] ) - or return undef; - - wantarray ? $self->History : $self->Results; -} - -sub setacl -{ my ($self, $target, $user, $acl) = @_; - length $user or $user = $self->User; - length $targer or $target = $self->Folder; - - $target = $self->Massage($target); - $user =~ s/^"(.*)"$/$1/; - $user =~ s/"/\\"/g; - $acl =~ s/^"(.*)"$/$1/; - $acl =~ s/"/\\"/g; - - $self->_imap_command( qq[SETACL $target "$user" "$acl"] ) - or return undef; - - wantarray ? $self->History : $self->Results; -} - - -sub getacl -{ my ($self, $target) = @_; - defined $target or $target = $self->Folder; - my $mtarget = $self->Massage($target); - $self->_imap_command( qq[GETACL $mtarget] ) - or return undef; - - my @history = $self->History; - my $hash; - for(my $x = 0; $x < @history; $x++ ) - { - next if $history[$x] !~ /^\* ACL/; - - my $perm = $history[$x]=~ /^\* ACL $/ - ? $history[++$x].$history[++$x] - : $history[$x]; - - $perm =~ s/\s?\x0d\x0a$//; - until( $perm =~ /\Q$target\E"?$/ || !$perm) - { $perm =~ s/\s([^\s]+)\s?$// or last; - my $p = $1; - $perm =~ s/\s([^\s]+)\s?$// or last; - my $u = $1; - $hash->{$u} = $p; - $self->_debug("Permissions: $u => $p \n"); - } - } - $hash; -} - -sub listrights -{ my ($self, $target, $user) = @_; - $target ||= $self->Folder; - $target = $self->Massage($target); - - $user ||= $self->User; - $user =~ s/^"(.*)"$/$1/; - $user =~ s/"/\\"/g; - - $self->_imap_command( qq[LISTRIGHTS $target "$user"] ) - or return undef; - - my $resp = first { /^\* LISTRIGHTS/ } $self->History; - my @rights = split /\s/, $resp; - my $rights = join '', @rights[4..$#rights]; - $rights =~ s/"//g; - wantarray ? split(//, $rights) : $rights; -} - -sub select -{ my ($self, $target) = @_; - defined $target or return undef; - - my $qqtarget = $self->Massage($target); - my $old = $self->Folder; - - $self->_imap_command("SELECT $qqtarget") && $self->State(Selected) - or return undef; - - $self->Folder($target); - $old || $self; # ??$self?? -} - -sub message_string -{ my ($self, $msg) = @_; - my $expected_size = $self->size($msg); - defined $expected_size or return undef; # unable to get size - - my $peek = $self->Peek ? '.PEEK' : ''; - my $cmd = $self->map4rev1 ? "BODY${peek}[]" : "RFC822$peek"; - - $self->fetch($msg, $cmd) - or return undef; - - my $string = $self->transactionLiterals; - - unless($self->Ignoresizeerrors) - { # Should this return undef if length != expected? - # now, attempts are made to salvage parts of the message. - if( length($string) != $expected_size ) - { carp "${self}::message_string: " . - "expected $expected_size bytes but received ".length($string) - if $self->Debug || $^W; - } - - $string = substr $string, 0, $expected_size - if length($string) > $expected_size; - - if( length($string) < $expected_size ) - { $self->LastError("${self}::message_string: expected ". - "$expected_size bytes but received ".length($string)); - return undef; - } - } - - $string; -} - -sub bodypart_string -{ my($self, $msg, $partno, $bytes, $offset) = @_; - - unless( $self->has_capability('IMAP4REV1') ) - { $self->LastError("Unable to get body part; server ".$self->Server - . " does not support IMAP4REV1"); - return undef; - } - - $offset ||= 0; - my $cmd = "BODY" . ($self->Peek ? '.PEEK' : '') . "[$partno]" - . ($bytes ? "<$offset.$bytes>" : ''); - - $self->fetch($msg, $cmd) - or return undef; - - $self->transactionLiterals; -} - -sub message_to_file -{ my $self = shift; - my $fh = shift; - my $msgs = join ',', @_; - - my $handle; - if(ref $fh) { $handle = $fh } - else - { $handle = IO::File->new(">>$fh"); - unless(defined($handle)) - { $self->LastError("Unable to open $fh: $!"); - return undef; - } - binmode $handle; # For those of you who need something like this... - } - - - my $clear = $self->Clear; - $self->Clear($clear) - if $self->Count >= $clear && $clear > 0; - - my $peek = $self->Peek ? '.PEEK' : ''; - my $cmd = $self->imap4rev1 ? "RFC822$peek" : "BODY${peek}[]"; - my $uid = $self->Uid ? "UID " : ""; - my $trans = $self->Count($self->Count+1); - my $string = "$trans ${uid}FETCH $msgs $cmd"; - - $self->_record($trans, [0, "INPUT", "$string\x0d\x0a"] ); - - my $feedback = $self->_send_line($string); - unless($feedback) - { $self->LastError("Error sending '$string' to IMAP: $!"); - return undef; - } - - my $code; - - READ: - until($code) - { my $output = $self->_read_line($handle) - or return undef; - - foreach my $o (@$output) - { $self->_record($trans,$o); - next unless $self->_is_output($o); - - ($code) = $o->[DATA] =~ /^$trans (OK|BAD|NO)/mi; - if($o->[DATA] =~ /^\*\s+BYE/im) - { $self->State(Unconnected); - return undef; - } - } - } - ref $fh or close $handle; - $code =~ /^OK/im ? $self : undef; -} - -sub message_uid -{ my ($self, $msg) = @_; - - foreach ($self->fetch($msg, "UID")) - { return $1 if m/\(UID\s+(\d+)\s*\)\r?$/; - } - undef; -} - -sub original_migrate -{ my ($self, $peer, $msgs, $folder) = @_; - unless( eval { $peer->IsConnected } ) - { $self->LastError("Invalid or unconnected " . ref($self). - " object used as target for migrate." ); - return undef; - } - - unless($folder) - { $folder = $self->Folder; - unless($peer->exists($folder) || $peer->create($folder)) - { $self->LastError("Unable to created folder $folder on target " - . "mailbox: ".$peer->LastError); - return undef; - } - } - - $msgs = $self->search("ALL") - if uc $msgs eq 'ALL'; - - foreach my $mid (ref($msgs) ? @$msgs : $msgs) - { my $uid = $peer->append($folder, $self->message_string($mid)); - $self->LastError("Trouble appending to peer: ". $peer->LastError); - } -} - -sub migrate -{ my ($self, $peer, $msgs, $folder) = @_; - my $toSock = $peer->Socket, - my $fromSock = $self->Socket; - my $bufferSize = $self->Buffer || 4096; - - unless(eval {$peer->IsConnected} ) - { $self->LastError("Invalid or unconnected " . ref($self) - . " object used as target for migrate. $@"); - return undef; - } - - unless($folder) - { unless($folder = $self->Folder) - { $self->LastError( "No folder selected on source mailbox."); - return undef; - } - - unless($peer->exists($folder) || $peer->create($folder)) - { $self->LastError("Unable to create folder $folder on target " - . "mailbox: ". $peer->LastError); - return undef - }; - } - - defined $msgs or $msgs = "ALL"; - $msgs = $self->search("ALL") - if uc $msgs eq 'ALL'; - - my $range = $self->Range($msgs); - my $clear = $self->Clear; - - $self->_debug("Migrating the following msgs from $folder: $range\n"); - MSG: - foreach my $mid ($range->unfold) - { - $self->_debug("Migrating message $mid in folder $folder\n") - if $self->Debug; - - my $leftSoFar = my $size = $self->size($mid); - - # fetch internaldate and flags of original message: - my $intDate = $self->internaldate($mid); - my @flags = grep !/\\Recent/i, $self->flags($mid); - my $flags = join ' ', $peer->supported_flags(@flags); - - # set up transaction numbers for from and to connections: - my $trans = $self->Count($self->Count+1); - my $ptrans = $peer->Count($peer->Count+1); - - # If msg size is less than buffersize then do whole msg in one - # transaction: - if($size <= $bufferSize) - { my $new_mid = $peer->append_string - ($folder, $self->message_string($mid), $flags, $intDate); - - unless(defined $new_mid) - { $self->LastError("Unable to append to $folder " - . "on target mailbox. ". $peer->LastError); - return undef; - } - - $self->_debug("Copied message $mid in folder $folder to " - . $peer->User . '@' . $peer->Server - . ". New Message UID is $new_mid.\n") - if $self->Debug; - - $peer->_debug("Copied message $mid in folder $folder from " - . $self->User . '@' . $self->Server - . ". New Message UID is $new_mid.\n") - if $peer->Debug; - - next MSG; - } - - # otherwise break it up into digestible pieces: - my ($cmd, $pattern); - if($self->imap4rev1) - { $cmd = $self->Peek ? 'BODY.PEEK[]' : 'BODY[]'; - $pattern = sub { $_[0] =~ /\(.*BODY\[\]<\d+> \{(\d+)\}/i; $1 }; - } - else - { $cmd = $self->Peek ? 'RFC822.PEEK' : 'RFC822'; - $pattern = sub { $_[0] =~ /\(RFC822\[\]<\d+> \{(\d+)\}/i; $1 }; - } - - # Now let's warn the peer that there's a message coming: - - my $pstring = "$ptrans APPEND " . $self->Massage($folder) - . (length $flags ? " ($flags)" : '') . qq[ "$intDate" {$size}]; - - $self->_debug("About to issue APPEND command to peer for msg $mid\n") - if $self->Debug; - - $peer->_record($ptrans, [0, "INPUT", $pstring] ); - unless($peer->_send_line($pstring)) - { $self->LastError("Error sending '$pstring' to target IMAP: $!"); - return undef; - } - - # Get the "+ Go ahead" response: - my $code = 0; - until($code eq '+' || $code =~ /NO|BAD|OK/) - { - my $readSoFar = 0; - my $fromBuffer = '';; - $readSoFar += sysread($toSock, $fromBuffer, 1, $readSoFar) || 0 - until $fromBuffer =~ /\x0d\x0a/; - - $code = $fromBuffer =~ /^\+/ ? $1 - : $fromBuffer =~ / ^(?:\d+\s(BAD|NO))/ ? $1 : 0; - - $peer->_debug( "$folder: received $fromBuffer from server\n") - if $peer->Debug; - - # ... and log it in the history buffers - $self->_record($trans, [0, "OUTPUT", - "Mail::IMAPClient migrating message $mid to $peer->User\@$peer->Server"] ); - $peer->_record($ptrans, [0, "OUTPUT", $fromBuffer] ); - } - - if($code ne '+') - { $self->_debug("Error writing to target host: $@\n"); - next MIGMSG; - } - - # Here is where we start sticking in UID if that parameter - # is turned on: - my $string = ($self->Uid ? "UID " : "") . "FETCH $mid $cmd"; - - # Clean up history buffer if necessary: - $self->Clear($clear) - if $self->Count >= $clear && $clear > 0; - - # position will tell us how far from beginning of msg the - # next IMAP FETCH should start (1st time start at offet zero): - my $position = 0; - my $chunkCount = 0; - while($leftSoFar > 0) - { my $take = min $leftSoFar, $bufferSize; - my $newstring = "$trans $string<$position.$take>"; - - $self->_record($trans, [0, "INPUT", "$newstring\x0d\x0a"] ); - $self->_debug("Issuing migration command: $newstring\n" ) - if $self->Debug;; - - unless($self->_send_line($newstring)) - { $self->LastError("Error sending '$newstring' to source IMAP: $!"); - return undef; - } - - my $chunk; - until($chunk = $pattern->($fromBuffer)) - { $fromBuffer = ""; - until($fromBuffer=~/\x0d\x0a$/ ) - { sysread($fromSock, $fromBuffer, 1, length($fromBuffer)); - } - - $self->_record($trans, [0, "OUTPUT", "$fromBuffer"]); - - if($fromBuffer =~ /^$trans (?:NO|BAD)/ ) - { $self->LastError($fromBuffer); - next MIGMSG; - } - - if($fromBuffer =~ /^$trans (?:OK)/ ) - { $self->LastError("Unexpected good return code " . - "from source host: $fromBuffer"); - next MIGMSG; - } - - } - - $fromBuffer = ""; - my $readSoFar = 0; - while($readSoFar < $chunk) - { $readSoFar += sysread($fromSock, $fromBuffer - , $chunk-$readSoFar,$readSoFar) ||0; - } - - my $wroteSoFar = 0; - my $temperrs = 0; - my $waittime = .02; - my $maxagain = $self->Maxtemperrors || 10; - undef $maxagain if $maxagain eq 'unlimited'; - my @previous_writes; - - while($wroteSoFar < $chunk) - { while($wroteSoFar < $readSoFar) - { my $ret = syswrite($toSock, $fromBuffer - , $chunk - $wroteSoFar, $wroteSoFar); - - if(defined $ret) - { $wroteSoFar += $ret; - $maxwrite = max $maxwrite, $ret; - $temperrs = 0; - } - - if($! == EAGAIN) - { if(defined $maxagain && $temperrs++ > $maxagain) - { $self->LastError("Persistent '$!' errors"); - return undef; - } - - $waittime = $self->_optimal_sleep($maxwrite, - $waittime, \@previous_writes); - next; - } - - return; # no luck - } - - $peer->_debug("Chunk $chunkCount: Wrote $wroteSoFar (of $chunk)\n"); - } - } - - $position += $readSoFar; - $leftSoFar -= $readSoFar; - $fromBuffer = ""; - - # Finish up reading the server response from the fetch cmd - # on the source system: - - undef $code; - until($code) - { $self->_debug("Reading from source server; expecting ') OK' type response\n"); - $output = $self->_read_line or return undef; - foreach my $o (@$output) - { $self->_record($trans, $o); - $self->_is_output($o) or next; - - $code = $o->[DATA] =~ /^$trans (OK|BAD|NO)/mi ? $1 : undef; - if($o->[DATA] =~ /^\*\s+BYE/im) - { $self->State(Unconnected); - return undef; - } - } - } - } - - # Now let's send a to the peer to signal end of APPEND cmd: - { my $wroteSoFar = 0; - $fromBuffer = "\x0d\x0a"; - $wroteSoFar += syswrite($toSock,$fromBuffer,2-$wroteSoFar,$wroteSoFar)||0 - until $wroteSoFar >= 2; - - } - - # Finally, let's get the new message's UID from the peer: - my $new_mid; - undef $code; - until($code) - { $peer->_debug("Reading from target: expect new uid in response\n"); - - $output = $peer->_read_line or last; - foreach my $o (@$output) - { $peer->_record($ptrans,$o); - next unless $peer->_is_output($o); - - $code = $o->[DATA] =~ /^$ptrans (OK|BAD|NO)/mi ? $1 : undef; - $new_mid = $o->[DATA] =~ /APPENDUID \d+ (\d+)/ ? $1 : undef - if $code; - - if($o->[DATA] =~ /^\*\s+BYE/im) - { $peer->State(Unconnected); - return undef; - } - } - - $new_mid ||= "unknown"; - } - - if($self->Debug) - { $self->_debug("Copied message $mid in folder $folder to " - . $peer->User.'@'.$peer->Server. ". New Message UID is $new_mid.\n"); - - $peer->_debug("Copied message $mid in folder $folder from " - . $self->User.'@'.$self->Server . ". New Message UID is $new_mid.\n"); - } - - $self; -} - -# Optimization of wait time between syswrite calls only runs if syscalls -# run too fast and fill the buffer causing "EAGAIN: Resource Temp. Unavail" -# errors. The premise is that $maxwrite will be approx. the same as the -# smallest buffer between the sending and receiving side. Waiting time -# between syscalls should ideally be exactly as long as it takes the -# receiving side to empty that buffer, minus a little bit to prevent it -# from emptying completely and wasting time in the select call. - -sub _optimal_sleep($$$) -{ my ($self, $maxwrite, $waittime, $last5writes) = @_; - - push @$last5writes, $ret; - shift @$last5writes if @$last5writes > 5; - - my $bufferavail = (sum @$last5writes) / @$last5writes; - - if($bufferavail < .4 * $maxwrite) - { # Buffer is staying pretty full; we should increase the wait - # period to reduce transmission overhead/number of packets sent - $waittime *= 1.3; - } - elsif($bufferavail > .9 * $maxwrite) - { # Buffer is nearly or totally empty; we're wasting time in select - # call that could be used to send data, so reduce the wait period - $waittime *= .5; - } - - CORE::select(undef, undef, undef, $waittime); - $waittime; -} - -sub body_string -{ my ($self, $msg) = @_; - my $ref = $self->fetch($msg, "BODY" .($self->Peek ? ".PEEK" : "")."[TEXT]"); - - my $string = join '', map {$_->[DATA]} - grep {defined $_ && $self->_is_literal($_)} @$ref; - - return $string - if $string; - - while(my $head = shift @$ref) - { $self->_debug("body_string: head = '$head'\n"); - - last if $head =~ - /(?:.*FETCH .*\(.*BODY\[TEXT\])|(?:^\d+ BAD )|(?:^\d NO )/i; - } - - unless(@$ref) - { $self->LastError("Unable to parse server response from ".$self->LastIMAPCommand); - return undef; - } - - my $popped; - $popped = pop @$ref # (-: vi - until ($popped && $popped =~ /\)\x0d\x0a$/) # (-: vi - || ! grep /\)\x0d\x0a$/, @$ref; - - if($head =~ /BODY\[TEXT\]\s*$/i ) - { # Next line is a literal - $string .= shift @$ref while @$ref; - $self->_debug("String is now $string\n") - if $self->Debug; - } - - $string; -} - - -sub examine -{ my ($self, $target) = @_; - defined $target or return undef; - - $target = $self->Massage($target); - - my $old = $self->Folder; - - $self->_imap_command("EXAMINE $target") && $self->State(Selected) - or return undef; - - $self->Folder($target); - $old || $self; -} - -sub idle -{ my $self = shift; - my $good = '+'; - my $count = $self->Count +1; - $self->_imap_command("IDLE", $good) ? $count : undef; -} - -sub done -{ my $self = shift; - my $count = shift || $self->Count; - - my $clear = $self->Clear; - $self->Clear($clear) - if $self->Count >= $clear && $clear > 0; - - my $string = "DONE\x0d\x0a"; - $self->_record($count, [$self->_next_index($count), "INPUT", "$string\x0d\x0a"] ); - - unless($self->_send_line($string, 1)) - { $self->LastError("Error sending '$string' to IMAP: $!"); - return undef; - } - - my ($code, $output); - $output = ""; - - until($code && $code =~ /(OK|BAD|NO)/m) - { $output = $self->_read_line or return undef; - for my $o (@$output) - { $self->_record($count,$o); - next unless $self->_is_output($o); - ($code) = $o->[DATA] =~ /^(?:$count) (OK|BAD|NO)/m; - $self->State(Unconnected) if $o->[DATA] =~ /^\*\s+BYE/; - } - } - $code =~ /^OK/ ? @{$self->Results} : undef; -} - -sub tag_and_run -{ my ($self, $string, $good) = @_; - $self->_imap_command($string, $good); - @{$self->Results}; #??? enforce list context -} - -# _{name} methods are undocumented and meant to be private. - -# _imap_command runs a command, inserting the correct tag -# and and whatnot. -# When updating _imap_command, remember to examine the run method, -# too, since it is very similar. - -sub _imap_command -{ my $self = shift; - my $string = shift or return undef; - my $good = shift || 'GOOD'; - my $qgood = quotemeta $good; - - my $clear = $clear = $self->Clear; - $self->Clear($clear) - if $self->Count >= $clear and $clear > 0; - - my $count = $self->Count($self->Count+1); - $string = "$count $string"; - - $self->_record($count, [0, "INPUT", "$string\x0d\x0a"] ); - - unless($self->_send_line($string)) - { $self->LastError("Error sending '$string' to IMAP: $!"); - return undef; - } - - my $code; - - READ: - until($code) - { my $output = $self->_read_line or return undef; - foreach my $o (@$output) - { $self->_record($count, $o); - $self->_is_output($o) or next; - - if($good eq '+') - { $o->[DATA] =~ /^$count (OK|BAD|NO|$qgood)|^($qgood)/mi; - $code = $1||$2; - } - else - { ($code) = $o->[DATA] =~ /^$count (OK|BAD|NO|$qgood)/mi; - } - if ($o->[DATA] =~ /^\*\s+BYE/im) - { $self->State(Unconnected); - return undef; - } - } - } - - $code =~ /^OK|$qgood/im ? $self : undef; - -} - -sub _imap_uid_command -{ my $self = shift; - my $cmd = shift; - my $args = @_ ? join(" ", '', @_) : ''; - my $uid = $self->Uid ? 'UID ' : ''; - $self->_imap_command("$uid$cmd$args"); -} - -sub run -{ - my $self = shift; - my $string = shift or return undef; - my $good = shift || 'GOOD'; - my $count = $self->Count($self->Count+1); - my $tag = $string =~ /^(\S+) / ? $1 : undef; - - $tag or $self->LastError("Invalid string passed to run method; no tag found."); - - my $qgood = quotemeta($good); - my $clear = $self->Clear; - $self->Clear($clear) - if $self->Count >= $clear && $clear > 0; - - $self->_record($count, [$self->_next_index($count), "INPUT", "$string"] ); - - unless($self->_send_line("$string",1)) - { $self->LastError("Error sending '$string' to IMAP: $!"); - return undef; - } - - my ($code, $output); - $output = ""; - - until($code =~ /(OK|BAD|NO|$qgood)/m ) - { $output = $self->_read_line or return undef; - foreach my $o (@$output) - { $self->_record($count,$o); - next unless $self->_is_output($o); - if($good eq '+') - { $o->[DATA] =~ /^(?:$tag|\*) (OK|BAD|NO|$qgood)|(^$qgood)/m; - $code = $1 || $2; - } - else - { ($code) = $o->[DATA] =~ /^(?:$tag|\*) (OK|BAD|NO|$qgood)/m; - } - - $o->[DATA] =~ /^\*\s+BYE/ - and $self->State(Unconnected); - } - } - - $tag eq $count - or $self->{History}{$tag} = $self->{History}{$count}; - - $code =~ /^OK|$qgood/ ? @{$self->Results} : undef; -} - -# _record saves the conversation into the History structure: -sub _record -{ my ($self, $count, $array) = @_; - local($^W)= undef; - - if ($array->[DATA] =~ /^\d+ LOGIN/i && !$self->Showcredentials) - { $array->[DATA] =~ s/LOGIN.*/LOGIN XXXXXXXX XXXXXXXX/i; - } - - push @{$self->{History}{$count}}, $array; - - if($array->[DATA] =~ /^\d+\s+(BAD|NO)\s/im ) - { $self->LastError($array->[DATA]); - carp "$array->[DATA]" if $^W; - } - $self; -} - -#_send_line writes to the socket: -sub _send_line -{ my ($self, $string,$suppress) = (shift, shift, shift); - - unless($self->IsConnected && $self->Socket) - { $self->LastError("NO Not connected."); - carp "Not connected" if $^W; - return undef; - } - - unless($string =~ /\x0d\x0a$/ || $suppress ) - { chomp $string; - $string .= "\x0d" unless $string =~ /\x0d$/; - $string .= "\x0a"; - } - - if ($string =~ /^[^\x0a{]*\{(\d+)\}\x0d\x0a/) # ;-} vi - { my ($p1,$p2,$len); - if( ($p1,$len) = $string =~ /^([^\x0a{]*\{(\d+)\}\x0d\x0a)/ # }-: vi - && ( $len < 32766 - ? (($p2) = $string =~ / ^[^\x0a{]* \{\d+\} \x0d\x0a - ( .{$len} .*\x0d\x0a) /x ) - : (($p2) = $string =~ / ^[^\x0a{]* \{\d+\} \x0d\x0a - (.*\x0d\x0a) /x - && length($p2) == $len ) # }} vi - ) - ) - { - $self->_debug("Sending literal string " . - "in two parts: $p1\n\tthen: $p2\n"); - - $self->_send_line($p1) or return undef; - $output = $self->_read_line or return undef; - - foreach my $o (@$output) - { $self->_record($self->Count, $o); - ($code) = $o->[DATA] =~ /(^\+|NO|BAD)/i; - - if($o->[DATA] =~ /^\*\s+BYE/) - { $self->State(Unconnected); - close $fh; - return undef; - } - elsif($o->[DATA]=~ /^\d+\s+(NO|BAD)/i ) - { close $fh; - return undef; - } - } - - $code eq '+' or return undef; - $string = $p2; - } - } - - if($self->Debug) # debug must not show password - { my $dstring = $string; - my ($user, $passwd) = ($self->{Password}, $self->{User}); - $dstring =~ s#\b(?:\Q$passwd\E|\Q$user\E)\b#'X' x length($Passwd)#eg - if $dstring =~ m[\d+\s+Login\s+]i; - $self->_debug("Sending: $dstring\n"); - } - - if(my $prew = $self->Prewritemethod) - { $string = $prew->($self, $string); - $self->_debug("Sending: $string\n"); - } - - my $total = 0; - my $temperrs = 0; - my $maxwrite = 0; - my $waittime = .02; - my @previous_writes; - - my $maxagain = $self->Maxtemperrors || 10; - undef $maxagain if $maxagain eq 'unlimited'; - - while($total < length $string) - { my $ret = syswrite($self->Socket, $string, length($string)-$total, - $total); - - if(defined $ret) - { $temperrs = 0; - $total += $ret; - next; - } - - if($! == EAGAIN) - { if(defined $maxagain && $temperrs++ > $maxagain) - { $self->LastError("Persistent '$!' errors"); - return undef; - } - - $waittime = $self->_optimal_sleep($maxwrite, $waittime, \@previous_writes); - next; - } - - return; # no luck - } - - $self->_debug("Sent $total bytes\n"); - $total; -} - -# _read_line: read one line from the socket - -# It is also re-implemented in: message_to_file -# -# syntax: $output = $self->_readline( ( $literal_callback|undef ) , ( $output_callback|undef ) ); -# Both input argument are optional, but if supplied must either be a filehandle, coderef, or undef. -# -# Returned argument is a reference to an array of arrays, ie: -# $output = [ -# [ $index, 'OUTPUT'|'LITERAL', $output_line ] , -# [ $index, 'OUTPUT'|'LITERAL', $output_line ] , -# ... # etc, -# ]; - -sub _read_line -{ my ($self, $literal_callback, $output_callback) = @_; - - my $sh = $self->Socket; - unless($self->IsConnected && $self->Socket) - { $self->LastError("NO Not connected."); - return undef; - } - - my $iBuffer = ""; - my $oBuffer = []; - my $count = 0; - my $index = $self->_next_index($self->Transaction); - my $rvec = my $ready = my $errors = 0; - my $timeout = $self->Timeout; - - my $readlen = 1; - my $fast_io = $self->Fast_io; - - if($fast_io) - { $self->Fast_io($fast_io) if exists $self->{_fcntl}; - $readlen = $self->{Buffer} || 4096; - } - - until(@$oBuffer # there's stuff in output buffer: - && $oBuffer->[-1][DATA] =~ /\x0d\x0a$/ # the last thing there has cr-lf: - && $oBuffer->[-1][TYPE] eq "OUTPUT" # that thing is an output line: - && !length($iBuffer) # and the input buffer has been MT'ed: - ) - { my $transno = $self->Transaction; - - if($timeout) - { vec($rvec, fileno($self->Socket), 1) = 1; - - my @ready = $self->{_select}->can_read($timeout); - unless(@ready) - { $self->LastError("Tag $transno: Timeout after $timeout seconds" - . " waiting for data from server"); - - $self->_record($transno, - [ $self->_next_index($transno), "ERROR" - , "$transno * NO Timeout after $timeout seconds " . - "during read from server\x0d\x0a"]); - - $self->LastError("Timeout after $timeout seconds during " - . "read from server\x0d\x0a"); - - return undef; - } - } - - no warnings; - - my $ret = $self->_sysread($sh, \$iBuffer, $readlen, length($iBuffer)); - - if($timeout && !defined $ret) - { # Blocking read error... - my $msg = "Error while reading data from server: $!\x0d\x0a"; - $self->_record($transno, - [ $self->_next_index($transno), "ERROR", "$transno * NO $msg "]); - $@ = $msg; - return undef; - } - - if(defined $ret && $ret == 0) # Caught EOF... - { my $msg = "Socket closed while reading data from server.\x0d\x0a"; - $self->_record($transno, - [ $self->_next_index($transno), "ERROR","$transno * NO $msg "]); - $@ = $msg; - return undef; - } - - # successfully wrote to other end, keep going... - $count += $ret; - - while($iBuffer =~ s/^(.*?\x0d?\x0a)// ) - { my $current_line = $1; - - # This part handles IMAP "Literals", - # which according to rfc2060 look something like this: - # [tag]|* BLAH BLAH {nnn}\r\n - # [nnn bytes of literally transmitted stuff] - # [part of line that follows literal data]\r\n - - if($current_line !~ s/\{(\d+)\}\x0d\x0a$//) - { push @$oBuffer, [$index++, "OUTPUT" , $current_line]; - next; - } - - ## handle LITERAL - - # Set $len to be length of impending literal: - my $len = $1; - - $self->_debug("LITERAL: received literal in line ". - "$current_line of length $len; attempting to ". - "retrieve from the " . length($iBuffer) . - " bytes in: $iBuffer\n"); - - # Xfer up to $len bytes from front of $iBuffer to $litstring: - my $litstring = substr $iBuffer, 0, $len, ''; - - # Figure out what's left to read (i.e. what part of - # literal wasn't in buffer): - my $remainder_count = $len - length $litstring; - my $callback_value = ""; - - if(!$literal_callback) { ; } - elsif(UNIVERSAL::isa($literal_callback, 'GLOB')) - { print $literal_callback $litstring; - $litstring = ""; - } - elsif(UNIVERSAL::isa($literal_callback, 'CODE')) - { ; } # ignore - else - { $self->LastError(ref($literal_callback) . " is an " - . "invalid callback; must be a filehandle or CODE"); - } - - if($remainder_count > 0 && $timeout) - { - # wait for data from the the IMAP socket. - vec($rvec, fileno($self->Socket), 1) = 1; - unless(CORE::select($ready = $rvec, undef, - $errors = $rvec, $timeout)) - { $self->LastError("Tag $transno: Timeout waiting for " - . "literal data from server"); - return undef; - } - } - - fcntl($sh, F_SETFL, $self->{_fcntl}) - if $fast_io && defined $self->{_fcntl}; - - while($remainder_count > 0 ) - { $self->_debug("Still need $remainder_count to " . - "complete literal string\n"); - - my $ret = $self->_sysread($sh - , \$litstring, $remainder_count, length $litstring); - - $self->_debug("Received ret=$ret and buffer = " . - "\n$litstring\nwhile processing LITERAL\n"); - - if($timeout && !defined $ret) - { $self->_record($transno, - [ $self->_next_index($transno), "ERROR", - "$transno * NO Error reading data from server: $!\n" ]); - return undef; - } - - if($ret == 0 && $sh->eof) - { $self->_record($transno, - [ $self->_next_index($transno), "ERROR", - "$transno * BYE Server unexpectedly closed connection: $!\n" ]); - $self->State(Unconnected); - return undef; - } - - $remainder_count -= $ret; - - if(length $litstring > $len) - { # copy the extra struff into the iBuffer: - $iBuffer = substr $litstring, $len - , length($litstring) - $len, ''; - - if($literal_callback - && UNIVERSAL::isa($literal_callback, 'GLOB')) - { print $literal_callback $litstring; - $litstring = ""; - } - } - } - - $literal_callback->($litstring) - if defined $litstring - && UNIVERSAL::isa($literal_callback, 'CODE'); - - $self->Fast_io($fast_io) if $fast_io; - - # Now let's make sure there are no IMAP server output lines - # (i.e. [tag|*] BAD|NO|OK Text) embedded in the literal string - # (There shouldn't be but I've seen it done!), but only if - # EnableServerResponseInLiteral is set to true - - my $embedded_output = 0; - my $lastline = ( split(/\x0d?\x0a/,$litstring))[-1] - if $litstring; - - if( $self->EnableServerResponseInLiteral - && $lastline - && $lastline =~ /^(?:\*|(\d+))\s(BAD|NO|OK)/i) - { - $litstring =~ s/\Q$lastline\E\x0d?\x0a//; - $embedded_output++; - - $self->_debug("Got server output mixed in with literal: $lastline\n"); - } - - # Finally, we need to stuff the literal onto the - # end of the oBuffer: - push @$oBuffer, [$index++, "OUTPUT", $current_line], - [ $index++, "LITERAL", $litstring ]; - - push @$oBuffer, [$index++, "OUTPUT", $lastline] - if $embedded_output; - - } - } - - $self->_debug("Read: " . join("",map {$_->[DATA]} @$oBuffer) ."\n"); - @$oBuffer ? $oBuffer : undef; -} - -sub _sysread($$$$) -{ my ($self, $fh, $buf, $len, $off) = @_; - my $rm = $self->Readmethod; - $rm ? $rm->($self, @_) : sysread($fh, $buf, $len, $off); -} - -sub _trans_index() { sort {$a <=> $b} keys %{$_[0]->{History}} } - -# all default to last transaction -sub _transaction(;$) { @{$_[0]->{History}{$_[1] || $_[0]->Transaction}} } -sub _trans_data(;$) { map { $_->[DATA] } $_[0]->_transaction($_[1]) } - -sub Report { - my $self = shift; - map { $self->_trans_data($_) } $self->_trans_index; -} - -sub Results(;$) -{ my ($self, $trans) = @_; - my @a = $self->_trans_data($trans); - wantarray ? @a : \@a; -} - -sub LastIMAPCommand(;$) -{ my ($self, $trans) = @_; - my $cmd = ($self->_transaction($trans))[0]; - $msg ? $msg->[DATA] : undef; -} - -sub History(;$) -{ my ($self, $trans) = @_; - my ($cmd, @a) = $self->_trans_data($trans); - wantarray ? @a : \@a; -} - -# Don't know what it does, but used a few times. -sub transactionLiterals() -{ my $self = shift; - join '', map { $_->[DATA] } - grep { defined $_ && $self->_is_literal($_) } - $self->_transaction; -} - -sub Escaped_results -{ my ($self, $trans) = @_; - my @a; - foreach my $line (grep defined, $self->Results($trans)) - { if($self->_is_literal($line)) - { $line->[DATA] =~ s/([\\\(\)"\x0d\x0a])/\\$1/g; - push @a, qq("$line->[DATA]"); - } - else { push @a, $line->[DATA] } - } - - shift @a; # remove cmd - wantarray ? @a : \@a; -} - -sub Unescape -{ my $whatever = defined $_[1] ? $_[1] : $_[0]; - $whatever =~ s/\\([\\\(\)"\x0d\x0a])/$1/g; - $whatever; -} - -sub logout { - my $self = shift; - $self->_imap_command("LOGOUT"); - - delete $self->{Folders}; - delete $self->{_IMAP4REV1}; - eval {$self->Socket->close} if $self->Socket; - delete $self->{Socket}; - - $self->State(Unconnected); - $self; -} - -sub folders -{ my ($self, $what) = @_; - - ref $self->{Folders} && !$what - or return wantarray ? @{$self->{Folders}} : $self->{Folders}; - - my @folders; - my @list = $self->list(undef,($what ? $what.$self->separator($what)."*" : undef ) ); - push @list, $self->list(undef, $what) - if $what && $self->exists($what); - - for(my $m = 0; $m < scalar(@list); $m++ ) - { if($list[$m] && $list[$m] !~ /\x0d\x0a$/ ) - { $self->_debug("folders: concatenating $list[$m] and $list[$m+1]\n"); - $list[$m] .= $list[$m+1]; - $list[$m+1] = ""; - $list[$m] .= "\x0d\x0a" unless $list[$m] =~ /\x0d\x0a$/; - } - - $list[$m] =~ / ^\*\s+LIST # * LIST - \s+\([^\)]*\)\s+ # (Flags) - (?:"[^"]*"|NIL)\s+ # "delimiter" or NIL - (?:"([^"]*)"|(.*))\x0d\x0a$ # Name or "Folder name" - /ix - or next; - - my $folder = $1 || $2; - $folder = qq("$folder") - if $1 && !$self->exists($folder); - - push @folders, $folder - } - - my (@clean, %memory); - foreach my $f (@folders) { push @clean, $f unless $memory{$f}++ } - $self->{Folders} = \@clean unless $what; - - wantarray ? @clean : \@clean; -} - - -sub exists -{ my ($self, $what) = @_; - $self->STATUS($self->Massage($what),"(MESSAGES)") ? $self : undef; -} - -# Updated to handle embedded literal strings -sub get_bodystructure -{ my($self, $msg) = @_; - unless(eval {require Mail::IMAPClient::BodyStructure; 1} ) - { $self->LastError("Unable to use get_bodystructure: $@"); - return undef; - } - - my @out = $self->fetch($msg,"BODYSTRUCTURE"); - my $bs = ""; - my $output = grep /BODYSTRUCTURE \(/i, @out; # Wee! ;-) - if($output =~ /\r\n$/) - { $bs = eval { Mail::IMAPClient::BodyStructure->new($output) }; - } - else - { $self->_debug("get_bodystructure: reassembling original response\n"); - my $start = 0; - foreach my $o ($self->Results) - { next unless $self->_is_output_or_literal($o); - next unless $start or - $o->[DATA] =~ /BODYSTRUCTURE \(/i and ++$start; # Hi, vi! ;-) - - if(length $output && $self->_is_literal($o) ) - { my $data = $o->[DATA]; - $data =~ s/"/\\"/g; - $data =~ s/\(/\\\(/g; - $data =~ s/\)/\\\)/g; - $output .= qq("$data"); - } - else { $output .= $o->[DATA] } - - $self->_debug("get_bodystructure: reassembled output=$output\n"); - } - eval { $bs = Mail::IMAPClient::BodyStructure->new( $output )}; - } - - $self->_debug("get_bodystructure: msg $msg returns: ".($bs||"UNDEF")."\n"); - $bs; -} - -# Updated to handle embedded literal strings -sub get_envelope -{ my ($self,$msg) = @_; - unless( eval {require Mail::IMAPClient::BodyStructure ; 1 } ) - { $self->LastError("Unable to use get_envelope: $@"); - return undef; - } - - my @out = $self->fetch($msg,"ENVELOPE"); - my $bs = ""; - my $output = first { /ENVELOPE \(/i } @out; # Wee! ;-) - if($output =~ /\r\n$/ ) - { eval { $bs = Mail::IMAPClient::BodyStructure::Envelope->new($output) }; - } - else - { $self->_debug("get_envelope: reassembling original response\n"); - my $start = 0; - foreach my $o ($self->Results) - { next unless $self->_is_output_or_literal($o); - $self->_debug("o->[DATA] is $o->[DATA]\n"); - - next unless $start or - $o->[DATA] =~ /ENVELOPE \(/i and ++$start; - # Hi, vi! ;-) - - if ( length($output) and $self->_is_literal($o) ) { - my $data = $o->[DATA]; - $data =~ s/"/\\"/g; - $data =~ s/\(/\\\(/g; - $data =~ s/\)/\\\)/g; - $output .= '"'.$data.'"'; - } else { - $output .= $o->[DATA]; - } - $self->_debug("get_envelope: " . - "reassembled output=$output\n"); - } - - eval { $bs=Mail::IMAPClient::BodyStructure::Envelope->new($output) }; - } - - $self->_debug("get_envelope: msg $msg returns ref: ".($bs||"UNDEF")."\n"); - $bs; -} - -sub fetch -{ my $self = shift; - my $what = shift || "ALL"; - - my $take - = $what eq 'ALL' ? $self->Range($self->messages) - : ref $what || $what =~ /^[,:\d]+\w*$/ ? $self->Range($what) - : $what; - - $self->_imap_uid_command(FETCH => $take, @_) - or return (); - - wantarray ? $self->History : $self->Results; -} - -sub fetch_hash -{ my $self = shift; - my $uids = ref $_[-1] ? pop @_ : {}; - my @words = @_; - my $what = join ' ', @_; - - for(@words) - { s/([\( ])FAST([\) ])/${1}FLAGS INTERNALDATE RFC822\.SIZE$2/i; - s/([\( ])FULL([\) ])/${1}FLAGS INTERNALDATE RFC822\.SIZE ENVELOPE BODY$2/i; - } - - my $msgref = scalar $self->messages; - my $output = scalar $self->fetch($msgref, "($what)"); - - for(my $x = 0; $x <= $#$output ; $x++) - { my $entry = {}; - my $l = $output->[$x]; - - if($self->Uid) - { my $uid = $l =~ /\bUID\s+(\d+)/i ? $1 : undef; - $uid or next; - - if($uids->{$uid}) { $entry = $uids->{$uid} } - else { $uids->{$uid} ||= $entry } - - } - else - { my $mid = $l =~ /^\* (\d+) FETCH/i ? $1 : undef; - $mid or next; - - if($uids->{$mid}) { $entry = $uids->{$mid} } - else { $uids->{$mid} ||= $entry } - } - - foreach my $w (@words) - { if($l =~ /\Q$w\E\s*$/i ) - { $entry->{$w} = $output->[$x+1]; - $entry->{$w} =~ s/(?:\x0a?\x0d)+$//g; - chomp $entry->{$w}; - } - else - { - $l =~ /\( # open paren followed by ... - (?:.*\s)? # ...optional stuff and a space - \Q$w\E\s # escaped fetch field - (?:" # then: a dbl-quote - (\\.| # then bslashed anychar(s) or ... - [^"]+) # ... nonquote char(s) - "| # then closing quote; or ... - \( # ...an open paren - (\\.| # then bslashed anychar or ... - [^\)]+) # ... non-close-paren char - \)| # then closing paren; or ... - (\S+)) # unquoted string - (?:\s.*)? # possibly followed by space-stuff - \) # close paren - /xi; - $entry->{$w} = defined $1 ? $1 : defined $2 ? $2 : $3; - } - } - } - wantarray ? %$uids : $uids; -} - -sub store -{ my ($self, @a) = @_; - delete $self->{Folders}; - $self->_imap_uid_command(store => @a) - or return undef; - wantarray ? $self->History : $self->Results; -} - -sub subscribe -{ my ($self, @a) = @_; - delete $self->{Folders}; - $a[-1] = $self->Massage($a[-1]) if @a; - $self->_imap_uid_command(SUBSCRIBE => @a) - or return undef; - wantarray ? $self->History : $self->Results; -} - -sub delete -{ my ($self, @a) = @_; - delete $self->{Folders}; - $a[-1] = $self->Massage($a[-1]) if @a; - $self->_imap_uid_command(DELETE => @a) - or return undef; - wantarray ? $self->History : $self->Results; -} - -sub myrights -{ my ($self, @a) = @_; - delete $self->{Folders}; - $a[-1] = $self->Massage($a[-1]) if @a; - $self->_imap_uid_command(MYRIGHTS => @a) - or return undef; - wantarray ? $self->History : $self->Results; -} - -sub create -{ my ($self, @a) = @_; - delete $self->{Folders}; - $a[0] = $self->Massage($a[0]) if @a; - $self->_imap_uid_command(CREATE => @a) - or return undef; - wantarray ? $self->History : $self->Results; -} - -sub close -{ my $self = shift; - $self->Folders(undef); - $self->_imap_uid_command('CLOSE') - or return undef; - wantarray ? $self->History : $self->Results; -} - -sub expunge -{ my ($self, $folder) = @_; - defined $folder - or return; - - my $old = $self->Folder; - if(defined $old && $folder eq $old) - { $self->select($folder); - my $succ = $self->_imap_command('EXPUNGE'); - $self->select($old); - $succ or return undef; - } - else - { $self->_imap_command('EXPUNGE') - or return undef; - } - - wantarray ? $self->History : $self->Results; -} - -sub rename -{ my ($self, $from, $to) = @_; - - if($from =~ /^"(.*)"$/) - { $from = $1 unless $self->exists($from); - $from =~ s/"/\\"/g; - } - - if($to =~ /^"(.*)"$/) - { $to = $1 unless $self->exists($from) && $from =~ /^".*"$/; - $to =~ s/"/\\"/g; - } - - $self->_imap_command( qq[RENAME "$from" "$to"] ) ? $self : undef; -} - -sub status -{ my $self = shift; - my $folder = shift; - defined $folder or return; - - my $box = $self->Massage($folder); - my $which = @_ ? join(" ", @_) : 'MESSAGES'; - - $self->_imap_command("STATUS $box ($which)") - or return undef; - - wantarray ? $self->History : $self->Results; -} - -sub flags -{ my ($self, $msgspec) = @_; - my $msg - = ref $msgspec && $msgspec->isa('Mail::IMAPClient::MessageSet') - ? $msgspec - : $self->Range($msgspec); - - $msg->cat(@_) if @_; - - # Send command - $self->fetch($msg, "FLAGS") - or return undef; - - my $u_f = $self->Uid; - my $flagset = {}; - - # Parse results, setting entry in result hash for each line - foreach my $resultline ($self->Results) - { $self->_debug("flags: line = '$resultline'\n"); - if ( $resultline =~ - /\*\s+(\d+)\s+FETCH\s+ # * nnn FETCH - \( # open-paren - (?:\s?UID\s(\d+)\s?)? # optional: UID nnn - FLAGS\s?\((.*)\)\s? # FLAGS (\Flag1 \Flag2) - (?:\s?UID\s(\d+))? # optional: UID nnn - \) # close-paren - /x - ) - { my $mailid = $u_f ? ($2||$4) : $1; - $flagset->{$mailid} = [ split " ", $3 ]; - } - } - - # Or did he want a hash from msgid to flag array? - return $flagset - if ref $msgspec; - - # or did the guy want just one response? Return it if so - my $flagsref = $flagset->{$msgspec}; - wantarray ? @$flagsref : $flagsref; -} - -# reduce a list, stripping undeclared flags. Flags with or without -# leading backslash. -sub supported_flags(@) -{ my $self = shift; - my $sup = $self->Supportedflags - or return @_; - - return map { $sup->($_) } @_ - if ref $sup eq 'CODE'; - - grep { $sup->{ /^\\(\S+)/ ? lc $1 : ()} } @_; -} - -# parse_headers modified to allow second param to also be a -# reference to a list of numbers. If this is a case, the headers -# are read from all the specified messages, and a reference to -# an hash of mail numbers to references to hashes, are returned. -# I found, with a mailbox of 300 messages, this was -# *significantly* faster against our mailserver (< 1 second -# vs. 20 seconds) -# -# 2000-03-22 Adrian Smith (adrian.smith@ucpag.com) - -sub parse_headers -{ my ($self, $msgspec, @fields) = @_; - my $fields = join ' ', @fields; - my $msg = ref $msgspec eq 'ARRAY' ? $self->Range($msgspec) : $msgspec; - my $peek = !defined $self->Peek || $self->Peek ? '.PEEK' : ''; - - my $string = "$msg body$peek" - . ($fields eq 'ALL' ? '[HEADER]' : "[HEADER.FIELDS ($fields)]"); - - my @raw = $self->fetch($string) - or return undef; - - my %headers; # HASH from message ids to headers - my $h; # HASH of fields for current msgid - my $field; # previous field name - my %fieldmap = map { ( lc($_) => $_ ) } @fields; - - foreach my $header (map {split /\x0d?\x0a/} @raw) - { - if($header =~ s/^(?:\*|UID) \s+ (\d+) \s+ FETCH \s+ - \( \s* BODY\[HEADER (?:\.FIELDS)? .*? \]\s*//ix) - { # start new message header - $h = $headers{$1} = {}; - } - $header =~ /\S/ or next; - - # ( for vi - if($header =~ /^\)/) # end of this message - { undef $h; # inbetween headers - next; - } - - unless(defined $h) - { $self->_debug("found data between fetch headers: $header"); - next; - } - - if($header =~ s/^(\S+)\:\s*//) - { $field = $fieldmap{lc $1} || $1; - push @{$h->{$field}}, $header; - } - elsif(ref $h->{$field} eq 'ARRAY') # folded header - { $h->{$field}[-1] .= $header; - } - } - - # if we asked for one message, just return its hash, - # otherwise, return hash of numbers => header hash - ref $msgspec eq 'ARRAY' ? \%headers : $headers{$msgspec}; -} - -sub subject { $_[0]->get_header($_[1], "Subject") } -sub date { $_[0]->get_header($_[1], "Date") } -sub rfc822_header { shift->get_header(@_) } - -sub get_header -{ my ($self, $msg, $field) = @_; - my $headers = $self->parse_headers($msg, $field); - $headers ? $headers->{$field}[0] : undef; -} - -sub recent_count -{ my ($self, $folder) = (shift, shift); - - $self->status($folder, 'RECENT') - or return undef; - - my $r = first {s/\*\s+STATUS\s+.*\(RECENT\s+(\d+)\s*\)/$1/} $self->History; - chomp $r; - $r; -} - -sub message_count -{ my $self = shift; - my $folder = shift || $self->Folder; - - $self->status($folder, 'MESSAGES') - or return undef; - - foreach my $result ($self->Results) - { return $1 if $result->[DATA] =~ /\(MESSAGES\s+(\d+)\s*\)/; - } - - undef; -} - -sub recent() { shift->search('recent') } -sub seen() { shift->search('seen') } -sub unseen() { shift->search('unseen') } -sub messages() { shift->search('ALL') } - -sub sentbefore($$) { shift->_search_date(sentbefore => @_) } -sub sentsince($$) { shift->_search_date(sentsince => @_) } -sub senton($$) { shift->_search_date(senton => @_) } -sub since($$) { shift->_search_date(since => @_) } -sub before($$) { shift->_search_date(before => @_) } -sub on($$) { shift->_search_date(on => @_) } - -sub _search_date($$$) -{ my($self, $how, $time) = @_; - my $imapdate; - - if($time =~ /\d\d-\D\D\D-\d\d\d\d/ ) - { $imapdate = $time; - } - elsif($time =~ /^\d+$/ ) - { my @ltime = localtime $time; - $imapdate = sprintf "%2.2d-%s-%4.4d" - , $ltime[3], $mnt[$ltime[4]], $ltime[5] + 1900; - } - else - { $self->LastError("Invalid date format supplied to '$datum' method."); - return undef; - } - - $self->_imap_uid_command(SEARCH => $datum, $imapdate) - or return undef; - - my @hits; - foreach ($self->History) - { chomp; - s/\r$//; - s/^\*\s+SEARCH\s+//i or next; - push @hits, grep /\d/, split; - } - $self->_debug("Hits are: @hits\n"); - wantarray ? @hits : \@hits; -} - -sub or -{ my ($self, @what) = @_; - if(@what < 2) - { $self->LastError("Invalid number of arguments passed to or()"); - return undef; - } - - my $or = "OR ".$self->Massage(shift @what)." ".$self->Massage(shift @what); - - $or = "OR $or " . $self->Massage($_) - for @what; - - $self->_imap_uid_command(SEARCH => $or) - or return undef; - - my @hits; - foreach ($self->History) - { chomp; - s/\r$//; - s/^\*\s+SEARCH\s+//i or next; - push @hits, grep /\d/, split; - } - $self->_debug("Hits are now: @hits\n"); - - wantarray ? @hits : \@hits; -} - -sub disconnect { shift->logout } - -sub search -{ my ($self, @a) = @_; - - $@ = ""; - # massage? - $a[-1] = $self->Massage($a[-1], 1) - if @a > 1 && !exists $SEARCH_KEYS{uc $a[-1]}; - - $self->_imap_uid_command(SEARCH => @a) - or return undef; - - my @hits; - foreach ($self->History) - { chomp; - s/\r\n?/ /g; - s/^\*\s+SEARCH\s+(?=.*\d.*)// or next; - push @hits, grep /^\d+$/, split; - } - - @hits - or $self->LastError("Search completed successfully but " - . "found no matching messages"); - - wantarray ? @hits - : !@hits ? undef - : $self->Ranges ? $self->Range(\@hits) - : \@hits; -} - -# returns a Thread data structure -my $thread_parser; -sub thread -{ my $self = shift; - my $algorythm = shift || - ($self->has_capability("THREAD=REFERENCES")?"REFERENCES":"ORDEREDSUBJECT"); - my $charset = shift || "UTF-8"; - my @a = @_ ? @_ : 'ALL'; - - $a[-1] = $self->Massage($a[-1], 1) - if @a > 1 && ! exists $SEARCH_KEYS{uc $a[-1]}; - - $self->_imap_uid_command(THREAD => $algorythm, $charset, @a) - or return undef; - - unless($thread_parser) - { return if $thread_parser == 0; - - eval "require Mail::IMAPClient::Thread"; - if($@) - { $self->LastError($@); - $thread_parser = 0; - return undef; - } - $thread_parser = Mail::IMAPClient::Thread->new; - } - - my $thread; - foreach ($self->History) - { chomp $r; - s/\r\n?/ /g; - /^\*\s+THREAD\s+/ or next; - - $thread = $thread_parser->start($r); - } - - unless($thread) - { $self->LastError("Thread search completed successfully but found no matching messages"); - return undef; - } - - $thread; -} - -sub delete_message -{ my $self = shift; - my @msgs = map {ref $arg eq 'ARRAY' ? @$arg : split /\,/, $arg} @_; - - $self->store(join(',',@msgs),'+FLAGS.SILENT','(\Deleted)') - ? scalar @msgs - : 0 -} - -sub restore_message -{ my $self = shift; - my @msgs = map {ref $arg eq 'ARRAY' ? @$arg : split /\,/, $arg} @_; - - $self->store(join(',',@msgs),'-FLAGS','(\Deleted)'); - scalar grep /^\*\s\d+\sFETCH\s\(.*FLAGS.*(?!\\Deleted)/, $self->Results; -} - -#??? compare to uidnext. Why is Massage missing? -sub uidvalidity -{ my ($self, $folder) = @_; - my $vline = first { /UIDVALIDITY/i } $self->status($folder, "UIDVALIDITY"); - defined $vline && $vline =~ /\(UIDVALIDITY\s+([^\)]+)/ ? $1 : undef; -} - -sub uidnext -{ my $self = shift; - my $folder = $self->Massage(shift); - my $line = first { /UIDNEXT/i } $self->status($folder, "UIDNEXT"); - defined $line && $line =~ /\(UIDNEXT\s+([^\)]+)/ ? $1 : undef; -} - -sub capability -{ my $self = shift; - $self->_imap_command('CAPABILITY') - or return undef; - - if($self->{CAPABILITY}) - { my @caps = keys %{$self->{CAPABILITY}}; - return wantarray ? @caps : \@caps; - } - - my @caps = map { split } grep s/^\*\s+CAPABILITY\s+//, $self->History; - foreach (@caps) - { $self->{CAPABILITY}{uc $_}++; - $self->{uc $1} = uc $2 if /(.*?)\=(.*)/; - } - - wantarray ? @caps : \@caps; -} - -sub has_capability -{ my ($self, $which) = @_; - $self->capability; - $which ? $self->{CAPABILITY}{uc $which} : undef; -} - -sub imap4rev1 { - my $self = shift; - return $self->{_IMAP4REV1} if exists $self->{_IMAP4REV1}; - $self->{_IMAP4REV1} = $self->has_capability(IMAP4REV1); -} - -sub namespace { - # Returns a nested list as follows: - # [ - # [ - # [ $user_prefix, $user_delim ] (,[$user_prefix2 ,$user_delim ],...), - # ], - # [ - # [ $shared_prefix,$shared_delim] (,[$shared_prefix2,$shared_delim],... ), - # ], - # [ - # [$public_prefix, $public_delim] (,[$public_prefix2,$public_delim],...), - # ], - # ]; - - my $self = shift; - unless($self->has_capability("NAMESPACE")) - { $self->LastError($self->Count." NO NAMESPACE not supported by " - . $self->Server); - return undef; - } - - my @namespaces = map { /^\* NAMESPACE (.*)/ ? $1 : () } - $self->_imap_command("NAMESPACE")->Results; - - my $namespace = shift @namespaces; - $namespace =~ s/\x0d?\x0a$//; - - my($personal, $shared, $public) = $namespace =~ m# - (NIL|\((?:\([^\)]+\)\s*)+\))\s - (NIL|\((?:\([^\)]+\)\s*)+\))\s - (NIL|\((?:\([^\)]+\)\s*)+\)) - #xi; - - my @ns; - $self->_debug("NAMESPACE: pers=$personal, shared=$shared, pub=$public\n"); - foreach ($personal, $shared, $public) - { s/^\((.*)\)$/$1/; - lc $_ ne 'NIL' or next; - - my @pieces = m#\(([^\)]*)\)#g; - $self->_debug("NAMESPACE pieces: @pieces\n"); - - push @ns, [ map { [ m#"([^"]*)"\s*#g ] } @pieces ]; - } - - wantarray ? @ns : \@ns; -} - -sub internaldate -{ my ($self, $msg) = @_; - $self->_imap_uid_command(FETCH => $msg, 'INTERNALDATE') - or return undef; - my $internalDate = join '', $self->History; - $internalDate =~ s/^.*INTERNALDATE "//si; - $internalDate =~ s/\".*$//s; - $internalDate; -} - -sub is_parent -{ my ($self, $folder) = (shift, shift); - my $list = $self->list(undef, $folder) || "NO NO BAD BAD"; - my $line; - - for(my $m = 0; $m < @$list; $m++) - { - #$self->_debug("Judging whether or not $list->[$m] is fit for parenthood\n"); - - return undef - if $list->[$m] =~ /NoInferior/i; - - if($list->[$m] =~ s/(\{\d+\})\x0d\x0a$// ) - { $list->[$m] .= $list->[$m+1]; - $list->[$m+1] = ""; - } - - $line = $list->[$m] - if $list->[$m] =~ - / ^\*\s+LIST # * LIST - \s+\([^\)]*\)\s+ # (Flags) - "[^"]*"\s+ # "delimiter" - (?:"([^"]*)"|(.*))\x0d\x0a$ # Name or "Folder name" - /x; - } - - unless(length $line) - { $self->_debug("Warning: separator method found no correct o/p in:\n\t" . - join("\t",@list)."\n"); - } - my $f = defined $line && $line =~ /^\*\s+LIST\s+\(([^\)]*)\s*\)/ ? $1 : undef; - return 1 if $f =~ /HasChildren/i; - return 0 if $f =~ /HasNoChildren/i; - - unless($f =~ /\\/) # no flags at all unless there's a backslash - { my $sep = $self->separator($folder) || $self->separator(undef); - my $lead = $folder . $sep; - my $len = length $lead; - return scalar grep {$lead eq substr($_, 0, $len)} $self->folders; - } - - 0; # ??? -} - -sub selectable -{ my ($self, $f) = @_; - not grep /NoSelect/i, $self->list("", $f); -} - -sub append_string($$$;$$) -{ my $self = shift; - my $folder = $self->Massage(shift); - my ($text, $flags, $date) = @_; - - $text =~ s/\x0d?\x0a/\x0d\x0a/g; - - if(defined($flags)) - { $flags =~ s/^\s+//g; - $flags =~ s/\s+$//g; - $flags = "($flags)" if $flags !~ /^\(.*\)$/; - } - - if(defined $date) - { $date =~ s/^\s+//g; - $date =~ s/\s+$//g; - $date = qq/"$date"/ if $date !~ /^"/; - } - - my $clear = $self->Clear; - $self->Clear($clear) - if $self->Count >= $clear and $clear > 0; - - my $count = $self->Count($self->Count+1); - - my $string = "$count APPEND $folder " . ($flags ? "$flags " : "") . - ($date ? "$date " : "") . "{" . length($text) . "}\x0d\x0a"; - - $self->_record($count, [$self->_next_index($count), "INPUT", "$string\x0d\x0a" ] ); - - # Step 1: Send the append command. - - unless($self->_send_line($string)) - { $self->LastError("Error sending '$string' to IMAP: $!"); - return undef; - } - - my $code; - - # Step 2: Get the "+ go ahead" response - until($code) - { - my $output = $self->_read_line or return undef; - foreach my $o (@$output) - { $self->_record($count, $o); - next unless $self->_is_output($o); - - $code = $o->[DATA] =~ /(^\+|^\d*\s*NO\s|^\d*\s*BAD\s)/i ? $1 :undef; - - if($o->[DATA] =~ /^\*\s+BYE/i) - { $self->LastError("Error trying to append string: " - . "$o->[DATA]; Disconnected."); - $self->State(Unconnected); - } - elsif($o->[DATA] =~ /^\d*\s*(NO|BAD)/i ) # i and / transposed!!! - { $self->LastError("Error trying to append string: $o->[DATA]"); - return undef; - } - } - } - - $self->_record($count,[$self->_next_index($count),"INPUT","$text\x0d\x0a"]); - - # Step 3: Send the actual text of the message: - unless($self->_send_line("$text\x0d\x0a")) - { $self->LastError("Error sending append msg text to IMAP: $!"); - return undef; - } - - # Step 4: Figure out the results: - $code = undef; - until($code) - { $output = $self->_read_line or return undef; - foreach my $o (@$output) - { $self->_record($count, $o); - $code = $o->[DATA] =~ /^(?:$count|\*)\s+(OK|NO|BAD)\s/i ? $1 :undef; - - if($o->[DATA] =~ /^\*\s+BYE/im) - { $self->State(Unconnected); - $self->LastError("Error trying to append: $o->[DATA]"); - } - - if($code && $code !~ /^OK/im) - { $self->LastError("Error trying to append: $o->[DATA]"); - return undef; - } - } - } - - my $data = join "",map {$_->[TYPE] eq "OUTPUT" ? $_->[DATA] : ()} @$output; - $data =~ m#\s+(\d+)\]# ? $1 : $self; -} - -sub append -{ my $self = shift; - my $folder = shift; - my $text = join "\x0d\x0a", @_; - - $text =~ s/\x0d?\x0a/\x0d\x0a/g; - $self->append_string($folder, $text); -} - -sub append_file -{ my $self = shift; - my $folder = $self->Massage(shift); - my $file = shift; - my $control = shift; - - my $count = $self->Count($self->Count+1); #???? too early? - - unless(-f $file) - { $self->LastError("File $file not found."); - return undef; - } - - my $fh = IO::File->new($file); - unless($fh) - { $self->LastError("Unable to open $file: $!"); - return undef; - } - - my $bare_nl_count = grep m/^\x0a$|[^\x0d]\x0a$/, <$fh>; - - seek($fh,0,0); - - my $clear = $self->Clear; - $self->Clear($clear) - if $self->Count >= $clear and $clear > 0; - - my $length = $bare_nl_count + -s $file; - my $string = "$count APPEND $folder {$length}\x0d\x0a"; - - $self->_record($count, [$self->_next_index($count), "INPUT", $string] ); - - unless($self->_send_line($string)) - { $self->LastError("Error sending '$string' to IMAP: $!"); - $fh->close; - return undef; - } - - my $code; - - until($code) - { my $output = $self->_read_line; - unless($output) - { $fh->close; - return undef; - } - - foreach my $o (@$output) - { $self->_record($count,$o); - $code = $o->[DATA] =~ /(^\+|^\d+\sNO\s|^\d+\sBAD)\s/i ? $1 : undef; - - if($o->[DATA] =~ /^\*\s+BYE/ ) - { $self->State(Unconnected); - $fh->close; - return undef; - } - elsif($o->[DATA]=~ /^\d+\s+(NO|BAD)/i ) - { $fh->close; - return undef; - } - } - } - - # Slurp up headers: later we'll make this more efficient I guess - - local $/ = "\x0d\x0a\x0d\x0a"; - my $text = <$fh>; - - $text =~ s/\x0d?\x0a/\x0d\x0a/g; - $self->_record($count, - [$self->_next_index($count), "INPUT", "{From file $file}"] ); - - unless($self->_send_line($text)) - { $self->LastError("Error sending append msg text to IMAP: $!"); - $fh->close; - return undef; - } - $self->_debug("control points to $$control\n") if ref $control; - - $/ = ref $control ? "\x0a" : $control ? $control : "\x0a"; - while(defined($text = <$fh>)) - { $text =~ s/\x0d?\x0a/\x0d\x0a/g; - $self->_record($count, - [ $self->_next_index($count), "INPUT", "{from $file}\x0d\x0a"]); - - unless($self->_send_line($text,1)) - { $self->LastError("Error sending append msg text to IMAP: $!"); - $fh->close; - return undef; - } - } - - unless($self->_send_line("\x0d\x0a")) - { $self->LastError("Error sending append msg text to IMAP: $!"); - $fh->close; - return undef; - } - - # Now for the crucial test: Did the append work or not? - my $uid; - undef $code; - until($code) - { my $output = $self->_read_line or return undef; - foreach my $o (@$output) - { $self->_record($count,$o); - $self->_debug("append_file: Does $o->[DATA] have the code\n"); - $code = $o->[DATA] =~ m/^\d+\s(NO|BAD|OK)/i ? $1 : undef; - $uid = $o->[DATA] =~ m/UID\s+\d+\s+(\d+)\]/ ? $1 : undef; - - if($o->[DATA] =~ /^\*\s+BYE/) - { carp $o->[DATA] if $^W; - $self->State(Unconnected); - $fh->close; - return undef; - } - elsif($o->[DATA]=~ /^\d+\s+(NO|BAD)/i ) - { carp $o->[DATA] if $^W; - $fh->close; - return undef; - } - } - } - $fh->close; - - $code eq 'OK' ? undef - : defined $uid ? $uid - : $self; -} - - -sub authenticate -{ my ($self, $scheme, $response) = @_; - $scheme ||= $self->Authmechanism; - $response ||= $self->Authcallback; - my $clear = $self->Clear; - $self->Clear($clear) - if $self->Count >= $clear && $clear > 0; - - my $count = $self->Count($self->Count+1); - my $string = "$count AUTHENTICATE $scheme"; - - $self->_record($count, - [ $self->_next_index($self->Transaction), "INPUT", "$string\x0d\x0a"] ); - - unless($self->_send_line($string)) - { $self->LastError("Error sending '$string' to IMAP: $!"); - return undef; - } - - my $code; - until($code) - { my $output = $self->_read_line or return undef; - foreach my $o (@$output) - { $self->_record($count,$o); - $code = $o->[DATA] =~ /^\+(.*)$/ ? $1 : undef; - - if ($o->[DATA] =~ /^\*\s+BYE/) - { $self->State(Unconnected); - return undef; - } - } - } - - return undef - if $code =~ /^BAD|^NO/; - - if($scheme eq 'CRAM-MD5') - { $response ||= sub - { my ($code, $client) = @_; - my $hmac = hmac_md5_hex(decode_base64($code), $client->Password); - encode_base64($client->User." ".$hmac); - } - } - elsif($schema eq 'PLAIN') # PLAIN SASL - { $response ||= sub - { my ($code, $client) = @_; - encode_base64($client->User . chr(0) . $client->Proxy - . chr(0) . $client->Password); - }; - } - - unless($self->_send_line($response->($code, $self))) - { $self->LastError("Error sending append msg text to IMAP: $!"); - return undef; - } - - undef $code = $schema eq 'PLAIN' ? 'OK' : undef; - until($code) - { my $output = $self->_read_line or return undef; - foreach my $o (@$output) - { $self->_record($count,$o); - $code = $o->[DATA] =~ /^\+ (.*)$/ ? $1 : undef; - - if($code) - { unless($self->_send_line($response->($code, $self))) - { $self->LastError("Error sending append msg text to IMAP: $!"); - return undef; - } - undef $code; # Clear code; we're still not finished - } - - $code = $1 if $o->[DATA] =~ /^$count\s+(OK|NO|BAD)\b/; - if($o->[DATA] =~ /^\*\s+BYE/) - { $self->State(Unconnected); - return undef; - } - } - } - - - $code eq 'OK' - or return undef; - - $self->State(Authenticated); - $self; - -} - -# UIDPLUS response from a copy: [COPYUID (uidvalidity) (origuid) (newuid)] -sub copy -{ my ($self, $target, @msgs) = @_; - - $target = $self->Massage($target); - @msgs = $self->Ranges ? $self->Range(@msgs) - : sort { $a <=> $b } map { ref $_ ? @$_ : split(',',$_) } @msgs; - - my $msgs = $self->Ranges ? $self->Range(@msgs) - : join ',', map {ref $_ ? @$_ : $_} @msgs; - - $self->_imap_uid_command(COPY => $msgs, $target) - or return undef; - - my @results = $self->History; - - my @uids; - foreach (@results) - { chomp; - s/\r$//; - s/^.*\[COPYUID\s+\d+\s+[\d:,]+\s+([\d:,]+)\].*/$1/ or next; - push @uids, /(\d+):(\d+)/ ? ($1 ... $2) : (split /\,/); - - } - @uids ? join(",",@uids) : $self; -} - -sub move -{ my ($self, $target, @msgs) = @_; - - $self->exists($target) - or $self->create($target) && $self->subscribe($target); - - my $uids = $self->copy($target, map {ref $_ eq 'ARRAY' ? @$_ : $_} @msgs) - or return undef; - - $self->delete_message(@msgs) - or carp $self->LastError; - - $uids; -} - -sub set_flag -{ my ($self, $flag, @msgs) = @_; - @msgs = @{$msgs[0]} if ref $msgs[0] eq 'ARRAY'; - $flag = "\\$flag" - if $flag =~ /^(?:Answered|Flagged|Deleted|Seen|Draft)$/i; - - my $which = $self->Ranges ? $self->Range(@msgs) : join(',',@msgs); - $self->store( "$which+FLAGS.SILENT ($flag)" ); -} - -sub see -{ my($self, @msgs) = @_; - @msgs = @{$msgs[0]} if ref $msgs[0] eq 'ARRAY'; - $self->set_flag('\\Seen', @msgs); -} - -sub mark -{ my($self, @msgs) = @_; - @msgs = @{$msgs[0]} if ref $msgs[0] eq 'ARRAY'; - $self->set_flag('\\Flagged', @msgs); -} - -sub unmark -{ my($self, @msgs) = @_; - @msgs = @{$msgs[0]} if ref $msgs[0] eq 'ARRAY'; - $self->unset_flag('\\Flagged', @msgs); -} - -sub unset_flag { - my ($self, $flag, @msgs) = @_; - @msgs = @{$msgs[0]} if ref $msgs[0] eq 'ARRAY'; - - $flag = "\\$flag" - if $flag =~ /^(?:Answered|Flagged|Deleted|Seen|Draft)$/i; - - $self->store( join(",",@msgs), "-FLAGS.SILENT ($flag)" ); -} - -sub deny_seeing -{ my ($self, @msgs) = @_; - @msgs = @{$msgs[0]} if ref $msgs[0] eq 'ARRAY'; - $self->unset_flag('\\Seen', @msgs); -} - -sub size -{ my ($self,$msg) = @_; - my @data = $self->fetch($msg,"(RFC822.SIZE)"); - defined $data[0] or return undef; - - my $size = first { /RFC822\.SIZE/ } @data; - $size =~ /RFC822\.SIZE\s+(\d+)/; - $1; -} - -sub getquotaroot -{ my ($self, $what) = @_; - my $who = $what ? $self->Massage($what) : "INBOX"; - $self->_imap_command("GETQUOTAROOT $who") ? $self->Results : undef; -} - -sub getquota -{ my ($self, $what) = @_; - my $how = $what ? $self->Massage($what) : "user/$self->{User}"; - $self->_imap_command("GETQUOTA $who") ? $self->Results : undef; -} - -sub quota -{ my $self = shift; - my $what = shift || "INBOX"; - $self->_imap_command("GETQUOTA $what") || $self->getquotaroot($what); - (map { /.*STORAGE\s+\d+\s+(\d+).*\n$/ ? $1 : () } $self->Results)[0]; -} - -sub quota_usage -{ my $self = shift; - my $what = shift || "INBOX"; - $self->_imap_command("GETQUOTA $what") || $self->getquotaroot($what); - ( map { /.*STORAGE\s+(\d+)\s+\d+.*\n$/ ? $1 : () } $self->Results)[0]; -} - -sub Quote { - my ($class, $arg) = @_; - return $class->Massage($arg, NonFolderArg); -} - -sub Massage -{ my ($self, $arg, $notFolder) = @_; - $arg or return; - my $escaped_arg = $arg; - $escaped_arg =~ s/"/\\"/g; - $arg = substr($arg, 1, length($arg)-2) if $arg =~ /^".*"$/ - && ! ( $notFolder || $self->STATUS(qq("$escaped_arg"),"(MESSAGES)")); - - if($arg =~ /["\\]/) { $arg = "{".length($arg). "}\x0d\x0a$arg" } - elsif($arg =~ /\s|[{}()]/) { $arg = qq("$arg") unless $arg =~ /^"/ } - - $arg; -} - -sub unseen_count -{ my ($self, $folder) = (shift, shift); - $folder ||= $self->Folder; - $self->status($folder, 'UNSEEN') or return undef; - - my $r = first { s/\*\s+STATUS\s+.*\(UNSEEN\s+(\d+)\s*\)/$1/ } - $self->History; - - $r =~ s/\D//g; - $r; -} - -sub Status { shift->State } -sub IsUnconnected { shift->State == Unconnected } -sub IsConnected { shift->State >= Connected } -sub IsAuthenticated { shift->State >= Authenticated } -sub IsSelected { shift->State == Selected } - -# The following private methods all work on an output line array. -# _data returns the data portion of an output array: -sub _data { ref $_[1] && defined $_[1]->[TYPE] ? $_[1]->[DATA] : undef } - -# _index returns the index portion of an output array: -sub _index { ref $_[1] && defined $_[1]->[TYPE] ? $_[1]->[INDEX] : undef } - -# _type returns the type portion of an output array: -sub _type { ref $_[1] && $_[1]->[TYPE] } - -# _is_literal returns true if this is a literal: -sub _is_literal { ref $_[1] && $_[1]->[TYPE] && $_[1]->[TYPE] eq 'LITERAL' }; - -# _is_output_or_literal returns true if this is an -# output line (or the literal part of one): - -sub _is_output_or_literal { ref $_[1] && defined $_[1]->[TYPE] - && ($_[1]->[TYPE] eq "OUTPUT" || $_[1]->[TYPE] eq "LITERAL") }; - -# _is_output returns true if this is an output line: -sub _is_output { ref $_[1] && $_[1]->[TYPE] && $_[1]->[TYPE] eq "OUTPUT" }; - -# _is_input returns true if this is an input line: -sub _is_input { ref $_[1] && $_[1]->[TYPE] && $_[1]->[TYPE] eq "INPUT" }; - -# _next_index returns next_index for a transaction; may legitimately -# return 0 when successful. -sub _next_index { $r = $_[0]->Results($_[1]); @$r } - -sub Range -{ my ($self, $targ) = @_; - ref $targ && $targ->isa('Mail::IMAPClient::MessageSet') - ? $targ->cat(@_) - : Mail::IMAPClient::MessageSet->new($targ, @_); -} - -1; diff --git a/Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pod b/Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pod deleted file mode 100644 index cd3011f..0000000 --- a/Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pod +++ /dev/null @@ -1,3746 +0,0 @@ -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 - -=head1 DESCRIPTION - -This module provides methods implementing the IMAP protocol. It allows -perl scripts to interact with IMAP message stores. - -The module is used by constructing or instantiating a new IMAPClient -object via the L constructor method. Once the object has been -instantiated, the L method is either implicitly or explicitly -called. At that point methods are available that implement the IMAP -client commands as specified in I. When processing is -complete, the I object method should be called. - -This documentation is not meant to be a replacement for RFC2060, and -the wily programmer will have a copy of that document handy when coding -IMAP clients. - -Note that this documentation uses the term I in place of -RFC2060's use of I. This documentation reserves the use of the -term I to refer to the set of folders owned by a specific IMAP -id. - -RFC2060 defines four possible states for an IMAP connection: not -authenticated, authenticated, selected, and logged out. These -correspond to the B constants C, -C, C, and C, respectively. These -constants are implemented as class methods, and can be used in -conjunction with the L method to determine the status of an -B object and its underlying IMAP session. Note that an -B object can be in the C state both before a -server connection is made and after it has ended. This differs slightly -from RFC2060, which does not define a pre-connection status. For a -discussion of the methods available for examining the B -object's status, see the section labeled L<"Status Methods">, below. - -=head2 Advanced Authentication Mechanisms - -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. - -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 -many questions, I will provide a quick overview here. All of the methods -and parameters discussed here are described in more detail elsewhere in -this document; this section is meant to help you get started. - -First of all, if you just want to do plain text authentication and -your server is okay with that idea then you don't even need to read -this section. - -Second of all, the intent of this section is to help you implement the -authentication mechanism of your choice, but you will have to understand -how that mechanism works. There are I of authentication mechanisms -and most of them are not available to me to test with for one reason or -another. Even if this section does not answer all of your authentication -questions it I contain all the answers that I have, which I admit -are scant. - -Third of all, if you manage to get any advanced authentication mechanisms -to work then please consider donating them to this module. I don't quite -have a framework visualized for how different authentication mechanisms -could "plug in" to this module but I would like to eventually see this -module distributed with a number of helper modules to implement various -authentication schemes. - -The B's support for add-on authentication mechanisms is -pretty straight forward and is built upon several assumptions. Basically -you create a callback to be used to provide the response to the server's -challenge. The I parameter contains a reference to the -callback, which can be an anonymous subroutine or a named subroutine. -Then, you identify your authentication mechanism, either via the -I parameter or as an argument to L. - -You may also need to provide a subroutine to encrypt (or whatever) data -before it is sent to the server. The I parameter must -contain a reference to this subroutine. And, you will need to decrypt -data from the server; a reference to the subroutine that does this must -be stored in the I parameter. - -This framework is based on the assumptions that a) the mechanism you are -using requires a challenge-response exchange, and b) the mechanism does -not fundamentally alter the exchange between client and server but merely -wraps the exchange in a layer of encryption. It particularly assumes -that the line-oriented nature of the IMAP conversation is preserved; -authentication mechanisms that break up messages into blocks of a -predetermined size may still be possible but will certainly be more -difficult to implement. - -Alternatively, if you have access to B, a utility included in -the Cyrus IMAP distribution, you can use that utility to broker your -communications with the IMAP server. This is quite easy to implement. An -example, L, can be found in the C -subdirectory of the source distribution. - -The following list summarizes the methods and parameters that you may -find useful in implementing advanced autentication: - -=over 4 - -=item authenticate method - -This method implements the AUTHENTICATE IMAP client command as documented -in RFC2060. If you have set the I parameter then the -L method will call L instead of doing a clear text -login, which is its normal behavior. If you don't want B to call -B on your behalf then you can call it yourself. Instead -of setting an I you can just pass the authmechanism as -the first argument to AUTHENTICATE. - -=item Socket Parameter - -The I parameter holds a reference to the socket -connection. Normally this is set for you by the L 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 method completely. - -=item State, Server, Proxy, Password, and User Parameters - -If you need to make your own connection to the server and perform your -authentication manually, then you can set these parameters to keep your -B object in sync with its actual status. Of these, -only the I parameter is always necessary. The others need to be -set only if you think your program will need them later. - -I is required for PLAIN (SASL) authentication. - -=item Authmechanism - -Set this to the value that AUTHENTICATE should send to the server as the -authentication mechanism. If you are brokering your own authentication -then this parameter may be less useful. It is also not needed by the -L method. It exists solely so that you can set it when -you call L to instantiate your object. The B method will -call L, who will call L. If B sees that you've -set an I then it will call B, using your -I and I parameters as arguments. - -=item Authcallback - -The I parameter, if set, should contain a pointer -to a subroutine. The L method will use this as the callback -argument to the B method if the I and -I parameters are both set. If you set I -but not I 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 -results in an error. - -Most advanced authentication mechanisms require a challenge-response -exchange. After the L method sends " AUTHENTICATE -\r\n" to the IMAP server, the server replies with -a challenge. The B method then invokes the code whose -reference is stored in the I parameter as follows: - - $Authcallback->($challenge,$imap) - -where C<$Authcallback> is the code reference stored in the I -parameter, C<$challenge> is the challenge received from the IMAP server, -and C<$imap> is a pointer to the B object. The return -value from the I routine should be the response to the -challenge, and that return value will be sent by the L -method to the server. - -=item Readmethod - -The I parameter points to a routine that will read data from -the socket connection. This read method will replace the B that -would otherwise be performed by B. The replacement -method is called with five arguments. The first is a pointer to the -B object; the rest are the four arguments required by -the B function. Note the third argument (which corresponds to -the second argument to B) is a buffer to read into; this will -be a pointer to a scalar. So for example if your I were -just going to replace B without any intervening processing -(which would be silly but this is just an example after all) then you -would set your I like this: - - $imap->Readmethod( - sub { - my($self) = shift; - my($handle,$buffer,$count,$offset) = @_; - return sysread( $handle, $$buffer, $count, $offset); - } - ); - -Note particularly the double dollar signs in C<$$buffer> in the B -call; this is not a typo! - -=item Prewritemethod - -The I, if defined, should contain a pointer to a -subroutine. It is called immediately prior to writing to the socket -connection. It is called by B with two arguments: -a reference to the B object and the ASCII text -string to be written. It should return another string that will be -the actual string sent to the IMAP server. The idea here is that your -I will do whatever encryption is necessary and then -return the result to the caller so it in turn can be sent to the server. - -=item Ignoresizeerrors - -Certain (caching) servers, like Exchange 2007, often report the wrong -message size. Instead of chopping the message into a size that it -fits the specified size, the reported size will be simply ignored -when this parameter is set to C<1>. - -=item Supportedflags - -Especially when C is used, the receiving peer may need to -be configured explicitly with the list of supported flags; that may -be different from the source IMAP server. - -The names are to be specified as an ARRAY. Black-slashes and casing -will be ignored. - -You may also specify a CODE reference, which will be called for each of -the flags seperately. In this case, the flags are not (yet) normalized. -The returned lists of the CODE calls are shape the resulting flag list. - -=back - -=head2 Errors - -If you attempt an operation that results in an error, then you can -retrieve the text of the error message by using the L -method. However, since the L method is an object method (and -not a class method) you will only be able to use this method if you've -successfully created your object. Errors in the L method can -prevent your object from ever being created. Additionally, if you -supply the I, I, and I parameters to L, it -will attempt to call B and B, either of which could -fail and cause your L method call to return C (in which case -your object will have been created but its reference will have been -discarded before ever having been returned to you). - -If this happens to you, you can always check C<$@>. B -will populate that variable with something useful if either of the -L, L, or L methods fail. In fact, as of version 2, -the C<$@> variable will always contain error info from the last error, -so you can print that instead of calling L if you wish. - -If you run your script with warnings turned on (which I'm sure you'll -do at some point because it's such a good idea) then any error message -that gets placed into the L slot (and/or in C<$@>) will -automatically generate a warning. - -=head2 Transactions - -RFC2060 requires that each line in an IMAP conversation be prefixed -with a tag. A typical conversation consists of the client issuing a -tag-prefixed command string, and the server replying with one of more -lines of output. Those lines of output will include a command -completion status code prefixed by the same tag as the original command -string. - -The B module uses a simple counter to ensure that each -client command is issued with a unique tag value. This tag value is -referred to by the B module as the transaction number. A -history is maintained by the B object documenting each -transaction. The L method returns the number of the last -transaction, and can be used to retrieve lines of text from the -object's history. - -The L parameter is used to control the size of the session -history so that long-running sessions do not eat up unreasonable -amounts of memory. See the discussion of L under L<"Parameters"> -for more information. - -The L transaction returns the history of the entire IMAP -session since the initial connection or for the last I -transactions. This provides a record of the entire conversation, -including client command strings and server responses, and is a -wonderful debugging tool as well as a useful source of raw data for -custom parsing. - -=head1 CLASS METHODS - -There are a couple of methods that can be invoked as class methods. -Generally they can be invoked as an object method as well, as a -convenience to the programmer. (That is, as a convenience to the -programmer who wrote this module, as well as the programmers using it. -It's easier I to enforce a class method's classiness.) Note that -if the L method is called as an object method, the object returned -is identical to what have would been returned if L had been called -as a class method. It doesn't give you a copy of the original object or -anything like that. - -=head2 new - -Example: - - Mail::IMAPClient->new(%args) or die "Could not new: $@\n"; - -The L method creates a new instance of an B object. If -the I parameter is passed as an argument to B, then B -will implicitly call the L method, placing the new object in -the I state. If I and I values are also -provided, then L will in turn call L, and the resulting -object will be returned from B in the I state. - -If the I parameter is not supplied then the B -object is created in the I state. - -If the B method is passed arguments then those arguments will be -treated as a list of key=>value pairs. The key should be one of the -parameters as documented under L<"Parameters">, below. - -Here are some examples: - - use Mail::IMAPClient; - - # returns an unconnected Mail::IMAPClient object: - my $imap = Mail::IMAPClient->new; - # ... - # intervening code using the 1st object, then: - # (returns a new, authenticated Mail::IMAPClient object) - $imap = Mail::IMAPClient->new( - Server => $host, - User => $id, - Password=> $pass, - Clear => 5, # Unnecessary since '5' is the default - # ... # Other key=>value pairs go here - ) or die "Cannot connect to $host as $id: $@"; - -See also L<"Parameters">, below, and L<"connect"> and L<"login"> for -information on how to manually connect and login after B. - -=cut - -=head2 Authenticated - -Example: - - $Authenticated = $imap->Authenticated(); - # or: - $imap->Authenticated($new_value); # But you'll probably never need to do this - -returns a value equal to the numerical value associated with an object -in the B state. This value is normally maintained by the -B module, so you typically will only query it and -won't need to set it. - -B For a more programmer-friendly idiom, see the L, -L, L, and L object methods. You -will usually want to use those methods instead of one of the above. - -=head2 Connected - -Example: - - $Connected = $imap->Connected(); - # or: - $imap->Connected($new_value); # But you'll probably never need to do this - -returns a value equal to the numerical value associated with an object -in the B state. This value is normally maintained by the -B module, so you typically will only query it and -won't need to set it. - -B For a more programmer-friendly idiom, see the L, -L, L, and L object methods. You -will usually want to use those methods instead of one of the above. - -=head2 Quote - -Example: - - $imap->search(HEADER => 'Message-id' => $imap->Quote($msg_id)); - -The B method accepts a value as an argument. It returns its -argument as a correctly quoted string or a literal string. - -Note that you should not use this on folder names, since methods that accept -folder names as an argument will quote the folder name arguments appropriately -for you. (Exceptions to this rule are methods that come with IMAP extensions -that are not explicitly supported by B.) - -If you are getting unexpected results when running methods with values that -have (or might have) embedded spaces, double quotes, braces, or parentheses, -then you may wish to call B to quote these values. You should B -use this method with foldernames or with arguments that are wrapped in quotes -or parens if those quotes or parens are there because the RFC2060 spec requires -them. So, for example, if RFC requires an argument in this format: - - ( argument ) - -and your argument is (or might be) "pennies (from heaven)", then you could just -use: - - $argument = "(" . $imap->Quote($argument) . ")" - -and be done with it. - -Of course, the fact that sometimes these characters are sometimes required -delimiters is precisely the reason you must quote them when they are I -delimiting. For example: - - - $imap->Search('SUBJECT',"(no subject)"); - # WRONG! Sends this to imap server: - # Search SUBJECT (no subject)\r\n - - $imap->Search('SUBJECT',$imap->Quote("(no subject)")); - # Correct! Sends this to imap server: - # Search SUBJECT "(no subject)"\r\n - - -On the other hand: - - $imap->store('+FLAGS',$imap->Quote("(\Deleted)")); - # WRONG! Sends this to imap server: - # [UID] STORE +FLAGS "(\Deleted)"\r\n - - - $imap->store($imap->Quota('+FLAGS'),"(\Deleted)"); - # CORRECT! Sends this to imap server: - # [UID] STORE +FLAGS (\Deleted)\r\n - -In the above, I had to abandon the many methods available to -B programmers (such as L and all-lowercase -L) for the sake of coming up with an example. However, there are -times when unexpected values in certain places will force you to B. -An example is RFC822 Message-id's, which I don't contain quotes or -parens. So you don't worry about it, until suddenly searches for certain -message-id's fail for no apparent reason. (A failed search is not simply a -search that returns no hits; it's a search that flat out didn't happen.) -This normally happens to me at about 5:00 pm on the one day when I was hoping -to leave on time. (By the way, my experience is that any character that can -possibly find its way into a Message-Id eventually will, so when dealing -with these values take proactive, defensive measures from the very start. -In fact, as I was typing the above, a buddy of mine came in to ask advice about -a logfile parsing routine he was writing in which the fields were delimited -by colons. One of the fields was a Message Id, and, you guessed it, some of the -message id's in the log had (unescaped!) colons embedded in them and were -screwing up his C. So there you have it, it's not just me. This is -everyone's problem.) - -=head2 Range - -Example: - - my %parsed = $imap->parse_headers( - $imap->Range($imap->messages), - "Date", - "Subject" - ); - -The B method will condense a list of message sequence numbers or -message UID's into the most compact format supported by RFC2060. It accepts -one or more arguments, each of which can be: - -=over 8 - -=item a) a message number, - -=item b) a comma-separated list of message numbers, - -=item c) a colon-separated range of message numbers (i.e. "$begin:$end") - -=item d) a combination of messages and message ranges, separated by commas -(i.e. 1,3,5:8,10), or - -=item e) a reference to an array whose elements are like I through I. - -=back - -The B method returns a reference to a B -object. The object has all kinds of magic properties, one of which being that -if you treat it as if it were just a string it will act like it's just a -string. This means you can ignore its objectivity and just treat it like a -string whose value is your message set expressed in compact format. - -You may want to use this method if you find that fetch operations on large -message sets seem to take a really long time, or if your server rejects -these requests with the claim that the input line is too long. You may also -want to use this if you need to add or remove messages to your message set -and want an easy way to manage this. - -For more information on the capabilities of the returned object reference, -see L. - -=head2 Rfc2060_date - -Example: - - $Rfc2060_date = $imap->Rfc2060_date($seconds); - # or: - $Rfc2060_date = Mail::IMAPClient->Rfc2060_date($seconds); - -The B method accepts one input argument, a number of -seconds since the epoch date. It returns an RFC2060 compliant date -string for that date (as required in date-related arguments to SEARCH, -such as "since", "before", etc.). - -=head2 Rfc822_date - -Example: - - $Rfc822_date = $imap->Rfc822_date($seconds); - # or: - $Rfc822_date = Mail::IMAPClient->Rfc822_date($seconds); - -The B method accepts one input argument, a number of -seconds since the epoch date. It returns an RFC822 compliant date -string for that date (without the 'Date:' prefix). Useful for putting -dates in message strings before calling L, L, etcetera. - -=head2 Selected - -Example: - - $Selected = $imap->Selected(); - # or: - $imap->Selected($new_value); # But you'll probably never need to do this - -returns a value equal to the numerical value associated with an object -in the B state. This value is normally maintained by the -B module, so you typically will only query it and -won't need to set it. - -B For a more programmer-friendly idiom, see the L, -L, L, and L object methods. You -will usually want to use those methods instead of one of the above. - -=head2 Strip_cr - -Example: - - $Strip_cr = $imap->Strip_cr(); - # or: - $imap->Strip_cr($new_value); - -The B method strips carriage returns from IMAP client command -output. Although RFC2060 specifies that lines in an IMAP conversation -end with , it is often cumbersome to have the carriage returns -in the returned data. This method accepts one or more lines of text as -arguments, and returns those lines with all sequences changed -to . Any input argument with no carriage returns is returned -unchanged. If the first argument (not counting the class name or object -reference) is an array reference, then members of that array are -processed as above and subsequent arguments are ignored. If the method -is called in scalar context then an array reference is returned instead -of an array of results. - -Taken together, these last two lines mean that you can do something -like: - - my @list = $imap->some_imap_method ; - @list = $imap->Strip_cr(@list) ; - # or: - my $list = [ $imap->some_imap_method ] ; # returns an array ref - $list = $imap->Strip_cr($list); - -B does not remove new line characters. - -=cut - -=head2 Unconnected - -Example: - - $Unconnected = $imap->Unconnected(); - # or: - $imap->Unconnected($new_value); - -returns a value equal to the numerical value associated with an object -in the B state. This value is normally maintained by the -B module, so you typically will only query it and -won't need to set it. - -B For a more programmer-friendly idiom, see the L, -L, L, and L object methods. You -will usually want to use those methods instead of one of the above. - -=head1 OBJECT METHODS - -Object methods must be invoked against objects created via the L -method. They cannot be invoked as class methods, which is why they are -called "object methods" and not "class methods". - -There are basically two types of object methods--mailbox methods, which -participate in the IMAP session's conversation (i.e. they issue IMAP -client commands) and object control methods, which do not result in -IMAP commands but which may affect later commands or provide details -of previous ones. This latter group can be further broken down into -two types, Parameter accessor methods, which affect the behavior of -future mailbox methods, and Status methods, which report on the affects -of previous mailbox methods. - -Methods that do not result in new IMAP client commands being issued -(such as the L, L, and L methods) all -begin with an uppercase letter, to distinguish them from methods that -do correspond to IMAP client commands. Class methods and eponymous -parameter methods likewise begin with an uppercase letter because -they also do not correspond to an IMAP client command. - -As a general rule, mailbox control methods return C on failure -and something besides C when they succeed. This rule is modified -in the case of methods that return search results. When called in a list -context, searches that do not find matching results return an empty list. -When called in a scalar context, searches with no hits return 'undef' -instead of an array reference. If you want to know why you received no hits, -you should check C<$@>, which will be empty if the search was successful -but had no matching results but populated with an error message if the -search encountered a problem (such as invalid parameters). - -A number of IMAP commands do not have corresponding B -methods. Instead, they are implemented via a default method and Perl's -L facility. If you are looking for a specific -IMAP client command (or IMAP extension) and do not see it documented in this -pod, then that does not necessarily mean you can not use B to -issue the command. In fact, you can issue almost any IMAP client -command simply by I that there is a corresponding -B method. See the section on -L<"Other IMAP Client Commands and the Default Object Method"> -below for details on the default method. - -=head1 Mailbox Control Methods - -=head2 append - -Example: - - my $uid = $imap->append($folder,$msg_text) - or die "Could not append: $@\n"; - -The B method adds a message to the specified folder. It takes -two arguments, the name of the folder to append the message to, and the -text of the message (including headers). Additional arguments are added -to the message text, separated with . - -The B method returns the UID of the new message (a true value) -if successful, or C if not, if the IMAP server has the UIDPLUS -capability. If it doesn't then you just get true on success and undef -on failure. - -Note that many servers will get really ticked off if you try to append -a message that contains "bare newlines", which is the titillating term -given to newlines that are not preceded by a carrage return. To protect -against this, B will insert a carrage return before any newline -that is "bare". If you don't like this behavior then you can avoid it -by not passing naked newlines to B. - -Note that B does not allow you to specify the internal date or -initial flags of an appended message. If you need this capability then -use L, below. - -=cut - -=head2 append_file - -Example: - - my $new_msg_uid = $imap->append_file( - $folder, - $filename - [ , $input_record_separator ] # optional (not arrayref) - ) or die "Could not append_file: $@\n"; - -The B method adds a message to the specified folder. It -takes two arguments, the name of the folder to append the message to, -and the file name of an RFC822-formatted message. - -An optional third argument is the value to use for -C. The default is to use "" for the first read -(to get the headers) and "\n" for the rest. Any valid value for C<$/> -is acceptable, even the funky stuff, like C<\1024>. (See L -for more information on C<$/>). (The brackets in the example indicate -that this argument is optional; they do not mean that the argument -should be an array reference.) - -The B method returns the UID of the new message (a true -value) if successful, or C if not, if the IMAP server has the -UIDPLUS capability. If it doesn't then you just get true on success and -undef on failure. If you supply a filename that doesn't exist then you -get an automatic C. The L method will remind you of this -if you forget that your file doesn't exist but somehow manage to -remember to check L. - -In case you're wondering, B is provided mostly as a way to -allow large messages to be appended without having to have the whole -file in memory. It uses the C<-s> operator to obtain the size of the -file and then reads and sends the contents line by line (or not, -depending on whether you supplied that optional third argument). - -=cut - -=head2 append_string - -Example: - - # 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 method adds a message to the specified folder. It -requires two arguments, the name of the folder to append the message -to, and the text of the message (including headers). The message text -must be included in a single string (unlike L, above). - -You can optionally specify a third and fourth argument to -B. The third argument, if supplied, is the list of flags -to set for the appended message. The list must be specified as a -space-separated list of flags, including any backslashes that may be -necessary. The enclosing parentheses that are required by RFC2060 are -optional for B. The fourth argument, if specified, is -the date to set as the internal date. It should be in the format -described for I fields in RFC2060, i.e. "dd-Mon-yyyy -hh:mm:ss +0000". - -If you want to specify a date/time but you don't want any flags then -specify I as the third argument. - -The B method returns the UID of the new message (a true -value) if successful, or C if not, if the IMAP server has the -UIDPLUS capability. If it doesn't then you just get true on success and -undef on failure. - -Note that many servers will get really ticked off if you try to append -a message that contains "bare newlines", which is the titillating term -given to newlines that are not preceded by a carrage return. To protect -against this, B will insert a carrage return before any -newline that is "bare". If you don't like this behavior then you can -avoid it by not passing naked newlines to B. - -=cut - -=head2 authenticate - -Example: - - $imap->authenticate($authentication_mechanism, $coderef) - or die "Could not authenticate: $@\n"; - -The B method accepts two arguments, an authentication -type to be used (ie CRAM-MD5) and a code or subroutine reference to -execute to obtain a response. The B method assumes that -the authentication type specified in the first argument follows a -challenge-response flow. The B method issues the IMAP -Client AUTHENTICATE command and receives a challenge from the server. -That challenge (minus any tag prefix or enclosing '+' characters but -still in the original base64 encoding) is passed as the only argument -to the code or subroutine referenced in the second argument. The return -value from the 2nd argument's code is written to the server as is, -except that a sequence is appended if neccessary. - -If one or both of the arguments are not specified in the call to -B but their corresponding parameters have been set -(I and I, respectively) then the parameter -values are used. Arguments provided to the method call however will -override parameter settings. - -If you do not specify a second argument and you have not set the -I parameter, then the first argument must be -one of the authentication mechanisms for which B has -built in support. Currently there is only built in support for CRAM-MD5, -but I hope to add more in future releases. - -If you are interested in doing NTLM authentication then please see Mark -Bush's L, which can work with B to -provide NTLM authentication. - -See also the L method, which is the simplest form of -authentication defined by RFC2060. - -=cut - -=head2 before - -Example: - - my @msgs = $imap->before($Rfc2060_date) - or warn "No messages found before $Rfc2060_date.\n"; - -The B method works just like the L<"since"> method, below, -except it returns a list of messages whose internal system dates are -before the date supplied as the argument to the B method. - -=cut - -=head2 body_string - -Example: - - my $string = $imap->body_string($msgId) - or die "Could not body_string: $@\n"; - -The B method accepts a message sequence number (or a -message UID, if the L parameter is set to true) as an argument and -returns the message body as a string. The returned value contains the -entire message in one scalar variable, without the message headers. - -=cut - -=head2 bodypart_string - -Example: - - my $string=$imap->bodypart_string( $msgid, $part_number , - $length ,$offset - ) or die "Could not get bodypart string: $@\n"; - - -The B method accepts a message sequence number (or a -message UID, if the L parameter is set to true) and a body part as -arguments and returns the message part as a string. The returned value -contains the entire message part (or, optionally, a portion of the part) -in one scalar variable. - -If an optional third argument is provided, that argument is the number -of bytes to fetch. (The default is the whole message part.) If an -optional fourth argument is provided then that fourth argument is the -offset into the part at which the fetch should begin. The default is -offset zero, or the beginning of the message part. - -If you specify an offset without specifying a length then the offset -will be ignored and the entire part will be returned. - -B will return C if it encounters an error. - -=cut - -=head2 capability - -Example: - - my @features = $imap->capability - or die "Could not determine capability: $@\n"; - -The B method returns an array of capabilities as returned -by the CAPABILITY IMAP Client command, or a reference to an array of -capabilities if called in scalar context. If the CAPABILITY IMAP Client -command fails for any reason then the B method will return -C. - -=head2 close - -Example: - - $imap->close or die "Could not close: $@\n"; - -The B method is implemented via the default method and is used -to close the currently selected folder via the CLOSE IMAP client -command. According to RFC2060, the CLOSE command performs an implicit -EXPUNGE, which means that any messages that you've flagged as -I<\Deleted> (say, with the L method) will now be -deleted. If you haven't deleted any messages then B can be -thought of as an "unselect". - -Note again that this closes the currently selected folder, not the -IMAP session. - -See also L, L, and your tattered copy of -RFC2060. - -=head2 connect - -Example: - - $imap->connect or die "Could not connect: $@\n"; - -The B method connects an imap object to the server. It returns -C if it fails to connect for any reason. If values are available -for the I and I parameters at the time that B -is invoked, then B will call the L method after -connecting and return the result of the L method to B's -caller. If either or both of the I and I parameters are -unavailable but the connection to the server succeeds then B -returns a pointer to the B object. - -The I parameter must be set (either during L method -invocation or via the L object method) before invoking -B. If the L parameter is supplied to the L method -then B is implicitly called during object construction. - -The B method sets the state of the object to C if -it successfully connects to the server. It returns C on failure. - -=head2 copy - -Example: - - # Here brackets indicate optional arguments: - my $uidList = $imap->copy($folder, $msg_1 [ , ... , $msg_n ]) - or die "Could not copy: $@\n"; - -Or: - - # Now brackets indicate an array ref! - my $uidList = $imap->copy($folder, [ $msg_1, ... , $msg_n ]) - or die "Could not copy: $@\n"; - - -The B method requires a folder name as the first argument, and a -list of one or more messages sequence numbers (or messages UID's, if -the I parameter is set to a true value). The message sequence -numbers or UID's should refer to messages in the currenly selected -folder. Those messages will be copied into the folder named in the -first argument. - -The B method returns C on failure and a true value if -successful. If the server to which the current Mail::IMAPClient object -is connected supports the UIDPLUS capability then the true value -returned by B will be a comma separated list of UID's, which are -the UID's of the newly copied messages in the target folder. - -=cut - -=head2 create - -Example: - - $imap->create($new_folder) - or die "Could not create $new_folder: $@\n"; - -The B method accepts one argument, the name of a folder (or -what RFC2060 calls a "mailbox") to create. If you specifiy additional -arguments to the B method and your server allows additional -arguments to the CREATE IMAP client command then the extra argument(s) -will be passed to your server. - -If you specifiy additional arguments to the B method and your -server does not allow additional arguments to the CREATE IMAP client -command then the extra argument(s) will still be passed to your server -and the create will fail, so don't do that. - -B returns a true value on success and C on failure, as -you've probably guessed. - -=head2 date - -Example: - - my $date = $imap->date($msg); - - -The B method accepts one argument, a message sequence number (or a -message UID if the I parameter is set to a true value). It returns -the date of message as specified in the message's RFC822 "Date: " header, -without the "Date: " prefix. - -The B method is a short-cut for: - - my $date = $imap->get_header($msg,"Date"); - - -=head2 delete - -Example: - - $imap->delete($folder) or die "Could not delete $folder: $@\n"; - -The B method accepts a single argument, the name of a folder to -delete. It returns a true value on success and C on failure. - -=head2 delete_message - -Example: - - my @msgs = $imap->seen; - scalar(@msgs) and $imap->delete_message(\@msgs) - or die "Could not delete_message: $@\n"; - -The above could also be rewritten like this: - - # scalar context returns array ref - my $msgs = scalar($imap->seen); - - scalar(@$msgs) and $imap->delete_message($msgs) - or die "Could not delete_message: $@\n"; - -Or, as a one-liner: - - - $imap->delete_message( scalar($imap->seen) ) - or warn "Could not delete_message: $@\n"; - # just give warning in case failure is - # due to having no 'seen' msgs in the 1st place! - - -The B method accepts a list of arguments. If the L -parameter is not set to a true value, then each item in the list should -be either: - -=over 4 - -=item > a message sequence number, - -=item > a comma-separated list of message sequence numbers, - -=item > a reference to an array of message sequence numbers, or - -=back - -If the L parameter is set to a true value, then each item in the -list should be either: - -=over 4 - -=item > a message UID, - -=item > a comma-separated list of UID's, or - -=item > a reference to an array of message UID's. - -=back - -The messages identified by the sequence numbers or UID's will be -deleted. If successful, B returns the number -of messages it was told to delete. However, since the delete is -done by issuing the I<+FLAGS.SILENT> option of the STORE IMAP -client command, there is no guarantee that the delete was successful -for every message. In this manner the B method sacrifices -accuracy for speed. Generally, though, if a single message in a list -of messages fails to be deleted it's because it was already deleted, -which is what you wanted anyway so why worry about it? If there is -a more severe error, i.e. the server replies "NO", "BAD", or, -banish the thought, "BYE", then B will return C. - -If you must have guaranteed results then use the IMAP STORE client -command (via the default method) and use the +FLAGS (\Deleted) option, -and then parse your results manually. - -Eg: - - $imap->store($msg_id,'+FLAGS (\Deleted)'); - my @results = $imap->History($imap->Transaction); - ... # code to parse output goes here - - - -(Frankly I see no reason to bother with any of that; if a message doesn't get -deleted it's almost always because it's already not there, which is what you -want anyway. But 'your milage may vary' and all that.) - -The B object must be in C status to use the -B method. - -B All the messages identified in the input argument(s) must be -in the currently selected folder. Failure to comply with this -requirement will almost certainly result in the wrong message(s) being -deleted. This would be a crying shame. - -B In the grand tradition of the IMAP protocol, -deleting a message doesn't actually delete the message. Really. If you -want to make sure the message has been deleted, you need to expunge the -folder (via the L method, which is implemented via the default -method). Or at least L it. This is generally considered a -feature, since after deleting a message, you can change your mind and -undelete it at any time before your L or L. - -I The L method, to delete a folder, the L -method, to expunge a folder, the L method to undelete -a message, and the L method (implemented here via the default -method) to close a folder. Oh, and don't forget about RFC2060. - -=cut - -=head2 deny_seeing - -Example: - - # Reset all read msgs to unread - # (produces error if there are no seen msgs): - $imap->deny_seeing( scalar($imap->seen) ) - or die "Could not deny_seeing: $@\n" ; - -The B method accepts a list of one or more message -sequence numbers, or a single reference to an array of one or more -message sequence numbers, as its argument(s). It then unsets the -"\Seen" flag for those messages (so that you can "deny" that you ever -saw them). Of course, if the L parameter is set to a true value -then those message sequence numbers should be unique message id's. - -Note that specifying C<$imap-Edeny_seeing(@msgs)> is just a -shortcut for specifying C<$imap-Eunset_flag("Seen",@msgs)>. - -=cut - -=head2 disconnect - -Example: - - $imap->disconnect or warn "Could not disconnect: $@\n"; - -Disconnects the B object from the server. Functionally -equivalent to the L method. (In fact it's actually a synonym -for L.) - -=cut - -=head2 done - -Example: - - my $idle = $imap->idle or warn "Couldn't idle: $@\n"; - &goDoOtherThings; - $imap->done($idle) or warn "Error from done: $@\n"; - -The B method tells the IMAP server that the connection is finished -idling. See L for more information. It accepts one argument, -which is the transaction number you received from the previous call -to L. - -If you pass the wrong transaction number to B then your perl program -will probably hang. If you don't pass any transaction number to B -then it will try to guess, and if it guesses wrong it will hang. - -If you call done without previously having called L then your -server will mysteriously respond with I<* BAD Invalid tag>. - -If you try to run any other mailbox method after calling L but -before calling L, then that method will not only fail but also -take you out of the IDLE state. This means that when you eventually -remember to call B you will just get that I<* BAD Invalid tag> -thing again. - -=head2 examine - -Example: - - $imap->examine($folder) or die "Could not examine: $@\n"; - -The B method selects a folder in read-only mode and changes -the object's state to "Selected". The folder selected via the -B method can be examined but no changes can be made unless it -is first selected via the L or L method to select it instead of trying something -funky). Note that RFC2683 contains warnings about the use of the IMAP -I command (and thus the L method and therefore the -B method) against the currenlty selected folder. -You should carefully consider this before using B -on the currently selected folder. You may be better off using -L or one of its variants (especially L), and then -counting the results. On the other hand, I regularly violate this -rule on my server without suffering any dire consequences. Your -milage may vary. - -=cut - -=head2 message_string - -Example: - - my $string = $imap->message_string($msgid) - or die "Could not message_string: $@\n"; - -The B method accepts a message sequence number (or -message UID if L is true) as an argument and returns the message -as a string. The returned value contains the entire message in one -scalar variable, including the message headers. Note that using this -method will set the message's "\Seen" flag as a side effect, unless -I is set to a true value. - -=cut - -=head2 message_to_file - -Example: - - $imap->message_to_file($file,@msgs) - or die "Could not message_to_file: $@\n"; - -The B method accepts a filename or file handle and one -or more message sequence numbers (or message UIDs if L is true) as -arguments and places the message string(s) (including RFC822 headers) -into the file named in the first argument (or prints them to the -filehandle, if a filehandle is passed). The returned value is true on -succes and C on failure. - -If the first argument is a reference, it is assumed to be an open -filehandle and will not be closed when the method completes, If it is a -file, it is opened in append mode, written to, then closed. - -Note that using this method will set the message's "\Seen" flag as a -side effect. But you can use the L method to set it back, -or set the L parameter to a true value to prevent setting the -"\Seen" flag at all. - -This method currently works by making some basic assumptions about the -server's behavior, notably that the message text will be returned as a -literal string but that nothing else will be. If you have a better idea -then I'd like to hear it. - -=cut - -=head2 message_uid - -Example: - - my $msg_uid = $imap->message_uid($msg_seq_no) - or die "Could not get uid for $msg_seq_no: $@\n"; - -The B method accepts a message sequence number (or message -UID if L is true) as an argument and returns the message's UID. -Yes, if L is true then it will use the IMAP UID FETCH UID client -command to obtain and return the very same argument you supplied. This -is an IMAP feature so don't complain to me about it. - -=cut - -=head2 messages - -Example: - - # Get a list of messages in the current folder: - my @msgs = $imap->messages or die "Could not messages: $@\n"; - # Get a reference to an array of messages in the current folder: - my $msgs = $imap->messages or die "Could not messages: $@\n"; - -If called in list context, the B method returns a list of all -the messages in the currenlty selected folder. If called in scalar -context, it returns a reference to an array containing all the messages -in the folder. If you have the L parameter turned off, then this -is the same as specifying C<1 ... $imap-EL>; if you -have UID set to true then this is the same as specifying -C<$imap-EL("ALL")>. - -=cut - -=head2 migrate - -Example: - - $imap->migrate($imap_2, "ALL", $targetFolder ) - or die "Could not migrate: $@\n"; - -The B method copies the indicated messages B the -currently selected folder B another B object's -session. It requires these arguments: - -=over 4 - -=item 1. - -a reference to the target B object (not the calling -object, which is connected to the source account); - -=item 2. - -the message(s) to be copied, specified as either a) the message -sequence number (or message UID if the UID parameter is true) of a -single message, b) a reference to an array of message sequence numbers -(or message UID's if the UID parameter is true) or c) the special -string "ALL", which is a shortcut for the results of -C("ALL")>. - -=item 3. - -the folder name of a folder on the target mailbox to receive the -message(s). If this argument is not supplied or if I is supplied -then a folder with the same name as the currently selected folder on -the calling object will be created if necessary and used. If you -specify something other then I for this argument, even if it's -'$imap1-EFolder' or the name of the currently selected folder, then -that folder will only be used if it exists on the target object's -mailbox; if it does not exist then B will fail. - -=back - -The target B object should not be the same as the -source. The source object is the calling object, i.e. the one whose -B method will be used. It cannot be the same object as the one -specified as the target, even if you are for some reason migrating -between folders on the same account (which would be silly anyway, since -L can do that much more efficiently). If you try to use the same -B object for both the caller and the reciever then -they'll both get all screwed up and it will be your fault because I -just warned you and you didn't listen. - -B will download messages from the source in chunks to minimize -memory usage. The size of the chunks can be controlled by changing the -source B object's the L parameter. The higher -the L value, the faster the migration, but the more memory your -program will require. TANSTAAFL. (See the L parameter and -eponymous accessor method, described above under the L<"Parameters"> -section.) - -The B method uses Black Magic to hardwire the I/O between the -two B objects in order to minimize resource -consumption. If you have older scripts that used L and -L to move large messages between IMAP mailboxes then you -may want to try this method as a possible replacement. - -See also C. - -=head2 move - -Example: - - my $newUid = $imap->move($newFolder, $oldUid) - or die "Could not move: $@\n"; - $imap->expunge; - -The B method moves messages from the currently selected folder to -the folder specified in the first argument to B. If the L -parameter is not true, then the rest of the arguments should be either: - -=over 4 - -=item > - -a message sequence number, - -=item > - -a comma-separated list of message sequence numbers, or - -=item > - -a reference to an array of message sequence numbers. - -=back - -If the L parameter is true, then the arguments should be: - -=over 4 - -=item > - -a message UID, - -=item > - -a comma-separated list of message UID's, or - -=item > - -a reference to an array of message UID's. - -=back - -If the target folder does not exist then it will be created. - -If move is sucessful, then it returns a true value. Furthermore, if the -B object is connected to a server that has the -UIDPLUS capability, then the true value will be the comma-separated -list of UID's for the newly copied messages. The list will be in the -order in which the messages were moved. (Since B uses the copy -method, the messages will be moved in numerical order.) - -If the move is not successful then B returns C. - -Note that a move really just involves copying the message to the new -folder and then setting the I<\Deleted> flag. To actually delete the -original message you will need to run L (or L). - -=cut - -=head2 namespace - -Example: - - my @refs = $imap->namespace - or die "Could not namespace: $@\n"; - -The namespace method runs the NAMESPACE IMAP command (as defined in RFC -2342). When called in a list context, it returns a list of three -references. Each reference looks like this: - - [ [ $prefix_1, $separator_1 ] , - [ $prefix_2, $separator_2 ], - [ $prefix_n , $separator_n] - ] - -The first reference provides a list of prefices and separator -charactors for the available personal namespaces. The second reference -provides a list of prefices and separator charactors for the available -shared namespaces. The third reference provides a list of prefices and -separator charactors for the available public namespaces. - -If any of the three namespaces are unavailable on the current server -then an 'undef' is returned instead of a reference. So for example if -shared folders were not supported on the server but personal and public -namespaces were both available (with one namespace each), the returned -value might resemble this: - - ( [ "", "/" ] , undef, [ "#news", "." ] ) ; - -If the B method is called in scalar context, it returns a -reference to the above-mentioned list of three references, thus -creating a single structure that would pretty-print something like -this: - - $VAR1 = [ - [ - [ $user_prefix_1, $user_separator_1 ] , - [ $user_prefix_2, $user_separator_2], - [ $user_prefix_n , $user_separator_n] - ] , # or undef - [ - [ $shared_prefix_1, $shared_separator_1 ] , - [ $shared_prefix_2, $shared_separator_2], - [ $shared_prefix_n , $shared_separator_n] - ] , # or undef - [ - [ $public_prefix_1, $public_separator_1 ] , - [ $public_prefix_2, $public_separator_2], - [ $public_prefix_n , $public_separator_n] - ] , # or undef - ]; - -Or, to look at our previous example (where shared folders are -unsupported) called in scalar context: - - $VAR1 = [ - [ - [ - "" , - "/", - ], - ], - - undef, - - [ - [ - "#news", - "." - ], - ], - ]; - -=cut - -=head2 on - -Example: - - my @msgs = $imap->on($Rfc2060_date) - or warn "Could not find messages sent on $Rfc2060_date: $@\n"; - -The B method works just like the L method, below, except it -returns a list of messages whose internal system dates are the same as -the date supplied as the argument. - -=head2 parse_headers - -Example: - - my $hashref = $imap->parse_headers($msg||@msgs, "Date", "Subject") - or die "Could not parse_headers: $@\n"; - -The B method accepts as arguments a message sequence -number and a list of header fields. It returns a hash reference in -which the keys are the header field names (without the colon) and the -values are references to arrays of values. A picture would look -something like this: - - $hashref = $imap->parse_headers(1,"Date","Received","Subject","To"); - $hashref = { - "Date" => [ "Thu, 09 Sep 1999 09:49:04 -0400" ] , - "Received" => [ q/ - from mailhub ([111.11.111.111]) by mailhost.bigco.com - (Netscape Messaging Server 3.6) with ESMTP id AAA527D for - ; Fri, 18 Jun 1999 16:29:07 +0000 - /, q/ - from directory-daemon by mailhub.bigco.com (PMDF V5.2-31 #38473) - id <0FDJ0010174HF7@mailhub.bigco.com> for bigshot@bigco.com - (ORCPT rfc822;big.shot@bigco.com); Fri, 18 Jun 1999 16:29:05 +0000 (GMT) - /, q/ - from someplace ([999.9.99.99]) by smtp-relay.bigco.com (PMDF V5.2-31 #38473) - with ESMTP id <0FDJ0000P74H0W@smtp-relay.bigco.com> for big.shot@bigco.com; Fri, - 18 Jun 1999 16:29:05 +0000 (GMT) - /] , - "Subject" => [ qw/ Help! I've fallen and I can't get up!/ ] , - "To" => [ "Big Shot ] , - } ; - -The text in the example for the "Received" array has been formated to -make reading the example easier. The actual values returned are just -strings of words separated by spaces and with newlines and carriage -returns stripped off. The I header is probably the main -reason that the B method creates a hash of lists rather -than a hash of values. - -If the second argument to B is 'ALL' or if it is -unspecified then all available headers are included in the returned -hash of lists. - -If you're not emotionally prepared to deal with a hash of lists then -you can always call the L method yourself with the appropriate -parameters and parse the data out any way you want to. Also, in the -case of headers whose contents are also reflected in the envelope, you -can use the L method as an alternative to -L. - -If the L parameter is true then the first argument will be treated -as a message UID. If the first argument is a reference to an array of -message sequence numbers (or UID's if L is true), then -B will be run against each message in the array. In this -case the return value is a hash, in which the key is the message -sequence number (or UID) and the value is a reference to a hash as -described above. - -An example of using B to print the date and subject of -every message in your smut folder could look like this: - - use Mail::IMAPClient; - my $imap = Mail::IMAPClient->new( Server => $imaphost, - User => $login, - Password=> $pass, - Uid => 1, # optional - ); - - $imap->select("smut"); - - for my $h ( - - # grab the Subject and Date from every message in my (fictional!) smut folder; - # the first argument is a reference to an array listing all messages in the folder - # (which is what gets returned by the $imap->search("ALL") method when called in - # scalar context) and the remaining arguments are the fields to parse out - - # The key is the message number, which in this case we don't care about: - values %{$imap->parse_headers( scalar($imap->search("ALL")) , "Subject", "Date")} - ) { - # $h is the value of each element in the hash ref returned from parse_headers, - # and $h is also a reference to a hash. - # We'll only print the first occurance of each field because we don't expect more - # than one Date: or Subject: line per message. - print map { "$_:\t$h->{$_}[0]\n"} keys %$h ; - } - - -=cut - -=head2 recent - -Example: - - my @recent = $imap->recent or warn "No recent msgs: $@\n"; - -The B method performs an IMAP SEARCH RECENT search against the -selected folder and returns an array of sequence numbers (or UID's, if -the L parameter is true) of messages that are recent. - -=cut - -=head2 recent_count - -Example: - - my $count = 0; - defined($count = $imap->recent_count($folder)) - or die "Could not recent_count: $@\n"; - -The B method accepts as an argument a folder name. It -returns the number of recent messages in the folder (as returned by the -IMAP client command "STATUS folder RECENT"), or C in the case of an -error. The B method was contributed by Rob Deker -(deker@ikimbo.com). - -=cut - -=head2 rename - -Example: - - $imap->rename($oldname,$nedwname) - or die "Could not rename: $@\n"; - -The B method accepts two arguments: the name of an existing -folder, and a new name for the folder. The existing folder will be -renamed to the new name using the RENAME IMAP client command. B -will return a true value if successful, or C if unsuccessful. - -=cut - -=head2 restore_message - -Example: - - $imap->restore_message(@msgs) or die "Could not restore_message: $@\n"; - -The B method is used to undo a previous -L operation (but not if there has been an intervening -L or L). The B object must be in -L status to use the B method. - -The B method accepts a list of arguments. If the -L parameter is not set to a true value, then each item in the list -should be either: - -=over 4 - -=item > - -a message sequence number, - -=item > - -a comma-separated list of message sequence numbers, - -=item > - -a reference to an array of message sequence numbers, or - -=back - -If the L parameter is set to a true value, then each item in the -list should be either: - -=over 4 - -=item > - -a message UID, - -=item > - -a comma-separated list of UID's, or - -=item > - -a reference to an array of message UID's. - -=back - -The messages identified by the sequence numbers or UID's will have -their I<\Deleted> flags cleared, effectively "undeleting" the messages. -B returns the number of messages it was able to -restore. - -Note that B is similar to calling -C("\Deleted",@msgs)>, except that B -returns a (slightly) more meaningful value. Also it's easier to type. - -=cut - -=head2 run - -Example: - - $imap->run(@args) or die "Could not run: $@\n"; - -Like Perl itself, the B module is designed to make -common things easy and uncommon things possible. The B method is -provided to make those uncommon things possible. - -The B method excepts one or two arguments. The first argument is a -string containing an IMAP Client command, including a tag and all -required arguments. The optional second argument is a string to look -for that will indicate success. (The default is C). The B -method returns an array of output lines from the command, which you are -free to parse as you see fit. - -The B method does not do any syntax checking, other than -rudimentary checking for a tag. - -When B processes the command, it increments the transaction count -and saves the command and responses in the History buffer in the same -way other commands do. However, it also creates a special entry in the -History buffer named after the tag supplied in the string passed as the -first argument. If you supply a numeric value as the tag then you may -risk overwriting a previous transaction's entry in the History buffer. - -If you want the control of B but you don't want to worry about the -damn tags then see L<"tag_and_run">, below. - -=cut - -=head2 search - -Example: - - my @msgs = $imap->search(@args) or warn "search: None found\n"; - if ($@) { - warn "Error in search: $@\n"; - } - -The B method implements the SEARCH IMAP client command. Any -argument supplied to B is prefixed with a space and appended to -the SEARCH IMAP client command. This method is another one of those -situations where it will really help to have your copy of RFC2060 -handy, since the SEARCH IMAP client command contains a plethora of -options and possible arguments. I'm not going to repeat them here. - -Remember that if your argument needs quotes around it then you must -make sure that the quotes will be preserved when passing the argument. -I.e. use C instead of C<"$arg">. When in doubt, use the -L method. - -The B method returns an array containing sequence numbers of -messages that passed the SEARCH IMAP client command's search criteria. -If the L parameter is true then the array will contain message -UID's. If B is called in scalar context then a pointer to the -array will be passed, instead of the array itself. If no messages meet -the criteria then B returns an empty list (when in list context) -or C (in scalar context). - -Since a valid, successful search can legitimately return zero matches, -you may wish to distinguish between a search that correctly returns -zero hits and a search that has failed for some other reason (i.e. -invalid search parameters). Therefore, the C<$@> variable will always -be cleared before the I command is issued to the server, and -will thus remain empty unless the server gives a I or I response -to the I command. - -=cut - -=head2 see - -Example: - - $imap->see(@msgs) or die "Could not see: $@\n"; - -The B method accepts a list of one or more messages sequence -numbers, or a single reference to an array of one or more message -sequence numbers, as its argument(s). It then sets the I<\Seen> flag -for those message(s). Of course, if the L parameter is set to a -true value then those message sequence numbers had better be unique -message id's, but then you already knew that, didn't you? - -Note that specifying C<$imap-Esee(@msgs)> is just a shortcut for -specifying C<$imap-EL("Seen",@msgs)>. - -=cut - -=head2 seen - -Example: - - my @seenMsgs = $imap->seen or warn "No seen msgs: $@\n"; - -The B method performs an IMAP SEARCH SEEN search against the -selected folder and returns an array of sequence numbers of messages -that have already been seen (ie their I<\Seen> flag is set). If the -L parameter is true then an array of message UID's will be -returned instead. If called in scalar context than a reference to the -array (rather than the array itself) will be returned. - -=cut - -=head2 select - -Example: - - $imap->select($folder) or die "Could not select: $@\n"; - -The B method (or L or L object methods for that. -Generally, the I parameter should only be queried (by using the -no-argument form of the B method). You will only need to set the -I parameter if you use some mysterious technique of your own for -selecting a folder, which you probably won't do. - -=cut - -=head2 Maxtemperrors - -Example: - - $Maxtemperrors = $imap->Maxtemperrors(); - # or: - $imap->Maxtemperrors($new_value); - -The I parameter specifies the number of times a write -operation is allowed to fail on a "Resource Temporarily Available" -error. These errors can occur from time to time if the server is too -busy to empty out its read buffer (which is logically the "other end" -of the client's write buffer). By default, B will -retry an unlimited number of times, but you can adjust this -behavior by setting I. Note that after each temporary -error, the server will wait for a number of seconds equal to the number -of consecutive temporary errors times .25, so very high values for -I can slow you down in a big way if your "temporary -error" is not all that temporary. - -You can set this parameter to "UNLIMITED" to ignore "Resource -Temporarily Unavailable" errors. This is the default. - -=head2 Password - -Example: - - $Password = $imap->Password(); - # or: - $imap->Password($new_value); - -Specifies the password to use when logging into the IMAP service on the -host specified in the I parameter as the user specified in the -I parameter. Can be supplied with the B method call or -separately by calling the B object method. - -If I, I, and I are all provided to the L -method, then the newly instantiated object will be connected to the -host specified in I (at either the port specified in I or -the default port 143) and then logged on as the user specified in the -I parameter (using the password provided in the I -parameter). See the discussion of the L<"new"> method, below. - -=head2 Peek - -Example: - - $Peek = $imap->Peek(); - # or: - $imap->Peek($true_or_false); - -Setting I to a true value will prevent the L, -L and L methods from automatically -setting the I<\Seen> flag. Setting L<"Peek"> to 0 (zero) will force -L<"body_string">, L<"message_string">, L<"message_to_file">, and -L<"parse_headers"> to always set the I<\Seen> flag. - -The default is to set the seen flag whenever you fetch the body of a -message but not when you just fetch the headers. Passing I to -the eponymous B method will reset the I parameter to its -pristine, default state. - -=cut - -=head2 Port - -Example: - - $Port = $imap->Port(); - # or: - $imap->Port($new_value); - -Specifies the port on which the IMAP server is listening. The default -is 143, which is the standard IMAP port. Can be supplied with the -L method call or separately by calling the L object method. - -=head2 Prewritemethod - -Specifies a method to call if your authentication mechanism requires you to -to do pre-write processing of the data sent to the server. If defined, then the -I parameter should contain a reference to a subroutine that -will do Special Things to data before it is sent to the IMAP server (such as -encryption or signing). - -This method will be called immediately prior to sending an IMAP client command -to the server. Its first argument is a reference to the I object -and the second argument is a string containing the command that will be sent to -the server. Your I should return a string that has been signed or -encrypted or whatever; this returned string is what will actually be sent to the -server. - -Your I will probably need to know more than this to do whatever it does. -It is recommended that you tuck all other pertinent information into a hash, and store a -reference to this hash somewhere where your method can get to it, possibly in the -I object itself. - -Note that this method should not actually send anything over the socket connection to -the server; it merely converts data prior to sending. - -If you need a I then you probably need a L as well. - -=head2 Ranges - -Example: - - $imap->Ranges(1); - # or: - my $search = $imap->search(@search_args); - if ( $imap->Ranges) { # $search is a MessageSet object - print "This is my condensed search result: $search\n"; - print "This is every message in the search result: ", - join(",",@$search),"\n; - } - - -If set to a true value, then the L method will return a -L object if called in a scalar context, -instead of the array reference that B normally returns when called -in a scalar context. If set to zero or if undefined, then B -will continue to return an array reference when called in scalar context. - -This parameter has no affect on the B method when B -is called in a list context. - -=head2 Readmethod IMAP, BUFFER, LENGTH, OFFSET - -This parameter, if supplied, should contain a reference to a subroutine -that will replace sysreads. The subroutine will be passed the following -arguments: first the used Mail::IMAPClient object. As second, -a reference to a scalar variable into which data is readl the BUFFER. The -data place in here should be "finished data", so if you are decrypting -or removing signatures then be sure to do that before you place data -into this buffer. - -As third, the number of bytes requested to be read; the LENGTH of the -request. Finally, the OFFSET into the BUFFER where the data should be -read. If not supplied it should default to zero. - -Note that this method completely replaces reads from the connection -to the server, so if you define one of these then your subroutine will -have to actually do the read. It is for things like this that we have -the L parameter and eponymous accessor method. - -Your I will probably need to know more than this to do -whatever it does. It is recommended that you tuck all other pertinent -information into a hash, and store a reference to this hash somewhere -where your method can get to it, possibly in the I -object itself. - -If you need a I then you probably need a L -as well. - -=head2 Server - -Example: - - $Server = $imap->Server(); - # or: - $imap->Server($hostname); - -Specifies the hostname or IP address of the host running the IMAP -server. If provided as part of the L method call, then the new -IMAP object will automatically be connected at the time of -instantiation. (See the L method, below.) Can be supplied with the -L method call or separately by calling the B object -method. - -=cut - -=head2 Showcredentials - -Normally debugging output will mask the login credentials when the plain -text login mechanism is used. Setting I to a true value -will suppress this, so that you can see the string being passed back -and forth during plain text login. Only set this to true when you are -debugging problems with the IMAP LOGIN command, and then turn it off -right away when you're finished working on that problem. - -Example: - - print "This is very risky!\n" if $imap->Showcredentials(); - # or: - $imap->Showcredentials(0); # mask credentials again - - -=head2 Socket - -Example: - - $Socket = $imap->Socket(); - # or: - $imap->Socket($socket_fh); - -The I 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) or to replace the current -socket with a new handle (for instance an SSL handle, see -IO::Socket::SSL). - -If you supply a socket handle yourself, either by doing something like: - - $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->Socket($ssl); - -then it will be up to you to establish the connection AND to -authenticate, either via the L method, or the fancier -L, 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 parameter yourself to reflect the -current state of the object (i.e. Connected, Authenticated, etc). - -=cut - -=head2 Timeout - -Example: - - $Timeout = $imap->Timeout(); - # or: - $imap->Timeout($new_value); - -Specifies the timeout value in seconds for reads. Specifying a true -value for I will prevent B from blocking in -a read. - -Since timeouts are implemented via the perl L -operator, the I parameter may be set to a fractional number of -seconds. Not supplying a I, or (re)setting it to zero, -disables the timeout feature. - -=cut - -=head2 Uid - -Example: - - $Uid = $imap->Uid(); - # or: - $imap->Uid($true_or_false); - -If L is set to a true value (i.e. 1) then the behavior of the -L, L, L, and L methods (and their -derivatives) is changed so that arguments that would otherwise be -message sequence numbers are treated as message UID's and so that -return values (in the case of the L method and its derivatives) -that would normally be message sequence numbers are instead message -UID's. - -Internally this is implemented as a switch that, if turned on, causes -methods that would otherwise issue an IMAP FETCH, STORE, SEARCH, or -COPY client command to instead issue UID FETCH, UID STORE, UID SEARCH, -or UID COPY, respectively. The main difference between message sequence -numbers and message UID's is that, according to RFC2060, UID's must not -change during a session and should not change between sessions, and -must never be reused. Sequence numbers do not have that same guarantee -and in fact may be reused right away. - -Since foldernames also have a unique identifier (UIDVALIDITY), which is -provided when the folder is L a non-existing folder, then L