From 6576e43299d905ff2c4be9054455666c23d2ee48 Mon Sep 17 00:00:00 2001 From: Nick Bebout Date: Sat, 12 Mar 2011 02:44:35 +0000 Subject: [PATCH] 1.233 --- BUG_219_windows | 17 + CREDITS | 47 +- ChangeLog | 53 +- FAQ | 73 +- INSTALL | 12 +- Mail-IMAPClient-2.99_02/COPYRIGHT | 401 + Mail-IMAPClient-2.99_02/Changes | 1435 ++ Mail-IMAPClient-2.99_02/INSTALL | 82 + Mail-IMAPClient-2.99_02/MANIFEST | 39 + Mail-IMAPClient-2.99_02/META.yml | 25 + Mail-IMAPClient-2.99_02/Makefile | 850 + Mail-IMAPClient-2.99_02/Makefile.PL | 110 + Mail-IMAPClient-2.99_02/README | 147 + Mail-IMAPClient-2.99_02/Todo | 65 + 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.pm | 2856 +++ .../blib/lib/Mail/IMAPClient.pod | 3746 ++++ .../blib/lib/Mail/IMAPClient/BodyStructure.pm | 661 + .../IMAPClient/BodyStructure/Parse.grammar | 288 + .../Mail/IMAPClient/BodyStructure/Parse.pm | 17245 ++++++++++++++++ .../Mail/IMAPClient/BodyStructure/Parse.pod | 17 + .../blib/lib/Mail/IMAPClient/MessageSet.pm | 285 + .../blib/lib/Mail/IMAPClient/Thread.grammar | 18 + .../blib/lib/Mail/IMAPClient/Thread.pm | 1014 + .../blib/lib/Mail/IMAPClient/Thread.pod | 21 + .../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 .../examples/build_dist.pl | 172 + .../examples/build_ldif.pl | 235 + Mail-IMAPClient-2.99_02/examples/cleanTest.pl | 64 + .../examples/copy_folder.pl | 147 + .../examples/cyrus_expire.pl | 111 + .../examples/cyrus_expunge.pl | 85 + .../examples/find_dup_msgs.pl | 217 + .../examples/imap_to_mbox.pl | 154 + .../examples/imtestExample.pl | 226 + .../examples/migrate_mail2.pl | 326 + .../examples/migrate_mbox.pl | 131 + .../examples/populate_mailbox.pl | 319 + .../examples/sharedFolder.pl | 88 + .../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.pm | 1014 + .../lib/Mail/IMAPClient/Thread.pod | 21 + Mail-IMAPClient-2.99_02/pm_to_blib | 0 Mail-IMAPClient-2.99_02/prepare_dist | 37 + Mail-IMAPClient-2.99_02/sample.perldb | 1 + Mail-IMAPClient-2.99_02/t/basic.t | 305 + Mail-IMAPClient-2.99_02/t/bodystructure.t | 29 + Mail-IMAPClient-2.99_02/t/messageset.t | 32 + Mail-IMAPClient-2.99_02/t/pod.t | 9 + Mail-IMAPClient-2.99_02/t/thread.t | 31 + Mail-IMAPClient-2.99_02/test.txt | 5 + Mail-IMAPClient-2.99_02/test_template.txt | 5 + Makefile | 6 +- README | 65 +- TODO | 16 + VERSION | 2 +- freshmeat_submition.inp | 20 +- imapsync | 183 +- imapsync2 | 2071 -- learn/hugemigr | 2 +- memo | 39 +- t/01_connect | 15 + tests.sh | 36 +- 76 files changed, 58645 insertions(+), 2197 deletions(-) create mode 100644 BUG_219_windows create mode 100644 Mail-IMAPClient-2.99_02/COPYRIGHT create mode 100644 Mail-IMAPClient-2.99_02/Changes create mode 100644 Mail-IMAPClient-2.99_02/INSTALL create mode 100644 Mail-IMAPClient-2.99_02/MANIFEST create mode 100644 Mail-IMAPClient-2.99_02/META.yml create mode 100644 Mail-IMAPClient-2.99_02/Makefile create mode 100644 Mail-IMAPClient-2.99_02/Makefile.PL create mode 100644 Mail-IMAPClient-2.99_02/README create mode 100644 Mail-IMAPClient-2.99_02/Todo create mode 100644 Mail-IMAPClient-2.99_02/blib/arch/.exists create mode 100644 Mail-IMAPClient-2.99_02/blib/arch/auto/Mail/IMAPClient/.exists create mode 100644 Mail-IMAPClient-2.99_02/blib/bin/.exists create mode 100644 Mail-IMAPClient-2.99_02/blib/lib/Mail/.exists create mode 100644 Mail-IMAPClient-2.99_02/blib/lib/Mail/IMAPClient.pm create mode 100644 Mail-IMAPClient-2.99_02/blib/lib/Mail/IMAPClient.pod create mode 100755 Mail-IMAPClient-2.99_02/blib/lib/Mail/IMAPClient/BodyStructure.pm create mode 100755 Mail-IMAPClient-2.99_02/blib/lib/Mail/IMAPClient/BodyStructure/Parse.grammar create mode 100644 Mail-IMAPClient-2.99_02/blib/lib/Mail/IMAPClient/BodyStructure/Parse.pm create mode 100755 Mail-IMAPClient-2.99_02/blib/lib/Mail/IMAPClient/BodyStructure/Parse.pod create mode 100644 Mail-IMAPClient-2.99_02/blib/lib/Mail/IMAPClient/MessageSet.pm create mode 100644 Mail-IMAPClient-2.99_02/blib/lib/Mail/IMAPClient/Thread.grammar create mode 100644 Mail-IMAPClient-2.99_02/blib/lib/Mail/IMAPClient/Thread.pm create mode 100755 Mail-IMAPClient-2.99_02/blib/lib/Mail/IMAPClient/Thread.pod create mode 100644 Mail-IMAPClient-2.99_02/blib/lib/auto/Mail/IMAPClient/.exists create mode 100644 Mail-IMAPClient-2.99_02/blib/man1/.exists create mode 100644 Mail-IMAPClient-2.99_02/blib/man3/.exists create mode 100644 Mail-IMAPClient-2.99_02/blib/script/.exists create mode 100755 Mail-IMAPClient-2.99_02/examples/build_dist.pl create mode 100755 Mail-IMAPClient-2.99_02/examples/build_ldif.pl create mode 100755 Mail-IMAPClient-2.99_02/examples/cleanTest.pl create mode 100644 Mail-IMAPClient-2.99_02/examples/copy_folder.pl create mode 100755 Mail-IMAPClient-2.99_02/examples/cyrus_expire.pl create mode 100644 Mail-IMAPClient-2.99_02/examples/cyrus_expunge.pl create mode 100644 Mail-IMAPClient-2.99_02/examples/find_dup_msgs.pl create mode 100755 Mail-IMAPClient-2.99_02/examples/imap_to_mbox.pl create mode 100755 Mail-IMAPClient-2.99_02/examples/imtestExample.pl create mode 100755 Mail-IMAPClient-2.99_02/examples/migrate_mail2.pl create mode 100755 Mail-IMAPClient-2.99_02/examples/migrate_mbox.pl create mode 100755 Mail-IMAPClient-2.99_02/examples/populate_mailbox.pl create mode 100755 Mail-IMAPClient-2.99_02/examples/sharedFolder.pl create mode 100644 Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm create mode 100644 Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pod create mode 100755 Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/BodyStructure.pm create mode 100755 Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/BodyStructure/Parse.grammar create mode 100644 Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/BodyStructure/Parse.pm create mode 100755 Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/BodyStructure/Parse.pod create mode 100644 Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/MessageSet.pm create mode 100644 Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/Thread.grammar create mode 100644 Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/Thread.pm create mode 100755 Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/Thread.pod create mode 100644 Mail-IMAPClient-2.99_02/pm_to_blib create mode 100755 Mail-IMAPClient-2.99_02/prepare_dist create mode 100755 Mail-IMAPClient-2.99_02/sample.perldb create mode 100755 Mail-IMAPClient-2.99_02/t/basic.t create mode 100755 Mail-IMAPClient-2.99_02/t/bodystructure.t create mode 100755 Mail-IMAPClient-2.99_02/t/messageset.t create mode 100755 Mail-IMAPClient-2.99_02/t/pod.t create mode 100755 Mail-IMAPClient-2.99_02/t/thread.t create mode 100644 Mail-IMAPClient-2.99_02/test.txt create mode 100755 Mail-IMAPClient-2.99_02/test_template.txt delete mode 100644 imapsync2 create mode 100644 t/01_connect diff --git a/BUG_219_windows b/BUG_219_windows new file mode 100644 index 0000000..de0e3e5 --- /dev/null +++ b/BUG_219_windows @@ -0,0 +1,17 @@ + + +Users reported a problem with Windows and the imapsync release 1.219 +To fix the problem try this : + +Near line 1170 there are 2 lines : + +#unless($new_id = $to->append_string($t_fold,$string, $flags_f, $d)){ +unless($new_id = $to->append_file2($t_fold, $message_file, "", $flags_f, $d)){ + +The first is commented with a # character, the second is not. +Remove the # on the first line and add a # at the beginning +of the second line. Run imapsync again and tell me if +your problem is solved. + +This bug is fixed in revision 1.231 + diff --git a/CREDITS b/CREDITS index 58832af..a8747bb 100644 --- a/CREDITS +++ b/CREDITS @@ -2,11 +2,48 @@ I thank very much all of these people. -If you want to make a donation to the author, Gilles LAMIRAL, -you can use the imapsync wishlist : -http://www.amazon.com/gp/registry/wishlist/1C9UNDIH3P7R7/ -(Use the lowest postal cost) -or its paypal account gilles.lamiral@laposte.net +If you want to make a donation to the author, Gilles LAMIRAL: +- you can use the imapsync wishlist : + http://www.amazon.com/gp/registry/wishlist/1C9UNDIH3P7R7/ + (Use the lowest postal cost) + +- its paypal account gilles.lamiral@laposte.net + +- If you can read french, please use the following wishlist : + http://amazon.fr/gp/registry/wishlist/37RZF7PPCD7YL + (free postal cost) + +Patrick Ben Koetter +Gave link to imapmigrate : http://sourceforge.net/projects/cyrus-utils/ +Will wrote an article about imapsync, imapmigrate, offline-imap +in German Linuxmagazin http://www.linuxmagazin.de/ January 2008 + +Julien MARY +From Dovecot 0.99.14 to Courier 3.0.8 (success) + +John Owens +FAQ "Does imapsync retain the \Answered and $Forwarded flags?" +From ??? imap server to gmail. Success or failure ? + +Lorenz Wallner +Had success from "GMX IMAP4 StreamProxy" to Courier-IMAP. + +Stan Larson +Contributed by giving the book "Biting and Humorous Tales of a +Software Engineering Manager". + +Daniel I. Meiron +Contributed by giving the book "Asterisk: The future of Telephony" + +Todd Minnella +Contributed by giving the book "Agile and Iterative Development". + +Balázs Bárány +Suggested to update documentation about --authuserX: +avoid use of --authmechX with --authuserX + +Peer Heinlein +Suggested the --justlogin* options. Chris Weinhaupl Had problems from courier to zimbra diff --git a/ChangeLog b/ChangeLog index 2318297..efe23e4 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,17 +1,62 @@ RCS file: RCS/imapsync,v Working file: imapsync -head: 1.223 +head: 1.233 branch: locks: strict - gilles: 1.223 + gilles: 1.233 access list: symbolic names: keyword substitution: kv -total revisions: 223; selected revisions: 223 +total revisions: 233; selected revisions: 233 description: ---------------------------- -revision 1.223 locked by: gilles; +revision 1.233 locked by: gilles; +date: 2007/10/30 03:20:53; author: gilles; state: Exp; lines: +69 -7 +Added connect2() to replace buggy connect() with bad hostname. +---------------------------- +revision 1.232 +date: 2007/10/30 01:41:17; author: gilles; state: Exp; lines: +24 -23 +Added imapmigrate link (cyrus-utils) +Checked each SIMILAR SOFTWARES link and fixed bad ones. +Courier IMAP 3.0.8 success +Fixed Mail::IMAPClient version output. +---------------------------- +revision 1.231 +date: 2007/10/30 00:28:40; author: gilles; state: Exp; lines: +12 -11 +bug fix avoid append_file2 on MSWin32, not the opposite :-) +---------------------------- +revision 1.230 +date: 2007/10/30 00:01:34; author: gilles; state: Exp; lines: +14 -9 +Added bug fix to MSWin32 system and append_file2() problem. +---------------------------- +revision 1.229 +date: 2007/10/29 23:02:46; author: gilles; state: Exp; lines: +15 -11 +Added OS name in --help +---------------------------- +revision 1.228 +date: 2007/10/29 22:49:07; author: gilles; state: Exp; lines: +8 -8 +Added DBMail 0.9 failure. +Commented lib_version check. +---------------------------- +revision 1.227 +date: 2007/10/20 02:30:31; author: gilles; state: Exp; lines: +7 -6 +GMX IMAP4 StreamProxy success. +---------------------------- +revision 1.226 +date: 2007/10/20 01:33:34; author: gilles; state: Exp; lines: +11 -9 +Updated help message about --authuser : avoid --authmech1 SOMETHING +---------------------------- +revision 1.225 +date: 2007/08/21 03:04:08; author: gilles; state: Exp; lines: +10 -6 +Uppercase authmech input. +---------------------------- +revision 1.224 +date: 2007/08/16 23:54:26; author: gilles; state: Exp; lines: +9 -10 +Ubuntu package. +Date with minus %d-%b-%Y +---------------------------- +revision 1.223 date: 2007/06/15 04:08:44; author: gilles; state: Exp; lines: +7 -7 Domino 7.0.1 Exchange 6.5.7638.1 diff --git a/FAQ b/FAQ index 235329d..108cdec 100644 --- a/FAQ +++ b/FAQ @@ -21,6 +21,11 @@ RFC 4549 - Synchronization Operations for Disconnected IMAP4 Clients http://www.faqs.org/rfcs/rfc4549.html +======================================================================= +Q. Where I can find old imapsync releases ? + +R. ftp://www.linux-france.org/pub/prj/imapsync/ + ======================================================================= Q. We have found that the sent time and date have been changed to the time at which the file was synchronised. @@ -29,6 +34,7 @@ R. This is the case with: - Eudora - Zimbra - Outlook 2003 + - Gmail but not with - Mutt - Thunderbird @@ -51,6 +57,25 @@ b) Use the --syncinternaldates option and keep using Eudora :-) c) Use the script learn/adjust_time.pl to change the internal dates from the "Date:" header. +======================================================================= +Q. Does imapsync retain the \Answered and $Forwarded flags? + +R. imapsync retains all flags except \Recent +(RFC 3501 says "This flag can not be altered by the client.") + +Some imap servers have problems with flags not beginning with +the backslash character \ + +====================================================================== +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: + +imapsync ... --regexflag 's/NonJunk//g' + ======================================================================= Q. Flags are not well synchonized. Is it a bug ? @@ -65,6 +90,31 @@ Q. imapsync hangs taking up 99.8% cpu right after start, R. Try option --noauthmd5 +======================================================================= +Q. Some passwords contain * and " characters. Login fails. +R. Use + + imapsync --password1 \"password\" + +Ii works for the star * character, +I don't know if it works for the " character. + +======================================================================= +Q. Out of memory on FreeBSD + +R. http://groups.google.com/group/lucky.freebsd.questions/browse_thread/thread/f4218e4252863328 + +See the user limit with the command + ulimit -a +To change it, try + ulimit -d 1000000000 +Also +http://www.unixadmintalk.com/f41/perl-out-memory-sbrk-9112/ +The default hard datasize limit on FreeBSD is 512MB. To raise it, put this +(or more) in /boot/loader.conf and reboot: + +kern.maxdsiz="1024M" + ======================================================================= Q. imapsync failed with a "word too long" error from the imap server, What can I do ? @@ -195,14 +245,14 @@ Here is an example: --exclude '^user\.' ====================================================================== -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 +Q. Is anyway imapsync to purge destionation folder when the source + folder is deleted? -R. Flags have to begin with a \ character. -The flag "NonJunk" is not a valid flag so use for example: +R. No, that's too much dangerous. +But if the source folder is empty (not deleted) and +options --delete2 --expunge2 are used then +the destination folder will be empty. -imapsync ... --regexflag 's/NonJunk//g' ====================================================================== Q. I have moved from Braunschweig to Graz, so I would like to have my whole @@ -230,12 +280,18 @@ Q. Give examples about --regextrans2 R. Examples: +0) First try with --dry option since imapsync shows the transformation +it will do. Then when happy with the output remove the --dry option + 1) To remove INBOX. in the name of destination folders: --regextrans2 's/^INBOX\.(.+)/$1/' 2) To sync a complete account in a subfolder called FOO: --regextrans2 's/^INBOX(.*)/INBOX.FOO$1/' +3) to substitute all characters dot "." by underscores "_" + --regextrans2 's/\./_/g' + ======================================================================= Q. I would like to move emails from InBox to a sub-folder called , say "2005-InBox" based on the date (Like all emails @@ -471,6 +527,11 @@ R: --sep1 "/" --prefix1 "" Q: From MailEnable 2.2 R: --sep1 "." --prefix1 "" +====================================================================== +Q. From GMX IMAP4 StreamProxy +R. Use: + --prefix1 INBOX and --sep1 . + ====================================================================== 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/INSTALL b/INSTALL index ae11046..578bb36 100644 --- a/INSTALL +++ b/INSTALL @@ -1,4 +1,4 @@ -# $Id: INSTALL,v 1.11 2007/06/11 04:08:51 gilles Exp gilles $ +# $Id: INSTALL,v 1.12 2007/10/30 00:49:03 gilles Exp gilles $ # # INSTALL file for imapsync # imapsync : IMAP sync or copy tool. @@ -74,6 +74,16 @@ make install or copy the file imapsync where you want it to be. +WINDOWS +------- + +- Install Perl if it isn't already installed. + ActivePerl from ActiveState is a good candidate if + you understand nothing at free/open software + and want to run imapsync with success. +- Use PPM to install modules listed in the PREREQUISITES section. + PPM is Perl Package Manager. + TESTING ------- diff --git a/Mail-IMAPClient-2.99_02/COPYRIGHT b/Mail-IMAPClient-2.99_02/COPYRIGHT new file mode 100644 index 0000000..ebc36eb --- /dev/null +++ b/Mail-IMAPClient-2.99_02/COPYRIGHT @@ -0,0 +1,401 @@ +COPYRIGHT + + Copyright 1999, 2000, 2001, 2002 , 2003 The Kernen Group, Inc. + All rights reserved. + +This program is free software; you can redistribute it and/or modify it +under the terms of either: + + +a) the "Artistic License" which comes with this Kit, or + +b) the GNU General Public License as published by the Free Software +Foundation; either version 1, or (at your option) any later version. + + +This program is distributed in the hope that it will be useful, but +WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either the GNU +General Public License or the Artistic License for more details. All your +base are belong to us. + +============= + + The "Artistic License" + + Preamble + +The intent of this document is to state the conditions under which a +Package may be copied, such that the Copyright Holder maintains some +semblance of artistic control over the development of the package, +while giving the users of the package the right to use and distribute +the Package in a more-or-less customary fashion, plus the right to make +reasonable modifications. + +Definitions: + + "Package" refers to the collection of files distributed by the + Copyright Holder, and derivatives of that collection of files + created through textual modification. + + "Standard Version" refers to such a Package if it has not been + modified, or has been modified in accordance with the wishes + of the Copyright Holder as specified below. + + "Copyright Holder" is whoever is named in the copyright or + copyrights for the package. + + "You" is you, if you're thinking about copying or distributing + this Package. + + "Reasonable copying fee" is whatever you can justify on the + basis of media cost, duplication charges, time of people involved, + and so on. (You will not be required to justify it to the + Copyright Holder, but only to the computing community at large + as a market that must bear the fee.) + + "Freely Available" means that no fee is charged for the item + itself, though there may be fees involved in handling the item. + It also means that recipients of the item may redistribute it + under the same conditions they received it. + +1. You may make and give away verbatim copies of the source form of the +Standard Version of this Package without restriction, provided that you +duplicate all of the original copyright notices and associated disclaimers. + +2. You may apply bug fixes, portability fixes and other modifications +derived from the Public Domain or from the Copyright Holder. A Package +modified in such a way shall still be considered the Standard Version. + +3. You may otherwise modify your copy of this Package in any way, provided +that you insert a prominent notice in each changed file stating how and +when you changed that file, and provided that you do at least ONE of the +following: + + a) place your modifications in the Public Domain or otherwise make them + Freely Available, such as by posting said modifications to Usenet or + an equivalent medium, or placing the modifications on a major archive + site such as uunet.uu.net, or by allowing the Copyright Holder to include + your modifications in the Standard Version of the Package. + + b) use the modified Package only within your corporation or organization. + + c) rename any non-standard executables so the names do not conflict + with standard executables, which must also be provided, and provide + a separate manual page for each non-standard executable that clearly + documents how it differs from the Standard Version. + + d) make other distribution arrangements with the Copyright Holder. + +4. You may distribute the programs of this Package in object code or +executable form, provided that you do at least ONE of the following: + + a) distribute a Standard Version of the executables and library files, + together with instructions (in the manual page or equivalent) on where + to get the Standard Version. + + b) accompany the distribution with the machine-readable source of + the Package with your modifications. + + c) give non-standard executables non-standard names, and clearly + document the differences in manual pages (or equivalent), together + with instructions on where to get the Standard Version. + + d) make other distribution arrangements with the Copyright Holder. + +5. You may charge a reasonable copying fee for any distribution of this +Package. You may charge any fee you choose for support of this +Package. You may not charge a fee for this Package itself. However, +you may distribute this Package in aggregate with other (possibly +commercial) programs as part of a larger (possibly commercial) software +distribution provided that you do not advertise this Package as a +product of your own. You may embed this Package's interpreter within +an executable of yours (by linking); this shall be construed as a mere +form of aggregation, provided that the complete Standard Version of the +interpreter is so embedded. + +6. The scripts and library files supplied as input to or produced as +output from the programs of this Package do not automatically fall +under the copyright of this Package, but belong to whoever generated +them, and may be sold commercially, and may be aggregated with this +Package. If such scripts or library files are aggregated with this +Package via the so-called "undump" or "unexec" methods of producing a +binary executable image, then distribution of such an image shall +neither be construed as a distribution of this Package nor shall it +fall under the restrictions of Paragraphs 3 and 4, provided that you do +not represent such an executable image as a Standard Version of this +Package. + +7. C subroutines (or comparably compiled subroutines in other +languages) supplied by you and linked into this Package in order to +emulate subroutines and variables of the language defined by this +Package shall not be considered part of this Package, but are the +equivalent of input as in Paragraph 6, provided these subroutines do +not change the language in any way that would cause it to fail the +regression tests for the language. + +8. Aggregation of this Package with a commercial distribution is always +permitted provided that the use of this Package is embedded; that is, +when no overt attempt is made to make this Package's interfaces visible +to the end user of the commercial distribution. Such use shall not be +construed as a distribution of this Package. + +9. The name of the Copyright Holder may not be used to endorse or promote +products derived from this software without specific prior written permission. + +10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED +WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. + + The End + +============= + + GNU GENERAL PUBLIC LICENSE + Version 1, February 1989 + + Copyright (C) 1989 Free Software Foundation, Inc. + 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The license agreements of most software companies try to keep users +at the mercy of those companies. By contrast, our General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. The +General Public License applies to the Free Software Foundation's +software and to any other program whose authors commit to using it. +You can use it for your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Specifically, the General Public License is designed to make +sure that you have the freedom to give away or sell copies of free +software, that you receive source code or can get it if you want it, +that you can change the software or use pieces of it in new free +programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of a such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must tell them their rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License Agreement applies to any program or other work which +contains a notice placed by the copyright holder saying it may be +distributed under the terms of this General Public License. The +"Program", below, refers to any such program or work, and a "work based +on the Program" means either the Program or any work containing the +Program or a portion of it, either verbatim or with modifications. Each +licensee is addressed as "you". + + 1. You may copy and distribute verbatim copies of the Program's source +code as you receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice and +disclaimer of warranty; keep intact all the notices that refer to this +General Public License and to the absence of any warranty; and give any +other recipients of the Program a copy of this General Public License +along with the Program. You may charge a fee for the physical act of +transferring a copy. + + 2. You may modify your copy or copies of the Program or any portion of +it, and copy and distribute such modifications under the terms of Paragraph +1 above, provided that you also do the following: + + a) cause the modified files to carry prominent notices stating that + you changed the files and the date of any change; and + + b) cause the whole of any work that you distribute or publish, that + in whole or in part contains the Program or any part thereof, either + with or without modifications, to be licensed at no charge to all + third parties under the terms of this General Public License (except + that you may choose to grant warranty protection to some or all + third parties, at your option). + + c) If the modified program normally reads commands interactively when + run, you must cause it, when started running for such interactive use + in the simplest and most usual way, to print or display an + announcement including an appropriate copyright notice and a notice + that there is no warranty (or else, saying that you provide a + warranty) and that users may redistribute the program under these + conditions, and telling the user how to view a copy of this General + Public License. + + d) You may charge a fee for the physical act of transferring a + copy, and you may at your option offer warranty protection in + exchange for a fee. + +Mere aggregation of another independent work with the Program (or its +derivative) on a volume of a storage or distribution medium does not bring +the other work under the scope of these terms. + + 3. You may copy and distribute the Program (or a portion or derivative of +it, under Paragraph 2) in object code or executable form under the terms of +Paragraphs 1 and 2 above provided that you also do one of the following: + + a) accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of + Paragraphs 1 and 2 above; or, + + b) accompany it with a written offer, valid for at least three + years, to give any third party free (except for a nominal charge + for the cost of distribution) a complete machine-readable copy of the + corresponding source code, to be distributed under the terms of + Paragraphs 1 and 2 above; or, + + c) accompany it with the information you received as to where the + corresponding source code may be obtained. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form alone.) + +Source code for a work means the preferred form of the work for making +modifications to it. For an executable file, complete source code means +all the source code for all modules it contains; but, as a special +exception, it need not include source code for modules which are standard +libraries that accompany the operating system on which the executable +file runs, or for standard header files or definitions files that +accompany that operating system. + + 4. You may not copy, modify, sublicense, distribute or transfer the +Program except as expressly provided under this General Public License. +Any attempt otherwise to copy, modify, sublicense, distribute or transfer +the Program is void, and will automatically terminate your rights to use +the Program under this License. However, parties who have received +copies, or rights to use copies, from you under this General Public +License will not have their licenses terminated so long as such parties +remain in full compliance. + + 5. By copying, distributing or modifying the Program (or any work based +on the Program) you indicate your acceptance of this license to do so, +and all its terms and conditions. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the original +licensor to copy, distribute or modify the Program subject to these +terms and conditions. You may not impose any further restrictions on the +recipients' exercise of the rights granted herein. + + 7. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of the license which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +the license, you may choose any version ever published by the Free Software +Foundation. + + 8. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + Appendix: How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to humanity, the best way to achieve this is to make it +free software which everyone can redistribute and change under these +terms. + + To do so, attach the following notices to the program. It is safest to +attach them to the start of each source file to most effectively convey +the exclusion of warranty; and each file should have at least the +"copyright" line and a pointer to where the full notice is found. + + + Copyright (C) 19yy + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 1, or (at your option) + any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software Foundation, + Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) 19xx name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the +appropriate parts of the General Public License. Of course, the +commands you use may be called something other than `show w' and `show +c'; they could even be mouse-clicks or menu items--whatever suits your +program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the + program `Gnomovision' (a program to direct compilers to make passes + at assemblers) written by James Hacker. + + , 1 April 1989 + Ty Coon, President of Vice + +That's all there is to it! diff --git a/Mail-IMAPClient-2.99_02/Changes b/Mail-IMAPClient-2.99_02/Changes new file mode 100644 index 0000000..d449392 --- /dev/null +++ b/Mail-IMAPClient-2.99_02/Changes @@ -0,0 +1,1435 @@ +Revision History for Perl extension Mail::IMAPClient. + +version 2.99_02: + + The whole Mail::IMAPClient was rewritten, hopefully without + breaking the interface. Nearly no line is untouched. + + The following things happened: + - removed many lines which were commented out, over the years + - $self->_debug if $self->Debug checked debug flag twice + - $self->LogError calls where quite inconsequent wrt $@ and carp + - consequent layout, changed sporadic tabs in blanks + - consequent calling convensions + - zillions of minor syntactical improvements + - a few major algorithmic rewrites to simplify the code, still + many oppotunities for improvements. + - expanded "smart" accessor methods, search abbreviations, + and autoloaded methods into separate subs. In total much + shorter, and certainly better understandable! + - fixed many potential bugs. + - labeled some weird things with #???? + Over 900 lines and 25kB smaller in size. + Needs to be tested!!!! Volunteers? + + Fixes: + + - Exchange 2007 only works with new parameter: Ignoresizeerrors + rt.cpan.org#28933 [Dregan], #5297 [Kevin P. Fleming] + + - Passed socket did not get selected. + debian bug #401144, rt.cpan.org# [Alexander Zanger], + #8480 [Karl Gaissmaier], #8481 [Karl Gaissmaier], + #7298 [Herbert Engelmann] + http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=401144 + + - Seperator not correctly extracted from list command. + rt.cpan.org#9236 [Eugene Koontz] + + - migrate() Massage'd foldername twice + rt.cpan.org#20703 [Peter J. Holzer] + + - migrate() could loop because error in regexp. + rt.cpan.org#20703 [Peter J. Holzer] + + - migrate() append_string result not tested. + rt.cpan.org#8577 [guest] + + - Failing fetch() returned undef, not empty list. + rt.cpan.org#18361 [Robert Terzi] + + - Fix "use of uninitialised" warning when expunge is called + rt.cpan.org#15002 [Matt Jackson] + + - Fix count subfolders in is_parent, regexp did not take care + of regex special characters in foldername and seperator. + rt.cpan.org#12883 [Mike Porter] + + - In fetch_hash(), the capturing of UID was too complicated + (and simply wrong) + rt.cpan.org#9341 [Gilles Lamiral] + + - overload in MessageSet treated the 3rd arg (reverse) as + message-set. + + Improvements: + + - PREAUTH support by rt.cpan.org#17693 [Danny Siu] + + - Option "SupportedFlags", useful when the source supports + different flags than the peer in migrate(). + Requested by rt.cpan.org#12961 [Don Christensen] + + - Fast_io did not clear $@ on unimportant errors. + rt.cpan.org#9835 [guest] and #11220 [Brian Helterline] + + - Digest::HMAC_MD5 and MIME::Base64 are now prerequisits. + rt.cpan.org#6391 [David Greaves] + + - PLAIN (SASL) authentication added, option Proxy + rt.cpan.org#5706 [Carl Provencher] + + - removed Bodystructure.grammar and IMAPClient.cleanup from dist. + +version 2.99_01: + + After 4 years of silence, Mark Overmeer took maintenance. David + Kernen could not be reached. Please let him contact the new + maintainer. + + A considerable clean-up took place, fixing bug and adapting the + distribution to current best practices. + + - use "prompt" in Makefile.PL, to please CPAN-testers + + - removed old Parse::RecDescent grammars + + - include Artistic and Copying (GPL) into COPYRIGHT file + + - remove INSTALL_perl5.80 + + - removed all the seperate Makefile.PLs and test directories + + - removed the hard-copy of all involved RFCs: there are better + sources for those. + + - converted tests to use "Test::More" + + - Authmechanism eq 'LOGIN' understood. + + - test for CRAM-MD5 removed, because conflicts with test params + from Makefile.PL + + - test for fast-io removed, it is Perl core functionality + + - require IO::Socket::INET 1.26 to avoid Port number work-around. + + - Parse::RecDescent is required, and the grammars are pre-parsed + in the distribution. This makes the whole installation process + a lot easier. + + - Update Todo, and many other texts. + + - added pod tester in t/pod.t + + - cleaned-up the rt.cpan.org bug-list from spam. The next + release will contain fixes for the real reports. + +Changes in version 2.2.9 +------------------------ +Fixed problem in migrate that caused problems in versions of perl earlier +than 5.6. Thanks go to Steven Roberts for reporting the problem and +identifying its cause. + +Fixed problem in the make process that caused tests for BodyStructure +subclass to fail if the grammer had been compiled under a different +version of Parse::RecDescent. This problem was detected by the dedicated +people at testers@cpan.org. + +Fixed a compatibility problem using Parse::RecDescent version 1.94. +This caused BodyStructure and Thread to fail for 5.8.x users. A number of +people reported this bug to CPAN but it took me a while to realize what +was going on. Really it took me a while to realize my Parse::RecDescent +was out of date. ;-) Now this module is delivered with two versions of +each of the affected grammars and Makefile.PL determines which version +to use. Upgrading to Parse::RecDescent 1.94 will require you to re-run +Makefile.PL and reinstall Mail::IMAPClient. + +Changes in version 2.2.8 +------------------------ +Change the login method so that it always send password as a literal +to get around problem 2544 reported by Phil Tracy which caused +passwords containing asterisks to fail on some systems (but not any of +mine...). Good catch, Phil. + +Added a new example that demonstrates the use of imtest (a utility +that comes with Cyrus IMAP) and Mail::IMAPClient together. The +example uses imtest to do secure authentication and then "passes" the +connection over to Mail::IMAPClient (but imtest is still brokering +the encryption/decryption). This example comes from an idea of +Tara L. Andrews', whose brainstorm it was to use imtest to broker +secure connections. (But I still want to get encryption working with +Mail::IMAPClient some day!) + +Fixed an error in which a "+" was used as a conncatenation error instead +of a ".". Thanks to Andrew Bramble for reporting this, even though he +mistakenly identified it as a "typo". It is not a typo; a plus sign is the +correct concatenation operator, as any decent Java book will tell you ;-) + +Fixed an error in the login method when the password contains a special +character (such as an asterisk.) Thanks to Phil Tracey for reporting +this bug. + +Fixed some bugs in _send_line (the "O" side of the I/O engine) that were +reported by Danny Smith. + +Fixed a bug in the migrate method in the optimization code (which +gets called when socket writes are delayed due to a slow or busy target +host, aka EAGAIN errors). Thanks to Pedro Carvalho for identifying +this bug and its cause. + +Fixed a bug in migrate that caused migration of unread messages to fail. +This was due to the way Mail::IMAPClient's migrate method would try to send +an empty list of flags to the target server in the APPEND. Thanks to +Stephen Fralich at Syracuse University and for reporting this bug. + +Fixed another bug in the migrate method that caused flags to get lost. Thanks +go to Jean-Michel Besnard for reporting this. + +Fixed a bug in migrate that caused +Fixed a bug in get_envelope that caused it to fail under certain conditions. +Thanks go to Bob Brown for reporting this bug. + + +Changes in version 2.2.7 +------------------------ + +Added some new parameters to support alternate authentication mechanisms: + + Prewritemethod + Readmethod + +Mail::IMAPClient has supported cram-md5 authentication "out of the box" +as of 2.2.6 (courtesy of Ville Skyttä). I also have digest-md5 working +in my lab with quality of protection levels "auth" and "integrity", but +not "confidentiality". I'm hoping to get the confidentiality part working +soon but so far have only managed to authenticate, send an encrypted command, +and receive and decrypt the response. This may sound like enough but I can't +seem to send a second command or receive a second response;-( In any event +2.2.8 will support at least qop=auth and qop=auth-int but maybe not +qop=auth-conf. + +Fixed a bug reported by Adrian that caused get_bodystructure to +fail if the server returned a bodystructure with an embedded +literal. Also fixed the same bug in get_envelope, so I guess now +everyone knows that get_envelope was just a tinkered-with copy of +get_bodystructure... + +Fixed two related bugs in Parser.pm that caused +get_bodystructure and get_envelope to fail if the +UID nnnnn part of a fetch response follows all the +other stuff. Thanks to Raphaël Langella for reporting this bug. + +Enhanced several methods to use MessageSets when the +Ranges parameter is true. There are still more methods that +need to be retrofitted to take advantage of the Range method +(and its underlying MessageSet object). In the meantime, if you +need to get the functionality of the shorter message ranges provided +by the Range method from a method that does not honor the Ranges +parameter, then you should a) create a message set by passing the +messages to the Range method and then pass the scalar as a string +to the method you want to use. For example, if you want to move +a whole lot of messages to Trash, do something like this: +> +>my $range = $imap->Range(scalar($imap->search("SentBefore", "01-Jan-2000"))); +>$imap->move("Trash","$range"); +> +This will cause the range object to stringify out to what looks like +a non-reference scalar before the move method gets the argument. If you +omit the quotes around "$range" then this won't work. + +Fixed a bug in the list method that caused LIST "" "" to fail miserably. +Thanks to John W Sopko Jr. for reporting this bug. + +Fixed a bug in the test suite that caused the cram-md5 tests to fail +if you are not running the extended tests. (Introduced in 2.2.6) + +Fixed a bug that affected users on platforms that do not support +fcntl (i.e. NT). Thanks to Raphaël Langella for reporting this bug. + +Changes in version 2.2.6 +------------------------ + +Fixed a bug in the migrate method that caused the internaldate +of migrated messages to sometimes be wrong. Credit goes to Jen Wu +for identifying both bug and fix. + +Added a new method, "get_header", to provide a short-cut for a common +use of parse_headers. Added two other methods, "subject" and "date", +to provide shortcuts to get_header. + +Changed the Mail::IMAPClient::MessageSet module to override array +dereferencing. (See below.) + +Changed fetch and search methods to use the Range method (and thus the +Mail::IMAPClient::MessageSet module) for messages. The fetch method will +use MessageSet objects all the time, but the search method will only +return MessageSet objects if you specify "Ranges => 1" (with Ranges being +a new parameter). The default will be "Ranges => 0" (which preserves +the old behavior) but this default will go away in some future release. +There should be no need to override the fetch method's new behavior, since +it will be transparent to you unless you tend to fetch a lot of messages +at once, in which case your fetches may be faster and perhaps less likely +to fail due to the request exceeding your server's line limit. If you set +the Ranges parameter to true, then you still should not see a difference, +because a) when fetch is called in a list context then you will not get +a MessageSet object, you'll get the same list as always, and b) the +MessageSet objects now override array de-referencing operations, so if you +treat the returned MessageSet object as if it were an array then the object +will humour you and act like a reference to an array of messages sequence +numbers or message uids. + +Also changed the flags method to use the Range method. This should also +be transparent since the methods arguments and return values do not change. + +Added built-in support for CRAM-MD5 authentication. This authentication +method will in this release be used only when requested. In future releases +the default authentication will probably be the strongest authentication +supported "out of the box" that is available on your server. Since CRAM-MD5 +is the only authentication other than plain text that is currently supported +"out of the box", it will be the default authentication mechanism for any +server that supports it. See the pod for the Authmechanism and Authcallback +parameters (which were also added in this release) and the doc for the +authenticate method (which has been around a while). Many thanks to Ville Skyttä +for providing the code that makes up the heart of this new support, as well +as to Gisle Aas for the Digest::HMAC_MD5 and MIME::Base64. + +Made minor tweaks to the documentation. Again. (Will it ever be 100% right?) + +Changes in version 2.2.5 +------------------------ +Added the Range method to convert a bunch of message UID's or sequence numbers +into compact ranges. Also added a supporting class for the returned range +objects with overloaded operators that support stringifying, adding to, and +deleting from a range object's message set (Mail::IMAPClient::MessageSet). +I also wrote documentation for same, so check it out. In future releases, +I will probably enhance the base module to use MessageSet objects when +feasible (i.e. whenever I know that the argument in question should in fact +be a message specification). But I'll let you find all the bugs in the +MessageSet module first ;-) Thanks goes to Stefan Schmidt, who is the first +to report using a server that restricted the size of a client request to +something smaller than what Mail::IMAPClient was generating for him. +(Originally the Range method was just supposed condense a message set into +the shortest possible RFC2060-compliant string, but then I got all happy and +started adding features. You know how it is...) + + +Changes in version 2.2.4 +------------------------- +Fixed a bug in the done method (new in 2.2.3). + +Added tests for idle and done. (That's how I found the bug in the done method, above.) + +Fixed minor bugs in test suite. (The test suite worked but wasn't always using the options +I wanted tested. ) + + +Changes in version 2.2.3 +------------------------- + +NOTE: This version was distributed to beta testers only. + +Fixed the "Changes in version 2.2.2" section so that it correctly specifies +version 2.2.2 (instead of being yet another 2.2.1 section). + +Fixed a bug in the migrate method that affected folders with spaces in their +names. + +Fixed a bug in the Massage method that affected folders with braces ({}) in +their names. + +Added a new class method, "Quote", that will quote your arguments for you. (So you +no longer have to worry so much about quoting your quotes. + +Added optimizations to the migrate method and to the core I/O engine inspired +by Jules Agee. (Actually they were not so much inspired by him as they were +lifted right out of a patch he had out on sourceForge.net. I had to refit them +for this version, and reformat his comments so they could fit in my window. Thanks +Jules, wherever you are.) + +Added the fetch_hash method, which will fetch an entire folder's contents into a +hash indexed by message UID (or message sequence number if that's all you've got). + +Added a new example to the examples subdirectory, and corrected some minor bugs +in existing examples. + +Added the idle and done methods, which together implement the IMAP IDLE extension +(RFC2177), at John Rudd's suggestion. + +Changes in version 2.2.2 +------------------------ +Fixed a bug in Massage method (generally only used by other IMAPClient methods) +that broke folder names with parens. + +Updated bug reporting procedures. Also added a section in the documentation +for REPORTING THINGS THAT ARE NOT BUGS. Bug tracking is now done via +rt.cpan.org, which I stumbled upon quite by accident and with which I am +really pleased. A lot of credit goes to _somebody_ for putting this +out on CPAN. Unfortunately as of this writing I don't whom. + +Fixed a bug in the documentation regarding the logoff method, which is never +implicitly invoked anymore; I gave up on that because the DESTROY method would +sometimes be called after the Socket handle was already destroyed. (This is +especially likely at program exit, when everything still in scope goes out of +scope at the same time.) You should always log off explicitly if you want to +be a well behaviod IMAP client. + +Changes in version 2.2.1 +------------------------ +Updated append_string to wrap the date argument in double quotes if the argument was +provided without quotes. Thanks to Grant Waldram for pointing out that some IMAP +servers require this behavior. + +Added a new method, selectable, which returns a true value if a folder is selectable. + +Documented in this Changes file a change that was actually made for 2.2.0, in which +newlines are chomped off of $@ (but not LastError). + +Added pointers in the documentation to point to Mark Bush's Authen::NTLM module. This +module will allow you to use NTML authentication with Mail::IMAPClient connections. +Also changed the authenticate method so that it will work with Authen::NTML without +the update mentioned in NTLM::Authen's README. + +Added a second example on using the new migrate method, migrate_mail2.pl. This example +demonstrates more advanced techniques then the first, such as using the separator method +to massage folder names and stuff like that. + +Added support for the IMAP THREAD extension. Added Mail::IMAPClient::Thread.pm to support +this. (This pm file is generated during make from Thread/Thread.grammar.) This new +function should be considered experimental. Note also that this extension has nothing +to do with threaded perl or anything like that. This is still on the TODO list. + +Updated the search, sort, and thread methods to set $@ to "" before attempting their +respective operations so that text in $@ won't be left over from some other error and +therefore always indicative of an error in search, sort, or thread, respectively. + +Made many many tweaks to the documentation, including adding more examples (albeit +simple ones) and fixing some errors. + +Changes in version 2.2.0 +------------------------ +Fixed some tests so that they are less likely to give false negatives. For example, test +41 would fail if the test account happened to have an empty inbox. + +Made improvements to Mail::IMAPClient::BodyStructure and renamed Mail::IMAPClient::Parse +to Mail::IMAPClient::BodyStructure::Parse. (This should be transparent to apps since the +...Parse helper module is used by BodyStructure.pm only.) I also resumed my earlier practice +of using ...Parse.pm from within BodyStructure.pm to avoid the overhead of compiling the +grammar every time you use BodyStructure.pm. (Parse.pm is just the output from saving +the compiled Parse::RecDescent grammar.) In a related change, I've moved the grammar into +its own file (Parse.grammar) and taught Makefile.PL how to write a Makefile that converts +the .grammar file into a .pm file. This work includes a number of fixes to how a body structure +gets parsed and the parts list returned by the parts method, among other things. I was able +to successfully parse every bodystructure I could get my hands on, and that's a lot. + +Also added a bunch of new methods to Mail::IMAPClient::BodyStructure and its child classes. +The child classes don't even have files of their own yet; they still live with +their parent class! Notable amoung these changes is support for the FETCH ENVELOPE IMAP +command (which was easy to build in once the BODYSTRUCTURE stuff was working) and some +helper modules to get at the envelope info (as well as envelope information for +MESSAGE/RFC822 attachments from the BODYSTRUCTURE output). Have a look at the +documentation for Mail::IMAPClient::BodyStructure for more information. + +Fixed a bug in the folders method regarding quotes and folders with spaces in the names. The +bug must have been around for a while but rarely manifested itself because of the way +methods that take folder name arguments always try to get the quoting right anyway but +it was still there. Noticing it was the hard part (none of you guys reported it to me!). + +Fixed a bug reported by Jeremy Hinton regarding how the search method handles dates. It was +screwing it all up but it should be much better now. + +Added the get_envelope method which is like the get_bodystructure method except for in ways +in which it's different. + +Added the messages method (a suggestion from Danny Carroll), which is functionally +equivalent to $imap->search("ALL") but easier to type. + +Added new arguments to the bodypart_string method so that you can get just a part of a part +(or a part of a subpart for that matter...) I did this so I could verify BodyStructure's +parts method by fetching the first few bytes of a part (just to prove that the part has a +valid part number). + +Added new tests to test the migrate function and to do more thorough testing of the +BodyStructure stuff. Also added a test to make sure that searches that come up empty handed +return an undef instead of an empty array (reference), regardless of context. Which reminds +me... + +Fixed a bug in which searches that don't find any hits would return a reference to an empty +array instead of undef when called in a scalar context. This bug sounds awfully familiar, +which is why I added the test mentioned above... + + +Changes in version 2.1.5 +------------------------ +Fixed the migrate method so now it not only works, but also works as originally +planned (i.e. without requiring source messages to be read entirely into memory). +If the message is smaller than the value in the Buffer parameter (default is 4096) then +a normal $imap2->append($folder,$imap1->message_string) is done. However, if the message +is over the buffer size then it is retrieved and written a bufferful at a time until the +whole message has been read and sent. (The receiving server still expects the entire +message at once, but it will have to wait because the message is being read from the +source in smaller chunks and then written to the destination a chunk at a time.) +This needs extensive testing before I'd be willing to trust it (or at least extensive +logging so you know when something has gone terribly wrong) and I consider this method +to be in BETA in this release. (Numerous people wrote complaining that migrate didn't +work, and some even included patches to make it work, but the real bug in the last +release wasn't that migrate was broken but that I had inadvertently included the pod +for the method which I knew perfectly well was not ready to be released. My apologies +to anyone who was affected by this.) The migrate method does seem to work okay on +iPlanet (i.e. Netscape) Messenger Server 4.x. Please let me know if you have any +issues on this or any other platform. + +Added a new example, migrate_mbox.pl, which will demonstrate the migrate method. + +Fixed a bug that will cause Mail::IMAPClient's message reading methods to misbehave if +the last line of the email message starts with a number followed by a space and either +"OK", "NO", or "BAD". This bug was originally introduced in 1.04 as a fix for another +bug, but since the fix supports noncompliant behavior I'm disabling this behavior by +default. If your IMAP clients start hanging every time you try to read literal text +(i.e. a message's test, or a folder name with spaces or funky characters) then you +may want to turn this on with the EnableServerResponseInLiteral parameter. Thanks go +to Manpreet Singh for reporting this bug. + +Fixed a bug in imap_to_mbox.pl that has been there since 2.0.0 (when the Uid +parameter started defaulting to "True"). Thanks to Christoph Viethen for reporting +the bug and suggesting the fix. BUT NOTE THIS: I often don't test the example programs, +so you should think of them as examples and not free production programs. Eventually +I would like to add tests to my test suite (either the 'make test' test suite that you +run or my own more extensive test suite) but it's not a super high priority right now. + +Significant improvements to the whole Mail::IMAPClient::BodyStructure module +were contributed by Pedro Melo Cunha. It's really much better now. + +Bullet-proofing added to some private methods. (Private meaning they are undocumented +and not part of the module's API. This is perl not java.) + +Fix applied to unset_flag to support user-defined flags (thanks to E.Priogov +for submitting the bug report and patch). + + +Changes in version 2.1.4 +------------------------ +Added Paul Warren's bugfix to the sort method. + +Added Mike Halderman's bugfix for the get_bodystructure method. + +Fixed a localization problem reported by Ivo Panecek. Because of this fix, +the Errno.pm file is now a prerequisite to this module. This way I can just +test to see if the error is an "EAGAIN" error (as defined in sys/errno.h and thus +Errno.pm) instead of awkwardly checking the string value of $!. + +I also renamed the MaxTempErrors parameter to Maxtemperrors in response the same +bug report. Added a "MaxTempErrors" accessor method that will set and return +Maxtemperrors for backwards compatibility. Also, the number of temporary errors +gets reset after each successful I/O, so that the socket i/o operation fails only if +you if your temporary I/O errors happen more than "Maxtemperrors" times in a row. +The old behavior was to continue incrementing the count of temporary errors until +either the entire message was written or until a total of Maxtemperrors had occurred, +regardless of how many intervening successful syswrites occurred. This was a bug, but +Ivo politely suggested the new behavior as an enhancement. ;-) Also, you can now +specify "UNLIMITED" as the Maxtemperrors, in which case these errors will be ignored. +And the default for Maxtemperrors is now 100, but I'm open to any feedback you may +have in this regard. + +I also fixed the operator precedence problem that was reported by many folks in that +very same part of the code. (As you may have guessed, that code was new in the last +version!) + +One of the people who reported the precedence problem was Jules Agee, who also submitted +a patch that may in the end provide an optimal solution to handling EAGAIN errors. +Unfortunately I have not had time to retrofit his patch into the current version of the +module. But if I can manage to do this soon and it tests well I'll include it in the next +release, in which case the Maxtemperrors parameter will be of interest only to historians. + +I also received a patch from John Ello that adds support for Netscape's proprietary +PROXYAUTH IMAP client command. I haven't included that support in this release because +you can already use the proxyauth method. It's one of those famous "default" methods +that, despite their fame and my documentation, nobody seems to know about. But you +can always say "$imap->proxyauth($uid)", for example, providing that $imap and $uid +are already what they're supposed to be. (I've been doing this myself for years.) + +However, John's patch does provide a cleaner interface (it remembers who you are as +well as who you were, for example) so I may include it later as part of a separate +module that extends Mail::IMAPClient. This would also give me an excuse for providing +the framework for plugging in Administrative methods that are proprietary to other imap +servers, so if you have a technique for acquiring administrative access to your users' +mailboxes (besides proxyauth) please let me know what it is. Perhaps we'll get something cool out of it, like a document on how to write administrative scripts for various +platforms and a suite of supporting methods for each. + +Changes in version 2.1.3 +------------------------ +Added the new method append_string. It works similarly to append but will allow extra +arguments to supply the flags and internal date of the appended message. See the pod +for more details. + +(Thanks to Federico Edelman Anaya for suggesting this fix.) + +Fixed a bug in the AUTOLOAD subroutine that caused "myrights" (and possibly other +non-existant methods) to fail. Thanks go to Larry Rosenbaum for reporting the bug +and identifying the fix. + +Added the new method Escaped_results, which preprocesses results so that data +containing certain special characters are returned quoted with special characters +(like quotes!) escaped. (I needed this for the bodystructure stuff, below.) + +NEW! Added support for parsing bodystructures (as provided in the server response to +FETCH BODYSTRUCTURE). This support requires Parse::RecDescent and is implemented via two +new modules, Mail::IMAPClient::BodyStructure and Mail::IMAPClient::Parse. Note that +the latter module is used by the former; your programs need not and should not use it +directly so don't. Also, these modules are ALPHA and EXPERIMENTAL so no screaming when +they don't work. (Polite bug reports will of course be gratefully accepted.) Many +thanks to Damian Conway, the author of Parse::RecDescent, without which this feature +would not have been possible (or at least not very likely). + +Enhanced support for DOS systems (and DOS's offspring, such as windows) by removing +the "\c\n"s and replacing them with "\x0d\x0a". Thanks go to Marcio Marchini for his +help with this effort. + +Fixed the list of symbols imported along with Fcntl.pm. (Paul Linder asked me to put +this in the last release but I forgot.) + +Changes in version 2.1.2 +------------------------ + +Fixed a bug in the is_parent method which made it inaccurate on some servers. + +Added new method "sort", which implements the SORT extenstion and which was contributed +by Josh Rotenberg. The SORT extension is documented at +http://search.ietf.org/internet-drafts/draft-ietf-imapext-sort-06.txt. A copy of the +draft is also included with the Mail::IMAPClient distribution, which means I also: + +Added draft-ietf-imapext-sort-06.txt to the docs subdirectory of the distribution. + +Fixed a bug in the folders method and the subscribed method (same bug, appeared twice) +which broke these methods under some conditions. Thanks again Josh Rotenberg for supplying the fix. + +Fixed bugs in getacl and listacl. Changed the interface for getacl significantly; +existing scripts using getacl will not behave the same way. But then on the other hand, +getacl was never documented before, so how could you be using it? + +Implemented improvements to reduce memory usage by up to 30%. Thanks go Paul Linder, +who developed the memory usage patch after a considerable amount of analysis. The +improvements include the use of 'use constant', so your perl needs to support that +pragma in order to use Mail::IMAPClient. + +Added a new parameter, MaxTempErrors, which allows the programmer to control the number +of consecutive "Resource Temporarily Unavailable" errors that can occur before a write +to the server will fail. Also changed the behavior of the client when one of these +errors occurs. Previously, Mail::IMAPClient waited .25 seconds (a quarter of one +second) before retrying the read operation. Now it will wait (.25 * the number of +consecutive temporary errors) seconds before retrying the read. + +Documented the "Buffer" parameter, which has been secretly available for some time. I +just forgot to document it. It sets the size of the read buffer when Fast_io is turned +on. (NOTE: As of version 2.1.5 it also controls the size of the buffer used by the +migrate method.) + +Updated the Todo file. It was nice to see that a number of lines in the "Todo" file were now deletable. It was depressing to see that a number of original lines need to stay +in there. + + +Changes in version 2.1.1 +------------------------ +Added the "mark", "unmark", and imap4rev1 methods. + +Updated the documentation to include the new methods and to document "create", "store", +and "delete". + +Updated "message_string" to be smart about whether you're using IMAP4 or IMAP4REV1. + +Updated "message_to_file" to be smart about whether you're using IMAP4 or IMAP4REV1. + +Added several bug fixes to authenticate method. Many thanks to Daniel Wright who +reported these bugs and provided the information necessary to fix them. + + +Changes in version 2.1.0 +------------------------ + +Fixed a serious bug introduced in 2.0.9 when appending large messages. + +Made minor changes to improve the cyrus_expunge.pl example script. + +Made the set_flags routine RFC2060-compliant. Previously it prepended flag names with +backslashes, even if the flags were not reserved flags. This broke support for +user-defined flags, which I didn't realize was supposed to even be there until Scott +Renner clued me in. (Thanks, Scott.) + +Promoted the release level to "1". + +Added a new 'internaldate' method. (Thanks to the folks at jwm3.org for donating the +code!) + +Added a new example, cyrus_expire.pl. + +Changes in version 2.0.8/2.0.9 +------------------------------ +Made minor changes to the tests in t/basic.t so that folders are explicitly closed +before they are deleted. (Don't worry, only folders created by the tests are +deleted. :-) Thanks go to Alan Young for reporting that some servers require this. + +Changed the routine that massages folder names into IMAP-compliant strings so that +single-quotes in a name do not force the folder to go through as "LITERAL" strings +(as defined in RFC2060). This shouldn't cause a problem for anybody (and in fact +should make life easier for some folks) but if you do have any trouble with +single-quotes in folder names PLEASE LET ME KNOW ASAP!! + +Divided the sending of literal strings into two I/O operations (as required by RFC2060). +This should correct problems with sending literals to some servers that will not read +any data sent before they reply with the "+ go ahead" message. (Thanks go to Keith Clay, +who reported seeing this problem with the M-Store IMAP server.) + +Changed the "create" method so that it will autoquote the first argument to create +rather than the last. Normally the first argument is the last, but Cyrus users can +specify an optional 2nd argument, except when using pre-2.0.8 versions of +Mail::IMAPClient ;-) Thank you Chris Stratford for reporting this bug and +identifying its cause. + +Fixed a bug in body_string when the message is empty. (Thanks go to Vladimir Jebelev for +finding this bug and providing the fix.) + +Added a new example to the examples subdirectory. cyrus_expunge.pl is a script you +can use (after making minor tweaks) to periodically expunge your server's mail store. + +Changes in version 2.0.7 +------------------------ +Fixed a bug in message_count. Thanks go to Alistair Adams for reporting this bug. + +Fixed a bug in folders that caused some foldernames to not be reported in the +returned array. + +Changes in version 2.0.6 +------------------------ + +Applied patches from Phil Lobbe to tighten up sysreads and 'writes and to correct a +bug in the I/O engine. + +Changes in version 2.0.5 +------------------------ + +Fixed bug in parse_headers so that RFC822 headers now match the pattern /(\S*):\s*/ +instead of /(\S*): /. Thanks go to Paul Warren for reporting this bug and providing the +fix. + +Added more robust error checking to prevent infinite loops during read attempts and +fixed bugs in parse_headers. Thanks go to Phil Lobbes, who provided several useful +patches and who performed valuable pre-release testing. + +Changes in version 2.0.4 +------------------------ + +Fixed bug in parse_headers when connected to an Exchange server with UID=>1. (Kudos to +Wilber Pol for that fix.) + +Fixed bugs in parse_headers and tightened reliability of I/O engine by implementing +many improvements suggested by Phil Lobbes, who also provided code for same. + +Added bugfix that under certain conditions caused server responses to be "repeated" +when fast_io is turned on. Thanks to Jason Hellman for providing bug report and +diagnostic data to fix this. + +Added a "LastIMAPCommand" method, which returns the last IMAP client command that +was sent to the server. + +Removed the "=begin debugging" paragraph that somehow got included in CPAN's +html pages (even though it shouldn't have). + +Began a process of redesigning the documentation. I would like to be able to present +a more formal syntax for the various methods and hope to have that ready for the next +release. + +Tested successfully against Cyrus v 2.0.7. + +Tested unsuccessfully against mdaemon. This appears to be due to mdaemon's +noncompliance with rfc2060 so future support for mdaemon should not be expected +any time soon. ;-( + + +Changes in version 2.0.3 +------------------------ + +Did major rewrite of message_string method, which should now be both cleaner +and more reliable. + +Fixed bug in move method that caused some folders to be incorrectly quoted. +Thanks go to Felix Finch for reporting this bug. Also, at his suggestion I +added information to move documentation explaining the need to expunge. + +Made many fixes and tweaks to pod text. + +Added a new method, Rfc2060_date, which takes times in the "seconds since 1/1/1970" +format and returns a string in RFC2060's "dd-Mon-yyyy" format (which is the format +you need to use in IMAP SEARCH commands). + +Changes in version 2.0.2 +------------------------ +Fixed bug that caused a compile error on some earlier versions of perl5. + +Noticed that some older versions of perl give spurious "Ambiguous use" warnings +here and there, mostly because I'm not quoting the name of the "History" member +of the underlying Mail::IMAPClient hash. These warnings will go away when you upgrade +perl. (I may fix them later, or maybe not. Depends on if I have time.) + +Added new parameter (and eponymous method) Peek, along with new tests for 'make test' +for same. See the pod for further info. + +Added some error checking to avoid trying to read or write with an +unconnected IMAPClient object. + +Made bug fixes to parse_headers and flags. + +Added missing documentation for the exciting new message_to_file method (oops). +Also cleaned up a few typos in the pod while I happened to be there. (I'm sure +there are still plenty left.) + +Fixed bugs in append and append_file. (Thanks to Mauro Bartolomeoli and to the people +at jwm3.org for reporting these bugs.) + +Made changes to call to syswrite to guarantee delivery of entire message. (Only affects +appends of very large messages.) + +Added the 'close' method to the list of lower-case-is-okay methods (see the section +under version 2.0.0 on "NEW ERROR MESSAGES"). + +Changes in version 2.0.1 +------------------------ +Several bug fixes related to the flags method and to spurious warning messages +when run with warnings turned on. + +A new method, message_to_file, writes message text directly into a file. This +bypasses saving the text in the history buffer and the overhead that entails, which +could be especially important when processing big ass messages. Of course the bad news +is that now you'll have to write all that shtuff out to a filehandle, but maybe you +wanted to do that anyway. Anyhow, between append_file and message_to_file, both +of which take filehandle arguments, there should be a way to "short circuit" the +copying of mail between two imap sessions. I just haven't got it completely figured +out yet how it would work. Got any ideas? Anyhow, this method is currently considered +experimental. + +A couple of new tests have been added to go along with our new little method. + +I've added a whole bunch more IMAP-related rfc's to the docs/ subdirectory. Trust me, +you are going to need them. + +Changes in version 2.0.0 +----------------------- +NEW I/O ENGINE +This version includes a major rewrite of the I/O engine. It's now cleaner and more +reliable. Also, output processing is less likely to match patterns that look like +server output but are really, say, message text contained in a literal or something +like that. Also, various problems with blank lines at the ends of messages either +magically appearing or disappearing should now go away. Basically, it's much better +is what I'm trying to say. + +NEW DEFAULT +The Uid parameter now defaults to true. This should be transparent to existing scripts +(except for those scripts that produce embarrassing results because someone forgot to +specify Uid=>1, in which case they'll magically start behaving somehow). + +NEW METHOD +The namespace method has been added, thus implementing RFC2342. If you have any scripts +that rely on the old, "default method" style of namespace implementation then you should +rename those method calls to be mixed case (thus forcing the AUTOLOADed default method). + +NEW ERROR MESSAGES +Mail::IMAPClient now issues a lot more warning messages when run in warn mode +(i.e. $^W is true). Of particular interest are methods implemented via the "default +method" AUTOLOAD hack. They will generate a warning telling you to use mixed- or +upper-case method names (but only if warnings are turned on, say with the -w switch +or $^W++ or something). The exceptions are certain unimplemented yet quite popular +methods that, if ever explicitly implemented, will behave the same way as they do via +the default method. (Or at least they will remain downwardly compatible. I may add +bells and whistles by not by default.) Those methods are listed in the pod and right +here: store, copy, subscribe, close, create, delete and expunge. + +NEW VERSION NUMBERING SCHEME +Changed the version numbering scheme to match perl's (as of perl v5.6.0). + +NEW INSTALLATION TESTS +Added a few new tests to the test suite. (Still need more, though.) Also changed fast_io +and uidplus test suites so that they just "do" the basic tests but with different +options set (i.e. Fast_io and Uid, respectively). + +OTHER CHANGES +- The expunge method now optionally accepts the name of the folder to be expunged. It's +also been documented, even though it technically doesn't exist. (That won't stop it from +working, though.) Since expunge deletes messages that you thought were already deleted, +it's only appropriate to use a method that you thought existed but really doesn't, don't +you think? And if you're wondering how I managed to change the behavior of a method that +doesn't exist, well, I don't want to talk about it. + +- Speaking of methods that don't exist (also known as methods implemented via "the +default method"), effective with this release there are a number of unimplemented +methods that are guaranteed to always exhibit their current behavior. In other words, +even if I do eventually implement these methods explicitly, they will continue to +accept the same arguments and return the same results that they do now via the default +method. (Why I would even bother to do that is specifically not addressed in this +document.) Currently this means that these methods will not trigger warnings when +called via all-lowercase letters (see "NEW ERROR MESSAGES", above). In the future I +hope that it will also mean that these non-existant but functioning methods will also +be documented in the pod. + +- Fixed a bug in the flags method introduced in 1.19. (Thanks to the people at jwm3.org +for reporting this!) + + +Changes in version 1.19 +----------------------- +Fixed a bug in which the Folder parameter returned quoted folder names, which sometimes +caused other methods to requote the folders an extra time. (The IMAP protocol is real +picky about that.) Thanks go to Felix Finch for both reporting the bug and identifying +the fix. + +Siggy Thorarinsson contributed the new "unseen_count" method and suggested a new +"peek mode" parameter. I have not yet gotten around to implementing the new parameter +but have included the unseen_count method, since a) he was kind enough to write it, and +b) it tests well. + +In the meantime, you cannot tell methods like "parse_headers" and "message_string" and +so forth whether or not you want them to mark messages as "\Seen". So, to make life +easier for you in particular I added a bunch of new methods: set_flag, unset_flag, +see, and deny_seeing. The latter two are derivitives of the former two, respectively, +which should make this sentence almost as difficult to parse as an IMAP conversation. + +Fixed bug in which "BAD" "OK" or "NO" lines prefixed by an asterisk (*) instead of the +tag are not handled correctly. This is especially likely when LOGIN to a UW IMAP server +fails. Thanks go to Phil Lobbes for squashing this bug. + +Fixed bug in logout that caused the socket handle to linger. Credit goes to +Jean-Philippe Bouchard for reporting this bug and for identifying the fix. + +Fixed bug in uidvalidity method where folder has special characters in it. + +Made several bug fixes to the example script examples/find_dup_msgs.pl. Thanks to Steve +Mayer for identifying these bugs. + +Changed Fast_io to automatically turn itself off if running on a platform that does +not provide the necessary fcntl macros (I won't mention any names, but it's initials +are "NT"). This will occur silently unless warnings are turned on or unless the Debug +parameter is set to true. Previously scripts running on this platform had to turn off +fast_io by hand, which is lame. (Thank you Kevin Cutts for reporting this problem.) + +Updated logic that X's out login credentials when printing debug output so that funky +characters in "User" or "Password" parameters won't break the regexp. (Kevin Cutts found +this one, too.) + +Tinkered with the Strip_cr method so it can accept multiple arguments OR an array +reference as an argument. See the updated pod for more info. + +Fixed a typo in the documentation in the section describing the fetch method. There +has been an entire paragraph missing from this section for who knows how long. Thanks +to Adam Wells, who reported this documentation error. + +Fixed bug in seen, recent, and unseen methods that caused them to return empty arrays +erroneously under certain conditions. + +Changes in version 1.18 +----------------------- +Timeouts during read operations now work correctly. + +Fixed several bugs in the I/O engine. This should correct various problems with Fast_io +turned on (which is now the default). + +Reworked message_string and body_string methods to avoid bugs when Uid set to true. + +Changes in version 1.17 +----------------------- + +Added support for the Oracle IMAP4r1 server. + +Tinkered with the DESTROY method so that it does a local($@) before doing its evals. +This will perserve the value of $@ when the "new" method fails during a login but the +DESTROY's "logout" succeeds. The module was setting the $@ variable, but on some +versions of perl the DESTROY method would clobber $@ before anything useful could be +done with it! Thanks to Kimmo Hovi for reporting this problem, which was harder to +debug than you might think. + +Changes in version 1.16 +----------------------- + +IMPORTANT: Made Fast_IO the default. You must specify Fast_io => 0 in your new method +call or invoke the Fast_io method (and supply 0 as an arg) to get the old behavior. +(This should be transparent to most users, but as always your mileage may vary.) + +Reduced the number of debug msgs printed in the _read_line internal method and added a +debug msg to report perl and Mail::IMAPClient versions. + +The message_count method will now return the number of messages in the currently select +folder if no folder argument is supplied. + +The message_string method now does an IMAP FETCH RFC822 (instead of a +FETCH RFC822.HEADERS and a FETCH RFC822.TEXT), which should eliminate missing blank +lines at the ends of some messages on some IMAP server platforms. It also returns undef +if for some reason the underlying FETCH fails (i.e. there is no folder selected), +thanks to a suggestion by Pankaj Garg. It has also been slightly re-worked to support +the changes in the I/O engine from version 1.14. + +Re-worked the body_string method to support the I/O engine changes from v1.14. + +Fixed a bug in parse_headers when used with multiple headers and the Uid parameter set +to a true value. + +Documented in this file a fix for a bug in the flags method with the Uid parameter +turned on. (Belated thanks to Michael Lieberman for reporting this bug.) + +Changes in version 1.15 +----------------------- +Fixes the test suite, which in v1.14 had an "exit" stmt that caused early termination +of the tests. (I had put that "exit" in there on purpose, and left it in there by +accident.) + +Changes in version 1.14 +----------------------- +Fixed a bug in the _readline subroutine (part of the I/O engine) that was caused by my +less-than-perfect interpretation of RFC2060. This fix will allow the Mail::IMAPClient +module to function correctly with servers that imbed literal datatypes in the middle +of response lines (rather than just at the end of them). Thanks to Pankaj Garg for +reporting this problem and providing the debugging output necessary to correct it. + +Fixed a bug in parse_headers that was introduced with the fix to the I/O engine +described above. + +Changes in version 1.13 +----------------------- +Changed the parse_headers method so that it uses BODY.PEEK instead of BODY. This +prevents the parse_headers method from implicitly setting the "\Seen" flag for messages +that have not been otherwise read. This change could produce an incompatibility in +scripts that relied on the parse_headers previous behavior. + +Fixed a bug in the flags method with the Uid parameter turned on. (Thanks to Michael +Lieberman for reporting this bug.) + +Changes in version 1.12 +----------------------- +Fixed a bug in the folders method when called first with a second arg and then without +a second arg. + +Tested sucessfully with perl-5.6.0. + +Added a section to the pod documentation on how to report bugs. I've had to ask for +output from scripts with "Debug => 1" so many times that I eventually decided to +include the procedure for documenting bugs in the distribution. (Duh! It only took me +11 releases to come up with that brainstorm.) Often following the procedures to obtain +the documentation is enough; once people see what's going on (by turning on Debug =>1) +they no longer want to report a bug. + +Did I mention it's a good idea to turn on debugging when trying to figure out why a +script isn't working? (It is.) + +In order to make the Debug parameter friendlier, it now prints to STDERR by default. +You can override this by supplying the spanking brand new Debug_fh parameter, which +if supplied had better well point to a filehandle (either by glob or by reference), +and by 'filehandle' I mean something besides STDIN! + +Debugging mode will now also X-out the login credentials used to login. This will make +it easier to share your debugging output. + +Added documentation for the State parameter, which must be set manually by programmers +who are not using Mail::IMAPClient's connect and/or login methods but who are instead +making their own connections and then using the Socket parameter to turn their +connections into IMAP clients. + +Fixed bug in parse_headers with Uid turned on. + +Fixed bug in parse_headers when using the argument "ALL". + +Changes in version 1.11 +----------------------- +Added new example script, copy_folder.pl, to demonstrate one way to copy entire +folders between imap accounts (which may or may not be on the same server). This +example is right next to all the others, in the examples/ subdirectory of the +distribution. + +Changed error handling slightly. $@ now contains pretty much the same stuff as what +gets returned by LastError, even when LastError won't work (i.e. when an implicit +connect or login fails and so no object reference is returned by new). You can thank +John Milton for the friendly nagging that got me to do this. + +Added new test suite for the fast_io engine. This should make it easier to determine +whether or not the fast_io engine will work on your platform. + +Implemented a work-around to allow the Port parameter to default despite a known bug in +IO::Socket::INET version 1.25 (distributed with perl 5.6.0). + +Fixed a bug in the message_string method in which the resulting text string for some +mime messages to be incompatible with append. + +Fixed a bug in the Fast_io i/o engine that could cause hangs during an append operation. + +Changed a number of regular expressions to accept mixed-case "Ok", "No" or "Bad" +responses from the server and to do multi-line matching. + +Fixed a bug in the append method that was causing extra carriage returns to appear in +messages whose lines were already terminated with the CR-LF sequence. Thanks to Heather +Adkins for reporting this bug. + +Enhanced the parse_headers routine so that it is less sensitive to variations of +case in message headers. Now, the case of the returned key matches the case of the +field as specified in the parse_headers method's arguments, regardless of its case +in the message being parsed. (You can thank Heather Atkins for this suggestion as +well.) See below for more changes to parse_headers in this release. + +Improved the append method so that it has better error handling and error recovery. +Thanks to Mark Keisler for pointing out some bugs in the error handling code in +this method. + +Added the append_file method, which is like the append method but it works on files +instead of strings. The file provided to append must contain an RFC822-formatted +message. Use of the append_file method avoids having to stuff huge messages into +variables before appending them. Thanks to jwmIII (http://jwm3.org) for suggesting +this method. + +Changed the flags method and the parse_headers method so that a reference to an array +of message sequence numbers (or message UIDS if the Uid parameter is turned on) can +optionally be passed instead of a single message sequence number (or UID). Use of this +enhancement will change your return values so be sure to read the pod. Thanks to +Adrian Smith (adrian.smith@ucpag.com) for delivering this enhancement. + +Fixed a bug in "message_string" that caused the blank lines between headers and body +to fall out of the string. + +Tinkered with the undocumented _send_line method to permit an optional argument +to suppress the automatic insertion of at the end of strings being sent. +(NOTE: I'm telling you this because I'm a nice guy. This doesn't mean that _send_line +is now a programming interface.) + +Changes in version 1.10 +----------------------- + +Added two new methods, lsub and subscribed. lsub replaces the behavior of the default +method and should be downwardly compatible. The subscribed method works like the +folders method but the results include only subscribed folders. Thanks to Alexei +Kharchenko for providing the code for lsub (which is the foundation upon which +'subscribed' was built). + +Changes in version 1.09 +----------------------- + +Changed login method so that values for the User parameter that do not start and end +with quotes will be quoted when sent to the server. This is to support user id's +with embedded spaces, which are legal on some platforms. + +Changed name of test input file created by perl Makefile.PL and used by 'make test' +from .test to test.txt to support weird, offbeat OS platforms that cannot handle +filenames beginning with a dot. + +Fixed bugs in seen, unseen, and recent methods. (These are almost the same method +anyway; they are dynamically created at compile time from the same code, with +variable substitution filling in the places where "seen", "unseen", or "recent" +belong.) The bug caused these methods to return the transaction number of the +search as if it were the last message sequence number (or message uid) in +the result set. + +Added the 'since' method, which accepts a date in either standard perl format (seconds +since 1/1/1970, or as output by time and as accepted by localtime) or in the date_text +format as defined in RFC2060 (dd-Mon-yyyy, where Mon is the English-language +three-letter abbreviation for the month). It searches for items in the currently +selected folder for messages sent since the day whose date is provided as an argument. + +Added 'sentsince', 'senton', 'sentbefore', 'on', and 'before' methods which are +totally 100% just like the 'since' method, except that they run different searches. +(Did I mention that it's useful to have RFC2060 handy when writing IMAP clients?) + +Added two new methods, run and tag_and_run, to allow IMAP client programmers finer +control over the IMAP conversation. These methods allow the programmer to compose +the entire IMAP command string and pass it as-is to the IMAP server. The difference +between these two methods is that the run method requires that the string include +the tag while the tag_and_run method requires that it does not. + +To a similar end, the pre-existing Socket parameter and eponymous accessor method +has been documented to allow direct access to the IMAP socket handle and to allow +the socket handle to be replaced with some other file handle, presumably one derived +from a more interesting technology (such as SSL). + +Fixed a bug that caused blank lines to be removed from 'literal' output (as defined +in RFC2060) when fast_io was not used. This bug was especially likely to show up in +routines that fetched a message's body text. The fact that this bug did not occur +in the newer fast_io code may indicate that I've learned something, but on the other +hand we shouldn't jump to rash conclusions. + +I've run benchmarks on the fast_io code to determine whether or not it is faster and, +if so, under what circumstances. It appears that the fast_io code is quite faster, +except when reading large 'literal' strings (i.e. message bodies), in which case it +appears to take the same amount of time as the older i/o code but at the cost of +more cpu cycles (which means it may actually be slower on cpu-constrained systems). +The reason for this is that reads of literal strings are by their nature already +optimized, but without the overhead of fcntl calls. So if you expect to be doing +lots of message text (or multipart message body parts) fetching you should not use +fast_io, but in pretty much any other case you should go ahead and use it. In any +event, a number of people have tested fast_io so I no longer consider it +experimental, unless you're running perl on NT or CP/M or something funky like that, +in which case let me know how you make out! + +Changes in version 1.08 +----------------------- + +Maintenance release 1.08a fixes a bug in the folders method when supplying the +optional argument (see "Enhanced folders method..." below) with some IMAP servers. + +Added option to build_ldif.pl (in the examples subdirectory) to allow new options and +to better handle quoted comments in e-mail addresses. Thanks to Jeffrey Fiedl, +whose book _Mastering Regular Expressions_ (O'Reilly) helped me to figure out a +good way to do this. + +Fixed documentation error that failed to mention constraints on when the append +method will return the uid of the appended message. (This feature only works with +servers that have the UIDPLUS capability.) + +Added/improved documentation somewhat. + +The copy method now returns a comma-separated list of uids if successful and if the +IMAP server supports UIDPLUS extentions. The move method now works similarly. + +Added new method uidnext, which accepts the name of a folder as an argument and returns +the next available message UID for that folder. + +The exists and append methods now will handle unquoted foldernames with embedded +spaces or quotes or whatever. Including quotes as part of the argument string is no +longer required but is still supported for backwards compatibility reasons. In other +words, $imap->exists(q("Some Folder")) is now no longer necessary (but will still work). $imap->exists(some folder) is good enough. + +Mail::IMAPClient has been tested successfully on Mirapoint 2.0.2. (Thanks to Jim +Hickstein.) + +I've now installed the UW imapd IMAP4rev1 v12.264 on one of my machines so I'm better +able to certify that platform. All the tests in 'make test' work there (or are at least +gently skipped). + +Fixed bug in getacl in which folder names were quoted twice. (Thanks to Albert Chin for +squashing this bug.) Similar bugs existed in the other ACL methods and were similarly +fixed. + +Fixed a bug in message_uid that basically caused it to not work. Muchos gracias to +Luvox (aka fluvoxamine hydrochloride) for providing me with just the help I needed to +discover and fix this bug. + +Enhanced folders method to allow an argument. If an argument is supplied, then +the folders method will restrict its results to subfolders of the supplied argument +(which should be the name of a parent folder, IMHO). This is implemented by supplying +arguments to the LIST IMAP Client command so we are optimizing network I/O at the +expense of possible server incompatibilities. If you find server incompatibilities +with this then please let me know, and in the meantime you can always +grep(/^parent/,$imap->folders) or something. Or re-implement the folders +method yourself. + + +Changes in version 1.07 +----------------------- +Added a new parameter, Fast_io, which, if set to a true value, will attempt to +implement a faster I/O engine. USE THIS AT YOUR OWN RISK. It is alpha code. I don't +even know yet if it even helps. + +Added support for spaces in folder names for the autoloaded subscribe method. + +Added new methods setacl, getacl, deleteacl, and listrights. These methods are not yet +fully tested and should be considered beta for this release. + +Enhanced support for the myrights method (which is implemented via the default method). + +Fixed bug in append method that caused it to hang if server replied to original APPEND +with a NO (because, say, the mailbox's quota has been exceeded). + +Removed the autodiscovery of the folder hierarchy from the login method. This will +speed up logging in but may delay certain other methods later (but see the next item, +below). + +Updated the exists method to issue a "STATUS" IMAP Client command, rather than depend +on the folder hierarchy being discovered via 'LIST "" "*"'. Apparently this speeds +things up a lot for some configurations, although the difference will be negligable to +many. + +Updated Makefile.PL to support the PREFIX=~/ directive. Thanks to Henry C. Barta +(hbarta@wwa.com) for this fix. + +Added the Timeout parameter and eponymous accessor method, which, if set to a true +value, causes reads to time out after the number of seconds specified in the Timeout +parameter. The value can be in fractions of a second. This has not been fully tested +though, so use of this parameter is strictly "Beta". + +Enhanced support for the UID IMAP client command. Setting the new Uid parameter to a +true value will now cause the object to treat all message numbers as message UID +numbers rather than message sequence numbers. Setting the Uid parameter to a false +value will turn off this behavior again. + +Updated test suite to handle servers that cannot do UIDPLUS and to add tests for +the Uid parameter. + +Incorporated bug fixes for recent_count and message_count in which some servers are +sticking in extra \r's, and updated DESTROY to remove spurious warning messages under +some versions of perl (thanks to Scott Wilson for catching and killing these bugs). + + +Changes in version 1.06 +----------------------- +Changed folders method so that it correctly handles mail folders whose names start and +end with quotes. + +Changed append method so that it returns the uid of the newly appended message if +successful. Since the uid is a "true" value this should not affect the behavior of +existing scripts, although it may enhance the behavior of new scripts ;-) + +Fixed bug in parse_headers that could cause script to die if there were no headers of +the type requested and if there was a space on the blank line returned from FETCH. +(Some blank lines are blanker than others...) + +Added the "flags" method, which returns an array (or array reference if called in scalar +context) containing the flags that have been set for the message whose sequence number +has been provided as the argument to the method. + +Added the "message_string" method, which accepts a message sequence number as an +argument and returns the contents of the message (including RFC822 headers) as a +single string. + +Added the "body_string" method, which accepts a message sequence number as an argument +and returns the contents of the message (not including RFC822 headers) as a single +string. + +Changes in version 1.05 +----------------------- + +Patched the 'make test' basic test to work correctly on systems that do not +support double quotes in folder names. Thanks to Rex Walters for this fix. + +Added a new example script, build_dist.pl, that rumages through a folder +(specified on the command line) and collects the "From:" address, and then +appends a message to that folder with all those addresses in both the To: field +and the text, to facilitate cuting and pasting (or dragging and dropping) +into address books and so forth. (Note that the message doesn't actually get +sent to all those people; it just kind of looks that way.) + +Also added another example, build_ldif.pl, that is similar to build_dist.pl +except that instead of listing addresses in the message text, it creates a +MIME attachment and attaches a text file in LDIF format, which can then be +imported into any address book that supports LDIF as an import file format. +This example requires the MIME::Lite module. MIME::Lite was written by Eryq +(okay, Erik Dorfman is his legal name), and is totally available on CPAN. + +This distribution has now been tested on Mirapoint Message Server Appliances +(versions 1.6.1 and 1.7.1). Many thanks to Rex Walters for certifying this +platform and for providing a test account for future releases. + +Changes in version 1.04 +----------------------- + +Fixed situation in which servers that include the " OK\r\n" line +as part of a literal (i.e. text delivered via {}\r\n bytes\r\n) +caused the module to hang. This situation is pretty rare; I've only run across +one server that does it. I'm sure it's a bug; I'm not sure whose. ;-} +Many thanks to Thomas Stromberg for 1) pointing out this bug and 2) providing +me with facilities to find and fix it! + +Fixed potential bug in I/O engine that could cause module to hang when reading +a literal if the first read did not capture the entire literal. + +Cleaned up some unnecessary runtime warnings when a script is executed with +the -w switch. + +Added new tests to 'make test'. I just can't keep my hands off it! ;-) + +Enhanced the append method and several tests in 'make test' to be more widely +compatible. Successfully tested on UW-IMAP, Cyrus v1.5.19, Netscape Messenger +4.1, and Netscape Messenger v3.6. If you know of others please add them to +the list! + +Fixed a bug in the separator method (new in 1.03) that caused it to fail if +'inbox' was specified in lowercase characters as the method's argument. + +Added a new example, imap_to_mbox.pl, contributed by Thomas Stromberg. This +example converts a user's IMAP folders on an IMAP server into mbox format. + +Changes in version 1.03 +----------------------- +Reworked several methods to support double-quote characters within folder +names. This was kind of hard. This has been successfully tested with create, +delete, select, and folders, to name the ones that come to mind. + +Reworked the undocumented method that reads the socket to accept and handle +more gracefully lines ending in {nnn}\r\n ( where nnn is a number of +characters to read). This seems to be part of the IMAP protocol although I +am at a total loss as to where it's explained, other than a brief description +of a "literal's" bnf syntax, which hardly counts. + +Added separator object method, which returns the separator character in use +by the current server. + +Added is_parent method, which returns 1, 0, or undef depending on whether a +folder has children, has no children, or is not permitted to have children. + +Added tests to 'make test' to test new function. Also changed 'make test' to +support IMAP systems that allow folders to be created only in the user's INBOX +(which is the exact opposite of what my IMAP server allows...oh, well). + +Fixed a bug that caused search to return an array of one undef'ed element +rather than undef if there were no hits. + +Changes in version 1.02 +----------------------- +Fixed bugs in search and folders methods. + +Fixed bug in new method that ignored Clear => 0 when specified as arguments to +new. + +Changes in version 1.01 +----------------------- +Fixed a bug in test.pl that caused tests to fail if the extended tests were not used. + +Added method 'parse_headers' to parse the header fields of a message in the +IMAP store into a perl data structure. + +Changes in version 1.00 +----------------------- +Made cosmetic changes to documentation. + +Fixed a bug introduced into the 'folders' method in .99. + +Changed 'new' method so that it returns undef if an implicit connection or +login is attempted but fails. Previous releases returned a Mail::IMAPClient +object that was not connected or not logged in, depending on what failed. + +Changed installation script so that it reuses the parameter file for test.pl +if it finds one. Installation can be run in the background if the test.txt file +exists. Touching it is good enough to prevent prompts; having a correctly +formatted version (as described in test_template.txt) is even better, as it will +allow you to do a thorough 'make test'. + +Changes in version .99 +---------------------- +Added the Rfc822_date class method to create RFC822-compliant date fields in +messages being appended with the append method. + +Added the recent, seen, and unseen methods to return an array of sequence +numbers from a SEARCH RECENT, SEARCH SEEN, or SEARCH UNSEEN method call. +These methods are shortcuts to $imap->search("RECENT"), etc. + +Added the recent_count method to return the number of RECENT messages in a +folder. Contributed by Rob Deker. + +Added 'use strict' compliance, courtesy of Mihai Ibanescu. + +Fixed a bug in the search method that resulted in a list with one empty member +being returned if a search had no hits. The search method now returns undef +if there are no hits. + +Added 'authenticate' method to provide very crude support for the IMAP +AUTHENTICATE command. The previous release didn't support AUTHENTICATE at all, +unless you used very low-level (and undocumented) methods. With the +'authenticate' method, the programmer still has to figure out how to +respond to the server's challenge. I hope to make it friendlier in the +next release. Or maybe the one after that. This method is at least a start, +albeit a pretty much untested one. + +Added Rfc822_date class method to facilitate creation of "Date:" header +field when creating text for the "append" method, although the method may +come in handy whenever you're creating a Date: header, even if it's not +in conjuction with an IMAP session. + +Added more tests, which will optionally run at 'make test' time, provided all +the necessary data (like username, hostname, password for testing an IMAP +session) are available. + + +Changes in version 0.09 +----------------------- +Thu Aug 26 14:10:03 1999 - original version; created by h2xs 1.19 + +# $Id: Changes,v 20001010.18 2003/06/12 21:35:48 dkernen Exp $ diff --git a/Mail-IMAPClient-2.99_02/INSTALL b/Mail-IMAPClient-2.99_02/INSTALL new file mode 100644 index 0000000..1b74934 --- /dev/null +++ b/Mail-IMAPClient-2.99_02/INSTALL @@ -0,0 +1,82 @@ +Mail::IMAPClient Installation + +The Mail::IMAPClient is written entirely in Perl, so it should install +on any reasonably recent version of Perl. See the README file for a perl +one-liner that you can run to verify that your perl has what it takes +to run Mail::IMAPClient. + +The installation is standard: + + 0) cd to installation directory + 1) perl Makefile.PL (and reply to the prompts) + 2) make (optional) + 3) make test (optional) + 4) make install + +The 'make install' and 'make test' will both do step 2 ('make') if you +haven't done it already. Currently the test script is lame (although +not as lame as in the last release!) but I hope to incorporate more +thorough testing in a future version. You should at least try it and +let me know if your tests fail. + +Version 1.0 changed the installation script so that it reuses the +parameter file for the tests if it finds one. Installation can be run in +the background if the test.txt file exists. Touching it is good enough +to prevent prompts; having a correctly formatted version (as shown in +test_template.txt) is even better, as it will allow you to do a thorough +'make test'. Invalid data in test.txt (either from precreating it or from +responding inaccurately to prompts) will cause 'make test' to report 'not +ok' results but won't break anything important (like the IMAPClient.pm +file, or your car). + +If you have tests that fail it may be more illuminating to run the +tests by hand. IE: perl -I./blib/lib t/basic.t from the installation +dir will pinpoint the failing test. Better yet, supply an argument to +basic/t (any 'true' argument will do; I use '1') to turn on debugging, +which will be placed in your installation directory in 'imap1.debug' +and 'imap2.debug'. E-mail me the results. + +If you don't have a test.txt file in your installation directory then you +will have to answer at least one prompt. If you do have a test.txt file, +and you run 'make clean', then you won't have a test.txt file anymore, +so take precautions. + +If you do have a test.txt file and you don't run 'make clean' then +a text file will be sitting around containing logon credentials, so, +again, take precautions. (It's just a test account anyway, right?) + +If, when replying to the "perl Makefile.PL" prompts, you supply server, +id, and password credentials for an id that has a ridiculously huge number +of folders and subfolders then the 'make test' may run approximately +forever. Next time try an id with less stuff. + +For examples on using Mail::IMAPClient, check out the examples +subdirectory. If you have better examples, then why haven't you e-mailed +them to me? Also, I totally recommend that you have a copy of RFC2060 +handy when using this module, since the documentation for this module is +meant to compliment, not replace, RFC2060. In fact, I am so convinced that +you'll need the RFC that I've included a copy of it in the distribution, +under the "docs/" subdirectory. It's a smashing good read so have at +it. Other IMAP related rfcs are there as well. + +One of the examples in the examples/ subdirectory is called +cleanTest.pl. If you find your 'make test' has had trouble and left some +folders named "IMAPClient_*" in your test account, you can run this +example to clean up the account. But probably only after you've fixed +any problems encountered with 'make test'! + +This module uses Damian Conway's excellent Parse::RecDescent module +for some advanced features. If you don't have that module installed +then you can still install Mail::IMAPClient but you won't have the +full functionality. If you have Parse::RecDescent installed and then +upgrade it, you may find that some features in Mail::IMAPClient suddenly +start throwing compile-time errors. Just 'make clean' and then 'make', +'make test', and 'make install'. This happens because grammers compiled +under older releases of Parse::RecDescent are sometimes incompatible +with newer Parse::RecDescent runtime engines. This would never be a +problem if Mail::IMAPClient recompiled grammers at run time, but for +performance reasons it precompiles them at install time. TANSTAAFL. + +Now go and write IMAP clients. + +Dave Kernen diff --git a/Mail-IMAPClient-2.99_02/MANIFEST b/Mail-IMAPClient-2.99_02/MANIFEST new file mode 100644 index 0000000..2966b10 --- /dev/null +++ b/Mail-IMAPClient-2.99_02/MANIFEST @@ -0,0 +1,39 @@ +Changes +COPYRIGHT +Todo +Makefile.PL +MANIFEST +README +examples/build_dist.pl +examples/build_ldif.pl +examples/cleanTest.pl +examples/copy_folder.pl +examples/cyrus_expire.pl +examples/cyrus_expunge.pl +examples/find_dup_msgs.pl +examples/imap_to_mbox.pl +examples/imtestExample.pl +examples/migrate_mail2.pl +examples/migrate_mbox.pl +examples/populate_mailbox.pl +examples/sharedFolder.pl +INSTALL +sample.perldb +test_template.txt +prepare_dist +lib/Mail/IMAPClient/BodyStructure/Parse.grammar +lib/Mail/IMAPClient/BodyStructure/Parse.pm +lib/Mail/IMAPClient/BodyStructure/Parse.pod +lib/Mail/IMAPClient/BodyStructure.pm +lib/Mail/IMAPClient/MessageSet.pm +lib/Mail/IMAPClient.pm +lib/Mail/IMAPClient.pod +lib/Mail/IMAPClient/Thread.grammar +lib/Mail/IMAPClient/Thread.pm +lib/Mail/IMAPClient/Thread.pod +t/basic.t +t/bodystructure.t +t/messageset.t +t/thread.t +t/pod.t +META.yml Module meta-data (added by MakeMaker) diff --git a/Mail-IMAPClient-2.99_02/META.yml b/Mail-IMAPClient-2.99_02/META.yml new file mode 100644 index 0000000..bb0321c --- /dev/null +++ b/Mail-IMAPClient-2.99_02/META.yml @@ -0,0 +1,25 @@ +--- #YAML:1.0 +name: Mail-IMAPClient +version: 2.99_02 +abstract: IMAP4 client library +license: ~ +generated_by: ExtUtils::MakeMaker version 6.32 +distribution_type: module +requires: + Carp: 0 + Data::Dumper: 0 + Digest::HMAC_MD5: 0 + Errno: 0 + Fcntl: 0 + File::Temp: 0.18 + IO::File: 0 + IO::Select: 0 + IO::Socket: 0 + IO::Socket::INET: 1.26 + MIME::Base64: 0 + Parse::RecDescent: 1.94 + Test::More: 0 + Test::Pod: 0 +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.2.html + version: 1.2 diff --git a/Mail-IMAPClient-2.99_02/Makefile b/Mail-IMAPClient-2.99_02/Makefile new file mode 100644 index 0000000..a24ca3d --- /dev/null +++ b/Mail-IMAPClient-2.99_02/Makefile @@ -0,0 +1,850 @@ +# 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/Makefile.PL b/Mail-IMAPClient-2.99_02/Makefile.PL new file mode 100644 index 0000000..48c3f2a --- /dev/null +++ b/Mail-IMAPClient-2.99_02/Makefile.PL @@ -0,0 +1,110 @@ +use ExtUtils::MakeMaker; +use warnings; +use strict; + +eval "require Parse::RecDescent"; +$@ and warn <<'__NO_BODY'; + *** NOTE *** + Unable to find and load Parse::RecDescent. + Mail::IMAPClient will be installed without support for the + get_bodystructure() method. +__NO_BODY + +WriteMakefile + ( NAME => 'Mail::IMAPClient', + , ABSTRACT => 'IMAP4 client library' + , VERSION_FROM => 'lib/Mail/IMAPClient.pm' + , PREREQ_PM => + { 'Errno' => 0 + , 'IO::Socket' => 0 + , 'Fcntl' => 0 + , 'IO::Select' => 0 + , 'IO::File' => 0 + , 'Data::Dumper' => 0 + , 'Carp' => 0 + , 'IO::Socket::INET' => 1.26 + , 'Parse::RecDescent' => 1.94 + , 'Digest::HMAC_MD5' => 0 + , 'MIME::Base64' => 0 + + , 'Test::More' => 0 + , 'File::Temp' => 0.18 + , 'Test::Pod' => 0 + } + , clean => { FILES => 'test.txt' } + ); + +set_test_data(); + +sub set_test_data { + unless(-f "lib/Mail/IMAPClient.pm") + { warn "ERROR: not in installation directory\n"; + return; + } + + return if -f "./test.txt"; + + print <<'__INTRO'; +You have the option of running an extended suite of tests during +'make test'. This requires an IMAP server name, user account, and +password to test with. + +__INTRO + + my $yes = prompt "Do you want to run the extended tests? (n/y)"; + return if $yes !~ /^[Yy](?:[Ee]:[Ss]?)?$/ ; + + unless(open TST,">./test.txt") + { warn "ERROR: couldn't open ./test.txt: $!\n"; + return; + } + + my $server = ""; + until($server) + { $server = prompt "\nPlease provide the hostname or IP address of " + . "a host running an\nIMAP server (or QUIT to skip " + . "the extended tests)"; + chomp $server; + return if $server =~ /^\s*quit\s*$/i ; + } + + print TST "server=$server\n"; + + my $user = ""; + until($user) + { $user = prompt "\nProvide the username of an account on $server (or QUIT)"; + chomp $user; + return if $user =~ /^\s*quit\s*$/i ; + } + print TST "user=$user\n"; + + my $passed = ""; + until($passed) + { $passed = prompt "\nProvide the password for $user (or QUIT)"; + chomp $passed; + return if $passed =~ /^\s+$|^quit$/i ; + } + + print TST "passed=$passed\n"; + + my $port = prompt "\nPlease provide the port to connect to on $server" + . "to run the test\n(default is 143)"; + chomp $port; + $port ||= 143; + print TST "port=$port\n"; + + my $authmech = prompt "\nProvide the authentication mechanism to use " + . "on $server to\nrun the test (default is 'LOGIN', " + . "which uses the plain text LOGIN command)"; + chomp $authmech; + $authmech ||= 'LOGIN'; + print TST "authmechanism=$authmech\n"; + close TST; + + print <<'__THANKS'; +Gracias! The information you provided (including the password!) has +been stored in test.txt and should be removed (either by hand or by +'make clean') after testing. +__THANKS + +} diff --git a/Mail-IMAPClient-2.99_02/README b/Mail-IMAPClient-2.99_02/README new file mode 100644 index 0000000..d21a5d3 --- /dev/null +++ b/Mail-IMAPClient-2.99_02/README @@ -0,0 +1,147 @@ + Mail::IMAPClient + +Copyright 1999-2003 The Kernen Group, Inc. +Copyright 2007 Mark Overmeer +All rights reserved. + +This program is free software; you can redistribute it and/or modify +it under the terms of either: + + a) the "Artistic License" which comes with this Kit, or + + b) the GNU General Public License as published by the Free Software + Foundation; either version 1, or (at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either +the GNU General Public License or the Artistic License for more details. + +DESCRIPTION + +This module provides perl routines that simplify a sockets connection +to and an IMAP conversation with an IMAP server. + +COMPATIBILITY + +This module was developed on Solaris 2.5.1 and 2.6 against Netscape IMAP +servers versions 3.6 and 4.1. However, since it is written in perl and +designed for flexibility, it should run on any OS with a TCP/IP stack and +a version of perl that includes the Socket and IO::Socket modules. It also +should be able to talk to any IMAP server, even those that have, um, +proprietary features (assuming that the programmer knows what those features +are). + +To date, I know that the test suite runs successfully with the following IMAP +servers: + +-Netscape Messenging Server v4.x +-Netscape Messenging Server v3.x +-UW-IMAP (I think it was 4.5) +-Cyrus IMAP4 v1.5.19 +-Mirapoint Message Server Appliances (OS versions 1.6.1, 1.7.1, and 2.0.2) + +I also know that it has some problems running against the InterMail +server vM.4.001.02.00 (and probably other versions of InterMail as well). + +Version 2.0.3 has been tested with the mdaemon server with mixed +results. It seems that mdaemon does not comply strictly with RFC2060 and +so you may have problems using this module with mdaemon, especially with +folder names with embedded spaces or embedded double quotes. You may be +able to get some simple tasks to work but you won't be able to run the +test suite successfully. Use with caution. + +If your server requires the use of the AUTHENTICATE IMAP client command +(say, for strong authentication) then you can still use this module, +provided you can come up with the appropriate responses to any challenges +offered by your server. Mark Bush's Authen::NTLM module can assist with +this if you specifically are interested in NTLM authentication. + +DEPENDENCIES + +The Mail::IMAPClient module uses the IO::Socket module to make a socket +connection to an IMAP server and the Socket module to get some constants. +It also uses Errno, Fcntl (for faster I/O) and IO::Select, IO::File, +Data::Dumper, and Carp. + +You can verify that your system has a sufficient perl installation by +entering on the command line: + +perl -e "use constant; use Socket; use IO::Socket; use IO::File; \ + use IO::Select; use Fcntl; use Errno; use Carp; use Data::Dumper;" + +If you get compile errors then you'll have trouble using Mail::IMAPClient. + +If you need to use the bodystructure helper module +Mail::IMAPClient::BodyStructure then you also need Parse::RecDescent. Try +this on the command line: + +perl -e "use Parse::RecDescent;" + +If you get compile errors then you will not be able to use the +Mail::IMAPClient::BodyStructure module (or the get_bodystructure method +in Mail::IMAPClient). You will also get errors when you run 'make test' +in t/bodystructure and/or t/parse. If these tests fail you can still +use Mail::IMAPClient safely (assuming the other tests passed!) but +you will not be able to use Mail::IMAPClient::BodyStructure or the +get_bodystructure method in Mail::IMAPClient. + +(Note that as of version 2.2.0 the above is somewhat obsolete, since +Makefile.PL will detect whether or not you have Parse::RecDescent and +will either choose to or decline to install the ::BodyStructure stuff +accordingly.) + +REPORING BUGS + +See http://rt.cpan.org/Public/Dist/Display.html?Name=Mail-IMAPClient + +INSTALLATION + +Generally, gunzipping and untarring the source file, running 'perl +Makefile.PL' and 'make install' are all it takes to install this +module. And if that's too much work you can always use the CPAN module! + +OVERVIEW OF FUNCTIONALITY + +Mail::IMAPClient.pm provides methods to simplify the connection to and +the conversation between a perl script and an IMAP server. Virtually +all IMAP Client commands (as defined in rfc2060) are supported, either +through IMAPClient object methods or the 'default method', which is an +AUTOLOAD hack that assumes a default syntax for IMAP Client commands of: + + tagvalue COMMAND [Arg1 [Arg2 [... Arg3]]]" + +By remarkable coincidence, AUTOLOAD's default syntax mimics the +general syntax of IMAP Client commands. This means that if a script +tries to use any undefined method then that method will be interpreted +as an unimplemented IMAP command, and the default syntax will be used +to create the command string. I did this as a short cut to writing a +bunch of methods that were practically the same. There are inheritance +implications because of this approach but as far as I can tell this is +not a serious limitation. However, if you decide to write modules that +inherit from this class that require AUTOLOAD logic of their own then you +will have to take the Mail::IMAPClient's AUTOLOAD strategy into account. + +Where methods are defined, they usually exist to add functionality, +perhaps by massaging output or by supplying default arguments. An example +is the search method, which accepts the same arguments as the SEARCH +IMAP Client command (as documented in RFC2060) but which massages the +results so that the return value is an array of message sequence numbers +matching the search criteria, rather than a line of text listing the +sequence numbers. + +Some methods exists solely to add functionality, such as the folders +method, which invokes the list method but then massages the results to +produce an array containing all folder names. The message_count and +delete_messsage methods are similarly examples of methods that add +function to "raw" IMAP Client commands. + +Further information is provided in the module's documentation, which you are +encouraged to read and enjoy. + +Good Luck! + +Dave Kernen +The Kernen Group, Inc. +DJKERNEN@cpan.org + diff --git a/Mail-IMAPClient-2.99_02/Todo b/Mail-IMAPClient-2.99_02/Todo new file mode 100644 index 0000000..36a5d6d --- /dev/null +++ b/Mail-IMAPClient-2.99_02/Todo @@ -0,0 +1,65 @@ + +Starting with release 2.99_01, I (Mark Overmeer) try to revive the +module. The original author David Kernen cannot be reached and didn't +release any fixes in four years. That is too long. + +In version 3.0, the installation procedure is been cleaned-up +radically, and some minimal improvements in the code are made to +fix things people reported. + +=== wishlist: + +- A start was made in cleanup of the code in Mail/IMAPClient.pm + The file Mail/IMAPClient-cleanup shows the progress (30%) + But I lack the time (a weeks work at least) to complete this + task. There is a lot of code replication to be stripped. + If anyone buys me time, I will complete that task. + +=== wishlist from the original author: + +The following is a list of some items that I hope to include in a future +release: + +- Support for threaded perl programs (still pending as of version 2.2.0.). + +- Support for imaps (Imap via SSL). I don't have any way to test this + right now but if you get this to work or know someone who has I'd be + really interested in hearing from you. + +- Support for more authentication mechanisms. Currently plain + authentication and cram-md5 authentication are supported. I have + DIGEST-MD5 working at the AUTH qop, but haven't incorporated it into + a released version because I'm still trying to get at least the + integrity qop working, and maybe even privacy, but considering how + much trouble I'm having with just the integrity level I wouldn't + hold my breath if I were you ;-). + +- Currently a number of IMAP Client commands are implemented using the + 'default method', which is an AUTOLOAD hack. I'd like to reduce that + if possible to a bare minimum. (Some are still pending as of version 2.2.7.) + +- I'd like to see this module certified for more OS's and more IMAP servers. + This is (hopefully) just a matter of testing; the code should already + be compatible with the IMAP servers that are out there and with any OS + that allows the IO::Socket module to work. ** A number of platforms + have been added to the list of tested platforms since this was first + written. Please contact DJKernen@cpan.org if you have any to add. + +- Support for newer/older/other versions of IMAP. Currently only RFC2060 is + explicitly supported, although thanks to the 'default method' + (implemented via an AUTOLOAD hack) virtually any IMAP command is + supported, even proprietary commands, X- extensions, and so forth. But + not necessarily other authentication mechanisms... :-( (NOTE: the + AUTHENTICATE method partially addresses this issue.) + +- Support for piping output from (some?) imap commands directly to a + thingy of some sort (perhaps a coderef, a filehandle, or both). + +- Your thingy here!!! Send me your request, and I'll do it in the order of + ($popularity/$difficulty ). + +- Support for perl version 6. This will probably involve a rewrite that + will make portions of the Mail::IMAPClient module look more like the + Mail::IMAPClient::BodyStructure module. (Perl 6 will have built-in + support for semantics that look remarkably like Damian Conway's + Parse::RecDescent module, which will solve a lot of problems for me.) diff --git a/Mail-IMAPClient-2.99_02/blib/arch/.exists b/Mail-IMAPClient-2.99_02/blib/arch/.exists new file mode 100644 index 0000000..e69de29 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 new file mode 100644 index 0000000..e69de29 diff --git a/Mail-IMAPClient-2.99_02/blib/bin/.exists b/Mail-IMAPClient-2.99_02/blib/bin/.exists new file mode 100644 index 0000000..e69de29 diff --git a/Mail-IMAPClient-2.99_02/blib/lib/Mail/.exists b/Mail-IMAPClient-2.99_02/blib/lib/Mail/.exists new file mode 100644 index 0000000..e69de29 diff --git a/Mail-IMAPClient-2.99_02/blib/lib/Mail/IMAPClient.pm b/Mail-IMAPClient-2.99_02/blib/lib/Mail/IMAPClient.pm new file mode 100644 index 0000000..58d943b --- /dev/null +++ b/Mail-IMAPClient-2.99_02/blib/lib/Mail/IMAPClient.pm @@ -0,0 +1,2856 @@ + +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/blib/lib/Mail/IMAPClient.pod b/Mail-IMAPClient-2.99_02/blib/lib/Mail/IMAPClient.pod new file mode 100644 index 0000000..cd3011f --- /dev/null +++ b/Mail-IMAPClient-2.99_02/blib/lib/Mail/IMAPClient.pod @@ -0,0 +1,3746 @@ +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 method. + +The B method accepts one argument, which is the name of the +folder to select. + +=cut + +=head2 exists + +Example: + + $imap->exists($folder) or warn "$folder not found: $@\n"; + +Accepts one argument, a folder name. Returns true if the folder exists +or false if it does not exist. + +=cut + +=head2 expunge + +Example: + + $imap->expunge($folder) or die "Could not expunge: $@\n"; + +The B method accepts one optional argument, a folder name. It +expunges the folder specified as the argument, or the currently +selected folder if no argument is supplied. + +Although RFC2060 does not permit optional arguments (like a folder +name) to the EXPUNGE client command, the L method does, which +is especially interesting given that the L method doesn't +technically exist. In case you're curious, expunging a folder deletes +the messages that you thought were already deleted via +L but really weren't, which means you have to use a +method that doesn't exist to delete messages that you thought didn't +exist. (Seriously, I'm not making any of this stuff up.) + +Or you could use the L method, which de-selects as well as +expunges and which likewise doesn't technically exist. As with any IMAP +client command, that fact that these methods don't exist will not stop +them from working anyway. This is a feature of the B +module. (See L<"Other IMAP Client Commands and the Default Object Method"> +if you still don't believe me.) + +=cut + +=head2 fetch + +Example: + + my $output = $imap->fetch(@args) or die "Could not fetch: $@\n"; + +The B method implements the FETCH IMAP client command. It +accepts a list of arguments, which will be converted into a +space-delimited list of arguments to the FETCH IMAP client command. If +no arguments are supplied then B does a FETCH ALL. If the L +parameter is set to a true value then the first argument will be +treated as a UID or list of UID's, which means that the UID FETCH IMAP +client command will be run instead of FETCH. (It would really be a good +idea at this point to review RFC2060.) + +If called in array context, B will return an array of output +lines. The output lines will be returned just as they were received +from the server, so your script will have to be prepared to parse out +the bits you want. The only exception to this is literal strings, which +will be inserted into the output line at the point at which they were +encountered (without the {nnn} literal field indicator). See RFC2060 +for a description of literal fields. + +If B is called in a scalar context, then a reference to an array +(as described above) is returned instead of the entire array. + +B returns C on failure. Inspect L or C<$@> for +an explanation of your error. + +=cut + +=head2 fetch_hash + +Example: + my $hashref = {} ; + $imap->fetch_hash("RFC822.SIZE",$hashref) ; + print "Msg #$m is $hashref->{$m} bytes\n" foreach my $m (keys %$hashref); + +The B method accepts a list of message attributes to be fetched +(as described in RFC2060). It returns a hash whose keys are all the messages +in the currently selected folder and whose values are key-value pairs of fetch +keywords and the message's value for that keyword (see sample output below). + +If B is called in scalar context, it returns a reference to the hash +instead of the hash itself. If the last argument is a hash reference, then that +hash reference will be used as the place where results are stored (and that +reference will be returned upon successful completion). If the last argument is +not a reference then it will be treated as one of the FETCH attributes and a new +hash will be created and returned (either by value or by reference, depending on +the context in which B was called). + +For example, if you have a folder with 3 messages and want the size and internal +date for each of them, you could do the following: + + use Mail::IMAPClient; + use Data::Dumper; + # ... other code goes here + $imap->select($folder); + my $hash = $imap->fetch_hash("RFC822.SIZE","INTERNALDATE"); + # (Same as: + # my $hash = $imap->fetch_hash("RFC822.SIZE"); + # $imap->fetch_hash("INTERNALDATE",$hash); + # ). + print Data::Dumper->Dumpxs([$hash],['$hash']); + +This would result in L output similar to the following: + + $hash = { + '1' => { + 'INTERNALDATE' => '21-Sep-2002 18:21:56 +0000', + 'RFC822.SIZE' => '1586', + }, + '2' => { + 'INTERNALDATE' => '22-Sep-2002 11:29:42 +0000', + 'RFC822.SIZE' => '1945', + }, + '3' => { + 'INTERNALDATE' => '23-Sep-2002 09:16:51 +0000', + 'RFC822.SIZE' => '134314', + } + }; + +You can specify I as an argument, but you +should keep the following in mind if you do: + +B<1.> You can only specify one argument of this type per call. If you need +multiple fields, then you'll have to call B multiple times, +each time specifying a different FETCH attribute but the same. + +B<2.> Fetch operations that return RFC822 message headers return the whole +header line, including the field name and the colon. For example, if you +do a C<$imap-Efetch_hash("BODY[HEADER.FIELDS (Subject)]")>, you will +get back subject lines that start with "Subject: ". + +By itself this method may be useful for, say, speeding up programs that +want the size of every message in a folder. It issues one command and +receives one (possibly long!) response from the server. However, it's true +power lies in the as-yet-unwritten methods that will rely on this method +to deliver even more powerful result hashes (and which may even remove the +restrictions mentioned in B<1> and B<2>, above). Look for more new function +in later releases. + +This method is new with version 2.2.3 and is thus still experimental. If you +decide to try this method and run into problems, please see the section on +L. + +=cut + +=head2 flags + +Example: + + my @flags = $imap->flags($msgid) + or die "Could not flags: $@\n"; + +The B method implements the FETCH IMAP client command to list a +single message's flags. It accepts one argument, a message sequence +number (or a message UID, if the L parameter is true), and returns +an array (or a reference to an array, if called in scalar context) +listing the flags that have been set. Flag names are provided with +leading backslashes. + +As of version 1.11, you can supply either a list of message id's or a +reference to an array of of message id's (which means either sequence +number, if the Uid parameter is false, or message UID's, if the Uid +parameter is true) instead of supplying a single message sequence +number or UID. If you do, then the return value will not be an array or +array reference; instead, it will be a hash reference, with each key +being a message sequence number (or UID) and each value being a +reference to an array of flags set for that message. + +For example, if you want to display the flags for every message in the +folder where you store e-mail related to your plans for world +domination, you could do something like this: + + use Mail::IMAPClient; + my $imap = Mail::IMAPClient->new( Server => $imaphost, + User => $login, + Password=> $pass, + Uid => 1, # optional + ); + + $imap->select("World Domination"); + # get the flags for every message in my 'World Domination' folder + $flaghash = $imap->flags( scalar($imap->search("ALL"))) ; + + # pump through sorted hash keys to print results: + for my $k (sort { $flaghash->{$a} <=> $flaghash->{$b} } keys %$flaghash) { + # print: Message 1: \Flag1, \Flag2, \Flag3 + print "Message $k:\t",join(", ",@{$flaghash->{$k}}),"\n"; + } + + +=cut + +=head2 folders + +Example: + + $imap->folders or die "Could not list folders: $@\n"; + +The B method returns an array listing the available folders. +It will only be successful if the object is in the I or +I states. + +The B argument accepts one optional argument, which is a prefix. +If a prefix is supplied to the B method, then only folders beginning +with the prefix will be returned. + +For example: + + print join(", ",$imap->folders),".\n"; + # Prints: + # INBOX, Sent, Projects, Projects/Completed, Projects/Ongoing, Projects Software. + print join(", ",$imap->folders("Projects"),".\n"; + # Prints: + # Projects, Projects/Completed, Projects/Ongoing, Projects Software. + print join(", ",$imap->folders("Projects" . $imap->separator),".\n"; + # Prints: + # Projects/Completed, Projects/Ongoing + +Notice that if you just want to list a folder's subfolders (and not the +folder itself), then you need to include the hierarchy separator character +(as returned by the L method). + +=cut + +=head2 has_capability + +Example: + + my $has_feature = $imap->has_capability($feature) + or die "Could not do has_capability($feature): $@\n"; + +Returns true if the IMAP server to which the B object is +connected has the capability specified as an argument to +B. + +=head2 idle + +Example: + + my $idle = $imap->idle or warn "Couldn't idle: $@\n"; + &goDoOtherThings; + $imap->done($idle) or warn "Error from done: $@\n"; + +The B method places the IMAP connection in an IDLE state. Your +server must support the IMAP IDLE extension to use this method. (See +RFC2177 for a discussion of the IDLE IMAP extension.) The B method +accepts no arguments and returns a transaction number. This transaction +number must be supplied as the argument for L when the L +method is later called. + +Use the L method to tell the IMAP server that the connection is +finished idling. + +If you attempt to use the B method against a server that does not +have the IDLE capability then the B method will return C. +If you then attempt to use the B method a second time the B +method will return C again. + +If you successfully run the B method, then you must use the L +method to stop idling (or to continue, in the parlance of RFC2177). +Failure to do so will only encourage your server to call you I +and to rant about a I. + +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 an I<* BAD Invalid tag> +message. + +=head2 imap4rev1 + +Example: + + $imap->imap4rev1 or die "Could not imap4rev1: $@\n"; + +Returns true if the IMAP server to which the B object is +connected has the IMAP4REV1 capability. + +=head2 internaldate + +Example: + + my $msg_internal_date = $imap->internaldate($msgid) + or die "Could not internaldate: $@\n"; + +B accepts one argument, a message id (or UID if the +L parameter is true), and returns that message's internal date. + +=head2 get_bodystructure + +Example: + + my $bodyStructObject = $imap->get_bodystructure($msgid) + or die "Could not get_bodystructure: $@\n"; + +The B method accepts one argument, a message +sequence number or, if L is true, a message UID. It obtains the +message's body structure and returns a parsed +L object for the message. + +=head2 get_envelope + +Example: + + my $envObject = $imap->get_envelope(@args) + or die "Could not get_envelope: $@\n"; + +The B method accepts one argument, a message sequence +number or, if L is true, a message UID. It obtains the message's +envelope and returns a B +object for the envelope, which is just a version of the envelope that's +been parsed into a perl object. + +For more information on how to use this object once you've gotten it, +see the L documention. (As of this +writing there is no separate pod document for +B.) + +=head2 getacl + +Example: + + my $hash = $imap->getacl($folder) + or die "Could not getacl for $folder: $@\n"; + +B accepts one argument, the name of a folder. If no argument is +provided then the currently selected folder is used as the default. It +returns a reference to a hash. The keys of the hash are userids that +have access to the folder, and the value of each element are the +permissions for that user. The permissions are listed in a string in +the order returned from the server with no whitespace or punctuation +between them. + +=cut + +=head2 get_header + +Example: + + my $messageId = $imap->get_header($msg, "Message-Id") ; + +The B method accepts two arguments, a message sequence number +or UID and the name of an RFC822 header (without the trailing colon). It returns +the value for that header in the message whose sequence number or UID +was passed as the first argument. If no value can be found it returns C; +if multiple values are found it returns the first one. Its return value is +always a scalar. B uses case insensitive matching to get the value, +so you do not have to worry about the case of your second argument. + +The B method is a short-cut for: + + my $messageId = $imap->parse_headers($msg,"Subject")->{"Subject"}[0]; + + + +=head2 is_parent + +Example: + + my $hasKids = $imap->is_parent($folder) ; + +The B method accepts one argument, the name of a folder. It +returns a value that indicates whether or not the folder has children. +The value it returns is either 1) a true value (indicating that the +folder has children), 2) 0 if the folder has no children at this time, +or 3) C if the folder is not permitted to have children. + +Eg: + + my $parenthood = $imap->is_parent($folder); + if (defined($parenthood)) { + if ($parenthood) { + print "$folder has children.\n" ; + } else { + print "$folder is permitted children, but has none.\n"; + } + } else { + print "$folder is not permitted to have children.\n"; + } + + +=cut + +=head2 list + +Example: + + my @raw_output = $imap->list(@args) + or die "Could not list: $@\n"; + +The B method implements the IMAP LIST client command. Arguments +are passed to the IMAP server as received, separated from each other by +spaces. If no arguments are supplied then the default list command +C is issued. + +The B method returns an array (or an array reference, if called +in a scalar context). The array is the unadulterated output of the LIST +command. (If you want your output adulterated then see the L +method, above.) + +=cut + +=head2 listrights + +Example: + + $imap->listrights($folder,$user) + or die "Could not listrights: $@\n"; + +The B method implements the IMAP LISTRIGHTS client command +(L). It accepts two arguments, the foldername and a user id. +It returns the rights the specified user has for the specified folder. +If called in a scalar context then the rights are returned a strings, with +no punction or whitespace or any nonsense like that. If called in array +context then B returns an array in which each element is one +right. + +=head2 login + +Example: + + $imap->login or die "Could not login: $@\n"; + +The B method uses the IMAP LOGIN client command (as defined in +RFC2060) to log into the server. The I and I parameters +must be set before the B method can be invoked. If successful, +the B method returns a pointer to the B object and +sets the object status to I. If unsuccessful, it returns +undef. See the L method for more information on how B can +be called automatically from L. + +B is sometimes called automatically by L, which in turn +is sometimes called automatically by L. You can predict this +behavior once you've read the section on the L method. + +=cut + +=head2 logout + +Example: + + $imap->logout or die "Could not logout: $@\n"; + +The B method issues the LOGOUT IMAP client commmand. Since the +LOGOUT IMAP client command causes the server to end the connection, +this also results in the B client entering the +I state. This method does not, however, destroy the +B object, so a program can re-invoke the L and +L methods if it wishes to reestablish a session later in the +program. + +According to the standard, a well-behaved client should log out before +closing the socket connection. Therefore, B will +attempt to log out of the server during B processing if the +object being destroyed is in the L state. + +=cut + +=head2 lsub + +Example: + + $imap->lsub(@args) or die "Could not lsub: $@\n"; + +The B method implements the IMAP LSUB client command. Arguments +are passed to the IMAP server as received, separated from each other +by spaces. If no arguments are supplied then the default lsub command +C is issued. + +The B method returns an array (or an array reference, if called +in a scalar context). The array is the unaltered output of the LSUB +command. If you want an array of subscribed folders then see the +L method, below. + +=cut + +=head2 mark + +Example: + + $imap->mark(@msgs) or die "Could not mark: $@\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 "\Flagged" 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. + +Note that specifying C<$imap-Esee(@msgs)> is just a shortcut for +specifying C<$imap-Eset_flag("Flagged",@msgs)>. + +=cut + +=head2 Massage + +Example: + + $imap->search(HEADER => 'Message-id' => $imap->Massage($msg_id,1)); + +The B method accepts a value as an argument and, optionally, a second +value that, when true, indicates that the first argument is not the name of an +existing folder. + +It returns its argument as a correctly quoted string or a literal string. + +Note that you should rarely use this on folder names, since methods that accept +folder names as an argument will call B for you. In fact, it was originally +developed as an undocumented helper method meant for internal Mail::IMAPClient methods +only. + +You may also want to see the L method, which is related to this method. + +=head2 message_count + +Example: + + my $msgcount = $imap->message_count($folder); + defined($msgcount) or die "Could not message_count: $@\n"; + +The B method accepts the name of a folder as an argument +and returns the number of messages in that folder. Internally, it +invokes the L method (see above) and parses out the results to +obtain the number of messages. If you don't supply an argument to +B then it will return the number of messages in the +currently selected folder (assuming of course that you've used the +L method selects a folder and changes the object's state to +I. It accepts one argument, which is the name of the folder +to select. + +=cut + +=head2 selectable + +Example: + + foreach my $f ( grep($imap->selectable($_),$imap->folders ) ) { + $imap->select($f) ; + } + +The B method accepts one value, a folder name, and returns true +if the folder is selectable or false if it is not selectable. + +=cut + +=head2 sentbefore + +Example: + + my @msgs = $imap->sentbefore($Rfc2060_date) + or warn "Could not find any msgs sent before $Rfc2060_date: $@\n"; + +The B method works just like L<"sentsince">, below, except it +searches for messages that were sent before the date supplied as an +argument to the method. + +=cut + +=head2 senton + +Example: + + my @msgs = $imap->senton($Rfc2060_date) + or warn "Could not find any messages sent on $Rfc2060_date: $@\n"; + +The B method works just like L<"sentsince">, below, except it searches +for messages that were sent on the exact date supplied as an argument +to the method. + +=cut + +=head2 sentsince + +Example: + + my @msgs = $imap->sentsince($Rfc2060_date) + or warn "Could not find any messages sent since $Rfc2060_date: $@\n"; + +The B method accepts one argument, a date in either epoch +time format (seconds since 1/1/1970, or as output by L +and as accepted by L) +or in the I format as defined in RFC2060 (dd-Mon-yyyy, where Mon +is the English-language three-letter abbreviation for the month). + +It searches for items in the currently selected folder for messages +sent since the day whose date is provided as the argument. It uses the +RFC822 I header to determine the I date. (Actually, +it the server that uses the I header; this documentation just +assumes that the date is coming from the I header because that's +what RFC2060 dictates.) + +In the case of arguments supplied as a number of seconds, the returned +result list will include items sent on or after that day, regardless of +whether they arrived before the specified time on that day. The IMAP +protocol does not support searches at a granularity finer than a day, +so neither do I. On the other hand, the only thing I check for in a +I argument is that it matches the pattern +C (notice the lack of anchors), so if your +server lets you add something extra to a I string then so +will B. + +If you'd like, you can use the L method to convert from +epoch time (as returned by L) into an RFC2060 date +specification. + +=cut + +=head2 separator + +Example: + + my $sepChar = $imap->separator(@args) + or die "Could not get separator: $@\n"; + +The B method returns the character used as a separator +character in folder hierarchies. On unix-based servers, this is often +but not necessarily a forward slash (/). It accepts one argument, the +name of a folder whose hierarchy's separator should be returned. If no +folder name is supplied then the separator for the INBOX is returned, +which probably is good enough. + +If you want your programs to be portable from IMAP server brand X to +IMAP server brand Y, then you should never use hard-coded separator +characters to specify subfolders. (In fact, it's even more complicated +than that, since some server don't allow any subfolders at all, some +only allow subfolders under the "INBOX" folder, and some forbid +subfolders in the inbox but allow them "next" to the inbox. +Furthermore, some server implementations do not allow folders to +contain both subfolders and mail messages; other servers allow this.) + +=cut + +=head2 set_flag + +Example: + + $imap->set_flag("Seen",@msgs) + or die "Could not set flag: $@\n"; + +The B method accepts the name of a flag as its first argument +and 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 +next argument(s). It then sets the flag specified 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, just as +you'd expect. + +Note that when specifying the flag in question, the preceding backslash +(\) is entirely optional. (For you, that is. B still +has remember to stick it in there before passing the command to the +server if the flag is one of the reserved flags specified in RFC2060. +This is in fact so important that the method checks its argument and +adds the backslash when necessary, which is why you don't have to worry +about it overly much.) + +=cut + +=head2 setacl + +Example: + + $imap->setacl($folder,$userid,$authstring) + or die "Could not set acl: $@\n"; + +The B method accepts three input arguments, a folder name, a +user id (or authentication identifier, to use the terminology of +RFC2086), and an access rights modification string. See RFC2086 for +more information. (This is somewhat experimental and its implementation +may change.) + +=cut + +=head2 since + +Example: + + my @msgs = $imap->since($date) + or warn "Could not find any messages since $date: $@\n"; + +The B method accepts a date in either epoch format +(seconds since 1/1/1970, or as output by L and as +accepted by L) or in the I format as +defined in RFC2060 (dd-Mon-yyyy, where Mon is the English-language +three-letter abbreviation for the month). It searches for items in the +currently selected folder for messages whose internal dates are on or +after the day whose date is provided as the argument. It uses the +internal system date for a message to determine if that message was +sent since the given date. + +In the case of arguments supplied as a number of seconds, the returned +result list will include items whose internal date is on or after that +day, regardless of whether they arrived before the specified time on +that day. + +If B is called in a list context then it will return a list of +messages meeting the I criterion, or an empty list if +no messages meet the criterion. + +If B is called in a scalar context then it will return +a reference to an array of messages meeting the I +criterion, or C if no messages meet the criterion. + +Since B is a front-end to L, some of the same rules apply. +For example, 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 size + +Example: + + my $size = $imap->size($msgId) + or die "Could not find size of message $msgId: $@\n"; + +The B method accepts one input argument, a sequence number (or +message UID if the L parameter is true). It returns the size of +the message in the currently selected folder with the supplied sequence +number (or UID). The B object must be in a I +state in order to use this method. + +=cut + +=head2 sort + +Example: + + my @msgs = $imap->sort(@args) ; + if ($@ ) { + warn "Error in sort: $@\n"; + } + +The B method is just like the L method, only different. +It implements the SORT extension as described in +L. +It would be wise to use the L method to verify that the +SORT capability is available on your server before trying to use the +B method. If you forget to check and you're connecting to a +server that doesn't have the SORT capability then B will return +undef. L will then say you are "BAD". If your server doesn't +support the SORT capability then you'll have to use L and then +sort the results yourself. + +The first argument to B is a space-delimited list of sorting +criteria. The Internet Draft that describes SORT requires that this +list be wrapped in parentheses, even if there is only one sort +criterion. If you forget the parentheses then the B method will +add them. But you have to forget both of them, or none. This isn't CMS +running under VM! + +The second argument is a character set to use for sorting. Different +character sets use different sorting orders, so this argument is +important. Since all servers must support UTF-8 and US-ASCII if they +support the SORT capability at all, you can use one of those if you +don't have some other preferred character set in mind. + +The rest of the arguments are searching criteria, just as you would +supply to the L method. These are all documented in RFC2060. If +you just want all of the messages in the currently selected folder +returned to you in sorted order, use I as your only search +criterion. + +The B method returns an array containing sequence numbers of +messages that passed the SORT 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. The message sequence numbers or +unique identifiers are ordered according to the sort criteria +specified. The sort criteria are nested in the order specified; that +is, items are sorted first by the first criterion, and within the first +criterion they are sorted by the second criterion, and so on. + +The sort method will clear C<$@> before attempting the I +operation just as the L method does. + +=head2 status + +Example: + + my @rawdata = $imap->status($folder,qw/(Messages)/) + or die "Error obtaining status: $@\n"; + +The B method accepts one argument, the name of a folder (or +mailbox, to use RFC2060's terminology), and returns an array containing +the results of running the IMAP STATUS client command against that +folder. If additional arguments are supplied then they are appended to +the IMAP STATUS client command string, separated from the rest of the +string and each other with spaces. + +If B is not called in an array context then it returns a +reference to an array rather than the array itself. + +The B method should not be confused with the B method +(with an uppercase 'S'), which returns information about the +B object. (See the section labeled L<"Status Methods">, +below). + +=cut + +=head2 store + +Example: + + $imap->store(@args) or die "Could not store: $@\n"; + +The B method accepts a message sequence number or +comma-separated list of message sequence numbers as a first argument, a +message data item name, and a value for the message data item. +Currently, data items are the word "FLAGS" followed by a space and a +list of flags (in parens). The word "FLAGS" can be modified by +prefixing it with either a "+" or a "-" (to indicate "add these flags" +or "remove these flags") and by suffixing it with ".SILENT" (which +reduces the amount of output from the server; very useful with large +message sets). Normally you won't need to call B because there +are oodles of methods that will invoke store for you with the correct +arguments. Furthermore, these methods are friendlier and more flexible +with regards to how you specify your arguments. See for example L, +L, L, and L. Or L, +L, L, and L. + +=head2 subject + +Example: + + + my $subject = $imap->subject($msg); + + +The B method accepts one argument, a message sequence number (or a +message UID, if the I parameter is true). The text in the "Subject" header +of that message is returned (without the "Subject: " prefix). This method is +a short-cut for: + + my $subject = $imap->get_header($msg, "Subject"); + +=head2 subscribed + +Example: + + my @subscribedFolders = $imap->subscribed + or warn "Could not find subscribed folders: $@\n"; + +The B method works like the B method, above, +except that the returned list (or array reference, if called in scalar +context) contains only the subscribed folders. + +Like L, you can optionally provide a prefix argument to the +B method. + +=head2 tag_and_run + +Example: + + my @output = $imap->tag_and_run(@args) + or die "Could not tag_and_run: $@\n"; + +The B method accepts one or two arguments. The first +argument is a string containing an IMAP Client command, without a tag +but with all required arguments. The optional second argument is a +string to look for that will indicate success (without pattern +delimiters). The default is C. + +The B method will prefix your string (from the first +argument) with the next transaction number and run the command. It +returns an array of output lines from the command, which you are free +to parse as you see fit. Using this method instead of B (above) +will free you from having to worry about handling the tags (and from +worrying about the side affects of naming your own tags). + +=cut + +=head2 uidnext + +Example: + + my $nextUid = $imap->uidnext($folder) or die "Could not uidnext: $@\n"; + +The B method accepts one argument, the name of a folder, and +returns the numeric string that is the next available message UID for +that folder. + +=head2 thread + +Example: + + my $thread = $imap->thread($algorythm, $charset, @search_args ) ; + +The B method accepts zero to three arguments. The first argument is the +threading algorythm to use, generally either I or I. +The second argument is the character set to use, and the third argument is the +set of search arguments to use. + +If the algorythm is not supplied, it defaults to I if available, or +I if available. If neither of these is available then the +B method returns undef. + +If the character set is not specified it will default to I. + +If the search arguments are not specified, the default is I. + +If B is called for an object connected to a server that does not support +the THREADS extension then the B method will return C. + +The B method will issue the I command as defined in +L. +It returns an array of threads. Each element in the array is either a message +id or a reference to another array of (sub)threads. + +If the L parameter is set to a true value then the message id's returned +in the thread structure will be message UID's. Otherwise they will be message +sequence numbers. + +=head2 uidvalidity + +Example: + + my $validity = $imap->uidvalidity($folder) + or die "Could not uidvalidity: $@\n"; + +The B method accepts one argument, the name of a folder, +and returns the numeric string that is the unique identifier validity +value for the folder. + +=head2 unmark + +Example: + + $imap->unmark(@msgs) or die "Could not unmark: $@\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 unsets the I<\Flagged> +flag for those message(s). Of course, if the L parameter is set to +a true value then those message sequence numbers should really be +unique message id's. + +Note that specifying C<$imap-Eunmark(@msgs)> is just a shortcut for +specifying C<$imap-Eunset_flag("Flagged",@msgs)>. + +Note also that the I<\Flagged> flag is just one of many possible flags. +This is a little confusing, but you'll have to get used to the idea +that among the reserved flags specified in RFC2060 is one name +I<\Flagged>. There is no specific meaning for this flag; it means +whatever the mailbox owner (or delegate) wants it to mean when it +is turned on. + +=cut + +=head2 unseen + +Example: + + my @unread = $imap->unseen or warn "Could not find unseen msgs: $@\n"; + +The B method performs an IMAP SEARCH UNSEEN search against the +selected folder and returns an array of sequence numbers of messages +that have not yet been seen (ie their I<\Seen> flag is not 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 pointer to the +array (rather than the array itself) will be returned. + +Note that when specifying the flag in question, the preceding backslash +(\) is entirely optional. + +=cut + +=head2 unseen_count + +Example: + + foreach my $f ($imap->folders) { + print "The $f folder has ", + $imap->unseen_count($f)||0, + " unseen messages.\n"; + } + +The B method accepts the name of a folder as an argument +and returns the number of unseen messages in that folder. If no folder +argument is provided then it returns the number of unseen messages in +the currently selected Folder. + +=head2 unset_flag + +Example: + + $imap->unset_flag("\Seen",@msgs) + or die "Could not unset_flag: $@\n"; + +The B method accepts the name of a flag as its first +argument and 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 next argument(s). It then unsets the flag specified 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, +just as you'd expect. + +=cut + +=head1 Other IMAP Client Commands and the Default Object Method + +IMAP Client Commands not otherwise documented have been implemented via +an AUTOLOAD hack and use a default method. + +If a program calls a method that is not defined (or inherited) by the +B module then the B module will assume that it +is an IMAP client command. It will prefix the command with the next +available transaction number (or tag value), and append to it the +space-delimited list of arguments supplied to the unimplemented method +(if any). It will then read lines of output from the imap session until +it finds a line containing the strings "OK" and "Completed", and return +an array containing all of the lines of output (or, if called in scalar +context, an array reference). If it finds "BAD" or "NO" instead of "OK" +it returns C. + +Eg: + + my @results = $imap->FOO("bar","an example","of the default"); + + +results in: + + + 99 FOO bar an example of the default\r\n + +being sent to the IMAP server (assuming that 99 is the current +transaction number). + +Notice that we used an uppercase method name "FOO" so as not to +conflict with future implementations of that IMAP command. If you run +your script with warnings turned on (always a good idea, at least +during testing), then you will receive warnings whenever you use a +lowercase method name that has not been implemented. An exception to +this is when you use certain common (yet unimplemented) methods that, +if ever explicitly implemented, are guaranteed to behave just like the +default method. To date, those methods are either documented in the +section labeled L<"OBJECT METHODS">, above, or listed here: + +B's default method adds enormous flexibility and +built-in extensibility but it is not psychic. It can handle almost +any extension and truthfully tell you if the server successfully +performed your request. But it cannot predict how the command's +output should be handled, beyond returning a true value on success +and C on failure. So if you are running a command because +you want the output then you may need to parse that output yourself. +If you develop code that extends B in a way that +you feel may be useful to others then please consider donating the +code. Many of the methods in B were contributed +by other programmers such as yourself. Their contributions are listed +in the F file as they occur. + +=head2 copy($msg,$folder) + +Copy a message from the currently selected folder in the the folder +whose name is in C<$folder> + +=head2 subscribe($folder) + +Subscribe to a folder + +B Once again, remember to quote your quotes (or use the +L method) if you want quotes to be part of the IMAP command +string. + +You can also use the default method to override the behavior of +implemented IMAP methods by changing the case of the method name, +preferably to all-uppercase so as not to conflict with the Class method +and accessor method namespace. For example, if you don't want the +L method's behavior (which returns a list of message numbers) +but would rather have an array of raw data returned from your L +operation, you can issue the following snippet: + + my @raw = $imap->SEARCH("SUBJECT","Whatever..."); + +which is slightly more efficient than the equivalent: + + $imap->search("SUBJECT","Whatever..."); + + my @raw = $imap->Results; + +Of course you probably want the search results tucked nicely into a list +for you anyway, in which case you might as well use the L method. + +=cut + +=head1 Parameters + +There are several parameters that influence the behavior of an +B object. Each is set by specifying a named value pair +during new method invocation as follows: + + my $imap = Mail::IMAPClient->new ( parameter => "value", + parameter2 => "value", + ... + ); + +Parameters can also be set after an object has been instantiated by +using the parameter's eponymous accessor method like this: + + my $imap = Mail::IMAPClient->new; + $imap->parameter( "value"); + $imap->parameter2("value"); + +The eponymous accessor methods can also be used without arguments to +obtain the current value of the parameter as follows: + + my $imap = Mail::IMAPClient->new; + $imap->parameter( "value"); + $imap->parameter2("value"); + + ... # A whole bunch of awesome perl code, + # omitted for brevity + + + my $forgot = $imap->parameter; + my $forgot2 = $imap->parameter2; + +Note that in these examples I'm using 'parameter' and 'parameter2' as +generic parameter names. The B object doesn't actually have +parameters named 'parameter' and 'parameter2'. On the contrary, the +available parameters are: + +=head2 Authmechanism + +Example: + + $imap->Authmechanism("CRAM-MD5"); + # or + my $authmech = $imap->Authmechanism(); + +If specified, the I causes the specified authentication +mechanism to be used whenever B would otherwise invoke +B. If the value specified for the I parameter is not +a valid authentication mechanism for your server then you will never ever +be able to log in again for the rest of your perl script, probably. So you +might want to check, like this: + + my $authmech = "CRAM-MD5"; + $imap->has_capability($authmech) and $imap->Authmechanism($authmech); + +Of course if you know your server supports your favorite authentication +mechanism then you know, so you can then include your I +with your B call, as in: + + my $imap = Mail::IMAPClient->new( + User => $user, + Passord => $passord, + Server => $server, + Authmechanism => $authmech, + %etc + ); + +If I is supplied but I is not then you had better be +supporting one of the authentication mechanisms that B supports +"out of the box" (such as CRAM-MD5). + +=head2 Authcallback + +Example: + + $imap->Authcallback( \&callback ); + + +This specifies a default callback to the default authentication mechanism +(see L, above). Together, these two methods replace automatic +calls to login with automatic calls that look like this (sort of): + + $imap->authenticate($imap->Authmechanism,$imap->Authcallback) ; + +If I is supplied but I is not then you had better be +supporting one of the authentication mechanisms that B supports +"out of the box" (such as CRAM-MD5). + +=head2 Buffer + +Example: + + $Buffer = $imap->Buffer(); + # or: + $imap->Buffer($new_value); + +The I parameter sets the size of a block of I/O. It is ignored +unless L, below, is set to a true value (the default), or +unless you are using the L method. It's value should be the +number of bytes to attempt to read in one I/O operation. The default +value is 4096. + +When using the L method, you can often achieve dramatic +improvements in throughput by adjusting this number upward. However, +doing so also entails a memory cost, so if set too high you risk losing +all the benefits of the L method's chunking algorythm. Your +program can thus terminate with an "out of memory" error and you'll +have no one but yourself to blame. + +Note that, as hinted above, the I parameter affects the +behavior of the L method regardless of whether you have +L turned on. Believe me, you don't want to go around migrating +tons of mail without using buffered I/O! + + +=head2 Clear + +Example: + + $Clear = $imap->Clear(); + # or: + $imap->Clear($new_value); + +The name of this parameter, for historical reasons, is somewhat +misleading. It should be named I, because it specifies how many +transactions are stored in the wrapped history buffer. But it didn't +always work that way; the buffer used to actually get cleared. The name +though remains the same in the interests of backwards compatibility. +Also I'm too lazy to change it. + +I specifies that the object's history buffer should be wrapped +after every I transactions, where I is the value specified for +the I parameter. Calling the eponymous B method without +an argument will return the current value of the I parameter but +will not cause clear the history buffer to wrap. + +Setting I to 0 turns off automatic history buffer wrapping, and +setting it to 1 turns off the history buffer facility (except for the +last transaction, which cannot be disabled without breaking the +B module). Setting I to 0 will not cause an +immediate clearing of the history buffer; setting it to 1 (or any other +number) will (except of course for that inevitable last transaction). + +The default I value is set to five in order to conserve memory. + +=head2 Debug + +Example: + + $Debug = $imap->Debug(); + # or: + $imap->Debug($true_or_false); + +Sets the debugging flag to either a true or false value. Can be +supplied with the L method call or separately by calling the +B object method. Use of this parameter is strongly recommended +when debugging scripts and required when reporting bugs. + +=head2 Debug_fh + +Example: + + $Debug_fh = $imap->Debug_fh(); + # or: + $imap->Debug_fh($fileHandle); + +Specifies the filehandle to which debugging information should be +printed. It can either a filehandle object reference or a filehandle +glob. The default is to print debugging info to STDERR. + +For example, you can: + + use Mail::IMAPClient; + use IO::File; + # set $user, $pass, and $server here + my $dh = IO::File->new(">debugging.output") + or die "Can't open debugging.output: $!\n"; + my $imap = Mail::IMAPClient->new( User=>$user, Password=>$pass, + Server=>$server, Debug=> "yes, please", + Debug_fh => $dh + ); + +which is the same as: + + use Mail::IMAPClient; + use IO::File; + # set $user, $pass, and $server here + my $imap = Mail::IMAPClient->new( User =>$user, + Password=>$pass, + Server =>$server, + Debug => "yes, please", + Debug_fh=> IO::File->new(">debugging.output") || + die "Can't open debugging.output: $!\n" + ); + + +You can also: + + use Mail::IMAPClient; + # set $user, $pass, and $server here + open(DBG,">debugging.output") + or die "Can't open debugging.output: $!\n"; + my $imap = Mail::IMAPClient->new( User=>$user, Password=>$pass, + Server=>$server, Debug=> 1, + Debug_fh => *DBG + ); + +Specifying this parameter is not very useful unless L is set +to a true value. + +=head2 EnableServerResponseInLiteral + +Example: + + $EnableServerResponseInLiteral = $imap->EnableServerResponseInLiteral(); + # or: + $imap->EnableServerResponseInLiteral($new_value); + +The I parameter tells +B to expect server responses to be embedded in +literal strings. Usually literal strings contain only message data, not +server responses. I have seen at least one IMAP server implementation +though that includes the final OK response in the literal data. +If your server does this then your script will hang whenever you try to +read literal data, such as message text, or even output from the +L method if some of your folders have special characters such +as double quotes or sometimes spaces in the name. + +I am pretty sure this behavior is not RFC2060 compliant so I am +dropping it by default. In fact, I encountered the problem a long time +ago when still new to IMAP and may have imagined the whole thing. +However, if your scripts hang running certain methods you may want to +at least try enabling this parameter by passing the eponymous method a +true value. + +=head2 Fast_io + +Example: + + $Fast_io = $imap->Fast_io(); + # or: + $imap->Fast_io($true_or_false); + +The I parameter controlls whether or not your +B object will attempt to use buffered (i.e. "Fast") +I/O. It is turned on by default. If you turn it off you will definately +slow down your program, often to a painfull degree. However, if you are +experience problems you may want to try this just to see if it helps. +If it does then that means you have found a bug and should report it +immediately (by following the instructions in the section on +L<"REPORTING BUGS">). Even if it doesn't fix the problem, testing with +both I turned on and with it turned off will often aid in +identifying the source of the problem. (If it doesn't help you, it may +help me when you report it!) + +Lately there have not been any bugs associated with I so this +parameter may become deprecated in the future. + +=head2 Folder + +Example: + + $Folder = $imap->Folder(); + # or: + $imap->Folder($new_value); + +The I parameter returns the name of the currently-selected +folder (in case you forgot). It can also be used to set the name of the +currently selected folder, which is completely unnecessary if you used +the L's read-only equivalent, the +L method) to select it. + +Note that setting the I parameter does not automatically select +a new folder; you use the Led or Ld or by doing +something like "$imap->status($folder,"UIDVALIDITY"), it is possible to +uniquely identify every message on the server, although normally you +won't need to bother. + +The methods currently affected by turning on the L flag are: + + copy fetch + search store + message_string message_uid + body_string flags + move size + parse_headers thread + +Note that if for some reason you only want the L parameter turned +on for one command, then you can choose between the following two +snippets, which are equivalent: + +Example 1: + + $imap->Uid(1); + my @uids = $imap->search('SUBJECT',"Just a silly test"); # + $imap->Uid(0); + +Example 2: + + my @uids; + foreach $r ($imap->UID("SEARCH","SUBJECT","Just a silly test") { + chomp $r; + $r =~ s/\r$//; + $r =~ s/^\*\s+SEARCH\s+// or next; + push @uids, grep(/\d/,(split(/\s+/,$r))); + } + +In the second example, we used the default method to issue the UID IMAP +Client command, being careful to use an all-uppercase method name so as +not to inadvertently call the L accessor method. Then we parsed +out the message UIDs manually, since we don't have the benefit of the +built-in L method doing it for us. + +Please be very careful when turning the L parameter on and off +throughout a script. If you loose track of whether you've got the +L parameter turned on you might do something sad, like deleting +the wrong message. Remember, like all eponymous accessor methods, the +B method without arguments will return the current value for the +L parameter, so do yourself a favor and check. The safest approach +is probably to turn it on at the beginning (or just let it default to +being on) and then leave it on. (Remember that leaving it turned off +can lead to problems if changes to a folder's contents cause +resequencing.) + +By default, the L parameter is turned on. + +=head2 User + +Example: + + $User = $imap->User(); + # or: + $imap->User($userid); + +Specifies the userid to use when logging into the IMAP service. Can be +supplied with the L method call or separately by calling the +B object method. + +Parameters can be set during L method invocation by passing named +parameter/value pairs to the method, or later by calling the +parameter's eponymous object method. + +=cut + + +=head1 Status Methods + +There are several object methods that return the status of the object. +They can be used at any time to check the status of an B +object, but are particularly useful for determining the cause of +failure when a connection and login are attempted as part of a single +L method invocation. The status methods are: + +=head2 Escaped_results + +Example: + my @results = $imap->Escaped_results ; + +The B method is almost identical to the B +method. Unlike the B method, however, server output +transmitted literally will be wrapped in double quotes, with all of the +parentheses, double quotes, backslashes, newlines, and carrage returns +escaped. If called in a scalar context, B returns an +array reference rather than an array. + +B is useful if you are retrieving output and +processing it manually, and you are depending on the above special +characters to delimit the data. It is not useful when retrieving +message contents; use B or B for that. + +=head2 History + +Example: + + my @history = $imap->History; + +The B method is almost identical to the L method. +Unlike the L method, however, the IMAP command that was issued +to create the results being returned is not included in the returned +results. If called in a scalar context, B returns an array +reference rather than an array. + +=head2 IsUnconnected + +returns a true value if the object is currently in an L +state. + +=head2 IsConnected + +returns a true value if the object is currently in either a +L, L, or L state. + +=head2 IsAuthenticated + +returns a true value if the object is currently in either an +L or L state. + +=head2 IsSelected + +returns a true value if the object is currently in a L state. + +=head2 LastError + +Internally B is implemented just like a parameter (as +described in L<"Parameters">, above). There is a I attribute +and an eponymous accessor method which returns the I text +string describing the last error condition encountered by the server. + +Note that some errors are more serious than others, so I's +value is only meaningful if you encounter an error condition that you +don't like. For example, if you use the L method to see if a +folder exists and the folder does not exist, then an error message will +be recorded in I even though this is not a particularly +serious error. On the other hand, if you didn't use L and just +tried to L would return +C after setting I to something like C. At this point +it would be useful to print out the contents of I as you +L. + +=head2 LastIMAPCommand + +New in version 2.0.4, B returns the exact IMAP command +string to be sent to the server. Useful mainly in constructing error +messages when L just isn't enough. + +=head2 Report + +The B method returns an array containing a history of the IMAP +session up to the point that B was called. It is primarily +meant to assist in debugging but can also be used to retrieve raw +output for manual parsing. The value of the L parameter controls +how many transactions are in the report. (See the discussion of +L in L<"Parameters">, above.) + +=cut + +=head2 Results + +The B method returns an array containing the results of one +IMAP client command. It accepts one argument, the transaction number of +the command whose results are to be returned. If transaction number is +unspecified then B returns the results of the last IMAP client +command issued. If called in a scalar context, B returns an +array reference rather than an array. + +=cut + +=head2 State + +The B method returns a numerical value that indicates the +current status of the B object. If invoked with an +argument, it will set the object's state to that value. If invoked +without an argument, it behaves just like L, below. + +Normally you will not have to invoke this function. An exception is if +you are bypassing the B module's L and/or +L modules to set up your own connection (say, for example, over +a secure socket), in which case you must manually do what the +L and L methods would otherwise do for you. + +=head2 Status + +The B method returns a numerical value that indicates the +current status of the B object. (Not to be confused with +the L method, all lower-case, which is the implementation of +the I IMAP client command.) + +=head2 Transaction + +The B method returns the tag value (or transaction number) +of the last IMAP client command. + +=head1 Undocumented Methods and Subroutines + +There are two types of undocumented subroutines and methods. The first +are methods that are not documented because they don't exist, even +though they work just fine. Some of my favorite B +methods don't exist but I use them all the time anyway. You can too, +assuming you have your copy of RFC2060 and its extension RFC's handy. +(By the way, you do have them handy because I gave them to you. They're +bundled with the B distribution in the F +subdirectory.) You should feel free to use any of these undocumented +methods. + +These undocumented methods all use what this document refers to as the +"default method". See L, above, for more information on the default method. + +There are also some undocumented methods and subroutines that actually +do exist. Don't use these! If they aren't documented it's for a reason. +They are either experimental, or intended for use by other +B methods only, or deprecated, or broken, or all or +none of the above. In no cases can you write programs that use these +methods and assume that these programs will work with the next version +of B. I never try to make these undocumented methods +and subroutines backwards compatible because they aren't part of the +documented API. + +Occasionally I will add a method and forget to document it; in that +case it's a bug and you should report it. (See L<"REPORTING BUGS">, +below.) It is sometimes hard to tell the difference; if in doubt you +may submit a bug report and see what happens! However, don't bothering +submitting bug reports for missing documentation for any method or +subroutine that begins with an underscore (_) character. These methods +are always private and will never be part of the documented interface. + +=head1 REPORTING BUGS + +Please feel free to e-mail the author at C +if you encounter any strange behaviors. Don't worry about hurting my +feelings or sounding like a whiner or anything like that; +if there's a problem with this module you'll be doing me a favor by +reporting it. However, I probably won't be able to do much about it if +you don't include enough information, so please read and follow these +instructions carefully. + +When reporting a bug, please be sure to include the following: + +- As much information about your environment as possible. I especially +need to know which version of Mail::IMAPClient you are running and the +type/version of IMAP server to which you are connecting. Your OS and +perl verions would be helpful too. + +- As detailed a description of the problem as possible. (What are you +doing? What happens? Have you found a work-around?) + +- An example script that demonstrates the problem (preferably with as +few lines of code as possible!) and which calls the Mail::IMAPClient's +L method with the L parameter set to "1". (If this generates +a ridiculous amount of output and you're sure you know where the problem +is, you can create your object with debugging turned off and then +turn it on later, just before you issue the commands that recreate the +problem. On the other hand, if you can do this you can probably also +reduce the program rather than reducing the output, and this would be +the best way to go under most circumstances.) + +- Output from the example script when it's running with the Debug +parameter turned on. You can edit the output to remove (or preferably +to "X" out) sensitive data, such as hostnames, user names, and +passwords, but PLEASE do not remove the text that identifies the TYPE +of IMAP server to which you are connecting. Note that in most versions +of B, debugging does not print out the user or +password from the login command line. However, if you use some other +means of authenticating then you may need to edit the debugging output +with an eye to security. + +- If something worked in a previous release and doesn't work now, +please tell me which release did work. You don't have to test every +intervening release; just let me know it worked in version x but +doesn't work in version (x+n) or whatever. + +- Don't be surprised if I come back asking for a trace of the problem. +To provide this, you should create a file called I<.perldb> in your +current working directory and include the following line of text in +that file: + +C<&parse_options("NonStop=1 LineInfo=mail_imapclient_db.out");> + +For your debugging convenience, a sample .perldb file, which was +randomly assigned the name F, is provided in the +distribution. + +Next, without changing your working directory, debug the example script +like this: C + +Note that in these examples, the script that demonstrates your problem +is named "example_script.pl" and the trace output will be saved in +"mail_imapclient_db.out". You should either change these values to suit +your needs, or change your needs to suit these values. + +Bug reports should be mailed to: + + bug-Mail-IMAPClient@rt.cpan.org + +Please remember to place a SHORT description of the problem in the subject +of the message. Please try to be a bit specific; things like "Bug +in Mail::IMAPClient" or "Computer Problem" won't exactly expedite things +on my end. + +=head1 REPORTING THINGS THAT ARE NOT BUGS + +If you have suggestions for extending this functionality of this module, or +if you have a question and you can't find an answer in any of the +documentation (including the RFC's, which are included in this distribution +for a reason), then you can e-mail me at the following address: + + DJKERNEN@cpan.org + +Please note that this address is for questions, suggestions, and other comments +about B. It's not for reporting bugs, it's not for general +correspondence, and it's especially not for selling porn, mortgages, Viagra, +penis enlargment pills, DVD copying software, or anything else. + +=head1 AUTHOR + + David J. Kernen + The Kernen Consulting Group, Inc + DJKERNEN@cpan.org + +=cut + +=head1 COPYRIGHT + + Copyright 1999, 2000, 2001, 2002 The Kernen Group, Inc. + All rights reserved. + +This program is free software; you can redistribute it and/or modify it +under the terms of either: + +=over 4 + +=item a) the "Artistic License" which comes with this Kit, or + +=item b) the GNU General Public License as published by the Free Software +Foundation; either version 1, or (at your option) any later version. + +=back + +This program is distributed in the hope that it will be useful, but +WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either the GNU +General Public License or the Artistic License for more details. All your +base are belong to us. + +=cut + +my $not_void = 0; # This is a documentation-only file! diff --git a/Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/BodyStructure.pm b/Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/BodyStructure.pm new file mode 100755 index 0000000..1d0bb72 --- /dev/null +++ b/Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/BodyStructure.pm @@ -0,0 +1,661 @@ +package Mail::IMAPClient::BodyStructure; +use base 'Exporter'; + +use Mail::IMAPClient; +use Mail::IMAPClient::BodyStructure::Parse; + +our $VERSION = '0.0.3'; +our @EXPORT_OK = '$parser'; + +our $parser = Mail::IMAPClient::BodyStructure::Parse->new() + or die "Cannot parse rules: $@\n" + . "Try remaking Mail::IMAPClient::BodyStructure::Parse.\n"; + +sub new { + my $class = shift; + my $bodystructure = shift; + my $self = $parser->start($bodystructure) or return undef; + $self->{_prefix} = ""; + + if ( exists $self->{bodystructure} ) { + $self->{_id} = 'HEAD' ; + } else { + $self->{_id} = 1; + } + + $self->{_top} = 1; + + bless $self, ref($class)||$class; +} + +sub _get_thingy { + my $thingy = shift; + my $object = shift||(ref($thingy)?$thingy:undef); + unless ( defined($object) and ref($object) ) { + $@ = "No argument passed to $thingy method." ; + $^W and print STDERR "$@\n" ; + return undef; + } + unless ( "$object" =~ /HASH/ + and exists($object->{$thingy}) + ) { + $@ = ref($object) . + " $object does not have " . + ( $thingy =~ /^[aeiou]/i ? "an " : "a " ) . + "${thingy}. " . + ( ref($object) =~ /HASH/ ? "It has " . join(", ",keys(%$object)) : "") ; + $^W and print STDERR "$@\n" ; + return undef; + } + return Unwrapped($object->{$thingy}); +} + +BEGIN { + foreach my $datum (qw/ bodytype bodysubtype bodyparms bodydisp bodyid + bodydesc bodyenc bodysize bodylang + envelopestruct textlines + / + ) { + no strict 'refs'; + *$datum = sub { _get_thingy($datum, @_); }; + } + +} + +sub parts { + my $self = shift; + + + if ( exists $self->{PartsList} ) { + return wantarray ? @{$self->{PartsList}} : $self->{PartsList} ; + } + + my @parts = (); + $self->{PartsList} = \@parts; + + unless ( exists($self->{bodystructure}) ) { + $self->{PartsIndex}{1} = $self ; + @parts = ("HEAD",1); + return wantarray ? @parts : \@parts; + } + #@parts = ( 1 ); + #} else { + + foreach my $p ($self->bodystructure()) { + push @parts, $p->id(); + $self->{PartsIndex}{$p->id()} = $p ; + if ( uc($p->bodytype()||"") eq "MESSAGE" ) { + #print "Part $parts[-1] is a ",$p->bodytype,"\n"; + push @parts,$parts[-1] . ".HEAD"; + #} else { + # print "Part $parts[-1] is a ",$p->bodytype,"\n"; + } + } + + #} + + return wantarray ? @parts : \@parts; +} + +sub oldbodystructure { + my $self = shift; + if ( exists $self->{_bodyparts} ) { + return wantarray ? @{$self->{_bodyparts}} : $self->{_bodyparts} ; + } + my @bodyparts = ( $self ); + $self->{_id} ||= "HEAD"; # aka "0" + my $count = 0; + #print STDERR "Analyzing a ",$self->bodytype, " part which I think is part number ", + # $self->{_id},"\n"; + my $dump = Data::Dumper->new( [ $self ] , [ 'bodystructure' ] ); + $dump->Indent(1); + + foreach my $struct (@{$self->{bodystructure}}) { + $struct->{_prefix} ||= $self->{_prefix} . +$count . "." unless $struct->{_top}; + $struct->{_id} ||= $self->{_prefix} . $count unless $struct->{_top}; + #if ( + # uc($struct->bodytype) eq 'MULTIPART' or + # uc($struct->bodytype) eq 'MESSAGE' + #) { + #} else { + #} + push @bodyparts, $struct, + ref($struct->{bodystructure}) ? $struct->bodystructure : () ; + } + $self->{_bodyparts} = \@bodyparts ; + return wantarray ? @bodyparts : $self->bodyparts ; +} + +sub bodystructure { + my $self = shift; + my @parts = (); + my $partno = 0; + + my $prefix = $self->{_prefix} || ""; + + #print STDERR "Analyzing a ",($self->bodytype||"unknown ") , + # " part which I think is part number ", + # $self->{_id},"\n"; + + my $bs = $self; + $prefix = "$prefix." if ( $prefix and $prefix !~ /\.$/); + + if ( $self->{_top} ) { + $self->{_id} ||= "HEAD"; + $self->{_prefix} ||= "HEAD"; + $partno = 0; + for (my $x = 0; $x < scalar(@{$self->{bodystructure}}) ; $x++) { + $self->{bodystructure}[$x]{_id} = ++$partno ; + $self->{bodystructure}[$x]{_prefix} = $partno ; + push @parts, $self->{bodystructure}[$x] , + $self->{bodystructure}[$x]->bodystructure; + } + + + } else { + $partno = 0; + foreach my $p ( @{$self->{bodystructure}} ) { + $partno++; + if ( + ! exists $p->{_prefix} + ) { + $p->{_prefix} = "$prefix$partno"; + } + $p->{_prefix} = "$prefix$partno"; + $p->{_id} ||= "$prefix$partno"; + #my $bt = $p->bodytype; + #if ($bt eq 'MESSAGE') { + #$p->{_id} = $prefix . + #$partno = 0; + #} + push @parts, $p, $p->{bodystructure} ? $p->bodystructure : (); + } + } + + return wantarray ? @parts : \@parts; +} + +sub id { + my $self = shift; + + return $self->{_id} if exists $self->{_id}; + return "HEAD" if $self->{_top}; + #if ($self->bodytype eq 'MESSAGE') { + # return + #} + + if ($self->{bodytype} eq 'MULTIPART') { + my $p = $self->{_id}||$self->{_prefix} ; + $p =~ s/\.$//; + return $p; + } else { + return $self->{_id} ||= 1; + } +} + +sub Unwrapped { + my $unescape = Mail::IMAPClient::Unescape(@_); + $unescape =~ s/^"(.*)"$/$1/ if defined($unescape); + return $unescape; +} + +package Mail::IMAPClient::BodyStructure::Part; +@ISA = qw/Mail::IMAPClient::BodyStructure/; + + +package Mail::IMAPClient::BodyStructure::Envelope; +@ISA = qw/Mail::IMAPClient::BodyStructure/; + +sub new { + my $class = shift; + my $envelope = shift; + my $self = $Mail::IMAPClient::BodyStructure::parser->envelope($envelope); + return $self; +} + + +sub _do_accessor { + my $datum = shift; + if (scalar(@_) > 1) { + return $_[0]->{$datum} = $_[1] ; + } else { + return $_[0]->{$datum}; + } +} + +# the following for loop sets up accessor methods for +# the object's address attributes: + +sub _mk_address_method { + my $datum = shift; + my $method1 = $datum . "_addresses" ; + no strict 'refs'; + *$method1 = sub { + my $self = shift; + return undef unless ref($self->{$datum}) eq 'ARRAY'; + my @list = map { + my $pn = $_->personalname ; + $pn = "" if $pn eq 'NIL' ; + ( $pn ? "$pn " : "" ) . + "<" . + $_->mailboxname . + '@' . + $_->hostname . + ">" + } @{$self->{$datum}} ; + if ( $senderFields{$datum} ) { + return wantarray ? @list : $list[0] ; + } else { + return wantarray ? @list : \@list ; + } + }; +} + +BEGIN { + + for my $datum ( + qw( subject inreplyto from messageid bcc date replyto to sender cc ) + ) { + no strict 'refs'; + *$datum = sub { _do_accessor($datum, @_); }; + } + my %senderFields = map { ($_ => 1) } qw/from sender replyto/ ; + for my $datum ( + qw( from bcc replyto to sender cc ) + ) { + _mk_address_method($datum); + } +} + + +package Mail::IMAPClient::BodyStructure::Address; +@ISA = qw/Mail::IMAPClient::BodyStructure/; + +for my $datum ( + qw( personalname mailboxname hostname sourcename ) + ) { + no strict 'refs'; + *$datum = sub { return $_[0]->{$datum}; }; +} + +1; +__END__ + +=head1 NAME + +Mail::IMAPClient::BodyStructure - Perl extension to Mail::IMAPClient to facilitate +the parsing of server responses to the FETCH BODYSTRUCTURE and FETCH ENVELOPE +IMAP client commands. + +=head1 SYNOPSIS + + use Mail::IMAPClient::BodyStructure; + use Mail::IMAPClient; + + my $imap = Mail::IMAPClient->new(Server=>$serv,User=>$usr,Password=>$pwd); + $imap->select("INBOX") or die "cannot select the inbox for $usr: $@\n"; + + my @recent = $imap->search("recent"); + + foreach my $new (@recent) { + + my $struct = Mail::IMAPClient::BodyStructure->new( + $imap->fetch($new,"bodystructure") + ); + + print "Msg $new (Content-type: ",$struct->bodytype,"/",$struct->bodysubtype, + ") contains these parts:\n\t",join("\n\t",$struct->parts),"\n\n"; + + + } + + + + +=head1 DESCRIPTION + +This extension will parse the result of an IMAP FETCH BODYSTRUCTURE +command into a perl data structure. It also provides helper methods that +will help you pull information out of the data structure. + +Use of this extension requires Parse::RecDescent. If you don't have +Parse::RecDescent then you must either get it or refrain from using +this module. + +=head2 EXPORT + +Nothing is exported by default. C<$parser> is exported upon +request. C<$parser> is the BodyStucture object's Parse::RecDescent object, +which you'll probably only need for debugging purposes. + +=head1 Class Methods + +The following class method is available: + +=head2 new + +This class method is the constructor method for instantiating new +Mail::IMAPClient::BodyStructure objects. The B method accepts one +argument, a string containing a server response to a FETCH BODYSTRUCTURE +directive. Only one message's body structure should be described in this +string, although that message may contain an arbitrary number of parts. + +If you know the messages sequence number or unique ID (UID) +but haven't got its body structure, and you want to get the body +structure and parse it into a B +object, then you might as well save yourself some work and use +B's B method, which accepts +a message sequence number (or UID if I is true) and returns a +B object. It's functionally equivalent +to issuing the FETCH BODYSTRUCTURE IMAP client command and then passing +the results to B's B method but +it does those things in one simple method call. + +=head1 Object Methods + +The following object methods are available: + +=head2 bodytype + +The B object method requires no arguments. It returns the +bodytype for the message whose structure is described by the calling +B object. + +=head2 bodysubtype + +The B object method requires no arguments. It returns the +bodysubtype for the message whose structure is described by the calling +B object. + +=head2 bodyparms + +The B object method requires no arguments. It returns the +bodyparms for the message whose structure is described by the calling +B object. + +=head2 bodydisp + +The B object method requires no arguments. It returns the +bodydisp for the message whose structure is described by the calling +B object. + +=head2 bodyid + +The B object method requires no arguments. It returns the +bodyid for the message whose structure is described by the calling +B object. + +=head2 bodydesc + +The B object method requires no arguments. It returns the +bodydesc for the message whose structure is described by the calling +B object. + +=head2 bodyenc + +The B object method requires no arguments. It returns the +bodyenc for the message whose structure is described by the calling +B object. + +=head2 bodysize + +The B object method requires no arguments. It returns the +bodysize for the message whose structure is described by the calling +B object. + +=head2 bodylang + +The B object method requires no arguments. It returns the +bodylang for the message whose structure is described by the calling +B object. + +=head2 bodystructure + +The B object method requires no arguments. It returns +the bodystructure for the message whose structure is described by the +calling B object. + +=head2 envelopestruct + +The B object method requires no arguments. It returns +the envelopestruct for the message whose structure is described by the +calling B object. This envelope structure +is blessed into the B subclass, +which is explained more fully below. + +=head2 textlines + +The B object method requires no arguments. It returns the +textlines for the message whose structure is described by the calling +B object. + +=head1 Envelopes and the Mail::IMAPClient::BodyStructure::Envelope Subclass + +The IMAP standard specifies that output from the IMAP B command will be an RFC2060 envelope structure. It further +specifies that output from the B command may also +contain embedded envelope structures (if, for example, a message's +subparts contain one or more included messages). Objects belonging to +B are Perl representations +of these envelope structures, which is to say the nested parenthetical +lists of RFC2060 translated into a Perl datastructure. + +Note that all of the fields relate to the specific part to which they +belong. In other words, output from a FETCH nnnn ENVELOPE command (or, +in B, C<$imap->fetch($msgid,"ENVELOPE")> or Cget_envelope($msgid)>) are for the message, but fields from within +a bodystructure relate to the message subpart and not the parent message. + +An envelope structure's B +representation is a hash of thingies that looks like this: + + { + subject => "subject", + inreplyto => "reference_message_id", + from => [ addressStruct1 ], + messageid => "message_id", + bcc => [ addressStruct1, addressStruct2 ], + date => "Tue, 09 Jul 2002 14:15:53 -0400", + replyto => [ adressStruct1, addressStruct2 ], + to => [ adressStruct1, addressStruct2 ], + sender => [ adressStruct1 ], + cc => [ adressStruct1, addressStruct2 ], + } + +The B<...::Envelope> object also has methods for accessing data in the +structure. They are: + +=over 4 + +=item date + +Returns the date of the message. + +=item inreplyto + +Returns the message id of the message to which this message is a reply. + +=item subject + +Returns the subject of the message. + +=item messageid + +Returns the message id of the message. + +=back + +You can also use the following methods to get addressing +information. Each of these methods returns an array of +B objects, which are perl +data structures representing RFC2060 address structures. Some of these +arrays would naturally contain one element (such as B, which +normally contains a single "From:" address); others will often contain +more than one address. However, because RFC2060 defines all of these as +"lists of address structures", they are all translated into arrays of +B<...::Address> objects. + +See the section on B", below, +for alternate (and preferred) ways of accessing these data. + +The methods available are: + +=over 4 + +=item bcc + +Returns an array of blind cc'ed recipients' address structures. (Don't +expect much in here unless the message was sent from the mailbox you're +poking around in, by the way.) + +=item cc + +Returns an array of cc'ed recipients' address structures. + +=item from + +Returns an array of "From:" address structures--usually just one. + +=item replyto + +Returns an array of "Reply-to:" address structures. Once again there is +usually just one address in the list. + +=item sender + +Returns an array of senders' address structures--usually just one and +usually the same as B. + +=item to + +Returns an array of recipients' address structures. + +=back + +Each of the methods that returns a list of address structures (i.e. a +list of B arrays) also has an +analagous method that will return a list of E-Mail addresses instead. The +addresses are in the format Cmailboxname@hostnameE> +(see the section on B, +below) However, if the personal name is 'NIL' then it is omitted from +the address. + +These methods are: + +=over 4 + +=item bcc_addresses + +Returns a list (or an array reference if called in scalar context) +of blind cc'ed recipients' email addresses. (Don't expect much in here +unless the message was sent from the mailbox you're poking around in, +by the way.) + +=item cc_addresses + +Returns a list of cc'ed recipients' email addresses. If called in a scalar +context it returns a reference to an array of email addresses. + +=item from_addresses + +Returns a list of "From:" email addresses. If called in a scalar context +it returns the first email address in the list. (It's usually a list of just +one anyway.) + +=item replyto_addresses + +Returns a list of "Reply-to:" email addresses. If called in a scalar context +it returns the first email address in the list. + +=item sender_addresses + +Returns a list of senders' email addresses. If called in a scalar context +it returns the first email address in the list. + +=item to_addresses + +Returns a list of recipients' email addresses. If called in a scalar context +it returns a reference to an array of email addresses. + +=back + +Note that context affects the behavior of all of the above methods. + +Those fields that will commonly contain multiple entries (i.e. they are +recipients) will return an array reference when called in scalar context. +You can use this behavior to optimize performance. + +Those fields that will commonly contain just one address (the sender's) will +return the first (and usually only) address. You can use this behavior to +optimize your development time. + +=head1 Addresses and the Mail::IMAPClient::BodyStructure::Address + +Several components of an envelope structure are address +structures. They are each parsed into their own object, +B, which looks like this: + + { + mailboxname => 'somebody.special', + hostname => 'somplace.weird.com', + personalname => 'Somebody Special + sourceroute => 'NIL' + } + +RFC2060 specifies that each address component of a bodystructure is a +list of address structures, so B parses +each of these into an array of B +objects. + +Each of these objects has the following methods available to it: + +=over 4 + +=item mailboxname + +Returns the "mailboxname" portion of the address, which is the part to +the left of the '@' sign. + +=item hostname + +Returns the "hostname" portion of the address, which is the part to the +right of the '@' sign. + +=item personalname + +Returns the "personalname" portion of the address, which is the part of +the address that's treated like a comment. + +=item sourceroute + +Returns the "sourceroute" portion of the address, which is typically "NIL". + +=back + +Taken together, the parts of an address structure form an address that will +look something like this: + +Cmailboxname@hostnameE> + +Note that because the B +objects come in arrays, it's generally easier to use the methods +available to B to obtain +all of the addresses in a particular array in one operation. These +methods are provided, however, in case you'd rather do things +the hard way. (And also because the aforementioned methods from +B need them anyway.) + +=cut + +=head1 AUTHOR + +David J. Kernen + +=head1 SEE ALSO + +perl(1), Mail::IMAPClient, and RFC2060. See also Parse::RecDescent if you want +to understand the internals of this module. + +=cut + +1; diff --git a/Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/BodyStructure/Parse.grammar b/Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/BodyStructure/Parse.grammar new file mode 100755 index 0000000..e418422 --- /dev/null +++ b/Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/BodyStructure/Parse.grammar @@ -0,0 +1,288 @@ +# Directives +# ( none) +# Start-up Actions + +{ + my $subpartCount = 0; + my $partCount = 0; +} + +# +# Atoms +TEXT: /^"TEXT"|^TEXT/i { $return = "TEXT" } +PLAIN: /^"PLAIN"|^PLAIN/i { $return = "PLAIN" } +HTML: /"HTML"|HTML/i { $return = "HTML" } +MESSAGE: /^"MESSAGE"|^MESSAGE/i { $return = "MESSAGE" } +RFC822: /^"RFC822"|^RFC822/i { $return = "RFC822" } +NIL: /^NIL/i { $return = "NIL" } +NUMBER: /^(\d+)/ { $return = $item[1]; $return||defined($return);} + +# Strings: + +SINGLE_QUOTED_STRING: "'" /(?:\\'|[^'])*/ "'" { + + $return = $item{__PATTERN1__} ; + $return||defined($return); +} + +DOUBLE_QUOTED_STRING: '"' /(?:\\"|[^"])*/ '"' { + + $return = $item{__PATTERN1__} ; + $return||defined($return); +} + +QUOTED_STRING: DOUBLE_QUOTED_STRING | SINGLE_QUOTED_STRING { + + $return = $item{DOUBLE_QUOTED_STRING}||$item{SINGLE_QUOTED_STRING} ; + $return||defined($return); +} + +BARESTRING: ...!/^[)('"]/ /^(?!\(|\))(?:\\ |\S)+/ { + $return = $item{__PATTERN1__} ; $return||defined($return); +} + +STRING: QUOTED_STRING | BARESTRING { + $return = $item{QUOTED_STRING}||$item{BARESTRING} ; + $return||defined($return); +} + +OLDSTRING: /^"((?:[^"\\]|\\.)*)"/ | /^([^ \(\)]+)/ + { $item{__PATTERN1__} =~ s/^"(.*)"$/$1/; + $return = $item{__PATTERN1__} || $item{__PATTERN2__} ; + $return||defined($return); + } + +#BARESTRING: /^[^(]+\s+(?=\()/ +# { $return = $item[1] ; $return||defined($return);} + +textlines: NIL | NUMBER { $return = $item[1] || $item[2]; $return||defined($return); } +rfc822message: MESSAGE RFC822 { $return = "MESSAGE RFC822" } +key: STRING { $return = $item{STRING} ; $return||defined($return);} +value: NIL | '(' kvpair(s) ')'| NUMBER | STRING + { $return = $item{NIL} || + $item{NUMBER} || + $item{STRING} || + { map { (%$_) } @{$item{'kvpair(s)'}} } ; + $return||defined($return); + } +kvpair: ...!")" key value + { $return = { $item{key} => $item{value} }; $return||defined($return);} +bodytype: STRING + { $return = $item{STRING} ; $return||defined($return);} +bodysubtype: PLAIN | HTML | NIL | STRING + { $return = $item{PLAIN}||$item{HTML}||$item{NIL}||$item{STRING} ; + $return||defined($return); + } +bodyparms: NIL | '(' kvpair(s) ')' + { + $return = $item{NIL} || + { map { (%$_) } @{$item{'kvpair(s)'}} }; + $return || defined($return); + } +bodydisp: NIL | '(' kvpair(s) ')' + { + $return = $item{NIL} || + { map { (%$_) } @{$item{'kvpair(s)'}} }; + $return || defined($return); + } +bodyid: ...!/[()]/ NIL | STRING + { $return = $item{NIL} || $item{STRING} ; $return||defined($return);} +bodydesc: ...!/[()]/ NIL | STRING + { $return = $item{NIL} || $item{STRING} ; $return||defined($return);} +bodyenc: NIL | STRING | '(' kvpair(s) ')' + { + $return = $item{NIL} || + $item{STRING} || + { map { (%$_) } @{$item{'kvpair(s)'}} }; + $return||defined($return); + } +bodysize: ...!/[()]/ NIL | NUMBER + { $return = $item{NIL} || $item{NUMBER} ;$return||defined($return);} + +bodyMD5: NIL | STRING + { $return = $item{NIL} || $item{STRING} ;$return||defined($return);} +bodylang: NIL | STRING | "(" STRING(s) ")" + { $return = $item{NIL} || $item{'STRING(s)'} ;$return||defined($return);} +personalname: NIL | STRING + { $return = $item{NIL} || $item{STRING} ;$return||defined($return);} +sourceroute: NIL | STRING + { $return = $item{NIL} || $item{STRING} ;$return||defined($return);} +mailboxname: NIL | STRING + { $return = $item{NIL} || $item{STRING} ;$return||defined($return);} +hostname: NIL | STRING + { $return = $item{NIL} || $item{STRING} ;$return||defined($return);} +addressstruct: "(" personalname sourceroute mailboxname hostname ")" + { $return = { + personalname => $item{personalname} , + sourceroute => $item{sourceroute} , + mailboxname => $item{mailboxname} , + hostname => $item{hostname} , + } ; + bless($return, "Mail::IMAPClient::BodyStructure::Address"); + } +subject: NIL | STRING + { + $return = $item{NIL} || $item{STRING} ; + $return||defined($return); + } +inreplyto: NIL | STRING + { $return = $item{NIL} || $item{STRING} ;$return||defined($return);} + +messageid: NIL | STRING + { $return = $item{NIL} || $item{STRING} ;$return||defined($return);} + +date: NIL | STRING + { $return = $item{NIL} || $item{STRING} ;$return||defined($return);} + +cc: NIL | "(" addressstruct(s) ")" + { $return = $item{NIL} || $item{'addressstruct(s)'} } + +bcc: NIL | "(" addressstruct(s) ")" + { $return = $item{NIL} || $item{'addressstruct(s)'} } + +from: NIL | "(" addressstruct(s) ")" + { $return = $item{NIL} || $item{'addressstruct(s)'} } + +replyto: NIL | "(" addressstruct(s) ")" + { $return = $item{NIL} || $item{'addressstruct(s)'} } + +sender: NIL | "(" addressstruct(s) ")" + { $return = $item{NIL} || $item{'addressstruct(s)'} } + +to: NIL | "(" addressstruct(s) ")" + { $return = $item{NIL} || $item{'addressstruct(s)'} } + +envelopestruct: "(" date subject from sender replyto to cc bcc inreplyto messageid ")" + { $return = {}; + foreach my $what (qw/date subject from sender replyto to cc bcc inreplyto messageid/) { + $return->{$what} = $item{$what}; + } + bless $return, "Mail::IMAPClient::BodyStructure::Envelope"; + $return||defined($return); + } + +basicfields: bodysubtype bodyparms bodyid(?) + bodydesc(?) bodyenc(?) + bodysize(?) { + + $return = { + bodysubtype => $item{bodysubtype} , + + bodyparms => $item{bodyparms} , + + bodyid => (ref $item{'bodyid(?)'} ? + $item{'bodyid(?)'}[0] : + $item{'bodyid(?)'} ), + + 'bodydesc' => (ref $item{'bodydesc(?)'} ? + $item{'bodydesc(?)'}[0] : + $item{'bodydesc(?)'} ), + + 'bodyenc' => (ref $item{'bodyenc(?)'} ? + $item{'bodyenc(?)'}[0] : + $item{'bodyenc(?)'} ), + + 'bodysize' => (ref $item{'bodysize(?)'} ? + $item{'bodysize(?)'}[0] : + $item{'bodysize(?)'} ), + }; + $return; +} + +textmessage: TEXT basicfields textlines(?) bodyMD5(?) bodydisp(?) bodylang(?) + { + $return = $item{basicfields}||{}; + $return->{bodytype} = 'TEXT'; + foreach my $what (qw/textlines(?) bodyMD5(?) bodydisp(?) bodylang(?)/) { + my $k = $what; $k =~ s/\(\?\)$//; + ref($item{$what}) and $return->{$k} = $item{$what}[0]; + } + $return||defined($return); + } + +othertypemessage: bodytype basicfields bodyparms(?) bodydisp(?) bodylang(?) + { $return = {}; + foreach my $what (qw/bodytype bodyparms(?) bodydisp(?) bodylang(?)/) { + my $k = $what; $k =~ s/\(\?\)$//; + $return->{$k} = ref($item{$what})? $item{$what}[0] : $item{$what} ; + } + while ( my($k,$v) = each %{$item{basicfields}} ) { $return->{$k} = $v } + $return||defined($return); + } + +messagerfc822message: + rfc822message bodyparms bodyid bodydesc bodyenc bodysize + envelopestruct bodystructure textlines + bodyMD5(?) bodydisp(?) bodylang(?) + { + $return = {}; + foreach my $what (qw/ bodyparms bodyid bodydesc bodyenc bodysize + envelopestruct bodystructure textlines + bodyMD5(?) bodydisp(?) bodylang(?) + / + ) { + my $k = $what; $k =~ s/\(\?\)$//; + $return->{$k} = ref $item{$what} =~ 'ARRAY'? + $item{$what}[0] : $item{$what}; + } + while ( my($k,$v) = each %{$item{bodystructure}[0]} ) { $return->{$k} = $v } + while ( my($k,$v) = each %{$item{basicfields}} ) { $return->{$k} = $v } + $return->{bodytype} = "MESSAGE" ; + $return->{bodysubtype}= "RFC822" ; + $return||defined($return); + } + +subpart: "(" part ")" + { + $return = $item{part} ; + $return||defined($return); + } + + +part: subpart(s) basicfields + bodyparms(?) bodydisp(?) bodylang(?) + + { + $return = bless($item{basicfields}, + "Mail::IMAPClient::BodyStructure"); + $return->{bodytype} = "MULTIPART"; + $return->{bodystructure} = $item{'subpart(s)'}; + foreach my $b (qw/bodyparms(?) bodydisp(?) bodylang(?)/) { + my $k = $b; $k =~ s/\(\?\)$//; + $return->{$k} = ref($item{$b}) ? $item{$b}[0] : $item{$b}; + } + $return||defined($return) ; + } + | textmessage + { + $return = bless $item{textmessage}, "Mail::IMAPClient::BodyStructure"; + $return||defined($return); + } + | messagerfc822message + { + $return = bless $item{messagerfc822message}, "Mail::IMAPClient::BodyStructure"; + $return||defined($return); + } + | othertypemessage + { + $return = bless $item{othertypemessage}, "Mail::IMAPClient::BodyStructure"; + $return||defined($return); + } + +bodystructure: "(" part(s) ")" + { + $return = $item{'part(s)'} ; + $return||defined($return); + } + +start: /.*\(.*BODYSTRUCTURE \(/i part(1) /\).*\)\r?\n?/ + { + #print STDERR "item = ",Data::Dumper->Dump([\%item],['$item']); + $return = $item{'part(1)'}[0]; + $return||defined($return); + } + +envelope: /.*\(.*ENVELOPE/ envelopestruct /.*\)/ { + $return = $item{envelopestruct} ; + $return||defined($return) ; + } diff --git a/Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/BodyStructure/Parse.pm b/Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/BodyStructure/Parse.pm new file mode 100644 index 0000000..974cbf3 --- /dev/null +++ b/Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/BodyStructure/Parse.pm @@ -0,0 +1,17245 @@ +package Mail::IMAPClient::BodyStructure::Parse; +use Parse::RecDescent; + +{ my $ERRORS; + + +package Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse; +use strict; +use vars qw($skip $AUTOLOAD ); +$skip = '\s*'; + + my $subpartCount = 0; + my $partCount = 0; +; + + +{ +local $SIG{__WARN__} = sub {0}; +# PRETEND TO BE IN Parse::RecDescent NAMESPACE +*Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::AUTOLOAD = sub +{ + no strict 'refs'; + $AUTOLOAD =~ s/^Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse/Parse::RecDescent/; + goto &{$AUTOLOAD}; +} +} + +push @Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::ISA, 'Parse::RecDescent'; +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodyparms +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"bodyparms"}; + + Parse::RecDescent::_trace(q{Trying rule: [bodyparms]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodyparms}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodyparms}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{bodyparms}); + %item = (__RULE__ => q{bodyparms}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{bodyparms}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodyparms}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodyparms}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodyparms}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: ['(' kvpair ')']}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodyparms}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{bodyparms}); + %item = (__RULE__ => q{bodyparms}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: ['(']}, + Parse::RecDescent::_tracefirst($text), + q{bodyparms}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A\(//) + { + + $expectation->failed(); + Parse::RecDescent::_trace(qq{<>}, + 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{__STRING1__}=$&; + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [kvpair]}, + Parse::RecDescent::_tracefirst($text), + q{bodyparms}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{kvpair})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::kvpair, 1, 100000000, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodyparms}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [kvpair]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{bodyparms}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{kvpair(s)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying terminal: [')']}, + Parse::RecDescent::_tracefirst($text), + q{bodyparms}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{')'})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A\)//) + { + + $expectation->failed(); + Parse::RecDescent::_trace(qq{<>}, + 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{__STRING2__}=$&; + + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{bodyparms}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { + $return = $item{NIL} || + { map { (%$_) } @{$item{'kvpair(s)'}} }; + $return || defined($return); + }; + 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: ['(' kvpair ')']<<}, + Parse::RecDescent::_tracefirst($text), + q{bodyparms}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodyparms}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{bodyparms}, + $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{bodyparms}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{bodyparms}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::date +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"date"}; + + Parse::RecDescent::_trace(q{Trying rule: [date]}, + Parse::RecDescent::_tracefirst($_[1]), + q{date}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{date}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{date}); + %item = (__RULE__ => q{date}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{date}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{date}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{date}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{date}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{date}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{date}); + %item = (__RULE__ => q{date}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [STRING]}, + Parse::RecDescent::_tracefirst($text), + q{date}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::STRING($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{date}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [STRING]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{date}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{STRING}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{date}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = $item{NIL} || $item{STRING} ;$return||defined($return);}; + 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: [STRING]<<}, + Parse::RecDescent::_tracefirst($text), + q{date}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{date}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{date}, + $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{date}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{date}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodysubtype +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"bodysubtype"}; + + Parse::RecDescent::_trace(q{Trying rule: [bodysubtype]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [PLAIN]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{bodysubtype}); + %item = (__RULE__ => q{bodysubtype}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [PLAIN]}, + Parse::RecDescent::_tracefirst($text), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::PLAIN($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [PLAIN]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{PLAIN}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [PLAIN]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [HTML]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{bodysubtype}); + %item = (__RULE__ => q{bodysubtype}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [HTML]}, + Parse::RecDescent::_tracefirst($text), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::HTML($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [HTML]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{HTML}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [HTML]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[2]; + $text = $_[1]; + my $_savetext; + @item = (q{bodysubtype}); + %item = (__RULE__ => q{bodysubtype}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[3]; + $text = $_[1]; + my $_savetext; + @item = (q{bodysubtype}); + %item = (__RULE__ => q{bodysubtype}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [STRING]}, + Parse::RecDescent::_tracefirst($text), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::STRING($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [STRING]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{STRING}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = $item{PLAIN}||$item{HTML}||$item{NIL}||$item{STRING} ; + $return||defined($return); + }; + 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: [STRING]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{bodysubtype}, + $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{bodysubtype}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{bodysubtype}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::hostname +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"hostname"}; + + Parse::RecDescent::_trace(q{Trying rule: [hostname]}, + Parse::RecDescent::_tracefirst($_[1]), + q{hostname}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{hostname}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{hostname}); + %item = (__RULE__ => q{hostname}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{hostname}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{hostname}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{hostname}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{hostname}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{hostname}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{hostname}); + %item = (__RULE__ => q{hostname}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [STRING]}, + Parse::RecDescent::_tracefirst($text), + q{hostname}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::STRING($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{hostname}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [STRING]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{hostname}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{STRING}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{hostname}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = $item{NIL} || $item{STRING} ;$return||defined($return);}; + 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: [STRING]<<}, + Parse::RecDescent::_tracefirst($text), + q{hostname}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{hostname}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{hostname}, + $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{hostname}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{hostname}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::basicfields +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"basicfields"}; + + Parse::RecDescent::_trace(q{Trying rule: [basicfields]}, + Parse::RecDescent::_tracefirst($_[1]), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [bodysubtype bodyparms bodyid bodydesc bodyenc bodysize]}, + Parse::RecDescent::_tracefirst($_[1]), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{basicfields}); + %item = (__RULE__ => q{basicfields}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [bodysubtype]}, + Parse::RecDescent::_tracefirst($text), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodysubtype($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [bodysubtype]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodysubtype}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying subrule: [bodyparms]}, + Parse::RecDescent::_tracefirst($text), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{bodyparms})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodyparms($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [bodyparms]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodyparms}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying repeated subrule: [bodyid]}, + Parse::RecDescent::_tracefirst($text), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{bodyid})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodyid, 0, 1, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodyid]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodyid(?)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [bodydesc]}, + Parse::RecDescent::_tracefirst($text), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{bodydesc})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodydesc, 0, 1, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodydesc]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodydesc(?)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [bodyenc]}, + Parse::RecDescent::_tracefirst($text), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{bodyenc})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodyenc, 0, 1, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodyenc]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodyenc(?)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [bodysize]}, + Parse::RecDescent::_tracefirst($text), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{bodysize})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodysize, 0, 1, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodysize]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodysize(?)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { + + $return = { + bodysubtype => $item{bodysubtype} , + + bodyparms => $item{bodyparms} , + + bodyid => (ref $item{'bodyid(?)'} ? + $item{'bodyid(?)'}[0] : + $item{'bodyid(?)'} ), + + 'bodydesc' => (ref $item{'bodydesc(?)'} ? + $item{'bodydesc(?)'}[0] : + $item{'bodydesc(?)'} ), + + 'bodyenc' => (ref $item{'bodyenc(?)'} ? + $item{'bodyenc(?)'}[0] : + $item{'bodyenc(?)'} ), + + 'bodysize' => (ref $item{'bodysize(?)'} ? + $item{'bodysize(?)'}[0] : + $item{'bodysize(?)'} ), + }; + $return; +}; + 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: [bodysubtype bodyparms bodyid bodydesc bodyenc bodysize]<<}, + Parse::RecDescent::_tracefirst($text), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{basicfields}, + $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{basicfields}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{basicfields}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::personalname +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"personalname"}; + + Parse::RecDescent::_trace(q{Trying rule: [personalname]}, + Parse::RecDescent::_tracefirst($_[1]), + q{personalname}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{personalname}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{personalname}); + %item = (__RULE__ => q{personalname}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{personalname}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{personalname}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{personalname}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{personalname}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{personalname}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{personalname}); + %item = (__RULE__ => q{personalname}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [STRING]}, + Parse::RecDescent::_tracefirst($text), + q{personalname}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::STRING($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{personalname}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [STRING]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{personalname}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{STRING}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{personalname}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = $item{NIL} || $item{STRING} ;$return||defined($return);}; + 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: [STRING]<<}, + Parse::RecDescent::_tracefirst($text), + q{personalname}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{personalname}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{personalname}, + $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{personalname}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{personalname}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::key +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"key"}; + + Parse::RecDescent::_trace(q{Trying rule: [key]}, + Parse::RecDescent::_tracefirst($_[1]), + q{key}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{key}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{key}); + %item = (__RULE__ => q{key}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [STRING]}, + Parse::RecDescent::_tracefirst($text), + q{key}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::STRING($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{key}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [STRING]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{key}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{STRING}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{key}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = $item{STRING} ; $return||defined($return);}; + 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: [STRING]<<}, + Parse::RecDescent::_tracefirst($text), + q{key}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{key}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{key}, + $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{key}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{key}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::cc +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"cc"}; + + Parse::RecDescent::_trace(q{Trying rule: [cc]}, + Parse::RecDescent::_tracefirst($_[1]), + q{cc}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{cc}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{cc}); + %item = (__RULE__ => q{cc}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{cc}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{cc}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{cc}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{cc}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: ['(' addressstruct ')']}, + Parse::RecDescent::_tracefirst($_[1]), + q{cc}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{cc}); + %item = (__RULE__ => q{cc}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: ['(']}, + Parse::RecDescent::_tracefirst($text), + q{cc}, + $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: [addressstruct]}, + Parse::RecDescent::_tracefirst($text), + q{cc}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{addressstruct})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::addressstruct, 1, 100000000, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{cc}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [addressstruct]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{cc}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{addressstruct(s)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying terminal: [')']}, + Parse::RecDescent::_tracefirst($text), + q{cc}, + $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{cc}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = $item{NIL} || $item{'addressstruct(s)'} }; + 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: ['(' addressstruct ')']<<}, + Parse::RecDescent::_tracefirst($text), + q{cc}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{cc}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{cc}, + $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{cc}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{cc}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodyMD5 +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"bodyMD5"}; + + Parse::RecDescent::_trace(q{Trying rule: [bodyMD5]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodyMD5}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodyMD5}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{bodyMD5}); + %item = (__RULE__ => q{bodyMD5}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{bodyMD5}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodyMD5}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodyMD5}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodyMD5}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodyMD5}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{bodyMD5}); + %item = (__RULE__ => q{bodyMD5}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [STRING]}, + Parse::RecDescent::_tracefirst($text), + q{bodyMD5}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::STRING($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodyMD5}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [STRING]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodyMD5}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{STRING}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{bodyMD5}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = $item{NIL} || $item{STRING} ;$return||defined($return);}; + 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: [STRING]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodyMD5}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodyMD5}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{bodyMD5}, + $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{bodyMD5}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{bodyMD5}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::envelope +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"envelope"}; + + Parse::RecDescent::_trace(q{Trying rule: [envelope]}, + Parse::RecDescent::_tracefirst($_[1]), + q{envelope}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [/.*\\(.*ENVELOPE/ envelopestruct /.*\\)/]}, + Parse::RecDescent::_tracefirst($_[1]), + q{envelope}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{envelope}); + %item = (__RULE__ => q{envelope}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: [/.*\\(.*ENVELOPE/]}, Parse::RecDescent::_tracefirst($text), + q{envelope}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:.*\(.*ENVELOPE)//) + { + + $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 subrule: [envelopestruct]}, + Parse::RecDescent::_tracefirst($text), + q{envelope}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{envelopestruct})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::envelopestruct($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{envelope}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [envelopestruct]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{envelope}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{envelopestruct}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying terminal: [/.*\\)/]}, Parse::RecDescent::_tracefirst($text), + q{envelope}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{/.*\\)/})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:.*\))//) + { + + $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{__PATTERN2__}=$&; + + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{envelope}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { + $return = $item{envelopestruct} ; + $return||defined($return) ; + }; + 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: [/.*\\(.*ENVELOPE/ envelopestruct /.*\\)/]<<}, + Parse::RecDescent::_tracefirst($text), + q{envelope}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{envelope}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{envelope}, + $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{envelope}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{envelope}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::MESSAGE +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"MESSAGE"}; + + Parse::RecDescent::_trace(q{Trying rule: [MESSAGE]}, + Parse::RecDescent::_tracefirst($_[1]), + q{MESSAGE}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [/^"MESSAGE"|^MESSAGE/i]}, + Parse::RecDescent::_tracefirst($_[1]), + q{MESSAGE}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{MESSAGE}); + %item = (__RULE__ => q{MESSAGE}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: [/^"MESSAGE"|^MESSAGE/i]}, Parse::RecDescent::_tracefirst($text), + q{MESSAGE}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:^"MESSAGE"|^MESSAGE)//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 action}, + Parse::RecDescent::_tracefirst($text), + q{MESSAGE}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = "MESSAGE" }; + 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: [/^"MESSAGE"|^MESSAGE/i]<<}, + Parse::RecDescent::_tracefirst($text), + q{MESSAGE}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{MESSAGE}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{MESSAGE}, + $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{MESSAGE}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{MESSAGE}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::DOUBLE_QUOTED_STRING +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"DOUBLE_QUOTED_STRING"}; + + Parse::RecDescent::_trace(q{Trying rule: [DOUBLE_QUOTED_STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{DOUBLE_QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: ['"' /(?:\\\\"|[^"])*/ '"']}, + Parse::RecDescent::_tracefirst($_[1]), + q{DOUBLE_QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{DOUBLE_QUOTED_STRING}); + %item = (__RULE__ => q{DOUBLE_QUOTED_STRING}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: ['"']}, + Parse::RecDescent::_tracefirst($text), + q{DOUBLE_QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A\"//) + { + + $expectation->failed(); + Parse::RecDescent::_trace(qq{<>}, + 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{__STRING1__}=$&; + + + Parse::RecDescent::_trace(q{Trying terminal: [/(?:\\\\"|[^"])*/]}, Parse::RecDescent::_tracefirst($text), + q{DOUBLE_QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{/(?:\\\\"|[^"])*/})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:(?:\\"|[^"])*)//) + { + + $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 terminal: ['"']}, + Parse::RecDescent::_tracefirst($text), + q{DOUBLE_QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{'"'})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A\"//) + { + + $expectation->failed(); + Parse::RecDescent::_trace(qq{<>}, + 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{__STRING2__}=$&; + + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{DOUBLE_QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { + + $return = $item{__PATTERN1__} ; + $return||defined($return); +}; + 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: ['"' /(?:\\\\"|[^"])*/ '"']<<}, + Parse::RecDescent::_tracefirst($text), + q{DOUBLE_QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{DOUBLE_QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{DOUBLE_QUOTED_STRING}, + $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{DOUBLE_QUOTED_STRING}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{DOUBLE_QUOTED_STRING}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::subject +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"subject"}; + + Parse::RecDescent::_trace(q{Trying rule: [subject]}, + Parse::RecDescent::_tracefirst($_[1]), + q{subject}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{subject}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{subject}); + %item = (__RULE__ => q{subject}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{subject}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{subject}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{subject}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{subject}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{subject}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{subject}); + %item = (__RULE__ => q{subject}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [STRING]}, + Parse::RecDescent::_tracefirst($text), + q{subject}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::STRING($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{subject}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [STRING]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{subject}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{STRING}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{subject}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { + $return = $item{NIL} || $item{STRING} ; + $return||defined($return); + }; + 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: [STRING]<<}, + Parse::RecDescent::_tracefirst($text), + q{subject}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{subject}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{subject}, + $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{subject}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{subject}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::value +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"value"}; + + Parse::RecDescent::_trace(q{Trying rule: [value]}, + Parse::RecDescent::_tracefirst($_[1]), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{value}); + %item = (__RULE__ => q{value}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: ['(' kvpair ')']}, + Parse::RecDescent::_tracefirst($_[1]), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{value}); + %item = (__RULE__ => q{value}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: ['(']}, + Parse::RecDescent::_tracefirst($text), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A\(//) + { + + $expectation->failed(); + Parse::RecDescent::_trace(qq{<>}, + 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{__STRING1__}=$&; + + + + + Parse::RecDescent::_trace(q{Trying directive: []}, + Parse::RecDescent::_tracefirst($text), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + $_tok = do { $commit = 1 }; + if (defined($_tok)) + { + Parse::RecDescent::_trace(q{>>Matched directive<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + } + else + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + } + + last unless defined $_tok; + push @item, $item{__DIRECTIVE1__}=$_tok; + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [kvpair]}, + Parse::RecDescent::_tracefirst($text), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{kvpair})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::kvpair, 1, 100000000, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [kvpair]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{kvpair(s)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying terminal: [')']}, + Parse::RecDescent::_tracefirst($text), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{')'})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A\)//) + { + + $expectation->failed(); + Parse::RecDescent::_trace(qq{<>}, + 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{__STRING2__}=$&; + + + + Parse::RecDescent::_trace(q{>>Matched production: ['(' kvpair ')']<<}, + Parse::RecDescent::_tracefirst($text), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [NUMBER]}, + Parse::RecDescent::_tracefirst($_[1]), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[2]; + $text = $_[1]; + my $_savetext; + @item = (q{value}); + %item = (__RULE__ => q{value}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NUMBER]}, + Parse::RecDescent::_tracefirst($text), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NUMBER($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NUMBER]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NUMBER}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NUMBER]<<}, + Parse::RecDescent::_tracefirst($text), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[3]; + $text = $_[1]; + my $_savetext; + @item = (q{value}); + %item = (__RULE__ => q{value}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [STRING]}, + Parse::RecDescent::_tracefirst($text), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::STRING($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [STRING]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{STRING}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = $item{NIL} || + $item{NUMBER} || + $item{STRING} || + { map { (%$_) } @{$item{'kvpair(s)'}} } ; + $return||defined($return); + }; + 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: [STRING]<<}, + Parse::RecDescent::_tracefirst($text), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{value}, + $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{value}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{value}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::inreplyto +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"inreplyto"}; + + Parse::RecDescent::_trace(q{Trying rule: [inreplyto]}, + Parse::RecDescent::_tracefirst($_[1]), + q{inreplyto}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{inreplyto}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{inreplyto}); + %item = (__RULE__ => q{inreplyto}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{inreplyto}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{inreplyto}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{inreplyto}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{inreplyto}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{inreplyto}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{inreplyto}); + %item = (__RULE__ => q{inreplyto}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [STRING]}, + Parse::RecDescent::_tracefirst($text), + q{inreplyto}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::STRING($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{inreplyto}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [STRING]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{inreplyto}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{STRING}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{inreplyto}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = $item{NIL} || $item{STRING} ;$return||defined($return);}; + 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: [STRING]<<}, + Parse::RecDescent::_tracefirst($text), + q{inreplyto}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{inreplyto}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{inreplyto}, + $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{inreplyto}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{inreplyto}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::messageid +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"messageid"}; + + Parse::RecDescent::_trace(q{Trying rule: [messageid]}, + Parse::RecDescent::_tracefirst($_[1]), + q{messageid}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{messageid}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{messageid}); + %item = (__RULE__ => q{messageid}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{messageid}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{messageid}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{messageid}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{messageid}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{messageid}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{messageid}); + %item = (__RULE__ => q{messageid}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [STRING]}, + Parse::RecDescent::_tracefirst($text), + q{messageid}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::STRING($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{messageid}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [STRING]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{messageid}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{STRING}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{messageid}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = $item{NIL} || $item{STRING} ;$return||defined($return);}; + 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: [STRING]<<}, + Parse::RecDescent::_tracefirst($text), + q{messageid}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{messageid}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{messageid}, + $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{messageid}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{messageid}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::sender +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"sender"}; + + Parse::RecDescent::_trace(q{Trying rule: [sender]}, + Parse::RecDescent::_tracefirst($_[1]), + q{sender}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{sender}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{sender}); + %item = (__RULE__ => q{sender}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{sender}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{sender}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{sender}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{sender}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: ['(' addressstruct ')']}, + Parse::RecDescent::_tracefirst($_[1]), + q{sender}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{sender}); + %item = (__RULE__ => q{sender}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: ['(']}, + Parse::RecDescent::_tracefirst($text), + q{sender}, + $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: [addressstruct]}, + Parse::RecDescent::_tracefirst($text), + q{sender}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{addressstruct})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::addressstruct, 1, 100000000, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{sender}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [addressstruct]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{sender}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{addressstruct(s)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying terminal: [')']}, + Parse::RecDescent::_tracefirst($text), + q{sender}, + $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{sender}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = $item{NIL} || $item{'addressstruct(s)'} }; + 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: ['(' addressstruct ')']<<}, + Parse::RecDescent::_tracefirst($text), + q{sender}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{sender}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{sender}, + $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{sender}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{sender}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::QUOTED_STRING +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"QUOTED_STRING"}; + + Parse::RecDescent::_trace(q{Trying rule: [QUOTED_STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [DOUBLE_QUOTED_STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{QUOTED_STRING}); + %item = (__RULE__ => q{QUOTED_STRING}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [DOUBLE_QUOTED_STRING]}, + Parse::RecDescent::_tracefirst($text), + q{QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::DOUBLE_QUOTED_STRING($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [DOUBLE_QUOTED_STRING]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{DOUBLE_QUOTED_STRING}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [DOUBLE_QUOTED_STRING]<<}, + Parse::RecDescent::_tracefirst($text), + q{QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [SINGLE_QUOTED_STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{QUOTED_STRING}); + %item = (__RULE__ => q{QUOTED_STRING}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [SINGLE_QUOTED_STRING]}, + Parse::RecDescent::_tracefirst($text), + q{QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::SINGLE_QUOTED_STRING($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [SINGLE_QUOTED_STRING]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{SINGLE_QUOTED_STRING}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { + + $return = $item{DOUBLE_QUOTED_STRING}||$item{SINGLE_QUOTED_STRING} ; + $return||defined($return); +}; + 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: [SINGLE_QUOTED_STRING]<<}, + Parse::RecDescent::_tracefirst($text), + q{QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{QUOTED_STRING}, + $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{QUOTED_STRING}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{QUOTED_STRING}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::messagerfc822message +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"messagerfc822message"}; + + Parse::RecDescent::_trace(q{Trying rule: [messagerfc822message]}, + Parse::RecDescent::_tracefirst($_[1]), + q{messagerfc822message}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [rfc822message bodyparms bodyid bodydesc bodyenc bodysize envelopestruct bodystructure textlines bodyMD5 bodydisp bodylang]}, + Parse::RecDescent::_tracefirst($_[1]), + q{messagerfc822message}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{messagerfc822message}); + %item = (__RULE__ => q{messagerfc822message}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [rfc822message]}, + Parse::RecDescent::_tracefirst($text), + q{messagerfc822message}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::rfc822message($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{messagerfc822message}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [rfc822message]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{messagerfc822message}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{rfc822message}} = $_tok; + push @item, $_tok; + + } + + + + Parse::RecDescent::_trace(q{Trying directive: []}, + Parse::RecDescent::_tracefirst($text), + q{messagerfc822message}, + $tracelevel) + if defined $::RD_TRACE; + $_tok = do { $commit = 1 }; + if (defined($_tok)) + { + Parse::RecDescent::_trace(q{>>Matched directive<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + } + else + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + } + + last unless defined $_tok; + push @item, $item{__DIRECTIVE1__}=$_tok; + + + Parse::RecDescent::_trace(q{Trying subrule: [bodyparms]}, + Parse::RecDescent::_tracefirst($text), + q{messagerfc822message}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{bodyparms})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodyparms($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{messagerfc822message}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [bodyparms]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{messagerfc822message}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodyparms}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying subrule: [bodyid]}, + Parse::RecDescent::_tracefirst($text), + q{messagerfc822message}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{bodyid})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodyid($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{messagerfc822message}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [bodyid]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{messagerfc822message}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodyid}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying subrule: [bodydesc]}, + Parse::RecDescent::_tracefirst($text), + q{messagerfc822message}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{bodydesc})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodydesc($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{messagerfc822message}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [bodydesc]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{messagerfc822message}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodydesc}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying subrule: [bodyenc]}, + Parse::RecDescent::_tracefirst($text), + q{messagerfc822message}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{bodyenc})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodyenc($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{messagerfc822message}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [bodyenc]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{messagerfc822message}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodyenc}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying subrule: [bodysize]}, + Parse::RecDescent::_tracefirst($text), + q{messagerfc822message}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{bodysize})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodysize($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{messagerfc822message}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [bodysize]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{messagerfc822message}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodysize}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying subrule: [envelopestruct]}, + Parse::RecDescent::_tracefirst($text), + q{messagerfc822message}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{envelopestruct})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::envelopestruct($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{messagerfc822message}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [envelopestruct]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{messagerfc822message}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{envelopestruct}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying subrule: [bodystructure]}, + Parse::RecDescent::_tracefirst($text), + q{messagerfc822message}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{bodystructure})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodystructure($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{messagerfc822message}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [bodystructure]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{messagerfc822message}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodystructure}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying subrule: [textlines]}, + Parse::RecDescent::_tracefirst($text), + q{messagerfc822message}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{textlines})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::textlines($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{messagerfc822message}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [textlines]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{messagerfc822message}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{textlines}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying repeated subrule: [bodyMD5]}, + Parse::RecDescent::_tracefirst($text), + q{messagerfc822message}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{bodyMD5})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodyMD5, 0, 1, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{messagerfc822message}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodyMD5]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{messagerfc822message}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodyMD5(?)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [bodydisp]}, + Parse::RecDescent::_tracefirst($text), + q{messagerfc822message}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{bodydisp})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodydisp, 0, 1, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{messagerfc822message}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodydisp]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{messagerfc822message}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodydisp(?)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [bodylang]}, + Parse::RecDescent::_tracefirst($text), + q{messagerfc822message}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{bodylang})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodylang, 0, 1, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{messagerfc822message}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodylang]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{messagerfc822message}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodylang(?)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{messagerfc822message}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { + $return = {}; + foreach my $what (qw/ bodyparms bodyid bodydesc bodyenc bodysize + envelopestruct bodystructure textlines + bodyMD5(?) bodydisp(?) bodylang(?) + / + ) { + my $k = $what; $k =~ s/\(\?\)$//; + $return->{$k} = ref $item{$what} =~ 'ARRAY'? + $item{$what}[0] : $item{$what}; + } + while ( my($k,$v) = each %{$item{bodystructure}[0]} ) { $return->{$k} = $v } + while ( my($k,$v) = each %{$item{basicfields}} ) { $return->{$k} = $v } + $return->{bodytype} = "MESSAGE" ; + $return->{bodysubtype}= "RFC822" ; + $return||defined($return); + }; + 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: [rfc822message bodyparms bodyid bodydesc bodyenc bodysize envelopestruct bodystructure textlines bodyMD5 bodydisp bodylang]<<}, + Parse::RecDescent::_tracefirst($text), + q{messagerfc822message}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{messagerfc822message}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{messagerfc822message}, + $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{messagerfc822message}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{messagerfc822message}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodyenc +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"bodyenc"}; + + Parse::RecDescent::_trace(q{Trying rule: [bodyenc]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodyenc}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodyenc}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{bodyenc}); + %item = (__RULE__ => q{bodyenc}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{bodyenc}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodyenc}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodyenc}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodyenc}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodyenc}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{bodyenc}); + %item = (__RULE__ => q{bodyenc}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [STRING]}, + Parse::RecDescent::_tracefirst($text), + q{bodyenc}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::STRING($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodyenc}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [STRING]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodyenc}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{STRING}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [STRING]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodyenc}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: ['(' kvpair ')']}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodyenc}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[2]; + $text = $_[1]; + my $_savetext; + @item = (q{bodyenc}); + %item = (__RULE__ => q{bodyenc}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: ['(']}, + Parse::RecDescent::_tracefirst($text), + q{bodyenc}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A\(//) + { + + $expectation->failed(); + Parse::RecDescent::_trace(qq{<>}, + 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{__STRING1__}=$&; + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [kvpair]}, + Parse::RecDescent::_tracefirst($text), + q{bodyenc}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{kvpair})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::kvpair, 1, 100000000, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodyenc}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [kvpair]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{bodyenc}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{kvpair(s)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying terminal: [')']}, + Parse::RecDescent::_tracefirst($text), + q{bodyenc}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{')'})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A\)//) + { + + $expectation->failed(); + Parse::RecDescent::_trace(qq{<>}, + 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{__STRING2__}=$&; + + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{bodyenc}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { + $return = $item{NIL} || + $item{STRING} || + { map { (%$_) } @{$item{'kvpair(s)'}} }; + $return||defined($return); + }; + 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: ['(' kvpair ')']<<}, + Parse::RecDescent::_tracefirst($text), + q{bodyenc}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodyenc}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{bodyenc}, + $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{bodyenc}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{bodyenc}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodydesc +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"bodydesc"}; + + Parse::RecDescent::_trace(q{Trying rule: [bodydesc]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodydesc}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [/[()]/ NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodydesc}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{bodydesc}); + %item = (__RULE__ => q{bodydesc}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: [/[()]/]}, Parse::RecDescent::_tracefirst($text), + q{bodydesc}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + $_savetext = $text; + + if ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:[()])//) + { + $text = $_savetext; + $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__}=$&; + $text = $_savetext; + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{bodydesc}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{NIL})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodydesc}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodydesc}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [/[()]/ NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodydesc}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodydesc}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{bodydesc}); + %item = (__RULE__ => q{bodydesc}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [STRING]}, + Parse::RecDescent::_tracefirst($text), + q{bodydesc}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::STRING($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodydesc}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [STRING]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodydesc}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{STRING}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{bodydesc}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = $item{NIL} || $item{STRING} ; $return||defined($return);}; + 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: [STRING]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodydesc}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodydesc}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{bodydesc}, + $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{bodydesc}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{bodydesc}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::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 $def_at = @{$thisparser->{deferred}}; + 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: [/.*\\(.*BODYSTRUCTURE \\(/i part /\\).*\\)\\r?\\n?/]}, + 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: [/.*\\(.*BODYSTRUCTURE \\(/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(?:.*\(.*BODYSTRUCTURE \()//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: [part]}, + Parse::RecDescent::_tracefirst($text), + q{start}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{part})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::part, 1, 1, $_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: [part]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{start}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{part(1)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying terminal: [/\\).*\\)\\r?\\n?/]}, Parse::RecDescent::_tracefirst($text), + q{start}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{/\\).*\\)\\r?\\n?/})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:\).*\)\r?\n?)//) + { + + $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{__PATTERN2__}=$&; + + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{start}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { + #print STDERR "item = ",Data::Dumper->Dump([\%item],['$item']); + $return = $item{'part(1)'}[0]; + $return||defined($return); + }; + 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: [/.*\\(.*BODYSTRUCTURE \\(/i part /\\).*\\)\\r?\\n?/]<<}, + Parse::RecDescent::_tracefirst($text), + q{start}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[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::BodyStructure::Parse::RFC822 +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"RFC822"}; + + Parse::RecDescent::_trace(q{Trying rule: [RFC822]}, + Parse::RecDescent::_tracefirst($_[1]), + q{RFC822}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [/^"RFC822"|^RFC822/i]}, + Parse::RecDescent::_tracefirst($_[1]), + q{RFC822}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{RFC822}); + %item = (__RULE__ => q{RFC822}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: [/^"RFC822"|^RFC822/i]}, Parse::RecDescent::_tracefirst($text), + q{RFC822}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:^"RFC822"|^RFC822)//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 action}, + Parse::RecDescent::_tracefirst($text), + q{RFC822}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = "RFC822" }; + 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: [/^"RFC822"|^RFC822/i]<<}, + Parse::RecDescent::_tracefirst($text), + q{RFC822}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{RFC822}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{RFC822}, + $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{RFC822}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{RFC822}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::textmessage +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"textmessage"}; + + Parse::RecDescent::_trace(q{Trying rule: [textmessage]}, + Parse::RecDescent::_tracefirst($_[1]), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [TEXT basicfields textlines bodyMD5 bodydisp bodylang]}, + Parse::RecDescent::_tracefirst($_[1]), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{textmessage}); + %item = (__RULE__ => q{textmessage}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [TEXT]}, + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::TEXT($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [TEXT]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{TEXT}} = $_tok; + push @item, $_tok; + + } + + + + Parse::RecDescent::_trace(q{Trying directive: []}, + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + $_tok = do { $commit = 1 }; + if (defined($_tok)) + { + Parse::RecDescent::_trace(q{>>Matched directive<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + } + else + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + } + + last unless defined $_tok; + push @item, $item{__DIRECTIVE1__}=$_tok; + + + Parse::RecDescent::_trace(q{Trying subrule: [basicfields]}, + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{basicfields})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::basicfields($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [basicfields]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{basicfields}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying repeated subrule: [textlines]}, + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{textlines})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::textlines, 0, 1, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [textlines]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{textlines(?)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [bodyMD5]}, + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{bodyMD5})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodyMD5, 0, 1, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodyMD5]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodyMD5(?)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [bodydisp]}, + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{bodydisp})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodydisp, 0, 1, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodydisp]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodydisp(?)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [bodylang]}, + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{bodylang})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodylang, 0, 1, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodylang]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodylang(?)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { + $return = $item{basicfields}||{}; + $return->{bodytype} = 'TEXT'; + foreach my $what (qw/textlines(?) bodyMD5(?) bodydisp(?) bodylang(?)/) { + my $k = $what; $k =~ s/\(\?\)$//; + ref($item{$what}) and $return->{$k} = $item{$what}[0]; + } + $return||defined($return); + }; + 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: [TEXT basicfields textlines bodyMD5 bodydisp bodylang]<<}, + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{textmessage}, + $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{textmessage}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{textmessage}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodyid +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"bodyid"}; + + Parse::RecDescent::_trace(q{Trying rule: [bodyid]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodyid}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [/[()]/ NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodyid}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{bodyid}); + %item = (__RULE__ => q{bodyid}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: [/[()]/]}, Parse::RecDescent::_tracefirst($text), + q{bodyid}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + $_savetext = $text; + + if ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:[()])//) + { + $text = $_savetext; + $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__}=$&; + $text = $_savetext; + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{bodyid}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{NIL})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodyid}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodyid}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [/[()]/ NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodyid}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodyid}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{bodyid}); + %item = (__RULE__ => q{bodyid}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [STRING]}, + Parse::RecDescent::_tracefirst($text), + q{bodyid}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::STRING($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodyid}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [STRING]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodyid}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{STRING}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{bodyid}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = $item{NIL} || $item{STRING} ; $return||defined($return);}; + 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: [STRING]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodyid}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodyid}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{bodyid}, + $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{bodyid}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{bodyid}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::othertypemessage +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"othertypemessage"}; + + Parse::RecDescent::_trace(q{Trying rule: [othertypemessage]}, + Parse::RecDescent::_tracefirst($_[1]), + q{othertypemessage}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [bodytype basicfields bodyparms bodydisp bodylang]}, + Parse::RecDescent::_tracefirst($_[1]), + q{othertypemessage}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{othertypemessage}); + %item = (__RULE__ => q{othertypemessage}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [bodytype]}, + Parse::RecDescent::_tracefirst($text), + q{othertypemessage}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodytype($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{othertypemessage}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [bodytype]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{othertypemessage}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodytype}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying subrule: [basicfields]}, + Parse::RecDescent::_tracefirst($text), + q{othertypemessage}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{basicfields})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::basicfields($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{othertypemessage}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [basicfields]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{othertypemessage}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{basicfields}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying repeated subrule: [bodyparms]}, + Parse::RecDescent::_tracefirst($text), + q{othertypemessage}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{bodyparms})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodyparms, 0, 1, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{othertypemessage}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodyparms]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{othertypemessage}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodyparms(?)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [bodydisp]}, + Parse::RecDescent::_tracefirst($text), + q{othertypemessage}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{bodydisp})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodydisp, 0, 1, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{othertypemessage}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodydisp]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{othertypemessage}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodydisp(?)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [bodylang]}, + Parse::RecDescent::_tracefirst($text), + q{othertypemessage}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{bodylang})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodylang, 0, 1, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{othertypemessage}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodylang]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{othertypemessage}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodylang(?)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{othertypemessage}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = {}; + foreach my $what (qw/bodytype bodyparms(?) bodydisp(?) bodylang(?)/) { + my $k = $what; $k =~ s/\(\?\)$//; + $return->{$k} = ref($item{$what})? $item{$what}[0] : $item{$what} ; + } + while ( my($k,$v) = each %{$item{basicfields}} ) { $return->{$k} = $v } + $return||defined($return); + }; + 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: [bodytype basicfields bodyparms bodydisp bodylang]<<}, + Parse::RecDescent::_tracefirst($text), + q{othertypemessage}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{othertypemessage}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{othertypemessage}, + $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{othertypemessage}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{othertypemessage}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::kvpair +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"kvpair"}; + + Parse::RecDescent::_trace(q{Trying rule: [kvpair]}, + Parse::RecDescent::_tracefirst($_[1]), + q{kvpair}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [')' key value]}, + Parse::RecDescent::_tracefirst($_[1]), + q{kvpair}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{kvpair}); + %item = (__RULE__ => q{kvpair}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: [')']}, + Parse::RecDescent::_tracefirst($text), + q{kvpair}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + $_savetext = $text; + + if ($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; } + ) + { + $text = $_savetext; + $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; + $text = $_savetext; + + Parse::RecDescent::_trace(q{Trying subrule: [key]}, + Parse::RecDescent::_tracefirst($text), + q{kvpair}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{key})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::key($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{kvpair}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [key]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{kvpair}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{key}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying subrule: [value]}, + Parse::RecDescent::_tracefirst($text), + q{kvpair}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{value})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::value($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{kvpair}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [value]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{kvpair}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{value}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{kvpair}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = { $item{key} => $item{value} }; $return||defined($return);}; + 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: [')' key value]<<}, + Parse::RecDescent::_tracefirst($text), + q{kvpair}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{kvpair}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{kvpair}, + $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{kvpair}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{kvpair}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodysize +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"bodysize"}; + + Parse::RecDescent::_trace(q{Trying rule: [bodysize]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodysize}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [/[()]/ NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodysize}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{bodysize}); + %item = (__RULE__ => q{bodysize}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: [/[()]/]}, Parse::RecDescent::_tracefirst($text), + q{bodysize}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + $_savetext = $text; + + if ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:[()])//) + { + $text = $_savetext; + $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__}=$&; + $text = $_savetext; + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{bodysize}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{NIL})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodysize}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodysize}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [/[()]/ NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodysize}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [NUMBER]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodysize}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{bodysize}); + %item = (__RULE__ => q{bodysize}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NUMBER]}, + Parse::RecDescent::_tracefirst($text), + q{bodysize}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NUMBER($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodysize}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NUMBER]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodysize}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NUMBER}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{bodysize}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = $item{NIL} || $item{NUMBER} ;$return||defined($return);}; + 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{bodysize}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodysize}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{bodysize}, + $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{bodysize}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{bodysize}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::STRING +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"STRING"}; + + Parse::RecDescent::_trace(q{Trying rule: [STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{STRING}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [QUOTED_STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{STRING}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{STRING}); + %item = (__RULE__ => q{STRING}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [QUOTED_STRING]}, + Parse::RecDescent::_tracefirst($text), + q{STRING}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::QUOTED_STRING($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{STRING}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [QUOTED_STRING]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{STRING}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{QUOTED_STRING}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [QUOTED_STRING]<<}, + Parse::RecDescent::_tracefirst($text), + q{STRING}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [BARESTRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{STRING}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{STRING}); + %item = (__RULE__ => q{STRING}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [BARESTRING]}, + Parse::RecDescent::_tracefirst($text), + q{STRING}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::BARESTRING($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{STRING}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [BARESTRING]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{STRING}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{BARESTRING}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{STRING}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { + $return = $item{QUOTED_STRING}||$item{BARESTRING} ; + $return||defined($return); +}; + 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: [BARESTRING]<<}, + Parse::RecDescent::_tracefirst($text), + q{STRING}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{STRING}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{STRING}, + $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{STRING}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{STRING}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodytype +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"bodytype"}; + + Parse::RecDescent::_trace(q{Trying rule: [bodytype]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodytype}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodytype}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{bodytype}); + %item = (__RULE__ => q{bodytype}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [STRING]}, + Parse::RecDescent::_tracefirst($text), + q{bodytype}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::STRING($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodytype}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [STRING]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodytype}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{STRING}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{bodytype}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = $item{STRING} ; $return||defined($return);}; + 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: [STRING]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodytype}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodytype}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{bodytype}, + $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{bodytype}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{bodytype}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::TEXT +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"TEXT"}; + + Parse::RecDescent::_trace(q{Trying rule: [TEXT]}, + Parse::RecDescent::_tracefirst($_[1]), + q{TEXT}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [/^"TEXT"|^TEXT/i]}, + Parse::RecDescent::_tracefirst($_[1]), + q{TEXT}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{TEXT}); + %item = (__RULE__ => q{TEXT}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: [/^"TEXT"|^TEXT/i]}, Parse::RecDescent::_tracefirst($text), + q{TEXT}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:^"TEXT"|^TEXT)//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 action}, + Parse::RecDescent::_tracefirst($text), + q{TEXT}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = "TEXT" }; + 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: [/^"TEXT"|^TEXT/i]<<}, + Parse::RecDescent::_tracefirst($text), + q{TEXT}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{TEXT}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{TEXT}, + $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{TEXT}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{TEXT}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::to +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"to"}; + + Parse::RecDescent::_trace(q{Trying rule: [to]}, + Parse::RecDescent::_tracefirst($_[1]), + q{to}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{to}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{to}); + %item = (__RULE__ => q{to}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{to}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{to}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{to}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{to}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: ['(' addressstruct ')']}, + Parse::RecDescent::_tracefirst($_[1]), + q{to}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{to}); + %item = (__RULE__ => q{to}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: ['(']}, + Parse::RecDescent::_tracefirst($text), + q{to}, + $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: [addressstruct]}, + Parse::RecDescent::_tracefirst($text), + q{to}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{addressstruct})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::addressstruct, 1, 100000000, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{to}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [addressstruct]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{to}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{addressstruct(s)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying terminal: [')']}, + Parse::RecDescent::_tracefirst($text), + q{to}, + $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{to}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = $item{NIL} || $item{'addressstruct(s)'} }; + 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: ['(' addressstruct ')']<<}, + Parse::RecDescent::_tracefirst($text), + q{to}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{to}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{to}, + $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{to}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{to}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"NIL"}; + + Parse::RecDescent::_trace(q{Trying rule: [NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{NIL}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [/^NIL/i]}, + Parse::RecDescent::_tracefirst($_[1]), + q{NIL}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{NIL}); + %item = (__RULE__ => q{NIL}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: [/^NIL/i]}, Parse::RecDescent::_tracefirst($text), + q{NIL}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:^NIL)//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 action}, + Parse::RecDescent::_tracefirst($text), + q{NIL}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = "NIL" }; + 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: [/^NIL/i]<<}, + Parse::RecDescent::_tracefirst($text), + q{NIL}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{NIL}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{NIL}, + $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{NIL}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{NIL}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::from +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"from"}; + + Parse::RecDescent::_trace(q{Trying rule: [from]}, + Parse::RecDescent::_tracefirst($_[1]), + q{from}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{from}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{from}); + %item = (__RULE__ => q{from}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{from}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{from}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{from}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{from}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: ['(' addressstruct ')']}, + Parse::RecDescent::_tracefirst($_[1]), + q{from}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{from}); + %item = (__RULE__ => q{from}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: ['(']}, + Parse::RecDescent::_tracefirst($text), + q{from}, + $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: [addressstruct]}, + Parse::RecDescent::_tracefirst($text), + q{from}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{addressstruct})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::addressstruct, 1, 100000000, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{from}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [addressstruct]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{from}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{addressstruct(s)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying terminal: [')']}, + Parse::RecDescent::_tracefirst($text), + q{from}, + $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{from}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = $item{NIL} || $item{'addressstruct(s)'} }; + 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: ['(' addressstruct ')']<<}, + Parse::RecDescent::_tracefirst($text), + q{from}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{from}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{from}, + $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{from}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{from}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodystructure +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"bodystructure"}; + + Parse::RecDescent::_trace(q{Trying rule: [bodystructure]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodystructure}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: ['(' part ')']}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodystructure}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{bodystructure}); + %item = (__RULE__ => q{bodystructure}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: ['(']}, + Parse::RecDescent::_tracefirst($text), + q{bodystructure}, + $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: [part]}, + Parse::RecDescent::_tracefirst($text), + q{bodystructure}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{part})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::part, 1, 100000000, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodystructure}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [part]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{bodystructure}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{part(s)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying terminal: [')']}, + Parse::RecDescent::_tracefirst($text), + q{bodystructure}, + $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{bodystructure}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { + $return = $item{'part(s)'} ; + $return||defined($return); + }; + 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: ['(' part ')']<<}, + Parse::RecDescent::_tracefirst($text), + q{bodystructure}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodystructure}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{bodystructure}, + $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{bodystructure}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{bodystructure}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::PLAIN +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"PLAIN"}; + + Parse::RecDescent::_trace(q{Trying rule: [PLAIN]}, + Parse::RecDescent::_tracefirst($_[1]), + q{PLAIN}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [/^"PLAIN"|^PLAIN/i]}, + Parse::RecDescent::_tracefirst($_[1]), + q{PLAIN}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{PLAIN}); + %item = (__RULE__ => q{PLAIN}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: [/^"PLAIN"|^PLAIN/i]}, Parse::RecDescent::_tracefirst($text), + q{PLAIN}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:^"PLAIN"|^PLAIN)//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 action}, + Parse::RecDescent::_tracefirst($text), + q{PLAIN}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = "PLAIN" }; + 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: [/^"PLAIN"|^PLAIN/i]<<}, + Parse::RecDescent::_tracefirst($text), + q{PLAIN}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{PLAIN}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{PLAIN}, + $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{PLAIN}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{PLAIN}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::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 $def_at = @{$thisparser->{deferred}}; + 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{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{NUMBER}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = $item[1]; $return||defined($return);}; + 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: [/^(\\d+)/]<<}, + Parse::RecDescent::_tracefirst($text), + q{NUMBER}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[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::BodyStructure::Parse::HTML +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"HTML"}; + + Parse::RecDescent::_trace(q{Trying rule: [HTML]}, + Parse::RecDescent::_tracefirst($_[1]), + q{HTML}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [/"HTML"|HTML/i]}, + Parse::RecDescent::_tracefirst($_[1]), + q{HTML}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{HTML}); + %item = (__RULE__ => q{HTML}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: [/"HTML"|HTML/i]}, Parse::RecDescent::_tracefirst($text), + q{HTML}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:"HTML"|HTML)//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 action}, + Parse::RecDescent::_tracefirst($text), + q{HTML}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = "HTML" }; + 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: [/"HTML"|HTML/i]<<}, + Parse::RecDescent::_tracefirst($text), + q{HTML}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{HTML}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{HTML}, + $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{HTML}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{HTML}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodydisp +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"bodydisp"}; + + Parse::RecDescent::_trace(q{Trying rule: [bodydisp]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodydisp}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodydisp}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{bodydisp}); + %item = (__RULE__ => q{bodydisp}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{bodydisp}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodydisp}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodydisp}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodydisp}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: ['(' kvpair ')']}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodydisp}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{bodydisp}); + %item = (__RULE__ => q{bodydisp}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: ['(']}, + Parse::RecDescent::_tracefirst($text), + q{bodydisp}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A\(//) + { + + $expectation->failed(); + Parse::RecDescent::_trace(qq{<>}, + 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{__STRING1__}=$&; + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [kvpair]}, + Parse::RecDescent::_tracefirst($text), + q{bodydisp}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{kvpair})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::kvpair, 1, 100000000, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodydisp}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [kvpair]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{bodydisp}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{kvpair(s)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying terminal: [')']}, + Parse::RecDescent::_tracefirst($text), + q{bodydisp}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{')'})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A\)//) + { + + $expectation->failed(); + Parse::RecDescent::_trace(qq{<>}, + 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{__STRING2__}=$&; + + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{bodydisp}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { + $return = $item{NIL} || + { map { (%$_) } @{$item{'kvpair(s)'}} }; + $return || defined($return); + }; + 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: ['(' kvpair ')']<<}, + Parse::RecDescent::_tracefirst($text), + q{bodydisp}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodydisp}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{bodydisp}, + $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{bodydisp}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{bodydisp}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::part +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"part"}; + + Parse::RecDescent::_trace(q{Trying rule: [part]}, + Parse::RecDescent::_tracefirst($_[1]), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [subpart basicfields bodyparms bodydisp bodylang ]}, + Parse::RecDescent::_tracefirst($_[1]), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{part}); + %item = (__RULE__ => q{part}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [subpart]}, + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::subpart, 1, 100000000, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [subpart]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{subpart(s)}} = $_tok; + push @item, $_tok; + + + + + + Parse::RecDescent::_trace(q{Trying directive: []}, + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + $_tok = do { $commit = 1 }; + if (defined($_tok)) + { + Parse::RecDescent::_trace(q{>>Matched directive<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + } + else + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + } + + last unless defined $_tok; + push @item, $item{__DIRECTIVE1__}=$_tok; + + + Parse::RecDescent::_trace(q{Trying subrule: [basicfields]}, + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{basicfields})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::basicfields($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [basicfields]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{basicfields}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying repeated subrule: [bodyparms]}, + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{bodyparms})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodyparms, 0, 1, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodyparms]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodyparms(?)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [bodydisp]}, + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{bodydisp})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodydisp, 0, 1, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodydisp]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodydisp(?)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [bodylang]}, + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{bodylang})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodylang, 0, 1, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodylang]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodylang(?)}} = $_tok; + push @item, $_tok; + + + + + + Parse::RecDescent::_trace(q{Trying directive: []}, + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + $_tok = do { push @{$thisparser->{deferred}}, sub { $subpartCount = 0 }; }; + if (defined($_tok)) + { + Parse::RecDescent::_trace(q{>>Matched directive<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + } + else + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + } + + last unless defined $_tok; + push @item, $item{__DIRECTIVE2__}=$_tok; + + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { + $return = bless($item{basicfields}, + "Mail::IMAPClient::BodyStructure"); + $return->{bodytype} = "MULTIPART"; + $return->{bodystructure} = $item{'subpart(s)'}; + foreach my $b (qw/bodyparms(?) bodydisp(?) bodylang(?)/) { + my $k = $b; $k =~ s/\(\?\)$//; + $return->{$k} = ref($item{$b}) ? $item{$b}[0] : $item{$b}; + } + $return||defined($return) ; + }; + 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: [subpart basicfields bodyparms bodydisp bodylang ]<<}, + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [textmessage]}, + Parse::RecDescent::_tracefirst($_[1]), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{part}); + %item = (__RULE__ => q{part}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [textmessage]}, + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::textmessage($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [textmessage]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{textmessage}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { + $return = bless $item{textmessage}, "Mail::IMAPClient::BodyStructure"; + $return||defined($return); + }; + 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: [textmessage]<<}, + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [messagerfc822message]}, + Parse::RecDescent::_tracefirst($_[1]), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[2]; + $text = $_[1]; + my $_savetext; + @item = (q{part}); + %item = (__RULE__ => q{part}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [messagerfc822message]}, + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::messagerfc822message($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [messagerfc822message]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{messagerfc822message}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { + $return = bless $item{messagerfc822message}, "Mail::IMAPClient::BodyStructure"; + $return||defined($return); + }; + 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: [messagerfc822message]<<}, + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [othertypemessage]}, + Parse::RecDescent::_tracefirst($_[1]), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[3]; + $text = $_[1]; + my $_savetext; + @item = (q{part}); + %item = (__RULE__ => q{part}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [othertypemessage]}, + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::othertypemessage($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [othertypemessage]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{othertypemessage}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { + $return = bless $item{othertypemessage}, "Mail::IMAPClient::BodyStructure"; + $return||defined($return); + }; + 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: [othertypemessage]<<}, + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{part}, + $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{part}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{part}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::SINGLE_QUOTED_STRING +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"SINGLE_QUOTED_STRING"}; + + Parse::RecDescent::_trace(q{Trying rule: [SINGLE_QUOTED_STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{SINGLE_QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [''' /(?:\\\\'|[^'])*/ ''']}, + Parse::RecDescent::_tracefirst($_[1]), + q{SINGLE_QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{SINGLE_QUOTED_STRING}); + %item = (__RULE__ => q{SINGLE_QUOTED_STRING}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: [''']}, + Parse::RecDescent::_tracefirst($text), + q{SINGLE_QUOTED_STRING}, + $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 terminal: [/(?:\\\\'|[^'])*/]}, Parse::RecDescent::_tracefirst($text), + q{SINGLE_QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{/(?:\\\\'|[^'])*/})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:(?:\\'|[^'])*)//) + { + + $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 terminal: [''']}, + Parse::RecDescent::_tracefirst($text), + q{SINGLE_QUOTED_STRING}, + $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{SINGLE_QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { + + $return = $item{__PATTERN1__} ; + $return||defined($return); +}; + 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: [''' /(?:\\\\'|[^'])*/ ''']<<}, + Parse::RecDescent::_tracefirst($text), + q{SINGLE_QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{SINGLE_QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{SINGLE_QUOTED_STRING}, + $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{SINGLE_QUOTED_STRING}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{SINGLE_QUOTED_STRING}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bcc +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"bcc"}; + + Parse::RecDescent::_trace(q{Trying rule: [bcc]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bcc}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bcc}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{bcc}); + %item = (__RULE__ => q{bcc}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{bcc}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bcc}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bcc}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{bcc}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: ['(' addressstruct ')']}, + Parse::RecDescent::_tracefirst($_[1]), + q{bcc}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{bcc}); + %item = (__RULE__ => q{bcc}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: ['(']}, + Parse::RecDescent::_tracefirst($text), + q{bcc}, + $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: [addressstruct]}, + Parse::RecDescent::_tracefirst($text), + q{bcc}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{addressstruct})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::addressstruct, 1, 100000000, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bcc}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [addressstruct]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{bcc}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{addressstruct(s)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying terminal: [')']}, + Parse::RecDescent::_tracefirst($text), + q{bcc}, + $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{bcc}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = $item{NIL} || $item{'addressstruct(s)'} }; + 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: ['(' addressstruct ')']<<}, + Parse::RecDescent::_tracefirst($text), + q{bcc}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{bcc}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{bcc}, + $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{bcc}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{bcc}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::rfc822message +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"rfc822message"}; + + Parse::RecDescent::_trace(q{Trying rule: [rfc822message]}, + Parse::RecDescent::_tracefirst($_[1]), + q{rfc822message}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [MESSAGE RFC822]}, + Parse::RecDescent::_tracefirst($_[1]), + q{rfc822message}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{rfc822message}); + %item = (__RULE__ => q{rfc822message}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [MESSAGE]}, + Parse::RecDescent::_tracefirst($text), + q{rfc822message}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::MESSAGE($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{rfc822message}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [MESSAGE]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{rfc822message}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{MESSAGE}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying subrule: [RFC822]}, + Parse::RecDescent::_tracefirst($text), + q{rfc822message}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{RFC822})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::RFC822($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{rfc822message}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [RFC822]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{rfc822message}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{RFC822}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{rfc822message}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = "MESSAGE RFC822" }; + 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: [MESSAGE RFC822]<<}, + Parse::RecDescent::_tracefirst($text), + q{rfc822message}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{rfc822message}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{rfc822message}, + $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{rfc822message}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{rfc822message}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::OLDSTRING +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"OLDSTRING"}; + + Parse::RecDescent::_trace(q{Trying rule: [OLDSTRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{OLDSTRING}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [/^"((?:[^"\\\\]|\\\\.)*)"/]}, + Parse::RecDescent::_tracefirst($_[1]), + q{OLDSTRING}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{OLDSTRING}); + %item = (__RULE__ => q{OLDSTRING}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: [/^"((?:[^"\\\\]|\\\\.)*)"/]}, Parse::RecDescent::_tracefirst($text), + q{OLDSTRING}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:^"((?:[^"\\]|\\.)*)")//) + { + + $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: [/^"((?:[^"\\\\]|\\\\.)*)"/]<<}, + Parse::RecDescent::_tracefirst($text), + q{OLDSTRING}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [/^([^ \\(\\)]+)/]}, + Parse::RecDescent::_tracefirst($_[1]), + q{OLDSTRING}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{OLDSTRING}); + %item = (__RULE__ => q{OLDSTRING}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: [/^([^ \\(\\)]+)/]}, Parse::RecDescent::_tracefirst($text), + q{OLDSTRING}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:^([^ \(\)]+))//) + { + + $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 action}, + Parse::RecDescent::_tracefirst($text), + q{OLDSTRING}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $item{__PATTERN1__} =~ s/^"(.*)"$/$1/; + $return = $item{__PATTERN1__} || $item{__PATTERN2__} ; + $return||defined($return); + }; + 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: [/^([^ \\(\\)]+)/]<<}, + Parse::RecDescent::_tracefirst($text), + q{OLDSTRING}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{OLDSTRING}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{OLDSTRING}, + $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{OLDSTRING}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{OLDSTRING}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::addressstruct +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"addressstruct"}; + + Parse::RecDescent::_trace(q{Trying rule: [addressstruct]}, + Parse::RecDescent::_tracefirst($_[1]), + q{addressstruct}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: ['(' personalname sourceroute mailboxname hostname ')']}, + Parse::RecDescent::_tracefirst($_[1]), + q{addressstruct}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{addressstruct}); + %item = (__RULE__ => q{addressstruct}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: ['(']}, + Parse::RecDescent::_tracefirst($text), + q{addressstruct}, + $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 subrule: [personalname]}, + Parse::RecDescent::_tracefirst($text), + q{addressstruct}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{personalname})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::personalname($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{addressstruct}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [personalname]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{addressstruct}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{personalname}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying subrule: [sourceroute]}, + Parse::RecDescent::_tracefirst($text), + q{addressstruct}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{sourceroute})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::sourceroute($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{addressstruct}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [sourceroute]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{addressstruct}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{sourceroute}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying subrule: [mailboxname]}, + Parse::RecDescent::_tracefirst($text), + q{addressstruct}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{mailboxname})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::mailboxname($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{addressstruct}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [mailboxname]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{addressstruct}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{mailboxname}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying subrule: [hostname]}, + Parse::RecDescent::_tracefirst($text), + q{addressstruct}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{hostname})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::hostname($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{addressstruct}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [hostname]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{addressstruct}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{hostname}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying terminal: [')']}, + Parse::RecDescent::_tracefirst($text), + q{addressstruct}, + $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{addressstruct}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = { + personalname => $item{personalname} , + sourceroute => $item{sourceroute} , + mailboxname => $item{mailboxname} , + hostname => $item{hostname} , + } ; + bless($return, "Mail::IMAPClient::BodyStructure::Address"); + }; + 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: ['(' personalname sourceroute mailboxname hostname ')']<<}, + Parse::RecDescent::_tracefirst($text), + q{addressstruct}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{addressstruct}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{addressstruct}, + $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{addressstruct}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{addressstruct}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::sourceroute +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"sourceroute"}; + + Parse::RecDescent::_trace(q{Trying rule: [sourceroute]}, + Parse::RecDescent::_tracefirst($_[1]), + q{sourceroute}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{sourceroute}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{sourceroute}); + %item = (__RULE__ => q{sourceroute}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{sourceroute}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{sourceroute}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{sourceroute}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{sourceroute}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{sourceroute}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{sourceroute}); + %item = (__RULE__ => q{sourceroute}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [STRING]}, + Parse::RecDescent::_tracefirst($text), + q{sourceroute}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::STRING($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{sourceroute}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [STRING]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{sourceroute}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{STRING}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{sourceroute}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = $item{NIL} || $item{STRING} ;$return||defined($return);}; + 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: [STRING]<<}, + Parse::RecDescent::_tracefirst($text), + q{sourceroute}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{sourceroute}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{sourceroute}, + $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{sourceroute}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{sourceroute}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::subpart +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"subpart"}; + + Parse::RecDescent::_trace(q{Trying rule: [subpart]}, + Parse::RecDescent::_tracefirst($_[1]), + q{subpart}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: ['(' part ')' ]}, + Parse::RecDescent::_tracefirst($_[1]), + q{subpart}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{subpart}); + %item = (__RULE__ => q{subpart}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: ['(']}, + Parse::RecDescent::_tracefirst($text), + q{subpart}, + $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 subrule: [part]}, + Parse::RecDescent::_tracefirst($text), + q{subpart}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{part})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::part($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{subpart}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [part]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{subpart}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{part}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying terminal: [')']}, + Parse::RecDescent::_tracefirst($text), + q{subpart}, + $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{subpart}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { + $return = $item{part} ; + $return||defined($return); + }; + 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{Trying directive: []}, + Parse::RecDescent::_tracefirst($text), + q{subpart}, + $tracelevel) + if defined $::RD_TRACE; + $_tok = do { push @{$thisparser->{deferred}}, sub { ++$subpartCount; }; }; + if (defined($_tok)) + { + Parse::RecDescent::_trace(q{>>Matched directive<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + } + else + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + } + + last unless defined $_tok; + push @item, $item{__DIRECTIVE1__}=$_tok; + + + + Parse::RecDescent::_trace(q{>>Matched production: ['(' part ')' ]<<}, + Parse::RecDescent::_tracefirst($text), + q{subpart}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{subpart}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{subpart}, + $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{subpart}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{subpart}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::textlines +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"textlines"}; + + Parse::RecDescent::_trace(q{Trying rule: [textlines]}, + Parse::RecDescent::_tracefirst($_[1]), + q{textlines}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{textlines}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{textlines}); + %item = (__RULE__ => q{textlines}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{textlines}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{textlines}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{textlines}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{textlines}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [NUMBER]}, + Parse::RecDescent::_tracefirst($_[1]), + q{textlines}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{textlines}); + %item = (__RULE__ => q{textlines}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NUMBER]}, + Parse::RecDescent::_tracefirst($text), + q{textlines}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NUMBER($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{textlines}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NUMBER]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{textlines}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NUMBER}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{textlines}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = $item[1] || $item[2]; $return||defined($return); }; + 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{textlines}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{textlines}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{textlines}, + $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{textlines}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{textlines}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::BARESTRING +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"BARESTRING"}; + + Parse::RecDescent::_trace(q{Trying rule: [BARESTRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{BARESTRING}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [/^[)('"]/ /^(?!\\(|\\))(?:\\\\ |\\S)+/]}, + Parse::RecDescent::_tracefirst($_[1]), + q{BARESTRING}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{BARESTRING}); + %item = (__RULE__ => q{BARESTRING}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: [/^[)('"]/]}, Parse::RecDescent::_tracefirst($text), + q{BARESTRING}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + $_savetext = $text; + + if ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:^[)('"])//) + { + $text = $_savetext; + $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__}=$&; + $text = $_savetext; + + Parse::RecDescent::_trace(q{Trying terminal: [/^(?!\\(|\\))(?:\\\\ |\\S)+/]}, Parse::RecDescent::_tracefirst($text), + q{BARESTRING}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{/^(?!\\(|\\))(?:\\\\ |\\S)+/})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:^(?!\(|\))(?:\\ |\S)+)//) + { + + $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{__PATTERN2__}=$&; + + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{BARESTRING}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { + $return = $item{__PATTERN1__} ; $return||defined($return); +}; + 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: [/^[)('"]/ /^(?!\\(|\\))(?:\\\\ |\\S)+/]<<}, + Parse::RecDescent::_tracefirst($text), + q{BARESTRING}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{BARESTRING}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{BARESTRING}, + $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{BARESTRING}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{BARESTRING}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodylang +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"bodylang"}; + + Parse::RecDescent::_trace(q{Trying rule: [bodylang]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodylang}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodylang}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{bodylang}); + %item = (__RULE__ => q{bodylang}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{bodylang}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodylang}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodylang}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodylang}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodylang}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{bodylang}); + %item = (__RULE__ => q{bodylang}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [STRING]}, + Parse::RecDescent::_tracefirst($text), + q{bodylang}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::STRING($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodylang}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [STRING]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodylang}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{STRING}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [STRING]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodylang}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: ['(' STRING ')']}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodylang}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[2]; + $text = $_[1]; + my $_savetext; + @item = (q{bodylang}); + %item = (__RULE__ => q{bodylang}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: ['(']}, + Parse::RecDescent::_tracefirst($text), + q{bodylang}, + $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: [STRING]}, + Parse::RecDescent::_tracefirst($text), + q{bodylang}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{STRING})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::STRING, 1, 100000000, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodylang}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [STRING]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{bodylang}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{STRING(s)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying terminal: [')']}, + Parse::RecDescent::_tracefirst($text), + q{bodylang}, + $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{bodylang}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = $item{NIL} || $item{'STRING(s)'} ;$return||defined($return);}; + 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: ['(' STRING ')']<<}, + Parse::RecDescent::_tracefirst($text), + q{bodylang}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodylang}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{bodylang}, + $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{bodylang}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{bodylang}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::envelopestruct +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"envelopestruct"}; + + Parse::RecDescent::_trace(q{Trying rule: [envelopestruct]}, + Parse::RecDescent::_tracefirst($_[1]), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: ['(' date subject from sender replyto to cc bcc inreplyto messageid ')']}, + Parse::RecDescent::_tracefirst($_[1]), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{envelopestruct}); + %item = (__RULE__ => q{envelopestruct}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: ['(']}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $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 subrule: [date]}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{date})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::date($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [date]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{date}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying subrule: [subject]}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{subject})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::subject($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [subject]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{subject}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying subrule: [from]}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{from})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::from($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [from]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{from}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying subrule: [sender]}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{sender})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::sender($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [sender]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{sender}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying subrule: [replyto]}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{replyto})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::replyto($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [replyto]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{replyto}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying subrule: [to]}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{to})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::to($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [to]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{to}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying subrule: [cc]}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{cc})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::cc($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [cc]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{cc}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying subrule: [bcc]}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{bcc})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bcc($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [bcc]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bcc}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying subrule: [inreplyto]}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{inreplyto})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::inreplyto($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [inreplyto]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{inreplyto}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying subrule: [messageid]}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{messageid})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::messageid($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [messageid]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{messageid}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying terminal: [')']}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $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{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = {}; + foreach my $what (qw/date subject from sender replyto to cc bcc inreplyto messageid/) { + $return->{$what} = $item{$what}; + } + bless $return, "Mail::IMAPClient::BodyStructure::Envelope"; + $return||defined($return); + }; + 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: ['(' date subject from sender replyto to cc bcc inreplyto messageid ')']<<}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{envelopestruct}, + $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{envelopestruct}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{envelopestruct}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::replyto +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"replyto"}; + + Parse::RecDescent::_trace(q{Trying rule: [replyto]}, + Parse::RecDescent::_tracefirst($_[1]), + q{replyto}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{replyto}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{replyto}); + %item = (__RULE__ => q{replyto}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{replyto}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{replyto}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{replyto}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{replyto}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: ['(' addressstruct ')']}, + Parse::RecDescent::_tracefirst($_[1]), + q{replyto}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{replyto}); + %item = (__RULE__ => q{replyto}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: ['(']}, + Parse::RecDescent::_tracefirst($text), + q{replyto}, + $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: [addressstruct]}, + Parse::RecDescent::_tracefirst($text), + q{replyto}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{addressstruct})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::addressstruct, 1, 100000000, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{replyto}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [addressstruct]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{replyto}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{addressstruct(s)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying terminal: [')']}, + Parse::RecDescent::_tracefirst($text), + q{replyto}, + $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{replyto}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = $item{NIL} || $item{'addressstruct(s)'} }; + 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: ['(' addressstruct ')']<<}, + Parse::RecDescent::_tracefirst($text), + q{replyto}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{replyto}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{replyto}, + $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{replyto}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{replyto}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::mailboxname +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"mailboxname"}; + + Parse::RecDescent::_trace(q{Trying rule: [mailboxname]}, + Parse::RecDescent::_tracefirst($_[1]), + q{mailboxname}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + 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: [NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{mailboxname}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{mailboxname}); + %item = (__RULE__ => q{mailboxname}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{mailboxname}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{mailboxname}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{mailboxname}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{mailboxname}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{mailboxname}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{mailboxname}); + %item = (__RULE__ => q{mailboxname}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [STRING]}, + Parse::RecDescent::_tracefirst($text), + q{mailboxname}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::STRING($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{mailboxname}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [STRING]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{mailboxname}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{STRING}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{mailboxname}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = $item{NIL} || $item{STRING} ;$return||defined($return);}; + 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: [STRING]<<}, + Parse::RecDescent::_tracefirst($text), + q{mailboxname}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{mailboxname}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{mailboxname}, + $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{mailboxname}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{mailboxname}, + $tracelevel) + } + $_[1] = $text; + return $return; +} +} +package Mail::IMAPClient::BodyStructure::Parse; sub new { my $self = bless( { + '_AUTOTREE' => undef, + 'localvars' => '', + 'startcode' => '', + '_check' => { + 'thisoffset' => '', + 'itempos' => '', + 'prevoffset' => '', + 'prevline' => '', + 'prevcolumn' => '', + 'thiscolumn' => '' + }, + 'namespace' => 'Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse', + 'deferrable' => 1, + '_AUTOACTION' => undef, + 'rules' => { + 'bodyparms' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'kvpair' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 76 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 2, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => '(', + 'hashname' => '__STRING1__', + 'description' => '\'(\'', + 'lookahead' => 0, + 'line' => 76 + }, 'Parse::RecDescent::Literal' ), + bless( { + 'subrule' => 'kvpair', + 'expected' => undef, + 'min' => 1, + 'argcode' => undef, + 'max' => 100000000, + 'matchrule' => 0, + 'repspec' => 's', + 'lookahead' => 0, + 'line' => 76 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'pattern' => ')', + 'hashname' => '__STRING2__', + 'description' => '\')\'', + 'lookahead' => 0, + 'line' => 76 + }, 'Parse::RecDescent::Literal' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 77, + 'code' => '{ + $return = $item{NIL} || + { map { (%$_) } @{$item{\'kvpair(s)\'}} }; + $return || defined($return); + }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => 76 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'bodyparms', + 'vars' => '', + 'line' => 76 + }, 'Parse::RecDescent::Rule' ), + 'date' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'STRING' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 134 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'subrule' => 'STRING', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 134 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 135, + 'code' => '{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => 134 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'date', + 'vars' => '', + 'line' => 134 + }, 'Parse::RecDescent::Rule' ), + 'bodysubtype' => bless( { + 'impcount' => 0, + 'calls' => [ + 'PLAIN', + 'HTML', + 'NIL', + 'STRING' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'PLAIN', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 72 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'HTML', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 72 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => 72 + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '2', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 72 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => 72 + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '3', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'subrule' => 'STRING', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 72 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 73, + 'code' => '{ $return = $item{PLAIN}||$item{HTML}||$item{NIL}||$item{STRING} ; + $return||defined($return); + }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => 72 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'bodysubtype', + 'vars' => '', + 'line' => 72 + }, 'Parse::RecDescent::Rule' ), + 'hostname' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'STRING' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 112 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'subrule' => 'STRING', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 112 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 113, + 'code' => '{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => 112 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'hostname', + 'vars' => '', + 'line' => 112 + }, 'Parse::RecDescent::Rule' ), + 'basicfields' => bless( { + 'impcount' => 0, + 'calls' => [ + 'bodysubtype', + 'bodyparms', + 'bodyid', + 'bodydesc', + 'bodyenc', + 'bodysize' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'subrule' => 'bodysubtype', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 164 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'bodyparms', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 164 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'bodyid', + 'expected' => undef, + 'min' => 0, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '?', + 'lookahead' => 0, + 'line' => 164 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'subrule' => 'bodydesc', + 'expected' => undef, + 'min' => 0, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '?', + 'lookahead' => 0, + 'line' => 165 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'subrule' => 'bodyenc', + 'expected' => undef, + 'min' => 0, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '?', + 'lookahead' => 0, + 'line' => 165 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'subrule' => 'bodysize', + 'expected' => undef, + 'min' => 0, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '?', + 'lookahead' => 0, + 'line' => 166 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 166, + 'code' => '{ + + $return = { + bodysubtype => $item{bodysubtype} , + + bodyparms => $item{bodyparms} , + + bodyid => (ref $item{\'bodyid(?)\'} ? + $item{\'bodyid(?)\'}[0] : + $item{\'bodyid(?)\'} ), + + \'bodydesc\' => (ref $item{\'bodydesc(?)\'} ? + $item{\'bodydesc(?)\'}[0] : + $item{\'bodydesc(?)\'} ), + + \'bodyenc\' => (ref $item{\'bodyenc(?)\'} ? + $item{\'bodyenc(?)\'}[0] : + $item{\'bodyenc(?)\'} ), + + \'bodysize\' => (ref $item{\'bodysize(?)\'} ? + $item{\'bodysize(?)\'}[0] : + $item{\'bodysize(?)\'} ), + }; + $return; +}' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'basicfields', + 'vars' => '', + 'line' => 164 + }, 'Parse::RecDescent::Rule' ), + 'personalname' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'STRING' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 106 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'subrule' => 'STRING', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 106 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 107, + 'code' => '{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => 106 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'personalname', + 'vars' => '', + 'line' => 106 + }, 'Parse::RecDescent::Rule' ), + 'key' => bless( { + 'impcount' => 0, + 'calls' => [ + 'STRING' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'subrule' => 'STRING', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 60 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 60, + 'code' => '{ $return = $item{STRING} ; $return||defined($return);}' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'key', + 'vars' => '', + 'line' => 60 + }, 'Parse::RecDescent::Rule' ), + 'cc' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'addressstruct' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 137 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 2, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => '(', + 'hashname' => '__STRING1__', + 'description' => '\'(\'', + 'lookahead' => 0, + 'line' => 137 + }, 'Parse::RecDescent::InterpLit' ), + bless( { + 'subrule' => 'addressstruct', + 'expected' => undef, + 'min' => 1, + 'argcode' => undef, + 'max' => 100000000, + 'matchrule' => 0, + 'repspec' => 's', + 'lookahead' => 0, + 'line' => 137 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'pattern' => ')', + 'hashname' => '__STRING2__', + 'description' => '\')\'', + 'lookahead' => 0, + 'line' => 137 + }, 'Parse::RecDescent::InterpLit' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 138, + 'code' => '{ $return = $item{NIL} || $item{\'addressstruct(s)\'} }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => 137 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'cc', + 'vars' => '', + 'line' => 137 + }, 'Parse::RecDescent::Rule' ), + 'bodyMD5' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'STRING' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 102 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'subrule' => 'STRING', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 102 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 103, + 'code' => '{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => 102 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'bodyMD5', + 'vars' => '', + 'line' => 102 + }, 'Parse::RecDescent::Rule' ), + 'envelope' => bless( { + 'impcount' => 0, + 'calls' => [ + 'envelopestruct' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 2, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => '.*\\(.*ENVELOPE', + 'hashname' => '__PATTERN1__', + 'description' => '/.*\\\\(.*ENVELOPE/', + 'lookahead' => 0, + 'rdelim' => '/', + 'line' => 285, + 'mod' => '', + 'ldelim' => '/' + }, 'Parse::RecDescent::Token' ), + bless( { + 'subrule' => 'envelopestruct', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 285 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'pattern' => '.*\\)', + 'hashname' => '__PATTERN2__', + 'description' => '/.*\\\\)/', + 'lookahead' => 0, + 'rdelim' => '/', + 'line' => 285, + 'mod' => '', + 'ldelim' => '/' + }, 'Parse::RecDescent::Token' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 285, + 'code' => '{ + $return = $item{envelopestruct} ; + $return||defined($return) ; + }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'envelope', + 'vars' => '', + 'line' => 285 + }, 'Parse::RecDescent::Rule' ), + 'MESSAGE' => bless( { + 'impcount' => 0, + 'calls' => [], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 1, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => '^"MESSAGE"|^MESSAGE', + 'hashname' => '__PATTERN1__', + 'description' => '/^"MESSAGE"|^MESSAGE/i', + 'lookahead' => 0, + 'rdelim' => '/', + 'line' => 15, + 'mod' => 'i', + 'ldelim' => '/' + }, 'Parse::RecDescent::Token' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 15, + 'code' => '{ $return = "MESSAGE" }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'MESSAGE', + 'vars' => '', + 'line' => 15 + }, 'Parse::RecDescent::Rule' ), + 'DOUBLE_QUOTED_STRING' => bless( { + 'impcount' => 0, + 'calls' => [], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 2, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 1, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => '"', + 'hashname' => '__STRING1__', + 'description' => '\'"\'', + 'lookahead' => 0, + 'line' => 28 + }, 'Parse::RecDescent::Literal' ), + bless( { + 'pattern' => '(?:\\\\"|[^"])*', + 'hashname' => '__PATTERN1__', + 'description' => '/(?:\\\\\\\\"|[^"])*/', + 'lookahead' => 0, + 'rdelim' => '/', + 'line' => 28, + 'mod' => '', + 'ldelim' => '/' + }, 'Parse::RecDescent::Token' ), + bless( { + 'pattern' => '"', + 'hashname' => '__STRING2__', + 'description' => '\'"\'', + 'lookahead' => 0, + 'line' => 28 + }, 'Parse::RecDescent::Literal' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 28, + 'code' => '{ + + $return = $item{__PATTERN1__} ; + $return||defined($return); +}' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'DOUBLE_QUOTED_STRING', + 'vars' => '', + 'line' => 28 + }, 'Parse::RecDescent::Rule' ), + 'subject' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'STRING' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 123 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'subrule' => 'STRING', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 123 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 124, + 'code' => '{ + $return = $item{NIL} || $item{STRING} ; + $return||defined($return); + }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => 123 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'subject', + 'vars' => '', + 'line' => 123 + }, 'Parse::RecDescent::Rule' ), + 'value' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'kvpair', + 'NUMBER', + 'STRING' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 61 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 2, + 'dircount' => 1, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'pattern' => '(', + 'hashname' => '__STRING1__', + 'description' => '\'(\'', + 'lookahead' => 0, + 'line' => 61 + }, 'Parse::RecDescent::Literal' ), + bless( { + 'hashname' => '__DIRECTIVE1__', + 'name' => '', + 'lookahead' => 0, + 'line' => 61, + 'code' => '$commit = 1' + }, 'Parse::RecDescent::Directive' ), + bless( { + 'subrule' => 'kvpair', + 'expected' => undef, + 'min' => 1, + 'argcode' => undef, + 'max' => 100000000, + 'matchrule' => 0, + 'repspec' => 's', + 'lookahead' => 0, + 'line' => 61 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'pattern' => ')', + 'hashname' => '__STRING2__', + 'description' => '\')\'', + 'lookahead' => 0, + 'line' => 61 + }, 'Parse::RecDescent::Literal' ) + ], + 'line' => 61 + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '2', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NUMBER', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 61 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => 61 + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '3', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'subrule' => 'STRING', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 61 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 62, + 'code' => '{ $return = $item{NIL} || + $item{NUMBER} || + $item{STRING} || + { map { (%$_) } @{$item{\'kvpair(s)\'}} } ; + $return||defined($return); + }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => 61 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'value', + 'vars' => '', + 'line' => 61 + }, 'Parse::RecDescent::Rule' ), + 'inreplyto' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'STRING' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 128 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'subrule' => 'STRING', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 128 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 129, + 'code' => '{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => 128 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'inreplyto', + 'vars' => '', + 'line' => 128 + }, 'Parse::RecDescent::Rule' ), + 'messageid' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'STRING' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 131 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'subrule' => 'STRING', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 131 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 132, + 'code' => '{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => 131 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'messageid', + 'vars' => '', + 'line' => 131 + }, 'Parse::RecDescent::Rule' ), + 'sender' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'addressstruct' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 149 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 2, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => '(', + 'hashname' => '__STRING1__', + 'description' => '\'(\'', + 'lookahead' => 0, + 'line' => 149 + }, 'Parse::RecDescent::InterpLit' ), + bless( { + 'subrule' => 'addressstruct', + 'expected' => undef, + 'min' => 1, + 'argcode' => undef, + 'max' => 100000000, + 'matchrule' => 0, + 'repspec' => 's', + 'lookahead' => 0, + 'line' => 149 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'pattern' => ')', + 'hashname' => '__STRING2__', + 'description' => '\')\'', + 'lookahead' => 0, + 'line' => 149 + }, 'Parse::RecDescent::InterpLit' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 150, + 'code' => '{ $return = $item{NIL} || $item{\'addressstruct(s)\'} }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => 149 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'sender', + 'vars' => '', + 'line' => 149 + }, 'Parse::RecDescent::Rule' ), + 'QUOTED_STRING' => bless( { + 'impcount' => 0, + 'calls' => [ + 'DOUBLE_QUOTED_STRING', + 'SINGLE_QUOTED_STRING' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'DOUBLE_QUOTED_STRING', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 34 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'subrule' => 'SINGLE_QUOTED_STRING', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 34 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 34, + 'code' => '{ + + $return = $item{DOUBLE_QUOTED_STRING}||$item{SINGLE_QUOTED_STRING} ; + $return||defined($return); +}' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => 34 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'QUOTED_STRING', + 'vars' => '', + 'line' => 34 + }, 'Parse::RecDescent::Rule' ), + 'messagerfc822message' => bless( { + 'impcount' => 0, + 'calls' => [ + 'rfc822message', + 'bodyparms', + 'bodyid', + 'bodydesc', + 'bodyenc', + 'bodysize', + 'envelopestruct', + 'bodystructure', + 'textlines', + 'bodyMD5', + 'bodydisp', + 'bodylang' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 1, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'subrule' => 'rfc822message', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 214 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'hashname' => '__DIRECTIVE1__', + 'name' => '', + 'lookahead' => 0, + 'line' => 214, + 'code' => '$commit = 1' + }, 'Parse::RecDescent::Directive' ), + bless( { + 'subrule' => 'bodyparms', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 214 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'bodyid', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 214 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'bodydesc', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 214 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'bodyenc', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 214 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'bodysize', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 214 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'envelopestruct', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 215 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'bodystructure', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 215 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'textlines', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 215 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'bodyMD5', + 'expected' => undef, + 'min' => 0, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '?', + 'lookahead' => 0, + 'line' => 216 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'subrule' => 'bodydisp', + 'expected' => undef, + 'min' => 0, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '?', + 'lookahead' => 0, + 'line' => 216 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'subrule' => 'bodylang', + 'expected' => undef, + 'min' => 0, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '?', + 'lookahead' => 0, + 'line' => 216 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 217, + 'code' => '{ + $return = {}; + foreach my $what (qw/ bodyparms bodyid bodydesc bodyenc bodysize + envelopestruct bodystructure textlines + bodyMD5(?) bodydisp(?) bodylang(?) + / + ) { + my $k = $what; $k =~ s/\\(\\?\\)$//; + $return->{$k} = ref $item{$what} =~ \'ARRAY\'? + $item{$what}[0] : $item{$what}; + } + while ( my($k,$v) = each %{$item{bodystructure}[0]} ) { $return->{$k} = $v } + while ( my($k,$v) = each %{$item{basicfields}} ) { $return->{$k} = $v } + $return->{bodytype} = "MESSAGE" ; + $return->{bodysubtype}= "RFC822" ; + $return||defined($return); + }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'messagerfc822message', + 'vars' => '', + 'line' => 213 + }, 'Parse::RecDescent::Rule' ), + 'bodyenc' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'STRING', + 'kvpair' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 92 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'STRING', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 92 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => 92 + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '2', + 'strcount' => 2, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => '(', + 'hashname' => '__STRING1__', + 'description' => '\'(\'', + 'lookahead' => 0, + 'line' => 92 + }, 'Parse::RecDescent::Literal' ), + bless( { + 'subrule' => 'kvpair', + 'expected' => undef, + 'min' => 1, + 'argcode' => undef, + 'max' => 100000000, + 'matchrule' => 0, + 'repspec' => 's', + 'lookahead' => 0, + 'line' => 92 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'pattern' => ')', + 'hashname' => '__STRING2__', + 'description' => '\')\'', + 'lookahead' => 0, + 'line' => 92 + }, 'Parse::RecDescent::Literal' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 93, + 'code' => '{ + $return = $item{NIL} || + $item{STRING} || + { map { (%$_) } @{$item{\'kvpair(s)\'}} }; + $return||defined($return); + }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => 92 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'bodyenc', + 'vars' => '', + 'line' => 92 + }, 'Parse::RecDescent::Rule' ), + 'bodydesc' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'STRING' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 1, + 'actcount' => 0, + 'items' => [ + bless( { + 'pattern' => '[()]', + 'hashname' => '__PATTERN1__', + 'description' => '/[()]/', + 'lookahead' => -1, + 'rdelim' => '/', + 'line' => 90, + 'mod' => '', + 'ldelim' => '/' + }, 'Parse::RecDescent::Token' ), + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 90 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'subrule' => 'STRING', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 90 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 91, + 'code' => '{ $return = $item{NIL} || $item{STRING} ; $return||defined($return);}' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => 90 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'bodydesc', + 'vars' => '', + 'line' => 90 + }, 'Parse::RecDescent::Rule' ), + 'start' => bless( { + 'impcount' => 0, + 'calls' => [ + 'part' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 2, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => '.*\\(.*BODYSTRUCTURE \\(', + 'hashname' => '__PATTERN1__', + 'description' => '/.*\\\\(.*BODYSTRUCTURE \\\\(/i', + 'lookahead' => 0, + 'rdelim' => '/', + 'line' => 278, + 'mod' => 'i', + 'ldelim' => '/' + }, 'Parse::RecDescent::Token' ), + bless( { + 'subrule' => 'part', + 'expected' => undef, + 'min' => 1, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '1', + 'lookahead' => 0, + 'line' => 278 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'pattern' => '\\).*\\)\\r?\\n?', + 'hashname' => '__PATTERN2__', + 'description' => '/\\\\).*\\\\)\\\\r?\\\\n?/', + 'lookahead' => 0, + 'rdelim' => '/', + 'line' => 278, + 'mod' => '', + 'ldelim' => '/' + }, 'Parse::RecDescent::Token' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 279, + 'code' => '{ + #print STDERR "item = ",Data::Dumper->Dump([\\%item],[\'$item\']); + $return = $item{\'part(1)\'}[0]; + $return||defined($return); + }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'start', + 'vars' => '', + 'line' => 278 + }, 'Parse::RecDescent::Rule' ), + 'RFC822' => bless( { + 'impcount' => 0, + 'calls' => [], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 1, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => '^"RFC822"|^RFC822', + 'hashname' => '__PATTERN1__', + 'description' => '/^"RFC822"|^RFC822/i', + 'lookahead' => 0, + 'rdelim' => '/', + 'line' => 16, + 'mod' => 'i', + 'ldelim' => '/' + }, 'Parse::RecDescent::Token' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 16, + 'code' => '{ $return = "RFC822" }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'RFC822', + 'vars' => '', + 'line' => 16 + }, 'Parse::RecDescent::Rule' ), + 'textmessage' => bless( { + 'impcount' => 0, + 'calls' => [ + 'TEXT', + 'basicfields', + 'textlines', + 'bodyMD5', + 'bodydisp', + 'bodylang' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 1, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'subrule' => 'TEXT', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 192 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'hashname' => '__DIRECTIVE1__', + 'name' => '', + 'lookahead' => 0, + 'line' => 192, + 'code' => '$commit = 1' + }, 'Parse::RecDescent::Directive' ), + bless( { + 'subrule' => 'basicfields', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 192 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'textlines', + 'expected' => undef, + 'min' => 0, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '?', + 'lookahead' => 0, + 'line' => 192 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'subrule' => 'bodyMD5', + 'expected' => undef, + 'min' => 0, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '?', + 'lookahead' => 0, + 'line' => 192 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'subrule' => 'bodydisp', + 'expected' => undef, + 'min' => 0, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '?', + 'lookahead' => 0, + 'line' => 192 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'subrule' => 'bodylang', + 'expected' => undef, + 'min' => 0, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '?', + 'lookahead' => 0, + 'line' => 192 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 193, + 'code' => '{ + $return = $item{basicfields}||{}; + $return->{bodytype} = \'TEXT\'; + foreach my $what (qw/textlines(?) bodyMD5(?) bodydisp(?) bodylang(?)/) { + my $k = $what; $k =~ s/\\(\\?\\)$//; + ref($item{$what}) and $return->{$k} = $item{$what}[0]; + } + $return||defined($return); + }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'textmessage', + 'vars' => '', + 'line' => 192 + }, 'Parse::RecDescent::Rule' ), + 'bodyid' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'STRING' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 1, + 'actcount' => 0, + 'items' => [ + bless( { + 'pattern' => '[()]', + 'hashname' => '__PATTERN1__', + 'description' => '/[()]/', + 'lookahead' => -1, + 'rdelim' => '/', + 'line' => 88, + 'mod' => '', + 'ldelim' => '/' + }, 'Parse::RecDescent::Token' ), + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 88 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'subrule' => 'STRING', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 88 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 89, + 'code' => '{ $return = $item{NIL} || $item{STRING} ; $return||defined($return);}' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => 88 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'bodyid', + 'vars' => '', + 'line' => 88 + }, 'Parse::RecDescent::Rule' ), + 'othertypemessage' => bless( { + 'impcount' => 0, + 'calls' => [ + 'bodytype', + 'basicfields', + 'bodyparms', + 'bodydisp', + 'bodylang' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'subrule' => 'bodytype', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 203 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'basicfields', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 203 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'bodyparms', + 'expected' => undef, + 'min' => 0, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '?', + 'lookahead' => 0, + 'line' => 203 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'subrule' => 'bodydisp', + 'expected' => undef, + 'min' => 0, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '?', + 'lookahead' => 0, + 'line' => 203 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'subrule' => 'bodylang', + 'expected' => undef, + 'min' => 0, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '?', + 'lookahead' => 0, + 'line' => 203 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 204, + 'code' => '{ $return = {}; + foreach my $what (qw/bodytype bodyparms(?) bodydisp(?) bodylang(?)/) { + my $k = $what; $k =~ s/\\(\\?\\)$//; + $return->{$k} = ref($item{$what})? $item{$what}[0] : $item{$what} ; + } + while ( my($k,$v) = each %{$item{basicfields}} ) { $return->{$k} = $v } + $return||defined($return); + }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'othertypemessage', + 'vars' => '', + 'line' => 203 + }, 'Parse::RecDescent::Rule' ), + 'kvpair' => bless( { + 'impcount' => 0, + 'calls' => [ + 'key', + 'value' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 1, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => ')', + 'hashname' => '__STRING1__', + 'description' => '\')\'', + 'lookahead' => -1, + 'line' => 68 + }, 'Parse::RecDescent::InterpLit' ), + bless( { + 'subrule' => 'key', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 68 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'value', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 68 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 69, + 'code' => '{ $return = { $item{key} => $item{value} }; $return||defined($return);}' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'kvpair', + 'vars' => '', + 'line' => 68 + }, 'Parse::RecDescent::Rule' ), + 'bodysize' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'NUMBER' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 1, + 'actcount' => 0, + 'items' => [ + bless( { + 'pattern' => '[()]', + 'hashname' => '__PATTERN1__', + 'description' => '/[()]/', + 'lookahead' => -1, + 'rdelim' => '/', + 'line' => 99, + 'mod' => '', + 'ldelim' => '/' + }, 'Parse::RecDescent::Token' ), + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 99 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + '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' => 99 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 100, + 'code' => '{ $return = $item{NIL} || $item{NUMBER} ;$return||defined($return);}' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => 99 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'bodysize', + 'vars' => '', + 'line' => 99 + }, 'Parse::RecDescent::Rule' ), + 'STRING' => bless( { + 'impcount' => 0, + 'calls' => [ + 'QUOTED_STRING', + 'BARESTRING' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'QUOTED_STRING', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 44 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'subrule' => 'BARESTRING', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 44 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 44, + 'code' => '{ + $return = $item{QUOTED_STRING}||$item{BARESTRING} ; + $return||defined($return); +}' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => 44 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'STRING', + 'vars' => '', + 'line' => 44 + }, 'Parse::RecDescent::Rule' ), + 'bodytype' => bless( { + 'impcount' => 0, + 'calls' => [ + 'STRING' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'subrule' => 'STRING', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 70 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 71, + 'code' => '{ $return = $item{STRING} ; $return||defined($return);}' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'bodytype', + 'vars' => '', + 'line' => 70 + }, 'Parse::RecDescent::Rule' ), + 'TEXT' => bless( { + 'impcount' => 0, + 'calls' => [], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 1, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => '^"TEXT"|^TEXT', + 'hashname' => '__PATTERN1__', + 'description' => '/^"TEXT"|^TEXT/i', + 'lookahead' => 0, + 'rdelim' => '/', + 'line' => 12, + 'mod' => 'i', + 'ldelim' => '/' + }, 'Parse::RecDescent::Token' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 12, + 'code' => '{ $return = "TEXT" }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'TEXT', + 'vars' => '', + 'line' => 11 + }, 'Parse::RecDescent::Rule' ), + 'to' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'addressstruct' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 152 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 2, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => '(', + 'hashname' => '__STRING1__', + 'description' => '\'(\'', + 'lookahead' => 0, + 'line' => 152 + }, 'Parse::RecDescent::InterpLit' ), + bless( { + 'subrule' => 'addressstruct', + 'expected' => undef, + 'min' => 1, + 'argcode' => undef, + 'max' => 100000000, + 'matchrule' => 0, + 'repspec' => 's', + 'lookahead' => 0, + 'line' => 152 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'pattern' => ')', + 'hashname' => '__STRING2__', + 'description' => '\')\'', + 'lookahead' => 0, + 'line' => 152 + }, 'Parse::RecDescent::InterpLit' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 153, + 'code' => '{ $return = $item{NIL} || $item{\'addressstruct(s)\'} }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => 152 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'to', + 'vars' => '', + 'line' => 152 + }, 'Parse::RecDescent::Rule' ), + 'NIL' => bless( { + 'impcount' => 0, + 'calls' => [], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 1, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => '^NIL', + 'hashname' => '__PATTERN1__', + 'description' => '/^NIL/i', + 'lookahead' => 0, + 'rdelim' => '/', + 'line' => 17, + 'mod' => 'i', + 'ldelim' => '/' + }, 'Parse::RecDescent::Token' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 17, + 'code' => '{ $return = "NIL" }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'NIL', + 'vars' => '', + 'line' => 17 + }, 'Parse::RecDescent::Rule' ), + 'from' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'addressstruct' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 143 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 2, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => '(', + 'hashname' => '__STRING1__', + 'description' => '\'(\'', + 'lookahead' => 0, + 'line' => 143 + }, 'Parse::RecDescent::InterpLit' ), + bless( { + 'subrule' => 'addressstruct', + 'expected' => undef, + 'min' => 1, + 'argcode' => undef, + 'max' => 100000000, + 'matchrule' => 0, + 'repspec' => 's', + 'lookahead' => 0, + 'line' => 143 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'pattern' => ')', + 'hashname' => '__STRING2__', + 'description' => '\')\'', + 'lookahead' => 0, + 'line' => 143 + }, 'Parse::RecDescent::InterpLit' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 144, + 'code' => '{ $return = $item{NIL} || $item{\'addressstruct(s)\'} }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => 143 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'from', + 'vars' => '', + 'line' => 143 + }, 'Parse::RecDescent::Rule' ), + 'bodystructure' => bless( { + 'impcount' => 0, + 'calls' => [ + 'part' + ], + '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' => 272 + }, 'Parse::RecDescent::InterpLit' ), + bless( { + 'subrule' => 'part', + 'expected' => undef, + 'min' => 1, + 'argcode' => undef, + 'max' => 100000000, + 'matchrule' => 0, + 'repspec' => 's', + 'lookahead' => 0, + 'line' => 272 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'pattern' => ')', + 'hashname' => '__STRING2__', + 'description' => '\')\'', + 'lookahead' => 0, + 'line' => 272 + }, 'Parse::RecDescent::InterpLit' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 273, + 'code' => '{ + $return = $item{\'part(s)\'} ; + $return||defined($return); + }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'bodystructure', + 'vars' => '', + 'line' => 272 + }, 'Parse::RecDescent::Rule' ), + 'PLAIN' => bless( { + 'impcount' => 0, + 'calls' => [], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 1, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => '^"PLAIN"|^PLAIN', + 'hashname' => '__PATTERN1__', + 'description' => '/^"PLAIN"|^PLAIN/i', + 'lookahead' => 0, + 'rdelim' => '/', + 'line' => 13, + 'mod' => 'i', + 'ldelim' => '/' + }, 'Parse::RecDescent::Token' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 13, + 'code' => '{ $return = "PLAIN" }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'PLAIN', + 'vars' => '', + 'line' => 13 + }, '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' => 1, + 'items' => [ + bless( { + 'pattern' => '^(\\d+)', + 'hashname' => '__PATTERN1__', + 'description' => '/^(\\\\d+)/', + 'lookahead' => 0, + 'rdelim' => '/', + 'line' => 18, + 'mod' => '', + 'ldelim' => '/' + }, 'Parse::RecDescent::Token' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 18, + 'code' => '{ $return = $item[1]; $return||defined($return);}' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'NUMBER', + 'vars' => '', + 'line' => 18 + }, 'Parse::RecDescent::Rule' ), + 'HTML' => bless( { + 'impcount' => 0, + 'calls' => [], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 1, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => '"HTML"|HTML', + 'hashname' => '__PATTERN1__', + 'description' => '/"HTML"|HTML/i', + 'lookahead' => 0, + 'rdelim' => '/', + 'line' => 14, + 'mod' => 'i', + 'ldelim' => '/' + }, 'Parse::RecDescent::Token' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 14, + 'code' => '{ $return = "HTML" }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'HTML', + 'vars' => '', + 'line' => 14 + }, 'Parse::RecDescent::Rule' ), + 'bodydisp' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'kvpair' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 82 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 2, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => '(', + 'hashname' => '__STRING1__', + 'description' => '\'(\'', + 'lookahead' => 0, + 'line' => 82 + }, 'Parse::RecDescent::Literal' ), + bless( { + 'subrule' => 'kvpair', + 'expected' => undef, + 'min' => 1, + 'argcode' => undef, + 'max' => 100000000, + 'matchrule' => 0, + 'repspec' => 's', + 'lookahead' => 0, + 'line' => 82 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'pattern' => ')', + 'hashname' => '__STRING2__', + 'description' => '\')\'', + 'lookahead' => 0, + 'line' => 82 + }, 'Parse::RecDescent::Literal' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 83, + 'code' => '{ + $return = $item{NIL} || + { map { (%$_) } @{$item{\'kvpair(s)\'}} }; + $return || defined($return); + }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => 82 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'bodydisp', + 'vars' => '', + 'line' => 82 + }, 'Parse::RecDescent::Rule' ), + 'part' => bless( { + 'impcount' => 0, + 'calls' => [ + 'subpart', + 'basicfields', + 'bodyparms', + 'bodydisp', + 'bodylang', + 'textmessage', + 'messagerfc822message', + 'othertypemessage' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 2, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'subrule' => 'subpart', + 'expected' => undef, + 'min' => 1, + 'argcode' => undef, + 'max' => 100000000, + 'matchrule' => 0, + 'repspec' => 's', + 'lookahead' => 0, + 'line' => 242 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'hashname' => '__DIRECTIVE1__', + 'name' => '', + 'lookahead' => 0, + 'line' => 242, + 'code' => '$commit = 1' + }, 'Parse::RecDescent::Directive' ), + bless( { + 'subrule' => 'basicfields', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 242 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'bodyparms', + 'expected' => undef, + 'min' => 0, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '?', + 'lookahead' => 0, + 'line' => 243 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'subrule' => 'bodydisp', + 'expected' => undef, + 'min' => 0, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '?', + 'lookahead' => 0, + 'line' => 243 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'subrule' => 'bodylang', + 'expected' => undef, + 'min' => 0, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '?', + 'lookahead' => 0, + 'line' => 243 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'hashname' => '__DIRECTIVE2__', + 'name' => '', + 'lookahead' => 0, + 'line' => 244, + 'code' => 'push @{$thisparser->{deferred}}, sub { $subpartCount = 0 };' + }, 'Parse::RecDescent::Directive' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 245, + 'code' => '{ + $return = bless($item{basicfields}, + "Mail::IMAPClient::BodyStructure"); + $return->{bodytype} = "MULTIPART"; + $return->{bodystructure} = $item{\'subpart(s)\'}; + foreach my $b (qw/bodyparms(?) bodydisp(?) bodylang(?)/) { + my $k = $b; $k =~ s/\\(\\?\\)$//; + $return->{$k} = ref($item{$b}) ? $item{$b}[0] : $item{$b}; + } + $return||defined($return) ; + }' + }, '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' => 'textmessage', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 256 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 257, + 'code' => '{ + $return = bless $item{textmessage}, "Mail::IMAPClient::BodyStructure"; + $return||defined($return); + }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => 256 + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '2', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'subrule' => 'messagerfc822message', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 261 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 262, + 'code' => '{ + $return = bless $item{messagerfc822message}, "Mail::IMAPClient::BodyStructure"; + $return||defined($return); + }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => 261 + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '3', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'subrule' => 'othertypemessage', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 266 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 267, + 'code' => '{ + $return = bless $item{othertypemessage}, "Mail::IMAPClient::BodyStructure"; + $return||defined($return); + }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => 266 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'part', + 'vars' => '', + 'line' => 242 + }, 'Parse::RecDescent::Rule' ), + 'SINGLE_QUOTED_STRING' => bless( { + 'impcount' => 0, + 'calls' => [], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 2, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 1, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => '\'', + 'hashname' => '__STRING1__', + 'description' => '\'\'\'', + 'lookahead' => 0, + 'line' => 22 + }, 'Parse::RecDescent::InterpLit' ), + bless( { + 'pattern' => '(?:\\\\\'|[^\'])*', + 'hashname' => '__PATTERN1__', + 'description' => '/(?:\\\\\\\\\'|[^\'])*/', + 'lookahead' => 0, + 'rdelim' => '/', + 'line' => 22, + 'mod' => '', + 'ldelim' => '/' + }, 'Parse::RecDescent::Token' ), + bless( { + 'pattern' => '\'', + 'hashname' => '__STRING2__', + 'description' => '\'\'\'', + 'lookahead' => 0, + 'line' => 22 + }, 'Parse::RecDescent::InterpLit' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 22, + 'code' => '{ + + $return = $item{__PATTERN1__} ; + $return||defined($return); +}' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'SINGLE_QUOTED_STRING', + 'vars' => '', + 'line' => 20 + }, 'Parse::RecDescent::Rule' ), + 'bcc' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'addressstruct' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 140 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 2, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => '(', + 'hashname' => '__STRING1__', + 'description' => '\'(\'', + 'lookahead' => 0, + 'line' => 140 + }, 'Parse::RecDescent::InterpLit' ), + bless( { + 'subrule' => 'addressstruct', + 'expected' => undef, + 'min' => 1, + 'argcode' => undef, + 'max' => 100000000, + 'matchrule' => 0, + 'repspec' => 's', + 'lookahead' => 0, + 'line' => 140 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'pattern' => ')', + 'hashname' => '__STRING2__', + 'description' => '\')\'', + 'lookahead' => 0, + 'line' => 140 + }, 'Parse::RecDescent::InterpLit' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 141, + 'code' => '{ $return = $item{NIL} || $item{\'addressstruct(s)\'} }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => 140 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'bcc', + 'vars' => '', + 'line' => 140 + }, 'Parse::RecDescent::Rule' ), + 'rfc822message' => bless( { + 'impcount' => 0, + 'calls' => [ + 'MESSAGE', + 'RFC822' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'subrule' => 'MESSAGE', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 59 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'RFC822', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 59 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 59, + 'code' => '{ $return = "MESSAGE RFC822" }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'rfc822message', + 'vars' => '', + 'line' => 59 + }, 'Parse::RecDescent::Rule' ), + 'OLDSTRING' => 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' => '^"((?:[^"\\\\]|\\\\.)*)"', + 'hashname' => '__PATTERN1__', + 'description' => '/^"((?:[^"\\\\\\\\]|\\\\\\\\.)*)"/', + 'lookahead' => 0, + 'rdelim' => '/', + 'line' => 49, + 'mod' => '', + 'ldelim' => '/' + }, 'Parse::RecDescent::Token' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 1, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => '^([^ \\(\\)]+)', + 'hashname' => '__PATTERN1__', + 'description' => '/^([^ \\\\(\\\\)]+)/', + 'lookahead' => 0, + 'rdelim' => '/', + 'line' => 49, + 'mod' => '', + 'ldelim' => '/' + }, 'Parse::RecDescent::Token' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 50, + 'code' => '{ $item{__PATTERN1__} =~ s/^"(.*)"$/$1/; + $return = $item{__PATTERN1__} || $item{__PATTERN2__} ; + $return||defined($return); + }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => 49 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'OLDSTRING', + 'vars' => '', + 'line' => 49 + }, 'Parse::RecDescent::Rule' ), + 'addressstruct' => bless( { + 'impcount' => 0, + 'calls' => [ + 'personalname', + 'sourceroute', + 'mailboxname', + 'hostname' + ], + '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' => 114 + }, 'Parse::RecDescent::InterpLit' ), + bless( { + 'subrule' => 'personalname', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 114 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'sourceroute', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 114 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'mailboxname', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 114 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'hostname', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 114 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'pattern' => ')', + 'hashname' => '__STRING2__', + 'description' => '\')\'', + 'lookahead' => 0, + 'line' => 114 + }, 'Parse::RecDescent::InterpLit' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 115, + 'code' => '{ $return = { + personalname => $item{personalname} , + sourceroute => $item{sourceroute} , + mailboxname => $item{mailboxname} , + hostname => $item{hostname} , + } ; + bless($return, "Mail::IMAPClient::BodyStructure::Address"); + }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'addressstruct', + 'vars' => '', + 'line' => 114 + }, 'Parse::RecDescent::Rule' ), + 'sourceroute' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'STRING' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 108 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'subrule' => 'STRING', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 108 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 109, + 'code' => '{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => 108 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'sourceroute', + 'vars' => '', + 'line' => 108 + }, 'Parse::RecDescent::Rule' ), + 'subpart' => bless( { + 'impcount' => 0, + 'calls' => [ + 'part' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 2, + 'dircount' => 1, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => '(', + 'hashname' => '__STRING1__', + 'description' => '\'(\'', + 'lookahead' => 0, + 'line' => 235 + }, 'Parse::RecDescent::InterpLit' ), + bless( { + 'subrule' => 'part', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 235 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'pattern' => ')', + 'hashname' => '__STRING2__', + 'description' => '\')\'', + 'lookahead' => 0, + 'line' => 235 + }, 'Parse::RecDescent::InterpLit' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 236, + 'code' => '{ + $return = $item{part} ; + $return||defined($return); + }' + }, 'Parse::RecDescent::Action' ), + bless( { + 'hashname' => '__DIRECTIVE1__', + 'name' => '', + 'lookahead' => 0, + 'line' => 239, + 'code' => 'push @{$thisparser->{deferred}}, sub { ++$subpartCount; };' + }, 'Parse::RecDescent::Directive' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'subpart', + 'vars' => '', + 'line' => 235 + }, 'Parse::RecDescent::Rule' ), + 'textlines' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'NUMBER' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 58 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + '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' => 58 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 58, + 'code' => '{ $return = $item[1] || $item[2]; $return||defined($return); }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => 58 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'textlines', + 'vars' => '', + 'line' => 56 + }, 'Parse::RecDescent::Rule' ), + 'BARESTRING' => bless( { + 'impcount' => 0, + 'calls' => [], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 2, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => '^[)(\'"]', + 'hashname' => '__PATTERN1__', + 'description' => '/^[)(\'"]/', + 'lookahead' => -1, + 'rdelim' => '/', + 'line' => 40, + 'mod' => '', + 'ldelim' => '/' + }, 'Parse::RecDescent::Token' ), + bless( { + 'pattern' => '^(?!\\(|\\))(?:\\\\ |\\S)+', + 'hashname' => '__PATTERN2__', + 'description' => '/^(?!\\\\(|\\\\))(?:\\\\\\\\ |\\\\S)+/', + 'lookahead' => 0, + 'rdelim' => '/', + 'line' => 40, + 'mod' => '', + 'ldelim' => '/' + }, 'Parse::RecDescent::Token' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 40, + 'code' => '{ + $return = $item{__PATTERN1__} ; $return||defined($return); +}' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'BARESTRING', + 'vars' => '', + 'line' => 40 + }, 'Parse::RecDescent::Rule' ), + 'bodylang' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'STRING' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 104 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'STRING', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 104 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => 104 + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '2', + 'strcount' => 2, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => '(', + 'hashname' => '__STRING1__', + 'description' => '\'(\'', + 'lookahead' => 0, + 'line' => 104 + }, 'Parse::RecDescent::InterpLit' ), + bless( { + 'subrule' => 'STRING', + 'expected' => undef, + 'min' => 1, + 'argcode' => undef, + 'max' => 100000000, + 'matchrule' => 0, + 'repspec' => 's', + 'lookahead' => 0, + 'line' => 104 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'pattern' => ')', + 'hashname' => '__STRING2__', + 'description' => '\')\'', + 'lookahead' => 0, + 'line' => 104 + }, 'Parse::RecDescent::InterpLit' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 105, + 'code' => '{ $return = $item{NIL} || $item{\'STRING(s)\'} ;$return||defined($return);}' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => 104 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'bodylang', + 'vars' => '', + 'line' => 104 + }, 'Parse::RecDescent::Rule' ), + 'envelopestruct' => bless( { + 'impcount' => 0, + 'calls' => [ + 'date', + 'subject', + 'from', + 'sender', + 'replyto', + 'to', + 'cc', + 'bcc', + 'inreplyto', + 'messageid' + ], + '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' => 155 + }, 'Parse::RecDescent::InterpLit' ), + bless( { + 'subrule' => 'date', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 155 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'subject', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 155 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'from', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 155 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'sender', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 155 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'replyto', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 155 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'to', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 155 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'cc', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 155 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'bcc', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 155 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'inreplyto', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 155 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'messageid', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 155 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'pattern' => ')', + 'hashname' => '__STRING2__', + 'description' => '\')\'', + 'lookahead' => 0, + 'line' => 155 + }, 'Parse::RecDescent::InterpLit' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 156, + 'code' => '{ $return = {}; + foreach my $what (qw/date subject from sender replyto to cc bcc inreplyto messageid/) { + $return->{$what} = $item{$what}; + } + bless $return, "Mail::IMAPClient::BodyStructure::Envelope"; + $return||defined($return); + }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'envelopestruct', + 'vars' => '', + 'line' => 155 + }, 'Parse::RecDescent::Rule' ), + 'replyto' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'addressstruct' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 146 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 2, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => '(', + 'hashname' => '__STRING1__', + 'description' => '\'(\'', + 'lookahead' => 0, + 'line' => 146 + }, 'Parse::RecDescent::InterpLit' ), + bless( { + 'subrule' => 'addressstruct', + 'expected' => undef, + 'min' => 1, + 'argcode' => undef, + 'max' => 100000000, + 'matchrule' => 0, + 'repspec' => 's', + 'lookahead' => 0, + 'line' => 146 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'pattern' => ')', + 'hashname' => '__STRING2__', + 'description' => '\')\'', + 'lookahead' => 0, + 'line' => 146 + }, 'Parse::RecDescent::InterpLit' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 147, + 'code' => '{ $return = $item{NIL} || $item{\'addressstruct(s)\'} }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => 146 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'replyto', + 'vars' => '', + 'line' => 146 + }, 'Parse::RecDescent::Rule' ), + 'mailboxname' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'STRING' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 110 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'subrule' => 'STRING', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 110 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 111, + 'code' => '{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => 110 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'mailboxname', + 'vars' => '', + 'line' => 110 + }, 'Parse::RecDescent::Rule' ) + } + }, 'Parse::RecDescent' ); +} \ No newline at end of file diff --git a/Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/BodyStructure/Parse.pod b/Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/BodyStructure/Parse.pod new file mode 100755 index 0000000..dc2f67b --- /dev/null +++ b/Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/BodyStructure/Parse.pod @@ -0,0 +1,17 @@ +=head1 NAME + +Mail::IMAPClient::BodyStructure::Parse -- used internally by Mail::IMAPClient::BodyStructure + +=head1 DESCRIPTION + +This module is used internally by L +and is generated using L. It is not meant to be used +directly by other scripts nor is there much point in debugging it. + +=head1 SYNOPSIS + +This module is used internally by L +and is not meant to be used or called directly from applications. So +don't do that. + +=cut diff --git a/Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/MessageSet.pm b/Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/MessageSet.pm new file mode 100644 index 0000000..de58a35 --- /dev/null +++ b/Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/MessageSet.pm @@ -0,0 +1,285 @@ + +package Mail::IMAPClient::MessageSet; + +use warnings; +use strict; + +=head1 NAME + +Mail::IMAPClient::MessageSet -- ranges of message sequence nummers + +=cut + +use overload + '""' => "str" + , '.=' => sub {$_[0]->cat($_[1])} + , '+=' => sub {$_[0]->cat($_[1])} + , '-=' => sub {$_[0]->rem($_[1])} + , '@{}' => "unfold" + , fallback => 1; + +sub new +{ my $class = shift; + my $range = $class->range(@_); + bless \$range, $class; +} + +sub str { overload::StrVal( ${$_[0]} ) } + +sub _unfold_range($) +{ map { /(\d+)\:(\d+)/ ? ($1..$2) : $_ } + split /\,/, shift; +} + +sub rem +{ my $self = shift; + my %delete = map { ($_ => 1) } map { _unfold_range $_ } @_; + $$self = $self->range(map {$delete{$_} ? () : $_ } $self->unfold); + $self; +} + +sub cat +{ my $self = shift; + $$self = $self->range($$self, @_); + $self; +} + +sub range +{ my $class = shift; + + return $_[0] + if @_== 1 && ref $_[0] eq __PACKAGE__; + + my @msgs; + foreach my $m (@_) + { defined $m && length $m + or next; + + foreach my $mm (ref $m eq 'ARRAY' ? @$m : $m) + { push @msgs, _unfold_range $mm; + } + } + + @msgs + or return undef; + + + @msgs = sort {$a <=> $b} @msgs; + my $low = my $high = shift @msgs; + + my @ranges; + foreach my $m (@msgs) + { next if $m == $high; # double + + if($m == $high + 1) { $high = $m } + else + { push @ranges, $low == $high ? $low : "$low:$high"; + $low = $high = $m; + } + } + + push @ranges, $low == $high ? $low : "$low:$high" ; + join ",", @ranges; +} + + +sub unfold +{ my $self = shift; + wantarray ? ( _unfold_range $$self ) : [ _unfold_range $$self ]; +} + +=head2 SYNOPSIS + + my @msgs = $imap->search("SUBJECT","Virus"); # returns 1,3,4,5,6,9,10 + my $msgset = Mail::IMAPClient::MessageSet->new(@msgs); + print $msgset; # prints "1,3:6,9:10" + + # add message 14 to the set: + $msgset += 14; + print $msgset; # prints "1,3:6,9:10,14" + + # add messages 16,17,18,19, and 20 to the set: + $msgset .= "16,17,18:20"; + print $msgset; # prints "1,3:6,9:10,14,16:20" + + # Hey, I didn't really want message 17 in there; let's take it out: + $msgset -= 17; + print $msgset; # prints "1,3:6,9:10,14,16,18:20" + + # Now let's iterate over each message: + for my $msg (@$msgset) + { print "$msg\n"; # Prints: "1\n3\n4\n5\n6..16\n18\n19\n20\n" + } + print join("\n", @$msgset)."\n"; # same simpler + local $" = "\n"; print "@$msgset\n"; # even more simple + +=head2 DESCRIPTION + +The B module is designed to make life easier +for programmers who need to manipulate potentially large sets of IMAP +message UID's or sequence numbers. + +This module presents an object-oriented interface into handling your +message sets. The object reference returned by the L method is an +overloaded reference to a scalar variable that contains the message set's +compact RFC2060 representation. The object is overloaded so that using +it like a string returns this compact message set representation. You +can also add messages to the set (using either a '.=' operator or a '+=' +operator) or remove messages (with the '-=' operator). And if you use +it as an array reference, it will humor you and act like one by calling +L for you. + +RFC2060 specifies that multiple messages can be provided to certain IMAP +commands by separating them with commas. For example, "1,2,3,4,5" would +specify messages 1, 2, 3, 4, and (you guessed it!) 5. However, if you are +performing an operation on lots of messages, this string can get quite long. +So long that it may slow down your transaction, and perhaps even cause the +server to reject it. So RFC2060 also permits you to specifiy a range of +messages, so that messages 1, 2, 3, 4 and 5 can also be specified as +"1:5". + +This is where B comes in. It will convert +your message set into the shortest correct syntax. This could potentially +save you tons of network I/O, as in the case where you want to fetch the +flags for all messages in a 10000 message folder, where the messages +are all numbered sequentially. Delimited as commas, and making the +best-case assumption that the first message is message "1", it would take +48893 bytes to specify the whole message set using the comma-delimited +method. To specify it as a range, it takes just seven bytes (1:10000). + +Note that the L B method can be used as +a short-cut to specifying Cnew(@etc)>.) + +=head1 CLASS METHODS + +The only class method you need to worry about is B. And if you create +your B objects via L's +B method then you don't even need to worry about B. + +=head2 new + +Example: + + my $msgset = Mail::IMAPClient::MessageSet->new(@msgs); + +The B method requires at least one argument. That argument can be +either a message, a comma-separated list of messages, a colon-separated +range of messages, or a combination of comma-separated messages and +colon-separated ranges. It can also be a reference to an array of messages, +comma-separated message lists, and colon separated ranges. + +If more then one argument is supplied to B, then those arguments should +be more message numbers, lists, and ranges (or references to arrays of them) +just as in the first argument. + +The message numbers passed to B can really be any kind of number at +all but to be useful in a L session they should be either +message UID's (if your I parameter is true) or message sequence numbers. + +The B method will return a reference to a B +object. That object, when double quoted, will act just like a string whose +value is the message set expressed in the shortest possible way, with the +message numbers sorted in ascending order and with duplicates removed. + +=head1 OBJECT METHODS + +The only object method currently available to a B +object is the L method. + +=head2 unfold + +Example: + + my $msgset = $imap->Range( $imap->messages ) ; + my @all_messages = $msgset->unfold; + +The B method returns an array of messages that belong to the +message set. If called in a scalar context it returns a reference to the +array instead. + +=head1 OVERRIDDEN OPERATIONS + +B overrides a number of operators in order +to make manipulating your message sets easier. The overridden operations are: + +=head2 stringify + +Attempts to stringify a B object will result in +the compact message specification being returned, which is almost certainly +what you will want. + +=head2 Auto-increment + +Attempts to autoincrement a B object will +result in a message (or messages) being added to the object's message set. + +Example: + + $msgset += 34; + # Message #34 is now in the message set + +=head2 Concatenate + +Attempts to concatenate to a B object will +result in a message (or messages) being added to the object's message set. + +Example: + + $msgset .= "34,35,36,40:45"; + # Messages 34,35,36,40,41,42,43,44,and 45 are now in the message set + +The C<.=> operator and the C<+=> operator can be used interchangeably, but +as you can see by looking at the examples there are times when use of one +has an aesthetic advantage over use of the other. + +=head2 Autodecrement + +Attempts to autodecrement a B object will +result in a message being removed from the object's message set. + +Examples: + + $msgset -= 34; + # Message #34 is no longer in the message set + $msgset -= "1:10"; + # Messages 1 through 10 are no longer in the message set + +If you attempt to remove a message that was not in the original message set +then your resulting message set will be the same as the original, only more +expensive. However, if you attempt to remove several messages from the message +set and some of those messages were in the message set and some were not, +the additional overhead of checking for the messages that were not there +is negligable. In either case you get back the message set you want regardless +of whether it was already like that or not. + +=head1 AUTHOR + + David J. Kernen + The Kernen Consulting Group, Inc + +=head1 COPYRIGHT + + Copyright 1999, 2000, 2001, 2002 The Kernen Group, Inc. + All rights reserved. + +This program is free software; you can redistribute it and/or modify it +under the terms of either: + +=over 4 + +=item a) the "Artistic License" which comes with this Kit, or + +=item b) the GNU General Public License as published by the Free Software +Foundation; either version 1, or (at your option) any later version. + +=back + +This program is distributed in the hope that it will be useful, but +WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either the GNU +General Public License or the Artistic License for more details. All your +base are belong to us. + +=cut + +1; diff --git a/Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/Thread.grammar b/Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/Thread.grammar new file mode 100644 index 0000000..543c182 --- /dev/null +++ b/Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/Thread.grammar @@ -0,0 +1,18 @@ +# Atoms: + +NUMBER: /\d+/ + +# Rules: + +threadmember: NUMBER { $return = $item{NUMBER} ; } | + thread { $return = $item{thread} ; } + +thread: "(" threadmember(s) ")" + { + $return = $item{'threadmember(s)'}||undef; + } + +# Start: +start: /^\* THREAD /i thread(s?) { + $return=$item{'thread(s?)'}||undef; +} diff --git a/Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/Thread.pm b/Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/Thread.pm new file mode 100644 index 0000000..477246c --- /dev/null +++ b/Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/Thread.pm @@ -0,0 +1,1014 @@ +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/lib/Mail/IMAPClient/Thread.pod b/Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/Thread.pod new file mode 100755 index 0000000..c08ffeb --- /dev/null +++ b/Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/Thread.pod @@ -0,0 +1,21 @@ +package Mail::IMAPClient::Thread; +$Mail::IMAPClient::Thread::VERSION = "0.0.1"; +$Mail::IMAPClient::Thread::VERSION = "0.0.1"; + +=head1 NAME + +Mail::IMAPClient::Thread -- used internally by Mail::IMAPClient->thread + +=head1 DESCRIPTION + +This module is used internally by L and is +generated using L. It is not meant to be used directly by +other scripts nor is there much point in debugging it. + +=head1 SYNOPSIS + +This module is used internally by L and is not meant to +be used or called directly from applications. So don't do that. + +=cut + diff --git a/Mail-IMAPClient-2.99_02/pm_to_blib b/Mail-IMAPClient-2.99_02/pm_to_blib new file mode 100644 index 0000000..e69de29 diff --git a/Mail-IMAPClient-2.99_02/prepare_dist b/Mail-IMAPClient-2.99_02/prepare_dist new file mode 100755 index 0000000..fddf7da --- /dev/null +++ b/Mail-IMAPClient-2.99_02/prepare_dist @@ -0,0 +1,37 @@ +#!/usr/bin/perl + +use warnings; +use strict; + +use Parse::RecDescent 1.94; +use File::Slurp qw/read_file/; +use File::Copy qw/move/; + +sub build_parser($$); + +build_parser 'lib/Mail/IMAPClient/BodyStructure/Parse.grammar' + , 'Mail::IMAPClient::BodyStructure::Parse'; + +build_parser 'lib/Mail/IMAPClient/Thread.grammar' + , 'Mail::IMAPClient::Thread'; + +sub build_parser($$) +{ my ($grammarfn, $package) = @_; + + print "* building $package\n"; + + my $grammar = read_file $grammarfn + or die "cannot read grammar from $grammarfn: $!\n"; + + Parse::RecDescent->Precompile($grammar, $package); + + # clumpsy output by Parse::RecDescent + my $outfn = $package . '.pm'; + $outfn =~ s/.*\:\://; + + my $realfn = $grammarfn; + $realfn =~ s/\.\w+$/.pm/; + + move $outfn, $realfn + or die "cannot move $outfn to $realfn: $!\n"; +} diff --git a/Mail-IMAPClient-2.99_02/sample.perldb b/Mail-IMAPClient-2.99_02/sample.perldb new file mode 100755 index 0000000..0c299ec --- /dev/null +++ b/Mail-IMAPClient-2.99_02/sample.perldb @@ -0,0 +1 @@ +&parse_options("NonStop=1 LineInfo=mail_imapclient_db.out"); diff --git a/Mail-IMAPClient-2.99_02/t/basic.t b/Mail-IMAPClient-2.99_02/t/basic.t new file mode 100755 index 0000000..6e64b4b --- /dev/null +++ b/Mail-IMAPClient-2.99_02/t/basic.t @@ -0,0 +1,305 @@ +#!/usr/bin/perl + +my $uid; + +use warnings; +use strict; + +use Test::More; +use File::Temp 'tempfile'; + +my $debug = $ARGV[0]; + +my %parms; +my $range = 0; +my $uidplus = 0; +my $fast = 0; + +BEGIN +{ open TST, 'test.txt' + or plan skip_all => 'test parameters not provided'; + + while(my $l = ) + { chomp $l; + my($p,$v) = split /\=/, $l, 2; + s/(?:^\s+)|(?:\s+$)//g for $p, $v; + $parms{$p} = $v if $v; + } + + close TST; + + foreach my $p ( qw/server user passed/ ) + { $parms{$p} + or plan skip_all => "missing value for $_" + } + + plan tests => 40; +} + +use_ok('Mail::IMAPClient'); + +my $imap = Mail::IMAPClient->new + ( Server => $parms{server} + , Port => $parms{port} + , User => $parms{user} + , Password => $parms{passed} + , Authmechanism => $parms{authmechanism} + , Clear => 0 + , Timeout => 30 + , Fast_IO => $fast + , Uid => $uidplus + , Range => $range + + , Debug => 1 + , Debug_fh => ($debug ? IO::File->new('imap1.debug', 'w') : undef) +); + +ok(defined $imap, 'created client'); +die "Cannot log into $parms{server} as $parms{user}.\n" + . "Are server/user/password correct?\n" ; + +isa_ok($imap, 'Mail::IMAPClient'); + +$imap->Debug_fh->autoflush() if $imap->Debug_fh ; + +my $testmsg = <<__TEST_MSG; +Date: @{[$imap->Rfc822_date(time)]} +To: <$parms{user}\@$parms{server}> +From: Perl <$parms{user}\@$parms{server}> +Subject: Testing from pid $$ + +This is a test message generated by $0 during a 'make test' as part of +the installation of that nifty Mail::IMAPClient module from CPAN. Like +all things perl, it's way cool. +__TEST_MSG + +my $sep = $imap->separator; +ok(defined $sep, "separator is '$sep'"); + +my $isparent = $imap->is_parent("INBOX") || 0; +my ($target, $target2) = $isparent + ? ("INBOX${sep}IMAPClient_$$", "INBOX${sep}IMAPClient_2_$$") + : ("IMAPClient_$$", "IMAPClient_2_$$"); + +ok(1, "parent $isparent, target $target"); + +ok($imap->select('inbox'), "select inbox"); +ok($imap->create($target), "create target"); + +if(!$imap->is_parent($target)) +{ ok(1, "not parent, skipping quote test 1/3"); + ok(1, "not parent, skipping quote test 2/3"); + ok(1, "not parent, skipping quote test 3/3"); +} +elsif( eval {$imap->create( qq[ $target${sep}has "quotes" ] )} ) +{ ok(1, "supports quotes, create"); + ok($imap->select( qq[$target${sep}has "quotes"] ), 'select'); + $imap->close; + $imap->select('inbox'); + ok($imap->delete(qq($target${sep}has "quotes")), 'delete'); +} +else +{ if($imap->LastError =~ /NO Invalid.*name/) + { ok(1, "$parms{server} doesn't support quotes in folder names") } + else { ok(0, "failed creation with quotes") } + ok(1, "skipping 1/2 tests"); + ok(1, "skipping 2/2 tests"); +} + +ok($imap->exists($target), "exists $target"); +ok($imap->create($target2), "create $target2"); +ok($imap->exists($target2), "exists $target2"); + +$uid = $imap->append($target, $testmsg); +ok(defined $uid, "append test message to $target"); + +ok($imap->select($target), "select $target"); + +$target = ref $uid ? ($imap->search("ALL"))[0] : $uid; +my $size = $imap->size($target); +cmp_ok($size, '>', 0, "has size $size"); + +my $string = $imap->message_string($target); +ok($string, "returned string"); + +cmp_ok($size, '==', length($string), "string has size"); + +{ my ($fh, $fn) = tempfile UNLINK => 1; + ok($imap->message_to_file($fn, $target), "to file $fn"); + + cmp_ok(-s $fn, '==', $size, "correct size"); +} + +my $fields = $imap->search("HEADER","Message-id","NOT_A_MESSAGE_ID"); +ok(!defined $fields, 'message id does not exist'); + +my @seen = $imap->seen; +cmp_ok(scalar @seen, '==', 1, 'have seen 1'); + +ok($imap->deny_seeing(\@seen), 'deny seeing'); +my @unseen = $imap->unseen; +cmp_ok(scalar @unseen, '==', 1, 'have unseen 1'); + +ok($imap->see(\@seen), "let's see one"); +cmp_ok(scalar @seen, '==', 1, 'have seen 1'); + +$imap->deny_seeing(@seen); # reset + +$imap->Peek(1); +my $subject = $imap->parse_headers($seen[0],"Subject")->{Subject}[0]; +unlike(join("",$imap->flags($seen[0])), qr/\\Seen/i, 'Peek==1'); + +$imap->deny_seeing(@seen); +$imap->Peek(0); +$subject = $imap->parse_headers($seen[0],"Subject")->{Subject}[0]; +like(join("",$imap->flags($seen[0])), qr/\\Seen/i, 'Peek==0'); + +$imap->deny_seeing(@seen); +$imap->Peek(undef); +$subject = $imap->parse_headers($seen[0],"Subject")->{Subject}[0]; +unlike(join("",$imap->flags($seen[0])), qr/\\Seen/i, 'Peek==undef'); + +my $uid2 = $imap->copy($target2, 1); +ok($uid2, "copy $target2"); + +my @res = $imap->fetch(1,"RFC822.TEXT"); +ok(scalar @res, "fetch rfc822"); + +my $h = $imap->parse_headers(1, "Subject"); +ok($h, "got subject"); +like($h->{Subject}[0], qr/^Testing from pid/); + +$imap->select($target); +my @hits = $imap->search(SUBJECT => 'Testing'); +cmp_ok(scalar @hits, '==', 1); + +ok($imap->delete_message(@hits), 'delete hits'); +my $flaghash = $imap->flags(\@hits); +my $flagflag = 0; +foreach my $v ( values %$flaghash ) +{ $flagflag += grep /\\Deleted/, @$v; +} +cmp_ok($flagflag, '==', scalar @hits); + +my @nohits = $imap->search(qq(SUBJECT "Productioning")); +cmp_ok(scalar @nohits, '==', 0, 'no hits expected'); + +ok($imap->restore_message(@hits), 'restore messages'); +$flaghash = $imap->flags(\@hits); +$flagflag = 0; +foreach my $v (values(%$flaghash)){ + $flagflag += grep /\\Deleted/, @$v; +} +cmp_ok($flagflag, '==', scalar @hits); + +$imap->select($target2); +ok( $imap->delete_message(scalar($imap->search("ALL"))) + && $imap->close + && imap->delete($target2) , "delete $target2"); + +$imap->select("INBOX"); +$@ = ""; # clear $@ +@hits = $imap->search + (BEFORE => Mail::IMAPClient::Rfc2060_date(time), "UNDELETED"); +ok(!$@, 'search undeleted'); + +# +# Test migrate method +# + +my $im2 = Mail::IMAPClient->new + ( Server => $parms{server} + , Port => $parms{port} + , User => $parms{user} + , Password=> $parms{passed} + , Authmechanism => $parms{authmechanism} + , Clear => 0, + , Timeout => 30, + , Debug => $debug + , Debug_fh => ($debug ? IO::File->new(">./imap2.debug") : undef) + , Fast_IO => $fast + , Uid => $uidplus + ); +ok(defined $im2, 'started second imap client'); + +my $source = $target; +$imap->select($source) + or die "cannot select source $source: $@"; + +$imap->append($source, $testmsg) for 1..5; +$imap->close; +$imap->select($source); + +my $migtarget = $target. '_mirror'; + +$im2->create($migtarget) + or die "can't create $migtarget: $@" ; + +$im2->select($migtarget) + or die "can't select $migtarget: $@"; + +$imap->migrate($im2,scalar($imap->search("ALL")),$migtarget) + or die "couldn't migrate: $@"; + +$im2->close; +$im2->select($migtarget) + or die "can't select $migtarget: $@"; + +cmp_ok($@, 'eq', ''); + +# +# +# + +my $total_bytes1 = 0; +for ($imap->search("ALL")) +{ my $s = $imap->size($_); + $total_bytes1 += $s; + print "Size of msg $_ is $s\n" if $debug +}; + +my $total_bytes2 = 0; +for ($im2->search("ALL")) +{ my $s = $im2->size($_); + $total_bytes2 += $s; print "Size of msg $_ is $s\n" if $debug +} + +cmp_ok($@, '==', ''); +cmp_ok($total_bytes1, '==', $total_bytes2, 'size source==target'); + +# cleanup +$im2->select($migtarget); +$im2->delete_message(@{$im2->messages}) + if $im2->message_count; +$im2->close; +$im2->delete($migtarget); +$im2->logout; + +# +# Test IDLE +# + +if($imap->has_capability("IDLE") ) +{ eval { my $idle = $imap->idle; sleep 1; $imap->done($idle) }; + cmp_ok($@, 'eq', ''); +} +else +{ ok(1, "idle not supported"); +} + +$imap->select('inbox'); +if( $imap->rename($target,"${target}NEW") ) +{ ok(1, 'rename'); + $imap->close; + $imap->select("${target}NEW") ; + $imap->delete_message(@{$imap->messages}) if $imap->message_count; + $imap->close; + $imap->delete("${target}NEW") ; +} +else +{ ok(0, 'rename failed'); + $imap->delete_message(@{$imap->messages}) + if $imap->message_count; + $imap->close; + $imap->delete($target) ; +} diff --git a/Mail-IMAPClient-2.99_02/t/bodystructure.t b/Mail-IMAPClient-2.99_02/t/bodystructure.t new file mode 100755 index 0000000..1d8f1dd --- /dev/null +++ b/Mail-IMAPClient-2.99_02/t/bodystructure.t @@ -0,0 +1,29 @@ +#!/usr/bin/perl + +use warnings; +use strict; + +use Test::More tests => 8; + +use_ok('Mail::IMAPClient::BodyStructure'); + +my $bs = <<'END_OF_BS'; +(BODYSTRUCTURE ("TEXT" "PLAIN" ("CHARSET" "us-ascii") NIL NIL "7BIT" 511 20 NIL NIL NIL))^M +END_OF_BS + +my $bsobj = Mail::IMAPClient::BodyStructure->new($bs); +ok(defined $bsobj, 'parsed first'); +is($bsobj->bodytype, 'TEXT', 'bodytype'); +is($bsobj->bodysubtype, 'PLAIN', 'bodysubtype'); + +my $bs2 = <<'END_OF_BS2'; +(BODYSTRUCTURE (("TEXT" "PLAIN" ("CHARSET" "us-ascii") NIL NIL "7BIT" 2 1 NIL NIL NIL)("MESSAGE" "RFC822" NIL NIL NIL "7BIT" 3930 ("Tue, 16 Jul 2002 15:29:17 -0400" "Re: [Fwd: Here is the the list of uids]" (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("David J Kavid" NIL "david.kavid" "generic.com")) NIL NIL "<72f9a217.a21772f9@generic.com>") (("TEXT" "PLAIN" ("CHARSET" "us-ascii") NIL NIL "7BIT" 369 11 NIL NIL NIL)("MESSAGE" "RFC822" NIL NIL NIL "7BIT" 2599 ("Tue, 9 Jul 2002 13:42:04 -0400" "Here is the the list of uids" (("Nicholas Kringle" NIL "nicholas.kringle" "generic.com")) (("Nicholas Kringle" NIL "nicholas.kringle" "generic.com")) (("Nicholas Kringle" NIL "nicholas.kringle" "generic.com")) (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("Richard W Continued" NIL "richard.continued" "generic.com")) NIL NIL "<015401c2276f$f09b7c10$59cab08c@one.two.generic.com>") ((("TEXT" "PLAIN" ("CHARSET" "iso-8859-1") NIL NIL "QUOTED-PRINTABLE" 256 10 NIL NIL NIL)("TEXT" "HTML" ("CHARSET" "iso-8859-1") NIL NIL "QUOTED-PRINTABLE" 791 22 NIL NIL NIL) "ALTERNATIVE" ("BOUNDARY" "----=_NextPart_001_0151_01C2274E.6969D0F0") NIL NIL) "MIXED" ("BOUNDARY" "----=_NextPart_000_0150_01C2274E.6969D0F0") NIL NIL) 75 NIL NIL NIL) "MIXED" ("BOUNDARY" "--1f34eac2082b02") NIL ("EN")) 118 NIL NIL NIL) "MIXED" ("BOUNDARY" "------------F600BD8FDDD648ABA72A09E0") NIL NIL)) +END_OF_BS2 + +$bsobj = Mail::IMAPClient::BodyStructure->new($bs2) ; +ok(defined $bsobj, 'parsed second'); +is($bsobj->bodytype, 'MULTIPART', 'bodytype'); +is($bsobj->bodysubtype, 'MIXED', 'bodysubtype'); + +is(join("#",$bsobj->parts), + "1#2#2.HEAD#2.1#2.2#2.2.HEAD#2.2.1#2.2.1.1#2.2.1.2", 'parts'); diff --git a/Mail-IMAPClient-2.99_02/t/messageset.t b/Mail-IMAPClient-2.99_02/t/messageset.t new file mode 100755 index 0000000..00a4289 --- /dev/null +++ b/Mail-IMAPClient-2.99_02/t/messageset.t @@ -0,0 +1,32 @@ +#!/usr/bin/perl + +use warnings; +use strict; + +use Test::More tests => 7; + +use_ok('Mail::IMAPClient::MessageSet'); + +my $one = q/1:4,3:6,10:15,20:25,2:8/; +my $range = Mail::IMAPClient::MessageSet->new($one); +is($range, "1:8,10:15,20:25", 'range simplify'); + +is( join(",",$range->unfold) + , "1,2,3,4,5,6,7,8,10,11,12,13,14,15,20,21,22,23,24,25" + , 'range unfold'); + +$range .= "30,31,32,31:34,40:44"; +is($range, "1:8,10:15,20:25,30:34,40:44", 'overload concat'); + +is( join(",",$range->unfold) + , "1,2,3,4,5,6,7,8,10,11,12,13,14,15,20,21,22,23,24,25," + . "30,31,32,33,34,40,41,42,43,44" + , 'unfold extended'); + +$range -= "1:2"; +is($range, "3:8,10:15,20:25,30:34,40:44", 'overload subtract'); + +is( join(",",$range->unfold) + , "3,4,5,6,7,8,10,11,12,13,14,15,20,21,22,23,24,25," + . "30,31,32,33,34,40,41,42,43,44" + , 'subtract unfold'); diff --git a/Mail-IMAPClient-2.99_02/t/pod.t b/Mail-IMAPClient-2.99_02/t/pod.t new file mode 100755 index 0000000..68f9c3f --- /dev/null +++ b/Mail-IMAPClient-2.99_02/t/pod.t @@ -0,0 +1,9 @@ +#!/usr/bin/perl +use warnings; +use strict; + +use Test::More; +eval "use Test::Pod 1.00"; + +plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; +all_pod_files_ok(); diff --git a/Mail-IMAPClient-2.99_02/t/thread.t b/Mail-IMAPClient-2.99_02/t/thread.t new file mode 100755 index 0000000..78c04c7 --- /dev/null +++ b/Mail-IMAPClient-2.99_02/t/thread.t @@ -0,0 +1,31 @@ +#!/usr/bin/perl + +use warnings; +use strict; + +use Test::More tests => 7; + +use_ok('Mail::IMAPClient::Thread'); + +my $t1 = <<'e1'; +* THREAD (166)(167)(168)(169)(172)(170)(171)(173)(174 175 176 178 181 180)(179)(177 183 182 188 184 185 186 187 189)(190)(191)(192)(193)(194 195)(196 197 198)(199)(200 202)(201)(203)(204)(205)(206 207)(208) +e1 + +my $t2 = <<'e2'; +* THREAD (166)(167)(168)(169)(172)((170)(179))(171)(173)((174)(175)(176)(178)(181)(180))((177)(183)(182)(188 (184)(189))(185 186)(187))(190)(191)(192)(193)((194)(195 196))(197 198)(199)(200 202)(201)(203)(204)(205 206 207)(208) +e2 + +my $parser = Mail::IMAPClient::Thread->new; +ok(defined $parser, 'created parser'); + +isa_ok($parser, 'Parse::RecDescent'); # !!! + +my $thr1 = $parser->start($t1) ; +ok(defined $thr1, 'thread1 start'); + +cmp_ok(scalar(@$thr1), '==', 25); + +my $thr2 = $parser->start($t2); +ok(defined $thr2, 'thread2 start'); + +cmp_ok(scalar(@$thr2), '==', 23); diff --git a/Mail-IMAPClient-2.99_02/test.txt b/Mail-IMAPClient-2.99_02/test.txt new file mode 100644 index 0000000..a17a0ee --- /dev/null +++ b/Mail-IMAPClient-2.99_02/test.txt @@ -0,0 +1,5 @@ +server=localhost +user=tata@est.belle +passed=XXXXXXXXX +port=143 +authmechanism=LOGIN diff --git a/Mail-IMAPClient-2.99_02/test_template.txt b/Mail-IMAPClient-2.99_02/test_template.txt new file mode 100755 index 0000000..6c6db28 --- /dev/null +++ b/Mail-IMAPClient-2.99_02/test_template.txt @@ -0,0 +1,5 @@ +server=imap.server.hostname +user=username +passed=password +port=143 +authmechanism=LOGIN diff --git a/Makefile b/Makefile index 5f61128..9f6f4fe 100644 --- a/Makefile +++ b/Makefile @@ -1,5 +1,5 @@ -# $Id: Makefile,v 1.16 2007/06/15 04:08:28 gilles Exp $ +# $Id: Makefile,v 1.17 2007/10/30 00:49:43 gilles Exp gilles $ TARGET=imapsync @@ -104,9 +104,9 @@ clean_dist: lfo: dist niouze_lfo lfo_upload niouze lfo_upload: - rsync -av --delete . \ + rsync -avH --delete . \ /home/gilles/public_html/www.linux-france.org/html/prj/$(TARGET)/ - rsync -av --delete ../prepa_dist/imapsync-*tgz \ + rsync -avH --delete ../prepa_dist/imapsync-*tgz \ /home/gilles/public_html/www.linux-france.org/ftp/prj/$(TARGET)/ sh ~/memo/lfo-rsync diff --git a/README b/README index 7d1d4a2..e9434f5 100644 --- a/README +++ b/README @@ -1,32 +1,31 @@ +NAME imapsync - IMAP synchronisation, sync, copy or migration tool. Synchronise mailboxes between two imap servers. Good at IMAP migration. More than 32 different IMAP server softwares supported with success. - $Revision: 1.223 $ + $Revision: 1.233 $ INSTALL imapsync works fine under any Unix OS with perl. imapsync works fine under Windows 2000 (at least) and ActiveState's 5.8 Perl imapsync is already available directly on the following distributions (at least): - FreeBSD, Debian, Gentoo, NetBSD, Darwin, Mandriva. - - imapsync is already available directly on the following distributions: - OpenBSD + FreeBSD, Debian, Ubuntu, Gentoo, NetBSD, Darwin, Mandriva. Get imapsync at http://www.linux-france.org/prj/imapsync/dist/ You'll find a compressed tarball called imapsync-x.xx.tgz where x.xx is the version number. Untar the tarball where - you want : + you want (on Unix): tar xzvf imapsync-x.xx.tgz - Go into the directory imapsync-x.xx and read the INSTALL - file. - - The freshmeat record is http://freshmeat.net/projects/imapsync/ + Go into the directory imapsync-x.xx and read the INSTALL file. + The INSTALL file is also at + http://www.linux-france.org/prj/imapsync/INSTALL (for windows users) + + The freshmeat record is at http://freshmeat.net/projects/imapsync/ SYNOPSIS imapsync [options] @@ -143,9 +142,10 @@ SECURITY You may authenticate as one user (typically an admin user), but be authorized as someone else, which means you don't need to know every user's personal password. Specify --authuser1 "adminuser" to enable this - on host1. In this case, --authmech1 PLAIN will be used, but otherwise, - --authmech1 CRAM-MD5 is the default. Same behavior with the --authuser2 - option. + on host1. 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 "adminuser", it will not work. Same behavior with the + --authuser2 option. EXIT STATUS imapsync will exit with a 0 status (return code) if everything went @@ -204,17 +204,17 @@ IMAP SERVERS Failure stories reported with the following 4 imap servers : - MailEnable 1.54 (Proprietary) http://www.mailenable.com/ - - DBMail 2.0.7 (GPL). But DBMail 1.2.1 works. + - DBMail 0.9, 2.0.7 (GPL). But DBMail 1.2.1 works. Patient and confident testers are welcome. - dkimap4 2.39 - Imail 7.04 (maybe). - Success stories reported with the following 33 imap servers (softwares + Success stories reported with the following 34 imap servers (softwares names are in alphabetic order) : - BincImap 1.2.3 (GPL) (http://www.bincimap.org/) - CommuniGatePro server (Redhat 8.0) - - Courier IMAP 1.5.1, 2.2.0, 2.1.1, 2.2.1 (GPL) + - Courier IMAP 1.5.1, 2.2.0, 2.1.1, 2.2.1, 3.0.8 (GPL) (http://www.courier-mta.org/) - Critical Path (7.0.020) - Cyrus IMAP 1.5, 1.6, 2.1, 2.1.15, 2.1.16, 2.1.18 @@ -222,6 +222,7 @@ IMAP SERVERS v2.2.3-Invoca-RPM-2.2.3-8, 2.3-alpha (OSI Approved), v2.2.12-Invoca-RPM-2.2.12-3.RHEL4.1, + 2.2.13, v2.3.1-Invoca-RPM-2.3.1-2.7.fc5, (http://asg.web.cmu.edu/cyrus/) - David Tobit V8 (proprietary Message system). @@ -232,6 +233,7 @@ IMAP SERVERS 1.0.0 [dest] (LGPL) (http://www.dovecot.org/) - Domino (Notes) 6.5, 5.0.6, 5.0.7, 7.0.2, 6.0.2CF1, 7.0.1 [from] - Eudora WorldMail v2 + - GMX IMAP4 StreamProxy. - Groupwise IMAP (Novell) 6.x and 7.0. Buggy so see the FAQ. - iPlanet Messaging server 4.15, 5.1, 5.2 - IMail 7.15 (Ipswitch/Win2003), 8.12 @@ -304,22 +306,23 @@ Links Entries for imapsync: http://www.imap.org/products/showall.php SIMILAR SOFTWARES - imap_tools : http://www.athensfbc.com/imap_tools - offlineimap : http://gopher.quux.org:70/devel/offlineimap/ - mailsync : http://mailsync.sourceforge.net/ - imapxfer : http://www.washington.edu/imap/ - part of the imap-utils from UW. - mailutil : replace imapxfer in - part of the imap-utils from UW. - http://www.gsp.com/cgi-bin/man.cgi?topic=mailutil - imaprepl : http://www.bl0rg.net/software/ - http://freshmeat.net/projects/imap-repl/ - imap_migrate: http://freshmeat.net/projects/imapmigration/ - imapcopy : http://home.arcor.de/armin.diehl/imapcopy/imapcopy.html - migrationtool http://sourceforge.net/projects/migrationtool/ - pop2imap : http://www.linux-france.org/prj/pop2imap/ + imap_tools : http://www.athensfbc.com/imap_tools + offlineimap : http://software.complete.org/offlineimap + mailsync : http://mailsync.sourceforge.net/ + imapxfer : http://www.washington.edu/imap/ + part of the imap-utils from UW. + mailutil : replace imapxfer in + part of the imap-utils from UW. + http://www.gsp.com/cgi-bin/man.cgi?topic=mailutil + imaprepl : http://www.bl0rg.net/software/ + http://freshmeat.net/projects/imap-repl/ + imap_migrate : http://freshmeat.net/projects/imapmigration/ + imapcopy : http://home.arcor.de/armin.diehl/imapcopy/imapcopy.html + migrationtool : http://sourceforge.net/projects/migrationtool/ + imapmigrate : http://sourceforge.net/projects/cyrus-utils/ + pop2imap : http://www.linux-france.org/prj/pop2imap/ Feedback (good or bad) will be always welcome. - $Id: imapsync,v 1.223 2007/06/15 04:08:44 gilles Exp gilles $ + $Id: imapsync,v 1.233 2007/10/30 03:20:53 gilles Exp gilles $ diff --git a/TODO b/TODO index 353bee8..7d2f1fe 100644 --- a/TODO +++ b/TODO @@ -1,6 +1,22 @@ TODO file for imapsync ---------------------- +Add --justlogin --justlogin1 --justlogin2 options +to check username and passwort. + +Change IsUnconnected behavior. If IsUnconnected then print +stats and die. Avoid logout. + +Add --subscribeall option. +Is it possible to have a option that subscribes all folders regardless of +subscription on the source server? Perhaps --subscribeall? + +Add stdin/stdout filter before transfer: +"Now i asked me, how to modify your perl program to work with +that - in example, to write each mail to stdout, pipe that to the +convertion program, and read the result from stdin - and this all before +the mail will transfer to the target imap-server" + Add a --tmpdir option. Fix bug with folder names starting with an asterisk: *Archiv diff --git a/VERSION b/VERSION index 19e19a2..217e329 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -1.223 +1.233 diff --git a/freshmeat_submition.inp b/freshmeat_submition.inp index 32d87dd..d9da769 100644 --- a/freshmeat_submition.inp +++ b/freshmeat_submition.inp @@ -5,8 +5,8 @@ #RELEASE_FOCUS="Code cleanup" #RELEASE_FOCUS="Minor feature enhancements" #RELEASE_FOCUS="Major feature enhancements" -RELEASE_FOCUS="Minor bugfixes" -#RELEASE_FOCUS="Major bugfixes" +#RELEASE_FOCUS="Minor bugfixes" +RELEASE_FOCUS="Major bugfixes" #RELEASE_FOCUS="Minor security fixes" #RELEASE_FOCUS="Major security fixes" @@ -14,6 +14,16 @@ RELEASE_FOCUS="Minor bugfixes" #TEXT_BODY="Updated documentation" #TEXT_BODY="Bug fix: be case insensitive with header keywords." #TEXT_BODY="Bug fix: rewrote the way to store messages to avoid freeze problems with some imap servers" -TEXT_BODY="Bug fix: Allow long usernames with md5 authentification." - - +#TEXT_BODY="Bug fix: Allow long usernames with md5 authentification." +TEXT_BODY="Bug fixes: +- Avoid infinite loop with bad hostname. +- Works without patch on MSWin32 systems. +- Updated help message : avoid --authuser and --authmech1 SOMETHING +- Uppercase --authmech input. +- Date with minus %d-%b-%Y (RFC compliant) +- Added Date::Manip dependency. +- Added Dovecot 1.0.0 [dest] success. +- Added Deerfield VisNetic MailServer 5.8.6 [from] success. +- Turn to --nofastio1 --nofastio2 by default. +- Flags \Recent can be uppercase \RECENT now. +" diff --git a/imapsync b/imapsync index f6ce177..f5236d3 100755 --- a/imapsync +++ b/imapsync @@ -1,6 +1,7 @@ #!/usr/bin/perl -w =pod + =head1 NAME imapsync - IMAP synchronisation, sync, copy or migration @@ -8,7 +9,7 @@ tool. Synchronise mailboxes between two imap servers. Good at IMAP migration. More than 32 different IMAP server softwares supported with success. -$Revision: 1.223 $ +$Revision: 1.233 $ =head1 INSTALL @@ -16,24 +17,22 @@ $Revision: 1.223 $ imapsync works fine under Windows 2000 (at least) and ActiveState's 5.8 Perl imapsync is already available directly on the following distributions (at least): - FreeBSD, Debian, Gentoo, NetBSD, Darwin, Mandriva. - - imapsync is already available directly on the following distributions: - OpenBSD + FreeBSD, Debian, Ubuntu, Gentoo, NetBSD, Darwin, Mandriva. Get imapsync at http://www.linux-france.org/prj/imapsync/dist/ You'll find a compressed tarball called imapsync-x.xx.tgz where x.xx is the version number. Untar the tarball where - you want : + you want (on Unix): tar xzvf imapsync-x.xx.tgz - Go into the directory imapsync-x.xx and read the INSTALL - file. - - The freshmeat record is http://freshmeat.net/projects/imapsync/ + Go into the directory imapsync-x.xx and read the INSTALL file. + The INSTALL file is also at + http://www.linux-france.org/prj/imapsync/INSTALL (for windows users) + + The freshmeat record is at http://freshmeat.net/projects/imapsync/ =head1 SYNOPSIS @@ -83,6 +82,7 @@ The option list : =cut # comment + =pod =head1 DESCRIPTION @@ -166,9 +166,10 @@ You may authenticate as one user (typically an admin user), but be authorized as someone else, which means you don't need to know every user's personal password. Specify --authuser1 "adminuser" to enable this on host1. In this -case, --authmech1 PLAIN will be used, but otherwise, ---authmech1 CRAM-MD5 is the default. Same behavior with the ---authuser2 option. +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 "adminuser", it will not work. +Same behavior with the --authuser2 option. =head1 EXIT STATUS @@ -236,17 +237,17 @@ In your report, please include: Failure stories reported with the following 4 imap servers : - MailEnable 1.54 (Proprietary) http://www.mailenable.com/ - - DBMail 2.0.7 (GPL). But DBMail 1.2.1 works. + - DBMail 0.9, 2.0.7 (GPL). But DBMail 1.2.1 works. Patient and confident testers are welcome. - dkimap4 2.39 - Imail 7.04 (maybe). -Success stories reported with the following 33 imap servers +Success stories reported with the following 34 imap servers (softwares names are in alphabetic order) : - BincImap 1.2.3 (GPL) (http://www.bincimap.org/) - CommuniGatePro server (Redhat 8.0) - - Courier IMAP 1.5.1, 2.2.0, 2.1.1, 2.2.1 (GPL) + - Courier IMAP 1.5.1, 2.2.0, 2.1.1, 2.2.1, 3.0.8 (GPL) (http://www.courier-mta.org/) - Critical Path (7.0.020) - Cyrus IMAP 1.5, 1.6, 2.1, 2.1.15, 2.1.16, 2.1.18 @@ -254,6 +255,7 @@ Success stories reported with the following 33 imap servers v2.2.3-Invoca-RPM-2.2.3-8, 2.3-alpha (OSI Approved), v2.2.12-Invoca-RPM-2.2.12-3.RHEL4.1, + 2.2.13, v2.3.1-Invoca-RPM-2.3.1-2.7.fc5, (http://asg.web.cmu.edu/cyrus/) - David Tobit V8 (proprietary Message system). @@ -264,6 +266,7 @@ Success stories reported with the following 33 imap servers 1.0.0 [dest] (LGPL) (http://www.dovecot.org/) - Domino (Notes) 6.5, 5.0.6, 5.0.7, 7.0.2, 6.0.2CF1, 7.0.1 [from] - Eudora WorldMail v2 + - GMX IMAP4 StreamProxy. - Groupwise IMAP (Novell) 6.x and 7.0. Buggy so see the FAQ. - iPlanet Messaging server 4.15, 5.1, 5.2 - IMail 7.15 (Ipswitch/Win2003), 8.12 @@ -356,24 +359,25 @@ Entries for imapsync: =head1 SIMILAR SOFTWARES - imap_tools : http://www.athensfbc.com/imap_tools - offlineimap : http://gopher.quux.org:70/devel/offlineimap/ - mailsync : http://mailsync.sourceforge.net/ - imapxfer : http://www.washington.edu/imap/ - part of the imap-utils from UW. - mailutil : replace imapxfer in - part of the imap-utils from UW. - http://www.gsp.com/cgi-bin/man.cgi?topic=mailutil - imaprepl : http://www.bl0rg.net/software/ - http://freshmeat.net/projects/imap-repl/ - imap_migrate: http://freshmeat.net/projects/imapmigration/ - imapcopy : http://home.arcor.de/armin.diehl/imapcopy/imapcopy.html - migrationtool http://sourceforge.net/projects/migrationtool/ - pop2imap : http://www.linux-france.org/prj/pop2imap/ + imap_tools : http://www.athensfbc.com/imap_tools + offlineimap : http://software.complete.org/offlineimap + mailsync : http://mailsync.sourceforge.net/ + imapxfer : http://www.washington.edu/imap/ + part of the imap-utils from UW. + mailutil : replace imapxfer in + part of the imap-utils from UW. + http://www.gsp.com/cgi-bin/man.cgi?topic=mailutil + imaprepl : http://www.bl0rg.net/software/ + http://freshmeat.net/projects/imap-repl/ + imap_migrate : http://freshmeat.net/projects/imapmigration/ + imapcopy : http://home.arcor.de/armin.diehl/imapcopy/imapcopy.html + migrationtool : http://sourceforge.net/projects/migrationtool/ + imapmigrate : http://sourceforge.net/projects/cyrus-utils/ + pop2imap : http://www.linux-france.org/prj/pop2imap/ Feedback (good or bad) will be always welcome. -$Id: imapsync,v 1.223 2007/06/15 04:08:44 gilles Exp gilles $ +$Id: imapsync,v 1.233 2007/10/30 03:20:53 gilles Exp gilles $ @@ -432,14 +436,14 @@ my( use vars qw ($opt_G); # missing code for this will be option. -$rcs = ' $Id: imapsync,v 1.223 2007/06/15 04:08:44 gilles Exp gilles $ '; +$rcs = ' $Id: imapsync,v 1.233 2007/10/30 03:20:53 gilles Exp gilles $ '; $rcs =~ m/,v (\d+\.\d+)/; $VERSION = ($1) ? $1 : "UNKNOWN"; my $VERSION_IMAPClient = $Mail::IMAPClient::VERSION; -check_lib_version() or - die "Upgrade perl lib Mail::IMAPClient to release 2.2.9 at least\n"; +#check_lib_version() or +# die "Upgrade perl lib Mail::IMAPClient to release 2.2.9 at least\n"; $mess_size_total_trans = 0; @@ -469,10 +473,10 @@ $error=0; my $banner = join("", '$RCSfile: imapsync,v $ ', - '$Revision: 1.223 $ ', - '$Date: 2007/06/15 04:08:44 $ ', + '$Revision: 1.233 $ ', + '$Date: 2007/10/30 03:20:53 $ ', "\n",localhost_info(), - "Mail::IMAPClient version used here is ", + " and the module Mail::IMAPClient version used here is ", $VERSION_IMAPClient,"\n", "Command line used :\n", "$0 @ARGV\n", @@ -509,17 +513,20 @@ sub connect_imap { $imap->Server($host); $imap->Port($port); $imap->Debug($debugimap); - $imap->connect() + $imap->connect2() or die "Can not open imap connection on [$host] : $@\n"; } sub localhost_info { - my($infos) = join("", "Here is a $OSNAME system", - " ", join(" ", uname()), - ")\nwith perl ", - sprintf("%vd", $PERL_VERSION), "\n"); - + my($infos) = join("", + "Here is a [$OSNAME] system (", + join(" ", + uname(), + ), + ")\n", + "with perl ", + sprintf("%vd", $PERL_VERSION)); return($infos); } @@ -550,6 +557,9 @@ if(defined($authmd5) and not($authmd5)) { $authmech2 ||= $authuser2 ? 'PLAIN' : 'CRAM-MD5'; } +$authmech1 = uc($authmech1); +$authmech2 = uc($authmech2); + $authuser1 ||= $user1; $authuser2 ||= $user2; @@ -647,7 +657,7 @@ sub login_imap { if ($ssl) { $imap->State(Mail::IMAPClient::Connected); } else { - $imap->connect() + $imap->connect2() or die "Can not open imap connection on [$host] with user [$user] : $@\n"; } print "Banner : ", server_banner($imap); @@ -1160,7 +1170,7 @@ FOLDER: foreach my $f_fold (@f_folders) { $debug and print "internal date from 1: [$d]\n"; require Date::Manip; Date::Manip->import(qw(ParseDate Date_Cmp UnixDate)); - $d = UnixDate(ParseDate($d), "%d %b %Y %H:%M:%S %z"); + $d = UnixDate(ParseDate($d), "%d-%b-%Y %H:%M:%S %z"); $d = "\"$d\""; $debug and print "internal date from 1: [$d] (fixed)\n"; } @@ -1174,17 +1184,22 @@ FOLDER: foreach my $f_fold (@f_folders) { print "flags from : [$flags_f][$d]\n"; last FOLDER if $to->IsUnconnected(); unless ($dry) { - #unless($new_id = $to->append_string($t_fold,$string, $flags_f, $d)){ - unless($new_id = $to->append_file2($t_fold, $message_file, "", $flags_f, $d)){ + + if ($OSNAME eq "MSWin32") { + $new_id = $to->append_string($t_fold,$string, $flags_f, $d); + } + else { + $new_id = $to->append_file2($t_fold, $message_file, "", $flags_f, $d); + } + unless($new_id){ warn "Couldn't append msg #$f_msg (Subject:[". $from->subject($f_msg)."]) to folder $t_fold: ", $to->LastError, "\n"; $error++; $mess_size_total_error += $f_size; next MESS; - }else{ - # good + # good # $new_id is an id if the IMAP server has the # UIDPLUS capability else just a ref print "Copied msg id [$f_msg] to folder $t_fold msg id [$new_id]\n"; @@ -1515,6 +1530,7 @@ sub string_to_file { sub usage { + my $localhost_info = localhost_info(); print < : "from" imap server. Mandatory. --port1 : port to connect on host1. Default is 143. --user1 : user to login on host1. Mandatory. ---authuser1 : user to auth with on host1 (admin user). +--authuser1 : user to auth with on host1 (admin user). + Avoid using --authmech1 SOMETHING with --authuser1. --password1 : password for the user1. Dangerous, use --passfile1 --passfile1 : password file for the user1. Contains the password. --host2 : "destination" imap server. Mandatory. @@ -1535,7 +1552,7 @@ Several options are mandatory. --passfile2 : password file for the user2. Contains the password. --noauthmd5 : don't use MD5 authentification. --authmech1 : auth mechanism to use with host1: - PLAIN, LOGIN, CRAM-MD5 etc. + PLAIN, LOGIN, CRAM-MD5 etc. Use UPPERCASE. --authmech2 : auth mechanism to use with host2. See --authmech1 --ssl1 : use an SSL connection on host1. --ssl2 : use an SSL connection on host2. @@ -1642,7 +1659,7 @@ $0 \\ --host1 imap.truc.org --user1 foo --passfile1 /etc/secret1 \\ --host2 imap.trac.org --user2 bar --passfile2 /etc/secret2 - +$localhost_info Mail::IMAPClient version is $Mail::IMAPClient::VERSION $rcs imapsync copyleft is the GNU General Public License. @@ -2132,3 +2149,65 @@ sub _cram_md5_2 { $client->Password()); return MIME::Base64::encode($client->User() . " $hmac", ""); } + + +sub connect2 { + my $self = shift; + + $self->Port(143) + if defined ($IO::Socket::INET::VERSION) + and $IO::Socket::INET::VERSION eq '1.25' + and !$self->Port; + %$self = (%$self, @_); + my $sock = ($self->Ssl ? IO::Socket::SSL->new : IO::Socket::INET->new); + my $dp = ($self->Ssl ? 'imaps(993)' : 'imap(143)'); + #print "i01\n"; + my $ret = $sock->configure({ + PeerAddr => $self->Server , + PeerPort => $self->Port||$dp , + Proto => 'tcp' , + Timeout => $self->Timeout||0 , + Debug => $self->Debug , + }); + #print "i02\n"; + unless ( defined($ret) ) { + $self->LastError( "$@\n"); + $@ = "$@"; + carp "$@" + unless defined wantarray; + return undef; + } + #print "i03\n"; + $self->Socket($sock); + $self->State(Connected); + + $sock->autoflush(1) ; + + my ($code, $output); + $output = ""; + + until ( $code ) { + + $output = $self->_read_line or return undef; + for my $o (@$output) { + $self->_debug("Connect: Received this from readline: " . + join("/",@$o) . "\n"); + $self->_record($self->Count,$o); # $o is a ref + next unless $o->[TYPE] eq "OUTPUT"; + ($code) = $o->[DATA] =~ /^\*\s+(OK|BAD|NO)/i ; + } + + } + + if ($code =~ /BYE|NO /) { + $self->State(Unconnected); + return undef ; + } + + if ($self->User and $self->Password) { + return $self->login ; + } else { + return $self; + } +} + diff --git a/imapsync2 b/imapsync2 deleted file mode 100644 index 274f5cf..0000000 --- a/imapsync2 +++ /dev/null @@ -1,2071 +0,0 @@ -#!/usr/bin/perl -w - -=head1 NAME - -imapsync - IMAP synchronisation, sync, copy or migration -tool. Synchronise mailboxes between two imap servers. Good -at IMAP migration. More than 32 different IMAP server softwares -supported with success. - -$Revision: 1.213 $ - -=head1 INSTALL - - imapsync works fine under any Unix OS with perl. - imapsync works fine under Windows 2000 (at least) and ActiveState's 5.8 Perl - - imapsync is already available on the following distributions (at least): - FreeBSD, Debian, Gentoo, NetBSD. - - Get imapsync at - http://www.linux-france.org/prj/imapsync/dist/ - - You'll find a compressed tarball called imapsync-x.xx.tgz - where x.xx is the version number. Untar the tarball where - you want : - - tar xzvf imapsync-x.xx.tgz - - Go into the directory imapsync-x.xx and read the INSTALL - file. - - The freshmeat record is http://freshmeat.net/projects/imapsync/ - -=head1 SYNOPSIS - - imapsync [options] - - imapsync --help - imapsync - - imapsync [--host1 server1] [--port1 ] - [--user1 ] [--passfile1 ] - [--host2 server2] [--port2 ] - [--user2 ] [--passfile2 ] - [--ssl1] [--ssl2] - [--authmech1 ] [--authmech2 ] - [--noauthmd5] - [--folder --folder ...] - [--folderrec --folderrec ...] - [--include ] [--exclude ] - [--prefix2 ] [--prefix1 ] - [--regextrans2 --regextrans2 ...] - [--sep1 ] - [--sep2 ] - [--justfolders] [--justfoldersizes] [--justconnect] - [--syncinternaldates] - [--buffersize ] - [--syncacls] - [--regexmess ] [--regexmess ] - [--maxsize ] - [--maxage ] - [--minage ] - [--skipheader ] - [--useheader ] [--useheader ] - [--skipsize] - [--delete] [--delete2] - [--expunge] [--expunge1] [--expunge2] - [--subscribed] [--subscribe] - [--nofoldersizes] - [--dry] - [--debug] [--debugimap] - [--timeout ] [--fast] - [--split1] [--split2] - [--pidfile ] - [--tmpfile ] - [--version] [--help] - -=cut -# comment -=pod - -=head1 DESCRIPTION - -The command imapsync is a tool allowing incremental and recursive -imap transfer from one mailbox to another. - -We sometimes need to transfer mailboxes from one imap server to -another. This is called migration. - -imapsync is the adequate tool because it reduces the amount -of data transferred by not transferring a given message if it -is already on both sides. Same headers, same message size -and the transfer is done only once. All flags are -preserved, unread will stay unread, read will stay read, -deleted will stay deleted. You can stop the transfer at any -time and restart it later, imapsync is adapted to a bad -connection. imapsync is CPU hungry so nice and renice -commands can be a good help. imapsync can be memory hungry too, -especially with large messages. - -You can decide to delete the messages from the source mailbox -after a successful transfer (it is a good feature when migrating). -In that case, use the --delete --expunge1 options. - -You can also just synchronize a mailbox A from another mailbox B -in case you just want to keep a "live" copy of B in A. - -=head1 OPTIONS - -Invoke: imapsync --help - -=head1 HISTORY - -I wrote imapsync because an enterprise (basystemes) paid me to install -a new imap server without loosing huge old mailboxes located on a far -away remote imap server accessible by a low bandwith link. The tool -imapcp (written in python) could not help me because I had to verify -every mailbox was well transferred and delete it after a good -transfer. imapsync started its life being a copy_folder.pl patch. -The tool copy_folder.pl comes from the Mail-IMAPClient-2.1.3 perl -module tarball source (in the examples/ directory of the tarball). - -=head1 EXAMPLE - -While working on imapsync parameters please run imapsync in -dry mode (no modification induced) with the --dry -option. Nothing bad can be done this way. - -To synchronize the imap account "buddy" on host -"imap.src.fr" to the imap account "max" on host -"imap.dest.fr" (the passwords are located in two files -"/etc/secret1" for "buddy", "/etc/secret2" for "max") : - - imapsync --host1 imap.src.fr --user1 buddy --passfile1 /etc/secret1 \ - --host2 imap.dest.fr --user2 max --passfile2 /etc/secret2 - -Then, you will have buddy's mailbox updated from max's -mailbox. - -=head1 SECURITY - -You can use --password1 instead of --passfile1 to give the -password but it is dangerous because any user on your host -can see the password by using the 'ps auxwwww' -command. Using a variable (like $PASSWORD1) is also -dangerous because of the 'ps auxwwwwe' command. So, saving -the password in a well protected file (600 or rw-------) is -the best solution. - -imasync is not totally protected against sniffers on the -network since passwords may be transferred in plain text in -case CRAM-MD5 is not supported by your imap servers. Use ---ssl1 and --ssl2 to enable encryption on host1 and host2. - -You may authenticate as one user (typically an admin user), -but be authorized as someone else, which means you don't -need to know every user's personal password. Specify ---authuser1 "adminuser" to enable this on host1. In this -case, --authmech1 PLAIN will be used, but otherwise, ---authmech1 CRAM-MD5 is the default. Same behavior with the ---authuser2 option. - - -=head1 EXIT STATUS - -imapsync will exit with a 0 status (return code) if everything went good. -Otherwise, it exits with a non-zero status. - -So if you have a buggy internet connection, you can use this loop -in a Bourne shell: - - while ! imapsync ...; do - echo imapsync not complete - done - -=head1 AUTHOR - -Gilles LAMIRAL - -Feedback good or bad is always welcome. - -The newsgroup comp.mail.imap is a good place to talk about -imapsync. I read it when imapsync is concerned. - -Gilles LAMIRAL earn his living writing, installing, -configuring and teaching free open and gratis -softwares. Do not hesitate to pay him for that services. - - -=head1 LICENSE - -imapsync is free, gratis and open source software cover by -the GNU General Public License. See the GPL file included in -the distribution or the web site -http://www.gnu.org/licenses/licenses.html - -=head1 BUGS - -No known serious bug. Report any bug to the author. -Before reporting bugs, read the FAQ, this README and the -TODO files. - -In your report, please include: - - - imapsync version. - - IMAPClient.pm version. - - perl version. - - operating system running imapsync. - - imap servers softwares on both side and their version. - - Those values can be found with the command line - - imapsync --host1 imap.host1.net --host2 imap.host2.org --justconnect - - And also, if it can help : - - - operating systems on both sides and the third side in case - you run imapsync on a foreign host from the both. - - imapsync with all the options you use, the full command line - you use (except the passwords of course). This can be found - at the beginning of the output. - - output given with --debug --debugimap near the failure point. - -=head1 IMAP SERVERS - -Failure stories reported with the following 4 imap servers : - - - MailEnable 1.54 (Proprietary) http://www.mailenable.com/ - - DBMail 2.0.7 (GPL). But DBMail 1.2.1 works. - Patient and confident testers are welcome. - - dkimap4 2.39 - - Imail 7.04 (maybe). - -Success stories reported with the following 32 imap servers -(softwares names are in alphabetic order) : - - - BincImap 1.2.3 (GPL) (http://www.bincimap.org/) - - CommuniGatePro server (Redhat 8.0) - - Courier IMAP 1.5.1, 2.2.0, 2.1.1, 2.2.1 (GPL) - (http://www.courier-mta.org/) - - Critical Path (7.0.020) - - Cyrus IMAP 1.5, 1.6, 2.1, 2.1.15, 2.1.16, 2.1.18 - 2.2.1, 2.2.2-BETA, 2.2.10, 2.2.12, - v2.2.3-Invoca-RPM-2.2.3-8, - 2.3-alpha (OSI Approved), - v2.2.12-Invoca-RPM-2.2.12-3.RHEL4.1, - v2.3.1-Invoca-RPM-2.3.1-2.7.fc5, - (http://asg.web.cmu.edu/cyrus/) - - David Tobit V8 (proprietary Message system). - - DBMail 1.2.1, 2.0.4, 2.0.9, 2.2rc1 (GPL) (http://www.dbmail.org/). - 2.0.7 seems buggy. - - Dovecot 0.99.10.4, 0.99.14, 0.99.14-8.fc4, 1.0-0.beta2.7 (LGPL) - (http://www.dovecot.org/) - - Domino (Notes) 6.5, 5.0.6, 5.0.7, 7.0.2, 6.0.2CF1 - - Eudora WorldMail v2 - - Groupwise IMAP (Novell) 6.x and 7.0. Buggy so see the FAQ. - - iPlanet Messaging server 4.15, 5.1, 5.2 - - IMail 7.15 (Ipswitch/Win2003), 8.12 - - MDaemon 7.0.1, 8.1, 9.5.4 (Windows server 2003 R2 platform) - - Mercury 4.1 (Windows server 2000 platform) - - Microsoft Exchange Server 5.5 - - Netscape Mail Server 3.6 (Wintel !) - - Netscape Messaging Server 4.15 Patch 7 - - OpenMail IMAP server B.07.00.k0 (Samsung Contact ?) - - OpenWave - - Qualcomm Worldmail (NT) - - Rockliffe Mailsite 5.3.11 - - Samsung Contact IMAP server 8.5.0 - - Scalix v10.1, 10.0.1.3, 11.0.0.431 - - SmarterMail - - SunONE Messaging server 5.2, 6.0 (SUN JES - Java Enterprise System) - - Sun Java System Messaging Server 6.2-2.05 - - Surgemail 3.6f5-5 - - UW-imap servers (imap-2000b) rijkkramer IMAP4rev1 2000.287 - (RedHat uses UW like 2003.338rh), v12.264 Solaris 5.7 (OSI Approved) - (http://www.washington.edu/imap/) - - UW - QMail v2.1 - - Imap part of TCP/IP suite of VMS 7.3.2 - - Zimbra-IMAP 3.0.1 GA 160, 3.1.0 Build 279, 5.5. - -Please report to the author any success or bad story with -imapsync and don't forget to mention the IMAP server -software names and version on both sides. This will help -future users. To help the author maintaining this section -report the two lines at the begining of the output if they -are useful to know the softwares. Example: - - From software :* OK louloutte Cyrus IMAP4 v1.5.19 server ready - To software :* OK Courier-IMAP ready - -You can use option --justconnect to get those lines. -Example : - - imapsync --host1 imap.troc.org --host2 imap.trac.org --justconnect - -Please rate imapsync at http://freshmeat.net/projects/imapsync/ -or better give the author a book, he likes books: -http://www.amazon.com/gp/registry/wishlist/1C9UNDIH3P7R7/ - - -=head1 HUGE MIGRATION - - -Have a special attention on options ---subscribed ---subscribe ---delete ---delete2 ---expunge ---expunge1 ---expunge2 ---maxage ---minage ---maxsize ---useheader - -If you have many mailboxes to migrate think about a little -shell program. Write a file called file.csv (for example) -containing users and passwords. -The separator used in this example is ';' - -The file.csv file content is : - -user0001;password0001;user0002;password0002 -user0011;password0011;user0012;password0012 -... - -And the shell program is just : - - { while IFS=';' read u1 p1 u2 p2; do - imapsync --user1 "$u1" --password1 "$p1" --user2 "$u2" --password2 "$p2" ... - done ; } < file.csv - -Welcome in shell programming ! - -=head1 Hacking - -Feel free to hack imapsync as the GPL Licence permits it. - -=head1 Links - -Entries for imapsync: - http://www.imap.org/products/showall.php - - -=head1 SIMILAR SOFTWARES - - imap_tools : http://www.athensfbc.com/imap_tools - offlineimap : http://gopher.quux.org:70/devel/offlineimap/ - mailsync : http://mailsync.sourceforge.net/ - imapxfer : http://www.washington.edu/imap/ - part of the imap-utils from UW. - mailutil : replace imapxfer in - part of the imap-utils from UW. - http://www.gsp.com/cgi-bin/man.cgi?topic=mailutil - imaprepl : http://www.bl0rg.net/software/ - http://freshmeat.net/projects/imap-repl/ - imap_migrate: http://freshmeat.net/projects/imapmigration/ - imapcopy : http://home.arcor.de/armin.diehl/imapcopy/imapcopy.html - migrationtool http://sourceforge.net/projects/migrationtool/ - pop2imap : http://www.linux-france.org/prj/pop2imap/ - -Feedback (good or bad) will be always welcome. - -$Id: imapsync,v 1.213 2007/02/16 04:07:19 gilles Exp $ - - - -=cut - - -++$|; -use strict; -use Getopt::Long; -use Mail::IMAPClient; -use Digest::MD5 qw(md5_base64); -#use Term::ReadKey; -#use IO::Socket::SSL; -use MIME::Base64; -use English; -use POSIX qw(uname); -use Fcntl; - -eval { require 'usr/include/sysexits.ph' }; - - -my( - $rcs, $debug, $debugimap, $error, - $host1, $host2, $port1, $port2, - $user1, $user2, $password1, $password2, $passfile1, $passfile2, - @folder, @include, @exclude, @folderrec, - $prefix1, $prefix2, - @regextrans2, @regexmess, @regexflag, - $sep1, $sep2, - $syncinternaldates, $syncacls, - $fastio1, $fastio2, - $maxsize, $maxage, $minage, - $skipheader, @useheader, - $skipsize, $foldersizes, $buffersize, - $delete, $delete2, - $expunge, $expunge1, $expunge2, $dry, - $justfoldersizes, - $authmd5, - $subscribed, $subscribe, - $pidfile, $tmpfile, - $version, $VERSION, $help, - $justconnect, $justfolders, - $fast, - $mess_size_total_trans, - $mess_size_total_skipped, - $mess_size_total_error, - $mess_trans, $mess_skipped, $mess_skipped_dry, - $timeout, # whr (ESS/PRW) - $timestart, $timeend, $timediff, - $timesize, $timebefore, - $ssl1, $ssl2, - $authuser1, $authuser2, - $authmech1, $authmech2, - $split1, $split2, -); - -use vars qw ($opt_G); # missing code for this will be option. - - -$rcs = ' $Id: imapsync,v 1.213 2007/02/16 04:07:19 gilles Exp $ '; -$rcs =~ m/,v (\d+\.\d+)/; -$VERSION = ($1) ? $1 : "UNKNOWN"; - -my $VERSION_IMAPClient = $Mail::IMAPClient::VERSION; - -check_lib_version() or - die "Upgrade perl lib Mail::IMAPClient to release 2.2.9 at least\n"; - - -$mess_size_total_trans = 0; -$mess_size_total_skipped = 0; -$mess_size_total_error = 0; -$mess_trans = $mess_skipped = $mess_skipped_dry = 0; - - -sub check_lib_version { - # I know this is ugly, I should write a sort function - if ($VERSION_IMAPClient =~ m/(\d+)\.(\d+)\.(\d+)/) { - $debug and print "VERSION_IMAPClient $1 $2 $3\n"; - my($major,$minor,$sub) = ($1, $2, $3); - - return(1) if($major >=3); - return(0) if($major <=1); - return(1) if($minor >=3); - return(0) if($minor <=1); - return(1) if($sub >=8); - return(0) if($sub <=7); - }else{ - return 0; # don't match regex => bad - } -} - -$error=0; - -my $banner = join("", - '$RCSfile: imapsync,v $ ', - '$Revision: 1.213 $ ', - '$Date: 2007/02/16 04:07:19 $ ', - "\n", - "Mail::IMAPClient version used here is ", - $VERSION_IMAPClient,"\n", - "Command line used :\n", - "$0 @ARGV\n", - ); - -unless(defined(&_SYSEXITS_H)) { - # 64 on my linux box. - eval 'sub EX_USAGE () {64;}' unless defined(&EX_USAGE); -} - -get_options(); -print $banner; - -if ($pidfile) { - open(TMP, ">$pidfile") or die "Can not open PID file for writing\n"; - print TMP $$; - close(TMP); -} - -sub missing_option { - my ($option) = @_; - unlink($pidfile) if ($pidfile and -f $pidfile); - die "$option option must be used, run $0 --help for help\n"; -} - -# By default, 1000 at a time, not more. -$split1 ||= 1000; -$split2 ||= 1000; - -$host1 || missing_option("--host1") ; -# $port1 = (defined($port1)) ? $port1 : 143; -$port1 ||= defined $ssl1 ? 993 : 143; - -$host2 || missing_option("--host2") ; -# $port2 = (defined($port2)) ? $port2 : 143; -$port2 ||= defined $ssl2 ? 993 : 143; - -sub connect_imap { - my($host, $port, $debugimap) = @_; - my $imap = Mail::IMAPClient->new(); - $imap->Server($host); - $imap->Port($port); - $imap->Debug($debugimap); - unless ($imap->connect()) { - unlink($pidfile) if ($pidfile and -f $pidfile); - die "Can not open imap connection on [$host] : $@\n"; - } -} - -if ($justconnect) { - my $from = (); - my $to = (); - - - print "Here is a $OSNAME system (", - join(" ", uname()), - ")\nwith perl ", - sprintf("%vd", $PERL_VERSION), "\n"; - - $from = connect_imap($host1, $port1); - print "From software : ", server_banner($from); - print "From capability : ", join(" ", $from->capability()), "\n"; - $to = connect_imap($host2, $port2); - print "To software : ", server_banner($to); - print "To capability : ", join(" ", $to->capability()), "\n"; - $from->logout(); - $to->logout(); - exit(0); -} - -$user1 || missing_option("--user1"); -$user2 || missing_option("--user2"); - -if(defined($authmd5) and not($authmd5)) { - $authmech1 ||= 'LOGIN'; - $authmech2 ||= 'LOGIN'; -}else{ - $authmech1 ||= $authuser1 ? 'PLAIN' : 'CRAM-MD5'; - $authmech2 ||= $authuser2 ? 'PLAIN' : 'CRAM-MD5'; -} - -$authuser1 ||= $user1; -$authuser2 ||= $user2; - -print "will try to use $authmech1 authentication on host1\n"; -print "will try to use $authmech2 authentication on host2\n"; - -$syncacls = (defined($syncacls)) ? $syncacls : 0; -$foldersizes = (defined($foldersizes)) ? $foldersizes : 1; - -$fastio1 = (defined($fastio1)) ? $fastio1 : 1; -$fastio2 = (defined($fastio2)) ? $fastio2 : 1; - - -@useheader = ("ALL") unless (@useheader); - -print "From imap server [$host1] port [$port1] user [$user1]\n"; -print "To imap server [$host2] port [$port2] user [$user2]\n"; - - -sub ask_for_password { - require Term::ReadKey; - my ($user, $host) = @_; - print "What's the password for $user\@$host? "; - Term::ReadKey::ReadMode(2); - my $password = <>; - chomp $password; - printf "\n"; - Term::ReadKey::ReadMode(0); - return $password; -} - - -$password1 || $passfile1 || do { - $password1 = ask_for_password($authuser1 || $user1, $host1); -}; - -$password1 = (defined($passfile1)) ? firstline ($passfile1) : $password1; - -$password2 || $passfile2 || do { - $password2 = ask_for_password($authuser2 || $user2, $host2); -}; - -$password2 = (defined($passfile2)) ? firstline ($passfile2) : $password2; - -my $from = (); -my $to = (); - -$timestart = time(); -$timebefore = $timestart; - -$debugimap and print "From connection\n"; -$from = login_imap($host1, $port1, $user1, $password1, - $debugimap, $timeout, $fastio1, $ssl1, - $authmech1, $authuser1); - -$debugimap and print "To connection\n"; -$to = login_imap($host2, $port2, $user2, $password2, - $debugimap, $timeout, $fastio2, $ssl2, - $authmech2, $authuser2); - -# history - -$debug and print "From Buffer I/O : ", $from->Buffer(), "\n"; -$debug and print "To Buffer I/O : ", $to->Buffer(), "\n"; - - -sub login_imap { - my($host, $port, $user, $password, - $debugimap, $timeout, $fastio, - $ssl, $authmech, $authuser) = @_; - my ($imap); - if ($ssl) { - require IO::Socket::SSL; - my $socssl = new IO::Socket::SSL("$host:$port"); - unless ($socssl) { - unlink($pidfile) if ($pidfile and -f $pidfile); - die "Error connecting to $host:$port: $@\n"; - } - $socssl->autoflush(1); - - $imap = Mail::IMAPClient->new( - Socket => $socssl, - Server => $host, - ); - } else { - $imap = Mail::IMAPClient->new(); - } - $imap->Clear(20); - $imap->Server($host); - $imap->Port($port); - $imap->Fast_io($fastio); - $imap->Buffer($buffersize || 4096); - $imap->Uid(1); - $imap->Peek(1); - $imap->Debug($debugimap); - $timeout and $imap->Timeout($timeout); - - if ($ssl) { - $imap->State(Mail::IMAPClient::Connected); - } else { - unless($imap->connect()) - { - unlink($pidfile) if ($pidfile and -f $pidfile); - die "Can not open imap connection on [$host] with user [$user] : $@\n"; - } - } - print "Banner : ", server_banner($imap); - - if ($imap->has_capability("AUTH=$authmech") - or $imap->has_capability($authmech) - ) { - printf("Host %s says it has CAPABILITY for AUTHENTICATE %s\n", - $imap->Server, $authmech); - } else { - printf("Host %s says it has NO CAPABILITY for AUTHENTICATE %s\n", - $imap->Server, $authmech); - if ($authmech eq 'PLAIN') { - print "Frequently PLAIN is only supported with SSL, ", - "try --ssl1 or --ssl2 option\n"; - } - } - - $imap->Authmechanism($authmech) unless ($authmech eq 'LOGIN'); - $imap->Authcallback(\&plainauth) if $authmech eq "PLAIN"; - - $imap->User($user); - $imap->Authuser($authuser); - $imap->Password($password); - unless ($imap->login2()) { - print "Error login : [$host] with user [$user] auth [$authmech]: $@\n"; - if (($authmech eq 'LOGIN') or $imap->IsUnconnected()) { - unlink($pidfile) if ($pidfile and -f $pidfile); - die; - } - print "Trying LOGIN Auth mechanism on [$host] with user [$user]\n"; - $imap->Authmechanism(""); - unless ($imap->login2()) { - unlink($pidfile) if ($pidfile and -f $pidfile); - die "Error login : [$host] with user [$user] auth [LOGIN] : $@"; - } - } - print "Success login on [$host] with user [$user] auth [$authmech]\n"; - return($imap); -} - -sub plainauth() { - my $code = shift; - my $imap = shift; - - my $string = sprintf("%s\x00%s\x00%s", $imap->User, - $imap->Authuser, $imap->Password); - return encode_base64("$string", ""); -} - - -sub server_banner { - my $imap = shift; - for my $line ($imap->Results()) { - #print "LR: $line"; - return $line if $line =~ /^\* (OK|NO|BAD)/; - } - return "No banner\n"; - } - - - -print "From capability : ", join(" ", $from->capability()), "\n"; -print "To capability : ", join(" ", $to->capability()), "\n"; - -unless ($from->IsAuthenticated()) { - unlink($pidfile) if ($pidfile and -f $pidfile); - die; -} -print "From state Authenticated\n"; -unless ($to->IsAuthenticated()) { - unlink($pidfile) if ($pidfile and -f $pidfile); - die; -} -print "To state Authenticated\n"; - -$split1 and $from->Split($split1); -$split2 and $to->Split($split2); - - -my (@f_folders, @t_folders, %fs_folders, %t_folders); - -# Make a hash of subscribed folders in source server. -map { $fs_folders{$_}=1 } $from->subscribed(); - - -if (scalar(@folder) or $subscribed or scalar(@folderrec)) { - # folders given by option --folder - push(@f_folders, @folder) if scalar(@folder); - # option --subscribed - push(@f_folders, sort keys (%fs_folders)) if ($subscribed); - - if (scalar(@folderrec)) { - foreach my $folderrec (@folderrec) { - push(@f_folders, $from->folders($folderrec)); - } - } - @f_folders = sort @f_folders; -}else { - # no folder/subscribed/folderrec options => all folders - @f_folders = sort $from->folders(); -} - -# consider (optional) includes and excludes -if (scalar(@include)) { - my @f_folders_inc; - foreach my $include (@include) { - push(@f_folders_inc, grep /$include/, @f_folders); - print "Including folders matching pattern '$include'\n"; - } - push(@f_folders, sort @f_folders_inc); -} - -foreach my $exclude (@exclude) { - @f_folders = grep !/$exclude/,@f_folders; - print "Excluding folders matching pattern '$exclude'\n"; -} - - -@t_folders = sort @{$to->folders()}; - -my($f_sep,$t_sep); -# what are the private folders separators for each server ? - - -$debug and print "Getting separators\n"; -$f_sep = get_separator($from, $sep1, "--sep1"); -$t_sep = get_separator($to, $sep2, "--sep2"); - -#my $f_namespace = $from->namespace(); -#my $t_namespace = $to->namespace(); -#$debug and print "From namespace:\n", Data::Dumper->Dump([$f_namespace]); -#$debug and print "To namespace:\n", Data::Dumper->Dump([$t_namespace]); - -my($f_prefix,$t_prefix); -$f_prefix = get_prefix($from, $prefix1, "--prefix1"); -$t_prefix = get_prefix($to, $prefix2, "--prefix2"); - -sub get_prefix { - my($imap, $prefix_in, $prefix_opt) = @_; - my($prefix_out); - - $debug and print "Getting prefix namespace\n"; - if (defined($prefix_in)) { - print "Using [$prefix_in] given by $prefix_opt\n"; - $prefix_out = $prefix_in; - return($prefix_out); - } - $debug and print "Calling namespace capability\n"; - if ($imap->has_capability("namespace")) { - my $r_namespace = $imap->namespace(); - $prefix_out = $r_namespace->[0][0][0]; - return($prefix_out); - }else{ - print - "No NAMESPACE capability in imap server ", - $imap->Server(),"\n", - "Give the prefix namespace with the $prefix_opt option\n"; - exit(1); - } -} - - -sub get_separator { - my($imap, $sep_in, $sep_opt) = @_; - my($sep_out); - - - if ($sep_in) { - print "Using [$sep_in] given by $sep_opt\n"; - $sep_out = $sep_in; - return($sep_out); - } - $debug and print "Calling namespace capability\n"; - if ($imap->has_capability("namespace")) { - $sep_out = $imap->separator(); - return($sep_out); - }else{ - print - "No NAMESPACE capability in imap server ", - $imap->Server(),"\n", - "Give the separator caracter with the $sep_opt option\n"; - exit(1); - } -} - - -print "From separator and prefix : [$f_sep][$f_prefix]\n"; -print "To separator and prefix : [$t_sep][$t_prefix]\n"; - - -sub foldersizes { - - my ($side, $imap, $folders_r) = @_; - my $tot = 0; - my $tmess = 0; - my @folders = @{$folders_r}; - print "++++ Calculating sizes ++++\n"; - foreach my $folder (@folders) { - my $stot = 0; - my $smess = 0; - printf("$side Folder %-35s", "[$folder]"); - unless($imap->exists($folder)) { - print("does not exist yet\n"); - next; - } - unless ($imap->select($folder)) { - warn - "$side Folder $folder : Could not select ", - $imap->LastError, "\n"; - $error++; - next; - } - if (defined($maxage) or defined($minage)) { - # The pb is fetch_hash() can only be applied on ALL messages - my @msgs = select_msgs($imap); - $smess = scalar(@msgs); - foreach my $m (@msgs) { - my $s = $imap->size($m) - or warn "Could not find size of message $m: $@\n"; - $stot += $s; - } - }else{ - my $hashref = {}; - $smess = $imap->message_count(); - unless ($smess == 0) { - #$imap->Ranges(1); - unless ( $imap->fetch_hash2("RFC822.SIZE",$hashref) ) { - unlink($pidfile) if ($pidfile and -f $pidfile); - die "$@"; - } - #$imap->Ranges(0); - #print map {$hashref->{$_}->{"RFC822.SIZE"}, " "} keys %$hashref; - map {$stot += $hashref->{$_}->{"RFC822.SIZE"}} keys %$hashref; - } - } - printf(" Size: %9s", $stot); - printf(" Messages: %5s\n", $smess); - $tot += $stot; - $tmess += $smess; - } - print "Total size: $tot\n"; - print "Total messages: $tmess\n"; - print "Time : ", timenext(), " s\n"; -} - - -foreach my $f_fold (@f_folders) { - my $t_fold; - $t_fold = to_folder_name($f_fold); - $t_folders{$t_fold}++; -} - -@t_folders = sort keys(%t_folders); - - -if ($foldersizes) { - foldersizes("From", $from, \@f_folders); - foldersizes("To ", $to, \@t_folders); -} - - - - -sub timenext { - my ($timenow, $timerel); - # $timebefore is global, beurk ! - $timenow = time; - $timerel = $timenow - $timebefore; - $timebefore = $timenow; - return($timerel); -} - -exit if ($justfoldersizes); - -# needed for setting flags -my $tohasuidplus = $to->has_capability("UIDPLUS"); - - - -print - "++++ Listing folders ++++\n", - "From folders list : ", map("[$_] ",@f_folders),"\n", - "To folders list : ", map("[$_] ",@t_folders),"\n"; - -print - "From subscribed folders list : ", - map("[$_] ", sort keys(%fs_folders)), "\n" - if ($subscribed); - -sub separator_invert { - # The separator we hope we'll never encounter - my $o_sep="\000"; - - my($f_fold, $f_sep, $t_sep) = @_; - - my $t_fold = $f_fold; - $t_fold =~ s@\Q$t_sep@$o_sep@g; - $t_fold =~ s@\Q$f_sep@$t_sep@g; - $t_fold =~ s@\Q$o_sep@$f_sep@g; - return($t_fold); -} - -sub to_folder_name { - my ($t_fold); - my ($x_fold) = @_; - # first we remove the prefix - $x_fold =~ s/^$f_prefix//; - $debug and print "removed source prefix : [$x_fold]\n"; - $t_fold = separator_invert($x_fold,$f_sep, $t_sep); - $debug and print "inverted separators : [$t_fold]\n"; - # Adding the prefix supplied by namespace or the --prefix2 option - $t_fold = $t_prefix . $t_fold - unless(($t_prefix eq "INBOX.") and ($t_fold =~ m/^INBOX$/i)); - $debug and print "added target prefix : [$t_fold]\n"; - - # Transforming the folder name by the --regextrans2 option(s) - foreach my $regextrans2 (@regextrans2) { - $debug and print "eval \$t_fold =~ $regextrans2\n"; - eval("\$t_fold =~ $regextrans2"); - } - return($t_fold); -} - -sub flags_regex { - my ($flags_f) = @_; - foreach my $regexflag (@regexflag) { - $debug and print "eval \$flags_f =~ $regexflag\n"; - eval("\$flags_f =~ $regexflag"); - } - return($flags_f); -} - -sub acls_sync { - my($f_fold, $t_fold) = @_; - if ($syncacls) { - my $f_hash = $from->getacl($f_fold) - or warn "Could not getacl for $f_fold: $@\n"; - my $t_hash = $to->getacl($t_fold) - or warn "Could not getacl for $t_fold: $@\n"; - my %users = map({ ($_, 1) } (keys(%$f_hash), keys(%$t_hash))); - foreach my $user (sort(keys(%users))) { - my $acl = $f_hash->{$user} || "none"; - print "acl $user : [$acl]\n"; - next if ($f_hash->{$user} && $t_hash->{$user} && - $f_hash->{$user} eq $t_hash->{$user}); - unless ($dry) { - print "setting acl $t_fold $user $acl\n"; - $to->setacl($t_fold, $user, $acl) - or warn "Could not set acl: $@\n"; - } - } - } -} - - -print "++++ Looping on each folder ++++\n"; - -FOLDER: foreach my $f_fold (@f_folders) { - my $t_fold; - print "From Folder [$f_fold]\n"; - $t_fold = to_folder_name($f_fold); - print "To Folder [$t_fold]\n"; - - last FOLDER if $from->IsUnconnected(); - last FOLDER if $to->IsUnconnected(); - - unless ($from->select($f_fold)) { - warn - "From Folder $f_fold : Could not select ", - $from->LastError, "\n"; - $error++; - next FOLDER; - } - - unless ($to->exists($t_fold) or $to->select($t_fold)) { - print "To Folder $t_fold does not exist\n"; - print "Creating folder [$t_fold]\n"; - unless ($dry){ - unless ($to->create($t_fold)){ - warn "Couldn't create [$t_fold]", - $to->LastError,"\n"; - $error++; - next FOLDER; - } - }else{ - next FOLDER; - } - } - - acls_sync($f_fold, $t_fold); - - unless ($to->select($t_fold)) { - warn - "To Folder $t_fold : Could not select ", - $to->LastError, "\n"; - $error++; - next FOLDER; - } - - if ($expunge){ - print "Expunging $f_fold and $t_fold\n"; - unless($dry) { $from->expunge() }; - #unless($dry) { $to->expunge() }; - } - - if ($subscribe and exists $fs_folders{$f_fold}) { - print "Subscribing to folder $t_fold on destination server\n"; - unless($dry) { $to->subscribe($t_fold) }; - } - - next FOLDER if ($justfolders); - - last FOLDER if $from->IsUnconnected(); - last FOLDER if $to->IsUnconnected(); - - my @f_msgs = select_msgs($from); - - - - $debug and print "LIST FROM : ", scalar(@f_msgs), " messages [@f_msgs]\n"; - # internal dates on "TO" are after the ones on "FROM" - # normally... - my @t_msgs = select_msgs($to); - - $debug and print "LIST TO : ", scalar(@t_msgs), " messages [@t_msgs]\n"; - - my %f_hash = (); - my %t_hash = (); - - print "++++ From [$f_fold] Parse 1 ++++\n"; - last FOLDER if $from->IsUnconnected(); - last FOLDER if $to->IsUnconnected(); - - my $f_heads = $from->parse_headers2([@f_msgs], - @useheader)if (@f_msgs) ; - $debug and print "Time headers: ", timenext(), " s\n"; - my $f_fir = $from->fetch_hash2("FLAGS", - "INTERNALDATE", - "RFC822.SIZE") if (@f_msgs); - $debug and print "Time fir : ", timenext(), " s\n"; - - foreach my $m (@f_msgs) { - parse_header_msg1($from, $f_fold, $m, $f_heads, $f_fir, "F", \%f_hash); - } - $debug and print "Time headers: ", timenext(), " s\n"; - - print "++++ To [$t_fold] Parse 1 ++++\n"; - last FOLDER if $from->IsUnconnected(); - last FOLDER if $to->IsUnconnected(); - - my $t_heads = $to->parse_headers2([@t_msgs], - @useheader) if (@t_msgs); - $debug and print "Time headers: ", timenext(), " s\n"; - my $t_fir = $to->fetch_hash2("FLAGS", - "INTERNALDATE", - "RFC822.SIZE") if (@t_msgs); - $debug and print "Time fir : ", timenext(), " s\n"; - foreach my $m (@t_msgs) { - parse_header_msg1($to, $t_fold, $m, $t_heads, $t_fir, "T", \%t_hash); - } - $debug and print "Time headers: ", timenext(), " s\n"; - - print "++++ Verifying [$f_fold] -> [$t_fold] ++++\n"; - # messages in "from" that are not good in "to" - - my @f_hash_keys_sorted_by_uid - = sort {$f_hash{$a}{'m'} <=> $f_hash{$b}{'m'}} keys(%f_hash); - - #print map { $f_hash{$_}{'m'} . " "} @f_hash_keys_sorted_by_uid; - - my @t_hash_keys_sorted_by_uid - = sort {$t_hash{$a}{'m'} <=> $t_hash{$b}{'m'}} keys(%t_hash); - - - if($delete2) { - foreach my $m_id (@t_hash_keys_sorted_by_uid) { - #print "$m_id "; - unless (exists($f_hash{$m_id})) { - my $t_msg = $t_hash{$m_id}{'m'}; - print "deleting message $m_id $t_msg\n"; - $to->delete_message($t_msg) unless ($dry); - } - } - } - - MESS: foreach my $m_id (@f_hash_keys_sorted_by_uid) { - my $f_size = $f_hash{$m_id}{'s'}; - my $f_msg = $f_hash{$m_id}{'m'}; - my $f_idate = $f_hash{$m_id}{'D'}; - - if (defined $maxsize and $f_size > $maxsize) { - print "+ Skipping msg #$f_msg:$f_size in folder $f_fold (exceeds maxsize limit $maxsize bytes)\n"; - $mess_size_total_skipped += $f_size; - $mess_skipped += 1; - next MESS; - } - $debug and print "+ key $m_id #$f_msg\n"; - unless (exists($t_hash{$m_id})) { - print "+ NO msg #$f_msg [$m_id] in $t_fold\n"; - # copy - print "+ Copying msg #$f_msg:$f_size to folder $t_fold\n"; - last FOLDER if $from->IsUnconnected(); - #my $string = $from->message_string($f_msg); - my $message_file = $tmpfile || "tmp_imapsync_$$"; - unlink($message_file); - $from->message_to_file($message_file, $f_msg); - my $string = file_to_string($message_file); - #unlink($message_file); - if (@regexmess) { - foreach my $regexmess (@regexmess) { - $debug and print "eval \$string =~ $regexmess\n"; - eval("\$string =~ $regexmess"); - } - string_to_file($string, $message_file); - } - $debug and print "F message content begin next line\n", - $string, - "F message content ended on previous line\n"; - my $d = ""; - if ($syncinternaldates) { - $d = $f_idate; - $d = "\"$d\""; - $debug and print "internal date from 1: [$d]\n"; - } - - my $flags_f = $f_hash{$m_id}{'F'} || ""; - # RFC 2060 : This flag can not be altered by any client - $flags_f =~ s@\\Recent@@g; - $flags_f = flags_regex($flags_f) if @regexflag; - - my $new_id; - print "flags from : [$flags_f][$d]\n"; - last FOLDER if $to->IsUnconnected(); - unless ($dry) { - #unless($new_id = $to->append_string($t_fold,$string, $flags_f, $d)){ - unless($new_id = $to->append_file2($t_fold, $message_file, "", $flags_f, $d)){ - warn "Couldn't append msg #$f_msg (Subject:[". - $from->subject($f_msg)."]) to folder $t_fold: ", - $to->LastError, "\n"; - $error++; - $mess_size_total_error += $f_size; - next MESS; - - }else{ - # good - # $new_id is an id if the IMAP server has the - # UIDPLUS capability else just a ref - print "Copied msg id [$f_msg] to folder $t_fold msg id [$new_id]\n"; - $mess_size_total_trans += $f_size; - $mess_trans += 1; - if($delete) { - print "Deleting msg #$f_msg in folder $f_fold\n"; - $from->delete_message($f_msg) unless ($dry); - $from->expunge() if ($expunge and not $dry); - } - } - }else{ - $mess_skipped_dry += 1; - } - unlink($message_file); - next MESS; - }else{ - $debug and print "Message id [$m_id] found in t:$t_fold\n"; - $mess_size_total_skipped += $f_size; - $mess_skipped += 1; - } - - $fast and next MESS; - #$debug and print "MESSAGE $m_id\n"; - my $t_size = $t_hash{$m_id}{'s'}; - my $t_msg = $t_hash{$m_id}{'m'}; - - - $debug and print "Setting flags\n"; - last FOLDER if $from->IsUnconnected(); - last FOLDER if $to->IsUnconnected(); - - my (@flags_f,@flags_t); - my $flags_f_rv = $from->flags($f_msg); - @flags_f = @{$flags_f_rv} if ref($flags_f_rv); - - # No flag \Recent here, no ? - my $flags_f = join(" ", @flags_f); - - $flags_f = flags_regex($flags_f) if @regexflag; - - # This add or change flags but no flag are removed with this - $to->store($t_msg, - "+FLAGS (" . $flags_f . ")" - ) unless ($dry) ; - - my $flags_t_rv = $to->flags($t_msg); - @flags_t = @{$flags_t_rv} if ref($flags_t_rv); - my $flags_t = join(" ", @flags_t); - $debug and print - "flags from : $flags_f\n", - "flags to : $flags_t\n"; - - - $debug and do { - print "Looking dates\n"; - #my $d_f = $from->internaldate($f_msg); - #my $d_t = $to->internaldate($t_msg); - my $d_f = $f_hash{$m_id}{'D'}; - my $d_t = $t_hash{$m_id}{'D'}; - print - "idate from : $d_f\n", - "idate to : $d_t\n"; - - #unless ($d_f eq $d_t) { - # print "!!! Dates differ !!!\n"; - #} - }; - unless (($f_size == $t_size) or $skipsize) { - # Bad size - print - "Message $m_id SZ_BAD f:$f_msg:$f_size t:$t_msg:$t_size\n"; - # delete in to and recopy ? - # NO recopy CODE HERE. to be written if needed. - $error++; - if ($opt_G){ - print "Deleting msg f:#$t_msg in folder $t_fold\n"; - $to->delete_message($t_msg) unless ($dry); - } - }else { - # Good - $debug and print - "Message $m_id SZ_GOOD f:$f_msg:$f_size t:$t_msg:$t_size\n"; - if($delete) { - print "Deleting msg #$f_msg in folder $f_fold\n"; - $from->delete_message($f_msg) unless ($dry); - $from->expunge() if ($expunge and not $dry); - } - } - } - if ($expunge1){ - print "Expunging source folder $f_fold\n"; - unless($dry) { $from->expunge() }; - } - if ($expunge2){ - print "Expunging target folder $t_fold\n"; - unless($dry) { $to->expunge() }; - } - -print "Time : ", timenext(), " s\n"; -} -$from->logout(); -$to->logout(); - -$timeend = time(); - -$timediff = $timeend - $timestart; - -stats(); - -unlink($pidfile) if ($pidfile and -f $pidfile); -exit(1) if($error); - -sub select_msgs { - my ($imap) = @_; - my (@msgs,@max,@min,@union,@inter); - - unless (defined($maxage) or defined($minage)) { - @msgs = $imap->search("ALL"); - return(@msgs); - } - if (defined($maxage)) { - @max = $imap->sentsince(time - 86400 * $maxage); - } - if (defined($minage)) { - @min = $imap->sentbefore(time - 86400 * $minage); - } - SWITCH: { - unless(defined($minage)) {@msgs = @max; last SWITCH}; - unless(defined($maxage)) {@msgs = @min; last SWITCH}; - my (%union, %inter); - foreach my $m (@min, @max) {$union{$m}++ && $inter{$m}++} - @inter = keys(%inter); - @union = keys(%union); - # normal case - if ($minage <= $maxage) {@msgs = @inter; last SWITCH}; - # just exclude messages between - if ($minage > $maxage) {@msgs = @union; last SWITCH}; - - } - return(@msgs); -} - -sub stats { - print "++++ Statistics ++++\n"; - print "Time : $timediff sec\n"; - print "Messages transferred : $mess_trans "; - print "(could be $mess_skipped_dry without dry mode)" if ($dry); - print "\n"; - print "Messages skipped : $mess_skipped\n"; - print "Total bytes transferred: $mess_size_total_trans\n"; - print "Total bytes skipped : $mess_size_total_skipped\n"; - print "Total bytes error : $mess_size_total_error\n"; - print "Detected $error errors\n"; - print "Please, rate imapsync at http://freshmeat.net/projects/imapsync/\n"; - print "?Happy with this free, open source and gratis GPL software?\n", - "Feel free to thank the author by giving him a book:\n", - "http://www.amazon.com/gp/registry/wishlist/1C9UNDIH3P7R7/\n"; - - -} - - -sub get_options -{ - my $numopt = scalar(@ARGV); - my $opt_ret = GetOptions( - "debug!" => \$debug, - "debugimap!" => \$debugimap, - "host1=s" => \$host1, - "host2=s" => \$host2, - "port1=i" => \$port1, - "port2=i" => \$port2, - "user1=s" => \$user1, - "user2=s" => \$user2, - "password1=s" => \$password1, - "password2=s" => \$password2, - "passfile1=s" => \$passfile1, - "passfile2=s" => \$passfile2, - "authmd5!" => \$authmd5, - "sep1=s" => \$sep1, - "sep2=s" => \$sep2, - "folder=s" => \@folder, - "folderrec=s" => \@folderrec, - "include=s" => \@include, - "exclude=s" => \@exclude, - "prefix1=s" => \$prefix1, - "prefix2=s" => \$prefix2, - "regextrans2=s" => \@regextrans2, - "regexmess=s" => \@regexmess, - "regexflag=s" => \@regexflag, - "delete!" => \$delete, - "delete2!" => \$delete2, - "syncinternaldates!" => \$syncinternaldates, - "syncacls!" => \$syncacls, - "maxsize=i" => \$maxsize, - "maxage=i" => \$maxage, - "minage=i" => \$minage, - "buffersize=i" => \$buffersize, - "foldersizes!" => \$foldersizes, - "dry!" => \$dry, - "expunge!" => \$expunge, - "expunge1!" => \$expunge1, - "expunge2!" => \$expunge2, - "subscribed!" => \$subscribed, - "subscribe!" => \$subscribe, - "justconnect!"=> \$justconnect, - "justfolders!"=> \$justfolders, - "justfoldersizes!" => \$justfoldersizes, - "fast!" => \$fast, - "version" => \$version, - "help" => \$help, - "timeout=i" => \$timeout, - "skipheader=s" => \$skipheader, - "useheader=s" => \@useheader, - "skipsize!" => \$skipsize, - "fastio1!" => \$fastio1, - "fastio2!" => \$fastio2, - "ssl1!" => \$ssl1, - "ssl2!" => \$ssl2, - "authmech1=s" => \$authmech1, - "authmech2=s" => \$authmech2, - "authuser1=s" => \$authuser1, - "authuser2=s" => \$authuser2, - "split1=i" => \$split1, - "split2=i" => \$split2, - "pidfile=s" => \$pidfile, - "tmpfile=s" => \$tmpfile, - ); - - $debug and print "get options: [$opt_ret]\n"; - - # just the version - print "$VERSION\n" and exit if ($version) ; - - # exit with --help option or no option at all - usage() and exit if ($help or ! $numopt) ; - - # don't go on if options are not all known. - exit(EX_USAGE()) unless ($opt_ret) ; - - -} - - -sub parse_header_msg1 { - my ($imap, $folder, $m_uid, $s_heads, $s_fir, $s, $s_hash) = @_; - - my $head = $s_heads->{$m_uid}; - my $headnum = scalar(keys(%$head)); - $debug and print "Head NUM:", $headnum, "\n"; - unless($headnum) { print "Warning : no header used or found \n"; } - my $headstr; - - foreach my $h (sort keys(%$head)){ - foreach my $val (sort @{$head->{$h}}) { - # no 8-bit data in headers ! - $val =~ s/[\x80-\xff]/X/g; - - # remove the first blanks (dbmail bug ?) - # and uppercase header keywords - # (dbmail and dovecot) - $val =~ s/^\s*(.+)$/$1/; - my $H = uc($h); - # show stuff in debug mode - $debug and print "${s}H $H:", $val, "\n"; - if ($skipheader) { - if ($skipheader =~ m/^(.*?):(.*)$/) { - my ($forfolder,$skipheader2) = ($1,$2); - if ($folder =~ m/$forfolder/i) { - if ($H =~ m/$skipheader2/i) { - $debug and print "Skipping header $h\n"; - next; - } - } - } - elsif ($H =~ m/$skipheader/i) { - $debug and print "Skipping header $h\n"; - next; - } - } - $headstr .= "$H:". $val; - } - } - #return unless ($headstr); - unless ($headstr){ - print "no header so taking everything\n"; - $headstr = $imap->message_string($m_uid); - } - my $size = $s_fir->{$m_uid}->{"RFC822.SIZE"}; - my $flags = $s_fir->{$m_uid}->{"FLAGS"}; - my $idate = $s_fir->{$m_uid}->{"INTERNALDATE"}; - $size = length($headstr) unless ($size); - my $m_md5 = md5_base64($headstr); - $debug and print "$s msg $m_uid:$m_md5:$size\n"; - my $key; - if ($skipsize) { - $key = "$m_md5"; - }else { - $key = "$m_md5:$size"; - } - $s_hash->{"$key"}{'5'} = $m_md5; - $s_hash->{"$key"}{'s'} = $size; - $s_hash->{"$key"}{'D'} = $idate; - $s_hash->{"$key"}{'F'} = $flags; - $s_hash->{"$key"}{'m'} = $m_uid; -} - - -sub firstline { - # extract the first line of a file (without \n) - - my($file) = @_; - my $line = ""; - - unless (open FILE, $file) { - unlink($pidfile) if ($pidfile and -f $pidfile); - die("error [$file]: $! "); - } - chomp($line = ); - close FILE; - $line = ($line) ? $line : "error !EMPTY! [$file]"; - return $line; -} - - -sub file_to_string { - my($file) = @_; - my @string; - unless (open FILE, $file) { - unlink($pidfile) if ($pidfile and -f $pidfile); - die("error [$file]: $! "); - } - @string = ; - close FILE; - return join("", @string); -} - - -sub string_to_file { - my($string, $file) = @_; - unless (sysopen(FILE, $file,O_WRONLY|O_TRUNC|O_CREAT, 0600)) - { - unlink($pidfile) if ($pidfile and -f $pidfile); - die("$! $file"); - } - print FILE $string; - close FILE; -} - - - -sub usage { - print < : "from" imap server. Mandatory. ---port1 : port to connect on host1. Default is 143. ---user1 : user to login on host1. Mandatory. ---authuser1 : user to auth with on host1 (admin user). ---password1 : password for the user1. Dangerous, use --passfile1 ---passfile1 : password file for the user1. Contains the password. ---host2 : "destination" imap server. Mandatory. ---port2 : port to connect on host2. Default is 143. ---user2 : user to login on host2. Mandatory. ---authuser2 : user to auth with on host2 (admin user). ---password2 : password for the user2. Dangerous, use --passfile2 ---passfile2 : password file for the user2. Contains the password. ---noauthmd5 : don't use MD5 authentification. ---authmech1 : auth mechanism to use with host1: - PLAIN, LOGIN, CRAM-MD5 etc. ---authmech2 : auth mechanism to use with host2. See --authmech1 ---ssl1 : use an SSL connection on host1. ---ssl2 : use an SSL connection on host2. ---folder : sync this folder. ---folder : and this one, etc. ---folderrec : sync this folder recursively. ---folderrec : and this one, etc. ---include : sync folders matching this regular expression ---include : or this one, etc. - in case both --include --exclude options are - use, include is done before. ---exclude : skips folders matching this regular expression - Several folders to avoid: - --exclude 'fold1|fold2|f3' skips fold1, fold2 and f3. ---exclude : or this one, etc. ---prefix1 : remove prefix to all destination folders - (usually INBOX. for cyrus imap servers) - use --prefix1 if your source imap server does not - have NAMESPACE capability. ---prefix2 : add prefix to all destination folders - (usually INBOX. for cyrus imap servers) - use --prefix2 if your target imap server does not - have NAMESPACE capability. ---regextrans2 : Apply the whole regex to each destination folders. ---regextrans2 : and this one. etc. - When you play with the --regextrans2 option, first - add also the safe options --dry --justfolders - Then, when happy, remove --dry, remove --justfolders ---regexmess : Apply the whole regex to each message before transfer. - Example : 's/\\000/ /g' # to replace null by space. ---regexmess : and this one. ---regexmess : and this one, etc. ---regexflag : Apply the whole regex to each flags list. - Example : 's/\"Junk"//g' # to remove "Junk" flag. ---regexflag : and this one, etc. ---sep1 : separator in case namespace is not supported. ---sep2 : idem. ---delete : delete messages on source imap server after - a successful transfer. Useful in case you - want to migrate from one server to another one. - With imap, delete tags messages as deleted, they - are not really deleted. See expunge. ---delete2 : delete messages on the destination imap server that - are not on the source server. ---expunge : expunge messages on source account. - expunge really deletes messages marked deleted. - expunge is made at the beginning on the - source server only. newly transferred messages - are expunged if option --expunge is given. - no expunge is done on destination account but - it will change in future releases. ---expunge1 : expunge messages on source account. ---expunge2 : expunge messages on target account. ---syncinternaldates : sets the internal dates on host2 same as host1 ---buffersize : sets the size of a block of I/O. ---maxsize : skip messages larger than bytes ---maxage : skip messages older than days. - final stats (skipped) don't count older messages - see also --minage ---minage : skip messages newer than days. - final stats (skipped) don't count newer messages - You can do (+ are the messages selected): - past|----maxage+++++++++++++++>now - past|+++++++++++++++minage---->now - past|----maxage+++++minage---->now (intersection) - past|++++minage-----maxage++++>now (union) ---skipheader : Don't take into account header keyword - matching ex: --skipheader 'X.*' - use 'folder:regexp' to apply only to certain folders ---useheader : Use this header to compare messages on both sides. - Ex: Message-ID or Subject or Date. ---useheader and this one, etc. ---skipsize : Don't take message size into account. ---dry : do nothing, just print what would be done. ---subscribed : transfers subscribed folders. ---subscribe : subscribe to the folders transferred on the - "destination" server that are subscribed - on the "source" server. ---(no)foldersizes : Calculate the size of each "From" folder in bytes - and message counts. Meant to be used with - --justfoldersizes. Turned on by default. ---justfoldersizes : exit after printed the folder sizes. ---syncacls : Synchronises acls (Access Control Lists). ---nosyncacls : Does not synchronise acls. This is the default. ---debug : debug mode. ---debugimap : imap debug mode. ---version : print software version. ---justconnect : just connect to both servers and print useful - information. Need only --host1 and --host2 options. ---justfolders : just do things about folders (ignore messages). ---fast : be faster (just does not sync flags). ---split1 : split the requests in several parts on source server. - is the number of messages handled per request. - default is like --split1 1000 ---split2 : same thing on the "destination" server. ---nofastio1 : don't use fastio with the "from" server. ---nofastio2 : don't use fastio with the "destination" server. ---timeout : imap connect timeout. ---help : print this. ---tmpfile : file name for temporary message file. ---pidfile : file name for PID file. - -Example: to synchronise imap account "foo" on "imap.truc.org" - to imap account "bar" on "imap.trac.org" - -$0 \\ - --host1 imap.truc.org --user1 foo --passfile1 /etc/secret1 \\ - --host2 imap.trac.org --user2 bar --passfile2 /etc/secret2 - - - Mail::IMAPClient version is $Mail::IMAPClient::VERSION -$rcs - imapsync copyleft is the GNU General Public License. - See http://www.gnu.org/copyleft/gpl.html -EOF -} - - -package Mail::IMAPClient; - - -sub Authuser { - my $self = shift; - - if (@_) { $self->{AUTHUSER} = shift } - return $self->{AUTHUSER}; -} - - -sub Split { - my $self = shift; - - if (@_) { $self->{SPLIT} = shift } - return $self->{SPLIT}; -} - -# From IMAPClient.pm -sub append_file2 { - - my $self = shift; - my $folder = $self->Massage(shift); - my $file = shift; - my $control = shift || undef; - my $count = $self->Count($self->Count+1); - my $flags = shift || undef; - my $date = shift || undef; - - if (defined($flags)) { - $flags =~ s/^\s+//g; - $flags =~ s/\s+$//g; - } - - if (defined($date)) { - $date =~ s/^\s+//g; - $date =~ s/\s+$//g; - } - - $flags = "($flags)" if $flags and $flags !~ /^\(.*\)$/ ; - $date = qq/"$date"/ if $date and $date !~ /^"/ ; - - - unless ( -f $file ) { - $self->LastError("File $file not found.\n"); - return undef; - } - - my $fh = IO::File->new($file) ; - - unless ($fh) { - $self->LastError("Unable to open $file: $!\n"); - $@ = "Unable to open $file: $!" ; - carp "unable to open $file: $!" if $^W; - return undef; - } - - my $bare_nl_count = scalar grep { /^\x0a$|[^\x0d]\x0a$/} <$fh>; - - seek($fh,0,0); - - my $clear = $self->Clear; - - $self->Clear($clear) - if $self->Count >= $clear and $clear > 0; - - my $length = ( -s $file ) + $bare_nl_count; - - my $string = "$count APPEND $folder " . - ( $flags ? "$flags " : "" ) . - ( $date ? "$date " : "" ) . - "{" . $length . "}\x0d\x0a" ; - - $self->_record($count,[ $self->_next_index($count), "INPUT", "$string" ] ); - - my $feedback = $self->_send_line("$string"); - - unless ($feedback) { - $self->LastError("Error sending '$string' to IMAP: $!\n"); - close $fh; - return undef; - } - - my ($code, $output) = ("",""); - - until ( $code ) { - $output = $self->_read_line or close $fh, return undef; - foreach my $o (@$output) { - $self->_record($count,$o); # $o is already an array ref - ($code) = $o->[DATA] =~ /(^\+|^\d+\sNO|^\d+\sBAD)/i; - if ($o->[DATA] =~ /^\*\s+BYE/) { - carp $o->[DATA] if $^W; - $self->State(Unconnected); - close $fh; - return undef ; - } elsif ( $o->[DATA]=~ /^\d+\s+(NO|BAD)/i ) { - carp $o->[DATA] if $^W; - close $fh; - return undef; - } - } - } - - { # Narrow scope - # 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}" ] ) ; - $feedback = $self->_send_line($text); - - unless ($feedback) { - $self->LastError("Error sending append msg text to IMAP: $!\n"); - close $fh; - return undef; - } - _debug $self, "control points to $$control\n" if ref($control) and $self->Debug; - $/ = 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" ] - ); - $feedback = $self->_send_line($text,1); - - unless ($feedback) { - $self->LastError("Error sending append msg text to IMAP: $!\n"); - close $fh; - return undef; - } - } - $feedback = $self->_send_line("\x0d\x0a"); - - unless ($feedback) { - $self->LastError("Error sending append msg text to IMAP: $!\n"); - close $fh; - return undef; - } - } - - # Now for the crucial test: Did the append work or not? - ($code, $output) = ("",""); - - my $uid = undef; - until ( $code ) { - $output = $self->_read_line or return undef; - foreach my $o (@$output) { - $self->_record($count,$o); # $o is already an array ref - $self->_debug("append_file: Deciding if " . $o->[DATA] . " has the code.\n") - if $self->Debug; - ($code) = $o->[DATA] =~ /^\d+\s(NO|BAD|OK)/i; - # try to grab new msg's uid from o/p - $o->[DATA] =~ m#UID\s+\d+\s+(\d+)\]# and $uid = $1; - if ($o->[DATA] =~ /^\*\s+BYE/) { - carp $o->[DATA] if $^W; - $self->State(Unconnected); - close $fh; - return undef ; - } elsif ( $o->[DATA]=~ /^\d+\s+(NO|BAD)/i ) { - carp $o->[DATA] if $^W; - close $fh; - return undef; - } - } - } - close $fh; - - if ($code !~ /^OK/i) { - return undef; - } - - - return defined($uid) ? $uid : $self; -} - -# From IMAPClient.pm -sub fetch_hash2 { - # taken from original lib, - # just added split code. - my $self = shift; - my $hash = ref($_[-1]) ? pop @_ : {}; - my @words = @_; - for (@words) { - s/([\( ])FAST([\) ])/${1}FLAGS INTERNALDATE RFC822\.SIZE$2/i ; - s/([\( ])FULL([\) ])/${1}FLAGS INTERNALDATE RFC822\.SIZE ENVELOPE BODY$2/i ; - } - my $msgref_all = scalar($self->messages); - my $split = $self->Split() || scalar(@$msgref_all); - while(my @msgs = splice(@$msgref_all, 0, $split)) { - #print "SPLIT: @msgs\n"; - my $msgref = \@msgs; - my $output = scalar($self->fetch($msgref,"(" . join(" ",@_) . ")")) - ; # unless grep(/\b(?:FAST|FULL)\b/i,@words); - my $x; - for ($x = 0; $x <= $#$output ; $x++) { - my $entry = {}; - my $l = $output->[$x]; - if ($self->Uid) { - my($uid) = $l =~ /\((?:.* )?UID (\d+).*\)/i; - next unless $uid; - if ( exists $hash->{$uid} ) { - $entry = $hash->{$uid} ; - } else { - $hash->{$uid} ||= $entry; - } - } else { - my($mid) = $l =~ /^\* (\d+) FETCH/i; - next unless $mid; - if ( exists $hash->{$mid} ) { - $entry = $hash->{$mid} ; - } else { - $hash->{$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; - } - } - } -} - return wantarray ? %$hash : $hash; -} - - -# From IMAPClient.pm - -sub login2 { - my $self = shift; - return $self->authenticate($self->Authmechanism,$self->Authcallback) - if $self->{Authmechanism}; - - my $id = $self->User; - my $has_quotes = $id =~ /^".*"$/ ? 1 : 0; - my $string = "Login " . ( $has_quotes ? $id : qq("$id") ) . - " " . $self->Password . "\r\n"; - $self->_imap_command($string) - and $self->State(Authenticated); - # $self->folders and $self->separator unless $self->NoAutoList; - unless ( $self->IsAuthenticated) { - my($carp) = $self->LastError; - $carp =~ s/^[\S]+ ([^\x0d\x0a]*)\x0d?\x0a/$1/; - carp $carp unless defined wantarray; - return undef; - } - return $self; -} - -# From IMAPClient.pm - -sub parse_headers2 { - my($self,$msgspec_all,@fields) = @_; - my(%fieldmap) = map { ( lc($_),$_ ) } @fields; - my $msg; my $string; my $field; - - unless(ref($msgspec_all) eq 'ARRAY') { - print "parse_headers2 want an ARRAY ref\n"; - exit 1; - } - - my $headers = {}; # hash from message ids to header hash - my $split = $self->Split() || scalar(@$msgspec_all); - while(my @msgs = splice(@$msgspec_all, 0, $split)) { - $debug and print "SPLIT: @msgs\n"; - my $msgspec = \@msgs; - - # Make $msg a comma separated list, of messages we want - $msg = $self->Range($msgspec); - - if ($fields[0] =~ /^[Aa][Ll]{2}$/ ) { - - $string = "$msg body" . - # use ".peek" if Peek parameter is a) defined and true, - # or b) undefined, but not if it's defined and untrue: - - ( defined($self->Peek) ? - ( $self->Peek ? ".peek" : "" ) : - ".peek" - ) . "[header]" ; - - } else { - $string = "$msg body" . - # use ".peek" if Peek parameter is a) defined and true, or - # b) undefined, but not if it's defined and untrue: - - ( defined($self->Peek) ? - ( $self->Peek ? ".peek" : "" ) : - ".peek" - ) . "[header.fields (" . join(" ",@fields) . ')]' ; - } - - my @raw=$self->fetch( $string ) or return undef; - - - my $h = 0; # reference to hash of current msgid, or 0 between msgs - - for my $header (map { split(/(?:\x0d\x0a)/,$_) } @raw) { - local($^W) = undef; - if ( $header =~ /^\*\s+\d+\s+FETCH\s+\(.*BODY\[HEADER(?:\]|\.FIELDS)/i) { - if ($self->Uid) { - if ( my($msgid) = $header =~ /UID\s+(\d+)/ ) { - $h = {}; - $headers->{$msgid} = $h; - } else { - $h = {}; - } - } else { - if ( my($msgid) = $header =~ /^\*\s+(\d+)/ ) { - #start of new message header: - $h = {}; - $headers->{$msgid} = $h; - } - } - } - next if $header =~ /^\s+$/; - - # ( for vi - if ($header =~ /^\)/) { # end of this message - $h = 0; # set to be between messages - next; - } - # check for 'UID)' - # when parsing headers by UID. - if ($self->Uid and my($msgid) = $header =~ /^\s*UID\s+(\d+)\s*\)/) { - $headers->{$msgid} = $h; # store in results against this message - $h = 0; # set to be between messages - next; - } - - if ($h != 0) { # do we expect this to be a header? - my $hdr = $header; - chomp $hdr; - $hdr =~ s/\r$//; - if ($hdr =~ s/^(\S+):\s*//) { - $field = exists $fieldmap{lc($1)} ? $fieldmap{lc($1)} : $1 ; - push @{$h->{$field}} , $hdr ; - } elsif ($hdr =~ s/^.*FETCH\s\(.*BODY\[HEADER\.FIELDS.*\)\]\s(\S+):\s*//) { - $field = exists $fieldmap{lc($1)} ? $fieldmap{lc($1)} : $1 ; - push @{$h->{$field}} , $hdr ; - } elsif ( ref($h->{$field}) eq 'ARRAY') { - - $hdr =~ s/^\s+/ /; - $h->{$field}[-1] .= $hdr ; - } - } - } - my $candump = 0; - if ($self->Debug) { - eval { - require Data::Dumper; - Data::Dumper->import; - }; - $candump++ unless $@; - } - - } - # if we asked for one message, just return its hash, - # otherwise, return hash of numbers => header hash - # if (ref($msgspec) eq 'ARRAY') { - - return $headers; - -} diff --git a/learn/hugemigr b/learn/hugemigr index 4ebc364..285bc49 100755 --- a/learn/hugemigr +++ b/learn/hugemigr @@ -1,6 +1,6 @@ #!/bin/sh -{while IFS=';' read u1 p1 u2 p2; do +{ while IFS=';' read u1 p1 u2 p2; do imapsync --user1 "$u1" --password1 "$p1" --user2 "$u2" --password2 "$p2" ... done ; } < file.csv diff --git a/memo b/memo index 743948a..0c3b0eb 100644 --- a/memo +++ b/memo @@ -16,6 +16,8 @@ niouzes_compil() { cd $DIR_SAVE } + + lfo_announce() { software_version NEWS_FILE="/home/gilles/public_html/www.linux-france.org/html/niouzes/niouzes_imapsync.xml" @@ -26,7 +28,7 @@ else `LANG=fr date '+%A %d %B %Y'` : Synchronisez ou migrez vos boites -aux lettres avec économie et l'outil imapsync $VERSION (Gilles LAMIRAL) EOF @@ -42,22 +44,20 @@ fm_read_param() { } -fm_announce() { +fm_init() { software_version NEWS_FILE_FM="/home/gilles/public_html/imapsync/freshmeat_submition" NEWS_FILE_FM_INP=${NEWS_FILE_FM}.inp NEWS_FILE_FM_OUT=${NEWS_FILE_FM}.out -if ! newer VERSION $NEWS_FILE_FM_OUT; then - echo "$VERSION already submitted on freshmeat" -else - if newer VERSION $NEWS_FILE_FM_INP; then - echo "Update $NEWS_FILE_FM_INP please" - return 1 - fi +} - fm_read_param - cat > $NEWS_FILE_FM_OUT << EOF +fm_read_announce() { + +fm_init +fm_read_param + +cat << EOF Project: imapsync Version: $VERSION Release-Focus: $RELEASE_FOCUS @@ -68,7 +68,22 @@ Gzipped-Tar-URL: http://www.linux-france.org/prj/imapsync/dist/ $TEXT_BODY EOF -#return +} + +fm_announce() { +fm_init + +if ! newer VERSION $NEWS_FILE_FM_OUT; then + echo "$VERSION already submitted on freshmeat" +else + if newer VERSION $NEWS_FILE_FM_INP; then + echo "Update $NEWS_FILE_FM_INP please" + return 1 + fi + + fm_read_param + fm_read_announce > $NEWS_FILE_FM_OUT + freshmeat-submit < $NEWS_FILE_FM_OUT fi diff --git a/t/01_connect b/t/01_connect new file mode 100644 index 0000000..5f7cdce --- /dev/null +++ b/t/01_connect @@ -0,0 +1,15 @@ +#!/usr/bin/perl -w + + +use Mail::IMAPClient; + +$imap = Mail::IMAPClient->new(); +$imap->Debug(1); +$imap->Server('Xlouloutte.dyndns.org'); +$imap->connect() or die; +$imap->User('MarkOv@est.belle'); +$imap->Password('emhj91ly'); +$imap->login(); +$imap->logout(); + + diff --git a/tests.sh b/tests.sh index 8116917..174c058 100644 --- a/tests.sh +++ b/tests.sh @@ -1,6 +1,6 @@ #!/bin/sh -# $Id: tests.sh,v 1.61 2007/06/15 04:06:58 gilles Exp gilles $ +# $Id: tests.sh,v 1.64 2007/10/30 03:20:32 gilles Exp gilles $ #### Shell pragmas @@ -26,9 +26,9 @@ run_test() { } run_tests() { - for t in $*; do + for t in "$@"; do test_count=`expr 1 + $test_count` - run_test $t + run_test "$t" sleep 1 done } @@ -71,9 +71,10 @@ no_args() { # dprof() sendtestmessage() { + email=${1:-"tata@est.belle"} rand=`pwgen 16 1` mess='test:'$rand - cmd="echo $mess""| mail -s ""$mess"" tata@est.belle" + cmd="echo $mess""| mail -s ""$mess"" $email" echo $cmd eval "$cmd" } @@ -445,6 +446,16 @@ ll_bad_host() } +ll_bad_host_ssl() +{ + ! ./imapsync \ + --host1 badhost --user1 toto@est.belle \ + --passfile1 /var/tmp/secret1 \ + --host2 badhost --user2 titi@est.belle \ + --passfile2 /var/tmp/secret2 \ + --ssl1 --ssl2 +} + ll_justfoldersizes() { @@ -843,6 +854,20 @@ ariasolutions() { } + +ariasolutions2() { + ./imapsync \ + --host1 209.17.174.12 \ + --user1 chrisw@basebuilding.net \ + --passfile1 /var/tmp/secret.ariasolutions2 \ + --host2 209.17.174.20 \ + --user2 chrisw@basebuilding.net\ + --passfile2 /var/tmp/secret.ariasolutions2 \ + --noauthmd5 --syncinternaldates + # --dry --debug --debugimap + + +} ########################## ########################## @@ -883,6 +908,7 @@ test $# -eq 0 && run_tests \ ll_sep2 \ ll_bad_login \ ll_bad_host \ + ll_bad_host_ssl \ ll_justfoldersizes \ ll_useheader \ ll_regexmess \ @@ -901,7 +927,7 @@ test $# -eq 0 && run_tests \ # selective tests -test $# -gt 0 && run_tests $* +test $# -gt 0 && run_tests "$@" # If there, all is good