diff --git a/CREDITS b/CREDITS index 92dd10f..aff02cc 100644 --- a/CREDITS +++ b/CREDITS @@ -1,5 +1,5 @@ #!/bin/cat -# $Id: CREDITS,v 1.129 2010/02/15 17:41:48 gilles Exp gilles $ +# $Id: CREDITS,v 1.135 2010/04/27 23:10:53 gilles Exp gilles $ If you want to make a donation to the author, Gilles LAMIRAL: @@ -12,6 +12,7 @@ b) If you can read french, please use the following wishlist : (books will be send with free postal cost) c) its paypal account : gilles.lamiral@laposte.net +http://www.linux-france.org/prj/imapsync/paypal.html Here are the persons who helped me to develop imapsync. Feel free to tell me if a name is missing or if you want @@ -19,6 +20,38 @@ to remove one. I thank very much all of these people. +Pertti Karppinen +Found and fixed a bug in compare_lists(). +No flag on host1 was not removing flags on host2. + +Owen Allsopp +Contributed by giving the book +16.66 "The Success of Open Source" + +Kai Rankio +Contributed by giving the book +16.47 "Producing Open Source Software: How to Run a Successful Free Software Project" + +Joshua Schmidlkofer +Contributed by giving the book +36.97 "Hacker's Delight" + +Mark Charette +Contributed by giving the book +23.09 "MAKE: Electronics: Learning Through Discovery" + +Mordur Ingolfsson +Contributed by giving the book +47.16 "Mobile Python: Rapid prototyping of applications on the mobile platform" + +Daryl Herzmann +Contributed by giving the book +19.77 "The Elements: A Visual Exploration of Every Known Atom in the Universe" + +Brian Fonseca +Contributed by giving the book +35.95 "Lions' Commentary on Unix" + Gary MacIsaac Contributed by giving the books 32.00 "The Mathematical Theory of Communication" @@ -790,6 +823,16 @@ Eric Yung Total amount of book prices : c \ +16.66+\ +16.47+\ +\ +36.97+\ +23.09+\ +47.16+\ +\ +19.77+\ +\ +35.95+\ 32.00+\ 34.61+\ 91.26+\ @@ -886,4 +929,4 @@ c \ 31.20+\ 40.00 = -2372.31 +2568.38 diff --git a/ChangeLog b/ChangeLog index ac27372..7302fd9 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,17 +1,21 @@ RCS file: RCS/imapsync,v Working file: imapsync -head: 1.310 +head: 1.311 branch: locks: strict - gilles: 1.310 + gilles: 1.311 access list: symbolic names: keyword substitution: kv -total revisions: 310; selected revisions: 310 +total revisions: 311; selected revisions: 311 description: ---------------------------- -revision 1.310 locked by: gilles; +revision 1.311 locked by: gilles; +date: 2010/04/27 23:03:39; author: gilles; state: Exp; lines: +35 -12 +Fixed bug in compare_lists(). Thanks to Pertti Karppinen. +---------------------------- +revision 1.310 date: 2010/02/26 01:24:59; author: gilles; state: Exp; lines: +10 -11 Removed modules_VERSION() call (useless) Replaced Phil regex with /e one. diff --git a/FAQ b/FAQ index 980a1be..2d05791 100644 --- a/FAQ +++ b/FAQ @@ -1,5 +1,5 @@ #!/bin/cat -# $Id: FAQ,v 1.65 2010/02/26 01:07:01 gilles Exp gilles $ +# $Id: FAQ,v 1.66 2010/03/04 19:22:17 gilles Exp gilles $ +------------------+ | FAQ for imapsync | @@ -107,7 +107,12 @@ R. - Download Mail::IMAPClient 2.2.9 at or if imapsync is in directory /path/ perl -I./Mail-IMAPClient-2.2.9 /path/imapsync [...] +======================================================================= +Q. Can I use imapsync to migrate emails from pop server to imap server? +R. No. +You can migrate emails from pop server to imap server with pop2imap: +http://www.linux-france.org/prj/pop2imap/ ======================================================================= Q. I am interested in creating a local clone of the IMAP on a LAN diff --git a/Mail-IMAPClient-3.21/COPYRIGHT b/Mail-IMAPClient-3.21/COPYRIGHT deleted file mode 100644 index ebc36eb..0000000 --- a/Mail-IMAPClient-3.21/COPYRIGHT +++ /dev/null @@ -1,401 +0,0 @@ -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-3.21/Changes b/Mail-IMAPClient-3.21/Changes deleted file mode 100644 index fc8b7ab..0000000 --- a/Mail-IMAPClient-3.21/Changes +++ /dev/null @@ -1,2011 +0,0 @@ - -== Revision History for Mail::IMAPClient -Changes from 3.17_01 to ? made by Phil Lobbes -Changes from 2.99_01 to 3.16 made by Mark Overmeer -Changes from 0.09 to 2.99_01 made by David Kernen - - Potential compatibility issues from 3.17+ highlighted with '*' - -version 3.21: Tue Sep 22 19:45:13 EDT 2009 - - rt.cpan.org#49691: rewrite of fetch_hash to resolve several issues - [Robert Norris] - includes new tests via t/fetch_hash.t - - rt.cpan.org#48980: (enhancement) add support for XLIST extension - [Robert Norris] - - rt.cpan.org#49024: NIL personal name returned by *_addresses methods - [Dmitry Bigunyak] - - rt.cpan.org#49401: IMAPClient expunge fails (unless folder arg used) - [Gary Baluha] - - update/clarify close and expunge documentation a little - -version 3.20: Fri Aug 21 17:40:40 EDT 2009 - - added file/tests in t/simple.t - - added methods Rfc3501_date/Rfc3501_datetime - used by deprecated methods Rfc2060_date/Rfc2060_datetime - rt.cpan.org#48510: Rfc3501_date/Rfc3501_datetime methods do - not exist [sedmonds] - - login() hack to quote an empty password - rt.cpan.org#48107: Cannot LOGIN with empty password [skunk] - -version 3.19: Fri Jun 19 14:59:15 EDT 2009 - - *search() backwards compat: caller must quote single arg properly - rt.cpan.org#47044: $imap->search does not return [ekuemmer] - - cleanup regexp in _send_line() - - reduce extra newlines injected by _debug() - -version 3.19_02: Tue Jun 9 00:47:52 EDT 2009 - - _list_or_lsub() now calls _list_response_preprocess so - consumers of this method no longer need to deal with how - LITERAL data is represented in the returned data - - update _list_or_lsub_response_parse handling of folder names - that came back as literal data - - update comments related to _list_response_preprocess -version 3.19_01: Fri Jun 5 15:45:05 EDT 2009 - - make parse_headers more robust to errors/non-header data - -version 3.18: Wed Jun 3 23:07:12 EDT 2009 - - enhance fetch_hash to enable caller to specify list of messages - suggestion by [Eugene Mamaev] - - better handling of untagged BYE response - -version 3.18_02: Wed May 27 10:02:24 EDT 2009 - - *new attribute Ssl, when true causes IO::Socket::SSL to be - used instead of IO::Socket::INET. This change allows - Reconnectretry logic to work on SSL connections too. - - have LastError cluck() if setting error to NO not connected - - handle errors from imap4rev1() in multiple places - - Reconnectretry/_imap_command enhancements/fixes - + only run command if IsConnected - + keep a temporary history of LastError(s) - + sets LastError to NO not connected if ! IsConnected - + retry =~ timeout|socket closed|* BYE| NO not connected - - _imap_command_do reduce data logged when using APPEND - - fetch() now handles messages() errors - - thread(), has_capability(), capability() better error checking - - authenticate() now uses _imap_command for retry mechanism - - size() now sets LastError when no RFC822.SIZE is found - -version 3.18_01: Fri May 22 17:08:00 EDT 2009 - - *update several methods to use common _get_response() method - - refactor most code handling imap responses - - new internal method _get_response() to reduce code duplication - - more regex cleanup $CR/$LF (not \r\n) per perlport/IMAP spec - - major cleanup/fix of append_file for rt.cpan.org#42434 - -version 3.17: Thu May 21 01:40:08 EDT 2009 - - ran all test code and lib/Mail/IMAPClient.pm through Perl::Tidy - - plan on using perltidy to standardize format going forward - - added 13 tests to t/basic.t to cover more methods - - fix some broken tests - - update Makefile.PL to provide info about optional modules - -version 3.17_05: Tue May 19 11:04:28 EDT 2009 - - *reset LastError for every call to _imap_command_do() - - *run() - use _imap_command_do(), return arrayref in scalar context - - *tag_and_run() - return arrayref in scalar context - - *done() - use _imap_command_do(), return arrayref in scalar context - - *search() now returns empty arrayref not undef if no matches found - - _imap_command_do() made more flexible to avoid code duplication - - _list_response_parse renamed _list_or_lsub_response_parse - - updated POD with new/updated behavior - - append_string() now uses _imap_command_do() for Reconnectretry - - internally use defined return values instead of only LastError() - - run() updated to use same/similar code to _imap_command_do() - - make several return statements more consistent - - delete() now unsets current Folder attribute on success - -version 3.17_04: Fri May 15 17:18:52 EDT 2009 - - updated POD with new reconnect() method and Reconnectretry attr - - *new _imap_command() after renaming old one to _imap_command_do - support retrying commands X times EPIPE/ECONNRESET errors - - *new Reconnectretry attribute to control number of retry - attempts (default is 0 - no reconnect/retry) - - *added reconnect() method to support Reconnectretry attr - reconnect and updated _imap_command() method - - *_imap_command_do will return undef if command given has no TAG - - fixed message_string() logic/errors for failed size() calls - - local-ize $! anywhere we use Carp routines as older versions - of Carp could cause $! to be reset - - several 'BUG?' comments -- raising red flag for future work - - minor cleanup of sort() logic - - reduce duplicate code, hopefully improved error handling: - new _list_or_lsub() for list() and lsub() - new _folders_or_subscribed() for folders() and subscribed() - + new _list_response_preprocess() keeping old code/logic in - for now, but may remove in the future (for buggy servers?) - - some updates for migrate() but this method needs much work - - body_string() now handles fetch() errors - - tag_and_run now handles _imap_command() errors - - changed non-timeout CORE::select() timeout from 0.001 to 0.025 - - minor cleanup of _read_line() error handling/debug output - - get_bodystructure() handle more fetch() errors - - expunge() handle select() errors - - restore_message() handle store() errors - - uidvalidity() handle status() errors - - uidnext() handle status() errors - - is_parent() use _list_response_preprocess() for parsing - - move() send delete_message() errors to stderr - - simplify size() method - -version 3.17_03: Fri May 8 16:37:08 EDT 2009 - - *added uidexpunge() for UID EXPUNGE UIDPLUS support - - *search() now DWIM: auto-escapes args, SCALAR refs not escaped - rt.cpan.org#44936 [cjhenck] - - _quote_search() provides auto-escape capability for search() - - many POD updates as well as some major reformatting (incomplete) - - login now fails if passwd and user are not defined - - _sysread(): $self was in args to 'Readmethod' twice - - authenticate() return undef on scheme eq "" or LOGIN - - "require" instead "use" Digest::HMAC_MD5 for CRAM-MD5 support - -version 3.17_02: Fri May 1 16:44:21 EDT 2009 - - cleanup of use/imported data - - use Socket $CRLF in many cases not \r\n per perlport/IMAP spec - - *new Keepalive attribute used via new()/Socket() enables SO_KEEPALIVE - - LastError now uses Carp::confess for stack trace if Debug is true - - Maxcommandlength now defaults to 1000 per RFC2683 section 3.2.1.5 - - added noop() to support IMAP NOOP - - _imap_command now sets LastError if a OK/$good response is not seen - - fixed fetch_hash() to return FLAGS as "" not () when no FLAGS set - -version 3.17_01: Fri Apr 24 18:36:45 EDT 2009 - - *new attribute Maxcommandlength used by fetch() to limit - length of commands sent to a server. This should removes - need for utilities like imapsync to create their own split() - functions and instead allows Mail::IMAPClient to hopefully - "do the right thing" - - remove extra 'use' calls for Carp and Data::Dumper - - _read_more() improperly initialized vector causing select - errors, thus timeouts were not working properly (now they - work...) - - *change default timeout 30s => 600s: 30s seems too short in - practice - - *explicit import of encode_base64 and decode_base64 from - MIME::Base64 note the code forces a disconnect from the - server on timeout as we can not easily recover from this - situation right now in the code - - *numerous changes of error messages, removing superfluous - text and now relying on LastError instead of $! or $@ when - appropriate - - separator(): - + now return undef if an error occured for NAMESPACE or LIST calls - + *no longer defaults to '/' if NAMESPACE call does not succeed - - new internal _list_response_parse() method for parsing LIST - responses - - handle ECONNRESET errors on syswrite and mark connection as - Unconnected - + error "Connection lost" changed to "Write failed" - - previously untrapped syswrite error now generate "Write - failed" errors - - fix in _imap_command where LastError would be erroneously - set on LOGOUT - - _record() no longer tries to infer errors based on data - being "recorded" - - _send_line() - + cleanup in watching for: +|NO|BAD|BYE - + now sets LastError when an unexpected response is seen - - _read_line() - + handle select errors instead of ignoring them - + forcefully _disconnect() on timeouts as this breaks app logic - + reduced duplication of code on error handling - - added _disconnect() method to brute force drop connections - on timeout - - added _list_response_parse() to reduce duplicate code for - LIST parsing - - added _split_sequence() to support new Maxcommandlength argument - - fetch() - + use new Maxcommandlength to split a request into multiple - subrequests then aggregate results before passing them - back to the caller - - fetch_hash(): added checks for failed IMAP commands - - parse_headers() - + properly check if fetch fails - + handle cases where $header and/or $field are not defined - - size(): - + return undef if LastError is set - + fix case where SIZE is not found and return undef as expected - -version 3.16: Mon Apr 6 12:03:41 CEST 2009 - - Fixes: - - - set LastError when the imap_command receives an unexpected 'BYE' answer. - rt.cpan.org#44762 [Phil Lobbes] - - - handle SIGPIPE cleanly. - rt.cpan.org#43414 [Phil Lobbes] - - - improve handling of quotes in folder names - rt.cpan.org#43445 [Phil Lobbes] - - - do not use $socket->eof(), because IO::Socket::SSL does not support it. - rt.cpan.org#43415 [Phil Lobbes] - - - remove excessive reconfiguration of fastio in _read_line() - rt.cpan.org#43413 [Phil Lobbes] - - Improvements: - - - remove experied docs about automatically created calls, which - do not exist since 3.00 - - - remove verbose explanation about reporting bugs. - -version 3.15: Fri Mar 20 13:20:39 CET 2009 - - Fixes: - - - manual-page was using POD syntax incorrectly, which caused many - broken links on search.cpan.org - rt.cpan.org #44212 [R Hubbell] - -version 3.14: Mon Feb 16 14:18:09 CET 2009 - - Fixes: - - - isparent() when list() returns nothing. - rt.cpan.org#42932 [Phil Lobbes] - - - Quote more characters in Massage(): add CTL, [, ], % and * - rt.cpan.org#42932 [Phil Lobbes] - - - message_string() will only complain about a difference between - reported message size and actually received size; it will not - try to correct it anymore. - rt.cpan.org#42987 [Phil Lobbes] - - - No error when empty text in append_string() - rt.cpan.org#42987 [Phil Lobbes] - - - login() should not try authenticate() if auth is empty or undef - rt.cpan.org#43277 [Phil Lobbes] - -version 3.13: Thu Jan 15 10:29:04 CET 2009 - - Fixes: - - - "othermessage" in bodystructure parser should expect an MD5, - not bodyparams. Fix and test(!) by [Michael Stok] - - Improvement: - - - minor simplifications in code of run() and _imap_command() - - - get_bodystructure trace message fix [Michael Stok] - - - add Domain option for NTLM authentication. - -version 3.12: Mon Nov 24 15:34:58 CET 2008 - - Improvement: - - - major performance improvement in append_message(), avoiding - reading the whole file in memory as the docs promised but the - code didn't do. [David Podolsky] - -version 3.11: Wed Oct 8 10:57:31 CEST 2008 - - Fixes: - - - some SSL connections process more bytes then needed, which - made the select() timeout. Nice fix by [David Sansome] - rt.cpan.org#39776 - - Improvements: - - - improved example imap_to_mbox by [Ralph Sobek] - -version 3.10: Sun Aug 24 21:26:27 CEST 2008 - - Fixes: - - - INET socket scope error, introduced by 3.09 - rt.cpan.org#38689 [Matt Moen] - -version 3.09: Fri Aug 22 16:38:25 CEST 2008 - - Fixes: - - - return status of append_message reversed. - rt.cpan.org#36726 [Jakob Hirsch] - - - no line-breaks in base64 encoded strings when logging-in - rt.cpan.org#36879 [David Jonas] - - - fix MD5 authentication. - rt.cpan.org#38654 [Thomas Jarosch] - - Improvements: - - - extensions and clean-ups in examples/imap_to_mbox.pl by - [Ralph Sobek] - - - an absolute path as Server setting will open a local ::UNIX - socket, not an ::INET - rt.cpan.org#38655 [Thomas Jarosch] - -version 3.08: Tue Jun 3 09:36:24 CEST 2008 - - Fixes: - - - message_to_file used wrong command. - rt.cpan.org#36184 [Parse Int] - - - oops, distribution released with OODoc/oodist, not make dist. - [Randy Harmon] - - - fix parsing of body-structure information for multi-parts. - rt.cpan.org#36279 [Doug Claar] - - Improvements: - - - Updated README and TODO (Was 'Todo') - -version 3.07: Mon Apr 28 09:17:30 CEST 2008 - - Fixes: - - - expunge with no folder specified produced "use of undef" - error. Fixed by [André Warnier] - - - additional arguments for create [Michael Bacon] - - - accepts LIST answer with multiple lines [Michael Bacon] - - - ::BodyStructure::_address() should be _addresses() - Fixed by rt.cpan.org#35471 [Brian Kelly] - -version 3.06: Mon Apr 14 23:44:03 CEST 2008 - - Fixes: - - - expunge without argument must use selected folder. [John W] - - - expunge with folder does not select it. [John W] - - - the documentation still spoke about "autogenerated methods", - but they were removed with 2.99 [John W] - - - append_string needs LF -> CRLF translations, for some - servers. rt.cpan.org #35031 [Jonathan Kamens] - - Improvements: - - - added ::setquota(), thanks to [Jappe Reuling] - -version 3.05: Wed Feb 20 08:59:37 CET 2008 - - Fixes: - - - match ENVELOPE and BODYSTRUCTURE more strict in the - grammar, to avoid confusion. [Zach Levow] - - - get_envelope and get_bodystructure failed for servers which - did not return the whole answer in one piece. [Zach Levow] - - - do not produce parser errors when get_envelope does not - return an envelope. [Zach Levow] - - - PLAIN login response possibly solely a '+' [Zach] and [Nick] - -version 3.04: Fri Jan 25 09:25:51 CET 2008 - - Fixes: - - - read_header fix for UID on Windows Server 2003. - rt.cpan.org#32398 [Michiel Stelman] - - Improvements: - - - doc update on authentication, by [Thomas Jarosch] - -version 3.03: Wed Jan 9 22:11:36 CET 2008 - - Fixes: - - - LIST (f.i. used by folders()) did not return anything when the - passed argument had a trailing separator. [Gunther Heintze] - - - Rfc2060_datetime() must include a zone. - rt.cpan.org#31971 [David Golden] - - - folders() uses LIST, and then calls a STATUS on each of the - names found. This is superfluous, and will cause problems when - the STATUS fails... for instance because of ACL limitations - on the sub-folder. - rt.cpan.org#31962 [Thomas Jarosch] - - - fixed a zillion of problems in the BodyStructure parser. The - original author did not understand parsing, nor Perl. - - - part numbering wrong when nested messages contained multiparts - - Improvements: - - - implementation of DIGEST-MD5 authentication [Thomas Jarosch] - - - removed call for status() in Massage(), which hopefully speeds-up - things without destroying anything. It removed a possible deep - recursion, which no-one reported (so should be ok to remove it) - - - simplified folders() algorithm. - - - merged folder commands, like subscribe into one. - - - added unsubscribe() - rt.cpan.org#31268 [G Miller] - - - lazy-load Digest::HMAC_MD5 - -version 3.02: Wed Dec 5 21:33:17 CET 2007 - - Fixes: - - - Another attempt to get get FETCH UID right. Patch by [David Golden] - -version 3.01: Wed Dec 5 09:55:43 CET 2007 - - Changes: - - - removed version number from ::BodyStructure - - Fixes: - - - quote password at login. - rt.cpan.org#31035 [Andy Harriston] - - - empty return of flags command should be empty list, not undef. - rt.cpan.org#31195 [David Golden] - - - UID command does not work with folder management commands - rt.cpan.org#31182 [Robbert Norris] - - - _read_line simplifications avoids timeouts. - rt.cpan.org#31221 [Robbert Norris] - - - FETCH did not detect the UID of a message anymore. - [David Golden] - - Improvements: - - - proxyauth for SUN/iPlanet/NetScape IMAP servers. - patch by rt.cpan.org#31152 [Robbert Norris] - - - use grep in stead of map in one occasion in MessageSet.pm - [Yves Orton] - -version 3.00: Wed Nov 28 09:56:54 CET 2007 - - Fixes: - - - "${peek}[]" should be "$peek\[]" for perl 5.6.1 - rt.cpan.org#30900 [Gerald Richter] - -version 2.99_07: Wed Nov 14 09:54:46 CET 2007 - - Fixes: - - - forgot to update the translate grammar. - -version 2.99_06: Mon Nov 12 23:21:58 CET 2007 - - Fixes: - - - body structure can have any number of optional parameters. - Patch by [Gerald Richter]. - - - get_bodystructure did not take the output correctly [Gerald Richter] - - - parser of body-structure did not handle optional body parameters - Patch by [Gerald Richter], rt.cpan.org#4479 [Geoffrey D. Bennet] - -version 2.99_05: Mon Nov 12 00:17:42 CET 2007 - - Fixes: - - - pod error in MessageSet.pm - - - folders() without argument failed. [Gerald Richter] - - Improvements: - - - better use of format syntax in date formatting. - - - Rfc2060_datetime also contains the time. - - - append_file() now has options to pass flags and time of file - in one go. [Thomas Jarosch] - -version 2.99_04: Sat Nov 10 20:55:18 CET 2007 - - Changes: - - - Simplified initiation of IMAP object with own Socket with a new - option: RawSocket [Flavio Poletti] - - Fixes: - - - fixed read_line [Flavio Poletti] - - - fixed test-run in t/basic.t [Flavio Poletti] - -version 2.99_03: Thu Nov 1 12:36:44 CET 2007 - - Fixes: - - - Remove note about optional Parse::RecDescent by Makefile.PL; - it is not optional anymore - - Improvements: - - - When syswrite() returns 0, that might be caused by an error - as well. Take the timeout/maxtemperrors track. - rt.cpan.org#4701 [C Meyer] - - - add NTLM support for logging-in, cleanly intergrated. Requires - the user to install Authen::NTLM. - -version 2.99_02: Fri Oct 26 11:47:35 CEST 2007 - - The whole Mail::IMAPClient was rewritten, hopefully without - breaking the interface. Nearly no line was untouched. - - The following things happened: - - use warnings, use strict everywhere - - removed many lines which were commented out, over the years - - $self->_debug if $self->Debug checked debug flag twice - - $self->LogError calls where quite inconsequent wrt $@ and carp - - consequent layout, changed sporadic tabs in blanks - - consequent calling convensions - - \0x0d\0x0a is always \r\n - - zillions of minor syntactical improvements - - a few major algorithmic rewrites to simplify the code, still - many oppotunities for improvements. - - 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 1000 lines (30%!) 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], #4662 [Rasjid] - - - 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. - - - do not send the password on a different line as the username - in LOGIN. Suggested by many people, amongst them - rt.cpan.org#4449 [Lars Uffmann] - - - select() with $timeout==0 (no timeout) returns immediately. - Should be 'undef' as 4th select parameter. - rt.cpan.org#5962 [Colin Robertson] and [Jules Agee] - - - examine() remembers Massage()d folder name, not the unescaped - version. rt.cpan.org#7859 [guest] - - Improvements: - - - PREAUTH support by rt.cpan.org#17693 [Danny Siu] - - - 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. - - - reworked Bodystructure and MessageSet as well. - - - EnableServerResponseInLiteral now autodetect (hence ignored) - -version 2.99_01: - - After 4 years of silence, Mark Overmeer took maintenance. David - 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-3.21/INSTALL b/Mail-IMAPClient-3.21/INSTALL deleted file mode 100644 index 1b74934..0000000 --- a/Mail-IMAPClient-3.21/INSTALL +++ /dev/null @@ -1,82 +0,0 @@ -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-3.21/MANIFEST b/Mail-IMAPClient-3.21/MANIFEST deleted file mode 100644 index f71af2b..0000000 --- a/Mail-IMAPClient-3.21/MANIFEST +++ /dev/null @@ -1,41 +0,0 @@ -COPYRIGHT -Changes -INSTALL -MANIFEST -Makefile.PL -README -TODO -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 -lib/Mail/IMAPClient.pm -lib/Mail/IMAPClient.pod -lib/Mail/IMAPClient/BodyStructure.pm -lib/Mail/IMAPClient/BodyStructure/Parse.grammar -lib/Mail/IMAPClient/BodyStructure/Parse.pm -lib/Mail/IMAPClient/BodyStructure/Parse.pod -lib/Mail/IMAPClient/MessageSet.pm -lib/Mail/IMAPClient/Thread.grammar -lib/Mail/IMAPClient/Thread.pm -lib/Mail/IMAPClient/Thread.pod -prepare_dist -sample.perldb -t/basic.t -t/bodystructure.t -t/fetch_hash.t -t/messageset.t -t/pod.t -t/simple.t -t/thread.t -test_template.txt -META.yml Module meta-data (added by MakeMaker) diff --git a/Mail-IMAPClient-3.21/META.yml b/Mail-IMAPClient-3.21/META.yml deleted file mode 100644 index b26bb35..0000000 --- a/Mail-IMAPClient-3.21/META.yml +++ /dev/null @@ -1,22 +0,0 @@ -# http://module-build.sourceforge.net/META-spec.html -#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# -name: Mail-IMAPClient -version: 3.21 -version_from: lib/Mail/IMAPClient.pm -installdirs: site -requires: - Carp: 0 - Errno: 0 - Fcntl: 0 - File::Temp: 0 - IO::File: 0 - IO::Select: 0 - IO::Socket: 0 - IO::Socket::INET: 1.26 - List::Util: 0 - MIME::Base64: 0 - Parse::RecDescent: 1.94 - Test::More: 0 - -distribution_type: module -generated_by: ExtUtils::MakeMaker version 6.17 diff --git a/Mail-IMAPClient-3.21/Makefile.PL b/Mail-IMAPClient-3.21/Makefile.PL deleted file mode 100644 index 4cea875..0000000 --- a/Mail-IMAPClient-3.21/Makefile.PL +++ /dev/null @@ -1,145 +0,0 @@ -use ExtUtils::MakeMaker; -use warnings; -use strict; - -my @missing; -my %optional = ( - "Authen::NTLM" => { for => "Authmechanism 'NTLM'" }, - "Authen::SASL" => { for => "Authmechanism 'DIGEST-MD5'" }, - "Digest::HMAC_MD5" => { for => "Authmechanism 'CRAM-MD5'" }, - "Digest::MD5" => { for => "Authmechanism 'DIGEST-MD5'" }, - "IO::Socket::SSL" => { for => "SSL enabled connections (Ssl => 1)" }, - "Test::Pod" => { for => "Pod tests", ver => "1.00" }, -); - -foreach my $mod ( sort keys %optional ) { - my $for = $optional{$mod}->{"for"} || ""; - my $ver = $optional{$mod}->{"ver"} || ""; - eval "use $mod $ver ();"; - push @missing, $mod . ( $for ? " for $for" : "" ) if $@; -} - -# similar message to one used in DBI: -if (@missing) { - print( "The following optional modules were not found:", - map( "\n\t" . $_, @missing ), "\n" ); - - print <<'MSG'; -Optional modules are available from any CPAN mirror, reference: - http://search.cpan.org/ - http://www.perl.com/CPAN/modules/by-module - http://www.perl.org/CPAN/modules/by-module - -MSG - sleep 3; -} - -WriteMakefile( - NAME => 'Mail::IMAPClient', - , - ABSTRACT => 'IMAP4 client library', - VERSION_FROM => 'lib/Mail/IMAPClient.pm', - PREREQ_PM => { - 'Carp' => 0, - 'Errno' => 0, - 'Fcntl' => 0, - 'IO::File' => 0, - 'IO::Select' => 0, - 'IO::Socket' => 0, - 'IO::Socket::INET' => 1.26, - 'List::Util' => 0, - 'MIME::Base64' => 0, - 'Parse::RecDescent' => 1.94, - 'Test::More' => 0, - 'File::Temp' => 0, - }, - clean => { FILES => 'test.txt' }, - $] >= 5.005 - ? ## keywords supported since 5.005 - ( AUTHOR => 'Phil Lobbes ' ) - : () -); - -set_test_data(); - -exit 0; - -### -### HELPERS -### - -sub set_test_data { - unless ( -f "lib/Mail/IMAPClient.pm" ) { - warn "ERROR: not in installation directory\n"; - return; - } - - return if -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 !~ /^y(?:es)?$/i; - - unless ( open TST, '>', "./test.txt" ) { - warn "ERROR: couldn't open ./test.txt: $!\n"; - return; - } - - my $server = ""; - until ($server) { - $server = - prompt "\nPlease provide the hostname or IP address of " - . "a host running an\nIMAP server (or QUIT to skip " - . "the extended tests)"; - chomp $server; - return if $server =~ /^\s*quit\s*$/i; - } - - print TST "server=$server\n"; - - my $user = ""; - until ($user) { - $user = - prompt "\nProvide the username of an account on $server (or QUIT)"; - chomp $user; - return if $user =~ /^\s*quit\s*$/i; - } - print TST "user=$user\n"; - - my $passed = ""; - until ($passed) { - $passed = prompt "\nProvide the password for $user (or QUIT)"; - chomp $passed; - return if $passed =~ /^\s+$|^quit$/i; - } - - print TST "passed=$passed\n"; - - my $port = prompt "\nPlease provide the port to connect to on $server " - . "to run the test\n(default is 143)"; - chomp $port; - $port ||= 143; - print TST "port=$port\n"; - - my $authmech = prompt "\nProvide the authentication mechanism to use " - . "on $server to\nrun the test (default is LOGIN)"; - - chomp $authmech; - $authmech ||= 'LOGIN'; - print TST "authmechanism=$authmech\n"; - close TST; - - print <<'__THANKS'; - -The information you provided (including the password!) has been stored -in test.txt and SHOULD BE REMOVED (either by hand or by 'make clean') -after testing. -__THANKS - -} diff --git a/Mail-IMAPClient-3.21/README b/Mail-IMAPClient-3.21/README deleted file mode 100644 index 45de3fb..0000000 --- a/Mail-IMAPClient-3.21/README +++ /dev/null @@ -1,111 +0,0 @@ - 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 paragraph has not been updated for many years] -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) - -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. - -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-3.21/TODO b/Mail-IMAPClient-3.21/TODO deleted file mode 100644 index 47ff39a..0000000 --- a/Mail-IMAPClient-3.21/TODO +++ /dev/null @@ -1,68 +0,0 @@ - -=== README - -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 far too long. - -The code and installation procedure has 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-3.21/examples/build_dist.pl b/Mail-IMAPClient-3.21/examples/build_dist.pl deleted file mode 100644 index d51dc5f..0000000 --- a/Mail-IMAPClient-3.21/examples/build_dist.pl +++ /dev/null @@ -1,172 +0,0 @@ -#!/usr/local/bin/perl -#$Id: //depot/main/ZimbraPS/Mail-IMAPClient/examples/build_dist.pl#1 $ - -use Mail::IMAPClient; - -=head1 DESCRIPTION - -B accepts the name of a target folder as an argument. It -then opens that folder and rummages through all the mail files in it, looking -for "Reply-to:" headers (or "From:" headers, where there is no "Reply-to:"). -It then appends a message into the folder containing all of the addresses in -thus found as a list of recipients. This message can be used to conveniently -drag and drop names into an address book, distribution list, or e-mail message, -using the GUI client of choice. - -The email appended to the folder specified in the I<-f> option will have the -subject "buid_dist.pl I Output". - -=head1 SYNTAX - -b I<-h> - -b I<-s servername -u username -p password -f folder [ -d ]> - -=over 4 - -=item -f The folder name to process. - -=item -s The servername of the IMAP server - -=item -u The user to log in as - -=item -p The password for the user specified in the I<-u> option - -=item -d Tells the IMAP client to turn on debugging info - -=item -h Prints out this document - -=back - -B You can supply defaults for the above options by updating the script. - -=cut - -use Getopt::Std; - -getopts('s:u:p:f:d'); - -# Update the following to supply defaults: - -$opt_f ||= "default folder"; -$opt_s ||= "default server"; -$opt_u ||= "default user"; -$opt_p ||= "default password"; # security risk: use with caution! - -# Let the compiler know we're serious about these two variables: -$opt_h = $opt_h or $opt_d = $opt_d ; - -exec "perldoc $0" if $opt_h; - -my $imap = Mail::IMAPClient->new( - Server => $opt_s , - User => $opt_u , - Password=> $opt_p , - Debug => $opt_d||0 , -) or die "can't connect to server\n"; - -$imap->select($opt_f); - -my @msgs = $imap->search("NOT SUBJECT",qq("buid_dist.pl $opt_f Output")); -my %list; -foreach my $m (@msgs) { - - my $ref = $imap->parse_headers($m,"Reply-to","From"); - - warn "Couldn't get recipient address from msg#$m\n" - unless scalar(@{$ref->{'Reply-to'}}) || - scalar(@{$ref->{'From'}}) ; - - my $from = scalar(@{$ref->{'Reply-to'}}) ? - $ref->{'Reply-to'}[0] : - $ref->{'From'}[0] ; - - my $addr = $from; - $addr =~ s/.*]//g; - $list{$addr} = $from unless exists $list{$addr}; -} - -$append = <<"EOMSG"; -To: ${\(join(",",values %list))} -From: $opt_u\@$opt_s -Date: ${\($imap->Rfc822_date(time))} -Subject: build_dist.pl $opt_f Output - -The above note was never actually sent to the following people: - -${\(join("\n",keys %list))} - -Interesting, eh? - -Love, -$opt_u - -EOMSG - -$imap->append($opt_f,$append) or warn "Couldn't append the message."; - -$imap->logout; - - -=head1 AUTHOR - -David J. Kernen - -The Kernen Group, Inc. - -imap@kernengroup.com - -=head1 COPYRIGHT - -This example and Mail::IMAPClient are Copyright (c) 2003 -by The Kernen Group, Inc. All rights reserved. - -This example is distributed with Mail::IMAPClient and -subject to the same licensing requirements as Mail::IMAPClient. - -imtest is a utility distributed with Cyrus IMAP server, -Copyright (c) 1994-2000 Carnegie Mellon University. -All rights reserved. - -=cut - - -# $Id: //depot/main/ZimbraPS/Mail-IMAPClient/examples/build_dist.pl#1 $ -# $Log: build_dist.pl,v $ -# Revision 19991216.7 2003/06/12 21:38:29 dkernen -# -# Preparing 2.2.8 -# Added Files: COPYRIGHT -# Modified Files: Parse.grammar -# Added Files: Makefile.old -# Makefile.PL Todo sample.perldb -# BodyStructure.pm -# Parse.grammar Parse.pod -# range.t -# Thread.grammar -# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt -# rfc2221.txt rfc2359.txt rfc2683.txt -# -# Revision 19991216.6 2000/12/11 21:58:50 dkernen -# -# Modified Files: -# build_dist.pl build_ldif.pl copy_folder.pl find_dup_msgs.pl -# imap_to_mbox.pl populate_mailbox.pl -# to add CVS data -# -# Revision 19991216.5 1999/12/16 17:19:09 dkernen -# Bring up to same level -# -# Revision 19991124.3 1999/12/16 17:14:22 dkernen -# Incorporate changes for exists method performance enhancement -# -# Revision 19991124.02 1999/11/24 17:46:16 dkernen -# More fixes to t/basic.t -# -# Revision 19991124.01 1999/11/24 16:51:46 dkernen -# Changed t/basic.t to test for UIDPLUS before trying UID cmds -# -# Revision 1.8 1999/11/23 17:51:05 dkernen -# Committing version 1.06 distribution copy -# diff --git a/Mail-IMAPClient-3.21/examples/build_ldif.pl b/Mail-IMAPClient-3.21/examples/build_ldif.pl deleted file mode 100644 index aea17ec..0000000 --- a/Mail-IMAPClient-3.21/examples/build_ldif.pl +++ /dev/null @@ -1,235 +0,0 @@ -#!/usr/local/bin/perl -#$Id: //depot/main/ZimbraPS/Mail-IMAPClient/examples/build_ldif.pl#1 $ -use Mail::IMAPClient; -use MIME::Lite; -use Data::Dumper; - -=head1 DESCRIPTION - -B accepts the name of a target folder as an argument. It -then opens that folder and rummages through all the mail files in it, looking -for "Reply-to:" headers (or "From:" headers, where there is no "Reply-to:"). -It then prints to STDOUT a file in ldif format containing entries for all of -the addresses that it finds. It also appends a message into the specified folder containing -all of the addresses in both the B field of the message header and in an -LDIF-format attachment. - -B requires B. - -=head1 SYNTAX - -B I<-h> - -B I<-s servername -u username -p password -f folder [ -d ]> - -=over 4 - -=item -f The folder name to process. - -=item -s The servername of the IMAP server - -=item -t Include "To" and "Cc" fields as well as "From" - -=item -u The user to log in as - -=item -p The password for the user specified in the I<-u> option - -=item -d Tells the IMAP client to turn on debugging info - -=item -n Suppress delivering message to folder - -=item -h Prints out this document - -=back - -B You can supply defaults for the above options by updating the script. - -=cut - -use Getopt::Std; - -getopts('hs:u:p:f:dtn'); - -# Update the following to supply defaults: - -$opt_f ||= "default folder"; -$opt_s ||= "default server"; -$opt_u ||= "default user"; -$opt_p ||= "default password"; # security risk: use with caution! - -# Let the compiler know we're serious about these variables: -$opt_0 = ( $opt_h or $opt_d or $opt_t or $opt_n or $opt_0); - -exec "perldoc $0" if $opt_h; - -my $imap = Mail::IMAPClient->new( - Server => $opt_s , - User => $opt_u , - Password=> $opt_p , - Debug => $opt_d||0 , -) or die "can't connect to server\n"; - -$imap->select($opt_f); $imap->expunge; - -my @msgs = $imap->search("NOT SUBJECT",qq("buid_ldif.pl $opt_f Output")); -my %list; -foreach my $m (@msgs) { - - my $ref = $imap->parse_headers($m,"Reply-to","From"); - - warn "Couldn't get recipient address from msg#$m\n" - unless scalar(@{$ref->{'Reply-to'}}) || - scalar(@{$ref->{'From'}}) ; - - my $from = scalar(@{$ref->{'Reply-to'}}) ? - $ref->{'Reply-to'}[0] : - $ref->{'From'}[0] ; - my $name = $from ; - - $name =~ s/<.*// ; - if ($name =~ /\@/) { - $name = $from ; - $name =~ s/\@.*//; ; - } - $name =~ s/\"//g ; - $name =~ s/^\s+|\s+$//g ; - my $addr = $from ; - $addr =~ s/.*]//g ; - $list{lc($addr)} = [ $addr, $name ] - unless exists $list{lc($addr)} ; - if ($opt_t) { # Do "To" and "Cc", too - my $ref = $imap->parse_headers($m,"To","Cc") ; - my @array = ( @{$ref->{To}} , @{$ref->{Cc}} ) ; - my @members = () ; - foreach my $text (@array) { - while ( $text =~ / "([^"\\]*(\\.[^"\\]*)*"[^,]*),? | - ([^",]+),? | - , - /gx - ) { - push @members, defined($1)?$1:$3 ; - } - } - foreach my $to (@members) { - - my $name = $to ; - - $name =~ s/<.*// ; - if ($name =~ /\@/) { - $name = $to ; - $name =~ s/\@.*//; ; - } - $name =~ s/\"//g ; - $name =~ s/^\s+|\s+$//g ; - my $addr = $to ; - $addr =~ s/.*]//g ; - $list{lc($addr)} = [ $addr, $name ] - unless exists $list{lc($addr)} ; - } - - } -} - -my $text = join "",map { - qq{dn: cn="} . $list{$_}[1] . - qq{", mail=$list{$_}[0]\n} . - qq{cn: } . $list{$_}[1] . qq{\n} . - qq{mail: $list{$_}[0]\n} . - qq{objectclass: top\nobjectclass: person\n\n}; -} keys %list ; - -# Create a new multipart message: -my $msg = MIME::Lite->new( - From => $opt_u, - map({ ("To" => $list{$_}[0]) } keys %list), - Subject => "LDIF file from $opt_f", - Type =>'TEXT', - Data =>"Attached is the LDIF file of addresses from folder $opt_f." -); -$msg->attach( Type =>'text/ldif', - Filename => "$opt_f.ldif", - Data => $text , -); -print $text; -$imap->append($opt_f, $msg->as_string) unless $opt_n; -print Dumper($imap) if $opt_d; -$imap->logout; - - -=head1 AUTHOR - -David J. Kernen - -The Kernen Group, Inc. - -imap@kernengroup.com - -=head1 COPYRIGHT - -This example and Mail::IMAPClient are Copyright (c) 1999,2003 -by The Kernen Group, Inc. All rights reserved. - -This example is distributed with Mail::IMAPClient and -subject to the same licensing requirements as Mail::IMAPClient. - -imtest is a utility distributed with Cyrus IMAP server, -Copyright (c) 1994-2000 Carnegie Mellon University. -All rights reserved. - -=cut - -# $Id: //depot/main/ZimbraPS/Mail-IMAPClient/examples/build_ldif.pl#1 $ -# $Log: build_ldif.pl,v $ -# Revision 19991216.11 2003/06/12 21:38:30 dkernen -# -# Preparing 2.2.8 -# Added Files: COPYRIGHT -# Modified Files: Parse.grammar -# Added Files: Makefile.old -# Makefile.PL Todo sample.perldb -# BodyStructure.pm -# Parse.grammar Parse.pod -# range.t -# Thread.grammar -# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt -# rfc2221.txt rfc2359.txt rfc2683.txt -# -# Revision 19991216.10 2002/05/24 15:47:18 dkernen -# Misc fixes -# -# Revision 19991216.9 2000/12/11 21:58:51 dkernen -# -# Modified Files: -# build_dist.pl build_ldif.pl copy_folder.pl find_dup_msgs.pl -# imap_to_mbox.pl populate_mailbox.pl -# to add CVS data -# -# Revision 19991216.8 2000/03/02 19:57:13 dkernen -# -# Modified Files: build_ldif.pl -- to support new option to all "To:" and "Cc:" to be included in ldif file -# -# Revision 19991216.7 2000/02/21 16:16:10 dkernen -# -# Modified Files: build_ldif.pl -- to allow for "To:" and "Cc:" header handling and -# to handle quoted names in headers -# -# Revision 19991216.6 1999/12/28 13:56:59 dkernen -# Fixed -h option (help). -# -# Revision 19991216.5 1999/12/16 17:19:10 dkernen -# Bring up to same level -# -# Revision 19991124.3 1999/12/16 17:14:24 dkernen -# Incorporate changes for exists method performance enhancement -# -# Revision 19991124.02 1999/11/24 17:46:18 dkernen -# More fixes to t/basic.t -# -# Revision 19991124.01 1999/11/24 16:51:48 dkernen -# Changed t/basic.t to test for UIDPLUS before trying UID cmds -# -# Revision 1.8 1999/11/23 17:51:05 dkernen -# Committing version 1.06 distribution copy -# diff --git a/Mail-IMAPClient-3.21/examples/cleanTest.pl b/Mail-IMAPClient-3.21/examples/cleanTest.pl deleted file mode 100644 index a60f780..0000000 --- a/Mail-IMAPClient-3.21/examples/cleanTest.pl +++ /dev/null @@ -1,64 +0,0 @@ -#!/usr/local/bin/perl - -use Mail::IMAPClient; -use IO::File; -# -# Example that will also clean out your test account if interrupted 'make test' -# runs have left junk folders there. Run from installation dir, installation/examples -# subdir, or supply full path to the test.txt file (created during 'perl Makefile.PL' -# and left in the installation dir until 'make clean'). -# If you 've already run 'make clean' or said no to extended tests, -# then you don't have the file anyway; re-run 'perl Makefile.PL', reply 'y' to the -# extended tests prompt, then supply the test account's credentials as prompted. -# Then try this again. -# -if ( -f "./test.txt" ) { - $configFile = "./test.txt" -} elsif ( -f "../test.txt" ) { - $configFile = "../test.txt" -} elsif ( $ARGV[0] and -f "$ARGV[0]" ) { - $configFile = $ARGV[0]; -} else { - print STDERR "Can't find test.txt. Please run this from the installation directory ", - "or supply the full path to test.txt as an argument on the command line.\n"; -} -my $fh = IO::File->new("./test.txt") or die "./test.txt: $!\n"; -while (my $input = <$fh>) { - chomp $input; - my($k,$v) = split(/=/,$input,2); - $conf{$k}=$v; -} -my $imap = Mail::IMAPClient->new(Server=>$conf{server},User=>$conf{user}, - Password=>$conf{passed}) or die "Connecting to $conf{server}: $! $@\n"; - -for my $f ( grep(/^IMAPClient_/,$imap->folders) ) { - print "Deleting $f\n"; - $imap->select($f); - $imap->delete_messages(@{$imap->messages}) ; - $imap->close($f); - $imap->delete($f); -} - - -=head1 AUTHOR - -David J. Kernen - -The Kernen Group, Inc. - -imap@kernengroup.com - -=head1 COPYRIGHT - -This example and Mail::IMAPClient are Copyright (c) 2003 -by The Kernen Group, Inc. All rights reserved. - -This example is distributed with Mail::IMAPClient and -subject to the same licensing requirements as Mail::IMAPClient. - -imtest is a utility distributed with Cyrus IMAP server, -Copyright (c) 1994-2000 Carnegie Mellon University. -All rights reserved. - -=cut - diff --git a/Mail-IMAPClient-3.21/examples/copy_folder.pl b/Mail-IMAPClient-3.21/examples/copy_folder.pl deleted file mode 100644 index bfa9d2a..0000000 --- a/Mail-IMAPClient-3.21/examples/copy_folder.pl +++ /dev/null @@ -1,147 +0,0 @@ -#!/usr/local/bin/perl -#$Id: //depot/main/ZimbraPS/Mail-IMAPClient/examples/copy_folder.pl#1 $ -++$|; -use Getopt::Std; -use Mail::IMAPClient; -use vars qw/$opt_r $opt_h $opt_t $opt_f/; - -getopts("t:f:F:N:rh"); -if ( $opt_h ) { - print &usage; - exit; -} - -my($to_id,$to_pass,$thost) = $opt_t =~ m{ - ([^/]+) # everything up to / is the id - / # then a slash - ([^@]+) # then everything up to @ is pswd - @ # then an @-sign - (.*) # then everything else is the host - }x ; -my($from_id,$from_pass,$fhost) = - $opt_f =~ m{ - ([^/]+) # everything up to / is the id - / # then a slash - ([^@]+) # then everything up to @ is pswd - @ # then an @-sign - (.*) # then everything else is the host - }x ; -$to_id and $from_id and $to_pass and $from_pass and $thost and $fhost - or die "Error: Must specify -t and -f (to and from)\n" . &usage; -$opt_F or - die "Error: Must specify '-F folder' or how will I know what folder to copy?\n" . - &usage ; - -$opt_N ||= $opt_F; - - -print "Copying folder $opt_F from $from_id\@$fhost to ${to_id}'s $opt_N folder on $thost.\n"; - -my ($from) = Mail::IMAPClient->new( Server => $fhost, - User => $from_id, - Password=> $from_pass, - Fast_IO => 1, - Uid => 1, - Debug => 0, -); - - -my ($to) = Mail::IMAPClient->new( Server => $thost, - User => $to_id, - Password=> $to_pass, - Fast_IO => 1, - Uid => 1, - Debug => 0, -); - -my @folders = $opt_r ? @{$from->folders($opt_F)} : ( $opt_F ) ; - -foreach my $fold (@folders) { - print "Processing folder $fold\n"; - $from->select($fold); - if ($opt_F ne $opt_N) { - $fold =~s/^$opt_F/$opt_N/o; - } - unless ($to->exists($fold)) { - $to->create($fold) or warn "Couldn't create $fold\n" and next; - } - $to->select($fold); - my @msgs = $from->search("ALL"); - # my %flaghash = $from->flags(\@msgs); - foreach $msg (@msgs) { - print "Processing message $msg in folder $fold.\n"; - my $string = $from->message_string($msg); - # print "String = $string\n"; - my $new_id = $to->append($fold,$string) - or warn "Couldn't append msg #$msg to target folder $fold.\n"; - - $to->store($new_id,"+FLAGS (" . join(" ",@{$from->flags($msg)}) . ")"); - } -} - -sub usage { - return "Syntax:\n\t$0 -t to_id/to_pass\@to.host -f from_id/from_pass\@from.host \\\n" . - "\t\t-F folder [-N New_Folder] [-r]\n". - "\tor\n\t$0 -h\n\n". - "\twhere:\n\t\t". - "to_id\t\tis the id to recieve the folder\n\t\t". - "to_pass\t\tis the password for to_id\n\t\t". - "from\t\tis the uid who currently has the folder\n\t\t". - "from_pass\tis the password for from_id\n\t\t". - "to.host\t\tis the optional host where the 'to' uid has a mailbox\n\t\t". - "from.host\tis the optional host where the 'from' uid has a mailbox\n\t\t". - "folder\t\tis the folder to copy from\n\t\t". - "New_Folder\tis the folder to copy to (defaults to 'folder')\n\t\t". - "-h\t\tprints this help message\n\t\t". - "-r\t\tspecifies a recursive copy (only works on systems that support the idea " . - "\n\t\t\t\tof recursive folders)\n\t\t". - "\n" - ; -} - - -=head1 AUTHOR - -David J. Kernen - -The Kernen Group, Inc. - -imap@kernengroup.com - -=head1 COPYRIGHT - -This example and Mail::IMAPClient are Copyright (c) 1999,2000,2003 -by The Kernen Group, Inc. All rights reserved. - -This example is distributed with Mail::IMAPClient and -subject to the same licensing requirements as Mail::IMAPClient. - -imtest is a utility distributed with Cyrus IMAP server, -Copyright (c) 1994-2000 Carnegie Mellon University. -All rights reserved. - -=cut - -# History: -# $Log: copy_folder.pl,v $ -# Revision 19991216.3 2003/06/12 21:38:30 dkernen -# -# Preparing 2.2.8 -# Added Files: COPYRIGHT -# Modified Files: Parse.grammar -# Added Files: Makefile.old -# Makefile.PL Todo sample.perldb -# BodyStructure.pm -# Parse.grammar Parse.pod -# range.t -# Thread.grammar -# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt -# rfc2221.txt rfc2359.txt rfc2683.txt -# -# Revision 19991216.2 2000/12/11 21:58:51 dkernen -# -# Modified Files: -# build_dist.pl build_ldif.pl copy_folder.pl find_dup_msgs.pl -# imap_to_mbox.pl populate_mailbox.pl -# to add CVS data -# diff --git a/Mail-IMAPClient-3.21/examples/cyrus_expire.pl b/Mail-IMAPClient-3.21/examples/cyrus_expire.pl deleted file mode 100644 index 52a97d7..0000000 --- a/Mail-IMAPClient-3.21/examples/cyrus_expire.pl +++ /dev/null @@ -1,111 +0,0 @@ -#!/usr/local/bin/perl -#$Id - -use Mail::IMAPClient; # available from http://search.cpan.org/search?mode=module&query=IMAPClient -use IO::File; -use Getopt::Std; -use vars qw/ $opt_d $opt_s $opt_p $opt_u $opt_P $opt_h /; - -&getopts('d:s:u:p:P:h'); # -d days_to_keep -u cyrys_user -p cyrus_pswd -s cyrus_server -P port - -my $days_to_keep = $opt_d||365; # Delete msgs older than -d arg or 365 days -my $cutoff = time - ( $days_to_keep * 24 * 60 * 60 ) ; # time - arg * 24 * 60 * 60 = cutoff date in seconds - -# Change the following line (or replace it with something better): -$opt_h and die help()."\n"; -my $h = $opt_s || "localhost" ; -my $u = $opt_u || "cyrys" ; -my $p = $opt_p or die "Unable to continue. No password provided.\n" . help(); - -my $imap = Mail::IMAPClient->new( - Server => "$h", - User => "$u", # $u, - Password=> "$p", # $p, - Uid => 1, # True value - Port => $opt_P||143, # imapd - Debug => 0, # Make true to debug - Buffer => 4096*10, # True value; decrease on machines w/little memory - Fast_io => 1, # True value - Timeout => 30, # True value - # Debug_fh=> IO::File->new(">out.db"), # fhandle - ) -or die "$@"; - my $mcnt = my $fcnt = 0; -print "Deleting messages older than ",$imap->Rfc2060_date($cutoff),"\n"; -for my $f ( $imap->folders ) { - print "Expiring $f\n"; - unless ($imap->select($f) ) { - $imap->setacl($f,$u,"lrswipcda") or warn "Cannot setacl for $f: $@\n" and next; - $imap->select($f) or warn "Cannot select $f: $@" and next; - } - my @expired = $imap->search("SENTBEFORE",$imap->Rfc2060_date($cutoff)); - next unless @expired; - $mcnt += scalar(@expired); $fcnt ++; - print "Deleting ",scalar(@expired)," messages from $f\n"; - $imap->delete_message(@expired); - $imap->expunge; - $imap->close; -} - $imap->logout; - print "Deleted a total of $mcnt messages in $fcnt folders.\n"; -exit; - - -sub help { - return <<"EOHELP"; - -Usage: - - $0 [ -d days_to_keep ] [ -s mail_server ] [ -u cyrus_admin_id ] -p cyrus_password - $0 -h - - -h -- prints this here help message - -d days_to_keep -- $0 will delete messages older than "days_to_keep". (Default is 365) - -s mail_server -- hostname or IP Address of IMAP mail server (defaults to "localhost") - -u cyrus_admin_id -- user name of Unix account that owns Cyrus server (defaults to "cyrus") - -p cyrus_password -- password for the "cyrus_admin_id" user account (no default) - -P cyrus_port -- port where the cyrus imapd daemon is listening (defaults to value from - /etc/services or '143') - -EOHELP - -} - - -=head1 AUTHOR - -David J. Kernen - -The Kernen Group, Inc. - -imap@kernengroup.com - -=head1 COPYRIGHT - -This example and Mail::IMAPClient are Copyright (c) 2003 -by The Kernen Group, Inc. All rights reserved. - -This example is distributed with Mail::IMAPClient and -subject to the same licensing requirements as Mail::IMAPClient. - -imtest is a utility distributed with Cyrus IMAP server, -Copyright (c) 1994-2000 Carnegie Mellon University. -All rights reserved. - -=cut - -#$Log: cyrus_expire.pl,v $ -#Revision 19991216.2 2003/06/12 21:38:31 dkernen -# -#Preparing 2.2.8 -#Added Files: COPYRIGHT -#Modified Files: Parse.grammar -#Added Files: Makefile.old -# Makefile.PL Todo sample.perldb -# BodyStructure.pm -# Parse.grammar Parse.pod -# range.t -# Thread.grammar -# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt -# rfc2221.txt rfc2359.txt rfc2683.txt -# diff --git a/Mail-IMAPClient-3.21/examples/cyrus_expunge.pl b/Mail-IMAPClient-3.21/examples/cyrus_expunge.pl deleted file mode 100644 index 0016258..0000000 --- a/Mail-IMAPClient-3.21/examples/cyrus_expunge.pl +++ /dev/null @@ -1,85 +0,0 @@ -#!/usr/local/bin/perl -#$Id: //depot/main/ZimbraPS/Mail-IMAPClient/examples/cyrus_expunge.pl#1 $ - -use Mail::IMAPClient; -use IO::File; - -# Change the following line (or replace it with something better): -my($h,$u,$p) = ('cyrus_host','cyrus_admin_id','cyrus_admin_pswd'); - -my $imap = Mail::IMAPClient->new( Server => "$h", # imap host - User => "$u", # $u, - Password=> "$p", # $p, - Uid => 1, # True value - Port => 143, # Cyrus - Debug => 0, # True value - Buffer => 4096*10, # True value - Fast_io => 1, # True value - Timeout => 30, # True value - # Debug_fh=> IO::File->new(">out.db"), # fhandle - ) -or die "$@"; - -for my $f ( $imap->folders ) { - print "Expunging $f\n"; - unless ($imap->select($f) ) { - $imap->setacl($f,$u,"lrswipcda") or warn "Cannot setacl for $f: $@\n" and next; - $imap->select($f) or warn "Cannot select $f: $@" and next; - } - $imap->expunge; -} - - -=head1 AUTHOR - -David J. Kernen - -The Kernen Group, Inc. - -imap@kernengroup.com - -=head1 COPYRIGHT - -This example and Mail::IMAPClient are Copyright (c) 2003 -by The Kernen Group, Inc. All rights reserved. - -This example is distributed with Mail::IMAPClient and -subject to the same licensing requirements as Mail::IMAPClient. - -imtest is a utility distributed with Cyrus IMAP server, -Copyright (c) 1994-2000 Carnegie Mellon University. -All rights reserved. - -=cut - -# -#$Log: cyrus_expunge.pl,v $ -#Revision 19991216.3 2003/06/12 21:38:31 dkernen -# -#Preparing 2.2.8 -#Added Files: COPYRIGHT -#Modified Files: Parse.grammar -#Added Files: Makefile.old -# Makefile.PL Todo sample.perldb -# BodyStructure.pm -# Parse.grammar Parse.pod -# range.t -# Thread.grammar -# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt -# rfc2221.txt rfc2359.txt rfc2683.txt -# -#Revision 1.1 2003/06/12 21:38:14 dkernen -# -#Preparing 2.2.8 -#Added Files: COPYRIGHT -#Modified Files: Parse.grammar -#Added Files: Makefile.old -# Makefile.PL Todo sample.perldb -# BodyStructure.pm -# Parse.grammar Parse.pod -# range.t -# Thread.grammar -# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt -# rfc2221.txt rfc2359.txt rfc2683.txt -# -# diff --git a/Mail-IMAPClient-3.21/examples/find_dup_msgs.pl b/Mail-IMAPClient-3.21/examples/find_dup_msgs.pl deleted file mode 100644 index 1e4d8ea..0000000 --- a/Mail-IMAPClient-3.21/examples/find_dup_msgs.pl +++ /dev/null @@ -1,217 +0,0 @@ -#!/usr/local/bin/perl -# $Id: //depot/main/ZimbraPS/Mail-IMAPClient/examples/find_dup_msgs.pl#1 $ - -use Mail::IMAPClient; -use Mozilla::LDAP::Conn; -use Getopt::Std; -use vars qw/$rootdn $opt_a/; -use Data::Dumper; - -# It then connects to a user's mailhost and rummages around, -# looking for duplicate messages. -# It will optionally delete messages that are duplicates (based on -# msg-id header and number of bytes). -# For help, enter: -# find_dup_msgs.pl -h -# - -getopts('ahdtvf:F:u:s:p:P:'); - -if ( $opt_h ) { - print STDERR &usage; - exit; -} - -my $uid = $opt_u or die &usage; -$opt_s||='localhost'; -$opt_p or die &usage; -$opt_P||=143; - -$opt_t and - $opt_d and - die "ERROR: Don't specify -d and -t together.\n" . &usage; - - -my($pu,$pp) = get_admin(); - -print "Connecting to $host:$opt_P\n" if $opt_v; -my $imap = Imap->new( Server => $opt_s, - User => $opt_u, - Password=> $opt_p, - Port => $opt_P, - Fast_io => 1, -) or die "couldn't connect to $host port $opt_P: $!\n"; - -my %folders; my %counts; - -FOLDER: foreach my $f ( $opt_F ? $opt_F : $imap->folders ) { - next if $opt_t and $f eq 'Trash'; - $folders{$f} = 0; - $counts{$f} = $imap->message_count($f); - print "Processing folder $f\n" if $opt_v; - unless ( $imap->select($f)) { - warn "Error selecting $f: " . $imap->LastError . "\n"; - next FOLDER; - } - my @msgs = $imap->search("ALL"); - my %hash = (); - MESSAGE: foreach my $m (@msgs) { - my $mid; - if ($opt_a) { - my $h = $imap->parse_headers( - $m,"Date","Subject","From","Message-ID" - ) or next MESSAGE; - $mid = "$h->{'Date'}[0]$;$h->{'Subject'}[0]$;". - "$h->{'From'}[0]$;$h->{'Message-ID'}[0]"; - - } else { - $mid = $imap->parse_headers( - $m, - "Message-ID" - )->{'Message-ID'}[0] - or next MESSAGE; - } - my $size = $imap->size($m); - if ( exists $hash{$mid} and $hash{$mid} == $size ) { - if ($opt_f) { - open F,">>$opt_f" or - die "can't open $opt_f: $!\n"; - print F $imap->message_string($m), - "___END OF SAVED MESSAGE___","\n"; - close F; - } - $imap->move("Trash",$m) if $opt_t; - $imap->delete_message($m) if $opt_d; - $folders{$f}++; - print "Found a duplicate in ${f}; key = $mid\n" if $opt_v; - - } else { - - $hash{$mid} = $size; - } - } - print "$f hash:\n",Data::Dumper::Dumper(\%hash) if $opt_v; - $imap->expunge if ($opt_t or $opt_d); -} - -my $total; my $totms; -map { $total += $_} values %folders; -map { $totms += $_ } values %counts; -print "Found $total duplicate messages in ${uid}'s mailbox. ", - "The breakdown is:\n", - "\tFolder\tNumber of Duplicates\tNumber of Msgs in Folder\n", - "\t------\t--------------------\t------------------------\n", - map { "\t$_\t$folders{$_}\t$counts{$_}\n" } keys %folders, - "\tTOTAL\t$total\t$totms\n" -; - - -sub usage { - return "Usage:\n" . - "\t$0 [-d|-t] [-v] [-f filename] [-a] [-P port] \\\n". - "\t\t-s server -u user -p password\n\n" . - "\t-a\t\tdo an especially aggressive search for duplicates\n". - "\t-d\t\tdelete duplicates (default is to just report them)\n". - "\t-f file\t\tsave deleted messages in file named 'file'\n" . - "\t-F fldr\t\tOnly check the folder named 'fldr' (default is to check all folders)\n" . - "\t-h\t\tprint this help message (all other options are ignored)\n" . - "\t-p password\tspecify the target user's password\n" . - "\t-P port\t\tspecify the port to connect to (default is 143)\n" . - "\t-s server\tspecify the target mail server\n" . - "\t-u uid\t\tspecify the target user\n" . - "\t-t\t\tmove deleted messages to trash folder\n" . - "\t-v\t\tprint verbose status messages while processing\n". - "\n" ; -} - - -=head1 AUTHOR - -David J. Kernen - -The Kernen Group, Inc. - -imap@kernengroup.com - -=head1 COPYRIGHT - -This example and Mail::IMAPClient are Copyright (c) 2003 -by The Kernen Group, Inc. All rights reserved. - -This example is distributed with Mail::IMAPClient and -subject to the same licensing requirements as Mail::IMAPClient. - -imtest is a utility distributed with Cyrus IMAP server, -Copyright (c) 1994-2000 Carnegie Mellon University. -All rights reserved. - -=cut - -# History: -# $Log: find_dup_msgs.pl,v $ -# Revision 19991216.5 2003/06/12 21:38:32 dkernen -# -# Preparing 2.2.8 -# Added Files: COPYRIGHT -# Modified Files: Parse.grammar -# Added Files: Makefile.old -# Makefile.PL Todo sample.perldb -# BodyStructure.pm -# Parse.grammar Parse.pod -# range.t -# Thread.grammar -# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt -# rfc2221.txt rfc2359.txt rfc2683.txt -# -# Revision 1.1 2003/06/12 21:38:14 dkernen -# -# Preparing 2.2.8 -# Added Files: COPYRIGHT -# Modified Files: Parse.grammar -# Added Files: Makefile.old -# Makefile.PL Todo sample.perldb -# BodyStructure.pm -# Parse.grammar Parse.pod -# range.t -# Thread.grammar -# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt -# rfc2221.txt rfc2359.txt rfc2683.txt -# -# Revision 19991216.4 2002/08/23 14:34:51 dkernen -# -# Modified Files: Changes IMAPClient.pm Makefile Makefile.PL test.txt for version 2.2.0 -# Added Files: Makefile Makefile.PL Parse.grammar Parse.pm Parse.pod version 2.2.0 -# Added Files: parse.t for version 2.2.0 -# Added Files: bodystructure.t for 2.2.0 -# Modified Files: find_dup_msgs.pl for v2.2.0 -# -# Revision 1.6 2001/03/08 19:00:35 dkernen -# -# ---------------------------------------------------------------------- -# Modified Files: -# copy_folder.pl delete_mailbox.pl find_dup_msgs.pl -# mbox_check.pl process_orphans.pl rename_id.pl -# scratch_indexes.pl -# to get ready for nsusmsg02 upgrade -# ---------------------------------------------------------------------- -# -# Revision 1.5 2000/11/01 15:51:58 dkernen -# -# Modified Files: copy_folder.pl find_dup_msgs.pl restore_mbox.pl -# -# Revision 1.4 2000/04/13 21:17:18 dkernen -# -# Modified Files: find_dup_msgs.pl - to add -a switch (for aggressive dup search) -# Added Files: copy_folder.pl - a utility for copying a folder from one user's -# mailbox to another's -# -# Revision 1.3 2000/03/14 16:40:21 dkernen -# -# Modified Files: find_dup_msgs.pl -- to skip msgs with no message-id -# -# Revision 1.2 2000/03/13 19:05:50 dkernen -# -# Modified Files: -# delete_mailbox.pl find_dup_msgs.pl restore_mbox.pl -- to add cvs comments -# find_dup_msgs.pl -- to fix bug that occurred when -t (move-to-trash) switch is used -# diff --git a/Mail-IMAPClient-3.21/examples/imap_to_mbox.pl b/Mail-IMAPClient-3.21/examples/imap_to_mbox.pl deleted file mode 100644 index a617698..0000000 --- a/Mail-IMAPClient-3.21/examples/imap_to_mbox.pl +++ /dev/null @@ -1,266 +0,0 @@ -#!/usr/local/bin/perl -# (c) 1999 Thomas Stromberg, Research Triangle Commerce, Inc. -# This software is protected by the BSD License. No rights reserved anyhow. -# - -# DESC: Reads a users IMAP folders, and converts them to mbox -# Good for an interim switch-over from say, Exchange to Cyrus IMAP. - -# $Header: //depot/main/ZimbraPS/Mail-IMAPClient/examples/imap_to_mbox.pl#1 $ - -# History: -# -------- -# 2008/08/07 - Added SSL support, fixed From header printing, and CR -# elimination (sobek) - -# TODO: -# ----- -# lsub instead of list option - -use warnings; -use strict; - -use Mail::IMAPClient; # a nice set of perl libs for imap -use IO::Socket::SSL; # for SSL support - -use vars qw($opt_h $opt_u $opt_p $opt_P $opt_s $opt_i $opt_f $opt_m $opt_b - $opt_c $opt_r $opt_w $opt_W $opt_S $opt_D $opt_U $opt_d $opt_I - $opt_n); - -use Getopt::Std; # for the command-line overrides. good for user -use File::Path; # create full file paths. (yummy!) -use File::Basename; # find a nice basename for a folder. -use Date::Manip; # to create From header date -$| = 1; - -sub connect_imap(); -sub find_folders(); -sub write_folder($$$$); -sub help(); - -# Config for the imap migration kit. - -getopts('u:p:P:s:i:f:m:b:c:r:w:W:SDUdhIn:') or - $opt_h = 1; - -my $SSL = $opt_S || 0; -my $SERVER = $opt_s || 'machine'; -my $USER = $opt_u || 'userid'; -my $PASSWORD = $opt_p || 'password'; -my $PORT = $opt_P || '143'; -my $INBOX_PATH = $opt_i || "/var/mail/$USER"; -my $DOINBOX = $opt_I ? 0 : 1 || 1; -my $FOLDERS_PATH = $opt_f || "./folders/$USER"; -my $DONT_MOVE = $opt_m || '.mailboxlist|Trash|INBOXIIMAP|mlbxl'; -my $READ_DELIMITER = $opt_r || '/'; -my $WRITE_DELIMITER = $opt_w || '/'; -my $WRITE_MODE = $opt_W || '>'; -my $BANNED_CHARS = $opt_b || '.|^|%'; -my $CR = $opt_c || "\r"; -my $NUMBER = $opt_n || ""; -my $DELETE = $opt_D || 0; -my $DEBUG = $opt_d || "0"; -my $UNSEEN = $opt_U || 0; -my $FAIL = 0; - -my $imap; # definition for IMAP structure - -if ($opt_h) { - # print help here - help(); -} - -sub help() { - print "imap_to_mbox.pl - with the following optional arguments\: - -S Use an SSL connection (default $SSL) - -s Server specification (default $SERVER) - -u User login (default $USER) - -p

User password - -P

Server Port (default $PORT) - -i INBOX save path (default $INBOX_PATH) - -I skip INBOX (default $DOINBOX) - -f Save path for other folders (default $FOLDERS_PATH) - -m Regexp for IMAP folders not to be saved: - $DONT_MOVE - -r Read delimiter (default \"$READ_DELIMITER\") - -w Write Delimiter (default \"$WRITE_DELIMITER\") - -b Banned chars (default \"$BANNED_CHARS\") - -c Strip CRs from saved files [for Unix] (default \"$CR\") - -n Receive only messages (Default ".($NUMBER ? "$NUMBER" : "all").") - -U Unseen messages Only - -D Delete downloaded files on server - -d Debug mode (default $DEBUG)\n"; - exit 1; -} - -## do our magic tricks ###################################### -connect_imap(); -find_folders(); - - -sub connect_imap() -{ -# Open an SSL session to the IMAP server -# Handles the SSL setup, and gives us back a socket - my $ssl; - if ($opt_S) { - $ssl=IO::Socket::SSL->new( - PeerHost => "$SERVER:imaps" -# , SSL_version => 'SSLv2' # for older versions of openssl - ); - - defined $ssl - or die "Error connecting to $SERVER:imaps - $@"; - - $ssl->autoflush(1); - } - - $imap = Mail::IMAPClient->new( - Socket => ($opt_S ? $ssl : 0), - Server => $SERVER, - User => $USER, - Password => $PASSWORD, - Port => $PORT, - Debug => $DEBUG, - Uid => 0, - Clear => 1, - ) - or die ("Could not connect to $SERVER:$PORT with $USER: $! $?\n"); -} - -sub find_folders() -{ - my @folders = $imap->folders; -# push(@folders, "INBOX"); - - foreach my $folder (@folders) { - my $message_count; - - if ($folder eq "INBOX" and $DOINBOX == 0) { - print "* $folder is unwanted, skipping.\n"; - next; - } - if (!$UNSEEN) { - $message_count = $imap->message_count($folder); - } else { - $message_count = $imap->unseen_count($folder) || 0; - } - if(! $message_count) { - print "* $folder is empty, skipping.\n"; - next; - } - if($folder =~ /$DONT_MOVE/) { - warn "! $folder matches DONT_MOVE ruleset, skipping\n"; - next; - } - - my $new_folder = $folder; - $new_folder =~ s/\./_/g; - $new_folder =~ s/\Q$READ_DELIMITER/$WRITE_DELIMITER/g; - my $path - = $new_folder eq "INBOX" ? "$INBOX_PATH" - : "$FOLDERS_PATH/$new_folder"; - - if ($NUMBER && $NUMBER < $message_count) { - printf "x %4i %-45.45s => %s", $NUMBER, $folder, $path; - write_folder $folder, $path, 1, $NUMBER; - } else { - printf "x %4i %-45.45s => %s", $message_count, $folder, $path; - write_folder $folder, $path, 1, $message_count; - } - } -} - -sub write_folder($$$$) -{ my($folder, $newpath, $first_message, $last_message) = @_; - - $imap->select($folder) - or warn "Could not examine $folder: $!"; - - my $new_dir = dirname $newpath; - my $new_file = basename $newpath; - - -d $new_dir - or mkpath($new_dir, 0700) - or die "Cannot create $new_dir:$!\n"; - - open my $mbox, $WRITE_MODE, $newpath - or die "Cannot create file $newpath: $!\n"; - - my @msgs = $imap->unseen if $UNSEEN; - - for (my $i=$first_message; $i<$last_message+1; ++$i) - { my $m = ($UNSEEN ? shift @msgs : $i); - my $date = UnixDate(ParseDate($imap->internaldate($m)), - "%a %b %e %T %Y"); - my $user = $imap->get_envelope($m)->from_addresses; - $user =~ s/^.*<([^>]*)>/$1/; - $user = '-' unless $user; - print '.' if $m%25 == 0; - - my $msg_header = $imap->fetch($m, "FAST") - or warn "Could not fetch header $m from $folder\n"; - - my $msg_rfc822 = $imap->fetch($m, "RFC822"); - unless($msg_rfc822) - { warn "Could not fetch RFC822 $m from $folder\n"; - $FAIL=1 - } - - undef my $start; - foreach (@$msg_rfc822) - { my $message; - if($_ =~ /\: / && !$message) - { ++$message; - print $mbox "From $user $date\n"; - } - - if(/^\)\r/) - { undef $message; - print $mbox "\n\n"; - } - next unless $message; - $_ =~ s/\r$//; - $_ = $imap->Strip_cr($_) if $CR; - print $mbox "$_"; - - } - if($DELETE && ! $FAIL) - { $imap->delete_message($m) - or warn "Could not delete_message: $@\n"; - $FAIL = 0; - } - } - - close $mbox - or die "Write errors to $newpath: $!\n"; - - if($DELETE) - { $imap->expunge($folder) - or warn "Could not expunge: $@\n"; - } - - print "\n"; -} - -# 2008/08/07 - Added SSL support, fixed From header printing, and CR -# elimination (sobek) -# -# Revision 19991216.7 2002/08/23 13:29:48 dkernen -# -# Revision 19991216.6 2000/12/11 21:58:52 dkernen -# -# Revision 19991216.5 1999/12/16 17:19:12 dkernen -# Bring up to same level -# -# Revision 19991124.3 1999/12/16 17:14:25 dkernen -# Incorporate changes for exists method performance enhancement -# -# Revision 19991124.02 1999/11/24 17:46:19 dkernen -# More fixes to t/basic.t -# -# Revision 19991124.01 1999/11/24 16:51:49 dkernen -# Changed t/basic.t to test for UIDPLUS before trying UID cmds -# -# Revision 1.3 1999/11/23 17:51:06 dkernen -# Committing version 1.06 distribution copy diff --git a/Mail-IMAPClient-3.21/examples/imtestExample.pl b/Mail-IMAPClient-3.21/examples/imtestExample.pl deleted file mode 100644 index 27938e9..0000000 --- a/Mail-IMAPClient-3.21/examples/imtestExample.pl +++ /dev/null @@ -1,226 +0,0 @@ -#!/usr/local/bin/perl - -use Sys::Hostname; -use Mail::IMAPClient; -use IPC::Open3; -use IO::Socket::UNIX; -use IO::Socket; -use Socket; -use Getopt::Std; -&getopts('ha:df:i:o:p:r:m:u:x:w:p:s:'); - -if ($opt_h) { - print <<" HELP"; - $0 -- uses imtest to connect and authenticate to imap server - - Options: - -h print this help message - - -a auth authenticate as user 'auth'. This value is passed as the '-a' value - to imtest and defaults to whatever you supplied for -u. - -d turn on Mail::IMAPClient debugging - -f file write Mail::IMAPClient debugging info to file 'file' - -m mech use authentication mechanism "mech"; default is to not supply -m to - imtest - -i path path to imtest executable; default is to let your shell find it via the - PATH environmental variable. - -p port port on mail server to connect to (default is 143) - -r rlm Use realm 'rlm' (default is name of mail server) - -s srvr Name of IMAP mail server (default is the localhost's hostname) - -u usr Use 'usr' as the user id (required) - -w pswd Use 'pswd' as the password for 'usr' (required) - -x path Path to Unix socket (fifo). Default is '/tmp/$0.sock'. - -o 'ops' Pass the string 'ops' directy to imtest as additional options. - This is how you get "other" imtest options passed to imtest. (I only - included switches for options that are either really common or useful - to the IMAPClient object as well as to imtest.) - - Many of these switches have the same function here as with imtest. I added a - few extras though! - - Example: - $0 -o '-k 128 -l 128' -s imapmail -u test -w testpswd \ - -i /usr/local/src/cyrus/cyrus-imapd-2.1.11/imtest/ \ - -m DIGEST-MD5 - - It's a good idea to test your options by running imtest from the command line - (but without the -x switch) first. Once you have it working by hand you should - be able to get it to work from this script (or one remarkably like it) without - too much bloodshed. - - HELP - exit; -} - -$opt_u and $opt_w or die "No userid/password credentials supplied. I hate that.\n"; -$opt_a ||= $opt_u; - -if ($opt_i ) { - $opt_i =~ m#^[/\.]# or $opt_i = "./$opt_i"; - $opt_i =~ m#imtest$# or ( -x $opt_i and -f $opt_i ) - or $opt_i .= ( $opt_i =~ m#/$# ? "imtest" : "/imtest") ; - -x $opt_i and -f $opt_i or die "Cannot find executable $opt_i\n"; -} - - -$opt_p ||= 143; -$opt_s ||= hostname; -$opt_r ||= $opt_s; -$opt_x ||= "/tmp/$0.sock"; - - -my($rfh,$wfh,$efh) ; - - -my($imt) = ($opt_i ? "$opt_i " : "imtest ") . - ($opt_m ? "-m $opt_m ":"" ) . - qq(-r $opt_r -a $opt_a -u $opt_u ). - qq(-x $opt_x -w $opt_w -p $opt_p $opt_s); - -open3($wfh,$rfh,$efh,$imt); - -my $line; - -until ($line =~ /^Security strength factor:/i ) { - $line = <$rfh> or die "EOF\n"; - print STDERR "Prolog: $line" if $opt_d; -} -sleep 5; -my $sock = IO::Socket::UNIX->new("$opt_x") - or warn "No socket: $!\n" and exit; - -print STDERR "<<>>\n" if $opt_d; -my $imap = Mail::IMAPClient->new; -$imap->Prewritemethod(\&Mail::IMAPClient::Strip_cr); -$imap->User("$opt_u"); -$imap->Server("$opt_s"); -$imap->Port("$opt_p"); -$imap->Debug($opt_d); -$imap->Debug_fh($opt_f||\*STDERR); -$imap->State($imap->Connected); -$imap->Socket($sock); - -# Your code goes here: - -$imap->Select("INBOX"); -for my $m (@{$imap->search("TEXT SUBJECT")} ) { - print "Message $m:\t",$imap->subject($m),"\n"; -} -# You should have finished your code by about here -$imap->logout; - -print STDERR "<<>>\n" if $opt_d; - -exit; - -=head1 NAME - -imtestExample.pl -- uses imtest to connect and authenticate to imap server - - -=head1 DESCRIPTION - - -=head2 Options - -=over 4 - -=item -h - -print this help message - -=item -a auth - -authenticate as user 'auth'. This value is passed as the '-a' value -to imtest and defaults to whatever you supplied for -u. - -=item -d - -turn on Mail::IMAPClient debugging - -=item -f file - -write Mail::IMAPClient debugging info to file 'file' - -=item -m mech - -use authentication mechanism "mech"; default is to not supply -m to - imtest - -=item -i path - -path to imtest executable; default is to let your shell find it via the -PATH environmental variable. - -=item -p port - -port on mail server to connect to (default is 143) - -=item -r rlm - -Use realm 'rlm' (default is name of mail server) - -=item -s srvr - -Name of IMAP mail server (default is the localhost's hostname) - -=item -u usr - -Use 'usr' as the user id (required) - -=item -w pswd - -Use 'pswd' as the password for 'usr' (required) - -=item -x path - -Path to Unix socket (fifo). Default is '/tmp/$0.sock'. - -=item -o 'ops' - -Pass the string 'ops' directy to imtest as additional options. -This is how you get "other" imtest options passed to imtest. (I only -included switches for options that are either really common or useful -to the IMAPClient object as well as to imtest.) - -Many of these switches have the same function here as with imtest. I added a -few extras though! - -=back - -Example: - - imtestExample.pl -o '-k 128 -l 128' -s imapmail -u test -w testpswd \ - -i /usr/local/src/cyrus/cyrus-imapd-2.1.11/imtest/ \ - -m DIGEST-MD5 - -It's a good idea to test your options by running imtest from the command line -(but without the -x switch) first. Once you have it working by hand you should -be able to get it to work from this script (or one remarkably like it) without -too much bloodshed. - - -=head1 AUTHOR - -David J. Kernen - -The Kernen Group, Inc. - -imap@kernengroup.com - -Based on a suggestion by Tara L. Andrews. - -=head1 COPYRIGHT - -This example and Mail::IMAPClient are Copyright (c) 2003 -by The Kernen Group, Inc. All rights reserved. - -This example is distributed with Mail::IMAPClient and -subject to the same licensing requirements as Mail::IMAPClient. - -imtest is a utility distributed with Cyrus IMAP server, -Copyright (c) 1994-2000 Carnegie Mellon University. -All rights reserved. - -=cut - diff --git a/Mail-IMAPClient-3.21/examples/migrate_mail2.pl b/Mail-IMAPClient-3.21/examples/migrate_mail2.pl deleted file mode 100644 index d656ae5..0000000 --- a/Mail-IMAPClient-3.21/examples/migrate_mail2.pl +++ /dev/null @@ -1,326 +0,0 @@ -#!/usr/local/bin/perl -#$Id: //depot/main/ZimbraPS/Mail-IMAPClient/examples/migrate_mail2.pl#1 $ -# -# An example of how to migrate from a Netscape server -# (which uses a slash as a separator and which does -# not allow subfolders under the INBOX, only next to it) -# to a Cyrus server (which uses a dot (.) as a separator -# and which requires subfolders to be under "INBOX"). -# There are also some allowed-character differences taken -# into account but this is by no means complete AFAIK. -# -# This is an example. If you are doing mail migrations -# then this may in fact be a very helpful example but -# it is unlikely to work 100% correctly as-is. -# A good place to start is by testing a rather large-volume -# transfer of actual mail from the source server with the -# -v option turned on and redirect output to a file for -# perusal. Examine the output carefully for unexpected -# results, such as a number of messages being skipped because -# they're already in the target folder when you know darn -# well this is the first time you ran the script. This -# would indicate an incompatibility with the logic for -# detecting duplicates, unless for some reason the source -# mailbox contains a lot of duplicate messages to begin with. -# (The latter case is an example of why you should use an -# actual mailbox stuffed with actual mail for test; if you -# generate test messages and then test migrating those you -# will only prove that your test messages are migratable. -# -# Also, you may need to play with the rules -# for translating folder names based on what kind of -# names your target server and source server support. -# -# You may also need to play with the logic that determines -# whether or not a message has already been migrated, -# especially if your source server has messages that -# did not come from an SMTP gateway or something like that. -# -# Some servers allow folders to contain mail and subfolders, -# some allow folders to only contain either mail or subfolders. -# If you are migrating from a "mixed use" type to a "single use" -# type server then you'll have to figure out how to deal -# with this. (This script deals with this by creating folders like -# "/blah_mail", "/blah/blah_mail", and "/blah/blah/blah_mail" -# to hold mail if the source folder contains mail and subfolders -# and the target server supports only single-use folders. -# You may not choose a different strategy.) -# -# Finally, it's possible that in some server-to-server -# copies, the source server supports messages that the -# target server considers unacceptable. For example, some -# but not all IMAP servers flat out refuse to accept -# messages with "base newlines", which is to say messages -# whose lines are match the pattern /[^\r]\n$/. There is -# no logic in this script that deals with the situation; -# you will have to identify it if it exists and figure -# out how you want to handle it. -# -# This is probably not an exhaustive list of issues you'll -# face in a migration, but it's a start. -# -# If you're just migrating from an old version to a newer -# version of the same server then you'll probably have -# a much easier time of it. -# -# - -use Mail::IMAPClient; -use Data::Dumper; -use IO::File; -use File::Basename ; -use Getopt::Std; -use strict; -use vars qw/ $opt_B $opt_D $opt_T $opt_U - $opt_W $opt_b $opt_d $opt_h - $opt_t $opt_u $opt_w $opt_v - $opt_s $opt_S $opt_W $opt_p - $opt_P $opt_f $opt_F $opt_m - $opt_M -/; - -getopts('vs:S:u:U:dDb:B:f:F:w:W:p:P:t:T:hm:M:'); - -if ( $opt_h ) { - print STDERR <<"HELP"; - -$0 - an example script demonstrating the use of the Mail::IMAPClient's - migrate method. - -Syntax: - $0 -s source_server -u source_user -w source_password -p source_port \ - -d debug_source -f source_debugging_file -b source_buffsize \ - -t source_timeout -m source_auth_mechanism \ - -S target_server -U target_user -W target_password -P target_port \ - -D debug_target -F target_debugging_file -B target_buffsize \ - -T target_timeout -M target_auth_mechanism \ - -v - -where "source" refers to the "copied from" mailbox, target is the -"copied to" mailbox, and -v turns on verbose output. -Authentication mechanisms default to "PLAIN". - -HELP - exit; -} -$opt_v and ++$|; -print "$0: Started at ",scalar(localtime),"\n" if $opt_v; - -$opt_p||=143; -$opt_P||=143; - -# Make a connection to the source mailbox: -my $imap = Mail::IMAPClient->new( - Server => $opt_s, - User => $opt_u, - Password=> $opt_w, - Uid => 1, - Port => $opt_p, - Debug => $opt_d||0, - Buffer => $opt_b||4096, - Fast_io => 1, - ( $opt_m ? ( Authmechanism => $opt_m) : () ), - Timeout => $opt_t, - ($opt_f ? ( Debug_fh=>IO::File->new(">$opt_f" )) : ()), -) or die "$@"; - -# Make a connection to the target mailbox: -my $imap2 = Mail::IMAPClient->new( - Server => $opt_S, - User => $opt_U, - Password=> $opt_W, - Port => $opt_P, - Uid => 1, - Debug => $opt_D||0, - ( $opt_M ? ( Authmechanism => $opt_M) : () ), - ($opt_F ? ( Debug_fh=>IO::File->new(">$opt_F")) : ()), - Buffer => $opt_B||4096, - Fast_io => 1, - Timeout => $opt_T, # True value -) or die "$@"; - -# Turn off buffering on debug files: -$imap->Debug_fh->autoflush; -$imap2->Debug_fh->autoflush; - -# Get folder hierarchy separator characters from source and target: -my $sep1 = $imap->separator; -my $sep2 = $imap2->separator; - -# Find out if source and target support subfolders inside INBOX: -my $inferiorFlag1 = $imap->is_parent("INBOX"); -my $inferiorFlag2 = $imap2->is_parent("INBOX"); - -# Set up a test folders to see if the source and target support mixed-use -# folders (i.e. folders with both subfolders and mail messages): -my $testFolder1 = "Migrate_Test_$$" ; # Ex: Migrate_Test_1234 -$testFolder1 = $inferiorFlag2 ? - "INBOX" . $sep2 . $testFolder1 : - $testFolder1 ; - -# The following folder will be a subfolder of $testFolder1: -my $testFolder2 = "Migrate_Test_$$" . $sep2 . "Migrate_test_subfolder_$$" ; -$testFolder2 = $inferiorFlag2 ? "INBOX" . $sep2 . $testFolder2 : $testFolder2 ; - -$imap2->create($testFolder2) ; # Create the subfolder first; RFC2060 dictates that - # the parent folder should be created at the same time - - -# The following line inspired the selectable method. It was also made obsolete by it, -# but I'm leaving it as is to demonstrate use of lower-level method calls: -my $mixedUse2 = grep(/NoSelect/i,$imap2->list("",$testFolder1))? 0 : 1; - -# Repeat the above with the source mailbox: -$testFolder2 = "Migrate_Test_$$" . $sep1 . "Migrate_test_subfolder_$$" ; -$testFolder2 = $inferiorFlag1 ? "INBOX" . $sep1 . $testFolder1 : $testFolder1 ; - -$imap->create($testFolder2) ; - -my $mixedUse1 = grep(/NoSelect/i,$imap->list("",$testFolder1))? 0 : 1; - -print "Imap host $opt_s:$opt_p uses a '$sep1' as a separator and ", - ( defined($inferiorFlag1) ? "allows " : "does not allow "), - "children in the INBOX. It supports ", - ($mixedUse1?"mixed use ":"single use "), "folders.\n" if $opt_v; - -print "Imap host $opt_S:$opt_P uses a '$sep2' as a separator and ", - ( defined($inferiorFlag2) ? "allows " : "does not allow "), - "children in the INBOX. It supports ", - ($mixedUse2?"mixed use ":"single use "), "folders.\n" if $opt_v; - -for ($testFolder1,$testFolder2) {$imap->delete($_); $imap2->delete($_);} - -my($totalMsgs, $totalBytes) = (0,0); - -# Now we will migrate the folder. Here we are doing one message at a time -# so that we can do more granular status reporting and error checking. -# A lazier way would be to do all the messages in one migrate method call -# (specifying "ALL" as the message number) but then we wouldn't be able -# to print out which message we were migrating and it would be a little -# bit tougher to control checking for duplicates and stuff like that. -# We could also check the size of the message on the target right after -# the migrate as an extra safety check if we wanted to but I didn't bother -# here. (I saved as an exercise for the reader. Yeah! That's it! An exercise!) - -# Iterate over all the folders in the source mailbox: -for my $f ($imap->folders) { - # Select the folder on the source side: - $imap->select($f) ; - - # Massage the foldername into an acceptable target-side foldername: - my $targF = ""; - my $srcF = $f; - $srcF =~ s/^INBOX$sep1//i; - if ( $inferiorFlag2 ) { - $targF = $srcF eq "INBOX" ? "INBOX" : "INBOX.$f" ; - } else { - $targF = $srcF ; - } - - $targF =~ s/$sep1/$sep2/go unless $sep1 eq $sep2; - $targF =~ tr/#\$\& '"/\@\@+_/; - if ( $imap->is_parent($f) and !$mixedUse2 ) { - $targF .= "_mail" ; - } - print "Migrating folder $f to $targF\n" if $opt_v; - - # Create the (massaged) folder on the target side: - unless ( $imap2->exists($targF) ) { - $imap2->create($imap2->Massage($targF)) - or warn "Cannot create $targF on " . $imap2->Server . ": $@\n" and next; - } - - # ... and select it - $imap2->select($imap2->Massage($targF)) - or warn "Cannot select $targF on " . $imap2->Server . ": $@\n" and next; - - # now that we know the target folder is selectable, we can close it again: - $imap2->close; - my $count = 0; - my $expectedTotal = $imap->message_count($f) ; - - # Now start iterating over all the messages on the source side... - for my $msg ($imap->messages) { - ++$count; - my $h = ""; - # Get some basic info about the message: - eval { $h = ($imap->parse_headers($msg,"Message-id")||{})->{'Message-id'}[0]}; - my $tsize = $imap->size($msg); - my $ret = 0 ; my $h2 = []; - - # Make sure we didn't already migrate the message in a previous pass: - $imap2->select($targF); - if ( $tsize and $h and $h2 = $imap2->search( - HEADER => 'Message-id' => $imap2->Quote($h), - NOT => SMALLER => $tsize, - NOT => LARGER => $tsize - ) - ) { - print - "Skipping $f/$msg to $targF. ", - "One or more messages (" ,join(", ",@$h2), - ") with the same size and message id ($h) ", - "is already on the server. ", - "\n" - if $opt_v; - $imap2->close; - - } else { - - print - "Migrating $f/$msg to $targF. ", - "Message #$count of $expectedTotal has ", - $tsize , " bytes.", - "\n" if $opt_v; - $imap2->close; - - # Migrate the message: - my $ret = $imap->migrate($imap2,$msg,"$targF") ; - $ret and ( $totalMsgs++ , $totalBytes += $tsize); - $ret or warn "Cannot migrate $f/$msg to $targF on " . $imap2->Server . ": $@\n" ; - } - } -} - -print "$0: Finished migrating $totalMsgs messages and $totalBytes bytes at ",scalar(localtime),"\n" - if $opt_v; -exit; - - -=head1 AUTHOR - -David J. Kernen - -The Kernen Group, Inc. - -imap@kernengroup.com - -=head1 COPYRIGHT - -This example and Mail::IMAPClient are Copyright (c) 2003 -by The Kernen Group, Inc. All rights reserved. - -This example is distributed with Mail::IMAPClient and -subject to the same licensing requirements as Mail::IMAPClient. - -imtest is a utility distributed with Cyrus IMAP server, -Copyright (c) 1994-2000 Carnegie Mellon University. -All rights reserved. - -=cut - -#$Log: migrate_mail2.pl,v $ -#Revision 19991216.4 2003/06/12 21:38:33 dkernen -# -#Preparing 2.2.8 -#Added Files: COPYRIGHT -#Modified Files: Parse.grammar -#Added Files: Makefile.old -# Makefile.PL Todo sample.perldb -# BodyStructure.pm -# Parse.grammar Parse.pod -# range.t -# Thread.grammar -# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt -# rfc2221.txt rfc2359.txt rfc2683.txt -# diff --git a/Mail-IMAPClient-3.21/examples/migrate_mbox.pl b/Mail-IMAPClient-3.21/examples/migrate_mbox.pl deleted file mode 100644 index 59b71bf..0000000 --- a/Mail-IMAPClient-3.21/examples/migrate_mbox.pl +++ /dev/null @@ -1,131 +0,0 @@ -#!/usr/local/bin/perl -# -# This is an example demonstrating the use of the migrate method. -# Note that the migrate method is considered experimental and should -# be used with caution. -# -#$Id: //depot/main/ZimbraPS/Mail-IMAPClient/examples/migrate_mbox.pl#1 $ -# - -use Mail::IMAPClient; -use IO::File; -use File::Basename ; -use Getopt::Std; -use warnings; -use vars qw/$opt_h $opt_H - $opt_s $opt_u $opt_p $opt_d $opt_b $opt_o - $opt_S $opt_U $opt_P $opt_D $opt_B $opt_O -/; - -getopts('Hhs:S:u:U:p:P:d:D:b:B:o:O:'); -if ($opt_h or $opt_H ) { -print << "HELP"; - - -Usage: - -$0 -[h|H] -- prints this message - -Lower-case options are for source server; upper-case options are for the target server. - -$0 -s server -S server -u uid -U uid -p passwd -P passwd \ - -b buffersize -B buffersize -o debugFile -O debugFile > error_file - -All uppercase options except -O default to the lowercase option that was specified. -If you don't specify any uppercase options at all then God help you, I don't know -what will happen. - -Always capture STDERR so that you'll be able to resolve any problems that come up. - - -HELP - -exit; -} - -my $imap = Mail::IMAPClient->new( - Server => $opt_s, - User => $opt_u, - Password=> $opt_p, - Uid => 1, - Debug => $opt_d, - Buffer => $opt_b||4096, - Fast_io => 1, - Timeout => 160, # True value - Debug_fh=> ( - $opt_o ? IO::File->new(">$opt_o")||die "can't open $opt_o: $!\n" : undef ) -) or die "Error opening source connection: $@\n"; - -my $imap2 = Mail::IMAPClient->new( - Server => $opt_S||$opt_s, - User => $opt_U||$opt_u, - Password=> $opt_P||$opt_p, - Uid => 1, - Debug => $opt_D||$opt_d, - Buffer => $opt_B||$opt_b||4096, - Fast_io => 1, - Timeout => 160, - Debug_fh=> ( - $opt_O ? IO::File->new(">$opt_O")||die "can't open $opt_O: $!\n" : undef ) -) or die "Error opening target connection: $@\n"; - - -$imap->Debug_fh->autoflush; -$imap2->Debug_fh->autoflush; - -for my $f ($imap->folders) { $imap->select($f) ; $imap->migrate($imap2,"ALL") ;} - - -=head1 AUTHOR - -David J. Kernen - -The Kernen Group, Inc. - -imap@kernengroup.com - -=head1 COPYRIGHT - -This example and Mail::IMAPClient are Copyright (c) 2003 -by The Kernen Group, Inc. All rights reserved. - -This example is distributed with Mail::IMAPClient and -subject to the same licensing requirements as Mail::IMAPClient. - -imtest is a utility distributed with Cyrus IMAP server, -Copyright (c) 1994-2000 Carnegie Mellon University. -All rights reserved. - -=cut - -# -#$Log: migrate_mbox.pl,v $ -#Revision 19991216.2 2003/06/12 21:38:33 dkernen -# -#Preparing 2.2.8 -#Added Files: COPYRIGHT -#Modified Files: Parse.grammar -#Added Files: Makefile.old -# Makefile.PL Todo sample.perldb -# BodyStructure.pm -# Parse.grammar Parse.pod -# range.t -# Thread.grammar -# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt -# rfc2221.txt rfc2359.txt rfc2683.txt -# -#Revision 1.1 2003/06/12 21:38:15 dkernen -# -#Preparing 2.2.8 -#Added Files: COPYRIGHT -#Modified Files: Parse.grammar -#Added Files: Makefile.old -# Makefile.PL Todo sample.perldb -# BodyStructure.pm -# Parse.grammar Parse.pod -# range.t -# Thread.grammar -# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt -# rfc2221.txt rfc2359.txt rfc2683.txt -# -# diff --git a/Mail-IMAPClient-3.21/examples/populate_mailbox.pl b/Mail-IMAPClient-3.21/examples/populate_mailbox.pl deleted file mode 100644 index b612de2..0000000 --- a/Mail-IMAPClient-3.21/examples/populate_mailbox.pl +++ /dev/null @@ -1,319 +0,0 @@ -#!/usr/local/bin/perl -#$Id: //depot/main/ZimbraPS/Mail-IMAPClient/examples/populate_mailbox.pl#1 $ # -use Time::Local ; -use FileHandle ; -use File::Copy ; -use Mail::IMAPClient; -use Sys::Hostname ; - # -my $default_user = 'default' ; -my $default_pswd = 'default' ; - # -######################################################################### -# ARGS: DATE = YYYYMMDDHHMM (defaults to current system date) # -# UID = IMAP account id (defaults to $default_user) # -# PSWD = uid's password (defaults to $default_pswd) # -# HOST = Target host (defaults to localhost) # -# CLEAN = 1 (defaults to 0; used to clean out mailbox 1st) # -# CLEANONLY= 1 (defaults to 0; if 1 then only CLEAN is done) # -# DOMAIN = x.com (no default) the mail domain for UID's address # -# # -# EG: populate_mailbox.pl DATE=200001010100 UID=testuser # -# # -######################################################################### - # -(my($x)= join(" ",@ARGV)) ; -$x=~s~=~ ~g ; -chomp($x) ; - # -my %hash = split(/\s+/, $x) if $x ; - # -while (my ($k,$v) = each %hash ) { - $hash{uc $k} = $v ; - } - -while (my ($k,$v) = each %hash ) { - delete $hash{$k} if $k =~ tr/[a-z]// ; - } - ; -$hash{UID} ||= "$default_user" ; -$hash{PSWD} ||= "$default_pswd" ; -$hash{HOST} ||= hostname ; - # -while (my ($k,$v) = each %hash ) { - print "Running with $k set to $v\n" ; - } - # -my $domain = $hash{DOMAIN} or die "No mail domain provided.\n" ; -my $now = seconds($hash{DATE}) || time ; - # -my $six = $now - ( 6 * 24 * 60 * 60 ) ; -my $seven = $now - ( 7 * 24 * 60 * 60 ) ; -my $notthirty = $now - ( 29 * 24 * 60 * 60 ) ; -my $thirty = $now - ( 30 * 24 * 60 * 60 ) ; -my $notsixty = $now - ( 59 * 24 * 60 * 60 ) ; -my $sixty = $now - ( 60 * 24 * 60 * 60 ) ; -my $notd365 = $now - ( 364 * 24 * 60 * 60 ) ; -my $d365 = $now - ( 365 * 24 * 60 * 60 ) ; - # -$hash{SUBJECTS} = [ "Sixty days old", "Less than sixty days old" , - "365 days old", "Less than 365 days old" , - "Trash/Incinerator -- 7 days old" , - "Sent -- 29 days old" , - "Sent -- 30 days old" , - "Trash -- 6 days old" , - ] ; -$hash{FOLDERS} = [ "Sent", "INBOX", "Trash" , - "365_folder", "Trash/Incinerator" , - "not_365_folder" , - ] ; - # -&clean_mailbox if $hash{CLEANONLY} || $hash{CLEAN} ; -exit if $hash{CLEANONLY} ; - # -#send to: date: subject: # -#-------- --- ----- --------- # -sendmail( $hash{UID}, $sixty, "Sixty days old" ) ; -sendmail( $hash{UID}, $notsixty, "Less than sixty days old") ; -sendmail( $hash{UID}, $d365, "365 days old" ) ; -sendmail( $hash{UID}, $notd365, "Less than 365 days old" ) ; - # -populate_trash("Trash/Incinerator",$hash{UID}, $seven, 7 ) ; -populate_trash( "Trash" , $hash{UID}, $six, 6 ) ; -populate_trash( "Sent" , $hash{UID}, $thirty, 30 ) ; -populate_trash( "Sent" , $hash{UID}, $notthirty, 29 ) ; - # -movemail( "365 days old" , - "365_folder" ) ; - # -movemail( "Less than 365 days old" , - "not_365_folder" ) ; - # -exit ; - # - # -sub seconds { - my $d = shift or return undef ; - my($yy,$moy,$dom,$hr,$min) = - # - $d =~ m! ^ # anchor at start # - (\d\d\d\d) # year # - (\d\d) # month # - (\d\d) # day # - (\d\d) # hour # - (\d\d) # minute # - !x ; - # - return timegm(0,$min,$hr,$dom,$moy-1,($yy>99?$yy-1900:$yy)) ; - } - # -sub sendmail { - # - my($to,$date,$subject) = @_ ; - my $text = <new ( - Server => $hash{HOST} , - User => $hash{UID} , - Password=> $hash{PSWD} ) - or die "can't connect: $!\n" ; - # - $imap->append("INBOX",$text) ; - $imap->logout ; - } - } - # -sub populate_trash { - my $where = shift ; - my $to = shift ; - my $date = shift ; - my $d = shift ; - # - my($ss,$min,$hr,$day,$mon,$year)=gmtime($date) ; - $mon++ ; - $year += 1900 ; - my $fn =sprintf("%4.4d%2.2d%2.2d%2.2d%2.2d%2.2d" , - $year,$mon,$day,$hr,$min,$ss ) ; - my $x = 0 ; - my $subject = "$where -- $d days old" ; - while ($x++ < 10) { - my $fh ; - $fh .= "Date: @{[&rfc822_date($date)]}\n" ; - $fh .= <new ( - Server => $hash{HOST} , - User => $hash{UID} , - Password=> $hash{PSWD} ) - or die "can't connect: $!\n" ; - $imap->append($where, $fh) ; - # - } - # - } - # -sub movemail { - # - my ($subj,$fold) = @_ ; - my $fh = Mail::IMAPClient->new ( - Debug => 0 , - Server => $hash{HOST} , - User => $hash{UID} , - Password => $hash{PSWD} , - ) - ; - # - $fh->select("inbox") or die "cannot open inbox: $!\n" ; - # - foreach my $f ($fh->search(qq(SUBJECT "$subj")) ) { - # - $fh->move($fold,$f) ; - # - } - # - } - # -sub clean_mailbox { - # - my $fh =Mail::IMAPClient->new ( - Debug => 0 , - Server => $hash{HOST} , - User => $hash{UID} , - Password => $hash{PSWD} , - ) - ; - for my $x (@{$hash{FOLDERS}}) { - my @msgs ; - $fh->create($x) unless $fh->exists($x) ; - $fh->select($x) ; - for my $s (@{$hash{SUBJECTS}}) { - push @msgs, $fh->search(qq(SUBJECT "$s")) ; - } - $fh->delete_message(@msgs) if scalar(@msgs) ; - $fh->expunge ; - } - } - # -sub rfc822_date { -#Date: Fri, 09 Jul 1999 13:10:55 -0400 # -my $date = shift ; -my @date = localtime($date) ; -my @dow = qw{ Sun Mon Tue Wed Thu Fri Sat } ; -my @mnt = qw{ Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec} ; - # -return sprintf ( - "%s, %2.2d %s %4.4s %2.2d:%2.2d:%2.2d -0400" , - $dow[$date[6]] , - $date[3] , - $mnt[$date[4]] , - $date[5]+=1900 , - $date[2] , - $date[1] , - $date[0] ) - ; - } - - -=head1 AUTHOR - -David J. Kernen - -The Kernen Group, Inc. - -imap@kernengroup.com - -=head1 COPYRIGHT - -This example and Mail::IMAPClient are Copyright (c) 2003 -by The Kernen Group, Inc. All rights reserved. - -This example is distributed with Mail::IMAPClient and -subject to the same licensing requirements as Mail::IMAPClient. - -imtest is a utility distributed with Cyrus IMAP server, -Copyright (c) 1994-2000 Carnegie Mellon University. -All rights reserved. - -=cut - -# $Id: //depot/main/ZimbraPS/Mail-IMAPClient/examples/populate_mailbox.pl#1 $ -# $Log: populate_mailbox.pl,v $ -# Revision 19991216.8 2003/06/12 21:38:34 dkernen -# -# Preparing 2.2.8 -# Added Files: COPYRIGHT -# Modified Files: Parse.grammar -# Added Files: Makefile.old -# Makefile.PL Todo sample.perldb -# BodyStructure.pm -# Parse.grammar Parse.pod -# range.t -# Thread.grammar -# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt -# rfc2221.txt rfc2359.txt rfc2683.txt -# -# Revision 1.1 2003/06/12 21:38:16 dkernen -# -# Preparing 2.2.8 -# Added Files: COPYRIGHT -# Modified Files: Parse.grammar -# Added Files: Makefile.old -# Makefile.PL Todo sample.perldb -# BodyStructure.pm -# Parse.grammar Parse.pod -# range.t -# Thread.grammar -# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt -# rfc2221.txt rfc2359.txt rfc2683.txt -# -# Revision 19991216.7 2002/08/23 13:29:49 dkernen -# -# Modified Files: Changes IMAPClient.pm INSTALL MANIFEST Makefile Makefile.PL README Todo test.txt -# Made changes to create version 2.1.6. -# Modified Files: -# imap_to_mbox.pl populate_mailbox.pl -# Added Files: -# cleanTest.pl migrate_mbox.pl -# -# Revision 19991216.6 2000/12/11 21:58:53 dkernen -# -# Modified Files: -# build_dist.pl build_ldif.pl copy_folder.pl find_dup_msgs.pl -# imap_to_mbox.pl populate_mailbox.pl -# to add CVS data -# -# Revision 19991216.5 1999/12/16 17:19:15 dkernen -# Bring up to same level -# -# Revision 19991124.3 1999/12/16 17:14:26 dkernen -# Incorporate changes for exists method performance enhancement -# -# Revision 19991124.02 1999/11/24 17:46:21 dkernen -# More fixes to t/basic.t -# -# Revision 19991124.01 1999/11/24 16:51:51 dkernen -# Changed t/basic.t to test for UIDPLUS before trying UID cmds -# -# Revision 1.4 1999/11/23 17:51:06 dkernen -# Committing version 1.06 distribution copy -# diff --git a/Mail-IMAPClient-3.21/examples/sharedFolder.pl b/Mail-IMAPClient-3.21/examples/sharedFolder.pl deleted file mode 100644 index 96666cc..0000000 --- a/Mail-IMAPClient-3.21/examples/sharedFolder.pl +++ /dev/null @@ -1,88 +0,0 @@ -#!/usr/local/bin/perl -#$Id: //depot/main/ZimbraPS/Mail-IMAPClient/examples/sharedFolder.pl#1 $ - -use Mail::IMAPClient; -use Getopt::Std; -use File::Basename; -getopts('s:u:p:f:dh'); - -if ($opt_h) { - - print STDERR "$0 -- example of how to select shared folder\n", - "\n\nUsage:\n", - "\t-s server -- specify name or ip address of mail server\n", - "\t-u userid -- specify login name of authenticating user\n", - "\t-p passwd -- specify login password of authenticating user\n", - "\t-f folder -- specify shared folder to access (i.e. '-f frank/INBOX')\n", - "\t-h display this help message\n\n"; - "\t-d turn on debugging output\n\n"; - exit; -} - -my $server = $opt_s or die "No server name specified\n"; -my $user = $opt_u or die "No user name specified\n"; -my $pass = $opt_p or die "No password specified\n"; -my $folder = $opt_f or die "No shared folder specified\n"; - -chomp $pass; -my $imap = Mail::IMAPClient->new(Server=>$server,User=>$user,Password=>$pass,Debug=>$opt_d) - or die "Can't connect to $user\@$server: $@ $!\n"; - -my($prefix,$prefSep) = @{$imap->namespace->[1][0]} - or die "Can't get shared folder namespace or separator: $@\n"; - - -my $target = $prefix . - ( $prefix =~ /\Q$prefSep\E$/ || $opt_f =~ /^\Q$prefSep/ ? "" : $prefSep ) . - $opt_f ; - -print "Selecting $target\n"; - -$imap->select($target) - or die "Cannot select $target: $@\n"; - -print "Ok: $target has ", $imap->message_count($target)," messages.\n"; - -$imap->logout; -exit; - - -=head1 AUTHOR - -David J. Kernen - -The Kernen Group, Inc. - -imap@kernengroup.com - -=head1 COPYRIGHT - -This example and Mail::IMAPClient are Copyright (c) 2003 -by The Kernen Group, Inc. All rights reserved. - -This example is distributed with Mail::IMAPClient and -subject to the same licensing requirements as Mail::IMAPClient. - -imtest is a utility distributed with Cyrus IMAP server, -Copyright (c) 1994-2000 Carnegie Mellon University. -All rights reserved. - -=cut - -# -#$Log: sharedFolder.pl,v $ -#Revision 19991216.1 2003/06/12 21:38:35 dkernen -# -#Preparing 2.2.8 -#Added Files: COPYRIGHT -#Modified Files: Parse.grammar -#Added Files: Makefile.old -# Makefile.PL Todo sample.perldb -# BodyStructure.pm -# Parse.grammar Parse.pod -# range.t -# Thread.grammar -# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt -# rfc2221.txt rfc2359.txt rfc2683.txt -# -# diff --git a/Mail-IMAPClient-3.21/lib/Mail/IMAPClient.pm b/Mail-IMAPClient-3.21/lib/Mail/IMAPClient.pm deleted file mode 100644 index db85e5b..0000000 --- a/Mail-IMAPClient-3.21/lib/Mail/IMAPClient.pm +++ /dev/null @@ -1,3279 +0,0 @@ - -# _{name} methods are undocumented and meant to be private. - -use strict; -use warnings; - -package Mail::IMAPClient; -our $VERSION = '3.21'; - -use Mail::IMAPClient::MessageSet; - -use IO::Socket qw(:crlf SOL_SOCKET SO_KEEPALIVE); -use IO::Select (); -use IO::File (); -use Carp qw(carp); #local $SIG{__WARN__} = \&Carp::cluck; #DEBUG - -use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK); -use Errno qw(EAGAIN EPIPE ECONNRESET); -use List::Util qw(first min max sum); -use MIME::Base64 qw(encode_base64 decode_base64); -use File::Spec (); - -use constant APPEND_BUFFER_SIZE => 1024 * 1024; - -use constant { - Unconnected => 0, - Connected => 1, # connected; not logged in - Authenticated => 2, # logged in; no mailbox selected - Selected => 3, # mailbox selected -}; - -use constant { - INDEX => 0, # Array index for output line number - TYPE => 1, # Array index for line type (OUTPUT, INPUT, or LITERAL) - DATA => 2, # Array index for output line data -}; - -use constant NonFolderArg => 1; # for Massage indicating non-folder arguments - -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 $text = join '', @_; - $text =~ s/$CRLF/\n /og; - $text =~ s/\s*$/\n/; - - #use POSIX (); $text = POSIX::strftime("%F %T ", localtime).$text; #DEBUG - my $fh = $self->{Debug_fh} || \*STDERR; - print $fh $text; -} - -BEGIN { - - # set-up accessors - foreach my $datum ( - qw(Authcallback Authmechanism Authuser Buffer Count Debug - Debug_fh Domain Folder Ignoresizeerrors Keepalive - Maxcommandlength Maxtemperrors Password Peek Port - Prewritemethod Proxy Ranges Readmethod Reconnectretry - Server Showcredentials State Supportedflags Timeout Uid - User Ssl) - ) - { - no strict 'refs'; - *$datum = sub { - @_ > 1 ? ( $_[0]->{$datum} = $_[1] ) : $_[0]->{$datum}; - }; - } -} - -sub LastError { - my $self = shift; - @_ or return $self->{LastError}; - my $err = shift; - - # allow LastError to be reset with undef - if ( defined $err ) { - $err =~ s/$CRLF$//og; - local ($!); # old versions of Carp could reset $! - $self->_debug( Carp::longmess("ERROR: $err") ); - - # hopefully this is rare... - if ( $err eq "NO not connected" ) { - my $lerr = $self->{LastError} || ""; - my $emsg = "Trying command when NOT connected!"; - $emsg .= " LastError was: $lerr" if $lerr; - Carp::cluck($emsg); - } - } - $@ = $self->{LastError} = $err; -} - -sub Fast_io(;$) { - my ( $self, $use ) = @_; - defined $use - or return $self->{File_io}; - - my $socket = $self->{Socket} - or return undef; - - unless ($use) { - eval { fcntl( $socket, F_SETFL, delete $self->{_fcntl} ) } - if exists $self->{_fcntl}; - $@ = ''; - $self->{Fast_io} = 0; - return undef; - } - - 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 undef; - } - - $self->{Fast_io} = 1; - my $newflags = $self->{_fcntl} = $fcntl; - $newflags |= O_NONBLOCK; - fcntl( $socket, F_SETFL, $newflags ); -} - -# removed -sub EnableServerResponseInLiteral { undef } - -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; - my $date = $class =~ /^\d+$/ ? $class : shift; # method or function? - my @date = gmtime($date); - - #Date: Fri, 09 Jul 1999 13:10:55 -0000 - sprintf( - "%s, %02d %s %04d %02d:%02d:%02d -%04d", - $dow[ $date[6] ], - $date[3], - $mnt[ $date[4] ], - $date[5] + 1900, - $date[2], $date[1], $date[0], $date[8] - ); -} - -# The following methods create valid dates for use in IMAP search strings -# - provide Rfc2060* methods/functions for backwards compatibility -sub Rfc2060_date { - $_[0] =~ /^\d+$/ ? Rfc3501_date(@_) : shift->Rfc3501_date(@_); -} - -sub Rfc3501_date { - my $class = shift; - my $stamp = $class =~ /^\d+$/ ? $class : shift; - my @date = gmtime($stamp); - - # 11-Jan-2000 - sprintf( "%02d-%s-%04d", $date[3], $mnt[ $date[4] ], $date[5] + 1900 ); -} - -sub Rfc2060_datetime($;$) { - $_[0] =~ /^\d+$/ ? Rfc3501_datetime(@_) : shift->Rfc3501_datetime(@_); -} - -sub Rfc3501_datetime($;$) { - my $class = shift; - my $stamp = $class =~ /^\d+$/ ? $class : shift; - my $zone = shift || '+0000'; - my @date = gmtime($stamp); - - # 11-Jan-2000 04:04:04 +0000 - sprintf( - "%02d-%s-%04d %02d:%02d:%02d %s", - $date[3], - $mnt[ $date[4] ], - $date[5] + 1900, - $date[2], $date[1], $date[0], $zone - ); -} - -# Change CRLF into \n -sub Strip_cr { - my $class = shift; - if ( !ref $_[0] && @_ == 1 ) { - ( my $string = $_[0] ) =~ s/$CRLF/\n/og; - return $string; - } - - return wantarray - ? map { s/$CRLF/\n/og; $_ } ( ref $_[0] ? @{ $_[0] } : @_ ) - : [ map { s/$CRLF/\n/og; $_ } ( 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] }; - } - - return $oldclear; -} - -# read-only access to the transaction number -sub Transaction { shift->Count } - -# remove doubles from list -sub _remove_doubles(@) { - my %seen; - grep { !$seen{$_}++ } @_; -} - -# the constructor: -sub new { - my $class = shift; - my $self = { - LastError => "", - Uid => 1, - Count => 0, - Fast_io => 1, - Clear => 5, - Keepalive => 0, - Maxcommandlength => 1000, - Maxtemperrors => 'unlimited', - State => Unconnected, - Authmechanism => 'LOGIN', - Port => 143, - Timeout => 600, - History => {}, - }; - while (@_) { - my $k = ucfirst lc shift; - my $v = shift; - $self->{$k} = $v if defined $v; - } - bless $self, ref($class) || $class; - - if ( my $sup = $self->{Supportedflags} ) { # unpack into case-less HASH - my %sup = map { m/^\\?(\S+)/ ? lc $1 : () } @$sup; - $self->{Supportedflags} = \%sup; - } - - $self->{Debug_fh} ||= \*STDERR; - CORE::select( ( select( $self->{Debug_fh} ), $|++ )[0] ); - - if ( $self->Debug ) { - $self->_debug( "Started at " . localtime() ); - $self->_debug("Using Mail::IMAPClient version $VERSION on perl $]"); - } - - # BUG? return undef on Socket() failure? - $self->Socket( $self->{Socket} ) - if $self->{Socket}; - - if ( $self->{Rawsocket} ) { - my $sock = delete $self->{Rawsocket}; - - # Ignore Rawsocket if Socket is set. BUG? should we carp/croak? - $self->RawSocket($sock) unless $self->{Socket}; - } - - !$self->{Socket} && $self->{Server} ? $self->connect : $self; -} - -sub connect(@) { - my $self = shift; - - # BUG? We should restrict which keys can be passed/set here. - %$self = ( %$self, @_ ) if @_; - - my $server = $self->Server; - my $port = $self->Port; - my @timeout = $self->Timeout ? ( Timeout => $self->Timeout ) : (); - my $sock; - - if ( File::Spec->file_name_is_absolute($server) ) { - $self->_debug("Connecting to unix socket $server @timeout"); - $sock = IO::Socket::UNIX->new( - Peer => $server, - Debug => $self->Debug, - @timeout - ); - } - else { - my $ioclass = "IO::Socket::INET"; - if ( $self->Ssl ) { - $ioclass = "IO::Socket::SSL"; - eval "require $ioclass"; - if ($@) { - $self->LastError("Unable to load '$ioclass' for Ssl: $@"); - return undef; - } - } - - $self->_debug("Connecting via $ioclass to $server:$port @timeout"); - $sock = $ioclass->new( - PeerAddr => $server, - PeerPort => $port, - Proto => 'tcp', - Debug => $self->Debug, - @timeout - ); - } - - unless ($sock) { - $self->LastError("Unable to connect to $server: $@"); - return undef; - } - - $self->_debug( "Connected to $server" . ( $! ? " errno($!)" : "" ) ); - $self->Socket($sock); -} - -sub RawSocket(;$) { - my ( $self, $sock ) = @_; - defined $sock - or return $self->{Socket}; - - $self->{Socket} = $sock; - $self->{_select} = IO::Select->new($sock); - - delete $self->{_fcntl}; - $self->Fast_io( $self->Fast_io ); - - $sock; -} - -sub Socket($) { - my ( $self, $sock ) = @_; - defined $sock - or return $self->{Socket}; - - $self->RawSocket($sock); - $self->State(Connected); - - setsockopt( $sock, SOL_SOCKET, SO_KEEPALIVE, 1 ) if $self->Keepalive; - - # LastError may be set by _read_line via _get_response - # look for "* (OK|BAD|NO|PREAUTH)" - my $code = $self->_get_response( '*', 'PREAUTH' ) or return undef; - - if ( $code eq 'BYE' || $code eq 'NO' ) { - $self->State(Unconnected); - return undef; - } - elsif ( $code eq 'PREAUTH' ) { - $self->State(Authenticated); - return $self; - } - - $self->User && $self->Password ? $self->login : $self; -} - -sub login { - my $self = shift; - my $auth = $self->Authmechanism; - return $self->authenticate( $auth, $self->Authcallback ) - if $auth && $auth ne 'LOGIN'; - - my $passwd = $self->Password; - my $id = $self->User; - - return undef unless ( defined($passwd) and defined($id) ); - - # BUG: should use Quote() with $passwd and $id - if ( $passwd eq "" or $passwd =~ m/\W/ ) { - $passwd =~ s/(["\\])/\\$1/g; - $passwd = qq("$passwd"); - } - - $id = qq("$id") if $id !~ /^".*"$/; - - $self->_imap_command("LOGIN $id $passwd") - or return undef; - - $self->State(Authenticated); - $self; -} - -sub noop { - my ( $self, $user ) = @_; - $self->_imap_command("NOOP") ? $self->Results : undef; -} - -sub proxyauth { - my ( $self, $user ) = @_; - $self->_imap_command("PROXYAUTH $user") ? $self->Results : undef; -} - -sub separator { - my ( $self, $target ) = @_; - unless ( defined $target ) { - - # separator is namespace's 1st thing's 1st thing's 2nd thing: - my $ns = $self->namespace or return undef; - if ($ns) { - my $sep = $ns->[0][0][1]; - return $sep if $sep; - } - $target = ''; - } - - return $self->{separators}{$target} - if exists $self->{separators}{$target}; - - my $list = $self->list( undef, $target ) or return undef; - - foreach my $line (@$list) { - my $rec = $self->_list_or_lsub_response_parse($line); - next unless defined $rec->{name}; - $self->{separators}{ $rec->{name} } = $rec->{delim}; - } - return $self->{separators}{$target}; -} - -# BUG? caller gets empty list even if Error -# - returning an array with a single undef value seems even worse though -sub sort { - my ( $self, $crit, @a ) = @_; - - $crit =~ /^\(.*\)$/ # wrap criteria in parens - or $crit = "($crit)"; - - my @hits; - if ( $self->_imap_uid_command( SORT => $crit, @a ) ) { - my @results = $self->History; - foreach (@results) { - chomp; - s/$CR$//; - s/^\*\s+SORT\s+// or next; - push @hits, grep /\d/, split; - } - } - return wantarray ? @hits : \@hits; -} - -sub _list_or_lsub { - my ( $self, $cmd, $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($cmd "$reference" $target)) - or return undef; - - # cleanup any literal data that may be returned - my $ret = wantarray ? [ $self->History ] : $self->Results; - if ($ret) { - my $cmd = wantarray ? undef : shift @$ret; - $self->_list_response_preprocess($ret); - unshift( @$ret, $cmd ) if defined($cmd); - } - - #return wantarray ? $self->History : $self->Results; - return wantarray ? @$ret : $ret; -} - -sub list { shift->_list_or_lsub( "LIST", @_ ) } -sub lsub { shift->_list_or_lsub( "LSUB", @_ ) } - -sub xlist { - my ($self) = @_; - return undef unless $self->has_capability("XLIST"); - shift->_list_or_lsub( "XLIST", @_ ); -} - -sub _folders_or_subscribed { - my ( $self, $method, $what ) = @_; - my @folders; - - # do BLOCK allowing use of "last if undef/error" and avoiding dup code - do { - { - my @list; - if ($what) { - my $sep = $self->separator($what); - last unless defined $sep; - - my $whatsub = $what =~ m/\Q${sep}\E$/ ? "$what*" : "$what$sep*"; - - my $tref = $self->$method( undef, $whatsub ) or last; - shift @$tref; # remove command - push @list, @$tref; - - my $exists = $self->exists($what) or last; - if ($exists) { - $tref = $self->$method( undef, $what ) or last; - shift @$tref; # remove command - push @list, @$tref; - } - } - else { - my $tref = $self->$method( undef, undef ) or last; - shift @$tref; # remove command - push @list, @$tref; - } - - foreach my $resp (@list) { - my $rec = $self->_list_or_lsub_response_parse($resp); - next unless defined $rec->{name}; - push @folders, $rec->{name}; - } - } - }; - - my @clean = _remove_doubles @folders; - return wantarray ? @clean : \@clean; -} - -sub folders { - my ( $self, $what ) = @_; - - return wantarray ? @{ $self->{Folders} } : $self->{Folders} - if !$what && $self->{Folders}; - - my @folders = $self->_folders_or_subscribed( "list", $what ); - $self->{Folders} = \@folders unless $what; - return wantarray ? @folders : \@folders; -} - -sub xlist_folders { - my ($self) = @_; - my $xlist = $self->xlist; - return undef unless defined $xlist; - - my %xlist; - my $xlist_re = qr/\A\\(Inbox|AllMail|Trash|Drafts|Sent|Spam|Starred)\Z/; - - for my $resp (@$xlist) { - my $rec = $self->_list_or_lsub_response_parse($resp); - next unless defined $rec->{name}; - for my $attr ( @{ $rec->{attrs} } ) { - $xlist{$1} = $rec->{name} if ( $attr =~ $xlist_re ); - } - } - - return wantarray ? %xlist : \%xlist; -} - -sub subscribed { - my ( $self, $what ) = @_; - my @folders = $self->_folders_or_subscribed( "lsub", $what ); - return wantarray ? @folders : \@folders; -} - -# BUG? cleanup escaping/quoting -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; - - return wantarray ? $self->History : $self->Results; -} - -# BUG? cleanup escaping/quoting -sub setacl { - my ( $self, $target, $user, $acl ) = @_; - $target ||= $self->Folder; - $target = $self->Massage($target); - - $user ||= $self->User; - $user =~ s/^"(.*)"$/$1/; - $user =~ s/"/\\"/g; - - $acl =~ s/^"(.*)"$/$1/; - $acl =~ s/"/\\"/g; - - $self->_imap_command(qq(SETACL $target "$user" "$acl")) - or return undef; - - return 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?$CRLF$//o; - 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"); - } - } - return $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; - return 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") - or return undef; - - $self->State(Selected); - $self->Folder($target); - return $old || $self; # ??$self?? -} - -sub message_string { - my ( $self, $msg ) = @_; - - return undef unless defined $self->imap4rev1; - my $peek = $self->Peek ? '.PEEK' : ''; - my $cmd = $self->imap4rev1 ? "BODY$peek\[]" : "RFC822$peek"; - - $self->fetch( $msg, $cmd ) - or return undef; - - my $string = $self->_transaction_literals; - - unless ( $self->Ignoresizeerrors ) { # Check size with expected size - my $expected_size = $self->size($msg); - return undef unless defined $expected_size; - - # RFC822.SIZE may be wrong, see RFC2683 3.4.5 "RFC822.SIZE" - if ( length($string) != $expected_size ) { - $self->LastError( "message_string() " - . "expected $expected_size bytes but received " - . length($string) - . " you may need the IgnoreSizeErrors option" ); - return undef; - } - } - - return $string; -} - -sub bodypart_string { - my ( $self, $msg, $partno, $bytes, $offset ) = @_; - - unless ( $self->imap4rev1 ) { - $self->LastError( "Unable to get body part; server " - . $self->Server - . " does not support IMAP4REV1" ) - unless $self->LastError; - return undef; - } - - $offset ||= 0; - my $cmd = "BODY" - . ( $self->Peek ? '.PEEK' : '' ) - . "[$partno]" - . ( $bytes ? "<$offset.$bytes>" : '' ); - - $self->fetch( $msg, $cmd ) - or return undef; - - $self->_transaction_literals; -} - -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; - - return undef unless defined $self->imap4rev1; - my $peek = $self->Peek ? '.PEEK' : ''; - my $cmd = $self->imap4rev1 ? "BODY$peek\[]" : "RFC822$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 ] ); - - my $feedback = $self->_send_line($string); - unless ($feedback) { - $self->LastError( "Error sending '$string': " . $self->LastError ); - return undef; - } - - # look for " (OK|BAD|NO)" - my $code = $self->_get_response( { outref => $handle }, $trans ) - or return undef; - - return $code eq 'OK' ? $self : undef; -} - -sub message_uid { - my ( $self, $msg ) = @_; - - my $ref = $self->fetch( $msg, "UID" ) or return undef; - foreach (@$ref) { - return $1 if m/\(UID\s+(\d+)\s*\)$CR?$/o; - } - return undef; -} - -#???? this code is very clumsy, and currently probably broken. -# Why not use a pipe??? -# Is a quadratic slowdown not much simpler and better??? -# Shouldn't the slowdowns extend over multiple messages? -# --> create clean read and write methods - -sub migrate { - my ( $self, $peer, $msgs, $folder ) = @_; - my $toSock = $peer->Socket, my $fromSock = $self->Socket; - my $bufferSize = $self->Buffer || 4096; - - local $SIG{PIPE} = 'IGNORE'; # avoid SIGPIPE on syswrite, handle as error - - unless ( $peer and $peer->IsConnected ) { - $self->LastError( "Invalid or unconnected peer " - . 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'; - return undef unless defined $msgs; - - my $range = $self->Range($msgs); - my $clear = $self->Clear; - - $self->_debug("Migrating the following msgs from $folder: $range"); - MSG: - foreach my $mid ( $range->unfold ) { - $self->_debug("Migrating message $mid in folder $folder"); - - my $leftSoFar = my $size = $self->size($mid); - return undef unless defined $size; - - # fetch internaldate and flags of original message: - my $intDate = $self->internaldate($mid); - return undef unless defined $intDate; - - 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" ) - if $self->Debug; - - $peer->_debug( "Copied message $mid in folder $folder from " - . $self->User . '@' - . $self->Server - . ". New message UID is $new_mid" ) - if $peer->Debug; - - next MSG; - } - - # otherwise break it up into digestible pieces: - return undef unless defined $self->imap4rev1; - my ( $cmd, $extract_size ); - if ( $self->imap4rev1 ) { - $cmd = $self->Peek ? 'BODY.PEEK[]' : 'BODY[]'; - $extract_size = sub { $_[0] =~ /\(.*BODY\[\]<\d+> \{(\d+)\}/i; $1 }; - } - else { - $cmd = $self->Peek ? 'RFC822.PEEK' : 'RFC822'; - $extract_size = 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"); - - $peer->_record( $ptrans, [ 0, "INPUT", $pstring ] ); - unless ( $peer->_send_line($pstring) ) { - $self->LastError( "Error sending '$pstring': " . $self->LastError ); - return undef; - } - - # Get the "+ Go ahead" response: - my $code; - until ( defined $code ) { - my $readSoFar = 0; - my $fromBuffer = ''; - $readSoFar += sysread( $toSock, $fromBuffer, 1, $readSoFar ) || 0 - until $fromBuffer =~ /$CRLF/o; - - $code = - $fromBuffer =~ /^\+/ ? 'OK' - : $fromBuffer =~ /^\d+\s+(BAD|NO|OK)\b/ ? $1 - : undef; - - $peer->_debug("$folder: received $fromBuffer from server"); - - if ( $fromBuffer =~ /^(\*\s+BYE.*?)$CR?$LF/oi ) { - $self->State(Unconnected); - $self->LastError($1); - return undef; - } - - # ... 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 'OK' ) { - $self->_debug("Error writing to target host: $@"); - 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 offset zero): - my $position = 0; - my $chunkCount = 0; - my $readSoFar = 0; - while ( $leftSoFar > 0 ) { - my $take = min $leftSoFar, $bufferSize; - my $newstring = "$trans $string<$position.$take>"; - - $self->_record( $trans, [ 0, "INPUT", $newstring ] ); - $self->_debug("Issuing migration command: $newstring"); - - unless ( $self->_send_line($newstring) ) { - $self->LastError( "Error sending '$newstring' to source IMAP: " - . $self->LastError ); - return undef; - } - - my $chunk; - my $fromBuffer = ""; - until ( $chunk = $extract_size->($fromBuffer) ) { - $fromBuffer = ''; - sysread( $fromSock, $fromBuffer, 1, length $fromBuffer ) - until $fromBuffer =~ /$CRLF$/o; - - $self->_record( $trans, [ 0, "OUTPUT", $fromBuffer ] ); - - if ( $fromBuffer =~ /^$trans\s+(?:NO|BAD)/ ) { - $self->LastError($fromBuffer); - next MIGMSG; - } - elsif ( $fromBuffer =~ /^$trans\s+OK/ ) { - $self->LastError( "Unexpected good return code " - . "from source host: $fromBuffer" ); - next MIGMSG; - } - } - - $fromBuffer = ""; - while ( $readSoFar < $chunk ) { - $readSoFar += - sysread( $fromSock, $fromBuffer, $chunk - $readSoFar, - $readSoFar ) - || 0; - } - - my $wroteSoFar = 0; - my $temperrs = 0; - my $waittime = .02; - my $maxwrite = 0; - 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 ( $! == EPIPE or $! == ECONNRESET ) { - $self->State(Unconnected); - $self->LastError("Write failed '$!'"); - return undef; - } - - if ( $! == EAGAIN || $ret == 0 ) { - if ( defined $maxagain && $temperrs++ > $maxagain ) { - $self->LastError("Persistent error '$!'"); - return undef; - } - - $waittime = $self->_optimal_sleep( $maxwrite, $waittime, - \@previous_writes ); - next; - } - - $self->State(Unconnected) - if ( $! == EPIPE or $! == ECONNRESET ); - $self->LastError("Write failed '$!'"); - return; # no luck - } - - $peer->_debug( - "Chunk $chunkCount: wrote $wroteSoFar (of $chunk)"); - } - } - - $position += $readSoFar; - $leftSoFar -= $readSoFar; - my $fromBuffer = ""; - - # Finish up reading the server fetch response from the source system: - # look for " (OK|BAD|NO)" - $self->_debug("Reading from source: expecting 'OK' response"); - $code = $self->_get_response($trans) or return undef; - return undef unless $code eq 'OK'; - - # Now let's send a CRLF to the peer to signal end of APPEND cmd: - unless ( $peer->_send_bytes( \$CRLF ) ) { - $self->LastError( "Error appending CRLF: " . $self->LastError ); - return undef; - } - - # Finally, let's get the new message's UID from the peer: - # look for " (OK|BAD|NO)" - $peer->_debug("Reading from target: expect new uid in response"); - $code = $peer->_get_response($ptrans) or return undef; - - my $new_mid = "unknown"; - if ( $code eq 'OK' ) { - my $data = join '', $self->Results; - - # look for something like return size or self if no size found: - # OK [APPENDUID ] APPEND completed - my $ret = $data =~ m#\s+(\d+)\]# ? $1 : undef; - $new_mid = $ret; - } - - if ( $self->Debug ) { - $self->_debug( "Copied message $mid in folder $folder to " - . $peer->User . '@' - . $peer->Server - . ". New Message UID is $new_mid" ); - - $peer->_debug( "Copied message $mid in folder $folder from " - . $self->User . '@' - . $self->Server - . ". New Message UID is $new_mid" ); - } - } - - return $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, $waittime; - 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]" ) - or return undef; - - my $string = join '', map { $_->[DATA] } - grep { $self->_is_literal($_) } @$ref; - - return $string - if $string; - - my $head; - while ( $head = shift @$ref ) { - $self->_debug("body_string: head = '$head'"); - - 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 =~ /\)$CRLF$/o ) # (-: vi - || !grep /\)$CRLF$/o, @$ref; - - if ( $head =~ /BODY\[TEXT\]\s*$/i ) { # Next line is a literal - $string .= shift @$ref while @$ref; - $self->_debug("String is now $string") - if $self->Debug; - } - - $string; -} - -sub examine { - my ( $self, $target ) = @_; - defined $target or return undef; - - $self->_imap_command( 'EXAMINE ' . $self->Massage($target) ) - or return undef; - - my $old = $self->Folder; - $self->Folder($target); - $self->State(Selected); - $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; - $self->_imap_command( { addtag => 0, tag => $count }, "DONE" ) - or return undef; - return $self->Results; -} - -sub tag_and_run { - my ( $self, $string, $good ) = @_; - $self->_imap_command( $string, $good ) or return undef; - return $self->Results; -} - -sub reconnect { - my $self = shift; - - if ( $self->IsAuthenticated ) { - $self->_debug("reconnect called but already authenticated"); - return $self; - } - - my $einfo = $self->LastError || ""; - $self->_debug( "reconnecting to ", $self->Server, ", last error: $einfo" ); - - # reconnect and select appropriate folder - $self->connect or return undef; - - return ( defined $self->Folder ) ? $self->select( $self->Folder ) : $self; -} - -# wrapper for _imap_command_do to enable retrying on lost connections -sub _imap_command { - my $self = shift; - - my $tries = 0; - my $retry = $self->Reconnectretry || 0; - my ( $rc, @err ); - - # LastError (if set) will be overwritten masking any earlier errors - while ( $tries++ <= $retry ) { - - # do command on the first try or if Connected (reconnect ongoing) - if ( $tries == 1 or $self->IsConnected ) { - $rc = $self->_imap_command_do(@_); - push( @err, $self->LastError ) if $self->LastError; - } - - if ( !defined($rc) and $retry and $self->IsUnconnected ) { - last - unless ( - $! == EPIPE - or $! == ECONNRESET - or $self->LastError =~ /(?:timeout|error) waiting\b/ - or $self->LastError =~ /(?:socket closed|\* BYE)\b/ - - # BUG? reconnect if caller ignored/missed earlier errors? - # or $self->LastError =~ /NO not connected/ - ); - if ( $self->reconnect ) { - $self->_debug("reconnect successful on try #$tries"); - } - else { - $self->_debug("reconnect failed on try #$tries"); - push( @err, $self->LastError ) if $self->LastError; - } - } - else { - last; - } - } - - unless ($rc) { - my ( %seen, @keep, @info ); - - foreach my $str (@err) { - my ( $sz, $len ) = ( 96, length($str) ); - $str =~ s/$CR?$LF$/\\n/omg; - if ( !$self->Debug and $len > $sz * 2 ) { - my $beg = substr( $str, 0, $sz ); - my $end = substr( $str, -$sz, $sz ); - $str = $beg . "..." . $end; - } - next if $seen{$str}++; - push( @keep, $str ); - } - foreach my $msg (@keep) { - push( @info, $msg . ( $seen{$msg} > 1 ? " ($seen{$msg}x)" : "" ) ); - } - $self->LastError( join( "; ", @info ) ); - } - - return $rc; -} - -# _imap_command_do runs a command, inserting a tag and CRLF as requested -# options: -# addcrlf => 0|1 - suppress adding CRLF to $string -# addtag => 0|1 - suppress adding $tag to $string -# tag => $tag - use this $tag instead of incrementing count -sub _imap_command_do { - my $self = shift; - my $opt = ref( $_[0] ) eq "HASH" ? shift : {}; - my $string = shift or return undef; - my $good = shift; - - $opt->{addcrlf} = 1 unless exists $opt->{addcrlf}; - $opt->{addtag} = 1 unless exists $opt->{addtag}; - - # reset error in case the last error was non-fatal but never cleared - if ( $self->LastError ) { - - #DEBUG $self->_debug( "Reset LastError: " . $self->LastError ); - $self->LastError(undef); - } - - my $clear = $self->Clear; - $self->Clear($clear) - if $self->Count >= $clear && $clear > 0; - - my $count = $self->Count( $self->Count + 1 ); - my $tag = $opt->{tag} || $count; - $string = "$tag $string" if $opt->{addtag}; - - # for APPEND (append_string) only log first line of command - my $logstr = ( $string =~ /^($tag\s+APPEND\s+.*?)$CR?$LF/ ) ? $1 : $string; - - # BUG? use $self->_next_index($tag) ? or 0 ??? - # $self->_record($tag, [$self->_next_index($tag), "INPUT", $logstr] ); - $self->_record( $count, [ 0, "INPUT", $logstr ] ); - - # $suppress (adding CRLF) set to 0 if $opt->{addcrlf} is TRUE - unless ( $self->_send_line( $string, $opt->{addcrlf} ? 0 : 1 ) ) { - $self->LastError( "Error sending '$logstr': " . $self->LastError ); - return undef; - } - - # look for " (OK|BAD|NO|$good)" (or "+..." if $good is '+') - my $code = $self->_get_response( $tag, $good ) or return undef; - - if ( $code eq 'OK' ) { - return $self; - } - elsif ( $good and $code eq $good ) { - return $self; - } - else { - return undef; - } -} - -# _get_response get IMAP response optionally send data somewhere -# options: -# outref => GLOB|CODE - reference to send output to (see _read_line) -sub _get_response { - my $self = shift; - my $opt = ref( $_[0] ) eq "HASH" ? shift : {}; - my $tag = shift; - my $good = shift; - - # tag can be a ref (compiled regex) or we quote it or default to \S+ - my $qtag = ref($tag) ? $tag : defined($tag) ? quotemeta($tag) : qr/\S+/; - my $qgood = ref($good) ? $good : defined($good) ? quotemeta($good) : undef; - my @readopt = defined( $opt->{outref} ) ? ( $opt->{outref} ) : (); - - my ( $count, $out, $code, $byemsg ) = ( $self->Count, [], undef, undef ); - until ($code) { - my $output = $self->_read_line(@readopt) or return undef; - $out = $output; # keep last response just in case - - # not using last on first match? paranoia or right thing? - # only uc() when match is not on case where $tag|$good is a ref() - foreach my $o (@$output) { - $self->_record( $count, $o ); - $self->_is_output($o) or next; - - my $data = $o->[DATA]; - if ( $good and $good ne '+' and $data =~ /^$qtag\s+($qgood)/i ) { - $code = $1; - $code = uc($code) unless ref($good); - } - elsif ( $good and $good eq '+' and $data =~ /^$qgood/ ) { - $code = $good; - } - elsif ( $tag eq '+' and $data =~ /^$qtag/ ) { - $code = $tag; - } - elsif ( $data =~ /^$qtag\s+(OK|BAD|NO)\b/i ) { - $code = uc($1); - $self->LastError($data) unless ( $code eq 'OK' ); - } - elsif ( $data =~ /^\*\s+(BYE)\b/i ) { - $code = uc($1); - $byemsg = $data; - } - } - } - - if ($code) { - $code = uc($code) unless ( $good and $code eq $good ); - - # on successful LOGOUT $code is OK (not BYE!) see RFC 3501 sect 7.1.5 - if ( $code eq 'BYE' ) { - $self->State(Unconnected); - $self->LastError($byemsg) if $byemsg; - } - } - elsif ( !$self->LastError ) { - my $info = "unexpected response: " . join( " ", @$out ); - $self->LastError($info); - } - - return $code; -} - -sub _imap_uid_command { - my ( $self, $cmd ) = ( shift, 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 $tag = $string =~ /^(\S+) / ? $1 : undef; - unless ($tag) { - $self->LastError("No tag found in string passed to run(): $string"); - return undef; - } - - $self->_imap_command( { addtag => 0, addcrlf => 0, tag => $tag }, $string ) - or return undef; - - $self->{History}{$tag} = $self->{History}{ $self->Count } - unless $tag eq $self->Count; - - return $self->Results; -} - -# _record saves the conversation into the History structure: -sub _record { - my ( $self, $count, $array ) = @_; - if ( $array->[DATA] =~ /^\d+ LOGIN/i && !$self->Showcredentials ) { - $array->[DATA] =~ s/LOGIN.*/LOGIN XXXXXXXX XXXXXXXX/i; - } - - push @{ $self->{History}{$count} }, $array; -} - -# _send_line handles literal data and supports the Prewritemethod -sub _send_line { - my ( $self, $string, $suppress ) = ( shift, shift, shift ); - - $string =~ s/$CR?$LF?$/$CRLF/o - unless $suppress; - - # handle case where string contains a literal - if ( $string =~ s/^([^$LF\{]*\{\d+\}$CRLF)(?=.)//o ) { - my $first = $1; - $self->_debug("Sending literal: $first\tthen: $string"); - $self->_send_line($first) or return undef; - - # look for " OK|NO|BAD" or "+..." - my $code = $self->_get_response( qr(\S+), '+' ) or return undef; - return undef unless $code eq '+'; - } - - # non-literal part continues... - unless ( $self->IsConnected ) { - $self->LastError("NO not connected"); - return undef; - } - - if ( my $prew = $self->Prewritemethod ) { - $string = $prew->( $self, $string ); - } - - $self->_debug("Sending: $string"); - $self->_send_bytes( \$string ); -} - -sub _send_bytes($) { - my ( $self, $byteref ) = @_; - my ( $total, $temperrs, $maxwrite ) = ( 0, 0, 0 ); - my $waittime = .02; - my @previous_writes; - - my $maxagain = $self->Maxtemperrors || 10; - undef $maxagain if $maxagain eq 'unlimited'; - - local $SIG{PIPE} = 'IGNORE'; # handle SIGPIPE as normal error - - while ( $total < length $$byteref ) { - my $written = - syswrite( $self->Socket, $$byteref, length($$byteref) - $total, - $total ); - - if ( defined $written ) { - $temperrs = 0; - $total += $written; - next; - } - - if ( $! == EAGAIN ) { - if ( defined $maxagain && $temperrs++ > $maxagain ) { - $self->LastError("Persistent error '$!'"); - return undef; - } - - $waittime = - $self->_optimal_sleep( $maxwrite, $waittime, \@previous_writes ); - next; - } - - # Unconnected might be apropos for more than just these? - my $emsg = $! ? "$!" : "no error caught"; - $self->State(Unconnected) if ( $! == EPIPE or $! == ECONNRESET ); - $self->LastError("Write failed '$emsg'"); - - return undef; # no luck - } - - $self->_debug("Sent $total bytes"); - return $total; -} - -# _read_line: read one line from the socket - -# It is also re-implemented in: message_to_file -# -# $output = $self->_read_line($literal_callback, $output_callback) -# Both input arguments 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 $socket = $self->Socket; - unless ( $self->IsConnected && $socket ) { - $self->LastError("NO not connected"); - return undef; - } - - my $iBuffer = ""; - my $oBuffer = []; - my $index = $self->_next_index; - my $timeout = $self->Timeout; - my $readlen = $self->{Buffer} || 4096; - - until ( - @$oBuffer # there's stuff in output buffer: - && $oBuffer->[-1][TYPE] eq 'OUTPUT' # that thing is an output line: - && $oBuffer->[-1][DATA] =~ - /$CR?$LF$/o # the last thing there has cr-lf: - && !length $iBuffer # and the input buffer has been MT'ed: - ) - { - my $transno = $self->Transaction; - - if ($timeout) { - my $rc = _read_more( $socket, $timeout ); - unless ( $rc > 0 ) { - my $msg = - ( $rc ? "error" : "timeout" ) - . " waiting ${timeout}s for data from server" - . ( $! ? ": $!" : "" ); - $self->LastError($msg); - $self->_record( - $transno, - [ - $self->_next_index($transno), "ERROR", - "$transno * NO $msg" - ] - ); - $self->_disconnect; # BUG: can not handle timeouts gracefully - return undef; - } - } - - my $emsg; - my $ret = - $self->_sysread( $socket, \$iBuffer, $readlen, length $iBuffer ); - if ( $timeout && !defined $ret ) { - $emsg = "error while reading data from server: $!"; - $self->State(Unconnected) if ( $! == ECONNRESET ); - } - - if ( defined $ret && $ret == 0 ) { # Caught EOF... - $emsg = "socket closed while reading data from server"; - $self->State(Unconnected); - } - - # save errors and return - if ($emsg) { - $self->LastError($emsg); - $self->_record( - $transno, - [ - $self->_next_index($transno), "ERROR", "$transno * NO $emsg" - ] - ); - return undef; - } - - while ( $iBuffer =~ s/^(.*?$CR?$LF)//o ) # consume line - { - my $current_line = $1; - if ( $current_line !~ s/\s*\{(\d+)\}$CR?$LF$//o ) { - push @$oBuffer, [ $index++, 'OUTPUT', $current_line ]; - next; - } - - push @$oBuffer, [ $index++, 'OUTPUT', $current_line ]; - - ## handle LITERAL - # BLAH BLAH {nnn}$CRLF - # [nnn bytes of literally transmitted stuff] - # [part of line that follows literal data]$CRLF - - my $expected_size = $1; - - $self->_debug( "LITERAL: received literal in line " - . "$current_line of length $expected_size; attempting to " - . "retrieve from the " - . length($iBuffer) - . " bytes in: $iBuffer" ); - - my $litstring; - if ( length $iBuffer >= $expected_size ) { - - # already received all data - $litstring = substr $iBuffer, 0, $expected_size, ''; - } - else { # literal data still to arrive - $litstring = $iBuffer; - $iBuffer = ''; - - while ( $expected_size > length $litstring ) { - if ($timeout) { - my $rc = _read_more( $socket, $timeout ); - unless ( $rc > 0 ) { - my $msg = - ( $rc ? "error" : "timeout" ) - . " waiting ${timeout}s for literal data from server" - . ( $! ? ": $!" : "" ); - $self->LastError($msg); - $self->_record( - $transno, - [ - $self->_next_index($transno), "ERROR", - "$transno * NO $msg" - ] - ); - $self->_disconnect; # BUG: can not handle timeouts - return undef; - } - } - else { # 25 ms before retry - CORE::select( undef, undef, undef, 0.025 ); - } - - my $ret = $self->_sysread( - $socket, \$litstring, - $expected_size - length $litstring, - length $litstring - ); - - if ( $timeout && !defined $ret ) { - $emsg = "error while reading data from server: $!"; - $self->State(Unconnected) if ( $! == ECONNRESET ); - } - - # EOF: note IO::Socket::SSL does not support eof() - if ( defined $ret && $ret == 0 ) { - $emsg = "socket closed while reading data from server"; - $self->State(Unconnected); - } - - $self->_debug( "Received ret=" - . ( defined($ret) ? "$ret " : " " ) - . length($litstring) - . " of $expected_size" ); - - # save errors and return - if ($emsg) { - $self->LastError($emsg); - $self->_record( - $transno, - [ - $self->_next_index($transno), "ERROR", - "$transno * NO $emsg" - ] - ); - $litstring = "" unless defined $litstring; - $self->_debug( "ERROR while processing LITERAL, " - . " buffer=\n" - . $litstring - . "\n" ); - return undef; - } - } - } - - if ( !$literal_callback ) { ; } - elsif ( UNIVERSAL::isa( $literal_callback, 'GLOB' ) ) { - print $literal_callback $litstring; - $litstring = ""; - } - elsif ( UNIVERSAL::isa( $literal_callback, 'CODE' ) ) { - $literal_callback->($litstring) - if defined $litstring; - } - else { - $self->LastError( "'$literal_callback' is an " - . "invalid callback; must be a filehandle or CODE" ); - } - - push @$oBuffer, [ $index++, 'LITERAL', $litstring ]; - } - } - - $self->_debug( "Read: " . join "", map { "\t" . $_->[DATA] } @$oBuffer ); - @$oBuffer ? $oBuffer : undef; -} - -sub _sysread($$$$) { - my ( $self, $fh, $buf, $len, $off ) = @_; - my $rm = $self->Readmethod; - $rm ? $rm->(@_) : sysread( $fh, $$buf, $len, $off ); -} - -sub _read_more($$) { - my ( $socket, $timeout ) = @_; - - # IO::Socket::SSL buffers some data internally, so there might be some - # data available from the previous sysread of which the file-handle - # (used by select()) doesn't know of. - return 1 if $socket->isa("IO::Socket::SSL") && $socket->pending; - - my $rvec = ''; - vec( $rvec, fileno($socket), 1 ) = 1; - return CORE::select( $rvec, undef, $rvec, $timeout ); -} - -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 LastIMAPCommand(;$) { - my ( $self, $trans ) = @_; - my $msg = ( $self->_transaction($trans) )[0]; - $msg ? $msg->[DATA] : undef; -} - -sub History(;$) { - my ( $self, $trans ) = @_; - my ( $cmd, @a ) = $self->_trans_data($trans); - return wantarray ? @a : \@a; -} - -sub Results(;$) { - my ( $self, $trans ) = @_; - my @a = $self->_trans_data($trans); - return wantarray ? @a : \@a; -} - -# Don't know what it does, but used a few times. -sub _transaction_literals() { - my $self = shift; - join '', map { $_->[DATA] } - grep { $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/([\\\(\)"$CRLF])/\\$1/og; - push @a, qq("$line->[DATA]"); - } - else { push @a, $line->[DATA] } - } - - shift @a; # remove cmd - return wantarray ? @a : \@a; -} - -sub Unescape { - my $whatever = $_[1]; - $whatever =~ s/\\([\\\(\)"$CRLF])/$1/og; - $whatever; -} - -sub logout { - my $self = shift; - $self->_imap_command("LOGOUT"); - $self->_disconnect; -} - -sub _disconnect { - my $self = shift; - - delete $self->{Folders}; - delete $self->{_IMAP4REV1}; - $self->State(Unconnected); - if ( my $sock = delete $self->{Socket} ) { - eval { $sock->close }; - } - $self; -} - -# LIST/XLIST/LSUB Response -# Contents: name attributes, hierarchy delimiter, name -# Example: * LIST (\Noselect) "/" ~/Mail/foo -# NOTE: in _list_response_preprocess we append literal data so we need -# to be liberal about our matching of folder name data -sub _list_or_lsub_response_parse { - my ( $self, $resp ) = @_; - - return undef unless defined $resp; - my %info; - - $resp =~ s/\015?\012$//; - if ( - $resp =~ / ^\* \s+ (?:LIST|XLIST|LSUB) \s+ # * LIST|XLIST|LSUB - \( ([^\)]*) \) \s+ # (attrs) - (?: \" ([^"]*) \" | NIL ) \s # "delimiter" or NIL - (?:\s*\" (.*) \" | (.*) ) # "name" or name - /ix - ) - { - @info{qw(attrs delim name)} = - ( [ split( / /, $1 ) ], $2, defined($3) ? $self->Unescape($3) : $4 ); - } - return wantarray ? %info : \%info; -} - -# handle listeral data returned in list/lsub responses -# some example responses: -# * LIST () "/" "My Folder" # nothing to do here... -# * LIST () "/" {9} # the {9} is already removed by _read_line() -# Special % # we append this to the previous line -sub _list_response_preprocess { - my ( $self, $data ) = @_; - return undef unless defined $data; - - for ( my $m = 0 ; $m < @$data ; $m++ ) { - if ( $data->[$m] && $data->[$m] !~ /$CR?$LF$/o ) { - $self->_debug("concatenating '$data->[$m]' and '$data->[$m+1]'"); - $data->[$m] .= " " . $data->[ $m + 1 ]; - splice @$data, $m + 1, 1; - } - } - return $data; -} - -sub exists { - my ( $self, $folder ) = @_; - $self->status($folder) ? $self : undef; -} - -# Updated to handle embedded literal strings -sub get_bodystructure { - my ( $self, $msg ) = @_; - unless ( eval { require Mail::IMAPClient::BodyStructure; } ) { - $self->LastError("Unable to use get_bodystructure: $@"); - return undef; - } - - my $out = $self->fetch( $msg, "BODYSTRUCTURE" ) or return undef; - - my $bs = ""; - my $output = first { /BODYSTRUCTURE\s+\(/i } @$out; # Wee! ;-) - if ( $output =~ /$CRLF$/o ) { - $bs = eval { Mail::IMAPClient::BodyStructure->new($output) }; - } - else { - $self->_debug("get_bodystructure: reassembling original response"); - my $started = 0; - my $output = ''; - foreach my $o ( $self->_transaction ) { - next unless $self->_is_output_or_literal($o); - $started++ if $o->[DATA] =~ /BODYSTRUCTURE \(/i; - ; # Hi, vi! ;-) - $started or next; - - 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"); - } - eval { $bs = Mail::IMAPClient::BodyStructure->new($output) }; - } - - $self->_debug( - "get_bodystructure: msg $msg returns: " . ( $bs || "UNDEF" ) ); - $bs; -} - -# Updated to handle embedded literal strings -sub get_envelope { - my ( $self, $msg ) = @_; - unless ( eval { require Mail::IMAPClient::BodyStructure; } ) { - $self->LastError("Unable to use get_envelope: $@"); - return undef; - } - - my $out = $self->fetch( $msg, 'ENVELOPE' ) or return undef; - - my $bs = ""; - my $output = first { /ENVELOPE \(/i } @$out; # vi ;-) - - unless ($output) { - $self->LastError("Unable to use get_envelope: $@"); - return undef; - } - - if ( $output =~ /$CRLF$/o ) { - eval { $bs = Mail::IMAPClient::BodyStructure::Envelope->new($output) }; - } - else { - $self->_debug("get_envelope: reassembling original response"); - my $started = 0; - $output = ''; - foreach my $o ( $self->_transaction ) { - next unless $self->_is_output_or_literal($o); - $self->_debug("o->[DATA] is $o->[DATA]"); - - $started++ if $o->[DATA] =~ /ENVELOPE \(/i; # Hi, vi! ;-) - $started or next; - - if ( length($output) && $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"); - } - - eval { $bs = Mail::IMAPClient::BodyStructure::Envelope->new($output) }; - } - - $self->_debug( "get_envelope: msg $msg returns ref: " . $bs || "UNDEF" ); - $bs; -} - -# fetch( [$seq_set|ALL], @msg_data_items ) -sub fetch { - my $self = shift; - my $what = shift || "ALL"; - - my $take = $what; - if ( $what eq 'ALL' ) { - my $msgs = $self->messages or return undef; - $take = $self->Range($msgs); - } - elsif ( ref $what || $what =~ /^[,:\d]+\w*$/ ) { - $take = $self->Range($what); - } - - my ( @data, $cmd ); - my ( $seq_set, @fetch_att ) = $self->_split_sequence( $take, "FETCH", @_ ); - - for ( my $x = 0 ; $x <= $#$seq_set ; $x++ ) { - my $seq = $seq_set->[$x]; - $self->_imap_uid_command( FETCH => $seq, @fetch_att, @_ ) - or return undef; - my $res = $self->Results; - - # only keep last command and last response (* OK ...) - $cmd = shift(@$res); - pop(@$res) if ( $x != $#{$seq_set} ); - push( @data, @$res ); - } - - if ( $cmd and !wantarray ) { - $cmd =~ s/^(\d+\s+.*?FETCH\s+)\S+(\s*)/$1$take$2/; - unshift( @data, $cmd ); - } - - #wantarray ? $self->History : $self->Results; - return wantarray ? @data : \@data; -} - -# Some servers have a maximum command length. If Maxcommandlength is -# set, split a sequence to fit within the length restriction. -sub _split_sequence { - my ( $self, $take, @args ) = @_; - - # split take => sequence-set and (optional) fetch-att - my ( $seq, @att ) = split( / /, $take, 2 ); - - # use the entire sequence unless Maxcommandlength is set - my @seqs; - my $maxl = $self->Maxcommandlength; - if ($maxl) { - - # estimate command length, the sum of the lengths of: - # tag, command, fetch-att + $CRLF - push @args, $self->Transaction, $self->Uid ? "UID" : (), "\015\012"; - - # do not split on anything smaller than 64 chars - my $clen = length join( " ", @att, @args ); - my $diff = $maxl - $clen; - my $most = $diff > 64 ? $diff : 64; - - @seqs = ( $seq =~ m/(.{1,$most})(?:,|$)/g ) if defined $seq; - $self->_debug( "split_sequence: length($maxl-$clen) parts: ", - $#seqs + 1 ) - if ( $#seqs != 0 ); - } - else { - push( @seqs, $seq ) if defined $seq; - } - return \@seqs, @att; -} - -# fetch_hash( [$seq_set|ALL], @msg_data_items, [\%msg_by_ids] ) -sub fetch_hash { - my $self = shift; - my $uids = ref $_[-1] ? pop @_ : {}; - my @words = @_; - - # take an optional leading list of messages argument or default to - # ALL let fetch turn that list of messages into a msgref as needed - # fetch has similar logic for dealing with message list - my $msgs = 'ALL'; - if ( $words[0] ) { - if ( $words[0] eq 'ALL' || ref $words[0] ) { - $msgs = shift @words; - } - elsif ( $words[0] =~ s/^([,:\d]+)\s*// ) { - $msgs = $1; - shift @words if $words[0] eq ""; - } - } - - # message list (if any) is now removed from @words - my $what = join ' ', @words; - - for (@words) { - s/([\( ])FAST([\) ])/${1}FLAGS INTERNALDATE RFC822\.SIZE$2/i; -s/([\( ])FULL([\) ])/${1}FLAGS INTERNALDATE RFC822\.SIZE ENVELOPE BODY$2/i; - } - my %words = map { uc($_) => 1 } @words; - - my $output = $self->fetch( $msgs, "($what)" ) or return undef; - - while ( my $l = shift @$output ) { - next if $l !~ m/^\*\s(\d+)\sFETCH\s\(/g; - my ( $mid, $entry ) = ( $1, {} ); - my ( $key, $value ); - ATTR: - while ( $l !~ m/\G\s*\)\s*$/gc ) { - if ( $l =~ m/\G\s*([\w\d\.]+(?:\[[^\]]*\])?)\s*/gc ) { - $key = uc($1); - } - elsif ( !defined $key ) { - - # some kind of malformed response - $self->LastError("Invalid item name in FETCH response: $l"); - return undef; - } - - if ( $l =~ m/\G\s*$/gc ) { - $value = shift @$output; - $entry->{$key} = $value; - $l = shift @$output; - next ATTR; - } - elsif ( $l =~ m/\G(?:"([^"]+)"|([^()\s]+))\s*/gc ) { - $value = defined $1 ? $1 : $2; - $entry->{$key} = $value; - next ATTR; - } - elsif ( $l =~ m/\G\(/gc ) { - my $depth = 1; - $value = ""; - while ( $l =~ m/\G(\(|\)|[^()]+)/gc ) { - my $stuff = $1; - if ( $stuff eq "(" ) { - $depth++; - $value .= "("; - } - elsif ( $stuff eq ")" ) { - $depth--; - if ( $depth == 0 ) { - $entry->{$key} = $value; - next ATTR; - } - $value .= ")"; - } - else { - $value .= $stuff; - } - } - m/\G\s*/gc; - } - else { - $self->LastError("Invalid item value in FETCH response: $l"); - return undef; - } - } - - if ( $self->Uid ) { - $uids->{ $entry->{UID} } = $entry; - } - else { - $uids->{$mid} = $entry; - } - - for my $word ( keys %$entry ) { - next if exists $words{$word}; - - if ( my ($stuff) = $word =~ m/^BODY(\[.*)$/ ) { - next if exists $words{ "BODY.PEEK" . $stuff }; - } - - delete $entry->{$word}; - } - } - - return wantarray ? %$uids : $uids; -} - -sub store { - my ( $self, @a ) = @_; - delete $self->{Folders}; - $self->_imap_uid_command( STORE => @a ) - or return undef; - return wantarray ? $self->History : $self->Results; -} - -sub _imap_folder_command($$@) { - my ( $self, $command ) = ( shift, shift ); - delete $self->{Folders}; - my $folder = $self->Massage(shift); - - $self->_imap_command( join ' ', $command, $folder, @_ ) - or return undef; - - return wantarray ? $self->History : $self->Results; -} - -sub subscribe($) { shift->_imap_folder_command( SUBSCRIBE => @_ ) } -sub unsubscribe($) { shift->_imap_folder_command( UNSUBSCRIBE => @_ ) } -sub create($) { shift->_imap_folder_command( CREATE => @_ ) } - -sub delete($) { - my $self = shift; - $self->_imap_folder_command( DELETE => @_ ) or return undef; - $self->Folder(undef); - return wantarray ? $self->History : $self->Results; -} - -# rfc2086 -sub myrights($) { $_[0]->_imap_folder_command( MYRIGHTS => $_[1] ) } - -sub close { - my $self = shift; - delete $self->{Folders}; - $self->_imap_command('CLOSE') - or return undef; - return wantarray ? $self->History : $self->Results; -} - -sub expunge { - my ( $self, $folder ) = @_; - - return undef unless ( defined $folder or defined $self->Folder ); - - my $old = defined $self->Folder ? $self->Folder : ''; - - if ( !defined($folder) || $folder eq $old ) { - $self->_imap_command('EXPUNGE') - or return undef; - } - else { - $self->select($folder) or return undef; - my $succ = $self->_imap_command('EXPUNGE'); - - # if $old eq '' IMAP4 select should close $folder without EXPUNGE - return undef unless ( $self->select($old) and $succ ); - } - - return wantarray ? $self->History : $self->Results; -} - -sub uidexpunge { - my ( $self, $msgspec ) = ( shift, shift ); - - return undef unless $self->has_capability("UIDPLUS"); - - my $msg = - UNIVERSAL::isa( $msgspec, 'Mail::IMAPClient::MessageSet' ) - ? $msgspec - : $self->Range($msgspec); - - $msg->cat(@_) if @_; - - if ( $self->Uid ) { - $self->_imap_command("UID EXPUNGE $msg") - or return undef; - } - else { - $self->LastError("Uid must be enabled for uidexpunge"); - return undef; - } - - return wantarray ? $self->History : $self->Results; -} - -# BUG? cleanup escaping/quoting -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, $folder ) = ( shift, shift ); - defined $folder or return undef; - - my $which = @_ ? join( " ", @_ ) : 'MESSAGES'; - - my $box = $self->Massage($folder); - $self->_imap_command("STATUS $box ($which)") - or return undef; - - return wantarray ? $self->History : $self->Results; -} - -sub flags { - my ( $self, $msgspec ) = ( shift, shift ); - my $msg = - UNIVERSAL::isa( $msgspec, '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 $line ( $self->Results ) { - $self->_debug("flags: line = '$line'"); - if ( - $line =~ /\* \s+ (\d+) \s+ FETCH \s+ # * nnn FETCH - \( - (?:\s* UID \s+ (\d+) \s* )? # optional: UID nnn - FLAGS \s* \( (.*?) \) \s* # FLAGS (\Flag1 \Flag2) - (?:\s* UID \s+ (\d+) \s* )? # optional: UID nnn - \) - /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}; - return 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 : () } } @_; -} - -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; # message ids to headers - my $h; # fields for current msgid - my $field; # previous field name, for unfolding - my %fieldmap = map { ( lc($_) => $_ ) } @fields; - my $msgid; - - # some example responses: - # * OK Message 1 no longer exists - # * 1 FETCH (UID 26535 BODY[HEADER] "") - # * 5 FETCH (UID 30699 BODY[HEADER] {1711} - # header: value... - foreach my $header ( map { split /$CR?$LF/o } @$raw ) { - - # little problem: Windows2003 has UID as body, not in header - if ( - $header =~ s/^\* \s+ (\d+) \s+ FETCH \s+ - \( (.*?) BODY\[HEADER (?:\.FIELDS)? .*? \]\s*//ix - ) - { # start new message header - ( $msgid, my $msgattrs ) = ( $1, $2 ); - $h = {}; - if ( $self->Uid ) # undef when win2003 - { - $msgid = $msgattrs =~ m/\b UID \s+ (\d+)/x ? $1 : undef; - } - - $headers{$msgid} = $h if $msgid; - } - $header =~ /\S/ or next; # skip empty lines. - - # ( for vi - if ( $header =~ /^\)/ ) { # end of this message - undef $h; # inbetween headers - next; - } - elsif ( !$msgid && $header =~ /^\s*UID\s+(\d+)\s*\)/ ) { - $headers{$1} = $h; # finally found msgid, win2003 - undef $h; - next; - } - - unless ( defined $h ) { - $self->_debug("found data between fetch headers: $header"); - next; - } - - if ( $header and $header =~ s/^(\S+)\:\s*// ) { - $field = $fieldmap{ lc $1 } || $1; - push @{ $h->{$field} }, $header; - } - elsif ( $field and ref $h->{$field} eq 'ARRAY' ) { # folded header - $h->{$field}[-1] .= $header; - } - else { - - # show data if it is not like '"")' or '{123}' - $self->_debug("non-header data between fetch headers: $header") - if ( $header !~ /^(?:\s*\"\"\)|\{\d+\})$CR?$LF$/o ); - } - } - - # 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 =~ /\(MESSAGES\s+(\d+)\s*\)/i; - } - - 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 for '$how': $time"); - return undef; - } - - $self->_imap_uid_command( SEARCH => $how, $imapdate ) - or return undef; - - my @hits; - foreach ( $self->History ) { - chomp; - s/$CR?$LF$//o; - s/^\*\s+SEARCH\s+//i or next; - push @hits, grep /\d/, split; - } - $self->_debug("Hits are: @hits"); - return 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/$CR?$LF$//o; - s/^\*\s+SEARCH\s+//i or next; - push @hits, grep /\d/, split; - } - $self->_debug("Hits are now: @hits"); - - return wantarray ? @hits : \@hits; -} - -sub disconnect { shift->logout } - -sub _quote_search { - my ( $self, @args ) = @_; - my @ret; - foreach my $v (@args) { - if ( ref($v) eq "SCALAR" ) { - push( @ret, $$v ); - } - elsif ( exists $SEARCH_KEYS{ uc($_) } ) { - push( @ret, $v ); - } - elsif ( @args == 1 ) { - push( @ret, $v ); # <3.17 compat: caller responsible for quoting - } - else { - push( @ret, $self->Quote($v) ); - } - } - return @ret; -} - -sub search { - my ( $self, @args ) = @_; - - @args = $self->_quote_search(@args); - - $self->_imap_uid_command( SEARCH => @args ) - or return undef; - - my @hits; - foreach ( $self->History ) { - chomp; - s/$CR?$LF$//o; - s/^\*\s+SEARCH\s+(?=.*?\d)// or next; - push @hits, grep /^\d+$/, split; - } - - @hits - or $self->_debug("Search successful but found no matching messages"); - - # return empty list - return - wantarray ? @hits - : !@hits ? \@hits - : $self->Ranges ? $self->Range( \@hits ) - : \@hits; -} - -# returns a Thread data structure -my $thread_parser; - -sub thread { - my $self = shift; - - return undef unless defined $self->has_capability("THREAD=REFERENCES"); - 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 ) { - /^\*\s+THREAD\s+/ or next; - s/$CR?$LF|$LF+/ /og; - $thread = $thread_parser->start($_); - } - - 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 $_ eq 'ARRAY' ? @$_ : split /\,/ } @_; - - $self->store( join( ',', @msgs ), '+FLAGS.SILENT', '(\Deleted)' ) - ? scalar @msgs - : undef; -} - -sub restore_message { - my $self = shift; - my $msgs = join ',', map { ref $_ eq 'ARRAY' ? @$_ : split /\,/ } @_; - - $self->store( $msgs, '-FLAGS', '(\Deleted)' ) or return undef; - scalar grep /^\*\s\d+\sFETCH\s\(.*FLAGS.*(?!\\Deleted)/, $self->Results; -} - -#??? compare to uidnext. Why is Massage missing? -sub uidvalidity { - my ( $self, $folder ) = @_; - $self->status( $folder, "UIDVALIDITY" ) or return undef; - my $vline = first { /UIDVALIDITY/i } $self->History; - defined $vline && $vline =~ /\(UIDVALIDITY\s+([^\)]+)/ ? $1 : undef; -} - -sub uidnext { - my $self = shift; - my $folder = $self->Massage(shift); - $self->status( $folder, "UIDNEXT" ) or return undef; - my $line = first { /UIDNEXT/i } $self->History; - defined $line && $line =~ /\(UIDNEXT\s+([^\)]+)/ ? $1 : undef; -} - -sub capability { - my $self = shift; - - if ( $self->{CAPABILITY} ) { - my @caps = keys %{ $self->{CAPABILITY} }; - return wantarray ? @caps : \@caps; - } - - $self->_imap_command('CAPABILITY') - or return undef; - - my @caps = map { split } grep s/^\*\s+CAPABILITY\s+//, $self->History; - foreach (@caps) { - $self->{CAPABILITY}{ uc $_ }++; - $self->{ uc $1 } = uc $2 if /(.*?)\=(.*)/; - } - - return wantarray ? @caps : \@caps; -} - -# use "" not undef when lookup fails to differentiate imap command -# failure vs lack of capability -sub has_capability { - my ( $self, $which ) = @_; - $self->capability or return undef; - $which ? $self->{CAPABILITY}{ uc $which } : ""; -} - -sub imap4rev1 { - my $self = shift; - return $self->{_IMAP4REV1} if exists $self->{_IMAP4REV1}; - $self->{_IMAP4REV1} = $self->has_capability('IMAP4REV1'); -} - -#??? what a horror! -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( "NO NAMESPACE not supported by " . $self->Server ) - unless $self->LastError; - return undef; - } - - my $got = $self->_imap_command("NAMESPACE") or return undef; - my @namespaces = map { /^\* NAMESPACE (.*)/ ? $1 : () } $got->Results; - - my $namespace = shift @namespaces; - $namespace =~ s/$CR?$LF$//o; - - 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"); - foreach ( $personal, $shared, $public ) { - uc $_ ne 'NIL' or next; - s/^\((.*)\)$/$1/; - - my @pieces = m#\(([^\)]*)\)#g; - $self->_debug("NAMESPACE pieces: @pieces"); - - push @ns, [ map { [m#"([^"]*)"\s*#g] } @pieces ]; - } - - return 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 ) or return undef; - - my $attrs; - foreach my $resp (@$list) { - my $rec = $self->_list_or_lsub_response_parse($resp); - next unless defined $rec->{attrs}; - return 0 if $rec->{attrs} =~ /\bNoInferior\b/i; - $attrs = $rec->{attrs}; - } - - if ($attrs) { - return 1 if $attrs =~ /HasChildren/i; - return 0 if $attrs =~ /HasNoChildren/i; - } - else { - $self->_debug( join( "\n\t", "no attrs for '$folder' in:", @$list ) ); - } - - # BUG? This may be overkill for normal use cases... - # flag not supported or not returned for some reason, try via folders() - my $sep = $self->separator($folder) || $self->separator(undef); - return undef unless defined $sep; - - my $lead = $folder . $sep; - my $len = length $lead; - scalar grep { $lead eq substr( $_, 0, $len ) } $self->folders; -} - -sub selectable { - my ( $self, $f ) = @_; - my $info = $self->list( "", $f ); - defined $info ? not( grep /NoSelect/i, @$info ) : undef; -} - -sub append { - my $self = shift; - my $folder = shift; - my $text = @_ > 1 ? join( $CRLF, @_ ) : shift; - - $self->append_string( $folder, $text ); -} - -sub append_string($$$;$$) { - my $self = shift; - my $folder = $self->Massage(shift); - my ( $text, $flags, $date ) = @_; - defined $text or $text = ''; - - 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 !~ /^"/; - } - - $text =~ s/\r?\n/$CRLF/og; - - my $command = - "APPEND $folder " - . ( $flags ? "$flags " : "" ) - . ( $date ? "$date " : "" ) . "{" - . length($text) - . "}$CRLF"; - - $command .= $text . $CRLF; - $self->_imap_command( { addcrlf => 0 }, $command ) or return undef; - - my $data = join '', $self->Results; - - # look for something like return size or self if no size found: - # OK [APPENDUID ] APPEND completed - my $ret = $data =~ m#\s+(\d+)\]# ? $1 : $self; - - return $ret; -} - -sub append_file { - my ( $self, $folder, $file, $control, $flags, $use_filetime ) = @_; - my $mfolder = $self->Massage($folder); - - $flags ||= ''; - my $fflags = $flags =~ m/^\(.*\)$/ ? $flags : "($flags)"; - - my @err; - push( @err, "folder not specified" ) - unless ( defined($folder) and $folder ne "" ); - - my $fh; - if ( !defined($file) ) { - push( @err, "file not specified" ); - } - elsif ( ref($file) ) { - $fh = $file; # let the caller pass in their own file handle directly - } - elsif ( !-f $file ) { - push( @err, "file '$file' not found" ); - } - else { - $fh = IO::File->new( $file, 'r' ) - or push( @err, "Unable to open file '$file': $!" ); - } - - if (@err) { - $self->LastError( join( ", ", @err ) ); - return undef; - } - - my $date; - if ( $fh and $use_filetime ) { - my $f = $self->Rfc2060_datetime( ( stat($fh) )[9] ); - $date = qq("$f"); - } - - # BUG? seems wasteful to do this always, provide a "fast path" option? - my $length = 0; - { - local $/ = "\n"; # just in case global is not default - while ( my $line = <$fh> ) { # do no read the whole file at once! - $line =~ s/\r?\n$/$CRLF/; - $length += length($line); - } - seek( $fh, 0, 0 ); - } - - my $string = "APPEND $mfolder"; - $string .= " $fflags" if ( $fflags ne "" ); - $string .= " $date" if ( defined($date) ); - $string .= " {$length}"; - - my $rc = $self->_imap_command( $string, '+' ); - unless ($rc) { - $self->LastError( "Error sending '$string': " . $self->LastError ); - return undef; - } - - my $count = $self->Count; - - # Now send the message itself - my $buffer; - while ( $fh->sysread( $buffer, APPEND_BUFFER_SIZE ) ) { - $buffer =~ s/\r?\n/$CRLF/og; - - $self->_record( - $count, - [ - $self->_next_index($count), "INPUT", - '{' . length($buffer) . " bytes from $file}" - ] - ); - - my $bytes_written = $self->_send_bytes( \$buffer ); - unless ($bytes_written) { - $self->LastError( "Error appending message: " . $self->LastError ); - return undef; - } - } - - # finish off append - unless ( $self->_send_bytes( \$CRLF ) ) { - $self->LastError( "Error appending CRLF: " . $self->LastError ); - return undef; - } - - # Now for the crucial test: Did the append work or not? - # look for " (OK|BAD|NO)" - my $code = $self->_get_response($count) or return undef; - - if ( $code eq 'OK' ) { - my $data = join '', $self->Results; - - # look for something like return size or self if no size found: - # OK [APPENDUID ] APPEND completed - my $ret = $data =~ m#\s+(\d+)\]# ? $1 : $self; - - return $ret; - } - else { - return undef; - } -} - -# BUG? we should retry if "socket closed while..." but do not currently -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; - - if ( !$scheme ) { - $self->LastError("Authmechanism not set"); - return undef; - } - elsif ( $scheme eq 'LOGIN' ) { - $self->LastError("Authmechanism LOGIN is invalid, use login()"); - return undef; - } - - my $string = "AUTHENTICATE $scheme"; - - # use _imap_command for retry mechanism... - $self->_imap_command( $string, '+' ) or return undef; - - my $count = $self->Count; - my $code; - - # look for "+ " or just "+" - foreach my $line ( $self->Results ) { - if ( $line =~ /^\+\s*(.*?)\s*$/ ) { - $code = $1; - last; - } - } - - if ( $scheme eq 'CRAM-MD5' ) { - $response ||= sub { - my ( $code, $client ) = @_; - require Digest::HMAC_MD5; - my $hmac = - Digest::HMAC_MD5::hmac_md5_hex( decode_base64($code), - $client->Password ); - encode_base64( $client->User . " " . $hmac, '' ); - }; - } - elsif ( $scheme eq 'DIGEST-MD5' ) { - $response ||= sub { - my ( $code, $client ) = @_; - require Authen::SASL; - require Digest::MD5; - - my $authname = - defined $client->Authuser ? $client->Authuser : $client->User; - - my $sasl = Authen::SASL->new( - mechanism => 'DIGEST-MD5', - callback => { - user => $client->User, - pass => $client->Password, - authname => $authname - } - ); - - # client_new is an empty function for DIGEST-MD5 - my $conn = $sasl->client_new( 'imap', 'localhost', '' ); - my $answer = $conn->client_step( decode_base64 $code); - - encode_base64( $answer, '' ) - if defined $answer; - }; - } - elsif ( $scheme eq 'PLAIN' ) { # PLAIN SASL - $response ||= sub { - my ( $code, $client ) = @_; - encode_base64( - $client->User - . chr(0) - . $client->Proxy - . chr(0) - . $client->Password, - '' - ); - }; - } - elsif ( $scheme eq 'NTLM' ) { - $response ||= sub { - my ( $code, $client ) = @_; - - require Authen::NTLM; - Authen::NTLM::ntlm_user( $self->User ); - Authen::NTLM::ntlm_password( $self->Password ); - Authen::NTLM::ntlm_domain( $self->Domain ) if $self->Domain; - Authen::NTLM::ntlm(); - }; - } - - unless ( $self->_send_line( $response->( $code, $self ) ) ) { - $self->LastError( "Error sending $scheme data: " . $self->LastError ); - return undef; - } - - # this code may be a little too custom to try and use _get_response() - # look for "+ " (not just "+") otherwise " (OK|BAD|NO)" - undef $code; - until ($code) { - my $output = $self->_read_line or return undef; - foreach my $o (@$output) { - $self->_record( $count, $o ); - $code = $o->[DATA] =~ /^\+\s+(.*?)\s*$/ ? $1 : undef; - - if ($code) { - unless ( $self->_send_line( $response->( $code, $self ) ) ) { - $self->LastError( - "Error sending $scheme data: " . $self->LastError ); - return undef; - } - undef $code; # clear code as we are not finished yet - } - - if ( $o->[DATA] =~ /^$count\s+(OK|NO|BAD)\b/i ) { - $code = uc($1); - $self->LastError( $o->[DATA] ) unless ( $code eq 'OK' ); - } - elsif ( $o->[DATA] =~ /^\*\s+BYE/ ) { - $self->State(Unconnected); - $self->LastError( $o->[DATA] ); - return undef; - } - } - } - - return undef unless $code eq 'OK'; - - Authen::NTLM::ntlm_reset() - if $scheme eq 'NTLM'; - - $self->State(Authenticated); - return $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/$CR?$LF$//o; - s/^.*\[COPYUID\s+\d+\s+[\d:,]+\s+([\d:,]+)\].*/$1/ or next; - push @uids, /(\d+):(\d+)/ ? ( $1 ... $2 ) : ( split /\,/ ); - - } - return @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; - - unless ( $self->delete_message(@msgs) ) { - local ($!); # old versions of Carp could reset $! - carp $self->LastError; - } - - return $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 ); - return $self->store( $which, '+FLAGS.SILENT', "($flag)" ); -} - -sub see { - my ( $self, @msgs ) = @_; - @msgs = @{ $msgs[0] } if ref $msgs[0] eq 'ARRAY'; - return $self->set_flag( '\\Seen', @msgs ); -} - -sub mark { - my ( $self, @msgs ) = @_; - @msgs = @{ $msgs[0] } if ref $msgs[0] eq 'ARRAY'; - return $self->set_flag( '\\Flagged', @msgs ); -} - -sub unmark { - my ( $self, @msgs ) = @_; - @msgs = @{ $msgs[0] } if ref $msgs[0] eq 'ARRAY'; - return $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; - - return $self->store( join( ",", @msgs ), "-FLAGS.SILENT ($flag)" ); -} - -sub deny_seeing { - my ( $self, @msgs ) = @_; - @msgs = @{ $msgs[0] } if ref $msgs[0] eq 'ARRAY'; - return $self->unset_flag( '\\Seen', @msgs ); -} - -sub size { - my ( $self, $msg ) = @_; - my $data = $self->fetch( $msg, "(RFC822.SIZE)" ) or return undef; - - # beware of response like: * NO Cannot open message $msg - my $cmd = shift @$data; - my $err; - foreach my $line (@$data) { - return $1 if ( $line =~ /RFC822\.SIZE\s+(\d+)/ ); - $err = $line if ( $line =~ /\* NO\b/ ); - } - - if ($err) { - my $info = "$err was returned for $cmd"; - $info =~ s/$CR?$LF//og; - $self->LastError($info); - } - elsif ( !$self->LastError ) { - my $info = "no RFC822.SIZE found in: " . join( " ", @$data ); - $self->LastError($info); - } - return undef; -} - -sub getquotaroot { - my ( $self, $what ) = @_; - my $who = $what ? $self->Massage($what) : "INBOX"; - return $self->_imap_command("GETQUOTAROOT $who") ? $self->Results : undef; -} - -sub getquota { - my ( $self, $what ) = @_; - my $who = $what ? $self->Massage($what) : "user/$self->{User}"; - return $self->_imap_command("GETQUOTA $who") ? $self->Results : undef; -} - -# usage: $self->setquota($folder, storage => 512) -sub setquota(@) { - my ( $self, $what ) = ( shift, shift ); - my $who = $what ? $self->Massage($what) : "user/$self->{User}"; - my @limits; - while (@_) { - my $key = uc shift @_; - push @limits, $key => shift @_; - } - local $" = ' '; - $self->_imap_command("SETQUOTA $who (@limits)") ? $self->Results : undef; -} - -sub quota { - my $self = shift; - my $what = shift || "INBOX"; - $self->_imap_command("GETQUOTA $what") or $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($) { $_[0]->Massage( $_[1], NonFolderArg ) } - -# rfc3501: -# atom-specials = "(" / ")" / "{" / SP / CTL / list-wildcards / -# quoted-specials / resp-specials -# list-wildcards = "%" / "*" -# quoted-specials = DQUOTE / "\" -# resp-specials = "]" -# rfc2060: -# CTL ::= -# Additionally, we encode strings with } and [, be less than minimal -sub Massage($;$) { - my ( $self, $name, $notFolder ) = @_; - $name =~ s/^\"(.*)\"$/$1/ unless $notFolder; - - if ( $name =~ /["\\]/ ) { - return "{" . length($name) . "}" . $CRLF . $name; - } - elsif ( $name =~ /[(){}\s[:cntrl:]%*\[\]]/ ) { - return qq("$name"); - } - else { - return $name; - } -} - -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; - return $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 { my $r = $_[0]->_transaction( $_[1] ); $r } - -sub Range { - my ( $self, $targ ) = ( shift, shift ); - - UNIVERSAL::isa( $targ, 'Mail::IMAPClient::MessageSet' ) - ? $targ->cat(@_) - : Mail::IMAPClient::MessageSet->new( $targ, @_ ); -} - -1; diff --git a/Mail-IMAPClient-3.21/lib/Mail/IMAPClient.pod b/Mail-IMAPClient-3.21/lib/Mail/IMAPClient.pod deleted file mode 100644 index 34aed3b..0000000 --- a/Mail-IMAPClient-3.21/lib/Mail/IMAPClient.pod +++ /dev/null @@ -1,3646 +0,0 @@ -=head1 NAME - -Mail::IMAPClient - An IMAP Client API - -=head1 SYNOPSIS - - use Mail::IMAPClient; - - my $imap = Mail::IMAPClient->new( - Server => 'localhost', - User => 'username', - Password => 'password', - Ssl => 1, - Uid => 1, - ); - - my $folders = $imap->folders - or die "List folders error: ", $imap->LastError, "\n"; - print "Folders: @$folders\n"; - - $imap->select( $Opt{folder} ) - or die "Select '$Opt{folder}' error: ", $imap->LastError, "\n"; - - $imap->fetch_hash("FLAGS", "INTERNALDATE", "RFC822.SIZE") - or die "Fetch hash '$Opt{folder}' error: ", $imap->LastError, "\n"; - - $imap->logout - or die "Logout error: ", $imap->LastError, "\n"; - -=head1 DESCRIPTION - -This module provides methods implementing the IMAP protocol to support -interacting 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 B. When processing -is complete, the L object method should be called. - -This documentation is not meant to be a replacement for RFC3501 nor -any other IMAP related RFCs. - -Note that this documentation uses the term I in place of -RFC3501'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. - -=head2 Connection State - -RFC3501 defines four possible states for an IMAP connection: not -authenticated, authenticated, selected, and logged out. These -correspond to the IMAPClient constants C, C, -C, and C, respectively. These constants can be -used in conjunction with the L method to determine the status -of an IMAPClient object and its underlying IMAP session. - -Note that an IMAPClient object can be in the C state both -before a server connection is made and after it has ended. This -differs slightly from RFC3501, which does not define a pre-connection -status. For a discussion of the methods available for examining the -IMAPClient object's status, see the section labeled -L, below. - -=head2 Advanced Authentication Mechanisms - -RFC3501 defines two commands for authenticating to an IMAP server: - -=over 4 - -=item LOGIN - -LOGIN is for plain text authentication. - -=item AUTHENTICATE - -AUTHENTICATE for more advanced and/or secure authentication mechanisms. - -=back - -Mail::IMAPClient supports the following AUTHENTICATE mechanisms: - -=over 4 - -=item DIGEST-MD5 - -DIGEST-MD5 authentication requires the L and -L modules. See also L. - -=item CRAM-MD5 - -CRAM-MD5 requires the L module. - -=item PLAIN (SASL) - -PLAIN (SASL) authentication requires the use of the L parameter. - -=item NTLM - -NTLM authentication requires the L module. See also -L. - -=back - -=head2 Custom Authentication Mechanisms - -There are also a number of methods and parameters that you can use to -build your own authentication mechanism. All of the methods and -parameters discussed in this section are described in more detail -elsewhere in this document. This section provides a starting point -for building your own authentication mechanism. - -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, if your preferred mechanism is not -currently supported but you manage to get it working please consider -donating them to this module. Patches and suggestions are always -welcome. - -Support for add-on authentication mechanisms in Mail::IMAPClient is -pretty straight forward. You create a callback to be used to provide -the response to the server's challenge. The L 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 L 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 L 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 L 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 also -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, F, 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 authentication: - -=over 4 - -=item The authenticate method - -The L method uses the L parameter to -determine how to authenticate with the server see the method -documentation for details. - -=item Socket and RawSocket - -The L and L methods provide access to the socket -connection. The socket is typically automatically created 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. This is also useful if you want to use -L alternatives, like L. - -L simply gets/sets the socket without attempting any -interaction on it. In this case, you have to be sure to handle all -the preliminary operations and manually set the Mail::IMAPClient -object in sync with its actual status with respect to this socket (see -below for additional parameters regarding this, especially the -L parameter). - -Unlike L, L attempts to carry on preliminary -connection phases if the conditions apply. If both parameters are -present, this takes the precedence over L. It is primarily -used to provide an alternative socket for communications, e.g. to use -L instead of L used by L -by default. - -B As of version 2.99_04 of this module, semantics for -L have changed to make it more "DWIM". L was -introduced as a replacement for the L parameter in older -version. - -=item State, Server, User, Password, Proxy and Domain 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 Mail::IMAPClient object in sync with its actual status. Of -these, only the L parameter is always necessary. The others -need to be set only if you think your program will need them later. - -=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 exists -primarily so that you can set it when you call L to instantiate -your object. The L method will call L, which will -call L. If L sees that you have set an -B then it will call B, using your -B and B parameters as arguments. - -=item Authcallback - -The L, if set, holds a pointer to a subroutine -(CODEREF). The L method will use this as the callback -argument to the B method if the B and -B parameters are both set. If you set B -but not B then the default callback for your mechanism -will be used. All supported authentication mechanisms have a default -callback; in every other case not supplying the callback results in an -error. - -Most advanced authentication mechanisms require a challenge-response -exchange. After the L method sends " AUTHENTICATE -\015\012" to the IMAP server, the server replies with a -challenge. The L method then invokes the code whose -reference is stored in the B parameter as follows: - - $Authcallback->($challenge, $imap) - -where C<$Authcallback> is the code reference stored in the -B parameter, C<$challenge> is the challenge received -from the IMAP server, and C<$imap> is a pointer to the -Mail::IMAPClient object. The return value from the B -routine should be the response to the challenge, and that return value -will be sent by the L method to the server. - -=item Prewritemethod/Readmethod - -The B can hold a subroutine that will do whatever -encryption is necessary and then return the result to the caller so it -in turn can be sent to the server. - -The B can hold a subroutine to be used to replace -B usually performed by Mail::IMAPClient. - -See L and L for details. - -=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, the L method is an object method (not a -class method) and can only be used once an object is successfully -created. In cases where an object is not successfully created the -C<$@> variable is set with an error message. - -Mail::IMAPClient resets C<$@> and L to undef before most -IMAP requests, so the values only have a short lifespan. -L will always contain error info from the last error, -until another error is encountered, another IMAP command is issued or -it is explicitly cleared. - -Please note that the use of C<$@> is subject to change in the future -release so it is best to use L for error checking once a -Mail::IMAPClient object has been created. - -Errors in the L method can prevent your object from ever being -created. If the L, L, and L parameters are -supplied to L, it will attempt to call L and -L. Any of these methods could fail and cause the L -method call to return C and leaving the variable C<$@> is set -to an error message. - -=head2 Transactions - -RFC3501 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 IMAPClient 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 IMAPClient module as the transaction number. A history is -maintained by the IMAPClient 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 parameter for more -information. - -The L transaction returns the history of the entire IMAP -session since the initial connection or for the last L -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. 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. - -=head2 new - -Example: - - my $imap = Mail::IMAPClient->new(%args) - or die "new failed: $@\n"; - -The L method creates a new instance of an IMAPClient object. - -If the L 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 L and L 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 L parameter is not supplied then the IMAPClient -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 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, L and L for more -information on how to manually connect and login after B. - -=head2 Quote - -Example: - - $imap->search( HEADER => 'Message-id' => \$imap->Quote($msg_id) ); - -The B method accepts a value as an argument and returns its -argument as a correctly quoted string or a literal string. Since -version 3.17 Mail::IMAPClient automatically quotes search arguments we -use a SCALARREF so search will not modify or re-quite the valaue -returned by B. - -Note this method should not be used on folder names for -Mail::IMAPClient methods, since methods that accept folder names as an -argument will quote the folder name arguments appropriately -automatically. - -If you are getting unexpected results when running methods with values -that have (or might have) embedded spaces, double quotes, braces, or -parentheses, then calling B may be necessary. This method -should B be used with arguments that are wrapped in quotes or -parens if those quotes or parens are required by RFC3501. For -example, if the RFC requires an argument in this format: - - ( argument ) - -and the argument is (or might be) "pennies (from heaven)", then one -could use: - - $argument = "(" . $imap->Quote($argument) . ")" - -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. - -However, there are times when a method fails unexpectedly and may -require the use of B to work. Should this happen, you can -probably file a bug/enhancement request for Mail::IMAPClient to -safeguard the particular call/case better. - -An example is RFC822 Message-id's, which I don't contain -quotes or parens. When dealing with these it is usually best to take -proactive, defensive measures from the very start and use B. - -=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 RFC3501. -It accepts one or more arguments, each of which can be: - -=over 4 - -=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 L object. -The object uses L and if treated as a string it will act -like 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. - -This method provides an easy way to add or remove messages from a -message set. - -For more information see L. - -=head2 Rfc3501_date - -Example: - - $Rfc3501_date = $imap->Rfc3501_date($seconds); - # or: - $Rfc3501_date = Mail::IMAPClient->Rfc3501_date($seconds); - -The B method accepts one input argument, a number of -seconds since the epoch date. It returns an RFC3501 compliant date -string for that date (as required in date-related arguments to SEARCH, -such as "since", "before", etc.). - -=head2 Rfc3501_datetime - -Example: - - $date = $imap->Rfc3501_datetime($seconds); - # or: - $date = Mail::IMAPClient->Rfc3501_datetime($seconds); - -The B method accepts one or two arguments: a -obligatory timestamp and an optional zone. The zone shall be -formatted as C<< [+-]\d{4} >>, and defaults to C<< +0000 >>. The -timestamp follows the definition of the output of the platforms -specific C -method and cannot be invoked as class methods. - -There object methods typically fall into one of two categories. There -are 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 object control methods can be further broken down into two -types, Parameter accessor methods, which affect the behavior of future -mailbox methods, and L, 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 L or -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 Mail::IMAPClient -methods. Patches are welcome. In the pre-2.99 releases of this -module, they were automatically created (AUTOLOAD), but that was very -error-prone and stalled the progress of this module. - -=head1 Mailbox Control Methods - -=head2 append - -Example: - - my $uid = $imap->append($folder,$msg_text) - or die "Could not append: ", $imap->LastError; - -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 carriage return. To -protect against this, B will insert a carriage 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. - -=head2 append_file - -Example: - - my $new_msg_uid = $imap->append_file( - $folder, - $filename, - [ $input_record_separator, flags, date ] # optional - ) or die "Could not append_file: ", $imap->LastError; - -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). - -=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 RFC3501 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 RFC3501, 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 carriage return. To -protect against this, B will insert a carriage 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. - -=head2 authenticate - -Example: - - $imap->authenticate( $authentication_mechanism, $coderef ) - or die "Could not authenticate: ", $imap->LastError; - -This method implements the AUTHENTICATE IMAP client command. It can -be called directly or may be called by L if the -L parameter is set to anything except 'LOGIN'. - -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 necessary. - -If one or both of the arguments are not specified in the call to -B but their corresponding parameters have been set -(L and L, 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 -L parameter, then the first argument must be -one of the authentication mechanisms for which Mail::IMAPClient -has built in support. - -See also the L method, which is the simplest form of -authentication defined by RFC3501. - -=head2 before - -Example: - - my @msgs = $imap->before($Rfc3501_date) - or warn "No messages found before $Rfc3501_date.\n"; - -The B method works just like the L 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. - -=head2 body_string - -Example: - - my $string = $imap->body_string($msgId) - or die "Could not body_string: ", $imap->LastError; - -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. - -=head2 bodypart_string - -Example: - - my $string = $imap->bodypart_string( - $msgid, $part_number, $length, $offset - ) or die "Could not get bodypart string: ", $imap->LastError; - -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. - -=head2 capability - -Example: - - my $features = $imap->capability - or die "Could not determine capability: ", $imap->LastError; - -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 used to close the currently selected folder via -the CLOSE IMAP client command. According to RFC3501, the CLOSE -command performs an implicit EXPUNGE, which means that any messages -that are flagged as I<\Deleted> (i.e. 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: this closes the currently selected folder, not the IMAP session. - -See also L, L, and RFC3501. - -=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 L and L 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 L and -L parameters are unavailable but the connection to the -server succeeds then B returns a pointer to the IMAPClient -object. - -The L parameter must be set (either during L method -invocation or via the L object method) before invoking -B. When the parameter is an absolute file path, an UNIX -socket will get opened. 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 currently 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. - -=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 RFC3501 calls a "mailbox") to create. If you specify 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 specify 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. - -B returns a true value on success and C on failure. - -=head2 date - -Example: - - my $date = $imap->date($msg); - -The B method accepts one argument, a message sequence number (or -a message UID if the L 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 mileage may vary' and all -that.) - -The IMAPClient 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. - -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. - -See also: 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 RFC3501. - -=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)>. - -=head2 disconnect - -Example: - - $imap->disconnect or warn "Could not disconnect: $@\n"; - -Disconnects the IMAPClient object from the server. Functionally -equivalent to the L method. (In fact it's actually a synonym -for L.) - -=head2 done - -Example: - - my $tag = $imap->idle or warn "Couldn't idle: $@\n"; - goDoOtherThings(); - $imap->done($tag) 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 I (identifier) received from the previous -call to L. If no I is specified when calling B then -the default I using an internal B attribute is assumed to -be the I to use. - -If an invalid I is specified, or the default I is wrong, -then B will hang indefinitely or until a timeout occurs. - -If you call done without previously having called L then the -server will likely 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. In this case, a subsequent call to -B would result in an error. - -=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 method. - -The B method accepts one argument, which is the name of the -folder to select. - -=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. - -=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 any) when no argument is supplied. - -Although RFC3501 does not permit optional arguments (like a folder -name) to the EXPUNGE client command, the L method does. -Note: expunging a folder deletes the messages that have the \Deleted -flag set (i.e. messages flagged via L). - -See also the L method, which "deselects" as well as expunges. - -=head2 fetch - -Usage: - - $imap->fetch( [$seq_set|ALL], @msg_data_items ) - -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 RFC3501.) - -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 -RFC3501 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. - -=head2 fetch_hash - -Usage: - - $imap->fetch_hash( [$seq_set|ALL], @msg_data_items, [\%msg_by_ids] ) - -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 RFC3501). 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', - } - }; - -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. 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. - -=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"; - } - -=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). - -=head2 xlist_folders - -Example: - - my $xlist = $imap->xlist_folders - or die "Could not get xlist folders.\n"; - -IMAP servers implementing the XLIST extension (such as Gmail) -designate particular folders to be used for particular functions. -This is useful in the case where you want to know which folder should -be used for Trash when the actual folder name can't be predicted -(e.g. in the case of Gmail, the folder names change depending on the -user's locale settings). - -The B method returns a hash listing any "xlist" folder -names, with the values listing the actual folders that should be used -for those names. For example, using this method with a Gmail user -using the English (US) locale might give this output from -L: - - $VAR1 = { - 'Inbox' => 'Inbox', - 'AllMail' => '[Gmail]/All Mail', - 'Trash' => '[Gmail]/Trash', - 'Drafts' => '[Gmail]/Drafts', - 'Sent' => '[Gmail]/Sent Mail', - 'Spam' => '[Gmail]/Spam', - 'Starred' => '[Gmail]/Starred' - }; - -The same list for a user using the French locale might look like this: - - $VAR1 = { - 'Inbox' => 'Bo&AO4-te de r&AOk-ception', - 'AllMail' => '[Gmail]/Tous les messages', - 'Trash' => '[Gmail]/Corbeille', - 'Drafts' => '[Gmail]/Brouillons', - 'Sent' => '[Gmail]/Messages envoy&AOk-s', - 'Spam' => '[Gmail]/Spam', - 'Starred' => '[Gmail]/Suivis' - }; - -Mail::IMAPClient recognizes the following "xlist" folder names: - -=over 4 - -=item Inbox - -=item AllMail - -=item Trash - -=item Drafts - -=item Sent - -=item Spam - -=item Starred - -=back - -These are currently the only ones supported by Gmail. The XLIST -extension is not documented, and there are no other known -implementations other than Gmail, so this list is based on what Gmail -provides. - -If the server does not support the XLIST extension, this method -returns undef. - -=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 IMAPClient object is -connected has the capability specified as an argument to -B. If the server does not have the capability then -the empty string "" is returned, if the underlying L -calls fails then undef is returned. - -=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 IMAPClient object is -connected has the IMAP4REV1 capability. If the server does not have -the capability then the empty string "" is returned, if the underlying -L calls fails then undef is returned. - -=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 white space or punctuation -between them. - -=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"; - } - -=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.) - -An C value is returned in case of errors. Be sure to check for -it. - -=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 punctuation or white space 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 implements the IMAP LOGIN client command to log -into the server. It automatically calls L if the -I parameter is set to anything except 'LOGIN' otherwise -a clear text LOGIN is attempted. - -The I and I parameters must be set before the B -method can be invoked. On success, a Mail::IMAPClient object with the -Status of I is returned. On failure, undef is returned -and $@ is set. The methods L, L, and L may -automatically invoke B see the documentation of each method for -details. - -See also L and L for additional information -regarding ways of authenticating with a server via SASL and/or -PROXYAUTH. - -=head2 proxyauth - -Example: - - $imap->login("admin", "password"); - $imap->proxyauth("someuser"); - -The B method implements the IMAP PROXYAUTH client command. -The command is used by Sun/iPlanet/Netscape IMAP servers to allow an -administrative user to masquerade as another user. - -=head2 logout - -Example: - - $imap->logout or die "Could not logout: $@\n"; - -The B method implements the LOGOUT IMAP client commmand. This -method causes the server to end the connection and the IMAPClient -client enters the I state. This method does not, destroy -the IMAPClient object, thus the L and L methods can -be used to establish a new IMAP session. - -Per RFC2683, Mail::IMAPClient will attempt to log out of the server -during B if the object is in the L state. - -=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. - -=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)>. - -=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 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 currently -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 -mileage may vary. - -=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. - -=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 file handle, if a file handle is passed). The returned value is -true on success and C on failure. - -If the first argument is a reference, it is assumed to be an open -file handle 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. - -=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. - -=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 currently 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")>. - -=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 Mail::IMAPClient object's -session. It requires these arguments: - -=over 4 - -=item 1. - -a reference to the target Mail::IMAPClient 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 Mail::IMAPClient 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 Mail::IMAPClient object for both the caller and the receiver -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 Mail::IMAPClient 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 section.) - -The B method uses Black Magic to hardwire the I/O between the -two Mail::IMAPClient 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 successful, then it returns a true value. Furthermore, if -the Mail::IMAPClient 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). - -=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 prefixes and separator -characters for the available personal namespaces. The second -reference provides a list of prefixes and separator characters for the -available shared namespaces. The third reference provides a list of -prefixes and separator characters 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 - ]; - -=head2 on - -Example: - - my @msgs = $imap->on($Rfc3501_date) - or warn "Could not find messages sent on $Rfc3501_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 formatted 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 - ); - - $imap->select("demo"); - - my $msgs = $imap->search("ALL"); - for my $h ( - - # get the Subject and Date from every message in folder "demo" the - # first arg 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( $msgs , "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 occurrence 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; - } - -=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. - -=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). - -=head2 reconnect - -Example: - $imap->noop or $imap->reconnect or die "noop failed: $@\n"; - -Attempt to reconnect if the IMAP connection unless $imap is already in -the IsConnected state. This method calls L and optionally -L if a Folder was previously selected. On success, returns -the (same) $imap object. On failure is returned and -L is set. - -=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. - -=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 IMAPClient 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. - -=head2 run - -Example: - - $imap->run(@args) or die "Could not run: $@\n"; - -The B method is provided to make those uncommon things -possible... however, we would like you to contribute the knowledge of -missing features with us. - -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 (or arrayref in scalar context) 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 -tags then see L, below. - -=head2 search - -Example: - - my $msgs1 = $imap->search(@args); - if ($msgs) { - print "search matches: @$msgs1"; - } - else { - warn "Error in search: $@\n" if $@; - } - - # or note: be sure to quote string properly - my $msgs2 = $imap->search( \( $imap->Quote($msgid), "FROM", q{"me"} ) ) - or warn "search failed: $@\n"; - - # or note: be sure to quote string properly - my $msgs3 = $imap->search('TEXT "string not in mailbox"') - or warn "search failed: $@\n"; - -The B method implements the SEARCH IMAP client command. Any -arguments supplied to B are prefixed with a space then -appended to the SEARCH IMAP client command. The SEARCH IMAP client -command allows for many options and arguments. See RFC3501 for -details. - -As of version 3.17 B tries to "DWIM" by automatically quoting -things that likely need quotes when the words do not match any of the -following: - - 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 - -The following options exist to avoid the automatic quoting (note: -caller is responsible for verifying the data sent in these cases is -properly escaped/quoted): - -=over 4 - -=item * - -specify a single string/argument in the call to search. - -=item * - -specify args as scalar references (SCALAR) and the values of those -SCALAR refs will be passed along as-is. - -=back - -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. - -=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)>. - -=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. - -=head2 select - -Example: - - $imap->select($folder) or die "Could not select: $@\n"; - -The B method (or 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 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. - -=head2 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>. - -=head2 Keepalive - -Some firewalls and network gear like to timeout connections -prematurely if the connection sits idle. The B parameter, -when set to a true value, affects the behavior of L and -L by enabling SO_KEEPALIVE on the socket. - -Version note: attribute added in Mail::IMAPClient 3.17 - -=head2 Maxcommandlength - -The B attribute is used by fetch() to limit length -of commands sent to a server. The default is 1000 chars, following -the recommendation of RFC2683 section 3.2.1.5. - -B: this attribute should also be used for several other methods -but this has not yet been implemented please feel free to file bugs -for methods where you run into problems with this. - -This attribute should remove the need for utilities like imapsync to -create their own split() functions and instead allows Mail::IMAPClient -to DWIM. - -In practice, this parameter has proven to be useful to overcome a -limit of 8000 octets for UW-IMAPD and 16384 octets for Courier/Cyrus -IMAP servers. - -Version note: attribute added in Mail::IMAPClient 3.17 - -=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, Mail::IMAPClient 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 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 to 0 (zero) will force -L, L, L, and -L 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. - -=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 - -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. - -See also L. - -=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 RawSocket - -Example: - $socket = $imap->RawSocket; - # or: - $imap->RawSocket($socketh); - -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 Mail::IMAPClient) or to replace the current -socket with a new handle (for instance an SSL handle, see -L, but be sure to see the L method as well). - -If you supply a socket handle yourself, either by doing something like: - - $imap=Mail::IMAPClient->new(RawSocket => $sock, User => ... ); - -or by doing something like: - - $imap = Mail::IMAPClient->new(User => $user, - Password => $pass, Server => $host); - # blah blah blah - $imap->RawSocket($ssl); - -then it will be up to you to establish the connection AND to -authenticate, either via the L 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). - -Note that no operation will be attempted on the socket when this -method is called. In particular, after the TCP connections towards -the IMAP server is established, the protocol mandates the server to -send an initial greeting message, and you will have to explicitly cope -with this message before doing any other operation, e.g. trying to -call L. Caveat emptor. - -For a more DWIM approach to setting the socket see L. - -=head2 Readmethod - -Example: - - $imap->Readmethod( # IMAP, HANDLE, BUFFER, LENGTH, OFFSET - sub { - my ( $self, $handle, $buffer, $count, $offset ) = @_; - my $rc = sysread( $handle, $$buffer, $count, $offset ); - # do something useful here... - } - ); - -B should contain a reference to a subroutine that will -replace sysread. The subroutine will be passed the following -arguments: first the used Mail::IMAPClient object. Second, a -reference to a socket. Third, a reference to a scalar variable into -which data is read (BUFFER). The data placed 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. Fourth, the number of -bytes requested to be read; the LENGTH of the request. Lastly, 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. - -See also L. - -=head2 Reconnectretry - -If an IMAP connection sits idle too long, the connection may be closed -by the server or firewall, etc. The B parameter, when -given a positive integer value, will cause Mail::IMAPClient to -retrying IMAP commands up to X times when an EPIPE or ECONNRESET error -occurs. This is disabled (0) by default. - -See also L - -Version note: attribute added in Mail::IMAPClient 3.17 - -=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. - -=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 - -B The semantics of this method has changed as of version -2.99_04 of this module. If you need the old semantics use -L. - -Example: - - $Socket = $imap->Socket(); - # or: - $imap->Socket($socket_fh); - -The I method can be used to obtain the socket handle of the -current connection. This may be necessary to do I/O on the connection -that is not otherwise supported by Mail::IMAPClient) 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 - ); - $imap->Socket($ssl); - -then you are responsible for establishing the connection, i.e. make -sure that C<$ssl> in the example is a valid and connected socket. - -This method is primarily used to provide a drop-in replacement for -L, used by L by default. In fact, this -method is called by L itself after having established a -suitable L socket connection towards the target -server; for this reason, this method also carries the normal -operations associated with L, namely: - -=over 4 - -=item * - -read the initial greeting message from the server; - -=item * - -call L if the conditions apply (see L for details); - -=item * - -leave the I object in a suitable state. - -=back - -For these reasons, the following example will work "out of the box": - - use IO::Socket::SSL; - my $imap = Mail::IMAPClient->new - ( User => 'your-username', - Password => 'your-password', - Socket => IO::Socket::SSL->new - ( Proto => 'tcp', - PeerAddr => 'some.imap.server', - PeerPort => 993, # IMAP over SSL standard port - ), - ); - -If you need more control over the socket, e.g. you have to implement a -fancier authentication method, see L. - -=head2 Ssl - -If an IMAP connection requires SSL you can set the Ssl attribute to -'1' and Mail::IMAPClient will automatically use L -instead of L to connect to the server. This -attribute is used in the L method. - -See also L for details on connection initiatiation and -L and L if you need to take more control of -connection management. - -Version note: attribute added in Mail::IMAPClient 3.18 - -=head2 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 separately. In this case, the flags are not (yet) -normalized. The returned lists of the CODE calls are shape the -resulting flag list. - -=head2 Timeout - -Example: - - $Timeout = $imap->Timeout(); - # or: - $imap->Timeout($seconds); - -Specifies the timeout value in seconds for reads (default is 600). -Specifying a I will prevent Mail::IMAPClient 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. Setting I to 0 (zero) disables the timeout -feature. - -=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 RFC3501, -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 folder names also have a unique identifier (UIDVALIDITY), which -is provided when the folder is 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. - -=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 IMAPClient -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 carriage -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, 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 a non-existing folder, then -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. - -=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. - -=head2 State - -The B method returns a numerical value that indicates the -current status of the IMAPClient 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 Mail::IMAPClient 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 IMAPClient 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 REPORTING BUGS - -Please send bug reports to C - -=head1 COPYRIGHT - - Copyright 1999, 2000, 2001, 2002 The Kernen Group, Inc. - All rights reserved. - - Copyright 2007, 2008, 2009 Mark Overmeer - -This program is free software; you can redistribute under the same -terms as Perl itself. - -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. diff --git a/Mail-IMAPClient-3.21/lib/Mail/IMAPClient/BodyStructure.pm b/Mail-IMAPClient-3.21/lib/Mail/IMAPClient/BodyStructure.pm deleted file mode 100644 index 31dc16e..0000000 --- a/Mail-IMAPClient-3.21/lib/Mail/IMAPClient/BodyStructure.pm +++ /dev/null @@ -1,557 +0,0 @@ -use warnings; -use strict; - -package Mail::IMAPClient::BodyStructure; -use Mail::IMAPClient::BodyStructure::Parse; - -# my has file scope, not limited to package! -my $parser = Mail::IMAPClient::BodyStructure::Parse->new - or die "Cannot parse rules: $@\n" - . "Try remaking Mail::IMAPClient::BodyStructure::Parse.\n"; - -sub new -{ my $class = shift; - my $bodystructure = shift; - - my $self = $parser->start($bodystructure) - or return undef; - - $self->{_prefix} = ""; - $self->{_id} = exists $self->{bodystructure} ? 'HEAD' : 1; - $self->{_top} = 1; - - bless $self, ref($class)||$class; -} - -sub _get_thingy -{ my $thingy = shift; - my $object = shift || (ref $thingy ? $thingy : undef); - - unless ($object && ref $object) - { warn $@ = "No argument passed to $thingy method."; - return undef; - } - - unless(UNIVERSAL::isa($object, 'HASH') && exists $object->{$thingy}) - { my $a = $thingy =~ /^[aeiou]/i ? 'an' : 'a'; - my $has = ref $object eq 'HASH' ? join(", ",keys %$object) : ''; - warn $@ = ref($object)." $object does not have $a $thingy. " - . ($has ? "It has $has" : ''); - return undef; - } - - my $value = $object->{$thingy}; - $value =~ s/\\ ( [\\\(\)"\x0d\x0a] )/$1/gx; - $value =~ s/^"(.*)"$/$1/; - $value; -} - -BEGIN -{ no strict 'refs'; - foreach my $datum ( - qw/ bodytype bodysubtype bodyparms bodydisp bodyid bodydesc bodyenc - bodysize bodylang envelopestruct textlines / ) - { *$datum = sub { _get_thingy($datum, @_) }; - } -} - -sub parts -{ my $self = shift; - return wantarray ? @{$self->{PartsList}} : $self->{PartsList} - if exists $self->{PartsList}; - - my @parts; - $self->{PartsList} = \@parts; - - unless(exists $self->{bodystructure}) - { $self->{PartsIndex}{1} = $self; - @parts = ("HEAD", 1); - return wantarray ? @parts : \@parts; - } - - foreach my $p ($self->bodystructure) - { my $id = $p->id; - push @parts, $id; - $self->{PartsIndex}{$id} = $p ; - my $type = uc $p->bodytype || ''; - - push @parts, "$id.HEAD" - if $type eq 'MESSAGE'; - } - - wantarray ? @parts : \@parts; -} - -sub bodystructure -{ my $self = shift; - my $partno = 0; - my @parts; - - if($self->{_top}) - { $self->{_id} ||= "HEAD"; - $self->{_prefix} ||= "HEAD"; - $partno = 0; - foreach my $b ( @{$self->{bodystructure}} ) - { $b->{_id} = ++$partno; - $b->{_prefix} = $partno; - push @parts, $b, $b->bodystructure; - } - return wantarray ? @parts : \@parts; - } - - my $prefix = $self->{_prefix} || ""; - $prefix =~ s/\.?$/./; - - foreach my $p ( @{$self->{bodystructure}} ) - { $partno++; - $p->{_prefix} = "$prefix$partno"; - $p->{_id} ||= "$prefix$partno"; - push @parts, $p, $p->{bodystructure} ? $p->bodystructure : (); - } - - wantarray ? @parts : \@parts; -} - -sub id -{ my $self = shift; - return $self->{_id} - if exists $self->{_id}; - - return "HEAD" - if $self->{_top}; - - if ($self->{bodytype} eq 'MULTIPART') - { my $p = $self->{_id} || $self->{_prefix}; - $p =~ s/\.$//; - return $p; - } - else - { return $self->{_id} ||= 1; - } -} - -package Mail::IMAPClient::BodyStructure::Part; -our @ISA = qw/Mail::IMAPClient::BodyStructure/; - -package Mail::IMAPClient::BodyStructure::Envelope; -our @ISA = qw/Mail::IMAPClient::BodyStructure/; - -sub new -{ my ($class, $envelope) = @_; - $parser->envelope($envelope); -} - -sub from_addresses { shift->_addresses(from => 1) } -sub sender_addresses { shift->_addresses(sender => 1) } -sub replyto_addresses { shift->_addresses(replyto => 1) } -sub to_addresses { shift->_addresses(to => 0) } -sub cc_addresses { shift->_addresses(cc => 0) } -sub bcc_addresses { shift->_addresses(bcc => 0) } - -sub _addresses($$$) -{ my ($self, $name, $isSender) = @_; - ref $self->{$name} eq 'ARRAY' - or return (); - - my @list; - foreach ( @{$self->{$name}} ) - { my $pn = $_->personalname; - my $name = $pn && $pn ne 'NIL' ? "$pn " : ''; - push @list, $name . '<' . $_->mailboxname . '@' . $_->hostname . '>'; - } - - wantarray ? @list - : $isSender ? $list[0] - : \@list; -} - -BEGIN -{ no strict 'refs'; - for my $datum ( qw(subject inreplyto from messageid bcc date - replyto to sender cc)) - { *$datum = sub { @_ > 1 ? $_[0]->{$datum} = $_[1] : $_[0]->{$datum} } - } -} - - -package Mail::IMAPClient::BodyStructure::Address; -our @ISA = qw/Mail::IMAPClient::BodyStructure/; - -for my $datum ( qw(personalname mailboxname hostname sourcename) ) -{ no strict 'refs'; - *$datum = sub { shift->{$datum}; }; -} - -1; - -__END__ - -=head1 NAME - -Mail::IMAPClient::BodyStructure - parse fetched results - -=head1 SYNOPSIS - - use Mail::IMAPClient::BodyStructure; - use Mail::IMAPClient; - - my $imap = Mail::IMAPClient->new(Server=>$serv,User=>$usr,Password=>$pwd); - $imap->select("INBOX") or die "cannot select the inbox for $usr: $@\n"; - - my @recent = $imap->search("recent"); - - foreach my $id (@recent) - { my $fetched = $imap->fetch($id, "bodystructure"); - my $struct = Mail::IMAPClient::BodyStructure->new($fetched); - - my $mime = $struct->bodytype."/".$struct->bodysubtype; - my $parts =join "\n\t", $struct->parts; - print "Msg $id (Content-type: $mime) contains these parts:\n\t$parts\n"; - } - -=head1 DESCRIPTION - -This extension will parse the result of an IMAP FETCH BODYSTRUCTURE -command into a perl data structure. It also provides helper methods that -will help you pull information out of the data structure. - -Use of this extension requires Parse::RecDescent. If you don't have -Parse::RecDescent then you must either get it or refrain from using -this module. - -=head2 EXPORT - -Nothing is exported by default. C<$parser> is exported upon -request. C<$parser> is the BodyStucture object's Parse::RecDescent object, -which you'll probably only need for debugging purposes. - -=head1 Class Methods - -The following class method is available: - -=head2 new - -This class method is the constructor method for instantiating new -Mail::IMAPClient::BodyStructure objects. The B 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 - -Reworked and maintained by Mark Overmeer. - -=head1 SEE ALSO - -perl(1), Mail::IMAPClient, and RFC2060. See also Parse::RecDescent if you -want to understand the internals of this module. - -=cut diff --git a/Mail-IMAPClient-3.21/lib/Mail/IMAPClient/BodyStructure/Parse.grammar b/Mail-IMAPClient-3.21/lib/Mail/IMAPClient/BodyStructure/Parse.grammar deleted file mode 100644 index 853d092..0000000 --- a/Mail-IMAPClient-3.21/lib/Mail/IMAPClient/BodyStructure/Parse.grammar +++ /dev/null @@ -1,188 +0,0 @@ -# Directives -# ( none) -# Start-up Actions - -{ - my $mibs = "Mail::IMAPClient::BodyStructure"; - my $subpartCount = 0; - my $partCount = 0; - - sub take_optional_items($$@) - { my ($r, $items) = (shift, shift); - foreach (@_) - { my $opt = $_ .'(?)'; - exists $items->{$opt} or next; - $r->{$_} = UNIVERSAL::isa($items->{$opt}, 'ARRAY') - ? $items->{$opt}[0] : $items->{$opt}; - } - } - - sub merge_hash($$) - { my $to = shift; - my $from = shift or return; - while( my($k,$v) = each %$from) { $to->{$k} = $v } - } -} - -# Atoms - -TEXT: /^"TEXT"|^TEXT/i { $return = "TEXT" } -PLAIN: /^"PLAIN"|^PLAIN/i { $return = "PLAIN" } -HTML: /"HTML"|HTML/i { $return = "HTML" } -MESSAGE: /^"MESSAGE"|^MESSAGE/i { $return = "MESSAGE"} -RFC822: /^"RFC822"|^RFC822/i { $return = "RFC822" } -NIL: /^NIL/i { $return = "NIL" } -NUMBER: /^(\d+)/ { $return = $item[1] } - -# Strings: - -SINGLE_QUOTED_STRING: "'" /(?:\\'|[^'])*/ "'" { $return = $item{__PATTERN1__} } -DOUBLE_QUOTED_STRING: '"' /(?:\\"|[^"])*/ '"' { $return = $item{__PATTERN1__} } - -BARESTRING: ...!/^[)('"]/ /^(?!\(|\))(?:\\ |\S)+/ - { $return = $item{__PATTERN1__} } - -STRING: DOUBLE_QUOTED_STRING | SINGLE_QUOTED_STRING | BARESTRING - -STRINGS: "(" STRING(s) ")" { $return = $item{'STRING(s)'} } - -textlines: NIL | NUMBER - -rfc822message: MESSAGE RFC822 { $return = "MESSAGE RFC822" } - -bodysubtype: PLAIN | HTML | NIL | STRING - -key: STRING -value: NIL | NUMBER | STRING | KVPAIRS - -kvpair: ...!")" key value - { $return = { $item{key} => $item{value} } } - -KVPAIRS: "(" kvpair(s) ")" - { $return = { map { (%$_) } @{$item{'kvpair(s)'}} } } - -bodytype: STRING -bodyparms: NIL | KVPAIRS -bodydisp: NIL | KVPAIRS -bodyid: ...!/[()]/ NIL | STRING -bodydesc: ...!/[()]/ NIL | STRING -bodysize: ...!/[()]/ NIL | NUMBER -bodyenc: NIL | STRING | KVPAIRS -bodyMD5: NIL | STRING -bodylang: NIL | STRING | STRINGS -bodyextra: NIL | STRING | STRINGS -bodyloc: NIL | STRING - -personalname: NIL | STRING -sourceroute: NIL | STRING -mailboxname: NIL | STRING -hostname: NIL | STRING - -addressstruct: "(" personalname sourceroute mailboxname hostname ")" - { bless { personalname => $item{personalname} - , sourceroute => $item{sourceroute} - , mailboxname => $item{mailboxname} - , hostname => $item{hostname} - }, 'Mail::IMAPClient::BodyStructure::Address'; - } - -subject: NIL | STRING -inreplyto: NIL | STRING -messageid: NIL | STRING -date: NIL | STRING - -ADDRESSES: NIL - | "(" addressstruct(s) ")" { $return = $item{'addressstruct(s)'} } - -cc: ADDRESSES -bcc: ADDRESSES -from: ADDRESSES -replyto: ADDRESSES -sender: ADDRESSES -to: ADDRESSES - -envelopestruct: "(" date subject from sender replyto to cc - bcc inreplyto messageid ")" - { $return = bless {}, "Mail::IMAPClient::BodyStructure::Envelope"; - $return->{$_} = $item{$_} - for qw/date subject from sender replyto to cc/ - , qw/bcc inreplyto messageid/; - 1; - } - -basicfields: bodysubtype bodyparms(?) bodyid(?) - bodydesc(?) bodyenc(?) bodysize(?) - { $return = { bodysubtype => $item{bodysubtype} }; - take_optional_items($return, \%item, - qw/bodyparms bodyid bodydesc bodyenc bodysize/); - 1; - } - -textmessage: TEXT basicfields textlines(?) bodyMD5(?) - bodydisp(?) bodylang(?) bodyextra(?) - { - $return = $item{basicfields} || {}; - $return->{bodytype} = 'TEXT'; - take_optional_items($return, \%item - , qw/textlines bodyMD5 bodydisp bodylang bodyextra/); - 1; - } - -othertypemessage: bodytype basicfields bodyMD5(?) bodydisp(?) - bodylang(?) bodyextra(?) - { $return = { bodytype => $item{bodytype} }; - take_optional_items($return, \%item - , qw/bodyMD5 bodydisp bodylang bodyextra/ ); - merge_hash($return, $item{basicfields}); - 1; - } - -nestedmessage: rfc822message bodyparms bodyid bodydesc bodyenc -# bodysize envelopestruct bodystructure textlines - bodysize envelopestruct(?) bodystructure(?) textlines(?) - bodyMD5(?) bodydisp(?) bodylang(?) bodyextra(?) - { - $return = {}; - $return->{$_} = $item{$_} - for qw/bodyparms bodyid bodydesc bodyenc bodysize/; -# envelopestruct bodystructure textlines/; - - take_optional_items($return, \%item - , qw/envelopestruct bodystructure textlines/ - , qw/bodyMD5 bodydisp bodylang bodyextra/); - - merge_hash($return, $item{bodystructure}[0]); - merge_hash($return, $item{basicfields}); - $return->{bodytype} = "MESSAGE" ; - $return->{bodysubtype} = "RFC822" ; - 1; - } - -multipart: subpart(s) bodysubtype - bodyparms(?) bodydisp(?) bodylang(?) bodyloc(?) bodyextra(?) - - { $return = - { bodysubtype => $item{bodysubtype} - , bodytype => 'MULTIPART' - , bodystructure => $item{'subpart(s)'} - }; - take_optional_items($return, \%item - , qw/bodyparms bodydisp bodylang bodyloc bodyextra/); - 1; - } - -subpart: "(" part ")" {$return = $item{part}} - -part: multipart { $return = bless $item{multipart}, $mibs } - | textmessage { $return = bless $item{textmessage}, $mibs } - | nestedmessage { $return = bless $item{nestedmessage}, $mibs } - | othertypemessage { $return = bless $item{othertypemessage}, $mibs } - -bodystructure: "(" part(s) ")" - { $return = $item{'part(s)'} } - -start: /.*?\(.*?BODYSTRUCTURE \(/i part(1) /\).*\)\r?\n?/ - { $return = $item{'part(1)'}[0] } - -envelope: /.*?\(.*?ENVELOPE/ envelopestruct /.*\)/ - { $return = $item{envelopestruct} } diff --git a/Mail-IMAPClient-3.21/lib/Mail/IMAPClient/BodyStructure/Parse.pm b/Mail-IMAPClient-3.21/lib/Mail/IMAPClient/BodyStructure/Parse.pm deleted file mode 100644 index c710d9b..0000000 --- a/Mail-IMAPClient-3.21/lib/Mail/IMAPClient/BodyStructure/Parse.pm +++ /dev/null @@ -1,16425 +0,0 @@ -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 $mibs = "Mail::IMAPClient::BodyStructure"; - my $subpartCount = 0; - my $partCount = 0; - - sub take_optional_items($$@) - { my ($r, $items) = (shift, shift); - foreach (@_) - { my $opt = $_ .'(?)'; - exists $items->{$opt} or next; - $r->{$_} = UNIVERSAL::isa($items->{$opt}, 'ARRAY') - ? $items->{$opt}[0] : $items->{$opt}; - } - } - - sub merge_hash($$) - { my $to = shift; - my $from = shift or return; - while( my($k,$v) = each %$from) { $to->{$k} = $v } - } -; - - -{ -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: [KVPAIRS]}, - 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 subrule: [KVPAIRS]}, - 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::KVPAIRS($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: [KVPAIRS]<< (return value: [} - . $_tok . q{]}, - - Parse::RecDescent::_tracefirst($text), - q{bodyparms}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{KVPAIRS}} = $_tok; - push @item, $_tok; - - } - - - Parse::RecDescent::_trace(q{>>Matched production: [KVPAIRS]<<}, - 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{>>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{>>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{>>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 repeated subrule: [bodyparms]}, - Parse::RecDescent::_tracefirst($text), - q{basicfields}, - $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{basicfields}, - $tracelevel) - if defined $::RD_TRACE; - last; - } - Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodyparms]<< (} - . @$_tok . q{ times)}, - - 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} }; - take_optional_items($return, \%item, - qw/bodyparms bodyid bodydesc bodyenc bodysize/); - 1; - }; - 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{>>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{>>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: [ADDRESSES]}, - 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: [ADDRESSES]}, - 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::ADDRESSES($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: [ADDRESSES]<< (return value: [} - . $_tok . q{]}, - - Parse::RecDescent::_tracefirst($text), - q{cc}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{ADDRESSES}} = $_tok; - push @item, $_tok; - - } - - - Parse::RecDescent::_trace(q{>>Matched production: [ADDRESSES]<<}, - 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{>>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} }; - 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__} }; - 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{>>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: [NUMBER]}, - 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 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"}[2]; - $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{>>Matched production: [STRING]<<}, - 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: [KVPAIRS]}, - 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: [KVPAIRS]}, - 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::KVPAIRS($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: [KVPAIRS]<< (return value: [} - . $_tok . q{]}, - - Parse::RecDescent::_tracefirst($text), - q{value}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{KVPAIRS}} = $_tok; - push @item, $_tok; - - } - - - Parse::RecDescent::_trace(q{>>Matched production: [KVPAIRS]<<}, - 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{>>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{>>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: [ADDRESSES]}, - 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: [ADDRESSES]}, - 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::ADDRESSES($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: [ADDRESSES]<< (return value: [} - . $_tok . q{]}, - - Parse::RecDescent::_tracefirst($text), - q{sender}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{ADDRESSES}} = $_tok; - push @item, $_tok; - - } - - - Parse::RecDescent::_trace(q{>>Matched production: [ADDRESSES]<<}, - 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::multipart -{ - my $thisparser = $_[0]; - use vars q{$tracelevel}; - local $tracelevel = ($tracelevel||0)+1; - $ERRORS = 0; - my $thisrule = $thisparser->{"rules"}{"multipart"}; - - Parse::RecDescent::_trace(q{Trying rule: [multipart]}, - Parse::RecDescent::_tracefirst($_[1]), - q{multipart}, - $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 bodysubtype bodyparms bodydisp bodylang bodyloc bodyextra ]}, - Parse::RecDescent::_tracefirst($_[1]), - q{multipart}, - $tracelevel) - if defined $::RD_TRACE; - my $thisprod = $thisrule->{"prods"}[0]; - $text = $_[1]; - my $_savetext; - @item = (q{multipart}); - %item = (__RULE__ => q{multipart}); - my $repcount = 0; - - - Parse::RecDescent::_trace(q{Trying repeated subrule: [subpart]}, - Parse::RecDescent::_tracefirst($text), - q{multipart}, - $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{multipart}, - $tracelevel) - if defined $::RD_TRACE; - last; - } - Parse::RecDescent::_trace(q{>>Matched repeated subrule: [subpart]<< (} - . @$_tok . q{ times)}, - - Parse::RecDescent::_tracefirst($text), - q{multipart}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{subpart(s)}} = $_tok; - push @item, $_tok; - - - - - - Parse::RecDescent::_trace(q{Trying directive: []}, - Parse::RecDescent::_tracefirst($text), - q{multipart}, - $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: [bodysubtype]}, - Parse::RecDescent::_tracefirst($text), - q{multipart}, - $tracelevel) - if defined $::RD_TRACE; - if (1) { no strict qw{refs}; - $expectation->is(q{bodysubtype})->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{multipart}, - $tracelevel) - if defined $::RD_TRACE; - $expectation->failed(); - last; - } - Parse::RecDescent::_trace(q{>>Matched subrule: [bodysubtype]<< (return value: [} - . $_tok . q{]}, - - Parse::RecDescent::_tracefirst($text), - q{multipart}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{bodysubtype}} = $_tok; - push @item, $_tok; - - } - - Parse::RecDescent::_trace(q{Trying repeated subrule: [bodyparms]}, - Parse::RecDescent::_tracefirst($text), - q{multipart}, - $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{multipart}, - $tracelevel) - if defined $::RD_TRACE; - last; - } - Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodyparms]<< (} - . @$_tok . q{ times)}, - - Parse::RecDescent::_tracefirst($text), - q{multipart}, - $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{multipart}, - $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{multipart}, - $tracelevel) - if defined $::RD_TRACE; - last; - } - Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodydisp]<< (} - . @$_tok . q{ times)}, - - Parse::RecDescent::_tracefirst($text), - q{multipart}, - $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{multipart}, - $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{multipart}, - $tracelevel) - if defined $::RD_TRACE; - last; - } - Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodylang]<< (} - . @$_tok . q{ times)}, - - Parse::RecDescent::_tracefirst($text), - q{multipart}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{bodylang(?)}} = $_tok; - push @item, $_tok; - - - - Parse::RecDescent::_trace(q{Trying repeated subrule: [bodyloc]}, - Parse::RecDescent::_tracefirst($text), - q{multipart}, - $tracelevel) - if defined $::RD_TRACE; - $expectation->is(q{bodyloc})->at($text); - - unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodyloc, 0, 1, $_noactions,$expectation,undef))) - { - Parse::RecDescent::_trace(q{<>}, - Parse::RecDescent::_tracefirst($text), - q{multipart}, - $tracelevel) - if defined $::RD_TRACE; - last; - } - Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodyloc]<< (} - . @$_tok . q{ times)}, - - Parse::RecDescent::_tracefirst($text), - q{multipart}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{bodyloc(?)}} = $_tok; - push @item, $_tok; - - - - Parse::RecDescent::_trace(q{Trying repeated subrule: [bodyextra]}, - Parse::RecDescent::_tracefirst($text), - q{multipart}, - $tracelevel) - if defined $::RD_TRACE; - $expectation->is(q{bodyextra})->at($text); - - unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodyextra, 0, 1, $_noactions,$expectation,undef))) - { - Parse::RecDescent::_trace(q{<>}, - Parse::RecDescent::_tracefirst($text), - q{multipart}, - $tracelevel) - if defined $::RD_TRACE; - last; - } - Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodyextra]<< (} - . @$_tok . q{ times)}, - - Parse::RecDescent::_tracefirst($text), - q{multipart}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{bodyextra(?)}} = $_tok; - push @item, $_tok; - - - - - - Parse::RecDescent::_trace(q{Trying directive: []}, - Parse::RecDescent::_tracefirst($text), - q{multipart}, - $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{multipart}, - $tracelevel) - if defined $::RD_TRACE; - - - $_tok = ($_noactions) ? 0 : do { $return = - { bodysubtype => $item{bodysubtype} - , bodytype => 'MULTIPART' - , bodystructure => $item{'subpart(s)'} - }; - take_optional_items($return, \%item - , qw/bodyparms bodydisp bodylang bodyloc bodyextra/); - 1; - }; - 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 bodysubtype bodyparms bodydisp bodylang bodyloc bodyextra ]<<}, - Parse::RecDescent::_tracefirst($text), - q{multipart}, - $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{multipart}, - $tracelevel) - if defined $::RD_TRACE; - return undef; - } - if (!defined($return) && defined($score)) - { - Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", - q{multipart}, - $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{multipart}, - $tracelevel); - Parse::RecDescent::_trace(q{(consumed: [} . - Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, - Parse::RecDescent::_tracefirst($text), - , q{multipart}, - $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: [KVPAIRS]}, - 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 subrule: [KVPAIRS]}, - 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::KVPAIRS($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: [KVPAIRS]<< (return value: [} - . $_tok . q{]}, - - Parse::RecDescent::_tracefirst($text), - q{bodyenc}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{KVPAIRS}} = $_tok; - push @item, $_tok; - - } - - - Parse::RecDescent::_trace(q{>>Matched production: [KVPAIRS]<<}, - 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{>>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 { $return = $item{'part(1)'}[0] }; - 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 bodyextra]}, - 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 repeated subrule: [bodyextra]}, - Parse::RecDescent::_tracefirst($text), - q{textmessage}, - $tracelevel) - if defined $::RD_TRACE; - $expectation->is(q{bodyextra})->at($text); - - unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodyextra, 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: [bodyextra]<< (} - . @$_tok . q{ times)}, - - Parse::RecDescent::_tracefirst($text), - q{textmessage}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{bodyextra(?)}} = $_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'; - take_optional_items($return, \%item - , qw/textlines bodyMD5 bodydisp bodylang bodyextra/); - 1; - }; - 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 bodyextra]<<}, - 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{>>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::bodyextra -{ - my $thisparser = $_[0]; - use vars q{$tracelevel}; - local $tracelevel = ($tracelevel||0)+1; - $ERRORS = 0; - my $thisrule = $thisparser->{"rules"}{"bodyextra"}; - - Parse::RecDescent::_trace(q{Trying rule: [bodyextra]}, - Parse::RecDescent::_tracefirst($_[1]), - q{bodyextra}, - $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{bodyextra}, - $tracelevel) - if defined $::RD_TRACE; - my $thisprod = $thisrule->{"prods"}[0]; - $text = $_[1]; - my $_savetext; - @item = (q{bodyextra}); - %item = (__RULE__ => q{bodyextra}); - my $repcount = 0; - - - Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, - Parse::RecDescent::_tracefirst($text), - q{bodyextra}, - $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{bodyextra}, - $tracelevel) - if defined $::RD_TRACE; - $expectation->failed(); - last; - } - Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} - . $_tok . q{]}, - - Parse::RecDescent::_tracefirst($text), - q{bodyextra}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{NIL}} = $_tok; - push @item, $_tok; - - } - - - Parse::RecDescent::_trace(q{>>Matched production: [NIL]<<}, - Parse::RecDescent::_tracefirst($text), - q{bodyextra}, - $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{bodyextra}, - $tracelevel) - if defined $::RD_TRACE; - my $thisprod = $thisrule->{"prods"}[1]; - $text = $_[1]; - my $_savetext; - @item = (q{bodyextra}); - %item = (__RULE__ => q{bodyextra}); - my $repcount = 0; - - - Parse::RecDescent::_trace(q{Trying subrule: [STRING]}, - Parse::RecDescent::_tracefirst($text), - q{bodyextra}, - $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{bodyextra}, - $tracelevel) - if defined $::RD_TRACE; - $expectation->failed(); - last; - } - Parse::RecDescent::_trace(q{>>Matched subrule: [STRING]<< (return value: [} - . $_tok . q{]}, - - Parse::RecDescent::_tracefirst($text), - q{bodyextra}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{STRING}} = $_tok; - push @item, $_tok; - - } - - - Parse::RecDescent::_trace(q{>>Matched production: [STRING]<<}, - Parse::RecDescent::_tracefirst($text), - q{bodyextra}, - $tracelevel) - if defined $::RD_TRACE; - $_matched = 1; - last; - } - - splice - @{$thisparser->{deferred}}, $def_at unless $_matched; - - while (!$_matched && !$commit) - { - - Parse::RecDescent::_trace(q{Trying production: [STRINGS]}, - Parse::RecDescent::_tracefirst($_[1]), - q{bodyextra}, - $tracelevel) - if defined $::RD_TRACE; - my $thisprod = $thisrule->{"prods"}[2]; - $text = $_[1]; - my $_savetext; - @item = (q{bodyextra}); - %item = (__RULE__ => q{bodyextra}); - my $repcount = 0; - - - Parse::RecDescent::_trace(q{Trying subrule: [STRINGS]}, - Parse::RecDescent::_tracefirst($text), - q{bodyextra}, - $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::STRINGS($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) - { - - Parse::RecDescent::_trace(q{<>}, - Parse::RecDescent::_tracefirst($text), - q{bodyextra}, - $tracelevel) - if defined $::RD_TRACE; - $expectation->failed(); - last; - } - Parse::RecDescent::_trace(q{>>Matched subrule: [STRINGS]<< (return value: [} - . $_tok . q{]}, - - Parse::RecDescent::_tracefirst($text), - q{bodyextra}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{STRINGS}} = $_tok; - push @item, $_tok; - - } - - - Parse::RecDescent::_trace(q{>>Matched production: [STRINGS]<<}, - Parse::RecDescent::_tracefirst($text), - q{bodyextra}, - $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{bodyextra}, - $tracelevel) - if defined $::RD_TRACE; - return undef; - } - if (!defined($return) && defined($score)) - { - Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", - q{bodyextra}, - $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{bodyextra}, - $tracelevel); - Parse::RecDescent::_trace(q{(consumed: [} . - Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, - Parse::RecDescent::_tracefirst($text), - , q{bodyextra}, - $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 bodyMD5 bodydisp bodylang bodyextra]}, - 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: [bodyMD5]}, - Parse::RecDescent::_tracefirst($text), - q{othertypemessage}, - $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{othertypemessage}, - $tracelevel) - if defined $::RD_TRACE; - last; - } - Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodyMD5]<< (} - . @$_tok . q{ times)}, - - Parse::RecDescent::_tracefirst($text), - q{othertypemessage}, - $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{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 repeated subrule: [bodyextra]}, - Parse::RecDescent::_tracefirst($text), - q{othertypemessage}, - $tracelevel) - if defined $::RD_TRACE; - $expectation->is(q{bodyextra})->at($text); - - unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodyextra, 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: [bodyextra]<< (} - . @$_tok . q{ times)}, - - Parse::RecDescent::_tracefirst($text), - q{othertypemessage}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{bodyextra(?)}} = $_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 = { bodytype => $item{bodytype} }; - take_optional_items($return, \%item - , qw/bodyMD5 bodydisp bodylang bodyextra/ ); - merge_hash($return, $item{basicfields}); - 1; - }; - 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 bodyMD5 bodydisp bodylang bodyextra]<<}, - 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} } }; - 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{>>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: [DOUBLE_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: [DOUBLE_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::DOUBLE_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: [DOUBLE_QUOTED_STRING]<< (return value: [} - . $_tok . q{]}, - - Parse::RecDescent::_tracefirst($text), - q{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{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{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: [SINGLE_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::SINGLE_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: [SINGLE_QUOTED_STRING]<< (return value: [} - . $_tok . q{]}, - - Parse::RecDescent::_tracefirst($text), - q{STRING}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{SINGLE_QUOTED_STRING}} = $_tok; - push @item, $_tok; - - } - - - Parse::RecDescent::_trace(q{>>Matched production: [SINGLE_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"}[2]; - $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{>>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{>>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: [ADDRESSES]}, - 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: [ADDRESSES]}, - 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::ADDRESSES($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: [ADDRESSES]<< (return value: [} - . $_tok . q{]}, - - Parse::RecDescent::_tracefirst($text), - q{to}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{ADDRESSES}} = $_tok; - push @item, $_tok; - - } - - - Parse::RecDescent::_trace(q{>>Matched production: [ADDRESSES]<<}, - 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::KVPAIRS -{ - my $thisparser = $_[0]; - use vars q{$tracelevel}; - local $tracelevel = ($tracelevel||0)+1; - $ERRORS = 0; - my $thisrule = $thisparser->{"rules"}{"KVPAIRS"}; - - Parse::RecDescent::_trace(q{Trying rule: [KVPAIRS]}, - Parse::RecDescent::_tracefirst($_[1]), - q{KVPAIRS}, - $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: ['(' kvpair ')']}, - Parse::RecDescent::_tracefirst($_[1]), - q{KVPAIRS}, - $tracelevel) - if defined $::RD_TRACE; - my $thisprod = $thisrule->{"prods"}[0]; - $text = $_[1]; - my $_savetext; - @item = (q{KVPAIRS}); - %item = (__RULE__ => q{KVPAIRS}); - my $repcount = 0; - - - Parse::RecDescent::_trace(q{Trying terminal: ['(']}, - Parse::RecDescent::_tracefirst($text), - q{KVPAIRS}, - $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: [kvpair]}, - Parse::RecDescent::_tracefirst($text), - q{KVPAIRS}, - $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{KVPAIRS}, - $tracelevel) - if defined $::RD_TRACE; - last; - } - Parse::RecDescent::_trace(q{>>Matched repeated subrule: [kvpair]<< (} - . @$_tok . q{ times)}, - - Parse::RecDescent::_tracefirst($text), - q{KVPAIRS}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{kvpair(s)}} = $_tok; - push @item, $_tok; - - - - Parse::RecDescent::_trace(q{Trying terminal: [')']}, - Parse::RecDescent::_tracefirst($text), - q{KVPAIRS}, - $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{KVPAIRS}, - $tracelevel) - if defined $::RD_TRACE; - - - $_tok = ($_noactions) ? 0 : do { $return = { map { (%$_) } @{$item{'kvpair(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: ['(' kvpair ')']<<}, - Parse::RecDescent::_tracefirst($text), - q{KVPAIRS}, - $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{KVPAIRS}, - $tracelevel) - if defined $::RD_TRACE; - return undef; - } - if (!defined($return) && defined($score)) - { - Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", - q{KVPAIRS}, - $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{KVPAIRS}, - $tracelevel); - Parse::RecDescent::_trace(q{(consumed: [} . - Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, - Parse::RecDescent::_tracefirst($text), - , q{KVPAIRS}, - $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: [ADDRESSES]}, - 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: [ADDRESSES]}, - 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::ADDRESSES($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: [ADDRESSES]<< (return value: [} - . $_tok . q{]}, - - Parse::RecDescent::_tracefirst($text), - q{from}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{ADDRESSES}} = $_tok; - push @item, $_tok; - - } - - - Parse::RecDescent::_trace(q{>>Matched production: [ADDRESSES]<<}, - 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)'} }; - 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] }; - 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::STRINGS -{ - my $thisparser = $_[0]; - use vars q{$tracelevel}; - local $tracelevel = ($tracelevel||0)+1; - $ERRORS = 0; - my $thisrule = $thisparser->{"rules"}{"STRINGS"}; - - Parse::RecDescent::_trace(q{Trying rule: [STRINGS]}, - Parse::RecDescent::_tracefirst($_[1]), - q{STRINGS}, - $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{STRINGS}, - $tracelevel) - if defined $::RD_TRACE; - my $thisprod = $thisrule->{"prods"}[0]; - $text = $_[1]; - my $_savetext; - @item = (q{STRINGS}); - %item = (__RULE__ => q{STRINGS}); - my $repcount = 0; - - - Parse::RecDescent::_trace(q{Trying terminal: ['(']}, - Parse::RecDescent::_tracefirst($text), - q{STRINGS}, - $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{STRINGS}, - $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{STRINGS}, - $tracelevel) - if defined $::RD_TRACE; - last; - } - Parse::RecDescent::_trace(q{>>Matched repeated subrule: [STRING]<< (} - . @$_tok . q{ times)}, - - Parse::RecDescent::_tracefirst($text), - q{STRINGS}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{STRING(s)}} = $_tok; - push @item, $_tok; - - - - Parse::RecDescent::_trace(q{Trying terminal: [')']}, - Parse::RecDescent::_tracefirst($text), - q{STRINGS}, - $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{STRINGS}, - $tracelevel) - if defined $::RD_TRACE; - - - $_tok = ($_noactions) ? 0 : do { $return = $item{'STRING(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: ['(' STRING ')']<<}, - Parse::RecDescent::_tracefirst($text), - q{STRINGS}, - $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{STRINGS}, - $tracelevel) - if defined $::RD_TRACE; - return undef; - } - if (!defined($return) && defined($score)) - { - Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", - q{STRINGS}, - $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{STRINGS}, - $tracelevel); - Parse::RecDescent::_trace(q{(consumed: [} . - Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, - Parse::RecDescent::_tracefirst($text), - , q{STRINGS}, - $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: [KVPAIRS]}, - 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 subrule: [KVPAIRS]}, - 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::KVPAIRS($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: [KVPAIRS]<< (return value: [} - . $_tok . q{]}, - - Parse::RecDescent::_tracefirst($text), - q{bodydisp}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{KVPAIRS}} = $_tok; - push @item, $_tok; - - } - - - Parse::RecDescent::_trace(q{>>Matched production: [KVPAIRS]<<}, - 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: [multipart]}, - 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 subrule: [multipart]}, - 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::multipart($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: [multipart]<< (return value: [} - . $_tok . q{]}, - - Parse::RecDescent::_tracefirst($text), - q{part}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{multipart}} = $_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{multipart}, $mibs }; - 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: [multipart]<<}, - 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}, $mibs }; - 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: [nestedmessage]}, - 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: [nestedmessage]}, - 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::nestedmessage($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: [nestedmessage]<< (return value: [} - . $_tok . q{]}, - - Parse::RecDescent::_tracefirst($text), - q{part}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{nestedmessage}} = $_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{nestedmessage}, $mibs }; - 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: [nestedmessage]<<}, - 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}, $mibs }; - 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::nestedmessage -{ - my $thisparser = $_[0]; - use vars q{$tracelevel}; - local $tracelevel = ($tracelevel||0)+1; - $ERRORS = 0; - my $thisrule = $thisparser->{"rules"}{"nestedmessage"}; - - Parse::RecDescent::_trace(q{Trying rule: [nestedmessage]}, - Parse::RecDescent::_tracefirst($_[1]), - q{nestedmessage}, - $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 bodyextra]}, - Parse::RecDescent::_tracefirst($_[1]), - q{nestedmessage}, - $tracelevel) - if defined $::RD_TRACE; - my $thisprod = $thisrule->{"prods"}[0]; - $text = $_[1]; - my $_savetext; - @item = (q{nestedmessage}); - %item = (__RULE__ => q{nestedmessage}); - my $repcount = 0; - - - Parse::RecDescent::_trace(q{Trying subrule: [rfc822message]}, - Parse::RecDescent::_tracefirst($text), - q{nestedmessage}, - $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{nestedmessage}, - $tracelevel) - if defined $::RD_TRACE; - $expectation->failed(); - last; - } - Parse::RecDescent::_trace(q{>>Matched subrule: [rfc822message]<< (return value: [} - . $_tok . q{]}, - - Parse::RecDescent::_tracefirst($text), - q{nestedmessage}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{rfc822message}} = $_tok; - push @item, $_tok; - - } - - - - Parse::RecDescent::_trace(q{Trying directive: []}, - Parse::RecDescent::_tracefirst($text), - q{nestedmessage}, - $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{nestedmessage}, - $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{nestedmessage}, - $tracelevel) - if defined $::RD_TRACE; - $expectation->failed(); - last; - } - Parse::RecDescent::_trace(q{>>Matched subrule: [bodyparms]<< (return value: [} - . $_tok . q{]}, - - Parse::RecDescent::_tracefirst($text), - q{nestedmessage}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{bodyparms}} = $_tok; - push @item, $_tok; - - } - - Parse::RecDescent::_trace(q{Trying subrule: [bodyid]}, - Parse::RecDescent::_tracefirst($text), - q{nestedmessage}, - $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{nestedmessage}, - $tracelevel) - if defined $::RD_TRACE; - $expectation->failed(); - last; - } - Parse::RecDescent::_trace(q{>>Matched subrule: [bodyid]<< (return value: [} - . $_tok . q{]}, - - Parse::RecDescent::_tracefirst($text), - q{nestedmessage}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{bodyid}} = $_tok; - push @item, $_tok; - - } - - Parse::RecDescent::_trace(q{Trying subrule: [bodydesc]}, - Parse::RecDescent::_tracefirst($text), - q{nestedmessage}, - $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{nestedmessage}, - $tracelevel) - if defined $::RD_TRACE; - $expectation->failed(); - last; - } - Parse::RecDescent::_trace(q{>>Matched subrule: [bodydesc]<< (return value: [} - . $_tok . q{]}, - - Parse::RecDescent::_tracefirst($text), - q{nestedmessage}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{bodydesc}} = $_tok; - push @item, $_tok; - - } - - Parse::RecDescent::_trace(q{Trying subrule: [bodyenc]}, - Parse::RecDescent::_tracefirst($text), - q{nestedmessage}, - $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{nestedmessage}, - $tracelevel) - if defined $::RD_TRACE; - $expectation->failed(); - last; - } - Parse::RecDescent::_trace(q{>>Matched subrule: [bodyenc]<< (return value: [} - . $_tok . q{]}, - - Parse::RecDescent::_tracefirst($text), - q{nestedmessage}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{bodyenc}} = $_tok; - push @item, $_tok; - - } - - Parse::RecDescent::_trace(q{Trying subrule: [bodysize]}, - Parse::RecDescent::_tracefirst($text), - q{nestedmessage}, - $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{nestedmessage}, - $tracelevel) - if defined $::RD_TRACE; - $expectation->failed(); - last; - } - Parse::RecDescent::_trace(q{>>Matched subrule: [bodysize]<< (return value: [} - . $_tok . q{]}, - - Parse::RecDescent::_tracefirst($text), - q{nestedmessage}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{bodysize}} = $_tok; - push @item, $_tok; - - } - - Parse::RecDescent::_trace(q{Trying repeated subrule: [envelopestruct]}, - Parse::RecDescent::_tracefirst($text), - q{nestedmessage}, - $tracelevel) - if defined $::RD_TRACE; - $expectation->is(q{envelopestruct})->at($text); - - unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::envelopestruct, 0, 1, $_noactions,$expectation,undef))) - { - Parse::RecDescent::_trace(q{<>}, - Parse::RecDescent::_tracefirst($text), - q{nestedmessage}, - $tracelevel) - if defined $::RD_TRACE; - last; - } - Parse::RecDescent::_trace(q{>>Matched repeated subrule: [envelopestruct]<< (} - . @$_tok . q{ times)}, - - Parse::RecDescent::_tracefirst($text), - q{nestedmessage}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{envelopestruct(?)}} = $_tok; - push @item, $_tok; - - - - Parse::RecDescent::_trace(q{Trying repeated subrule: [bodystructure]}, - Parse::RecDescent::_tracefirst($text), - q{nestedmessage}, - $tracelevel) - if defined $::RD_TRACE; - $expectation->is(q{bodystructure})->at($text); - - unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodystructure, 0, 1, $_noactions,$expectation,undef))) - { - Parse::RecDescent::_trace(q{<>}, - Parse::RecDescent::_tracefirst($text), - q{nestedmessage}, - $tracelevel) - if defined $::RD_TRACE; - last; - } - Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodystructure]<< (} - . @$_tok . q{ times)}, - - Parse::RecDescent::_tracefirst($text), - q{nestedmessage}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{bodystructure(?)}} = $_tok; - push @item, $_tok; - - - - Parse::RecDescent::_trace(q{Trying repeated subrule: [textlines]}, - Parse::RecDescent::_tracefirst($text), - q{nestedmessage}, - $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{nestedmessage}, - $tracelevel) - if defined $::RD_TRACE; - last; - } - Parse::RecDescent::_trace(q{>>Matched repeated subrule: [textlines]<< (} - . @$_tok . q{ times)}, - - Parse::RecDescent::_tracefirst($text), - q{nestedmessage}, - $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{nestedmessage}, - $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{nestedmessage}, - $tracelevel) - if defined $::RD_TRACE; - last; - } - Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodyMD5]<< (} - . @$_tok . q{ times)}, - - Parse::RecDescent::_tracefirst($text), - q{nestedmessage}, - $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{nestedmessage}, - $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{nestedmessage}, - $tracelevel) - if defined $::RD_TRACE; - last; - } - Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodydisp]<< (} - . @$_tok . q{ times)}, - - Parse::RecDescent::_tracefirst($text), - q{nestedmessage}, - $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{nestedmessage}, - $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{nestedmessage}, - $tracelevel) - if defined $::RD_TRACE; - last; - } - Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodylang]<< (} - . @$_tok . q{ times)}, - - Parse::RecDescent::_tracefirst($text), - q{nestedmessage}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{bodylang(?)}} = $_tok; - push @item, $_tok; - - - - Parse::RecDescent::_trace(q{Trying repeated subrule: [bodyextra]}, - Parse::RecDescent::_tracefirst($text), - q{nestedmessage}, - $tracelevel) - if defined $::RD_TRACE; - $expectation->is(q{bodyextra})->at($text); - - unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodyextra, 0, 1, $_noactions,$expectation,undef))) - { - Parse::RecDescent::_trace(q{<>}, - Parse::RecDescent::_tracefirst($text), - q{nestedmessage}, - $tracelevel) - if defined $::RD_TRACE; - last; - } - Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodyextra]<< (} - . @$_tok . q{ times)}, - - Parse::RecDescent::_tracefirst($text), - q{nestedmessage}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{bodyextra(?)}} = $_tok; - push @item, $_tok; - - - - Parse::RecDescent::_trace(q{Trying action}, - Parse::RecDescent::_tracefirst($text), - q{nestedmessage}, - $tracelevel) - if defined $::RD_TRACE; - - - $_tok = ($_noactions) ? 0 : do { - $return = {}; - $return->{$_} = $item{$_} - for qw/bodyparms bodyid bodydesc bodyenc bodysize/; -# envelopestruct bodystructure textlines/; - - take_optional_items($return, \%item - , qw/envelopestruct bodystructure textlines/ - , qw/bodyMD5 bodydisp bodylang bodyextra/); - - merge_hash($return, $item{bodystructure}[0]); - merge_hash($return, $item{basicfields}); - $return->{bodytype} = "MESSAGE" ; - $return->{bodysubtype} = "RFC822" ; - 1; - }; - 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 bodyextra]<<}, - Parse::RecDescent::_tracefirst($text), - q{nestedmessage}, - $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{nestedmessage}, - $tracelevel) - if defined $::RD_TRACE; - return undef; - } - if (!defined($return) && defined($score)) - { - Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", - q{nestedmessage}, - $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{nestedmessage}, - $tracelevel); - Parse::RecDescent::_trace(q{(consumed: [} . - Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, - Parse::RecDescent::_tracefirst($text), - , q{nestedmessage}, - $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__} }; - 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::ADDRESSES -{ - my $thisparser = $_[0]; - use vars q{$tracelevel}; - local $tracelevel = ($tracelevel||0)+1; - $ERRORS = 0; - my $thisrule = $thisparser->{"rules"}{"ADDRESSES"}; - - Parse::RecDescent::_trace(q{Trying rule: [ADDRESSES]}, - Parse::RecDescent::_tracefirst($_[1]), - q{ADDRESSES}, - $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{ADDRESSES}, - $tracelevel) - if defined $::RD_TRACE; - my $thisprod = $thisrule->{"prods"}[0]; - $text = $_[1]; - my $_savetext; - @item = (q{ADDRESSES}); - %item = (__RULE__ => q{ADDRESSES}); - my $repcount = 0; - - - Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, - Parse::RecDescent::_tracefirst($text), - q{ADDRESSES}, - $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{ADDRESSES}, - $tracelevel) - if defined $::RD_TRACE; - $expectation->failed(); - last; - } - Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} - . $_tok . q{]}, - - Parse::RecDescent::_tracefirst($text), - q{ADDRESSES}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{NIL}} = $_tok; - push @item, $_tok; - - } - - - Parse::RecDescent::_trace(q{>>Matched production: [NIL]<<}, - Parse::RecDescent::_tracefirst($text), - q{ADDRESSES}, - $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{ADDRESSES}, - $tracelevel) - if defined $::RD_TRACE; - my $thisprod = $thisrule->{"prods"}[1]; - $text = $_[1]; - my $_savetext; - @item = (q{ADDRESSES}); - %item = (__RULE__ => q{ADDRESSES}); - my $repcount = 0; - - - Parse::RecDescent::_trace(q{Trying terminal: ['(']}, - Parse::RecDescent::_tracefirst($text), - q{ADDRESSES}, - $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{ADDRESSES}, - $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{ADDRESSES}, - $tracelevel) - if defined $::RD_TRACE; - last; - } - Parse::RecDescent::_trace(q{>>Matched repeated subrule: [addressstruct]<< (} - . @$_tok . q{ times)}, - - Parse::RecDescent::_tracefirst($text), - q{ADDRESSES}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{addressstruct(s)}} = $_tok; - push @item, $_tok; - - - - Parse::RecDescent::_trace(q{Trying terminal: [')']}, - Parse::RecDescent::_tracefirst($text), - q{ADDRESSES}, - $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{ADDRESSES}, - $tracelevel) - if defined $::RD_TRACE; - - - $_tok = ($_noactions) ? 0 : do { $return = $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{ADDRESSES}, - $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{ADDRESSES}, - $tracelevel) - if defined $::RD_TRACE; - return undef; - } - if (!defined($return) && defined($score)) - { - Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", - q{ADDRESSES}, - $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{ADDRESSES}, - $tracelevel); - Parse::RecDescent::_trace(q{(consumed: [} . - Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, - Parse::RecDescent::_tracefirst($text), - , q{ADDRESSES}, - $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: [ADDRESSES]}, - 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: [ADDRESSES]}, - 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::ADDRESSES($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: [ADDRESSES]<< (return value: [} - . $_tok . q{]}, - - Parse::RecDescent::_tracefirst($text), - q{bcc}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{ADDRESSES}} = $_tok; - push @item, $_tok; - - } - - - Parse::RecDescent::_trace(q{>>Matched production: [ADDRESSES]<<}, - 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::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 { bless { personalname => $item{personalname} - , sourceroute => $item{sourceroute} - , mailboxname => $item{mailboxname} - , hostname => $item{hostname} - }, '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{>>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}}; - 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{>>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__} }; - 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::bodyloc -{ - my $thisparser = $_[0]; - use vars q{$tracelevel}; - local $tracelevel = ($tracelevel||0)+1; - $ERRORS = 0; - my $thisrule = $thisparser->{"rules"}{"bodyloc"}; - - Parse::RecDescent::_trace(q{Trying rule: [bodyloc]}, - Parse::RecDescent::_tracefirst($_[1]), - q{bodyloc}, - $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{bodyloc}, - $tracelevel) - if defined $::RD_TRACE; - my $thisprod = $thisrule->{"prods"}[0]; - $text = $_[1]; - my $_savetext; - @item = (q{bodyloc}); - %item = (__RULE__ => q{bodyloc}); - my $repcount = 0; - - - Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, - Parse::RecDescent::_tracefirst($text), - q{bodyloc}, - $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{bodyloc}, - $tracelevel) - if defined $::RD_TRACE; - $expectation->failed(); - last; - } - Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} - . $_tok . q{]}, - - Parse::RecDescent::_tracefirst($text), - q{bodyloc}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{NIL}} = $_tok; - push @item, $_tok; - - } - - - Parse::RecDescent::_trace(q{>>Matched production: [NIL]<<}, - Parse::RecDescent::_tracefirst($text), - q{bodyloc}, - $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{bodyloc}, - $tracelevel) - if defined $::RD_TRACE; - my $thisprod = $thisrule->{"prods"}[1]; - $text = $_[1]; - my $_savetext; - @item = (q{bodyloc}); - %item = (__RULE__ => q{bodyloc}); - my $repcount = 0; - - - Parse::RecDescent::_trace(q{Trying subrule: [STRING]}, - Parse::RecDescent::_tracefirst($text), - q{bodyloc}, - $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{bodyloc}, - $tracelevel) - if defined $::RD_TRACE; - $expectation->failed(); - last; - } - Parse::RecDescent::_trace(q{>>Matched subrule: [STRING]<< (return value: [} - . $_tok . q{]}, - - Parse::RecDescent::_tracefirst($text), - q{bodyloc}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{STRING}} = $_tok; - push @item, $_tok; - - } - - - Parse::RecDescent::_trace(q{>>Matched production: [STRING]<<}, - Parse::RecDescent::_tracefirst($text), - q{bodyloc}, - $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{bodyloc}, - $tracelevel) - if defined $::RD_TRACE; - return undef; - } - if (!defined($return) && defined($score)) - { - Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", - q{bodyloc}, - $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{bodyloc}, - $tracelevel); - Parse::RecDescent::_trace(q{(consumed: [} . - Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, - Parse::RecDescent::_tracefirst($text), - , q{bodyloc}, - $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: [STRINGS]}, - 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 subrule: [STRINGS]}, - 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::STRINGS($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: [STRINGS]<< (return value: [} - . $_tok . q{]}, - - Parse::RecDescent::_tracefirst($text), - q{bodylang}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{STRINGS}} = $_tok; - push @item, $_tok; - - } - - - Parse::RecDescent::_trace(q{>>Matched production: [STRINGS]<<}, - 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 = bless {}, "Mail::IMAPClient::BodyStructure::Envelope"; - $return->{$_} = $item{$_} - for qw/date subject from sender replyto to cc/ - , qw/bcc inreplyto messageid/; - 1; - }; - 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: [ADDRESSES]}, - 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: [ADDRESSES]}, - 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::ADDRESSES($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: [ADDRESSES]<< (return value: [} - . $_tok . q{]}, - - Parse::RecDescent::_tracefirst($text), - q{replyto}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{ADDRESSES}} = $_tok; - push @item, $_tok; - - } - - - Parse::RecDescent::_trace(q{>>Matched production: [ADDRESSES]<<}, - 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{>>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', - 'KVPAIRS' - ], - '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' => 65 - }, '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' => 'KVPAIRS', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 65 - }, 'Parse::RecDescent::Subrule' ) - ], - 'line' => 65 - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'bodyparms', - 'vars' => '', - 'line' => 65 - }, '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' => 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' ) - ], - 'name' => 'date', - 'vars' => '', - 'line' => 92 - }, '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' => 53 - }, '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' => 53 - }, 'Parse::RecDescent::Subrule' ) - ], - 'line' => 53 - }, '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' => 53 - }, 'Parse::RecDescent::Subrule' ) - ], - 'line' => 53 - }, 'Parse::RecDescent::Production' ), - bless( { - 'number' => '3', - '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' => 53 - }, 'Parse::RecDescent::Subrule' ) - ], - 'line' => 53 - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'bodysubtype', - 'vars' => '', - 'line' => 53 - }, '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' => 79 - }, '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' => 79 - }, 'Parse::RecDescent::Subrule' ) - ], - 'line' => 79 - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'hostname', - 'vars' => '', - 'line' => 79 - }, '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' => 113 - }, 'Parse::RecDescent::Subrule' ), - bless( { - 'subrule' => 'bodyparms', - 'expected' => undef, - 'min' => 0, - 'argcode' => undef, - 'max' => 1, - 'matchrule' => 0, - 'repspec' => '?', - 'lookahead' => 0, - 'line' => 113 - }, 'Parse::RecDescent::Repetition' ), - bless( { - 'subrule' => 'bodyid', - 'expected' => undef, - 'min' => 0, - 'argcode' => undef, - 'max' => 1, - 'matchrule' => 0, - 'repspec' => '?', - 'lookahead' => 0, - 'line' => 113 - }, 'Parse::RecDescent::Repetition' ), - bless( { - 'subrule' => 'bodydesc', - 'expected' => undef, - 'min' => 0, - 'argcode' => undef, - 'max' => 1, - 'matchrule' => 0, - 'repspec' => '?', - 'lookahead' => 0, - 'line' => 114 - }, 'Parse::RecDescent::Repetition' ), - bless( { - 'subrule' => 'bodyenc', - 'expected' => undef, - 'min' => 0, - 'argcode' => undef, - 'max' => 1, - 'matchrule' => 0, - 'repspec' => '?', - 'lookahead' => 0, - 'line' => 114 - }, 'Parse::RecDescent::Repetition' ), - bless( { - 'subrule' => 'bodysize', - 'expected' => undef, - 'min' => 0, - 'argcode' => undef, - 'max' => 1, - 'matchrule' => 0, - 'repspec' => '?', - 'lookahead' => 0, - 'line' => 114 - }, 'Parse::RecDescent::Repetition' ), - bless( { - 'hashname' => '__ACTION1__', - 'lookahead' => 0, - 'line' => 115, - 'code' => '{ $return = { bodysubtype => $item{bodysubtype} }; - take_optional_items($return, \\%item, - qw/bodyparms bodyid bodydesc bodyenc bodysize/); - 1; - }' - }, 'Parse::RecDescent::Action' ) - ], - 'line' => undef - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'basicfields', - 'vars' => '', - 'line' => 113 - }, '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' => 76 - }, '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' => 76 - }, 'Parse::RecDescent::Subrule' ) - ], - 'line' => 76 - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'personalname', - 'vars' => '', - 'line' => 76 - }, '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' => 0, - 'items' => [ - bless( { - 'subrule' => 'STRING', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 55 - }, 'Parse::RecDescent::Subrule' ) - ], - 'line' => undef - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'key', - 'vars' => '', - 'line' => 55 - }, 'Parse::RecDescent::Rule' ), - 'cc' => bless( { - 'impcount' => 0, - 'calls' => [ - 'ADDRESSES' - ], - 'changed' => 0, - 'opcount' => 0, - 'prods' => [ - bless( { - 'number' => '0', - 'strcount' => 0, - 'dircount' => 0, - 'uncommit' => undef, - 'error' => undef, - 'patcount' => 0, - 'actcount' => 0, - 'items' => [ - bless( { - 'subrule' => 'ADDRESSES', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 97 - }, 'Parse::RecDescent::Subrule' ) - ], - 'line' => undef - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'cc', - 'vars' => '', - 'line' => 97 - }, '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' => 71 - }, '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' => 71 - }, 'Parse::RecDescent::Subrule' ) - ], - 'line' => 71 - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'bodyMD5', - 'vars' => '', - 'line' => 71 - }, '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' => 187, - 'mod' => '', - 'ldelim' => '/' - }, 'Parse::RecDescent::Token' ), - bless( { - 'subrule' => 'envelopestruct', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 187 - }, 'Parse::RecDescent::Subrule' ), - bless( { - 'pattern' => '.*\\)', - 'hashname' => '__PATTERN2__', - 'description' => '/.*\\\\)/', - 'lookahead' => 0, - 'rdelim' => '/', - 'line' => 187, - 'mod' => '', - 'ldelim' => '/' - }, 'Parse::RecDescent::Token' ), - bless( { - 'hashname' => '__ACTION1__', - 'lookahead' => 0, - 'line' => 188, - 'code' => '{ $return = $item{envelopestruct} }' - }, 'Parse::RecDescent::Action' ) - ], - 'line' => undef - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'envelope', - 'vars' => '', - 'line' => 187 - }, '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' => 32, - 'mod' => 'i', - 'ldelim' => '/' - }, 'Parse::RecDescent::Token' ), - bless( { - 'hashname' => '__ACTION1__', - 'lookahead' => 0, - 'line' => 32, - 'code' => '{ $return = "MESSAGE"}' - }, 'Parse::RecDescent::Action' ) - ], - 'line' => undef - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'MESSAGE', - 'vars' => '', - 'line' => 32 - }, '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' => 40 - }, 'Parse::RecDescent::Literal' ), - bless( { - 'pattern' => '(?:\\\\"|[^"])*', - 'hashname' => '__PATTERN1__', - 'description' => '/(?:\\\\\\\\"|[^"])*/', - 'lookahead' => 0, - 'rdelim' => '/', - 'line' => 40, - 'mod' => '', - 'ldelim' => '/' - }, 'Parse::RecDescent::Token' ), - bless( { - 'pattern' => '"', - 'hashname' => '__STRING2__', - 'description' => '\'"\'', - 'lookahead' => 0, - 'line' => 40 - }, 'Parse::RecDescent::Literal' ), - bless( { - 'hashname' => '__ACTION1__', - 'lookahead' => 0, - 'line' => 40, - 'code' => '{ $return = $item{__PATTERN1__} }' - }, 'Parse::RecDescent::Action' ) - ], - 'line' => undef - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'DOUBLE_QUOTED_STRING', - 'vars' => '', - 'line' => 40 - }, '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' => 89 - }, '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' => 89 - }, 'Parse::RecDescent::Subrule' ) - ], - 'line' => 89 - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'subject', - 'vars' => '', - 'line' => 89 - }, 'Parse::RecDescent::Rule' ), - 'value' => bless( { - 'impcount' => 0, - 'calls' => [ - 'NIL', - 'NUMBER', - 'STRING', - 'KVPAIRS' - ], - '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' => 56 - }, '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' => 'NUMBER', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 56 - }, 'Parse::RecDescent::Subrule' ) - ], - 'line' => 56 - }, 'Parse::RecDescent::Production' ), - bless( { - 'number' => '2', - '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' => 56 - }, 'Parse::RecDescent::Subrule' ) - ], - 'line' => 56 - }, 'Parse::RecDescent::Production' ), - bless( { - 'number' => '3', - 'strcount' => 0, - 'dircount' => 0, - 'uncommit' => undef, - 'error' => undef, - 'patcount' => 0, - 'actcount' => 0, - 'items' => [ - bless( { - 'subrule' => 'KVPAIRS', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 56 - }, 'Parse::RecDescent::Subrule' ) - ], - 'line' => 56 - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'value', - 'vars' => '', - 'line' => 56 - }, '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' => 90 - }, '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' => 90 - }, 'Parse::RecDescent::Subrule' ) - ], - 'line' => 90 - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'inreplyto', - 'vars' => '', - 'line' => 90 - }, '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' => 91 - }, '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' => 91 - }, 'Parse::RecDescent::Subrule' ) - ], - 'line' => 91 - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'messageid', - 'vars' => '', - 'line' => 91 - }, 'Parse::RecDescent::Rule' ), - 'sender' => bless( { - 'impcount' => 0, - 'calls' => [ - 'ADDRESSES' - ], - 'changed' => 0, - 'opcount' => 0, - 'prods' => [ - bless( { - 'number' => '0', - 'strcount' => 0, - 'dircount' => 0, - 'uncommit' => undef, - 'error' => undef, - 'patcount' => 0, - 'actcount' => 0, - 'items' => [ - bless( { - 'subrule' => 'ADDRESSES', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 101 - }, 'Parse::RecDescent::Subrule' ) - ], - 'line' => undef - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'sender', - 'vars' => '', - 'line' => 101 - }, 'Parse::RecDescent::Rule' ), - 'multipart' => bless( { - 'impcount' => 0, - 'calls' => [ - 'subpart', - 'bodysubtype', - 'bodyparms', - 'bodydisp', - 'bodylang', - 'bodyloc', - 'bodyextra' - ], - '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' => 161 - }, 'Parse::RecDescent::Repetition' ), - bless( { - 'hashname' => '__DIRECTIVE1__', - 'name' => '', - 'lookahead' => 0, - 'line' => 161, - 'code' => '$commit = 1' - }, 'Parse::RecDescent::Directive' ), - bless( { - 'subrule' => 'bodysubtype', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 161 - }, 'Parse::RecDescent::Subrule' ), - bless( { - 'subrule' => 'bodyparms', - 'expected' => undef, - 'min' => 0, - 'argcode' => undef, - 'max' => 1, - 'matchrule' => 0, - 'repspec' => '?', - 'lookahead' => 0, - 'line' => 162 - }, 'Parse::RecDescent::Repetition' ), - bless( { - 'subrule' => 'bodydisp', - 'expected' => undef, - 'min' => 0, - 'argcode' => undef, - 'max' => 1, - 'matchrule' => 0, - 'repspec' => '?', - 'lookahead' => 0, - 'line' => 162 - }, 'Parse::RecDescent::Repetition' ), - bless( { - 'subrule' => 'bodylang', - 'expected' => undef, - 'min' => 0, - 'argcode' => undef, - 'max' => 1, - 'matchrule' => 0, - 'repspec' => '?', - 'lookahead' => 0, - 'line' => 162 - }, 'Parse::RecDescent::Repetition' ), - bless( { - 'subrule' => 'bodyloc', - 'expected' => undef, - 'min' => 0, - 'argcode' => undef, - 'max' => 1, - 'matchrule' => 0, - 'repspec' => '?', - 'lookahead' => 0, - 'line' => 162 - }, 'Parse::RecDescent::Repetition' ), - bless( { - 'subrule' => 'bodyextra', - 'expected' => undef, - 'min' => 0, - 'argcode' => undef, - 'max' => 1, - 'matchrule' => 0, - 'repspec' => '?', - 'lookahead' => 0, - 'line' => 162 - }, 'Parse::RecDescent::Repetition' ), - bless( { - 'hashname' => '__DIRECTIVE2__', - 'name' => '', - 'lookahead' => 0, - 'line' => 163, - 'code' => 'push @{$thisparser->{deferred}}, sub { $subpartCount = 0 };' - }, 'Parse::RecDescent::Directive' ), - bless( { - 'hashname' => '__ACTION1__', - 'lookahead' => 0, - 'line' => 164, - 'code' => '{ $return = - { bodysubtype => $item{bodysubtype} - , bodytype => \'MULTIPART\' - , bodystructure => $item{\'subpart(s)\'} - }; - take_optional_items($return, \\%item - , qw/bodyparms bodydisp bodylang bodyloc bodyextra/); - 1; - }' - }, 'Parse::RecDescent::Action' ) - ], - 'line' => undef - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'multipart', - 'vars' => '', - 'line' => 161 - }, 'Parse::RecDescent::Rule' ), - 'bodyenc' => bless( { - 'impcount' => 0, - 'calls' => [ - 'NIL', - 'STRING', - 'KVPAIRS' - ], - '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' => 70 - }, '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' => 70 - }, 'Parse::RecDescent::Subrule' ) - ], - 'line' => 70 - }, 'Parse::RecDescent::Production' ), - bless( { - 'number' => '2', - 'strcount' => 0, - 'dircount' => 0, - 'uncommit' => undef, - 'error' => undef, - 'patcount' => 0, - 'actcount' => 0, - 'items' => [ - bless( { - 'subrule' => 'KVPAIRS', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 70 - }, 'Parse::RecDescent::Subrule' ) - ], - 'line' => 70 - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'bodyenc', - 'vars' => '', - 'line' => 70 - }, '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' => 68, - 'mod' => '', - 'ldelim' => '/' - }, 'Parse::RecDescent::Token' ), - bless( { - 'subrule' => 'NIL', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 68 - }, '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' => 68 - }, 'Parse::RecDescent::Subrule' ) - ], - 'line' => 68 - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'bodydesc', - 'vars' => '', - 'line' => 68 - }, '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' => 184, - 'mod' => 'i', - 'ldelim' => '/' - }, 'Parse::RecDescent::Token' ), - bless( { - 'subrule' => 'part', - 'expected' => undef, - 'min' => 1, - 'argcode' => undef, - 'max' => 1, - 'matchrule' => 0, - 'repspec' => '1', - 'lookahead' => 0, - 'line' => 184 - }, 'Parse::RecDescent::Repetition' ), - bless( { - 'pattern' => '\\).*\\)\\r?\\n?', - 'hashname' => '__PATTERN2__', - 'description' => '/\\\\).*\\\\)\\\\r?\\\\n?/', - 'lookahead' => 0, - 'rdelim' => '/', - 'line' => 184, - 'mod' => '', - 'ldelim' => '/' - }, 'Parse::RecDescent::Token' ), - bless( { - 'hashname' => '__ACTION1__', - 'lookahead' => 0, - 'line' => 185, - 'code' => '{ $return = $item{\'part(1)\'}[0] }' - }, 'Parse::RecDescent::Action' ) - ], - 'line' => undef - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'start', - 'vars' => '', - 'line' => 184 - }, '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' => 33, - 'mod' => 'i', - 'ldelim' => '/' - }, 'Parse::RecDescent::Token' ), - bless( { - 'hashname' => '__ACTION1__', - 'lookahead' => 0, - 'line' => 33, - 'code' => '{ $return = "RFC822" }' - }, 'Parse::RecDescent::Action' ) - ], - 'line' => undef - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'RFC822', - 'vars' => '', - 'line' => 33 - }, 'Parse::RecDescent::Rule' ), - 'textmessage' => bless( { - 'impcount' => 0, - 'calls' => [ - 'TEXT', - 'basicfields', - 'textlines', - 'bodyMD5', - 'bodydisp', - 'bodylang', - 'bodyextra' - ], - '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' => 121 - }, 'Parse::RecDescent::Subrule' ), - bless( { - 'hashname' => '__DIRECTIVE1__', - 'name' => '', - 'lookahead' => 0, - 'line' => 121, - 'code' => '$commit = 1' - }, 'Parse::RecDescent::Directive' ), - bless( { - 'subrule' => 'basicfields', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 121 - }, 'Parse::RecDescent::Subrule' ), - bless( { - 'subrule' => 'textlines', - 'expected' => undef, - 'min' => 0, - 'argcode' => undef, - 'max' => 1, - 'matchrule' => 0, - 'repspec' => '?', - 'lookahead' => 0, - 'line' => 121 - }, 'Parse::RecDescent::Repetition' ), - bless( { - 'subrule' => 'bodyMD5', - 'expected' => undef, - 'min' => 0, - 'argcode' => undef, - 'max' => 1, - 'matchrule' => 0, - 'repspec' => '?', - 'lookahead' => 0, - 'line' => 121 - }, 'Parse::RecDescent::Repetition' ), - bless( { - 'subrule' => 'bodydisp', - 'expected' => undef, - 'min' => 0, - 'argcode' => undef, - 'max' => 1, - 'matchrule' => 0, - 'repspec' => '?', - 'lookahead' => 0, - 'line' => 122 - }, 'Parse::RecDescent::Repetition' ), - bless( { - 'subrule' => 'bodylang', - 'expected' => undef, - 'min' => 0, - 'argcode' => undef, - 'max' => 1, - 'matchrule' => 0, - 'repspec' => '?', - 'lookahead' => 0, - 'line' => 122 - }, 'Parse::RecDescent::Repetition' ), - bless( { - 'subrule' => 'bodyextra', - 'expected' => undef, - 'min' => 0, - 'argcode' => undef, - 'max' => 1, - 'matchrule' => 0, - 'repspec' => '?', - 'lookahead' => 0, - 'line' => 122 - }, 'Parse::RecDescent::Repetition' ), - bless( { - 'hashname' => '__ACTION1__', - 'lookahead' => 0, - 'line' => 123, - 'code' => '{ - $return = $item{basicfields} || {}; - $return->{bodytype} = \'TEXT\'; - take_optional_items($return, \\%item - , qw/textlines bodyMD5 bodydisp bodylang bodyextra/); - 1; - }' - }, 'Parse::RecDescent::Action' ) - ], - 'line' => undef - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'textmessage', - 'vars' => '', - 'line' => 121 - }, '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' => 67, - 'mod' => '', - 'ldelim' => '/' - }, 'Parse::RecDescent::Token' ), - bless( { - 'subrule' => 'NIL', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 67 - }, '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' => 67 - }, 'Parse::RecDescent::Subrule' ) - ], - 'line' => 67 - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'bodyid', - 'vars' => '', - 'line' => 67 - }, 'Parse::RecDescent::Rule' ), - 'bodyextra' => bless( { - 'impcount' => 0, - 'calls' => [ - 'NIL', - 'STRING', - 'STRINGS' - ], - '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' => 73 - }, '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' => 73 - }, 'Parse::RecDescent::Subrule' ) - ], - 'line' => 73 - }, 'Parse::RecDescent::Production' ), - bless( { - 'number' => '2', - 'strcount' => 0, - 'dircount' => 0, - 'uncommit' => undef, - 'error' => undef, - 'patcount' => 0, - 'actcount' => 0, - 'items' => [ - bless( { - 'subrule' => 'STRINGS', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 73 - }, 'Parse::RecDescent::Subrule' ) - ], - 'line' => 73 - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'bodyextra', - 'vars' => '', - 'line' => 73 - }, 'Parse::RecDescent::Rule' ), - 'othertypemessage' => bless( { - 'impcount' => 0, - 'calls' => [ - 'bodytype', - 'basicfields', - 'bodyMD5', - 'bodydisp', - 'bodylang', - 'bodyextra' - ], - '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' => 131 - }, 'Parse::RecDescent::Subrule' ), - bless( { - 'subrule' => 'basicfields', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 131 - }, 'Parse::RecDescent::Subrule' ), - bless( { - 'subrule' => 'bodyMD5', - 'expected' => undef, - 'min' => 0, - 'argcode' => undef, - 'max' => 1, - 'matchrule' => 0, - 'repspec' => '?', - 'lookahead' => 0, - 'line' => 131 - }, 'Parse::RecDescent::Repetition' ), - bless( { - 'subrule' => 'bodydisp', - 'expected' => undef, - 'min' => 0, - 'argcode' => undef, - 'max' => 1, - 'matchrule' => 0, - 'repspec' => '?', - 'lookahead' => 0, - 'line' => 131 - }, 'Parse::RecDescent::Repetition' ), - bless( { - 'subrule' => 'bodylang', - 'expected' => undef, - 'min' => 0, - 'argcode' => undef, - 'max' => 1, - 'matchrule' => 0, - 'repspec' => '?', - 'lookahead' => 0, - 'line' => 132 - }, 'Parse::RecDescent::Repetition' ), - bless( { - 'subrule' => 'bodyextra', - 'expected' => undef, - 'min' => 0, - 'argcode' => undef, - 'max' => 1, - 'matchrule' => 0, - 'repspec' => '?', - 'lookahead' => 0, - 'line' => 132 - }, 'Parse::RecDescent::Repetition' ), - bless( { - 'hashname' => '__ACTION1__', - 'lookahead' => 0, - 'line' => 133, - 'code' => '{ $return = { bodytype => $item{bodytype} }; - take_optional_items($return, \\%item - , qw/bodyMD5 bodydisp bodylang bodyextra/ ); - merge_hash($return, $item{basicfields}); - 1; - }' - }, 'Parse::RecDescent::Action' ) - ], - 'line' => undef - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'othertypemessage', - 'vars' => '', - 'line' => 131 - }, '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' => 58 - }, 'Parse::RecDescent::InterpLit' ), - bless( { - 'subrule' => 'key', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 58 - }, 'Parse::RecDescent::Subrule' ), - bless( { - 'subrule' => 'value', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 58 - }, 'Parse::RecDescent::Subrule' ), - bless( { - 'hashname' => '__ACTION1__', - 'lookahead' => 0, - 'line' => 59, - 'code' => '{ $return = { $item{key} => $item{value} } }' - }, 'Parse::RecDescent::Action' ) - ], - 'line' => undef - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'kvpair', - 'vars' => '', - 'line' => 58 - }, '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' => 69, - 'mod' => '', - 'ldelim' => '/' - }, 'Parse::RecDescent::Token' ), - bless( { - 'subrule' => 'NIL', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 69 - }, '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' => 'NUMBER', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 69 - }, 'Parse::RecDescent::Subrule' ) - ], - 'line' => 69 - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'bodysize', - 'vars' => '', - 'line' => 69 - }, 'Parse::RecDescent::Rule' ), - 'STRING' => bless( { - 'impcount' => 0, - 'calls' => [ - 'DOUBLE_QUOTED_STRING', - 'SINGLE_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' => 'DOUBLE_QUOTED_STRING', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 45 - }, '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' => 'SINGLE_QUOTED_STRING', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 45 - }, 'Parse::RecDescent::Subrule' ) - ], - 'line' => 45 - }, 'Parse::RecDescent::Production' ), - bless( { - 'number' => '2', - 'strcount' => 0, - 'dircount' => 0, - 'uncommit' => undef, - 'error' => undef, - 'patcount' => 0, - 'actcount' => 0, - 'items' => [ - bless( { - 'subrule' => 'BARESTRING', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 45 - }, 'Parse::RecDescent::Subrule' ) - ], - 'line' => 45 - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'STRING', - 'vars' => '', - 'line' => 45 - }, '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' => 0, - 'items' => [ - bless( { - 'subrule' => 'STRING', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 64 - }, 'Parse::RecDescent::Subrule' ) - ], - 'line' => undef - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'bodytype', - 'vars' => '', - 'line' => 64 - }, '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' => 29, - 'mod' => 'i', - 'ldelim' => '/' - }, 'Parse::RecDescent::Token' ), - bless( { - 'hashname' => '__ACTION1__', - 'lookahead' => 0, - 'line' => 29, - 'code' => '{ $return = "TEXT" }' - }, 'Parse::RecDescent::Action' ) - ], - 'line' => undef - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'TEXT', - 'vars' => '', - 'line' => 27 - }, 'Parse::RecDescent::Rule' ), - 'to' => bless( { - 'impcount' => 0, - 'calls' => [ - 'ADDRESSES' - ], - 'changed' => 0, - 'opcount' => 0, - 'prods' => [ - bless( { - 'number' => '0', - 'strcount' => 0, - 'dircount' => 0, - 'uncommit' => undef, - 'error' => undef, - 'patcount' => 0, - 'actcount' => 0, - 'items' => [ - bless( { - 'subrule' => 'ADDRESSES', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 102 - }, 'Parse::RecDescent::Subrule' ) - ], - 'line' => undef - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'to', - 'vars' => '', - 'line' => 102 - }, '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' => 34, - 'mod' => 'i', - 'ldelim' => '/' - }, 'Parse::RecDescent::Token' ), - bless( { - 'hashname' => '__ACTION1__', - 'lookahead' => 0, - 'line' => 34, - 'code' => '{ $return = "NIL" }' - }, 'Parse::RecDescent::Action' ) - ], - 'line' => undef - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'NIL', - 'vars' => '', - 'line' => 34 - }, 'Parse::RecDescent::Rule' ), - 'KVPAIRS' => bless( { - 'impcount' => 0, - 'calls' => [ - 'kvpair' - ], - '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' => 61 - }, 'Parse::RecDescent::InterpLit' ), - 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::InterpLit' ), - bless( { - 'hashname' => '__ACTION1__', - 'lookahead' => 0, - 'line' => 62, - 'code' => '{ $return = { map { (%$_) } @{$item{\'kvpair(s)\'}} } }' - }, 'Parse::RecDescent::Action' ) - ], - 'line' => undef - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'KVPAIRS', - 'vars' => '', - 'line' => 61 - }, 'Parse::RecDescent::Rule' ), - 'from' => bless( { - 'impcount' => 0, - 'calls' => [ - 'ADDRESSES' - ], - 'changed' => 0, - 'opcount' => 0, - 'prods' => [ - bless( { - 'number' => '0', - 'strcount' => 0, - 'dircount' => 0, - 'uncommit' => undef, - 'error' => undef, - 'patcount' => 0, - 'actcount' => 0, - 'items' => [ - bless( { - 'subrule' => 'ADDRESSES', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 99 - }, 'Parse::RecDescent::Subrule' ) - ], - 'line' => undef - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'from', - 'vars' => '', - 'line' => 99 - }, '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' => 181 - }, 'Parse::RecDescent::InterpLit' ), - bless( { - 'subrule' => 'part', - 'expected' => undef, - 'min' => 1, - 'argcode' => undef, - 'max' => 100000000, - 'matchrule' => 0, - 'repspec' => 's', - 'lookahead' => 0, - 'line' => 181 - }, 'Parse::RecDescent::Repetition' ), - bless( { - 'pattern' => ')', - 'hashname' => '__STRING2__', - 'description' => '\')\'', - 'lookahead' => 0, - 'line' => 181 - }, 'Parse::RecDescent::InterpLit' ), - bless( { - 'hashname' => '__ACTION1__', - 'lookahead' => 0, - 'line' => 182, - 'code' => '{ $return = $item{\'part(s)\'} }' - }, 'Parse::RecDescent::Action' ) - ], - 'line' => undef - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'bodystructure', - 'vars' => '', - 'line' => 181 - }, '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' => 30, - 'mod' => 'i', - 'ldelim' => '/' - }, 'Parse::RecDescent::Token' ), - bless( { - 'hashname' => '__ACTION1__', - 'lookahead' => 0, - 'line' => 30, - 'code' => '{ $return = "PLAIN" }' - }, 'Parse::RecDescent::Action' ) - ], - 'line' => undef - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'PLAIN', - 'vars' => '', - 'line' => 30 - }, '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' => 35, - 'mod' => '', - 'ldelim' => '/' - }, 'Parse::RecDescent::Token' ), - bless( { - 'hashname' => '__ACTION1__', - 'lookahead' => 0, - 'line' => 35, - 'code' => '{ $return = $item[1] }' - }, 'Parse::RecDescent::Action' ) - ], - 'line' => undef - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'NUMBER', - 'vars' => '', - 'line' => 35 - }, 'Parse::RecDescent::Rule' ), - 'STRINGS' => bless( { - 'impcount' => 0, - 'calls' => [ - 'STRING' - ], - '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' => 47 - }, 'Parse::RecDescent::InterpLit' ), - bless( { - 'subrule' => 'STRING', - 'expected' => undef, - 'min' => 1, - 'argcode' => undef, - 'max' => 100000000, - 'matchrule' => 0, - 'repspec' => 's', - 'lookahead' => 0, - 'line' => 47 - }, 'Parse::RecDescent::Repetition' ), - bless( { - 'pattern' => ')', - 'hashname' => '__STRING2__', - 'description' => '\')\'', - 'lookahead' => 0, - 'line' => 47 - }, 'Parse::RecDescent::InterpLit' ), - bless( { - 'hashname' => '__ACTION1__', - 'lookahead' => 0, - 'line' => 47, - 'code' => '{ $return = $item{\'STRING(s)\'} }' - }, 'Parse::RecDescent::Action' ) - ], - 'line' => undef - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'STRINGS', - 'vars' => '', - 'line' => 47 - }, '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' => 31, - 'mod' => 'i', - 'ldelim' => '/' - }, 'Parse::RecDescent::Token' ), - bless( { - 'hashname' => '__ACTION1__', - 'lookahead' => 0, - 'line' => 31, - 'code' => '{ $return = "HTML" }' - }, 'Parse::RecDescent::Action' ) - ], - 'line' => undef - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'HTML', - 'vars' => '', - 'line' => 31 - }, 'Parse::RecDescent::Rule' ), - 'bodydisp' => bless( { - 'impcount' => 0, - 'calls' => [ - 'NIL', - 'KVPAIRS' - ], - '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' => 66 - }, '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' => 'KVPAIRS', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 66 - }, 'Parse::RecDescent::Subrule' ) - ], - 'line' => 66 - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'bodydisp', - 'vars' => '', - 'line' => 66 - }, 'Parse::RecDescent::Rule' ), - 'part' => bless( { - 'impcount' => 0, - 'calls' => [ - 'multipart', - 'textmessage', - 'nestedmessage', - 'othertypemessage' - ], - 'changed' => 0, - 'opcount' => 0, - 'prods' => [ - bless( { - 'number' => '0', - 'strcount' => 0, - 'dircount' => 0, - 'uncommit' => undef, - 'error' => undef, - 'patcount' => 0, - 'actcount' => 1, - 'items' => [ - bless( { - 'subrule' => 'multipart', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 176 - }, 'Parse::RecDescent::Subrule' ), - bless( { - 'hashname' => '__ACTION1__', - 'lookahead' => 0, - 'line' => 176, - 'code' => '{ $return = bless $item{multipart}, $mibs }' - }, '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' => 177 - }, 'Parse::RecDescent::Subrule' ), - bless( { - 'hashname' => '__ACTION1__', - 'lookahead' => 0, - 'line' => 177, - 'code' => '{ $return = bless $item{textmessage}, $mibs }' - }, 'Parse::RecDescent::Action' ) - ], - 'line' => 177 - }, 'Parse::RecDescent::Production' ), - bless( { - 'number' => '2', - 'strcount' => 0, - 'dircount' => 0, - 'uncommit' => undef, - 'error' => undef, - 'patcount' => 0, - 'actcount' => 1, - 'items' => [ - bless( { - 'subrule' => 'nestedmessage', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 178 - }, 'Parse::RecDescent::Subrule' ), - bless( { - 'hashname' => '__ACTION1__', - 'lookahead' => 0, - 'line' => 178, - 'code' => '{ $return = bless $item{nestedmessage}, $mibs }' - }, 'Parse::RecDescent::Action' ) - ], - 'line' => 178 - }, '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' => 179 - }, 'Parse::RecDescent::Subrule' ), - bless( { - 'hashname' => '__ACTION1__', - 'lookahead' => 0, - 'line' => 179, - 'code' => '{ $return = bless $item{othertypemessage}, $mibs }' - }, 'Parse::RecDescent::Action' ) - ], - 'line' => 179 - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'part', - 'vars' => '', - 'line' => 176 - }, 'Parse::RecDescent::Rule' ), - 'nestedmessage' => bless( { - 'impcount' => 0, - 'calls' => [ - 'rfc822message', - 'bodyparms', - 'bodyid', - 'bodydesc', - 'bodyenc', - 'bodysize', - 'envelopestruct', - 'bodystructure', - 'textlines', - 'bodyMD5', - 'bodydisp', - 'bodylang', - 'bodyextra' - ], - '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' => 140 - }, 'Parse::RecDescent::Subrule' ), - bless( { - 'hashname' => '__DIRECTIVE1__', - 'name' => '', - 'lookahead' => 0, - 'line' => 140, - 'code' => '$commit = 1' - }, 'Parse::RecDescent::Directive' ), - bless( { - 'subrule' => 'bodyparms', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 140 - }, 'Parse::RecDescent::Subrule' ), - bless( { - 'subrule' => 'bodyid', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 140 - }, 'Parse::RecDescent::Subrule' ), - bless( { - 'subrule' => 'bodydesc', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 140 - }, 'Parse::RecDescent::Subrule' ), - bless( { - 'subrule' => 'bodyenc', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 140 - }, 'Parse::RecDescent::Subrule' ), - bless( { - 'subrule' => 'bodysize', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 141 - }, 'Parse::RecDescent::Subrule' ), - bless( { - 'subrule' => 'envelopestruct', - 'expected' => undef, - 'min' => 0, - 'argcode' => undef, - 'max' => 1, - 'matchrule' => 0, - 'repspec' => '?', - 'lookahead' => 0, - 'line' => 142 - }, 'Parse::RecDescent::Repetition' ), - bless( { - 'subrule' => 'bodystructure', - 'expected' => undef, - 'min' => 0, - 'argcode' => undef, - 'max' => 1, - 'matchrule' => 0, - 'repspec' => '?', - 'lookahead' => 0, - 'line' => 142 - }, 'Parse::RecDescent::Repetition' ), - bless( { - 'subrule' => 'textlines', - 'expected' => undef, - 'min' => 0, - 'argcode' => undef, - 'max' => 1, - 'matchrule' => 0, - 'repspec' => '?', - 'lookahead' => 0, - 'line' => 142 - }, 'Parse::RecDescent::Repetition' ), - bless( { - 'subrule' => 'bodyMD5', - 'expected' => undef, - 'min' => 0, - 'argcode' => undef, - 'max' => 1, - 'matchrule' => 0, - 'repspec' => '?', - 'lookahead' => 0, - 'line' => 143 - }, 'Parse::RecDescent::Repetition' ), - bless( { - 'subrule' => 'bodydisp', - 'expected' => undef, - 'min' => 0, - 'argcode' => undef, - 'max' => 1, - 'matchrule' => 0, - 'repspec' => '?', - 'lookahead' => 0, - 'line' => 143 - }, 'Parse::RecDescent::Repetition' ), - bless( { - 'subrule' => 'bodylang', - 'expected' => undef, - 'min' => 0, - 'argcode' => undef, - 'max' => 1, - 'matchrule' => 0, - 'repspec' => '?', - 'lookahead' => 0, - 'line' => 143 - }, 'Parse::RecDescent::Repetition' ), - bless( { - 'subrule' => 'bodyextra', - 'expected' => undef, - 'min' => 0, - 'argcode' => undef, - 'max' => 1, - 'matchrule' => 0, - 'repspec' => '?', - 'lookahead' => 0, - 'line' => 143 - }, 'Parse::RecDescent::Repetition' ), - bless( { - 'hashname' => '__ACTION1__', - 'lookahead' => 0, - 'line' => 144, - 'code' => '{ - $return = {}; - $return->{$_} = $item{$_} - for qw/bodyparms bodyid bodydesc bodyenc bodysize/; -# envelopestruct bodystructure textlines/; - - take_optional_items($return, \\%item - , qw/envelopestruct bodystructure textlines/ - , qw/bodyMD5 bodydisp bodylang bodyextra/); - - merge_hash($return, $item{bodystructure}[0]); - merge_hash($return, $item{basicfields}); - $return->{bodytype} = "MESSAGE" ; - $return->{bodysubtype} = "RFC822" ; - 1; - }' - }, 'Parse::RecDescent::Action' ) - ], - 'line' => undef - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'nestedmessage', - 'vars' => '', - 'line' => 140 - }, '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' => 39 - }, 'Parse::RecDescent::InterpLit' ), - bless( { - 'pattern' => '(?:\\\\\'|[^\'])*', - 'hashname' => '__PATTERN1__', - 'description' => '/(?:\\\\\\\\\'|[^\'])*/', - 'lookahead' => 0, - 'rdelim' => '/', - 'line' => 39, - 'mod' => '', - 'ldelim' => '/' - }, 'Parse::RecDescent::Token' ), - bless( { - 'pattern' => '\'', - 'hashname' => '__STRING2__', - 'description' => '\'\'\'', - 'lookahead' => 0, - 'line' => 39 - }, 'Parse::RecDescent::InterpLit' ), - bless( { - 'hashname' => '__ACTION1__', - 'lookahead' => 0, - 'line' => 39, - 'code' => '{ $return = $item{__PATTERN1__} }' - }, 'Parse::RecDescent::Action' ) - ], - 'line' => undef - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'SINGLE_QUOTED_STRING', - 'vars' => '', - 'line' => 37 - }, 'Parse::RecDescent::Rule' ), - 'ADDRESSES' => 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' => 94 - }, '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' => 95 - }, 'Parse::RecDescent::InterpLit' ), - bless( { - 'subrule' => 'addressstruct', - 'expected' => undef, - 'min' => 1, - 'argcode' => undef, - 'max' => 100000000, - 'matchrule' => 0, - 'repspec' => 's', - 'lookahead' => 0, - 'line' => 95 - }, 'Parse::RecDescent::Repetition' ), - bless( { - 'pattern' => ')', - 'hashname' => '__STRING2__', - 'description' => '\')\'', - 'lookahead' => 0, - 'line' => 95 - }, 'Parse::RecDescent::InterpLit' ), - bless( { - 'hashname' => '__ACTION1__', - 'lookahead' => 0, - 'line' => 95, - 'code' => '{ $return = $item{\'addressstruct(s)\'} }' - }, 'Parse::RecDescent::Action' ) - ], - 'line' => 95 - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'ADDRESSES', - 'vars' => '', - 'line' => 94 - }, 'Parse::RecDescent::Rule' ), - 'bcc' => bless( { - 'impcount' => 0, - 'calls' => [ - 'ADDRESSES' - ], - 'changed' => 0, - 'opcount' => 0, - 'prods' => [ - bless( { - 'number' => '0', - 'strcount' => 0, - 'dircount' => 0, - 'uncommit' => undef, - 'error' => undef, - 'patcount' => 0, - 'actcount' => 0, - 'items' => [ - bless( { - 'subrule' => 'ADDRESSES', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 98 - }, 'Parse::RecDescent::Subrule' ) - ], - 'line' => undef - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'bcc', - 'vars' => '', - 'line' => 98 - }, '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' => 51 - }, 'Parse::RecDescent::Subrule' ), - bless( { - 'subrule' => 'RFC822', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 51 - }, 'Parse::RecDescent::Subrule' ), - bless( { - 'hashname' => '__ACTION1__', - 'lookahead' => 0, - 'line' => 51, - 'code' => '{ $return = "MESSAGE RFC822" }' - }, 'Parse::RecDescent::Action' ) - ], - 'line' => undef - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'rfc822message', - 'vars' => '', - 'line' => 51 - }, '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' => 81 - }, 'Parse::RecDescent::InterpLit' ), - bless( { - 'subrule' => 'personalname', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 81 - }, 'Parse::RecDescent::Subrule' ), - bless( { - 'subrule' => 'sourceroute', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 81 - }, 'Parse::RecDescent::Subrule' ), - bless( { - 'subrule' => 'mailboxname', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 81 - }, 'Parse::RecDescent::Subrule' ), - bless( { - 'subrule' => 'hostname', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 81 - }, 'Parse::RecDescent::Subrule' ), - bless( { - 'pattern' => ')', - 'hashname' => '__STRING2__', - 'description' => '\')\'', - 'lookahead' => 0, - 'line' => 81 - }, 'Parse::RecDescent::InterpLit' ), - bless( { - 'hashname' => '__ACTION1__', - 'lookahead' => 0, - 'line' => 82, - 'code' => '{ bless { personalname => $item{personalname} - , sourceroute => $item{sourceroute} - , mailboxname => $item{mailboxname} - , hostname => $item{hostname} - }, \'Mail::IMAPClient::BodyStructure::Address\'; - }' - }, 'Parse::RecDescent::Action' ) - ], - 'line' => undef - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'addressstruct', - 'vars' => '', - 'line' => 81 - }, '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' => 77 - }, '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' => 77 - }, 'Parse::RecDescent::Subrule' ) - ], - 'line' => 77 - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'sourceroute', - 'vars' => '', - 'line' => 77 - }, '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' => 174 - }, 'Parse::RecDescent::InterpLit' ), - bless( { - 'subrule' => 'part', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 174 - }, 'Parse::RecDescent::Subrule' ), - bless( { - 'pattern' => ')', - 'hashname' => '__STRING2__', - 'description' => '\')\'', - 'lookahead' => 0, - 'line' => 174 - }, 'Parse::RecDescent::InterpLit' ), - bless( { - 'hashname' => '__ACTION1__', - 'lookahead' => 0, - 'line' => 174, - 'code' => '{$return = $item{part}}' - }, 'Parse::RecDescent::Action' ), - bless( { - 'hashname' => '__DIRECTIVE1__', - 'name' => '', - 'lookahead' => 0, - 'line' => 174, - 'code' => 'push @{$thisparser->{deferred}}, sub { ++$subpartCount; };' - }, 'Parse::RecDescent::Directive' ) - ], - 'line' => undef - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'subpart', - 'vars' => '', - 'line' => 174 - }, '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' => 49 - }, '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' => 'NUMBER', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 49 - }, 'Parse::RecDescent::Subrule' ) - ], - 'line' => 49 - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'textlines', - 'vars' => '', - 'line' => 49 - }, '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' => 42, - 'mod' => '', - 'ldelim' => '/' - }, 'Parse::RecDescent::Token' ), - bless( { - 'pattern' => '^(?!\\(|\\))(?:\\\\ |\\S)+', - 'hashname' => '__PATTERN2__', - 'description' => '/^(?!\\\\(|\\\\))(?:\\\\\\\\ |\\\\S)+/', - 'lookahead' => 0, - 'rdelim' => '/', - 'line' => 42, - 'mod' => '', - 'ldelim' => '/' - }, 'Parse::RecDescent::Token' ), - bless( { - 'hashname' => '__ACTION1__', - 'lookahead' => 0, - 'line' => 43, - 'code' => '{ $return = $item{__PATTERN1__} }' - }, 'Parse::RecDescent::Action' ) - ], - 'line' => undef - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'BARESTRING', - 'vars' => '', - 'line' => 42 - }, 'Parse::RecDescent::Rule' ), - 'bodyloc' => 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' => 74 - }, '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' => 74 - }, 'Parse::RecDescent::Subrule' ) - ], - 'line' => 74 - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'bodyloc', - 'vars' => '', - 'line' => 74 - }, 'Parse::RecDescent::Rule' ), - 'bodylang' => bless( { - 'impcount' => 0, - 'calls' => [ - 'NIL', - 'STRING', - 'STRINGS' - ], - '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' => 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' => 'STRING', - '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' => 'STRINGS', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 72 - }, 'Parse::RecDescent::Subrule' ) - ], - 'line' => 72 - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'bodylang', - 'vars' => '', - 'line' => 72 - }, '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' => 104 - }, 'Parse::RecDescent::InterpLit' ), - bless( { - 'subrule' => 'date', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 104 - }, 'Parse::RecDescent::Subrule' ), - bless( { - 'subrule' => 'subject', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 104 - }, 'Parse::RecDescent::Subrule' ), - bless( { - 'subrule' => 'from', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 104 - }, 'Parse::RecDescent::Subrule' ), - bless( { - 'subrule' => 'sender', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 104 - }, 'Parse::RecDescent::Subrule' ), - bless( { - 'subrule' => 'replyto', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 104 - }, 'Parse::RecDescent::Subrule' ), - bless( { - 'subrule' => 'to', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 104 - }, 'Parse::RecDescent::Subrule' ), - bless( { - 'subrule' => 'cc', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 104 - }, 'Parse::RecDescent::Subrule' ), - bless( { - 'subrule' => 'bcc', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 105 - }, 'Parse::RecDescent::Subrule' ), - bless( { - 'subrule' => 'inreplyto', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 105 - }, 'Parse::RecDescent::Subrule' ), - bless( { - 'subrule' => 'messageid', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 105 - }, 'Parse::RecDescent::Subrule' ), - bless( { - 'pattern' => ')', - 'hashname' => '__STRING2__', - 'description' => '\')\'', - 'lookahead' => 0, - 'line' => 105 - }, 'Parse::RecDescent::InterpLit' ), - bless( { - 'hashname' => '__ACTION1__', - 'lookahead' => 0, - 'line' => 106, - 'code' => '{ $return = bless {}, "Mail::IMAPClient::BodyStructure::Envelope"; - $return->{$_} = $item{$_} - for qw/date subject from sender replyto to cc/ - , qw/bcc inreplyto messageid/; - 1; - }' - }, 'Parse::RecDescent::Action' ) - ], - 'line' => undef - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'envelopestruct', - 'vars' => '', - 'line' => 104 - }, 'Parse::RecDescent::Rule' ), - 'replyto' => bless( { - 'impcount' => 0, - 'calls' => [ - 'ADDRESSES' - ], - 'changed' => 0, - 'opcount' => 0, - 'prods' => [ - bless( { - 'number' => '0', - 'strcount' => 0, - 'dircount' => 0, - 'uncommit' => undef, - 'error' => undef, - 'patcount' => 0, - 'actcount' => 0, - 'items' => [ - bless( { - 'subrule' => 'ADDRESSES', - 'matchrule' => 0, - 'implicit' => undef, - 'argcode' => undef, - 'lookahead' => 0, - 'line' => 100 - }, 'Parse::RecDescent::Subrule' ) - ], - 'line' => undef - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'replyto', - 'vars' => '', - 'line' => 100 - }, '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' => 78 - }, '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' => 78 - }, 'Parse::RecDescent::Subrule' ) - ], - 'line' => 78 - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'mailboxname', - 'vars' => '', - 'line' => 78 - }, 'Parse::RecDescent::Rule' ) - } - }, 'Parse::RecDescent' ); -} \ No newline at end of file diff --git a/Mail-IMAPClient-3.21/lib/Mail/IMAPClient/BodyStructure/Parse.pod b/Mail-IMAPClient-3.21/lib/Mail/IMAPClient/BodyStructure/Parse.pod deleted file mode 100644 index 418259c..0000000 --- a/Mail-IMAPClient-3.21/lib/Mail/IMAPClient/BodyStructure/Parse.pod +++ /dev/null @@ -1,15 +0,0 @@ -=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. diff --git a/Mail-IMAPClient-3.21/lib/Mail/IMAPClient/MessageSet.pm b/Mail-IMAPClient-3.21/lib/Mail/IMAPClient/MessageSet.pm deleted file mode 100644 index 28405ad..0000000 --- a/Mail-IMAPClient-3.21/lib/Mail/IMAPClient/MessageSet.pm +++ /dev/null @@ -1,280 +0,0 @@ -use warnings; -use strict; - -package Mail::IMAPClient::MessageSet; - -=head1 NAME - -Mail::IMAPClient::MessageSet - ranges of message sequence nummers - -=cut - -use overload - '""' => "str" - , '.=' => sub {$_[0]->cat($_[1])} - , '+=' => sub {$_[0]->cat($_[1])} - , '-=' => sub {$_[0]->rem($_[1])} - , '@{}' => "unfold" - , fallback => 1; - -sub new -{ my $class = shift; - my $range = $class->range(@_); - bless \$range, $class; -} - -sub str { overload::StrVal( ${$_[0]} ) } - -sub _unfold_range($) -# { my $x = shift; return if $x =~ m/[^0-9,:]$/; $x =~ s/\:/../g; eval $x; } -{ map { /(\d+)\s*\:\s*(\d+)/ ? ($1..$2) : $_ } - split /\,/, shift; -} - -sub rem -{ my $self = shift; - my %delete = map { ($_ => 1) } map { _unfold_range $_ } @_; - $$self = $self->range(grep {not $delete{$_}} $self->unfold); - $self; -} - -sub cat -{ my $self = shift; - $$self = $self->range($$self, @_); - $self; -} - -sub range -{ my $self = shift; - - my @msgs; - foreach my $m (@_) - { defined $m && length $m - or next; - - foreach my $mm (ref $m eq 'ARRAY' ? @$m : $m) - { push @msgs, _unfold_range $mm; - } - } - - @msgs - or return undef; - - @msgs = sort {$a <=> $b} @msgs; - my $low = my $high = shift @msgs; - - my @ranges; - foreach my $m (@msgs) - { next if $m == $high; # double - - if($m == $high + 1) { $high = $m } - else - { push @ranges, $low == $high ? $low : "$low:$high"; - $low = $high = $m; - } - } - - push @ranges, $low == $high ? $low : "$low:$high" ; - join ",", @ranges; -} - -sub unfold -{ my $self = shift; - wantarray ? ( _unfold_range $$self ) : [ _unfold_range $$self ]; -} - -=head1 SYNOPSIS - - my @msgs = $imap->search("SUBJECT","Virus"); # returns 1,3,4,5,6,9,10 - my $msgset = Mail::IMAPClient::MessageSet->new(@msgs); - print $msgset; # prints "1,3:6,9:10" - - # add message 14 to the set: - $msgset += 14; - print $msgset; # prints "1,3:6,9:10,14" - - # add messages 16,17,18,19, and 20 to the set: - $msgset .= "16,17,18:20"; - print $msgset; # prints "1,3:6,9:10,14,16:20" - - # Hey, I didn't really want message 17 in there; let's take it out: - $msgset -= 17; - print $msgset; # prints "1,3:6,9:10,14,16,18:20" - - # Now let's iterate over each message: - for my $msg (@$msgset) - { print "$msg\n"; # Prints: "1\n3\n4\n5\n6..16\n18\n19\n20\n" - } - print join("\n", @$msgset)."\n"; # same simpler - local $" = "\n"; print "@$msgset\n"; # even more simple - -=head1 DESCRIPTION - -The B 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-3.21/lib/Mail/IMAPClient/Thread.grammar b/Mail-IMAPClient-3.21/lib/Mail/IMAPClient/Thread.grammar deleted file mode 100644 index 543c182..0000000 --- a/Mail-IMAPClient-3.21/lib/Mail/IMAPClient/Thread.grammar +++ /dev/null @@ -1,18 +0,0 @@ -# Atoms: - -NUMBER: /\d+/ - -# Rules: - -threadmember: NUMBER { $return = $item{NUMBER} ; } | - thread { $return = $item{thread} ; } - -thread: "(" threadmember(s) ")" - { - $return = $item{'threadmember(s)'}||undef; - } - -# Start: -start: /^\* THREAD /i thread(s?) { - $return=$item{'thread(s?)'}||undef; -} diff --git a/Mail-IMAPClient-3.21/lib/Mail/IMAPClient/Thread.pm b/Mail-IMAPClient-3.21/lib/Mail/IMAPClient/Thread.pm deleted file mode 100644 index 67fa663..0000000 --- a/Mail-IMAPClient-3.21/lib/Mail/IMAPClient/Thread.pm +++ /dev/null @@ -1,1014 +0,0 @@ -package Mail::IMAPClient::Thread; -use Parse::RecDescent; - -{ my $ERRORS; - - -package Parse::RecDescent::Mail::IMAPClient::Thread; -use strict; -use vars qw($skip $AUTOLOAD ); -$skip = '\s*'; - - -{ -local $SIG{__WARN__} = sub {0}; -# PRETEND TO BE IN Parse::RecDescent NAMESPACE -*Parse::RecDescent::Mail::IMAPClient::Thread::AUTOLOAD = sub -{ - no strict 'refs'; - $AUTOLOAD =~ s/^Parse::RecDescent::Mail::IMAPClient::Thread/Parse::RecDescent/; - goto &{$AUTOLOAD}; -} -} - -push @Parse::RecDescent::Mail::IMAPClient::Thread::ISA, 'Parse::RecDescent'; -# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) -sub Parse::RecDescent::Mail::IMAPClient::Thread::thread -{ - my $thisparser = $_[0]; - use vars q{$tracelevel}; - local $tracelevel = ($tracelevel||0)+1; - $ERRORS = 0; - my $thisrule = $thisparser->{"rules"}{"thread"}; - - Parse::RecDescent::_trace(q{Trying rule: [thread]}, - Parse::RecDescent::_tracefirst($_[1]), - q{thread}, - $tracelevel) - if defined $::RD_TRACE; - - - my $err_at = @{$thisparser->{errors}}; - - my $score; - my $score_return; - my $_tok; - my $return = undef; - my $_matched=0; - my $commit=0; - my @item = (); - my %item = (); - my $repeating = defined($_[2]) && $_[2]; - my $_noactions = defined($_[3]) && $_[3]; - my @arg = defined $_[4] ? @{ &{$_[4]} } : (); - my %arg = ($#arg & 01) ? @arg : (@arg, undef); - my $text; - my $lastsep=""; - my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); - $expectation->at($_[1]); - - my $thisline; - tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; - - - - while (!$_matched && !$commit) - { - - Parse::RecDescent::_trace(q{Trying production: ['(' threadmember ')']}, - Parse::RecDescent::_tracefirst($_[1]), - q{thread}, - $tracelevel) - if defined $::RD_TRACE; - my $thisprod = $thisrule->{"prods"}[0]; - $text = $_[1]; - my $_savetext; - @item = (q{thread}); - %item = (__RULE__ => q{thread}); - my $repcount = 0; - - - Parse::RecDescent::_trace(q{Trying terminal: ['(']}, - Parse::RecDescent::_tracefirst($text), - q{thread}, - $tracelevel) - if defined $::RD_TRACE; - $lastsep = ""; - $expectation->is(q{})->at($text); - - - unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and do { $_tok = "("; 1 } and - substr($text,0,length($_tok)) eq $_tok and - do { substr($text,0,length($_tok)) = ""; 1; } - ) - { - - $expectation->failed(); - Parse::RecDescent::_trace(q{<>}, - Parse::RecDescent::_tracefirst($text)) - if defined $::RD_TRACE; - last; - } - Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} - . $_tok . q{])}, - Parse::RecDescent::_tracefirst($text)) - if defined $::RD_TRACE; - push @item, $item{__STRING1__}=$_tok; - - - Parse::RecDescent::_trace(q{Trying repeated subrule: [threadmember]}, - Parse::RecDescent::_tracefirst($text), - q{thread}, - $tracelevel) - if defined $::RD_TRACE; - $expectation->is(q{threadmember})->at($text); - - unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::Thread::threadmember, 1, 100000000, $_noactions,$expectation,undef))) - { - Parse::RecDescent::_trace(q{<>}, - Parse::RecDescent::_tracefirst($text), - q{thread}, - $tracelevel) - if defined $::RD_TRACE; - last; - } - Parse::RecDescent::_trace(q{>>Matched repeated subrule: [threadmember]<< (} - . @$_tok . q{ times)}, - - Parse::RecDescent::_tracefirst($text), - q{thread}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{threadmember(s)}} = $_tok; - push @item, $_tok; - - - - Parse::RecDescent::_trace(q{Trying terminal: [')']}, - Parse::RecDescent::_tracefirst($text), - q{thread}, - $tracelevel) - if defined $::RD_TRACE; - $lastsep = ""; - $expectation->is(q{')'})->at($text); - - - unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and do { $_tok = ")"; 1 } and - substr($text,0,length($_tok)) eq $_tok and - do { substr($text,0,length($_tok)) = ""; 1; } - ) - { - - $expectation->failed(); - Parse::RecDescent::_trace(q{<>}, - Parse::RecDescent::_tracefirst($text)) - if defined $::RD_TRACE; - last; - } - Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} - . $_tok . q{])}, - Parse::RecDescent::_tracefirst($text)) - if defined $::RD_TRACE; - push @item, $item{__STRING2__}=$_tok; - - - Parse::RecDescent::_trace(q{Trying action}, - Parse::RecDescent::_tracefirst($text), - q{thread}, - $tracelevel) - if defined $::RD_TRACE; - - - $_tok = ($_noactions) ? 0 : do { - $return = $item{'threadmember(s)'}||undef; - }; - unless (defined $_tok) - { - Parse::RecDescent::_trace(q{<> (return value: [undef])}) - if defined $::RD_TRACE; - last; - } - Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} - . $_tok . q{])}, - Parse::RecDescent::_tracefirst($text)) - if defined $::RD_TRACE; - push @item, $_tok; - $item{__ACTION1__}=$_tok; - - - - Parse::RecDescent::_trace(q{>>Matched production: ['(' threadmember ')']<<}, - Parse::RecDescent::_tracefirst($text), - q{thread}, - $tracelevel) - if defined $::RD_TRACE; - $_matched = 1; - last; - } - - - unless ( $_matched || defined($return) || defined($score) ) - { - - - $_[1] = $text; # NOT SURE THIS IS NEEDED - Parse::RecDescent::_trace(q{<>}, - Parse::RecDescent::_tracefirst($_[1]), - q{thread}, - $tracelevel) - if defined $::RD_TRACE; - return undef; - } - if (!defined($return) && defined($score)) - { - Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", - q{thread}, - $tracelevel) - if defined $::RD_TRACE; - $return = $score_return; - } - splice @{$thisparser->{errors}}, $err_at; - $return = $item[$#item] unless defined $return; - if (defined $::RD_TRACE) - { - Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . - $return . q{])}, "", - q{thread}, - $tracelevel); - Parse::RecDescent::_trace(q{(consumed: [} . - Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, - Parse::RecDescent::_tracefirst($text), - , q{thread}, - $tracelevel) - } - $_[1] = $text; - return $return; -} - -# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) -sub Parse::RecDescent::Mail::IMAPClient::Thread::NUMBER -{ - my $thisparser = $_[0]; - use vars q{$tracelevel}; - local $tracelevel = ($tracelevel||0)+1; - $ERRORS = 0; - my $thisrule = $thisparser->{"rules"}{"NUMBER"}; - - Parse::RecDescent::_trace(q{Trying rule: [NUMBER]}, - Parse::RecDescent::_tracefirst($_[1]), - q{NUMBER}, - $tracelevel) - if defined $::RD_TRACE; - - - my $err_at = @{$thisparser->{errors}}; - - my $score; - my $score_return; - my $_tok; - my $return = undef; - my $_matched=0; - my $commit=0; - my @item = (); - my %item = (); - my $repeating = defined($_[2]) && $_[2]; - my $_noactions = defined($_[3]) && $_[3]; - my @arg = defined $_[4] ? @{ &{$_[4]} } : (); - my %arg = ($#arg & 01) ? @arg : (@arg, undef); - my $text; - my $lastsep=""; - my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); - $expectation->at($_[1]); - - my $thisline; - tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; - - - - while (!$_matched && !$commit) - { - - Parse::RecDescent::_trace(q{Trying production: [/\\d+/]}, - Parse::RecDescent::_tracefirst($_[1]), - q{NUMBER}, - $tracelevel) - if defined $::RD_TRACE; - my $thisprod = $thisrule->{"prods"}[0]; - $text = $_[1]; - my $_savetext; - @item = (q{NUMBER}); - %item = (__RULE__ => q{NUMBER}); - my $repcount = 0; - - - Parse::RecDescent::_trace(q{Trying terminal: [/\\d+/]}, Parse::RecDescent::_tracefirst($text), - q{NUMBER}, - $tracelevel) - if defined $::RD_TRACE; - $lastsep = ""; - $expectation->is(q{})->at($text); - - - unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:\d+)//) - { - - $expectation->failed(); - Parse::RecDescent::_trace(q{<>}, - Parse::RecDescent::_tracefirst($text)) - if defined $::RD_TRACE; - - last; - } - Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} - . $& . q{])}, - Parse::RecDescent::_tracefirst($text)) - if defined $::RD_TRACE; - push @item, $item{__PATTERN1__}=$&; - - - - Parse::RecDescent::_trace(q{>>Matched production: [/\\d+/]<<}, - Parse::RecDescent::_tracefirst($text), - q{NUMBER}, - $tracelevel) - if defined $::RD_TRACE; - $_matched = 1; - last; - } - - - unless ( $_matched || defined($return) || defined($score) ) - { - - - $_[1] = $text; # NOT SURE THIS IS NEEDED - Parse::RecDescent::_trace(q{<>}, - Parse::RecDescent::_tracefirst($_[1]), - q{NUMBER}, - $tracelevel) - if defined $::RD_TRACE; - return undef; - } - if (!defined($return) && defined($score)) - { - Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", - q{NUMBER}, - $tracelevel) - if defined $::RD_TRACE; - $return = $score_return; - } - splice @{$thisparser->{errors}}, $err_at; - $return = $item[$#item] unless defined $return; - if (defined $::RD_TRACE) - { - Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . - $return . q{])}, "", - q{NUMBER}, - $tracelevel); - Parse::RecDescent::_trace(q{(consumed: [} . - Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, - Parse::RecDescent::_tracefirst($text), - , q{NUMBER}, - $tracelevel) - } - $_[1] = $text; - return $return; -} - -# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) -sub Parse::RecDescent::Mail::IMAPClient::Thread::start -{ - my $thisparser = $_[0]; - use vars q{$tracelevel}; - local $tracelevel = ($tracelevel||0)+1; - $ERRORS = 0; - my $thisrule = $thisparser->{"rules"}{"start"}; - - Parse::RecDescent::_trace(q{Trying rule: [start]}, - Parse::RecDescent::_tracefirst($_[1]), - q{start}, - $tracelevel) - if defined $::RD_TRACE; - - - my $err_at = @{$thisparser->{errors}}; - - my $score; - my $score_return; - my $_tok; - my $return = undef; - my $_matched=0; - my $commit=0; - my @item = (); - my %item = (); - my $repeating = defined($_[2]) && $_[2]; - my $_noactions = defined($_[3]) && $_[3]; - my @arg = defined $_[4] ? @{ &{$_[4]} } : (); - my %arg = ($#arg & 01) ? @arg : (@arg, undef); - my $text; - my $lastsep=""; - my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); - $expectation->at($_[1]); - - my $thisline; - tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; - - - - while (!$_matched && !$commit) - { - - Parse::RecDescent::_trace(q{Trying production: [/^\\* THREAD /i thread]}, - Parse::RecDescent::_tracefirst($_[1]), - q{start}, - $tracelevel) - if defined $::RD_TRACE; - my $thisprod = $thisrule->{"prods"}[0]; - $text = $_[1]; - my $_savetext; - @item = (q{start}); - %item = (__RULE__ => q{start}); - my $repcount = 0; - - - Parse::RecDescent::_trace(q{Trying terminal: [/^\\* THREAD /i]}, Parse::RecDescent::_tracefirst($text), - q{start}, - $tracelevel) - if defined $::RD_TRACE; - $lastsep = ""; - $expectation->is(q{})->at($text); - - - unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:^\* THREAD )//i) - { - - $expectation->failed(); - Parse::RecDescent::_trace(q{<>}, - Parse::RecDescent::_tracefirst($text)) - if defined $::RD_TRACE; - - last; - } - Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} - . $& . q{])}, - Parse::RecDescent::_tracefirst($text)) - if defined $::RD_TRACE; - push @item, $item{__PATTERN1__}=$&; - - - Parse::RecDescent::_trace(q{Trying repeated subrule: [thread]}, - Parse::RecDescent::_tracefirst($text), - q{start}, - $tracelevel) - if defined $::RD_TRACE; - $expectation->is(q{thread})->at($text); - - unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::Thread::thread, 0, 100000000, $_noactions,$expectation,undef))) - { - Parse::RecDescent::_trace(q{<>}, - Parse::RecDescent::_tracefirst($text), - q{start}, - $tracelevel) - if defined $::RD_TRACE; - last; - } - Parse::RecDescent::_trace(q{>>Matched repeated subrule: [thread]<< (} - . @$_tok . q{ times)}, - - Parse::RecDescent::_tracefirst($text), - q{start}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{thread(s?)}} = $_tok; - push @item, $_tok; - - - - Parse::RecDescent::_trace(q{Trying action}, - Parse::RecDescent::_tracefirst($text), - q{start}, - $tracelevel) - if defined $::RD_TRACE; - - - $_tok = ($_noactions) ? 0 : do { - $return=$item{'thread(s?)'}||undef; -}; - unless (defined $_tok) - { - Parse::RecDescent::_trace(q{<> (return value: [undef])}) - if defined $::RD_TRACE; - last; - } - Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} - . $_tok . q{])}, - Parse::RecDescent::_tracefirst($text)) - if defined $::RD_TRACE; - push @item, $_tok; - $item{__ACTION1__}=$_tok; - - - - Parse::RecDescent::_trace(q{>>Matched production: [/^\\* THREAD /i thread]<<}, - Parse::RecDescent::_tracefirst($text), - q{start}, - $tracelevel) - if defined $::RD_TRACE; - $_matched = 1; - last; - } - - - unless ( $_matched || defined($return) || defined($score) ) - { - - - $_[1] = $text; # NOT SURE THIS IS NEEDED - Parse::RecDescent::_trace(q{<>}, - Parse::RecDescent::_tracefirst($_[1]), - q{start}, - $tracelevel) - if defined $::RD_TRACE; - return undef; - } - if (!defined($return) && defined($score)) - { - Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", - q{start}, - $tracelevel) - if defined $::RD_TRACE; - $return = $score_return; - } - splice @{$thisparser->{errors}}, $err_at; - $return = $item[$#item] unless defined $return; - if (defined $::RD_TRACE) - { - Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . - $return . q{])}, "", - q{start}, - $tracelevel); - Parse::RecDescent::_trace(q{(consumed: [} . - Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, - Parse::RecDescent::_tracefirst($text), - , q{start}, - $tracelevel) - } - $_[1] = $text; - return $return; -} - -# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) -sub Parse::RecDescent::Mail::IMAPClient::Thread::threadmember -{ - my $thisparser = $_[0]; - use vars q{$tracelevel}; - local $tracelevel = ($tracelevel||0)+1; - $ERRORS = 0; - my $thisrule = $thisparser->{"rules"}{"threadmember"}; - - Parse::RecDescent::_trace(q{Trying rule: [threadmember]}, - Parse::RecDescent::_tracefirst($_[1]), - q{threadmember}, - $tracelevel) - if defined $::RD_TRACE; - - - my $err_at = @{$thisparser->{errors}}; - - my $score; - my $score_return; - my $_tok; - my $return = undef; - my $_matched=0; - my $commit=0; - my @item = (); - my %item = (); - my $repeating = defined($_[2]) && $_[2]; - my $_noactions = defined($_[3]) && $_[3]; - my @arg = defined $_[4] ? @{ &{$_[4]} } : (); - my %arg = ($#arg & 01) ? @arg : (@arg, undef); - my $text; - my $lastsep=""; - my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); - $expectation->at($_[1]); - - my $thisline; - tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; - - - - while (!$_matched && !$commit) - { - - Parse::RecDescent::_trace(q{Trying production: [NUMBER]}, - Parse::RecDescent::_tracefirst($_[1]), - q{threadmember}, - $tracelevel) - if defined $::RD_TRACE; - my $thisprod = $thisrule->{"prods"}[0]; - $text = $_[1]; - my $_savetext; - @item = (q{threadmember}); - %item = (__RULE__ => q{threadmember}); - my $repcount = 0; - - - Parse::RecDescent::_trace(q{Trying subrule: [NUMBER]}, - Parse::RecDescent::_tracefirst($text), - q{threadmember}, - $tracelevel) - if defined $::RD_TRACE; - if (1) { no strict qw{refs}; - $expectation->is(q{})->at($text); - unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::Thread::NUMBER($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) - { - - Parse::RecDescent::_trace(q{<>}, - Parse::RecDescent::_tracefirst($text), - q{threadmember}, - $tracelevel) - if defined $::RD_TRACE; - $expectation->failed(); - last; - } - Parse::RecDescent::_trace(q{>>Matched subrule: [NUMBER]<< (return value: [} - . $_tok . q{]}, - - Parse::RecDescent::_tracefirst($text), - q{threadmember}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{NUMBER}} = $_tok; - push @item, $_tok; - - } - - Parse::RecDescent::_trace(q{Trying action}, - Parse::RecDescent::_tracefirst($text), - q{threadmember}, - $tracelevel) - if defined $::RD_TRACE; - - - $_tok = ($_noactions) ? 0 : do { $return = $item{NUMBER} ; }; - unless (defined $_tok) - { - Parse::RecDescent::_trace(q{<> (return value: [undef])}) - if defined $::RD_TRACE; - last; - } - Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} - . $_tok . q{])}, - Parse::RecDescent::_tracefirst($text)) - if defined $::RD_TRACE; - push @item, $_tok; - $item{__ACTION1__}=$_tok; - - - - Parse::RecDescent::_trace(q{>>Matched production: [NUMBER]<<}, - Parse::RecDescent::_tracefirst($text), - q{threadmember}, - $tracelevel) - if defined $::RD_TRACE; - $_matched = 1; - last; - } - - - while (!$_matched && !$commit) - { - - Parse::RecDescent::_trace(q{Trying production: [thread]}, - Parse::RecDescent::_tracefirst($_[1]), - q{threadmember}, - $tracelevel) - if defined $::RD_TRACE; - my $thisprod = $thisrule->{"prods"}[1]; - $text = $_[1]; - my $_savetext; - @item = (q{threadmember}); - %item = (__RULE__ => q{threadmember}); - my $repcount = 0; - - - Parse::RecDescent::_trace(q{Trying subrule: [thread]}, - Parse::RecDescent::_tracefirst($text), - q{threadmember}, - $tracelevel) - if defined $::RD_TRACE; - if (1) { no strict qw{refs}; - $expectation->is(q{})->at($text); - unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::Thread::thread($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) - { - - Parse::RecDescent::_trace(q{<>}, - Parse::RecDescent::_tracefirst($text), - q{threadmember}, - $tracelevel) - if defined $::RD_TRACE; - $expectation->failed(); - last; - } - Parse::RecDescent::_trace(q{>>Matched subrule: [thread]<< (return value: [} - . $_tok . q{]}, - - Parse::RecDescent::_tracefirst($text), - q{threadmember}, - $tracelevel) - if defined $::RD_TRACE; - $item{q{thread}} = $_tok; - push @item, $_tok; - - } - - Parse::RecDescent::_trace(q{Trying action}, - Parse::RecDescent::_tracefirst($text), - q{threadmember}, - $tracelevel) - if defined $::RD_TRACE; - - - $_tok = ($_noactions) ? 0 : do { $return = $item{thread} ; }; - unless (defined $_tok) - { - Parse::RecDescent::_trace(q{<> (return value: [undef])}) - if defined $::RD_TRACE; - last; - } - Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} - . $_tok . q{])}, - Parse::RecDescent::_tracefirst($text)) - if defined $::RD_TRACE; - push @item, $_tok; - $item{__ACTION1__}=$_tok; - - - - Parse::RecDescent::_trace(q{>>Matched production: [thread]<<}, - Parse::RecDescent::_tracefirst($text), - q{threadmember}, - $tracelevel) - if defined $::RD_TRACE; - $_matched = 1; - last; - } - - - unless ( $_matched || defined($return) || defined($score) ) - { - - - $_[1] = $text; # NOT SURE THIS IS NEEDED - Parse::RecDescent::_trace(q{<>}, - Parse::RecDescent::_tracefirst($_[1]), - q{threadmember}, - $tracelevel) - if defined $::RD_TRACE; - return undef; - } - if (!defined($return) && defined($score)) - { - Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", - q{threadmember}, - $tracelevel) - if defined $::RD_TRACE; - $return = $score_return; - } - splice @{$thisparser->{errors}}, $err_at; - $return = $item[$#item] unless defined $return; - if (defined $::RD_TRACE) - { - Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . - $return . q{])}, "", - q{threadmember}, - $tracelevel); - Parse::RecDescent::_trace(q{(consumed: [} . - Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, - Parse::RecDescent::_tracefirst($text), - , q{threadmember}, - $tracelevel) - } - $_[1] = $text; - return $return; -} -} -package Mail::IMAPClient::Thread; sub new { my $self = bless( { - '_AUTOTREE' => undef, - 'localvars' => '', - 'startcode' => '', - '_check' => { - 'thisoffset' => '', - 'itempos' => '', - 'prevoffset' => '', - 'prevline' => '', - 'prevcolumn' => '', - 'thiscolumn' => '' - }, - 'namespace' => 'Parse::RecDescent::Mail::IMAPClient::Thread', - '_AUTOACTION' => undef, - 'rules' => { - 'thread' => bless( { - 'impcount' => 0, - 'calls' => [ - 'threadmember' - ], - 'changed' => 0, - 'opcount' => 0, - 'prods' => [ - bless( { - 'number' => '0', - 'strcount' => 2, - 'dircount' => 0, - 'uncommit' => undef, - 'error' => undef, - 'patcount' => 0, - 'actcount' => 1, - 'items' => [ - bless( { - 'pattern' => '(', - 'hashname' => '__STRING1__', - 'description' => '\'(\'', - 'lookahead' => 0, - 'line' => 180 - }, 'Parse::RecDescent::InterpLit' ), - bless( { - 'subrule' => 'threadmember', - 'expected' => undef, - 'min' => 1, - 'argcode' => undef, - 'max' => 100000000, - 'matchrule' => 0, - 'repspec' => 's', - 'lookahead' => 0, - 'line' => 180 - }, 'Parse::RecDescent::Repetition' ), - bless( { - 'pattern' => ')', - 'hashname' => '__STRING2__', - 'description' => '\')\'', - 'lookahead' => 0, - 'line' => 180 - }, 'Parse::RecDescent::InterpLit' ), - bless( { - 'hashname' => '__ACTION1__', - 'lookahead' => 0, - 'line' => 181, - 'code' => '{ - $return = $item{\'threadmember(s)\'}||undef; - }' - }, 'Parse::RecDescent::Action' ) - ], - 'line' => undef - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'thread', - 'vars' => '', - 'line' => 180 - }, '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' => 173, - 'mod' => '', - 'ldelim' => '/' - }, 'Parse::RecDescent::Token' ) - ], - 'line' => undef - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'NUMBER', - 'vars' => '', - 'line' => 171 - }, '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' => 186, - 'mod' => 'i', - 'ldelim' => '/' - }, 'Parse::RecDescent::Token' ), - bless( { - 'subrule' => 'thread', - 'expected' => undef, - 'min' => 0, - 'argcode' => undef, - 'max' => 100000000, - 'matchrule' => 0, - 'repspec' => 's?', - 'lookahead' => 0, - 'line' => 186 - }, 'Parse::RecDescent::Repetition' ), - bless( { - 'hashname' => '__ACTION1__', - 'lookahead' => 0, - 'line' => 186, - 'code' => '{ - $return=$item{\'thread(s?)\'}||undef; -}' - }, 'Parse::RecDescent::Action' ) - ], - 'line' => undef - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'start', - 'vars' => '', - 'line' => 185 - }, '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' => 177 - }, 'Parse::RecDescent::Subrule' ), - bless( { - 'hashname' => '__ACTION1__', - 'lookahead' => 0, - 'line' => 177, - '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' => 178 - }, 'Parse::RecDescent::Subrule' ), - bless( { - 'hashname' => '__ACTION1__', - 'lookahead' => 0, - 'line' => 178, - 'code' => '{ $return = $item{thread} ; }' - }, 'Parse::RecDescent::Action' ) - ], - 'line' => 177 - }, 'Parse::RecDescent::Production' ) - ], - 'name' => 'threadmember', - 'vars' => '', - 'line' => 175 - }, 'Parse::RecDescent::Rule' ) - } - }, 'Parse::RecDescent' ); -} \ No newline at end of file diff --git a/Mail-IMAPClient-3.21/lib/Mail/IMAPClient/Thread.pod b/Mail-IMAPClient-3.21/lib/Mail/IMAPClient/Thread.pod deleted file mode 100644 index 46a5a26..0000000 --- a/Mail-IMAPClient-3.21/lib/Mail/IMAPClient/Thread.pod +++ /dev/null @@ -1,14 +0,0 @@ -=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. diff --git a/Mail-IMAPClient-3.21/prepare_dist b/Mail-IMAPClient-3.21/prepare_dist deleted file mode 100644 index fddf7da..0000000 --- a/Mail-IMAPClient-3.21/prepare_dist +++ /dev/null @@ -1,37 +0,0 @@ -#!/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-3.21/sample.perldb b/Mail-IMAPClient-3.21/sample.perldb deleted file mode 100644 index 0c299ec..0000000 --- a/Mail-IMAPClient-3.21/sample.perldb +++ /dev/null @@ -1 +0,0 @@ -&parse_options("NonStop=1 LineInfo=mail_imapclient_db.out"); diff --git a/Mail-IMAPClient-3.21/t/basic.t b/Mail-IMAPClient-3.21/t/basic.t deleted file mode 100644 index 4a22ef7..0000000 --- a/Mail-IMAPClient-3.21/t/basic.t +++ /dev/null @@ -1,348 +0,0 @@ -#!/usr/bin/perl - -use strict; -use warnings; -use Test::More; -use File::Temp qw(tempfile); - -my $debug = $ARGV[0]; - -my %parms; -my $range = 0; -my $uidplus = 0; -my $fast = 1; - -BEGIN { - open TST, 'test.txt' - or plan skip_all => 'test parameters not provided in test.txt'; - - while ( my $l = ) { - chomp $l; - my ( $p, $v ) = split /\=/, $l, 2; - s/^\s+//, s/\s+$// for $p, $v; - $parms{$p} = $v if $v; - } - - close TST; - - my @missing; - foreach my $p (qw/server user passed/) { - push( @missing, $p ) unless defined $parms{$p}; - } - - @missing - ? plan skip_all => "missing value for: @missing" - : plan tests => 64; -} - -BEGIN { use_ok('Mail::IMAPClient') or exit; } - -my $imap = Mail::IMAPClient->new( - Server => $parms{server}, - Port => $parms{port}, - User => $parms{user}, - Password => $parms{passed}, - Authmechanism => $parms{authmech}, - Clear => 0, - Fast_IO => $fast, - Uid => $uidplus, - Range => $range, - - Debug => $debug, - Debug_fh => ( $debug ? IO::File->new( 'imap1.debug', 'w' ) : undef ) -); - -ok( defined $imap, 'created client' ); -$imap - or 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 the Mail::IMAPClient module from CPAN. -__TEST_MSG - -ok( $imap->noop, "noop" ); - -my $sep = $imap->separator; -ok( defined $sep, "separator is '$sep'" ); - -my $ispar = $imap->is_parent('INBOX'); -my ( $target, $target2 ) = - $ispar - ? ( "INBOX${sep}IMAPClient_$$", "INBOX${sep}IMAPClient_2_$$" ) - : ( "IMAPClient_$$", "IMAPClient_2_$$" ); - -ok( defined $ispar, "INBOX is_parent '$ispar' (note: target '$target')" ); - -ok( $imap->select('inbox'), "select inbox" ); -ok( $imap->create($target), "create target" ); - -{ - my $list = $imap->list(); - is( ref($list), "ARRAY", "list" ); - - my $lsub = $imap->lsub(); - is( ref($lsub), "ARRAY", "lsub" ); - - ok( $imap->subscribe($target), "subscribe target" ); - - my $sub1 = $imap->subscribed(); - is( ( grep( /^\Q$target\E$/, @$sub1 ) )[0], "$target", "subscribed" ); - - ok( $imap->unsubscribe($target), "unsubscribe target" ); - - my $sub2 = $imap->subscribed(); - is( ( grep( /^\Q$target\E$/, @$sub2 ) )[0], undef, "unsubscribed" ); - - ok( $imap->tag_and_run("NOOP\r\n"), "tag_and_run" ); -} - -my $fwquotes = qq($target${sep}has "quotes"); -if ( !$imap->is_parent($target) ) { - ok( 1, "not parent, skipping quote test 1/3" ); - ok( 1, "not parent, skipping quote test 2/3" ); - ok( 1, "not parent, skipping quote test 3/3" ); -} -elsif ( $imap->create($fwquotes) ) { - ok( 1, "create $fwquotes" ); - ok( $imap->select($fwquotes), 'select $fwquotes' ); - ok( $imap->close, 'close $fwquotes' ); - $imap->select('inbox'); - ok( $imap->delete($fwquotes), 'delete $fwquotes' ); -} -else { - if ( $imap->LastError =~ /NO Invalid.*name/ ) { - ok( 1, "$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" ); - -my $uid = $imap->append( $target, $testmsg ); -ok( defined $uid, "append test message to $target" ); - -ok( $imap->select($target), "select $target" ); - -my $msg = ( $uidplus and $uid ) ? $uid : ( $imap->messages )[0]; -my $size = $imap->size($msg); - -cmp_ok( $size, '>', 0, "has size $size" ); - -my $string = $imap->message_string($msg); -ok( defined $string, "returned string" ); - -cmp_ok( length($string), '==', $size, "string has size" ); - -{ - my ( $fh, $fn ) = tempfile UNLINK => 1; - ok( $imap->message_to_file( $fn, $msg ), "to file $fn" ); - - cmp_ok( -s $fn, '==', $size, "correct size" ); -} - -my $fields = $imap->search( "HEADER", "Message-id", "NOT_A_MESSAGE_ID" ); -is( scalar @$fields, 0, 'bogus message id does not exist' ); - -my @seen = $imap->seen; -cmp_ok( scalar @seen, '==', 1, 'have seen 1' ); - -ok( $imap->deny_seeing( \@seen ), 'deny seeing' ); -my @unseen = $imap->unseen; -cmp_ok( scalar @unseen, '==', 1, 'have unseen 1' ); - -ok( $imap->see( \@seen ), "let's see one" ); -cmp_ok( scalar @seen, '==', 1, 'have seen 1' ); - -$imap->deny_seeing(@seen); # reset - -$imap->Peek(1); -my $subject = $imap->parse_headers( $seen[0], "Subject" )->{Subject}[0]; -unlike( join( "", $imap->flags( $seen[0] ) ), qr/\\Seen/i, 'Peek==1' ); - -$imap->deny_seeing(@seen); -$imap->Peek(0); -$subject = $imap->parse_headers( $seen[0], "Subject" )->{Subject}[0]; -like( join( "", $imap->flags( $seen[0] ) ), qr/\\Seen/i, 'Peek==0' ); - -$imap->deny_seeing(@seen); -$imap->Peek(undef); -$subject = $imap->parse_headers( $seen[0], "Subject" )->{Subject}[0]; -unlike( join( "", $imap->flags( $seen[0] ) ), qr/\\Seen/i, 'Peek==undef' ); - -my $uid2 = $imap->copy( $target2, 1 ); -ok( $uid2, "copy $target2" ); - -my @res = $imap->fetch( 1, "RFC822.TEXT" ); -ok( scalar @res, "fetch rfc822" ); - -my $res1 = $imap->fetch_hash("RFC822.SIZE"); -is( ref($res1), "HASH", "fetch_hash(RFC822.SIZE)" ); - -my $res2 = $imap->fetch_hash( 1, "RFC822.SIZE" ); -is( ref($res2), "HASH", "fetch_hash(1,RFC822.SIZE)" ); - -my $h = $imap->parse_headers( 1, "Subject" ); -ok( $h, "got subject" ); -like( $h->{Subject}[0], qr/^Testing from pid/, "subject matched" ); - -ok( $imap->select($target), "select $target" ); -my @hits = $imap->search( SUBJECT => 'Testing' ); -cmp_ok( scalar @hits, '==', 1, 'hit subject Testing' ); -ok( defined $hits[0], "subject is defined" ); - -ok( $imap->delete_message(@hits), 'delete hits' ); -my $flaghash = $imap->flags( \@hits ); -my $flagflag = 0; -foreach my $v ( values %$flaghash ) { - $flagflag += grep /\\Deleted/, @$v; -} -cmp_ok( $flagflag, '==', scalar @hits, "delete verified" ); - -my @nohits = $imap->search( \qq(SUBJECT "Productioning") ); -cmp_ok( scalar @nohits, '==', 0, 'no hits expected' ); - -ok( $imap->restore_message(@hits), 'restore messages' ); - -$flaghash = $imap->flags( \@hits ); -foreach my $v ( values %$flaghash ) { - $flagflag-- unless grep /\\Deleted/, @$v; -} -cmp_ok( $flagflag, '==', 0, "restore verified" ); - -$imap->select($target2); -ok( - $imap->delete_message( scalar( $imap->search("ALL") ) ) - && $imap->close - && $imap->delete($target2), - "delete $target2" -); - -$imap->select("INBOX"); -$@ = undef; -@hits = - $imap->search( BEFORE => Mail::IMAPClient::Rfc2060_date(time), "UNDELETED" ); -ok( !$@, "search undeleted" ) or diag( '$@:' . $@ ); - -# -# Test migrate method -# - -my $im2 = Mail::IMAPClient->new( - 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: $@"; - -ok( !$@, "LastError not set" ) or diag( '$@:' . $@ ); - -# -my $total_bytes1 = 0; -for ( $imap->search("ALL") ) { - my $s = $imap->size($_); - $total_bytes1 += $s; - print "Size of msg $_ is $s\n" if $debug; -} - -my $total_bytes2 = 0; -for ( $im2->search("ALL") ) { - my $s = $im2->size($_); - $total_bytes2 += $s; - print "Size of msg $_ is $s\n" if $debug; -} - -ok( !$@, "LastError not set" ) or diag( '$@:' . $@ ); -cmp_ok( $total_bytes1, '==', $total_bytes2, 'size source==target' ); - -# cleanup -$im2->select($migtarget); -$im2->delete_message( @{ $im2->messages } ) - if $im2->message_count; - -ok( $im2->close, "close" ); -$im2->delete($migtarget); - -ok( $im2->logout, "logout" ); - -# Test IDLE -{ - if ( $imap->has_capability("IDLE") ) { - ok( my $idle = $imap->idle, "idle" ); - sleep 1; - ok( $imap->done($idle), "done" ); - ok( !$@, "LastError not set" ) or diag( '$@:' . $@ ); - } - else { - ok( 1, "idle not supported" ); - ok( 1, "skipping 1/2 idle tests" ); - ok( 1, "skipping 2/2 idle tests" ); - } -} - -$imap->select('inbox'); -if ( $imap->rename( $target, "${target}NEW" ) ) { - ok( 1, 'rename' ); - $imap->close; - $imap->select("${target}NEW"); - $imap->delete_message( @{ $imap->messages } ) if $imap->message_count; - $imap->close; - $imap->delete("${target}NEW"); -} -else { - ok( 0, 'rename failed' ); - $imap->delete_message( @{ $imap->messages } ) - if $imap->message_count; - $imap->close; - $imap->delete($target); -} - -$imap->_disconnect; -ok( $imap->reconnect, "reconnect" ); diff --git a/Mail-IMAPClient-3.21/t/bodystructure.t b/Mail-IMAPClient-3.21/t/bodystructure.t deleted file mode 100644 index 1f3bc08..0000000 --- a/Mail-IMAPClient-3.21/t/bodystructure.t +++ /dev/null @@ -1,58 +0,0 @@ -#!/usr/bin/perl - -use strict; -use warnings; -use Test::More tests => 11; - -BEGIN { use_ok('Mail::IMAPClient::BodyStructure') or exit; } - -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 ), - - # Better parsing in version 3.03, changed this outcome - # "1#2#2.HEAD#2.1#2.2#2.2.HEAD#2.2.1#2.2.1.1#2.2.1.2" -"1#2#2.HEAD#2.1#2.1.1#2.1.2#2.1.2.HEAD#2.1.2.1#2.1.2.1.1#2.1.2.1.1.1#2.1.2.1.1.2", - 'parts' -); - -my $bs3 = <<'END_OF_BS3'; -FETCH (UID 1 BODYSTRUCTURE (("TEXT" "PLAIN" ("charset" "ISO-8859-1") -NIL NIL "quoted-printable" 1744 0)("TEXT" "HTML" ("charset" -"ISO-8859-1") NIL NIL "quoted-printable" 1967 0) "ALTERNATIVE")) -END_OF_BS3 - -$bsobj = Mail::IMAPClient::BodyStructure->new($bs3); -ok( defined $bsobj, 'parsed third' ); - -my $bs4 = <<'END_OF_BS4'; -* 9 FETCH (UID 9 BODYSTRUCTURE (("TEXT" "PLAIN" ("charset" "us-ascii") NIL "Notification" "7BIT" 588 0)("MESSAGE" "DELIVERY-STATUS" NIL NIL "Delivery report" "7BIT" 459)("MESSAGE" "RFC822" NIL NIL "Undelivered Message" "8bit" 10286 ("Thu, 31 May 2007 11:25:56 +0200 (CEST)" "*****SPAM***** RE: Daily News" (("admin@activtrades.com" NIL "polettld" "ensma.fr")) (("admin@activtrades.com" NIL "polettld" "ensma.fr")) (("admin@activtrades.com" NIL "polettld" "ensma.fr")) ((NIL NIL "polettld" "ensma.fr")) NIL NIL "NIL" "<20070531133257.92825.qmail@cc299962-a.haaks1.ov.home.nl>") (("TEXT" "PLAIN" ("charset" "iso-8859-1") NIL NIL "7bit" 1510 0)("MESSAGE" "RFC822" ("name" "message" "x-spam-type" "original") NIL "Original message" "8bit" 5718) "MIXED")) "REPORT")) -END_OF_BS4 - -$bsobj = Mail::IMAPClient::BodyStructure->new($bs4); -ok( defined $bsobj, 'parsed fourth' ); - -# test bodyMD5, contributed by Micheal Stok -my $bs5 = <<'END_OF_BS5'; -* 6 FETCH (UID 17280 BODYSTRUCTURE ((("text" "plain" ("charset" "utf-8") NIL NIL "quoted-printable" 1143 37 NIL NIL NIL)("text" "html" ("charset" "utf-8") NIL NIL "quoted-printable" 4618 106 NIL NIL NIL) "alternative" ("boundary" "Boundary-00=_Z7P340MWKGMMYJ0CCJD0") NIL NIL)("image" "tiff" ("name" "8dd0e430.tif") NIL NIL "base64" 204134 "pmZp5QOBa9BIqFNmvxUiyQ==" ("attachment" ("filename" "8dd0e430.tif")) NIL) "mixed" ("boundary" "Boundary-00=_T7P340MWKGMMYJ0CCJD0") NIL NIL)) -END_OF_BS5 - -$bsobj = Mail::IMAPClient::BodyStructure->new($bs5); -ok( defined $bsobj, 'parsed fifth' ); diff --git a/Mail-IMAPClient-3.21/t/fetch_hash.t b/Mail-IMAPClient-3.21/t/fetch_hash.t deleted file mode 100644 index 179ebf5..0000000 --- a/Mail-IMAPClient-3.21/t/fetch_hash.t +++ /dev/null @@ -1,233 +0,0 @@ -#!/usr/bin/perl -# -# -# tests for fetch_hash() -# -# fetch_hash() calls fetch() internally. rather than refactor -# fetch_hash() just for testing, we instead subclass M::IC and use the -# overidden fetch() to feed it test data. - -use strict; -use warnings; -use Test::More tests => 18; - -BEGIN { use_ok('Mail::IMAPClient') or exit; } - -my @tests = ( - [ - "unquoted value", - [ q{* 1 FETCH (UNQUOTED foobar)}, ], - [ [1], qw(UNQUOTED) ], - { "1" => { "UNQUOTED" => q{foobar}, } }, - ], - [ - "quoted value", - [ q{* 1 FETCH (QUOTED "foo bar baz")}, ], - [ [1], qw(QUOTED) ], - { "1" => { "QUOTED" => q{foo bar baz}, }, }, - ], - [ - "parenthesized value", - [ q{* 1 FETCH (PARENS (foo bar))}, ], - [ [1], qw(PARENS) ], - { "1" => { "PARENS" => q{foo bar}, }, }, - ], - [ - "parenthesized value with quotes", - [ q{* 1 FETCH (PARENS (foo "bar" baz))}, ], - [ [1], qw(PARENS) ], - { "1" => { "PARENS" => q{foo "bar" baz}, }, }, - ], - [ - "parenthesized value with parens at start", - [ q{* 1 FETCH (PARENS ((foo) bar baz))}, ], - [ [1], qw(PARENS) ], - { "1" => { "PARENS" => q{(foo) bar baz}, }, }, - ], - [ - "parenthesized value with parens in middle", - [ q{* 1 FETCH (PARENS (foo (bar) baz))}, ], - [ [1], qw(PARENS) ], - { "1" => { "PARENS" => q{foo (bar) baz}, }, }, - ], - [ - "parenthesized value with parens at end", - [ q{* 1 FETCH (PARENS (foo bar (baz)))}, ], - [ [1], qw(PARENS) ], - { "1" => { "PARENS" => q{foo bar (baz)}, }, }, - ], - [ - "complex parens", - [ q{* 1 FETCH (PARENS ((((foo) "bar") baz (quux))))}, ], - [ [1], qw(PARENS) ], - { "1" => { "PARENS" => q{(((foo) "bar") baz (quux))}, }, }, - ], - [ - "basic literal value", - [ q{* 1 FETCH (LITERAL}, q{foo}, q{)}, ], - [ [1], qw(LITERAL) ], - { "1" => { "LITERAL" => q{foo}, }, }, - ], - [ - "multiline literal value", - [ q{* 1 FETCH (LITERAL}, q{foo\r\nbar\r\nbaz\r\n}, q{)}, ], - [ [1], qw(LITERAL) ], - { "1" => { "LITERAL" => q{foo\r\nbar\r\nbaz\r\n}, }, }, - ], - [ - "multiple attributes", - [ q{* 1 FETCH (FOO foo BAR bar BAZ baz)}, ], - [ [1], qw(FOO BAR BAZ) ], - { - "1" => { - "FOO" => q{foo}, - "BAR" => q{bar}, - "BAZ" => q{baz}, - }, - }, - ], - [ - "dotted attribute", - [ q{* 1 FETCH (FOO.BAR foobar)}, ], - [ [1], qw(FOO.BAR) ], - { "1" => { "FOO.BAR" => q{foobar}, }, }, - ], - [ - "complex attribute", - [ q{* 1 FETCH (FOO.BAR[BAZ (QUUX)] quuz)}, ], - [ [1], q{FOO.BAR[BAZ (QUUX)]} ], - { "1" => { q{FOO.BAR[BAZ (QUUX)]} => q{quuz}, }, }, - ], - [ - "BODY.PEEK[] requests match BODY[] responses", - [ q{* 1 FETCH (BODY[] foo)} ], - [ [1], qw(BODY.PEEK[]) ], - { "1" => { "BODY[]" => q{foo}, }, }, - ], - [ - "BODY.PEEK[] requests match BODY.PEEK[] responses also", - [ q{* 1 FETCH (BODY.PEEK[] foo)} ], - [ [1], qw(BODY.PEEK[]) ], - { "1" => { "BODY.PEEK[]" => q{foo}, }, }, - ], - [ - "real life example", - [ -'* 1 FETCH (UID 541 FLAGS (\\Seen) INTERNALDATE "15-Sep-2009 20:05:45 +1000" RFC822.SIZE 771 BODY[HEADER.FIELDS (TO FROM DATE SUBJECT)]', - 'Date: Tue, 15 Sep 2009 20:05:45 +1000 -To: rob@pyro -From: rob@pyro -Subject: test Tue, 15 Sep 2009 20:05:45 +1000 - -', - ' BODY[]', - 'Return-Path: -X-Spam-Checker-Version: SpamAssassin 3.2.5 (2008-06-10) on pyro.home -X-Spam-Level: -X-Spam-Status: No, score=-0.5 required=5.0 tests=ALL_TRUSTED,BAYES_00, - FH_FROMEML_NOTLD,TO_MALFORMED autolearn=no version=3.2.5 -X-Original-To: rob@pyro -Delivered-To: rob@pyro -Received: from pyro (pyro [127.0.0.1]) - by pyro.home (Postfix) with ESMTP id A5C8115A066 - for ; Tue, 15 Sep 2009 20:05:45 +1000 (EST) -Date: Tue, 15 Sep 2009 20:05:45 +1000 -To: rob@pyro -From: rob@pyro -Subject: test Tue, 15 Sep 2009 20:05:45 +1000 -X-Mailer: swaks v20061116.0 jetmore.org/john/code/#swaks -Message-Id: <20090915100545.A5C8115A066@pyro.home> -X-Bogosity: Spam, tests=bogofilter, spamicity=0.999693, version=1.2.1 -Lines: 1 - -This is a test mailing -', - ') -', - ], - [ - [1], - q{BODY.PEEK[HEADER.FIELDS (To From Date Subject)]}, - qw(FLAGS INTERNALDATE RFC822.SIZE BODY[]) - ], - { - "1" => { - 'BODY[]' => 'Return-Path: -X-Spam-Checker-Version: SpamAssassin 3.2.5 (2008-06-10) on pyro.home -X-Spam-Level: -X-Spam-Status: No, score=-0.5 required=5.0 tests=ALL_TRUSTED,BAYES_00, - FH_FROMEML_NOTLD,TO_MALFORMED autolearn=no version=3.2.5 -X-Original-To: rob@pyro -Delivered-To: rob@pyro -Received: from pyro (pyro [127.0.0.1]) - by pyro.home (Postfix) with ESMTP id A5C8115A066 - for ; Tue, 15 Sep 2009 20:05:45 +1000 (EST) -Date: Tue, 15 Sep 2009 20:05:45 +1000 -To: rob@pyro -From: rob@pyro -Subject: test Tue, 15 Sep 2009 20:05:45 +1000 -X-Mailer: swaks v20061116.0 jetmore.org/john/code/#swaks -Message-Id: <20090915100545.A5C8115A066@pyro.home> -X-Bogosity: Spam, tests=bogofilter, spamicity=0.999693, version=1.2.1 -Lines: 1 - -This is a test mailing -', - 'INTERNALDATE' => '15-Sep-2009 20:05:45 +1000', - 'FLAGS' => '\\Seen', - 'BODY[HEADER.FIELDS (TO FROM DATE SUBJECT)]' => - 'Date: Tue, 15 Sep 2009 20:05:45 +1000 -To: rob@pyro -From: rob@pyro -Subject: test Tue, 15 Sep 2009 20:05:45 +1000 - -', - 'RFC822.SIZE' => '771' - }, - }, - ], -); - -my @uid_tests = ( - [ - "uid enabled", - [ q{* 1 FETCH (UID 123 UNQUOTED foobar)}, ], - [ [123], qw(UNQUOTED) ], - { "123" => { "UNQUOTED" => q{foobar}, } }, - ], -); - -package Test::Mail::IMAPClient; - -use vars qw(@ISA); -@ISA = qw(Mail::IMAPClient); - -sub new { - my ( $class, %args ) = @_; - my %me = %args; - return bless \%me, $class; -} - -sub fetch { - my ( $self, @args ) = @_; - return $self->{_next_fetch_response} || []; -} - -package main; - -sub run_tests { - my ( $imap, $tests ) = @_; - - for my $test (@$tests) { - my ( $comment, $fetch, $request, $response ) = @$test; - $imap->{_next_fetch_response} = $fetch; - my $r = $imap->fetch_hash(@$request); - is_deeply( $r, $response, $comment ); - } -} - -my $imap = Test::Mail::IMAPClient->new( Uid => 0 ); -run_tests( $imap, \@tests ); - -$imap->Uid(1); -run_tests( $imap, \@uid_tests ); diff --git a/Mail-IMAPClient-3.21/t/messageset.t b/Mail-IMAPClient-3.21/t/messageset.t deleted file mode 100644 index 9d3520e..0000000 --- a/Mail-IMAPClient-3.21/t/messageset.t +++ /dev/null @@ -1,37 +0,0 @@ -#!/usr/bin/perl - -use strict; -use warnings; -use Test::More tests => 7; - -BEGIN { use_ok('Mail::IMAPClient::MessageSet') or exit; } - -my $one = q/1:4,3:6,10:15,20:25,2:8/; -my $range = Mail::IMAPClient::MessageSet->new($one); -is( $range, "1:8,10:15,20:25", 'range simplify' ); - -is( - join( ",", $range->unfold ), - "1,2,3,4,5,6,7,8,10,11,12,13,14,15,20,21,22,23,24,25", - 'range unfold' -); - -$range .= "30,31,32,31:34,40:44"; -is( $range, "1:8,10:15,20:25,30:34,40:44", 'overload concat' ); - -is( - join( ",", $range->unfold ), - "1,2,3,4,5,6,7,8,10,11,12,13,14,15,20,21,22,23,24,25," - . "30,31,32,33,34,40,41,42,43,44", - 'unfold extended' -); - -$range -= "1:2"; -is( $range, "3:8,10:15,20:25,30:34,40:44", 'overload subtract' ); - -is( - join( ",", $range->unfold ), - "3,4,5,6,7,8,10,11,12,13,14,15,20,21,22,23,24,25," - . "30,31,32,33,34,40,41,42,43,44", - 'subtract unfold' -); diff --git a/Mail-IMAPClient-3.21/t/pod.t b/Mail-IMAPClient-3.21/t/pod.t deleted file mode 100644 index a79ef22..0000000 --- a/Mail-IMAPClient-3.21/t/pod.t +++ /dev/null @@ -1,10 +0,0 @@ -#!/usr/bin/perl - -use strict; -use warnings; -use Test::More; - -eval "use Test::Pod 1.00"; -plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; - -all_pod_files_ok(); diff --git a/Mail-IMAPClient-3.21/t/simple.t b/Mail-IMAPClient-3.21/t/simple.t deleted file mode 100644 index 335e121..0000000 --- a/Mail-IMAPClient-3.21/t/simple.t +++ /dev/null @@ -1,36 +0,0 @@ -#!/usr/bin/perl - -use strict; -use warnings; -use Test::More tests => 13; - -BEGIN { use_ok('Mail::IMAPClient') or exit; } - -{ - my $obj = Mail::IMAPClient->new(); - - my %t = ( 0 => "01-Jan-1970" ); - foreach my $k ( sort keys %t ) { - my $v = $t{$k}; - my $s = $v . ' 00:00:00 +0000'; - - is( Mail::IMAPClient::Rfc2060_date($k), $v, "Rfc2060_date($k)=$v" ); - is( Mail::IMAPClient::Rfc3501_date($k), $v, "Rfc3501_date($k)=$v" ); - is( Mail::IMAPClient::Rfc3501_datetime($k), - $s, "Rfc3501_datetime($k)=$s" ); - is( Mail::IMAPClient::Rfc2060_datetime($k), - $s, "Rfc3501_datetime($k)=$s" ); - is( $obj->Rfc3501_date($k), $v, "->Rfc3501_date($k)=$v" ); - is( $obj->Rfc2060_date($k), $v, "->Rfc2060_date($k)=$v" ); - is( $obj->Rfc3501_datetime($k), $s, "->Rfc3501_datetime($k)=$s" ); - is( $obj->Rfc2060_datetime($k), $s, "->Rfc2060_datetime($k)=$s" ); - - foreach my $z (qw(+0000 -0500)) { - my $vz = $v . ' 00:00:00 ' . $z; - is( Mail::IMAPClient::Rfc2060_datetime( $k, $z ), - $vz, "Rfc2060_datetime($k)=$vz" ); - is( Mail::IMAPClient::Rfc3501_datetime( $k, $z ), - $vz, "Rfc3501_datetime($k)=$vz" ); - } - } -} diff --git a/Mail-IMAPClient-3.21/t/thread.t b/Mail-IMAPClient-3.21/t/thread.t deleted file mode 100644 index 2e569b8..0000000 --- a/Mail-IMAPClient-3.21/t/thread.t +++ /dev/null @@ -1,30 +0,0 @@ -#!/usr/bin/perl - -use strict; -use warnings; -use Test::More tests => 7; - -BEGIN { use_ok('Mail::IMAPClient::Thread') or exit; } - -my $t1 = <<'e1'; -* THREAD (166)(167)(168)(169)(172)(170)(171)(173)(174 175 176 178 181 180)(179)(177 183 182 188 184 185 186 187 189)(190)(191)(192)(193)(194 195)(196 197 198)(199)(200 202)(201)(203)(204)(205)(206 207)(208) -e1 - -my $t2 = <<'e2'; -* THREAD (166)(167)(168)(169)(172)((170)(179))(171)(173)((174)(175)(176)(178)(181)(180))((177)(183)(182)(188 (184)(189))(185 186)(187))(190)(191)(192)(193)((194)(195 196))(197 198)(199)(200 202)(201)(203)(204)(205 206 207)(208) -e2 - -my $parser = Mail::IMAPClient::Thread->new; -ok( defined $parser, 'created parser' ); - -isa_ok( $parser, 'Parse::RecDescent' ); # !!! - -my $thr1 = $parser->start($t1); -ok( defined $thr1, 'thread1 start' ); - -cmp_ok( scalar(@$thr1), '==', 25 ); - -my $thr2 = $parser->start($t2); -ok( defined $thr2, 'thread2 start' ); - -cmp_ok( scalar(@$thr2), '==', 23 ); diff --git a/Mail-IMAPClient-3.21/test_template.txt b/Mail-IMAPClient-3.21/test_template.txt deleted file mode 100644 index 6c6db28..0000000 --- a/Mail-IMAPClient-3.21/test_template.txt +++ /dev/null @@ -1,5 +0,0 @@ -server=imap.server.hostname -user=username -passed=password -port=143 -authmechanism=LOGIN diff --git a/README b/README index 636c6c0..3946bee 100644 --- a/README +++ b/README @@ -3,7 +3,7 @@ NAME Synchronise mailboxes between two imap servers. Good at IMAP migration. More than 32 different IMAP server softwares supported with success. - $Revision: 1.310 $ + $Revision: 1.311 $ INSTALL imapsync works fine under any Unix OS with perl. @@ -369,5 +369,5 @@ SIMILAR SOFTWARES Feedback (good or bad) will always be welcome. - $Id: imapsync,v 1.310 2010/02/26 01:24:59 gilles Exp gilles $ + $Id: imapsync,v 1.311 2010/04/27 23:03:39 gilles Exp gilles $ diff --git a/TIME b/TIME new file mode 100644 index 0000000..75a3646 --- /dev/null +++ b/TIME @@ -0,0 +1 @@ +45 minutes diff --git a/VERSION b/VERSION index f8f19eb..27b7bea 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -1.310 +1.311 diff --git a/imapsync b/imapsync index 0a05f96..a1068e4 100755 --- a/imapsync +++ b/imapsync @@ -9,7 +9,7 @@ tool. Synchronise mailboxes between two imap servers. Good at IMAP migration. More than 32 different IMAP server softwares supported with success. -$Revision: 1.310 $ +$Revision: 1.311 $ =head1 INSTALL @@ -426,7 +426,7 @@ Entries for imapsync: Feedback (good or bad) will always be welcome. -$Id: imapsync,v 1.310 2010/02/26 01:24:59 gilles Exp gilles $ +$Id: imapsync,v 1.311 2010/04/27 23:03:39 gilles Exp gilles $ =cut @@ -489,7 +489,7 @@ my( $authmech1, $authmech2, $split1, $split2, $reconnectretry1, $reconnectretry2, - $tests, $test_builder, + $tests, $test_builder, $tests_debug, $allow3xx, $justlogin, $tmpdir, ); @@ -497,7 +497,7 @@ my( use vars qw ($opt_G); # missing code for this will be option. -$rcs = '$Id: imapsync,v 1.310 2010/02/26 01:24:59 gilles Exp gilles $ '; +$rcs = '$Id: imapsync,v 1.311 2010/04/27 23:03:39 gilles Exp gilles $ '; $rcs =~ m/,v (\d+\.\d+)/; $VERSION = ($1) ? $1: "UNKNOWN"; @@ -562,8 +562,8 @@ while (@argv_copy) { my $banner = join("", '$RCSfile: imapsync,v $ ', - '$Revision: 1.310 $ ', - '$Date: 2010/02/26 01:24:59 $ ', + '$Revision: 1.311 $ ', + '$Date: 2010/04/27 23:03:39 $ ', "\n",localhost_info(), " and the module Mail::IMAPClient version used here is ", $VERSION_IMAPClient,"\n", @@ -1010,14 +1010,16 @@ sub compare_lists { my ($list_1_ref, $list_2_ref) = @_; return(-1) if ((not defined($list_1_ref)) and defined($list_2_ref)); - return(0) if (! $list_1_ref); # end if no list - return(1) if (! $list_2_ref); # end if only one list + return(0) if ((not defined($list_1_ref)) and not defined($list_2_ref)); # end if no list + return(1) if (not defined($list_2_ref)); # end if only one list if (not ref($list_1_ref)) {$list_1_ref = [$list_1_ref]}; if (not ref($list_2_ref)) {$list_2_ref = [$list_2_ref]}; - my $last_used_indice = 0; + my $last_used_indice = -1; + #print "\$#$list_1_ref:", $#$list_1_ref, "\n"; + #print "\$#$list_2_ref:", $#$list_2_ref, "\n"; ELEMENT: foreach my $indice ( 0 .. $#$list_1_ref ) { $last_used_indice = $indice; @@ -1047,15 +1049,23 @@ sub tests_compare_lists { ok( 0 == compare_lists(undef) , 'compare_lists, undef = nothing'); ok( 0 == compare_lists(undef, undef) , 'compare_lists, undef = undef'); ok(-1 == compare_lists(undef , []) , 'compare_lists, undef < []'); + ok(-1 == compare_lists(undef , [1]) , 'compare_lists, undef < [1]'); + ok(-1 == compare_lists(undef , [0]) , 'compare_lists, undef < [0]'); ok(+1 == compare_lists([]) , 'compare_lists, [] > nothing'); ok(+1 == compare_lists([], undef) , 'compare_lists, [] > undef'); ok( 0 == compare_lists([] , []) , 'compare_lists, [] = []'); + + ok(-1 == compare_lists([] , [1]) , 'compare_lists, [] < [1]'); + ok(+1 == compare_lists([1] , []) , 'compare_lists, [1] > []'); + ok( 0 == compare_lists([1], 1 ) , "compare_lists, [1] = 1 ") ; ok( 0 == compare_lists( 1 , [1]) , "compare_lists, 1 = [1]") ; ok( 0 == compare_lists( 1 , 1 ) , "compare_lists, 1 = 1 ") ; - ok(-1 == compare_lists( 1 , 2 ) , "compare_lists, 1 = 1 ") ; - ok(+1 == compare_lists( 2 , 1 ) , "compare_lists, 1 = 1 ") ; + ok(-1 == compare_lists( 0 , 1 ) , "compare_lists, 0 < 1 ") ; + ok(-1 == compare_lists(-1 , 0 ) , "compare_lists, -1 < 0 ") ; + ok(-1 == compare_lists( 1 , 2 ) , "compare_lists, 1 < 2 ") ; + ok(+1 == compare_lists( 2 , 1 ) , "compare_lists, 2 > 1 ") ; ok( 0 == compare_lists([1,2], [1,2]) , "compare_lists, [1,2] = [1,2]") ; @@ -1880,7 +1890,7 @@ FOLDER: foreach my $h1_fold (@h1_folders) { $h1_flags = flags_filter($h1_flags, $permanentflags2) if ($permanentflags2); - # compare flags - set flags if there a diffrence + # compare flags - set flags if there a difference my @h1_flags = sort split(' ', $h1_flags ); my @h2_flags = sort split(' ', $h2_flags ); my $diff = compare_lists(\@h1_flags, \@h2_flags); @@ -2149,6 +2159,7 @@ sub get_options { "reconnectretry1=i" => \$reconnectretry1, "reconnectretry2=i" => \$reconnectretry2, "tests" => \$tests, + "tests_debug" => \$tests_debug, "allow3xx!" => \$allow3xx, "justlogin!" => \$justlogin, "tmpdir=s" => \$tmpdir, @@ -2164,6 +2175,11 @@ sub get_options { tests(); exit; } + if ($tests_debug) { + $test_builder->no_ending(0); + tests_debug(); + exit; + } $help = 1 if ! $numopt; load_modules(); @@ -2449,6 +2465,13 @@ EOF } +sub tests_debug { + + SKIP: { + skip "No test in normal run" if (not $tests_debug); + tests_compare_lists(); + } +} sub tests { diff --git a/zzz b/zzz new file mode 100644 index 0000000..8b13789 --- /dev/null +++ b/zzz @@ -0,0 +1 @@ +