Mail-IMAPClient-3.38/0000755000175000017500000000000012656252125013552 5ustar ppearlppearlMail-IMAPClient-3.38/Makefile.PL0000644000175000017500000001005012535524202015512 0ustar ppearlppearluse ExtUtils::MakeMaker; use warnings; use strict; use 5.008_001; my @missing; my %optional = ( "Authen::NTLM" => { for => "Authmechanism 'NTLM'" }, "Authen::SASL" => { for => "Authmechanism 'DIGEST-MD5'" }, "Compress::Zlib" => { for => "COMPRESS DEFLATE support" }, "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; } # HACK: die on broken Parse::RecDescent 1.966002 through 1.967009 # - rt.cpan.org#74593: Recent changes break Module::ExtractUse and ... # - rt.cpan.org#74733: Fails with Parse::RecDescent >= 1.966_002 do { eval { require version; require Parse::RecDescent; }; unless ($@) { my $found = version->parse( Parse::RecDescent->VERSION() ); my $broke = version->parse("1.966002"); my $fixed = version->parse("1.967009"); if ( $found < $fixed and $found >= $broke ) { die( "Found broken Parse::RecDescent $found in your environment.\n", "Please upgrade to version $fixed or greater.\n" ); } } }; WriteMakefile( NAME => 'Mail::IMAPClient', AUTHOR => 'Phil Pearl (Lobbes) ', ABSTRACT => 'IMAP4 client library', VERSION_FROM => 'lib/Mail/IMAPClient.pm', LICENSE => 'perl', META_MERGE => { resources => { bugtracker => { web => 'http://rt.cpan.org/Public/Dist/Display.html?Name=Mail-IMAPClient', mailto => 'bug-Mail-IMAPClient@rt.cpan.org', }, homepage => 'http://sourceforge.net/projects/mail-imapclient/', repository => { url => 'git://git.code.sf.net/p/mail-imapclient/git', web => 'http://sourceforge.net/p/mail-imapclient/git/', type => 'git', }, }, }, MIN_PERL_VERSION => '5.008', 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' }, ); set_test_data(); exit 0; ### ### HELPERS ### sub set_test_data { unless ( -f "lib/Mail/IMAPClient.pm" ) { warn("ERROR: not in installation directory\n"); return; } if ( -s "./test.txt" ) { print("The file test.txt will be used for extended tests.\n"); return; } print < [ (IO::Socket::.. args) ] + cleanup connect() to more flexible with IO::Socket::* args - untagged server data during send literal may cause client to hang [Arthur Wolfe, Josh Hillman] + _send_line() needs '+' only to know it is OK to send LITERAL data + created _response_code_sub() to simplify _get_response() - remove internal "Folders" cache - Allow for RFC 6154 "IMAP LIST Extension for Special-Use Mailboxes" [Mathias Reitinger] + new method: folders_hash() + deprecate: xlist_folders(), xlist() version 3.33: Tue, May 14, 2013 10:12:43 AM - more cleanup on use of $@ and $! - cleanup get_bodystructure / get_envelope - allow Ssl arg as an arrayref to pass args to IO::Socket::SSL [Ramana V Mokkapati] - no need to Massage() the folder name in uidnext() - rt.cpan.org#84028: get_envelope() fails when subject ends w/backslash [Andy Lyttle] - rt.cpan.org#79476: move()/copy() with sequence causes numeric warning [Oleg G] - *move()/copy() no longer sort message(s) provided by caller version 3.32: Fri, Aug 10, 2012 4:43:24 PM - document RFC2087 quota related calls [Mathias Reitinger] documentation request - rt.cpan.org#78474: idle/idle_data documentation error [Dima Kogan] - Quote()/Massage() now uses literals for non ascii data [Mathias Reitinger] reported issues with utf8 data in password - use Quote()/Massage() consistently now in: login() proxyauth() deleteacl() setacl() listrights() rename() - documented deleteacl() and other minor pod cleanup - ran Mail::IMAPClient::BodyStructure through perltidy - update year in README/pod to 2012 - rt.cpan.org#74733: Fails with Parse::RecDescent >= 1.966_002 rt.cpan.org#74593: Recent changes break Module::ExtractUse and ... [ANDK, TEAM, SREZIC, NBEBOUT at CPAN and nine from detonation] - Makefile.PL avoid buggy Parse::RecDescent 1.966_002 until 1.967_009 - rt.cpan.org#76989: Mail::IMAPClient::BodyStructure usage/docs [Pierluigi Frullani] - fix incorrect documentation on new() - lots of doc verbiage updates version 3.31: Mon, Mar 19, 2012 11:11:11 AM - rt.cpan.org#74799: Support for partial data responses in fetch_hash [Philip Garrett] + bonus: cleaner handling of BODY.PEEK responses - properly handle ALL|FULL|FAST fetch macros in fetch_hash version 3.30: Fri Nov 11 09:37:00 EST 2011 - rt.cpan.org#72347: Starttls array ref argument dereferenced twice [Jonathan Buhacoff] - during connect(): Port now defaults 143 or 993 if $self->Ssl [Kodi Arfer] - stop reconnect deep recursion if server disconnects on login [Luca Ferrario] - reconnect() now returns 1 on success; on error undef or 0=recursive - handle EBADF from syswrite in _send_bytes - rt.cpan.org#67263: add RFC4978 IMAP COMPRESS Extension support [SDIZ] + new method: compress() + new attributes: Compress Readmoremethod - general code cleanup: + new() now always returns $self or undef (never $sock any more) + Socket() now always return a socket or undef + login() now always return $self or undef + _read_more() will now use Readmoremethod if set - missing second arg '' for encode_base64 causing AUTHENTICATE PLAIN to fail on lines longer than 76 characters [Yoshiho Yoshida] version 3.29: Tue Aug 9 00:33:52 EDT 2011 - rt.cpan.org#69876: ENVELOPE as part of fetch_hash convenience method [Chris Huttman] + added Mail::IMAPClient::BodyStructure::Envelope->parse_string($str) convenience method for handling ENVELOPE data from fetch_hash - rt.cpan.org#68310: folders() should not call exists()/STATUS [Gilles Lamiral] - affects folders() and subscribed() methods + use selectable() instead of exists() in call - consider removing extra call to folders()/subscribed() + ensure separator is set properly in folders() + selectable now properly checks for \Noselect flag + update folders() POD to match implementation behavior - rt.cpan.org#68648: [patch]: CAPABILITY after authenticate [Stef Simoens] + delete cache after State set to Authenticate - State() is no longer an auto-generated method - rt.cpan.org#68755: provided socket loses blocking in 3.19-3.28 [Martin Schmitt] version 3.28: Fri Mar 4 00:17:38 EST 2011 - rt.cpan.org#66004: internaldate() return undef if no internaldate in reply [Jason Long] - rt.cpan.org#66367: fetch_hash uses Escaped_results() in 3.26/3.27 (redo) rt.cpan.org#63524: fetch_hash() parse errors [Mathias Reitinger] + fetch_hash: only Escape() data in parenthesized list + update fetch_hash test and add a new test - do not touch CRLF in Escape()/Unescape() - added Escape() method - rt.cpan.org#66287: flags results truncated due to Maxcommandlength [Erik Colson] - rt.cpan.org#65694: SASL PLAIN: bad order of login data [Willi Mann] version 3.27: Sun Feb 13 14:37:27 EST 2011 - rt.cpan.org#65694: migrate fails [Erik Colson] - rt.cpan.org#65470: uninitialized warning in message_to_file [Gilles Lamiral, Mark Hedges] - rt.cpan.org#61835: (DOC) in LIST context undef may be returned [Stefan V�lkel] + warn/highlight behavior in docs Errors section - updated documentation + migrate() documentation fixed + moved Custom Authentication Mechanisms toward end + recommended use of scalar context due to historical API behavior version 3.26: Mon Jan 31 22:15:04 EST 2011 - *require Perl 5.8.1 as constant use is invalid on 5.6 - rt.cpan.org#63524: fetch_hash() parse errors [Brian Kroth] + fixed handling of LITERAL values in response + fixed handling of field names with a dash (e.g. X-SAVEDATE) + fetch_hash now uses Escaped_results() method - *fixed Escaped_results() to properly join LITERAL data with the data that comes before and after it - *rt.cpan.org#60945: append_file() does not interpret $date as expected [Jason Long] $date should now be 1 (to use the file mtime) or a valid RFC3501 date - *rt.cpan.org#61292: memory consumption with message_string()/append() rt.cpan.org#61806: Major problem with one function in IMAPClient [Gilles Lamiral, Casey Duquette] + use @_ / $_[] in critical places to avoid pass by value memory overhead + use in memory files in a few critical places as that code path in Mail::IMAPClient is significantly more efficient with internal memory usage + *new (undocumented/do-not-use-without-good-reason) attribute Maxappendstringlength used by append() and append_string() holds the size (in bytes, default 1 MiB) that triggers when message SCALAR(s) passed to these methods will be treated as an in memory file. This attribute will likely be removed in a future version. + *append() and append_string() now call append_file() and use an im memory file when length($message) is greater than Maxappendstringlength; other minor code cleanup + *message_string() now calls message_to_file() and uses an in memory file + refactor message_to_file() to use internal _imap_uid_command() + update _read_line() to be more efficient w/CPU in critical section by pulling isa() checks out of main loop also conserve memory by not storing an extra copy of LITERAL data if the data was put into a filehandle from the caller + Memory/working set (KB) comparison (Perl 5.10 cygwin Win7): - test: message_string on 6.1M msg and then append 6.1M msg version | start | after message_string | after append --------+-------+----------------------+------------- 2.2.9 | 7624 | 74404 | 131896 3.25 | 7716 | 74408 | 156532 3.26 | 7684 | 33372 | 42608 - minor arg cleanup of noop() and tag_and_run() - rt.cpan.org#63444: relax get_envelope(), allow empty reply-to [Nikolay Kravchenko] - rt.cpan.org#61068: append_string can invalidate a good $date - rt.cpan.org#60045: Logout error if delay between BYE and tagged OK [Armin Wolfermann] no longer set an error when this happens - rt.cpan.org#61062: migrate() errors [Johan Ekenberg] + rewrote migrate() to be functional and simple - Update README and cleanup several old or out of date files version 3.25: Fri May 28 00:07:40 EDT 2010 - fix body_string parsing bug and added tests in t/body_string.t [Heiko Schlittermann] - rt.cpan.org#57661: uninitialized value warning in IMAPClient::thread [Max Bowsher] - rt.cpan.org#57337: Correctly handle multiparts in BodyStructure.pm [Robert Norris] fixes in Mail::IMAPClient::BodyStructure::bodystructure for bugs still in release 3.24 - rt.cpan.org#57659: install fails when using cPanel GUI [Ken Parisi] hack Makefile.PL to use alarm() and timeout prompt() gracefully - relax t/basic.t logout() error check (allow 'BYE' instead of 'OK') - left examples/idle.pl out of MANIFEST for 3.24 version 3.24: Fri May 7 17:02:35 EDT 2010 - rt.cpan.org#48912: wrong part numbers in multipart messages [Dmitry Bigunyak, Gabor Leszlauer] - fix Mail::IMAPClient::BodyStructure::bodystructure to properly assign parts for messages using multipart and also include .TEXT parts as well (still not including top level HEADER and TEXT though - bug?) - allow _load_module() to set $@ and LastError if module load fails - rt.cpan.org#55527: [no] disconnect during DESTROY [Stefan Seifert] - updated logout documentation to correctly state that DESTROY is not used to force an automatic logout on DESTROY despite documentation that indicated otherwise - update append* documentation to match current implementation - rt.cpan.org#55898: append_file can send too many bytes [Jeremy Robst] - avoid append_file corner cases operating on lines instead of buffers - use binmode on filehandle in append_file - add tests to t/basic.t for append_file - rt.cpan.org#57048: _quote_search() using $_ in loop instead of $v [Matthaus Kiem] - added examples/idle.pl program showing use of idle and idle_data - idle_data() should not read/block after server returns data [Marc Thielemann] - idle_data() _get_response regexp updated to not match errors - idle_data() now uses a timeout of 0 by default as documented - _get_response() now checks for defined($code) to allow $code==0 version 3.23: Fri Jan 29 00:39:27 EST 2010 - new beta idle_data() method to retrieve untagged messages during idle similar to method suggested by Daniel Richard G - added/updated documentation for idle, idle_data, and done - rt.cpan.org#53998: fix NTLM auth: call ntlm with challenge string [Dragoslav Mlakar] - report the return value from select/_read_more on errors - logout() again returns the success/failure of the LOGOUT command - set/return error when $response->() returns undef in authenticate() - new internal method _load_module() centralizing some 'require' calls - localize use $@ in several places to avoid stomping on global val - refactor code calling _read_more() to centralize error handling version 3.22: Thu Jan 21 15:25:54 EST 2010 - rt.cpan.org#52313: Getting read errors if Fast_io is set to 1 [Jukka Huhta] - updated Maxttemperrors docs related to EAGAIN handling - new starttls() method and Starttls attribute to support STARTTLS - update parse_headers to try harder to find UID in fetch response 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 $ Mail-IMAPClient-3.38/META.yml0000664000175000017500000000136112656252125015026 0ustar ppearlppearl--- abstract: 'IMAP4 client library' author: - 'Phil Pearl (Lobbes) ' build_requires: ExtUtils::MakeMaker: 0 configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.120921' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Mail-IMAPClient no_index: directory: - t - inc 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 perl: 5.008 resources: homepage: http://sourceforge.net/projects/mail-imapclient/ version: 3.38 Mail-IMAPClient-3.38/prepare_dist0000755000175000017500000000163212535524202016155 0ustar ppearlppearl#!/usr/bin/perl use strict; use warnings; use File::Copy qw/move/; use Parse::RecDescent 1.94; sub read_file { my $file = shift; local ( $/, *FH ); open( FH, $file ) or return undef; return ; } 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"); } Mail-IMAPClient-3.38/README0000644000175000017500000000552412642551142014434 0ustar ppearlppearlMail::IMAPClient ================ Mail::IMAPClient is a Perl module that provides an interface for communicating with an IMAP server as an IMAP client. DEPENDENCIES ============ The following are the minimum requirements for using Mail::IMAPClient: - Perl 5.8 http://www.perl.org/ - Perl modules from CPAN: http://search.cpan.org/ Required: List::Util MIME::Base64 Parse::RecDescent Optional: Authen::NTLM Authen::SASL Compress::Zlib Digest::HMAC_MD5 Digest::MD5 IO::Socket::SSL - RFC 3501 (IMAP4REV1) compatible IMAP server http://www.faqs.org/rfcs/rfc3501.html - Mail::IMAPClient (this package) INSTALLATION ============ 1. Download Mail::IMAPClient module http://search.cpan.org/dist/Mail-IMAPClient/ 2. Read this README 3. This module has a number of dependencies on other Perl modules available from CPAN. If any modules are missing, appropriate warnings will be generated in the following step. 4. Prepare to build this module and install any prerequisite modules: perl Makefile.PL 5. (OPTIONAL) For extended tests during 'make test', create a file 'test.txt' in the top level directory of this distribution (the same directory as the Makefile.PL, etc.). This file must contain an IMAP server name or IP (server=...), a user account (user=...), and password a (passed=...). A port (port=....) and an authentication mechanism to be used (authmechanism=...) can also be specified. Example: --- BEGIN: test.txt --- server=localhost user=mytestuser passed=mypassword port=143 --- END: test.txt --- NOTE: When testing is completed, be sure to remove test.txt (either by hand or by 'make clean'). 6. Build, test and install this module: make make test (sudo) make install 7. Read the documentation to become familiar with this module. Project Links ============= - Bugs/tickets: http://rt.cpan.org/Public/Dist/Display.html?Name=Mail-IMAPClient - Source code repository (git): http://sourceforge.net/p/mail-imapclient/git/ - CPAN releases: http://search.cpan.org/dist/Mail-IMAPClient/ - Project website http://sourceforge.net/projects/mail-imapclient/ COPYRIGHT AND LICENSE ===================== Copyright (C) 1999-2003 The Kernen Group, Inc. Copyright (C) 2007-2009 Mark Overmeer Copyright (C) 2010-2016 Phil Pearl (Lobbes) All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.0 or, at your option, any later version of Perl 5 you may have available. 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. Mail-IMAPClient-3.38/test_template.txt0000644000175000017500000000012712535524202017157 0ustar ppearlppearlserver=imap.server.hostname user=username passed=password port=143 authmechanism=LOGIN Mail-IMAPClient-3.38/MANIFEST0000644000175000017500000000203312656252125014701 0ustar ppearlppearlChanges MANIFEST Makefile.PL README examples/build_dist.pl examples/build_ldif.pl examples/cleanTest.pl examples/copy_folder.pl examples/cyrus_expire.pl examples/cyrus_expunge.pl examples/find_dup_msgs.pl examples/idle.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 t/basic.t t/body_string.t t/bodystructure.t t/fetch_hash.t t/lib/MyTest.pm t/messageset.t t/pod.t t/quota.t t/simple.t t/thread.t test_template.txt META.yml Module meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Mail-IMAPClient-3.38/t/0000755000175000017500000000000012656252125014015 5ustar ppearlppearlMail-IMAPClient-3.38/t/basic.t0000644000175000017500000003320312642543352015264 0ustar ppearlppearl#!/usr/bin/perl use strict; use warnings; use IO::File qw(); use Test::More; use File::Temp qw(tempfile); use lib "t/lib"; use MyTest; my $params; BEGIN { eval { $params = MyTest->new; }; $@ ? plan skip_all => $@ : plan tests => 104; } BEGIN { use_ok('Mail::IMAPClient') or exit; } my $debug = $ARGV[0]; my $range = 0; my $uidplus = 0; my %new_args = ( Clear => 0, Uid => $uidplus, Debug => $debug, ); # allow other options to be placed in test.txt %new_args = ( %new_args, %${params} ); my $imap = Mail::IMAPClient->new( %new_args, Range => $range, Debug_fh => ( $debug ? IO::File->new( 'imap1.debug', 'w' ) : undef ), ); ok( defined $imap, 'created client' ); $imap or die "Cannot log into $new_args{Server} as $new_args{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: <$new_args{User}\@$new_args{Server}> From: Perl <$new_args{User}\@$new_args{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" ); ok( $imap->tag_and_run("NOOP\r\n"), "tag_and_run" ); my $sep = $imap->separator; ok( defined $sep, "separator is '$sep'" ); { my $list = $imap->list(); is( ref($list), "ARRAY", "list" ); my $lsub = $imap->lsub(); is( ref($lsub), "ARRAY", "lsub" ); } my ( $target, $target2 ); { my $ispar = $imap->is_parent('INBOX'); my $pre = $ispar ? "INBOX${sep}" : ""; ( $target, $target2 ) = ( "${pre}IMAPClient_$$", "${pre}IMAPClient_2_$$" ); ok( defined $ispar, "INBOX is_parent '$ispar' (note: target '$target')" ); } ok( $imap->select('inbox'), "select inbox" ); # folders { my @f = $imap->folders(); ok( @f, "folders" . ( $debug ? ":@f" : "" ) ); my @fh = $imap->folders_hash(); my @fh_keys = qw(attrs delim name); ok( @fh, "folders_hash keys: @fh_keys" ); is_deeply( [ sort keys %{ $fh[0] } ], [ sort @fh_keys ], "folders eq folders_hash" ); } # test append_file my $append_file_size; { my ( $afh, $afn ) = tempfile UNLINK => 1; # write message to autoflushed file handle since we keep $afh around my $oldfh = select($afh); $| = 1; select($oldfh); print( $afh $testmsg ) or die("print testmsg failed"); cmp_ok( -s $afn, '>', 0, "tempfile has size" ); ok( $imap->create($target), "create target" ); my $uid = $imap->append_file( $target, $afn ); ok( defined $uid, "append_file 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 matches server size" ); # dovecot may disconnect client if deleting selected folder ok( $imap->select("INBOX"), "select INBOX" ); ok( $imap->delete($target), "delete folder $target" ); $append_file_size = $size; } # rt.cpan.org#91912: selectable test for /NoSelect { my $targetno = $target . "_noselect"; my $targetsubf = $targetno . "${sep}subfolder"; ok( $imap->create($targetsubf), "create target subfolder" ); ok( !$imap->selectable($targetno), "not selectable (non-mailbox w/inferior)" ); ok( $imap->delete($targetsubf), "delete target subfolder" ); ok( $imap->delete($targetno), "delete parent folder" ); } ok( $imap->create($target), "create target" ); ok( $imap->select($target), "select $target" ); # Test append / append_string if we also have UID capability SKIP: { skip "UIDPLUS not supported", 3 unless $imap->has_capability("UIDPLUS"); my $ouid = $imap->Uid(); $imap->Uid(1); # test with date that has a leading space my $d = " 1-Jan-2011 01:02:03 -0500"; my $uid = $imap->append_string( $target, $testmsg, undef, $d ); ok( defined $uid, "append test message to $target with date (uid=$uid)" ); # hash results do not have UID unless requested my $h1 = $imap->fetch_hash( $uid, "RFC822.SIZE" ); is( ref($h1), "HASH", "fetch_hash($uid,RFC822.SIZE)" ); is( scalar keys %$h1, 1, "fetch_hash: fetched one msg (as requested)" ); is( !exists $h1->{$uid}->{UID}, 1, "fetch_hash: no UID (not requested)" ); $h1 = $imap->fetch_hash( $uid, "UID RFC822.SIZE" ); is( exists $h1->{$uid}->{UID}, 1, "fetch_hash: has UID (as requested)" ); ok( $imap->delete_message($uid), "delete_message $uid" ); ok( $imap->uidexpunge($uid), "uidexpunge $uid" ); =begin comment my $ol = $imap->Maxcommandlength(); $imap->Maxcommandlength(64); my $exp = $imap->uidexpunge($uid . "," . join(",", map{$_*2} 2..40) ); $imap->Maxcommandlength($ol); is( $exp->[0], $imap->Count . " UID EXPUNGE $uid", "UID EXPUNGE $uid" ); is( grep( /^\* $uid EXPUNGE/, @$exp ), !undef, "found EXPUNGE response" ); =cut # multiple args joined internally in append() $uid = $imap->append( $target, $testmsg, "Some extra text too" ); ok( defined $uid, "append test message to $target with date (uid=$uid)" ); ok( $imap->delete_message($uid), "delete_message $uid" ); ok( $imap->uidexpunge($uid), "uidexpunge $uid" ); $imap->Uid($ouid); } # test append { my $uid = $imap->append( $target, $testmsg ); ok( defined $uid, "append test message to $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 == server size" ); { my $var; ok( $imap->message_to_file( \$var, $msg ), "to SCALAR ref" ); cmp_ok( length($var), '==', $size, "correct size" ); my ( $fh, $fn ) = tempfile UNLINK => 1; ok( $imap->message_to_file( $fn, $msg ), "to file $fn" ); cmp_ok( -s $fn, '==', $size, "correct size" ); } cmp_ok( $size, '==', $append_file_size, "size matches string/file" ); # save first message/folder for use below... #OFF ok( $imap->delete($target), "delete folder $target" ); } #OFF ok( $imap->create($target), "create target" ); ok( $imap->exists($target), "exists $target" ); ok( $imap->create($target2), "create $target2" ); ok( $imap->exists($target2), "exists $target2" ); is( defined $imap->is_parent($sep), 1, "is_parent($sep)" ); is( !$imap->is_parent($target2), 1, "is_parent($target2)" ); { 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" ); } my $fwquotes = qq($target has "quotes"); if ( $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 { my $err = $imap->LastError || "(no error)"; ok( 1, "failed creation with quotes, assume not supported: $err" ); ok( 1, "skipping 1/3 tests" ); ok( 1, "skipping 2/3 tests" ); ok( 1, "skipping 3/3 tests" ); } ok( $imap->select($target), "select $target" ); 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 $h1 = $imap->fetch_hash("RFC822.SIZE"); is( ref($h1), "HASH", "fetch_hash(RFC822.SIZE)" ); my $id = ( sort { $a <=> $b } keys %$h1 )[0]; my $h2 = $imap->fetch_hash( $id, "RFC822.SIZE" ); is( ref($h2), "HASH", "fetch_hash($id,RFC822.SIZE)" ); is( scalar keys %$h2, 1, "fetch_hash($id,RFC822.SIZE) => fetched one msg" ); } { my $seq = "1:*"; my @dat = (qw(RFC822.SIZE INTERNALDATE)); my $h1 = $imap->fetch_hash( $seq, @dat ); is( ref($h1), "HASH", "fetch_hash($seq, " . join( ", ", @dat ) . ")" ); # verify legacy and less desirable use case still works my $h2 = $imap->fetch_hash("$seq @dat"); is( ref($h2), "HASH", "fetch_hash('$seq @dat')" ); is_deeply( $h1, $h2, "fetch_hash same result with array or string args" ); } 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( %new_args, Timeout => 30, Debug_fh => ( $debug ? IO::File->new(">./imap2.debug") : undef ), ); 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_relaxed_logout($im2); # Test IDLE SKIP: { skip "IDLE not supported", 4 unless $imap->has_capability("IDLE"); ok( my $idle = $imap->idle, "idle" ); sleep 1; ok( $imap->idle_data, "idle_data" ); ok( $imap->done($idle), "done" ); ok( !$@, "LastError not set" ) or diag( '$@:' . $@ ); } $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" ); ok_relaxed_logout($imap); # STARTTLS - an optional feature if ( $imap->_load_module("SSL") ) { $imap->connect( Ssl => 0, Starttls => 1 ); ok( 1, "OPTIONAL connect(Starttls=>1)" . ( $@ ? ": (error) $@ " : "" ) ); } else { ok( 1, "skipping optional STARTTLS test" ); } # LOGOUT # - on successful LOGOUT $code is OK (not BYE!) see RFC 3501 sect 7.1.5 # however some servers return BYE instead so we let that pass here... sub ok_relaxed_logout { my $imap = shift; local ($@); my $rc = $imap->logout; my $err = $imap->LastError || ""; ok( ( $rc or $err =~ /^\* BYE/ ), "logout" . ( $err ? ": $err" : "" ) ); } Mail-IMAPClient-3.38/t/pod.t0000644000175000017500000000025612535524202014761 0ustar ppearlppearl#!/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(); Mail-IMAPClient-3.38/t/bodystructure.t0000644000175000017500000005061412563233572017130 0ustar ppearlppearl#!/usr/bin/perl use strict; use warnings; use Test::More tests => 49; 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)) 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 ), # Parsing in version 3.03-3.23, changed (broke) outcome from # this: "1#2#2.HEAD#2.1#2.2#2.2.HEAD#2.2.1#2.2.1.1#2.2.1.2" # to: "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" # Patches to BodyStructure.pm in 3.25 changed it to this: "1#2#2.HEAD#2.TEXT#2.1#2.2#2.2.HEAD#2.2.TEXT#2.2.1#2.2.1.1#2.2.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 my @exp; $bsobj = Mail::IMAPClient::BodyStructure->new($bs5); @exp = qw(1 1.1 1.2 2); ok( defined $bsobj, 'parsed fifth' ); is_deeply( [ $bsobj->parts ], \@exp, 'bs5 parts' ) or diag( join(" ", $bsobj->parts ) ); # my $bs6 = q{(BODYSTRUCTURE (("text" "plain" ("charset" "UTF-8" "format" "flowed") NIL NIL "8bit" 82 6 NIL NIL NIL NIL)("message" "rfc822" ("name" "this is internal letter.eml") NIL NIL "7bit" 243436 ("Mon, 24 Aug 2009 10:51:22 +0400" "this is internal letter" ((NIL NIL "icestar" "inbox.ru")) ((NIL NIL "icestar" "inbox.ru")) ((NIL NIL "icestar" "inbox.ru")) ((NIL NIL "dima" "adriver.ru")) NIL NIL NIL "<4A92386A.9080307@inbox.ru>") (("text" "plain" ("charset" "UTF-8" "format" "flowed") NIL NIL "7bit" 116 7 NIL NIL NIL NIL)("text" "xml" ("name" "mediaplan.xml" "charset" "us-ascii") NIL NIL "base64" 31412 424 NIL ("inline" ("filename" "mediaplan.xml")) NIL NIL)("application" "zip" ("name" "banners2.zip") NIL NIL "base64" 209942 NIL ("inline" ("filename" "banners2.zip")) NIL NIL) "mixed" ("boundary" "------------070804080502030807020509") NIL NIL NIL) 3326 NIL ("inline" ("filename" "this is internal letter.eml")) NIL NIL) "mixed" ("boundary" "------------070704030806000803040203") NIL NIL NIL))}; $bsobj = Mail::IMAPClient::BodyStructure->new($bs6); @exp = qw(1 2 2.HEAD 2.TEXT 2.1 2.2 2.3); ok( defined $bsobj, 'parsed sixth' ); is_deeply( [ $bsobj->parts ], \@exp, 'bs6 parts' ) or diag( join(" ", $bsobj->parts ) ); # my $bs7 = q{(BODYSTRUCTURE (("text" "plain" ("charset" "us-ascii") NIL NIL "7bit" 20 1 NIL NIL NIL NIL)("message" "rfc822" NIL NIL NIL "7bit" 1810 ("Fri,07 May 2010 01:55:07 -0400" "wrap inner a" (("Phil Pearl" NIL "phil" "perkpartners.com")) (("Phil Pearl" NIL "phil" "perkpartners.com")) (("Phil Pearl" NIL "phil" "perkpartners.com")) ((NIL NIL "phil" "perkpartners.com")) NIL NIL NIL "<25015.1273211707@local>") (("text" "plain" ("charset" "us-ascii") NIL NIL "7bit" 27 3 NIL NIL NIL NIL)("message" "rfc822" NIL NIL NIL "7bit" 783 ("Fri, 07 May 2010 01:54:14 -0400" "inner msg #1" (("Phil Pearl" NIL "phil" "perkpartners.com")) (("Phil Pearl" NIL "phil" "perkpartners.com")) (("Phil Pearl" NIL "phil" "perkpartners.com")) ((NIL NIL "phil" "perkpartners.com")) NIL NIL NIL "<24986.1273211654@local>") ("text" "plain" ("charset" "us-ascii") NIL NIL "7bit" 25 3 NIL NIL NIL NIL) 23 NIL ("inline" ("filename" "52")) NIL NIL) "mixed" ("boundary" "=-=-=") NIL NIL NIL) 58 NIL ("inline" ("filename" "53")) NIL NIL) "mixed" ("boundary""==-=-=") NIL NIL NIL))}; $bsobj = Mail::IMAPClient::BodyStructure->new($bs7); @exp = qw(1 2 2.HEAD 2.TEXT 2.1 2.2 2.2.HEAD 2.2.1); ok( defined $bsobj, 'parsed seventh' ); is_deeply( [ $bsobj->parts ], \@exp, 'bs7 parts' ) or diag( join(" ", $bsobj->parts ) ); # my $bs8 = q{(BODYSTRUCTURE (("text" "plain" ("charset" "us-ascii") NIL NIL "7bit" 31 2 NIL NIL NIL NIL)("message" "rfc822" NIL NIL "My forwarded message" "7bit" 2833 ("Fri, 07 May 2010 01:55:40 -0400" "outer msg" (("Phil Pearl" NIL "phil" "perkpartners.com")) (("Phil Pearl" NIL "phil" "perkpartners.com")) (("Phil Pearl" NIL "phil" "perkpartners.com")) ((NIL NIL "phil" "perkpartners.com")) NIL NIL NIL "<25030.1273211740@local>") (("text" "plain" ("charset" "us-ascii") NIL NIL "7bit" 20 1 NIL NIL NIL NIL)("message" "rfc822" NIL NIL NIL "7bit" 1810 ("Fri, 07 May 2010 01:55:07 -0400" "wrap inner a" (("Phil Pearl" NIL "phil" "perkpartners.com")) (("Phil Pearl" NIL "phil" "perkpartners.com")) (("Phil Pearl" NIL "phil" "perkpartners.com")) ((NIL NIL "phil" "perkpartners.com")) NIL NIL NIL "<25015.1273211707@local>") (("text" "plain" ("charset" "us-ascii") NIL NIL "7bit" 27 3 NIL NIL NIL NIL)("message" "rfc822" NIL NIL NIL "7bit" 783 ("Fri, 07 May 2010 01:54:14 -0400" "inner msg #1" (("Phil Pearl" NIL "phil" "perkpartners.com")) (("Phil Pearl" NIL "phil" "perkpartners.com")) (("Phil Pearl" NIL "phil" "perkpartners.com")) ((NIL NIL "phil" "perkpartners.com")) NIL NIL NIL "<24986.1273211654@local>") ("text" "plain" ("charset" "us-ascii") NIL NIL "7bit" 25 3 NIL NIL NIL NIL) 23 NIL ("inline" ("filename" "52")) NIL NIL) "mixed" ("boundary" "=-=-=") NIL NIL NIL) 58 NIL ("inline" ("filename" "53")) NIL NIL) "mixed" ("boundary" "==-=-=") NIL NIL NIL) 91 NIL ("inline" ("filename" "52")) NIL NIL)("text" "plain" ("charset" "us-ascii") NIL NIL "7bit" 30 2 NIL NIL NIL NIL)("application" "octet-stream" NIL NIL "My attachment" "7bit" 76 NIL ("attachment" ("filename" ".signature.cell")) NIL NIL)("text" "plain" ("charset" "us-ascii") NIL NIL "7bit" 31 2 NIL NIL NIL NIL) "mixed" ("boundary" "===-=-=") NIL NIL NIL))}; $bsobj = Mail::IMAPClient::BodyStructure->new($bs8); @exp = qw(1 2 2.HEAD 2.TEXT 2.1 2.2 2.2.HEAD 2.2.TEXT 2.2.1 2.2.2 2.2.2.HEAD 2.2.2.1 3 4 5); ok( defined $bsobj, 'parsed eighth' ); is_deeply( [ $bsobj->parts ], \@exp, 'bs8 parts' ) or diag( join(" ", $bsobj->parts ) ); # Ryan Finnie MIME torture test my $bs9 = q{(BODYSTRUCTURE (("text" "plain" ("CHARSET" "US-ASCII") NIL NIL "8bit" 617 16 NIL NIL NIL NIL)("message" "rfc822" NIL NIL "I'll be whatever I wanna do. --Fry" "7bit" 582 ("23 Oct 2003 22:25:56 -0700" "plain jane message" (("Ryan Finnie" NIL "rfinnie" "domain.dom")) (("Ryan Finnie" NIL "rfinnie" "domain.dom")) (("Ryan Finnie" NIL "rfinnie" "domain.dom")) ((NIL NIL "bob" "domain.dom")) NIL NIL NIL "<1066973156.4264.42.camel@localhost>") ("text" "plain" ("CHARSET" "US-ASCII") NIL NIL "8bit" 311 9 NIL NIL NIL NIL) 18 NIL ("inline" NIL) NIL NIL)("message" "rfc822" NIL NIL "Would you kindly shut your noise-hole? --Bender" "7bit" 1460 ("23 Oct 2003 23:15:11 -0700" "messages inside messages inside..." (("Ryan Finnie" NIL "rfinnie" "domain.dom")) (("Ryan Finnie" NIL "rfinnie" "domain.dom")) (("Ryan Finnie" NIL "rfinnie" "domain.dom")) ((NIL NIL "bob" "domain.dom")) NIL NIL NIL "<1066976111.4263.74.camel@localhost>") (("text" "plain" ("CHARSET" "US-ASCII") NIL NIL "8bit" 193 3 NIL NIL NIL NIL)("message" "rfc822" NIL NIL "At the risk of sounding negative, no. --Leela" "7bit" 697 ("23 Oct 2003 23:09:05 -0700" "the original message" (("Ryan Finnie" NIL "rfinnie" "domain.dom")) (("Ryan Finnie" NIL "rfinnie" "domain.dom")) (("Ryan Finnie" NIL "rfinnie" "domain.dom")) ((NIL NIL "bob" "domain.dom")) NIL NIL NIL "<1066975745.4263.70.camel@localhost>") (("text" "plain" ("CHARSET" "US-ASCII") NIL NIL "8bit" 78 3 NIL NIL NIL NIL)("application" "x-gzip" ("NAME" "foo.gz") NIL NIL "base64" 58 NIL ("attachment" ("filename" "foo.gz")) NIL NIL) "mixed" ("boundary" "=-XFYecI7w+0shpolXq8bb") NIL NIL NIL) 25 NIL ("inline" NIL) NIL NIL) "mixed" ("boundary" "=-9Brg7LoMERBrIDtMRose") NIL NIL NIL) 49 NIL ("inline" NIL) NIL NIL)("message" "rfc822" NIL NIL "Dirt doesn't need luck! --Professor" "7bit" 817 ("23 Oct 2003 22:40:49 -0700" "this message JUST contains an attachment" (("Ryan Finnie" NIL "rfinnie" "domain.dom")) (("Ryan Finnie" NIL "rfinnie" "domain.dom")) (("Ryan Finnie" NIL "rfinnie" "domain.dom")) ((NIL NIL "bob" "domain.dom")) NIL NIL NIL "<1066974048.4264.62.camel@localhost>") ("application" "x-gzip" ("NAME" "blah.gz") NIL "Attachment has identical content to above foo.gz" "base64" 396 NIL ("attachment" ("filename" "blah.gz")) NIL NIL) 17 NIL ("inline" NIL) NIL NIL)("message" "rfc822" NIL NIL "Hold still, I don't have good depth perception! --Leela" "7bit" 1045 ("23 Oct 2003 23:09:16 -0700" "Attachment filename vs. name" (("Ryan Finnie" NIL "rfinnie" "domain.dom")) (("Ryan Finnie" NIL "rfinnie" "domain.dom")) (("Ryan Finnie" NIL "rfinnie" "domain.dom")) ((NIL NIL "bob" "domain.dom")) NIL NIL NIL "<1066975756.4263.70.camel@localhost>") (("text" "plain" ("CHARSET" "US-ASCII") NIL NIL "8bit" 377 6 NIL NIL NIL NIL)("application" "x-gzip" ("NAME" "blah2.gz") NIL "filename is blah1.gz, name is blah2.gz" "base64" 58 NIL ("attachment" ("filename" "blah1.gz")) NIL NIL) "mixed" ("boundary" "=-1066975756jd02") NIL NIL NIL) 29 NIL ("inline" NIL) NIL NIL)("message" "rfc822" NIL NIL "Hello little man. I WILL DESTROY YOU! --Moro" "7bit" 1149 ("23 Oct 2003 23:09:21 -0700" "No filename? No problem!" (("Ryan Finnie" NIL "rfinnie" "domain.dom")) (("Ryan Finnie" NIL "rfinnie" "domain.dom")) (("Ryan Finnie" NIL "rfinnie" "domain.dom")) ((NIL NIL "bob" "domain.dom")) NIL NIL NIL "<1066975761.4263.70.camel@localhost>") (("text" "plain" ("CHARSET" "US-ASCII") NIL NIL "8bit" 517 10 NIL NIL NIL NIL)("application" "x-gzip" NIL NIL "I'm getting sick of witty things to say" "base64" 58 NIL ("attachment" NIL) NIL NIL) "mixed" ("boundary" "=-1066975756jd03") NIL NIL NIL) 33 NIL ("inline" NIL) NIL NIL)("message" "rfc822" NIL NIL "Friends! Help! A guinea pig tricked me! --Zoidberg" "7bit" 896 ("23 Oct 2003 22:40:45 -0700" "html and text, both inline" (("Ryan Finnie" NIL "rfinnie" "domain.dom")) (("Ryan Finnie" NIL "rfinnie" "domain.dom")) (("Ryan Finnie" NIL "rfinnie" "domain.dom")) ((NIL NIL "bob" "domain.dom")) NIL NIL NIL "<1066974044.4264.62.camel@localhost>") (("text" "html" ("CHARSET" "utf-8") NIL NIL "8bit" 327 11 NIL NIL NIL NIL)("text" "plain" ("CHARSET" "US-ASCII") NIL NIL "8bit" 61 2 NIL NIL NIL NIL) "mixed" ("boundary" "=-ZCKMfHzvHMyK1iBu4kff") NIL NIL NIL) 33 NIL ("inline" NIL) NIL NIL)("message" "rfc822" NIL NIL "Smeesh! --Amy" "7bit" 642 ("23 Oct 2003 22:41:29 -0700" "text and text, both inline" (("Ryan Finnie" NIL "rfinnie" "domain.dom")) (("Ryan Finnie" NIL "rfinnie" "domain.dom")) (("Ryan Finnie" NIL "rfinnie" "domain.dom")) ((NIL NIL "bob" "domain.dom")) NIL NIL NIL "<1066974089.4265.64.camel@localhost>") (("text" "plain" ("CHARSET" "US-ASCII") NIL NIL "8bit" 62 2 NIL NIL NIL NIL)("text" "plain" ("CHARSET" "US-ASCII") NIL NIL "8bit" 68 2 NIL NIL NIL NIL) "mixed" ("boundary" "=-pNc4wtlOIxs8RcX7H/AK") NIL NIL NIL) 24 NIL ("inline" NIL) NIL NIL)("message" "rfc822" NIL NIL "That's not a cigar. Uh... and it's not mine. --Hermes" "7bit" 1515 ("23 Oct 2003 22:39:17 -0700" "HTML and... HTML?" (("Ryan Finnie" NIL "rfinnie" "domain.dom")) (("Ryan Finnie" NIL "rfinnie" "domain.dom")) (("Ryan Finnie" NIL "rfinnie" "domain.dom")) ((NIL NIL "bob" "domain.dom")) NIL NIL NIL "<1066973957.4263.59.camel@localhost>") (("text" "html" ("CHARSET" "utf-8") NIL NIL "8bit" 824 22 NIL NIL NIL NIL)("text" "html" ("NAME" "htmlfile.html" "CHARSET" "UTF-8") NIL NIL "8bit" 118 6 NIL ("attachment" ("filename" "htmlfile.html")) NIL NIL) "mixed" ("boundary" "=-zxh/IezwzZITiphpcbJZ") NIL NIL NIL) 49 NIL ("inline" NIL) NIL NIL)("message" "rfc822" NIL NIL "The spirit is willing, but the flesh is spongy, and bruised. --Zapp" "7bit" 6683 ("23 Oct 2003 22:23:16 -0700" "smiley!" (("Ryan Finnie" NIL "rfinnie" "domain.dom")) (("Ryan Finnie" NIL "rfinnie" "domain.dom")) (("Ryan Finnie" NIL "rfinnie" "domain.dom")) ((NIL NIL "bob" "domain.dom")) NIL NIL NIL "<1066972996.4264.39.camel@localhost>") ((((("text" "plain" ("charset" "us-ascii") NIL NIL "quoted-printable" 1606 42 NIL NIL NIL NIL)("text" "html" ("charset" "utf-8") NIL NIL "quoted-printable" 2173 54 NIL NIL NIL NIL) "alternative" ("boundary" "=-dHujWM/Xizz57x/JOmDF") NIL NIL NIL)("image" "png" ("name" "smiley-3.png") "<1066971953.4232.15.camel@localhost>" NIL "base64" 1122 NIL ("attachment" ("filename" "smiley-3.png")) NIL NIL) "related" ("type" "multipart/alternative" "boundary" "=-GpwozF9CQ7NdF+fd+vMG") NIL NIL NIL)("image" "gif" ("name" "dot.gif") NIL NIL "base64" 96 NIL ("attachment" ("filename" "dot.gif")) NIL NIL) "mixed" ("boundary" "=-CgV5jm9HAY9VbUlAuneA") NIL NIL NIL)("application" "pgp-signature" ("name" "signature.asc") NIL "This is a digitally signed message part" "7bit" 196 NIL NIL NIL NIL) "signed" ("micalg" "pgp-sha1" "protocol" "application/pgp-signature" "boundary" "=-vH3FQO9a8icUn1ROCoAi") NIL NIL NIL) 176 NIL ("inline" NIL) NIL NIL)("message" "rfc822" NIL NIL "Kittens give Morbo gas. --Morbo" "7bit" 3113 ("23 Oct 2003 22:32:37 -0700" "the PROPER way to do alternative/related" (("Ryan Finnie" NIL "rfinnie" "domain.dom")) (("Ryan Finnie" NIL "rfinnie" "domain.dom")) (("Ryan Finnie" NIL "rfinnie" "domain.dom")) ((NIL NIL "bob" "domain.dom")) NIL NIL NIL "<1066973557.4265.51.camel@localhost>") (("text" "plain" ("CHARSET" "US-ASCII") NIL NIL "8bit" 863 22 NIL NIL NIL NIL)(("text" "html" ("CHARSET" "utf-8") NIL NIL "8bit" 1283 22 NIL NIL NIL NIL)("image" "gif" NIL "<1066973340.4232.46.camel@localhost>" NIL "base64" 116 NIL NIL NIL NIL) "related" ("boundary" "=-bFkxH1S3HVGcxi+o/5jG") NIL NIL NIL) "alternative" ("type" "multipart/alternative" "boundary" "=-tyGlQ9JvB5uvPWzozI+y") NIL NIL NIL) 79 NIL ("inline" NIL) NIL NIL) "mixed" ("boundary" "=-qYxqvD9rbH0PNeExagh1") NIL NIL NIL))}; $bsobj = Mail::IMAPClient::BodyStructure->new($bs9); @exp = qw(1 2 2.HEAD 2.1 3 3.HEAD 3.TEXT 3.1 3.2 3.2.HEAD 3.2.TEXT 3.2.1 3.2.2 4 4.HEAD 4.1 5 5.HEAD 5.TEXT 5.1 5.2 6 6.HEAD 6.TEXT 6.1 6.2 7 7.HEAD 7.TEXT 7.1 7.2 8 8.HEAD 8.TEXT 8.1 8.2 9 9.HEAD 9.TEXT 9.1 9.2 10 10.HEAD 10.TEXT 10.1 10.1.1 10.1.1.1 10.1.1.1.1 10.1.1.1.2 10.1.1.2 10.1.2 10.2 11 11.HEAD 11.TEXT 11.1 11.2 11.2.1 11.2.2); ok( defined $bsobj, 'parsed ninth' ); is_deeply( [ $bsobj->parts ], \@exp, 'bs9 parts' ) or diag( join(" ", $bsobj->parts ) ); # envelope # date, subject, from, sender, reply-to, to, cc, bcc, in-reply-to, message-id { my $resp = q{* 2 FETCH (UID 42895 ENVELOPE ("Mon, 29 Nov 2010 18:28:23 +0200" "subj" (("Phil Pearl" NIL "phil+from" "dom.loc")) (("Phil Pearl" NIL "phil+sender" "dom.loc")) () ((NIL NIL "phil+to" "dom.loc")) NIL NIL NIL ""))}; my $env = Mail::IMAPClient::BodyStructure::Envelope->new($resp); is( $env->subject, "subj", "subject" ); is( $env->inreplyto, "NIL", "inreplyto" ); is( $env->messageid, "", "messageid" ); is( $env->bcc, "NIL", "bcc" ); is( $env->cc, "NIL", "cc" ); is( $env->replyto, "NIL", "replyto" ); # personalname mailboxname hostname sourcename my $to = $env->to_addresses; is_deeply( $to, [ '' ], "to_addresses" ); } # envelope: parse_string # date, subject, from, sender, reply-to, to, cc, bcc, in-reply-to, message-id { my $str = q{"Mon, 29 Nov 2010 18:28:23 +0200" "subj" (("Phil Pearl" NIL "phil+from" "dom.loc")) (("Phil Pearl" NIL "phil+sender" "dom.loc")) () ((NIL NIL "phil+to" "dom.loc")) NIL NIL NIL ""}; my $env = Mail::IMAPClient::BodyStructure::Envelope->parse_string($str); is( $env->subject, "subj", "subject" ); is( $env->inreplyto, "NIL", "inreplyto" ); is( $env->messageid, "", "messageid" ); is( $env->bcc, "NIL", "bcc" ); is( $env->cc, "NIL", "cc" ); is( $env->replyto, "NIL", "replyto" ); # personalname mailboxname hostname sourcename my $to = $env->to_addresses; is_deeply( $to, [ '' ], "to_addresses" ); } # envelope: parse_string # date, subject, from, sender, reply-to, to, cc, bcc, in-reply-to, message-id { my $str = q{("Mon, 29 Nov 2010 18:28:23 +0200" "subj" (("Phil Pearl" NIL "phil+from" "dom.loc")) (("Phil Pearl" NIL "phil+sender" "dom.loc")) () ((NIL NIL "phil+to" "dom.loc")) NIL NIL NIL "")}; my $env = Mail::IMAPClient::BodyStructure::Envelope->parse_string($str); is( $env->subject, "subj", "subject" ); is( $env->inreplyto, "NIL", "inreplyto" ); is( $env->messageid, "", "messageid" ); is( $env->bcc, "NIL", "bcc" ); is( $env->cc, "NIL", "cc" ); is( $env->replyto, "NIL", "replyto" ); # personalname mailboxname hostname sourcename my $to = $env->to_addresses; is_deeply( $to, [ '' ], "to_addresses" ); } # envelope: parse_string with backslashes # date, subject, from, sender, reply-to, to, cc, bcc, in-reply-to, message-id { my $str = q{("Thu, 19 Jun 2014 17:12:34 -0700" "subj" (("Ken N" NIL "ken+from" "dom.loc")) (("Ken N" NIL "ken+sender" "dom.loc")) () (("backslash\\\\" NIL "ken+to" "dom.loc")) NIL NIL NIL "")}; my $env = Mail::IMAPClient::BodyStructure::Envelope->parse_string($str); ok( defined $env, 'parsed envelope string with backslashes' ); SKIP: { skip "ENVELOPE could not be parsed", 7 unless defined $env; is( $env->subject, "subj", "subject" ); is( $env->inreplyto, "NIL", "inreplyto" ); is( $env->messageid, "", "messageid" ); is( $env->bcc, "NIL", "bcc" ); is( $env->cc, "NIL", "cc" ); is( $env->replyto, "NIL", "replyto" ); # personalname mailboxname hostname sourcename my $to = $env->to_addresses; is_deeply( $to, [ 'backslash\\\\ ' ], "to_addresses" ); } } Mail-IMAPClient-3.38/t/simple.t0000644000175000017500000000236712535524202015475 0ustar ppearlppearl#!/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" ); } } } Mail-IMAPClient-3.38/t/fetch_hash.t0000644000175000017500000002312112563202516016271 0ustar ppearlppearl#!/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 => 27; 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}, }, }, ], [ "escaped-backslash before end-quote", [ 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)}, }, }, ], [ "parenthesized value with quoted parentheses", [ q{* 1 FETCH (PARENS (foo "(bar)" baz))}, ], [ [1], qw(PARENS) ], { "1" => { "PARENS" => q{foo "(bar)" baz}, }, }, ], [ "parenthesized value with quoted unclosed parentheses", [ q{* 1 FETCH (PARENS (foo "(bar" baz))}, ], [ [1], qw(PARENS) ], { "1" => { "PARENS" => q{foo "(bar" baz}, }, }, ], [ "parenthesized value with quoted unopened parentheses", [ 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}, }, }, ], [ "BODY[]<0.1024> requests match BODY[]<0> responses", [ q{* 1 FETCH (BODY[]<0>}, q{foo}, ")\r\n" ], [ [1], qw(BODY[]<0.1024>) ], { "1" => { "BODY[]<0>" => q{foo}, }, }, ], [ "BODY.PEEK[]<0.1024> requests match BODY[]<0> responses", [ q{* 1 FETCH (BODY[]<0>}, q{foo}, ")\r\n" ], [ [1], qw(BODY.PEEK[]<0.1024>) ], { "1" => { "BODY[]<0>" => q{foo}, }, }, ], [ "non-escaped BODY[HEADER.FIELDS (...)]", [ q{* 1 FETCH (FLAGS () BODY[HEADER.FIELDS (TO FROM SUBJECT DATE)]}, 'From: Phil Pearl (Lobbes) To: phil+to@perkpartners.com Subject: foo "bar\" (baz\) Date: Sat, 22 Jan 2011 20:43:58 -0500 ' ], [ [1], ( qw(FLAGS), 'BODY[HEADER.FIELDS (TO FROM SUBJECT DATE)]' ) ], { '1' => { 'BODY[HEADER.FIELDS (TO FROM SUBJECT DATE)]' => 'From: Phil Pearl (Lobbes) To: phil+to@perkpartners.com Subject: foo "bar\" (baz\) Date: Sat, 22 Jan 2011 20:43:58 -0500 ', 'FLAGS' => '', }, }, ], ); my @uid_tests = ( [ "uid enabled", [ q{* 1 FETCH (UID 123 UNQUOTED foobar)}, ], [ [123], qw(UNQUOTED) ], { "123" => { "UNQUOTED" => q{foobar}, } }, ], [ "ENVELOPE with escaped-backslash before end-quote", [ q{* 1 FETCH (UID 1 FLAGS (\Seen) ENVELOPE ("Fri, 28 Jan 2011 00:03:30 -0500" "Subject" (("Ken N" NIL "ken" "dom.loc")) (("Ken N" NIL "ken" "dom.loc")) (("Ken N" NIL "ken" "dom.loc")) (("Ken Backslash\\\\" NIL "ken.bl" "dom.loc")) NIL NIL NIL "")) } ], [ [1], qw(UID FLAGS ENVELOPE) ], { "1" => { 'UID' => '1', 'FLAGS' => '\\Seen', 'ENVELOPE' => q{"Fri, 28 Jan 2011 00:03:30 -0500" "Subject" (("Ken N" NIL "ken" "dom.loc")) (("Ken N" NIL "ken" "dom.loc")) (("Ken N" NIL "ken" "dom.loc")) (("Ken Backslash\\\\" NIL "ken.bl" "dom.loc")) NIL NIL NIL ""} }, }, ], [ "escaped ENVELOPE subject", [ q{* 1 FETCH (UID 1 X-SAVEDATE "28-Jan-2011 16:52:31 -0500" FLAGS (\Seen) ENVELOPE ("Fri, 28 Jan 2011 00:03:30 -0500"}, q{foo "bar\\" (baz\\)}, q{ (("Phil Pearl" NIL "phil" "dom.loc")) (("Phil Pearl" NIL "phil" "dom.loc")) (("Phil Pearl" NIL "phil" "dom.loc")) ((NIL NIL "phil" "dom.loc")) NIL NIL NIL "")) } ], [ [1], qw(UID X-SAVEDATE FLAGS ENVELOPE) ], { "1" => { 'X-SAVEDATE' => '28-Jan-2011 16:52:31 -0500', 'UID' => '1', 'FLAGS' => '\\Seen', 'ENVELOPE' => q{"Fri, 28 Jan 2011 00:03:30 -0500" "foo \\"bar\\\\\\" (baz\\\\)" (("Phil Pearl" NIL "phil" "dom.loc")) (("Phil Pearl" NIL "phil" "dom.loc")) (("Phil Pearl" NIL "phil" "dom.loc")) ((NIL NIL "phil" "dom.loc")) NIL NIL NIL ""} }, }, ], [ "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: 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> Lines: 1 This is a test mailing ', ') ', ], [ [1], q{BODY.PEEK[HEADER.FIELDS (To From Date Subject)]}, qw(FLAGS INTERNALDATE RFC822.SIZE BODY[]) ], { "541" => { 'BODY[]' => 'Return-Path: 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> 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', }, }, ], ); 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} || []; } sub Escaped_results { my ( $self, @args ) = @_; return $self->{_next_fetch_response} || []; } package main; sub run_tests { my ( $imap, $tests ) = @_; for my $test (@$tests) { my ( $comment, $fetch, $request, $expect ) = @$test; $imap->{_next_fetch_response} = $fetch; my $r = $imap->fetch_hash(@$request); is_deeply( $r, $expect, $comment ); } } my $imap = Test::Mail::IMAPClient->new( Uid => 0 ); run_tests( $imap, \@tests ); $imap->Uid(1); run_tests( $imap, \@uid_tests ); Mail-IMAPClient-3.38/t/quota.t0000644000175000017500000000203612642547232015335 0ustar ppearlppearl#!/usr/bin/perl use strict; use warnings; use Test::More; use lib "t/lib"; use MyTest; my $params; BEGIN { eval { $params = MyTest->new; }; $@ ? plan skip_all => $@ : plan tests => 7; } BEGIN { use_ok('Mail::IMAPClient') or exit; } my %args = ( Debug => $ARGV[0], %$params ); my $imap = Mail::IMAPClient->new(%args); ok( !$@, "successful login" ) or diag( '$@:' . $@ ); # RFC 2087: QUOTA SKIP: { my ( $res, $root ); skip "QUOTA not supported", 1 unless $imap->has_capability("QUOTA"); foreach my $root ( "", "INBOX", "/blah" ) { $res = $imap->getquotaroot($root); ok( $res, "getquotaroot($root)" ) or diag( '$@:' . $@ ); #my $tag = $imap->Count; #foreach my $r ( @{$res||[]} ) { # next if $r =~ /^$tag\s+/; # chomp($r); # warn("gqr r=$r\n"); #} } ok( $imap->getquota("User quota"), "getquota" ) or diag( '$@:' . $@ ); my $dne = "ThisDoesNotExist"; ok( !$imap->getquota($dne), "getquota($dne)" ) or diag( '$@:' . $@ ); } Mail-IMAPClient-3.38/t/thread.t0000644000175000017500000000167412535524202015453 0ustar ppearlppearl#!/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 ); Mail-IMAPClient-3.38/t/messageset.t0000644000175000017500000000160212535524202016333 0ustar ppearlppearl#!/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' ); Mail-IMAPClient-3.38/t/lib/0000755000175000017500000000000012656252125014563 5ustar ppearlppearlMail-IMAPClient-3.38/t/lib/MyTest.pm0000644000175000017500000000137312642542252016350 0ustar ppearlppearlpackage MyTest; use strict; use warnings; my $infile = "test.txt"; sub new { my ($class) = @_; my %self; open( my $fh, "<", $infile ) or die("test parameters not provided in $infile\n"); my %argmap = ( passed => "Password", authmech => "Authmechanism" ); while ( my $l = <$fh> ) { chomp $l; next if $l =~ /^\s*#/; my ( $p, $v ) = split( /=/, $l, 2 ); s/^\s+//, s/\s+$// for $p, $v; $p = $argmap{$p} if $argmap{$p}; $self{ ucfirst($p) } = $v if defined $v; } close($fh); my @missing; foreach my $p (qw/Server User Password/) { push( @missing, $p ) unless defined $self{$p}; } die("missing value for: @missing") if (@missing); return \%self; } 1; Mail-IMAPClient-3.38/t/body_string.t0000644000175000017500000000350212535524202016517 0ustar ppearlppearl#!/usr/bin/perl # # tests for body_string() # # body_string() calls fetch() internally. rather than refactor # body_string() just for testing, we subclass M::IC and use the # overidden fetch() to feed it test data. use strict; use warnings; use IO::Socket qw(:crlf); use Test::More tests => 3; BEGIN { use_ok('Mail::IMAPClient') or exit; } my @tests = ( [ "simple fetch", [ '12 FETCH 1 BODY[TEXT]', '* 1 FETCH (FLAGS (\\Seen \\Recent) BODY[TEXT]', "This is a test message$CRLF" . "Line Z (last line)$CRLF", ")$CRLF", "12 OK Fetch completed.$CRLF", ], [ 1 ], "This is a test message$CRLF" . "Line Z (last line)$CRLF", ], # 2010-05-27: test for bug reported by Heiko Schlittermann [ "uwimap IMAP4rev1 2007b.404 fetch unseen", [ '4 FETCH 1 BODY[TEXT]', '* 1 FETCH (BODY[TEXT]', "This is a test message$CRLF" . "Line Z (last line)$CRLF", ")$CRLF", "* 1 FETCH (FLAGS (\\Recent \\Seen)$CRLF", "4 OK Fetch completed$CRLF", ], [ 1 ], "This is a test message$CRLF" . "Line Z (last line)$CRLF", ], ); package Test::Mail::IMAPClient; use base 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->body_string(@$request); is_deeply( $r, $response, $comment ); } } my $imap = Test::Mail::IMAPClient->new( Uid => 0, Debug => 0 ); run_tests( $imap, \@tests ); Mail-IMAPClient-3.38/lib/0000755000175000017500000000000012656252125014320 5ustar ppearlppearlMail-IMAPClient-3.38/lib/Mail/0000755000175000017500000000000012656252125015202 5ustar ppearlppearlMail-IMAPClient-3.38/lib/Mail/IMAPClient/0000755000175000017500000000000012656252125017067 5ustar ppearlppearlMail-IMAPClient-3.38/lib/Mail/IMAPClient/Thread.pod0000644000175000017500000000071212535524202020774 0ustar ppearlppearl=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. Mail-IMAPClient-3.38/lib/Mail/IMAPClient/Thread.grammar0000644000175000017500000000045712535524202021646 0ustar ppearlppearl# 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; } Mail-IMAPClient-3.38/lib/Mail/IMAPClient/MessageSet.pm0000644000175000017500000002150212562562313021464 0ustar ppearlppearluse warnings; use strict; package Mail::IMAPClient::MessageSet; =head1 NAME Mail::IMAPClient::MessageSet - ranges of message sequence numbers =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 specify 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 negligible. 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; Mail-IMAPClient-3.38/lib/Mail/IMAPClient/Thread.pm0000644000175000017500000013552512563236720020647 0ustar ppearlppearlpackage Mail::IMAPClient::Thread; use Parse::RecDescent; { my $ERRORS; package Parse::RecDescent::Mail::IMAPClient::Thread; use strict; use vars qw($skip $AUTOLOAD ); @Parse::RecDescent::Mail::IMAPClient::Thread::ISA = (); $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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{'('}); $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; undef $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; } ) { $text = $lastsep . $text if defined $lastsep; $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,sub { \@arg },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; undef $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; } ) { $text = $lastsep . $text if defined $lastsep; $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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{NUMBER, or thread}); $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 },undef))) { 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 },undef))) { 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($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; } # ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{/\\d+/}); $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; undef $lastsep; $expectation->is(q{})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A(?:\d+)/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__PATTERN1__}=$current_match; Parse::RecDescent::_trace(q{>>Matched production: [/\\d+/]<<}, Parse::RecDescent::_tracefirst($text), q{NUMBER}, $tracelevel) if defined $::RD_TRACE; $_matched = 1; last; } unless ( $_matched || 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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{/^\\* THREAD /i}); $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; undef $lastsep; $expectation->is(q{})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A(?:^\* THREAD )/i) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__PATTERN1__}=$current_match; 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,sub { \@arg },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($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; } } package Mail::IMAPClient::Thread; sub new { my $self = bless( { '_AUTOTREE' => undef, '_AUTOACTION' => undef, 'namespace' => 'Parse::RecDescent::Mail::IMAPClient::Thread', 'startcode' => '', 'rules' => { 'thread' => bless( { 'calls' => [ 'threadmember' ], 'prods' => [ bless( { 'error' => undef, 'actcount' => 1, 'uncommit' => undef, 'line' => undef, 'items' => [ bless( { 'line' => 10, 'pattern' => '(', 'lookahead' => 0, 'hashname' => '__STRING1__', 'description' => '\'(\'' }, 'Parse::RecDescent::InterpLit' ), bless( { 'lookahead' => 0, 'subrule' => 'threadmember', 'line' => 10, 'max' => 100000000, 'min' => 1, 'argcode' => undef, 'expected' => undef, 'matchrule' => 0, 'repspec' => 's' }, 'Parse::RecDescent::Repetition' ), bless( { 'pattern' => ')', 'line' => 10, 'lookahead' => 0, 'hashname' => '__STRING2__', 'description' => '\')\'' }, 'Parse::RecDescent::InterpLit' ), bless( { 'hashname' => '__ACTION1__', 'code' => '{ $return = $item{\'threadmember(s)\'}||undef; }', 'line' => 11, 'lookahead' => 0 }, 'Parse::RecDescent::Action' ) ], 'dircount' => 0, 'strcount' => 2, 'number' => 0, 'patcount' => 0 }, 'Parse::RecDescent::Production' ) ], 'line' => 10, 'impcount' => 0, 'changed' => 0, 'vars' => '', 'opcount' => 0, 'name' => 'thread' }, 'Parse::RecDescent::Rule' ), 'threadmember' => bless( { 'line' => 5, 'prods' => [ bless( { 'error' => undef, 'strcount' => 0, 'dircount' => 0, 'items' => [ bless( { 'matchrule' => 0, 'argcode' => undef, 'lookahead' => 0, 'subrule' => 'NUMBER', 'implicit' => undef, 'line' => 7 }, 'Parse::RecDescent::Subrule' ), bless( { 'hashname' => '__ACTION1__', 'code' => '{ $return = $item{NUMBER} ; }', 'line' => 7, 'lookahead' => 0 }, 'Parse::RecDescent::Action' ) ], 'line' => undef, 'patcount' => 0, 'number' => 0, 'actcount' => 1, 'uncommit' => undef }, 'Parse::RecDescent::Production' ), bless( { 'error' => undef, 'actcount' => 1, 'uncommit' => undef, 'strcount' => 0, 'dircount' => 0, 'items' => [ bless( { 'matchrule' => 0, 'argcode' => undef, 'lookahead' => 0, 'line' => 8, 'implicit' => undef, 'subrule' => 'thread' }, 'Parse::RecDescent::Subrule' ), bless( { 'lookahead' => 0, 'line' => 8, 'hashname' => '__ACTION1__', 'code' => '{ $return = $item{thread} ; }' }, 'Parse::RecDescent::Action' ) ], 'line' => 7, 'patcount' => 0, 'number' => 1 }, 'Parse::RecDescent::Production' ) ], 'calls' => [ 'NUMBER', 'thread' ], 'impcount' => 0, 'changed' => 0, 'vars' => '', 'opcount' => 0, 'name' => 'threadmember' }, 'Parse::RecDescent::Rule' ), 'NUMBER' => bless( { 'line' => 1, 'prods' => [ bless( { 'line' => undef, 'items' => [ bless( { 'ldelim' => '/', 'mod' => '', 'description' => '/\\\\d+/', 'rdelim' => '/', 'pattern' => '\\d+', 'line' => 3, 'lookahead' => 0, 'hashname' => '__PATTERN1__' }, 'Parse::RecDescent::Token' ) ], 'dircount' => 0, 'strcount' => 0, 'number' => 0, 'patcount' => 1, 'actcount' => 0, 'uncommit' => undef, 'error' => undef }, 'Parse::RecDescent::Production' ) ], 'calls' => [], 'opcount' => 0, 'name' => 'NUMBER', 'impcount' => 0, 'changed' => 0, 'vars' => '' }, 'Parse::RecDescent::Rule' ), 'start' => bless( { 'opcount' => 0, 'name' => 'start', 'impcount' => 0, 'changed' => 0, 'vars' => '', 'calls' => [ 'thread' ], 'prods' => [ bless( { 'error' => undef, 'actcount' => 1, 'uncommit' => undef, 'strcount' => 0, 'line' => undef, 'items' => [ bless( { 'ldelim' => '/', 'mod' => 'i', 'description' => '/^\\\\* THREAD /i', 'rdelim' => '/', 'pattern' => '^\\* THREAD ', 'line' => 16, 'lookahead' => 0, 'hashname' => '__PATTERN1__' }, 'Parse::RecDescent::Token' ), bless( { 'lookahead' => 0, 'subrule' => 'thread', 'line' => 16, 'max' => 100000000, 'min' => 0, 'argcode' => undef, 'expected' => undef, 'matchrule' => 0, 'repspec' => 's?' }, 'Parse::RecDescent::Repetition' ), bless( { 'lookahead' => 0, 'line' => 16, 'code' => '{ $return=$item{\'thread(s?)\'}||undef; }', 'hashname' => '__ACTION1__' }, 'Parse::RecDescent::Action' ) ], 'dircount' => 0, 'patcount' => 1, 'number' => 0 }, 'Parse::RecDescent::Production' ) ], 'line' => 15 }, 'Parse::RecDescent::Rule' ) }, '_check' => { 'thisoffset' => '', 'prevcolumn' => '', 'prevline' => '', 'itempos' => '', 'thiscolumn' => '', 'prevoffset' => '' }, 'localvars' => '' }, 'Parse::RecDescent' ); }Mail-IMAPClient-3.38/lib/Mail/IMAPClient/BodyStructure.pm0000644000175000017500000004143312563016041022240 0ustar ppearlppearluse warnings; use strict; package Mail::IMAPClient::BodyStructure; use Mail::IMAPClient::BodyStructure::Parse; # BUG?: old code used name "HEAD" instead of "HEADER", change? my $HEAD = "HEAD"; # 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; # BUG?: should this default to ($HEAD, TEXT) 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++; # BUG?: old code didn't add .TEXT sections, should we skip these? # - This code needs to be generalised (maybe it belongs in parts()?) # - Should every message should have HEAD (actually MIME) and TEXT? # at least dovecot and iplanet appear to allow this even for # non-multipart sections my $pno = $partno; my $stype = $self->{bodytype} || ""; my $ptype = $p->{bodytype} || ""; # a message and the multipart inside of it "collapse together" if ( $partno == 1 and $stype eq 'MESSAGE' and $ptype eq 'MULTIPART' ) { $pno = "TEXT"; $p->{_prefix} = "$prefix"; } else { $p->{_prefix} = "$prefix$partno"; } $p->{_id} ||= "$prefix$pno"; 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}; # BUG?: can this be removed? ... seems wrong 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 parse_string { my ( $class, $envelope ) = @_; $envelope = "(" . $envelope . ")" unless ( $envelope =~ /^\(/ ); $parser->envelopestruct($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; use Mail::IMAPClient::BodyStructure; my $imap = Mail::IMAPClient->new( Server => $server, User => $login, Password => $pass ); $imap->select("INBOX") or die "Could not select INBOX: $@\n"; my @recent = $imap->search("recent") or die "No recent msgs in INBOX\n"; foreach my $id (@recent) { my $bsdat = $imap->fetch( $id, "bodystructure" ); my $bso = Mail::IMAPClient::BodyStructure->new( join("", $imap->History) ); my $mime = $bso->bodytype . "/" . $bso->bodysubtype; my $parts = map( "\n\t" . $_, $bso->parts ); print "Msg $id (Content-type: $mime) contains these parts:$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 to help pull information out of the data structure. This module requires Parse::RecDescent. =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. The module B provides the B convenience method to simplify use of this module when starting with just a messages sequence number or unique ID (UID). =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 a B object for the message from the calling B object. =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 Mail::IMAPClient::BodyStructure::Envelope 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 analogous 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 Original author: David J. Kernen; Reworked by: Mark Overmeer; Maintained by Phil Pearl. =head1 SEE ALSO perl(1), Mail::IMAPClient, Parse::RecDescent, and RFC2060. =cut Mail-IMAPClient-3.38/lib/Mail/IMAPClient/BodyStructure/0000755000175000017500000000000012656252125021705 5ustar ppearlppearlMail-IMAPClient-3.38/lib/Mail/IMAPClient/BodyStructure/Parse.pod0000644000175000017500000000077112535524202023462 0ustar ppearlppearl=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. Mail-IMAPClient-3.38/lib/Mail/IMAPClient/BodyStructure/Parse.pm0000644000175000017500000312063612563236706023334 0ustar ppearlppearlpackage Mail::IMAPClient::BodyStructure::Parse; use Parse::RecDescent; { my $ERRORS; package Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse; use strict; use vars qw($skip $AUTOLOAD ); @Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::ISA = (); $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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{'('}); $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; undef $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; } ) { $text = $lastsep . $text if defined $lastsep; $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 },undef))) { 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 },undef))) { 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 },undef))) { 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 },undef))) { 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 },undef))) { 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 },undef))) { 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 },undef))) { 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 },undef))) { 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 },undef))) { 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 },undef))) { 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; undef $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; } ) { $text = $lastsep . $text if defined $lastsep; $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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{'('}); $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; undef $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; } ) { $text = $lastsep . $text if defined $lastsep; $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 },undef))) { 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; undef $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; } ) { $text = $lastsep . $text if defined $lastsep; $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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{/^NIL/i}); $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; undef $lastsep; $expectation->is(q{})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A(?:^NIL)/i) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__PATTERN1__}=$current_match; 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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{/^"PLAIN"|^PLAIN/i}); $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; undef $lastsep; $expectation->is(q{})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A(?:^"PLAIN"|^PLAIN)/i) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__PATTERN1__}=$current_match; 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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{/^"RFC822"|^RFC822/i}); $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; undef $lastsep; $expectation->is(q{})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A(?:^"RFC822"|^RFC822)/i) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__PATTERN1__}=$current_match; 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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{PLAIN, or HTML, or NIL, or STRING}); $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 },undef))) { 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 },undef))) { 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 },undef))) { 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 },undef))) { 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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{ADDRESSES}); $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 },undef))) { 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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{subpart}); $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,sub { \@arg },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 },undef))) { 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,sub { \@arg },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,sub { \@arg },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,sub { \@arg },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,sub { \@arg },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,sub { \@arg },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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{/[()]/, or STRING}); $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; undef $lastsep; $expectation->is(q{})->at($text); $_savetext = $text; if ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A(?:[()])/) { $text = $_savetext; $expectation->failed(); Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__PATTERN1__}=$current_match; $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 },undef))) { 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 },undef))) { 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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{NIL, or STRING, or STRINGS}); $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 },undef))) { 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 },undef))) { 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 },undef))) { 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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{NIL, or STRING}); $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 },undef))) { 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 },undef))) { 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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{NIL, or STRING}); $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 },undef))) { 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 },undef))) { 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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{NIL, or RFCNONCOMPLY, or '('}); $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 },undef))) { 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: [RFCNONCOMPLY]}, 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 subrule: [RFCNONCOMPLY]}, 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::RFCNONCOMPLY($thisparser,$text,$repeating,$_noactions,sub { \@arg },undef))) { Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text), q{ADDRESSES}, $tracelevel) if defined $::RD_TRACE; $expectation->failed(); last; } Parse::RecDescent::_trace(q{>>Matched subrule: [RFCNONCOMPLY]<< (return value: [} . $_tok . q{]}, Parse::RecDescent::_tracefirst($text), q{ADDRESSES}, $tracelevel) if defined $::RD_TRACE; $item{q{RFCNONCOMPLY}} = $_tok; push @item, $_tok; } Parse::RecDescent::_trace(q{>>Matched production: [RFCNONCOMPLY]<<}, 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"}[2]; $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; undef $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; } ) { $text = $lastsep . $text if defined $lastsep; $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,sub { \@arg },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; undef $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; } ) { $text = $lastsep . $text if defined $lastsep; $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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{STRING}); $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 },undef))) { 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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{MESSAGE}); $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 },undef))) { 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 },undef))) { 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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{ADDRESSES}); $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 },undef))) { 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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{NIL, or KVPAIRS}); $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 },undef))) { 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 },undef))) { 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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{'('}); $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; undef $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; } ) { $text = $lastsep . $text if defined $lastsep; $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,sub { \@arg },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; undef $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; } ) { $text = $lastsep . $text if defined $lastsep; $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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{NIL, or STRING}); $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 },undef))) { 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 },undef))) { 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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{multipart, or textmessage, or nestedmessage, or othertypemessage}); $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 },undef))) { 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 },undef))) { 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 },undef))) { 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 },undef))) { 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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{/^"TEXT"|^TEXT/i}); $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; undef $lastsep; $expectation->is(q{})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A(?:^"TEXT"|^TEXT)/i) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__PATTERN1__}=$current_match; 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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{/^"MESSAGE"|^MESSAGE/i}); $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; undef $lastsep; $expectation->is(q{})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A(?:^"MESSAGE"|^MESSAGE)/i) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__PATTERN1__}=$current_match; 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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{/.*?\\(.*?BODYSTRUCTURE \\(/i}); $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; undef $lastsep; $expectation->is(q{})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A(?:.*?\(.*?BODYSTRUCTURE \()/i) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__PATTERN1__}=$current_match; 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,sub { \@arg },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; undef $lastsep; $expectation->is(q{/\\).*\\)\\r?\\n?/})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A(?:\).*\)\r?\n?)/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__PATTERN2__}=$current_match; 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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{'('}); $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; undef $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; } ) { $text = $lastsep . $text if defined $lastsep; $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 },undef))) { 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 },undef))) { 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 },undef))) { 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 },undef))) { 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; undef $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; } ) { $text = $lastsep . $text if defined $lastsep; $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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{NIL, or STRING}); $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 },undef))) { 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 },undef))) { 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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{NIL, or STRING}); $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 },undef))) { 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 },undef))) { 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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{/"HTML"|HTML/i}); $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; undef $lastsep; $expectation->is(q{})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A(?:"HTML"|HTML)/i) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__PATTERN1__}=$current_match; 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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{')'}); $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; undef $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 },undef))) { 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 },undef))) { 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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{ADDRESSES}); $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 },undef))) { 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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{NIL, or STRING}); $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 },undef))) { 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 },undef))) { 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($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; } # ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{bodysubtype}); $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 },undef))) { 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,sub { \@arg },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,sub { \@arg },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,sub { \@arg },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,sub { \@arg },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,sub { \@arg },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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{/[()]/, or NUMBER}); $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; undef $lastsep; $expectation->is(q{})->at($text); $_savetext = $text; if ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A(?:[()])/) { $text = $_savetext; $expectation->failed(); Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__PATTERN1__}=$current_match; $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 },undef))) { 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 },undef))) { 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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{bodytype}); $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 },undef))) { 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 },undef))) { 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,sub { \@arg },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,sub { \@arg },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,sub { \@arg },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,sub { \@arg },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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{/[()]/, or STRING}); $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; undef $lastsep; $expectation->is(q{})->at($text); $_savetext = $text; if ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A(?:[()])/) { $text = $_savetext; $expectation->failed(); Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__PATTERN1__}=$current_match; $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 },undef))) { 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 },undef))) { 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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{NIL, or STRING, or KVPAIRS}); $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 },undef))) { 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 },undef))) { 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 },undef))) { 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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{DOUBLE_QUOTED_STRING, or SINGLE_QUOTED_STRING, or BARESTRING}); $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 },undef))) { 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 },undef))) { 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 },undef))) { 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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{/.*?\\(.*?ENVELOPE/}); $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; undef $lastsep; $expectation->is(q{})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A(?:.*?\(.*?ENVELOPE)/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__PATTERN1__}=$current_match; 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 },undef))) { 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; undef $lastsep; $expectation->is(q{/.*\\)/})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A(?:.*\))/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__PATTERN2__}=$current_match; 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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{ADDRESSES}); $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 },undef))) { 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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{NIL, or NUMBER}); $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 },undef))) { 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 },undef))) { 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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{rfc822message}); $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 },undef))) { 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 },undef))) { 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 },undef))) { 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 },undef))) { 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 },undef))) { 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 },undef))) { 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,sub { \@arg },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,sub { \@arg },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,sub { \@arg },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,sub { \@arg },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,sub { \@arg },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,sub { \@arg },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,sub { \@arg },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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{ADDRESSES}); $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 },undef))) { 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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{'''}); $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; undef $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; } ) { $text = $lastsep . $text if defined $lastsep; $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; undef $lastsep; $expectation->is(q{/(?:\\\\['\\\\]|[^'])*/})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A(?:(?:\\['\\]|[^'])*)/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__PATTERN1__}=$current_match; Parse::RecDescent::_trace(q{Trying terminal: [''']}, Parse::RecDescent::_tracefirst($text), q{SINGLE_QUOTED_STRING}, $tracelevel) if defined $::RD_TRACE; undef $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; } ) { $text = $lastsep . $text if defined $lastsep; $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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{'('}); $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; undef $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; } ) { $text = $lastsep . $text if defined $lastsep; $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,sub { \@arg },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; undef $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; } ) { $text = $lastsep . $text if defined $lastsep; $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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{'('}); $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; undef $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; } ) { $text = $lastsep . $text if defined $lastsep; $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,sub { \@arg },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; undef $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; } ) { $text = $lastsep . $text if defined $lastsep; $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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{/^[)('"]/}); $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; undef $lastsep; $expectation->is(q{})->at($text); $_savetext = $text; if ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A(?:^[)('"])/) { $text = $_savetext; $expectation->failed(); Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__PATTERN1__}=$current_match; $text = $_savetext; Parse::RecDescent::_trace(q{Trying terminal: [/^(?!\\(|\\))(?:\\\\ |\\S)+/]}, Parse::RecDescent::_tracefirst($text), q{BARESTRING}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{/^(?!\\(|\\))(?:\\\\ |\\S)+/})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A(?:^(?!\(|\))(?:\\ |\S)+)/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__PATTERN2__}=$current_match; 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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{NIL, or KVPAIRS}); $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 },undef))) { 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 },undef))) { 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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{'"'}); $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; undef $lastsep; $expectation->is(q{})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A\"/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(qq{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__STRING1__}=$current_match; Parse::RecDescent::_trace(q{Trying terminal: [/(?:\\\\["\\\\]|[^"])*/]}, Parse::RecDescent::_tracefirst($text), q{DOUBLE_QUOTED_STRING}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{/(?:\\\\["\\\\]|[^"])*/})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A(?:(?:\\["\\]|[^"])*)/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__PATTERN1__}=$current_match; Parse::RecDescent::_trace(q{Trying terminal: ['"']}, Parse::RecDescent::_tracefirst($text), q{DOUBLE_QUOTED_STRING}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{'"'})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A\"/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(qq{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__STRING2__}=$current_match; 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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{NIL, or STRING}); $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 },undef))) { 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 },undef))) { 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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{STRING}); $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 },undef))) { 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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{NIL, or STRING}); $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 },undef))) { 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 },undef))) { 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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{NIL, or NUMBER, or STRING, or KVPAIRS}); $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 },undef))) { 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 },undef))) { 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 },undef))) { 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 },undef))) { 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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{NIL, or STRING}); $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 },undef))) { 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 },undef))) { 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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{ADDRESSES}); $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 },undef))) { 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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{/^(\\d+)/}); $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; undef $lastsep; $expectation->is(q{})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A(?:^(\d+))/) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__PATTERN1__}=$current_match; 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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{TEXT}); $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 },undef))) { 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 },undef))) { 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,sub { \@arg },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,sub { \@arg },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,sub { \@arg },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,sub { \@arg },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,sub { \@arg },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($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, $_itempos) sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::RFCNONCOMPLY { my $thisparser = $_[0]; use vars q{$tracelevel}; local $tracelevel = ($tracelevel||0)+1; $ERRORS = 0; my $thisrule = $thisparser->{"rules"}{"RFCNONCOMPLY"}; Parse::RecDescent::_trace(q{Trying rule: [RFCNONCOMPLY]}, Parse::RecDescent::_tracefirst($_[1]), q{RFCNONCOMPLY}, $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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{/^\\(\\)/i}); $expectation->at($_[1]); my $thisline; tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; while (!$_matched && !$commit) { Parse::RecDescent::_trace(q{Trying production: [/^\\(\\)/i]}, Parse::RecDescent::_tracefirst($_[1]), q{RFCNONCOMPLY}, $tracelevel) if defined $::RD_TRACE; my $thisprod = $thisrule->{"prods"}[0]; $text = $_[1]; my $_savetext; @item = (q{RFCNONCOMPLY}); %item = (__RULE__ => q{RFCNONCOMPLY}); my $repcount = 0; Parse::RecDescent::_trace(q{Trying terminal: [/^\\(\\)/i]}, Parse::RecDescent::_tracefirst($text), q{RFCNONCOMPLY}, $tracelevel) if defined $::RD_TRACE; undef $lastsep; $expectation->is(q{})->at($text); unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ m/\A(?:^\(\))/i) { $text = $lastsep . $text if defined $lastsep; $expectation->failed(); Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; last; } $current_match = substr($text, $-[0], $+[0] - $-[0]); substr($text,0,length($current_match),q{}); Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} . $current_match . q{])}, Parse::RecDescent::_tracefirst($text)) if defined $::RD_TRACE; push @item, $item{__PATTERN1__}=$current_match; Parse::RecDescent::_trace(q{Trying action}, Parse::RecDescent::_tracefirst($text), q{RFCNONCOMPLY}, $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: [/^\\(\\)/i]<<}, Parse::RecDescent::_tracefirst($text), q{RFCNONCOMPLY}, $tracelevel) if defined $::RD_TRACE; $_matched = 1; last; } splice @{$thisparser->{deferred}}, $def_at unless $_matched; unless ( $_matched || defined($score) ) { splice @{$thisparser->{deferred}}, $def_at; $_[1] = $text; # NOT SURE THIS IS NEEDED Parse::RecDescent::_trace(q{<>}, Parse::RecDescent::_tracefirst($_[1]), q{RFCNONCOMPLY}, $tracelevel) if defined $::RD_TRACE; return undef; } if (!defined($return) && defined($score)) { Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", q{RFCNONCOMPLY}, $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{RFCNONCOMPLY}, $tracelevel); Parse::RecDescent::_trace(q{(consumed: [} . Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, Parse::RecDescent::_tracefirst($text), , q{RFCNONCOMPLY}, $tracelevel) } $_[1] = $text; return $return; } # ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{NIL, or STRING}); $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 },undef))) { 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 },undef))) { 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($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, $_itempos) 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 = $_[2]; my $_noactions = $_[3]; my @arg = defined $_[4] ? @{ &{$_[4]} } : (); my $_itempos = $_[5]; my %arg = ($#arg & 01) ? @arg : (@arg, undef); my $text; my $lastsep; my $current_match; my $expectation = new Parse::RecDescent::Expectation(q{NIL, or STRING, or STRINGS}); $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 },undef))) { 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 },undef))) { 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 },undef))) { 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($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; } } package Mail::IMAPClient::BodyStructure::Parse; sub new { my $self = bless( { 'localvars' => '', 'startcode' => '', 'rules' => { 'envelopestruct' => bless( { 'calls' => [ 'date', 'subject', 'from', 'sender', 'replyto', 'to', 'cc', 'bcc', 'inreplyto', 'messageid' ], 'prods' => [ bless( { 'error' => undef, 'number' => 0, 'patcount' => 0, 'line' => undef, 'items' => [ bless( { 'lookahead' => 0, 'pattern' => '(', 'line' => 105, 'description' => '\'(\'', 'hashname' => '__STRING1__' }, 'Parse::RecDescent::InterpLit' ), bless( { 'line' => 105, 'implicit' => undef, 'subrule' => 'date', 'lookahead' => 0, 'argcode' => undef, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ), bless( { 'matchrule' => 0, 'lookahead' => 0, 'line' => 105, 'implicit' => undef, 'subrule' => 'subject', 'argcode' => undef }, 'Parse::RecDescent::Subrule' ), bless( { 'implicit' => undef, 'line' => 105, 'subrule' => 'from', 'lookahead' => 0, 'argcode' => undef, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ), bless( { 'matchrule' => 0, 'argcode' => undef, 'implicit' => undef, 'line' => 105, 'subrule' => 'sender', 'lookahead' => 0 }, 'Parse::RecDescent::Subrule' ), bless( { 'lookahead' => 0, 'implicit' => undef, 'line' => 105, 'subrule' => 'replyto', 'argcode' => undef, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ), bless( { 'matchrule' => 0, 'subrule' => 'to', 'implicit' => undef, 'line' => 105, 'lookahead' => 0, 'argcode' => undef }, 'Parse::RecDescent::Subrule' ), bless( { 'matchrule' => 0, 'argcode' => undef, 'subrule' => 'cc', 'implicit' => undef, 'line' => 105, 'lookahead' => 0 }, 'Parse::RecDescent::Subrule' ), bless( { 'matchrule' => 0, 'implicit' => undef, 'subrule' => 'bcc', 'line' => 106, 'lookahead' => 0, 'argcode' => undef }, 'Parse::RecDescent::Subrule' ), bless( { 'matchrule' => 0, 'lookahead' => 0, 'line' => 106, 'implicit' => undef, 'subrule' => 'inreplyto', 'argcode' => undef }, 'Parse::RecDescent::Subrule' ), bless( { 'argcode' => undef, 'lookahead' => 0, 'implicit' => undef, 'line' => 106, 'subrule' => 'messageid', 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ), bless( { 'description' => '\')\'', 'hashname' => '__STRING2__', 'lookahead' => 0, 'line' => 106, 'pattern' => ')' }, 'Parse::RecDescent::InterpLit' ), bless( { 'hashname' => '__ACTION1__', 'code' => '{ $return = bless {}, "Mail::IMAPClient::BodyStructure::Envelope"; $return->{$_} = $item{$_} for qw/date subject from sender replyto to cc/ , qw/bcc inreplyto messageid/; 1; }', 'line' => 107, 'lookahead' => 0 }, 'Parse::RecDescent::Action' ) ], 'dircount' => 0, 'strcount' => 2, 'uncommit' => undef, 'actcount' => 1 }, 'Parse::RecDescent::Production' ) ], 'line' => 105, 'opcount' => 0, 'name' => 'envelopestruct', 'changed' => 0, 'impcount' => 0, 'vars' => '' }, 'Parse::RecDescent::Rule' ), 'subpart' => bless( { 'name' => 'subpart', 'opcount' => 0, 'changed' => 0, 'impcount' => 0, 'vars' => '', 'line' => 175, 'prods' => [ bless( { 'actcount' => 1, 'uncommit' => undef, 'items' => [ bless( { 'hashname' => '__STRING1__', 'description' => '\'(\'', 'line' => 175, 'pattern' => '(', 'lookahead' => 0 }, 'Parse::RecDescent::InterpLit' ), bless( { 'argcode' => undef, 'lookahead' => 0, 'implicit' => undef, 'subrule' => 'part', 'line' => 175, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ), bless( { 'line' => 175, 'pattern' => ')', 'lookahead' => 0, 'hashname' => '__STRING2__', 'description' => '\')\'' }, 'Parse::RecDescent::InterpLit' ), bless( { 'line' => 175, 'lookahead' => 0, 'hashname' => '__ACTION1__', 'code' => '{$return = $item{part}}' }, 'Parse::RecDescent::Action' ), bless( { 'line' => 175, 'lookahead' => 0, 'code' => 'push @{$thisparser->{deferred}}, sub { ++$subpartCount; };', 'hashname' => '__DIRECTIVE1__', 'name' => '' }, 'Parse::RecDescent::Directive' ) ], 'dircount' => 1, 'line' => undef, 'strcount' => 2, 'number' => 0, 'patcount' => 0, 'error' => undef }, 'Parse::RecDescent::Production' ) ], 'calls' => [ 'part' ] }, 'Parse::RecDescent::Rule' ), 'NIL' => bless( { 'opcount' => 0, 'name' => 'NIL', 'changed' => 0, 'impcount' => 0, 'vars' => '', 'prods' => [ bless( { 'actcount' => 1, 'uncommit' => undef, 'strcount' => 0, 'dircount' => 0, 'line' => undef, 'items' => [ bless( { 'description' => '/^NIL/i', 'mod' => 'i', 'ldelim' => '/', 'hashname' => '__PATTERN1__', 'rdelim' => '/', 'lookahead' => 0, 'line' => 34, 'pattern' => '^NIL' }, 'Parse::RecDescent::Token' ), bless( { 'hashname' => '__ACTION1__', 'code' => '{ $return = "NIL" }', 'lookahead' => 0, 'line' => 34 }, 'Parse::RecDescent::Action' ) ], 'patcount' => 1, 'number' => 0, 'error' => undef }, 'Parse::RecDescent::Production' ) ], 'calls' => [], 'line' => 34 }, 'Parse::RecDescent::Rule' ), 'PLAIN' => bless( { 'opcount' => 0, 'name' => 'PLAIN', 'impcount' => 0, 'changed' => 0, 'vars' => '', 'line' => 30, 'prods' => [ bless( { 'error' => undef, 'actcount' => 1, 'uncommit' => undef, 'strcount' => 0, 'line' => undef, 'dircount' => 0, 'items' => [ bless( { 'hashname' => '__PATTERN1__', 'rdelim' => '/', 'pattern' => '^"PLAIN"|^PLAIN', 'line' => 30, 'lookahead' => 0, 'mod' => 'i', 'description' => '/^"PLAIN"|^PLAIN/i', 'ldelim' => '/' }, 'Parse::RecDescent::Token' ), bless( { 'lookahead' => 0, 'line' => 30, 'code' => '{ $return = "PLAIN" }', 'hashname' => '__ACTION1__' }, 'Parse::RecDescent::Action' ) ], 'patcount' => 1, 'number' => 0 }, 'Parse::RecDescent::Production' ) ], 'calls' => [] }, 'Parse::RecDescent::Rule' ), 'RFC822' => bless( { 'prods' => [ bless( { 'error' => undef, 'actcount' => 1, 'uncommit' => undef, 'strcount' => 0, 'items' => [ bless( { 'line' => 33, 'pattern' => '^"RFC822"|^RFC822', 'lookahead' => 0, 'rdelim' => '/', 'hashname' => '__PATTERN1__', 'ldelim' => '/', 'description' => '/^"RFC822"|^RFC822/i', 'mod' => 'i' }, 'Parse::RecDescent::Token' ), bless( { 'code' => '{ $return = "RFC822" }', 'hashname' => '__ACTION1__', 'lookahead' => 0, 'line' => 33 }, 'Parse::RecDescent::Action' ) ], 'line' => undef, 'dircount' => 0, 'patcount' => 1, 'number' => 0 }, 'Parse::RecDescent::Production' ) ], 'calls' => [], 'line' => 33, 'vars' => '', 'impcount' => 0, 'changed' => 0, 'opcount' => 0, 'name' => 'RFC822' }, 'Parse::RecDescent::Rule' ), 'bodysubtype' => bless( { 'vars' => '', 'impcount' => 0, 'changed' => 0, 'opcount' => 0, 'name' => 'bodysubtype', 'line' => 54, 'prods' => [ bless( { 'error' => undef, 'line' => undef, 'items' => [ bless( { 'argcode' => undef, 'lookahead' => 0, 'subrule' => 'PLAIN', 'implicit' => undef, 'line' => 54, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ) ], 'dircount' => 0, 'strcount' => 0, 'number' => 0, 'patcount' => 0, 'actcount' => 0, 'uncommit' => undef }, 'Parse::RecDescent::Production' ), bless( { 'error' => undef, 'strcount' => 0, 'items' => [ bless( { 'argcode' => undef, 'lookahead' => 0, 'line' => 54, 'implicit' => undef, 'subrule' => 'HTML', 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ) ], 'line' => 54, 'dircount' => 0, 'patcount' => 0, 'number' => 1, 'actcount' => 0, 'uncommit' => undef }, 'Parse::RecDescent::Production' ), bless( { 'uncommit' => undef, 'actcount' => 0, 'number' => 2, 'patcount' => 0, 'line' => 54, 'items' => [ bless( { 'argcode' => undef, 'lookahead' => 0, 'subrule' => 'NIL', 'implicit' => undef, 'line' => 54, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ) ], 'dircount' => 0, 'strcount' => 0, 'error' => undef }, 'Parse::RecDescent::Production' ), bless( { 'strcount' => 0, 'line' => 54, 'items' => [ bless( { 'argcode' => undef, 'line' => 54, 'implicit' => undef, 'subrule' => 'STRING', 'lookahead' => 0, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ) ], 'dircount' => 0, 'patcount' => 0, 'number' => 3, 'actcount' => 0, 'uncommit' => undef, 'error' => undef }, 'Parse::RecDescent::Production' ) ], 'calls' => [ 'PLAIN', 'HTML', 'NIL', 'STRING' ] }, 'Parse::RecDescent::Rule' ), 'from' => bless( { 'opcount' => 0, 'name' => 'from', 'vars' => '', 'impcount' => 0, 'changed' => 0, 'calls' => [ 'ADDRESSES' ], 'prods' => [ bless( { 'error' => undef, 'uncommit' => undef, 'actcount' => 0, 'patcount' => 0, 'number' => 0, 'strcount' => 0, 'items' => [ bless( { 'matchrule' => 0, 'argcode' => undef, 'implicit' => undef, 'subrule' => 'ADDRESSES', 'line' => 100, 'lookahead' => 0 }, 'Parse::RecDescent::Subrule' ) ], 'line' => undef, 'dircount' => 0 }, 'Parse::RecDescent::Production' ) ], 'line' => 100 }, 'Parse::RecDescent::Rule' ), 'multipart' => bless( { 'prods' => [ bless( { 'error' => undef, 'uncommit' => undef, 'actcount' => 1, 'number' => 0, 'patcount' => 0, 'line' => undef, 'dircount' => 2, 'items' => [ bless( { 'matchrule' => 0, 'expected' => undef, 'repspec' => 's', 'min' => 1, 'argcode' => undef, 'max' => 100000000, 'subrule' => 'subpart', 'line' => 162, 'lookahead' => 0 }, 'Parse::RecDescent::Repetition' ), bless( { 'lookahead' => 0, 'line' => 162, 'name' => '', 'hashname' => '__DIRECTIVE1__', 'code' => '$commit = 1' }, 'Parse::RecDescent::Directive' ), bless( { 'argcode' => undef, 'lookahead' => 0, 'subrule' => 'bodysubtype', 'implicit' => undef, 'line' => 162, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ), bless( { 'repspec' => '?', 'expected' => undef, 'matchrule' => 0, 'argcode' => undef, 'min' => 0, 'max' => 1, 'lookahead' => 0, 'line' => 163, 'subrule' => 'bodyparms' }, 'Parse::RecDescent::Repetition' ), bless( { 'min' => 0, 'argcode' => undef, 'matchrule' => 0, 'expected' => undef, 'repspec' => '?', 'line' => 163, 'subrule' => 'bodydisp', 'lookahead' => 0, 'max' => 1 }, 'Parse::RecDescent::Repetition' ), bless( { 'max' => 1, 'lookahead' => 0, 'line' => 163, 'subrule' => 'bodylang', 'repspec' => '?', 'expected' => undef, 'matchrule' => 0, 'argcode' => undef, 'min' => 0 }, 'Parse::RecDescent::Repetition' ), bless( { 'max' => 1, 'lookahead' => 0, 'line' => 163, 'subrule' => 'bodyloc', 'expected' => undef, 'matchrule' => 0, 'repspec' => '?', 'min' => 0, 'argcode' => undef }, 'Parse::RecDescent::Repetition' ), bless( { 'max' => 1, 'subrule' => 'bodyextra', 'line' => 163, 'lookahead' => 0, 'repspec' => '?', 'matchrule' => 0, 'expected' => undef, 'argcode' => undef, 'min' => 0 }, 'Parse::RecDescent::Repetition' ), bless( { 'hashname' => '__DIRECTIVE2__', 'name' => '', 'code' => 'push @{$thisparser->{deferred}}, sub { $subpartCount = 0 };', 'line' => 164, 'lookahead' => 0 }, 'Parse::RecDescent::Directive' ), bless( { 'lookahead' => 0, 'line' => 165, 'hashname' => '__ACTION1__', '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' ) ], 'strcount' => 0 }, 'Parse::RecDescent::Production' ) ], 'calls' => [ 'subpart', 'bodysubtype', 'bodyparms', 'bodydisp', 'bodylang', 'bodyloc', 'bodyextra' ], 'line' => 162, 'vars' => '', 'impcount' => 0, 'changed' => 0, 'name' => 'multipart', 'opcount' => 0 }, 'Parse::RecDescent::Rule' ), 'bodyid' => bless( { 'opcount' => 0, 'name' => 'bodyid', 'changed' => 0, 'impcount' => 0, 'vars' => '', 'calls' => [ 'NIL', 'STRING' ], 'prods' => [ bless( { 'number' => 0, 'patcount' => 1, 'line' => undef, 'dircount' => 0, 'items' => [ bless( { 'hashname' => '__PATTERN1__', 'rdelim' => '/', 'lookahead' => -1, 'line' => 68, 'pattern' => '[()]', 'mod' => '', 'description' => '/[()]/', 'ldelim' => '/' }, 'Parse::RecDescent::Token' ), bless( { 'matchrule' => 0, 'line' => 68, 'implicit' => undef, 'subrule' => 'NIL', 'lookahead' => 0, 'argcode' => undef }, 'Parse::RecDescent::Subrule' ) ], 'strcount' => 0, 'uncommit' => undef, 'actcount' => 0, 'error' => undef }, 'Parse::RecDescent::Production' ), bless( { 'line' => 68, 'items' => [ bless( { 'argcode' => undef, 'line' => 68, 'implicit' => undef, 'subrule' => 'STRING', 'lookahead' => 0, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ) ], 'dircount' => 0, 'strcount' => 0, 'number' => 1, 'patcount' => 0, 'actcount' => 0, 'uncommit' => undef, 'error' => undef }, 'Parse::RecDescent::Production' ) ], 'line' => 68 }, 'Parse::RecDescent::Rule' ), 'bodylang' => bless( { 'line' => 73, 'calls' => [ 'NIL', 'STRING', 'STRINGS' ], 'prods' => [ bless( { 'error' => undef, 'number' => 0, 'patcount' => 0, 'line' => undef, 'items' => [ bless( { 'lookahead' => 0, 'subrule' => 'NIL', 'implicit' => undef, 'line' => 73, 'argcode' => undef, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ) ], 'dircount' => 0, 'strcount' => 0, 'uncommit' => undef, 'actcount' => 0 }, 'Parse::RecDescent::Production' ), bless( { 'uncommit' => undef, 'actcount' => 0, 'patcount' => 0, 'number' => 1, 'strcount' => 0, 'items' => [ bless( { 'matchrule' => 0, 'argcode' => undef, 'implicit' => undef, 'subrule' => 'STRING', 'line' => 73, 'lookahead' => 0 }, 'Parse::RecDescent::Subrule' ) ], 'dircount' => 0, 'line' => 73, 'error' => undef }, 'Parse::RecDescent::Production' ), bless( { 'uncommit' => undef, 'actcount' => 0, 'number' => 2, 'patcount' => 0, 'items' => [ bless( { 'matchrule' => 0, 'lookahead' => 0, 'implicit' => undef, 'line' => 73, 'subrule' => 'STRINGS', 'argcode' => undef }, 'Parse::RecDescent::Subrule' ) ], 'line' => 73, 'dircount' => 0, 'strcount' => 0, 'error' => undef }, 'Parse::RecDescent::Production' ) ], 'opcount' => 0, 'name' => 'bodylang', 'vars' => '', 'impcount' => 0, 'changed' => 0 }, 'Parse::RecDescent::Rule' ), 'bodyloc' => bless( { 'line' => 75, 'calls' => [ 'NIL', 'STRING' ], 'prods' => [ bless( { 'error' => undef, 'uncommit' => undef, 'actcount' => 0, 'number' => 0, 'patcount' => 0, 'items' => [ bless( { 'matchrule' => 0, 'argcode' => undef, 'implicit' => undef, 'line' => 75, 'subrule' => 'NIL', 'lookahead' => 0 }, 'Parse::RecDescent::Subrule' ) ], 'line' => undef, 'dircount' => 0, 'strcount' => 0 }, 'Parse::RecDescent::Production' ), bless( { 'error' => undef, 'strcount' => 0, 'items' => [ bless( { 'implicit' => undef, 'line' => 75, 'subrule' => 'STRING', 'lookahead' => 0, 'argcode' => undef, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ) ], 'line' => 75, 'dircount' => 0, 'patcount' => 0, 'number' => 1, 'actcount' => 0, 'uncommit' => undef }, 'Parse::RecDescent::Production' ) ], 'opcount' => 0, 'name' => 'bodyloc', 'vars' => '', 'impcount' => 0, 'changed' => 0 }, 'Parse::RecDescent::Rule' ), 'inreplyto' => bless( { 'opcount' => 0, 'name' => 'inreplyto', 'impcount' => 0, 'changed' => 0, 'vars' => '', 'calls' => [ 'NIL', 'STRING' ], 'prods' => [ bless( { 'patcount' => 0, 'number' => 0, 'strcount' => 0, 'line' => undef, 'dircount' => 0, 'items' => [ bless( { 'argcode' => undef, 'subrule' => 'NIL', 'implicit' => undef, 'line' => 91, 'lookahead' => 0, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ) ], 'uncommit' => undef, 'actcount' => 0, 'error' => undef }, 'Parse::RecDescent::Production' ), bless( { 'error' => undef, 'actcount' => 0, 'uncommit' => undef, 'dircount' => 0, 'items' => [ bless( { 'argcode' => undef, 'lookahead' => 0, 'implicit' => undef, 'subrule' => 'STRING', 'line' => 91, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ) ], 'line' => 91, 'strcount' => 0, 'number' => 1, 'patcount' => 0 }, 'Parse::RecDescent::Production' ) ], 'line' => 91 }, 'Parse::RecDescent::Rule' ), 'ADDRESSES' => bless( { 'line' => 95, 'prods' => [ bless( { 'uncommit' => undef, 'actcount' => 0, 'patcount' => 0, 'number' => 0, 'strcount' => 0, 'dircount' => 0, 'items' => [ bless( { 'matchrule' => 0, 'lookahead' => 0, 'line' => 95, 'implicit' => undef, 'subrule' => 'NIL', 'argcode' => undef }, 'Parse::RecDescent::Subrule' ) ], 'line' => undef, 'error' => undef }, 'Parse::RecDescent::Production' ), bless( { 'patcount' => 0, 'number' => 1, 'strcount' => 0, 'items' => [ bless( { 'argcode' => undef, 'implicit' => undef, 'line' => 95, 'subrule' => 'RFCNONCOMPLY', 'lookahead' => 0, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ) ], 'line' => 95, 'dircount' => 0, 'uncommit' => undef, 'actcount' => 0, 'error' => undef }, 'Parse::RecDescent::Production' ), bless( { 'actcount' => 1, 'uncommit' => undef, 'strcount' => 2, 'line' => 96, 'dircount' => 0, 'items' => [ bless( { 'lookahead' => 0, 'line' => 96, 'pattern' => '(', 'description' => '\'(\'', 'hashname' => '__STRING1__' }, 'Parse::RecDescent::InterpLit' ), bless( { 'argcode' => undef, 'min' => 1, 'repspec' => 's', 'matchrule' => 0, 'expected' => undef, 'subrule' => 'addressstruct', 'line' => 96, 'lookahead' => 0, 'max' => 100000000 }, 'Parse::RecDescent::Repetition' ), bless( { 'lookahead' => 0, 'line' => 96, 'pattern' => ')', 'description' => '\')\'', 'hashname' => '__STRING2__' }, 'Parse::RecDescent::InterpLit' ), bless( { 'lookahead' => 0, 'line' => 96, 'code' => '{ $return = $item{\'addressstruct(s)\'} }', 'hashname' => '__ACTION1__' }, 'Parse::RecDescent::Action' ) ], 'patcount' => 0, 'number' => 2, 'error' => undef }, 'Parse::RecDescent::Production' ) ], 'calls' => [ 'NIL', 'RFCNONCOMPLY', 'addressstruct' ], 'vars' => '', 'impcount' => 0, 'changed' => 0, 'opcount' => 0, 'name' => 'ADDRESSES' }, 'Parse::RecDescent::Rule' ), 'key' => bless( { 'calls' => [ 'STRING' ], 'prods' => [ bless( { 'error' => undef, 'number' => 0, 'patcount' => 0, 'items' => [ bless( { 'argcode' => undef, 'implicit' => undef, 'line' => 56, 'subrule' => 'STRING', 'lookahead' => 0, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ) ], 'dircount' => 0, 'line' => undef, 'strcount' => 0, 'uncommit' => undef, 'actcount' => 0 }, 'Parse::RecDescent::Production' ) ], 'line' => 56, 'impcount' => 0, 'changed' => 0, 'vars' => '', 'opcount' => 0, 'name' => 'key' }, 'Parse::RecDescent::Rule' ), 'rfc822message' => bless( { 'prods' => [ bless( { 'error' => undef, 'actcount' => 1, 'uncommit' => undef, 'dircount' => 0, 'items' => [ bless( { 'lookahead' => 0, 'subrule' => 'MESSAGE', 'implicit' => undef, 'line' => 52, 'argcode' => undef, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ), bless( { 'argcode' => undef, 'lookahead' => 0, 'subrule' => 'RFC822', 'implicit' => undef, 'line' => 52, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ), bless( { 'lookahead' => 0, 'line' => 52, 'hashname' => '__ACTION1__', 'code' => '{ $return = "MESSAGE RFC822" }' }, 'Parse::RecDescent::Action' ) ], 'line' => undef, 'strcount' => 0, 'number' => 0, 'patcount' => 0 }, 'Parse::RecDescent::Production' ) ], 'calls' => [ 'MESSAGE', 'RFC822' ], 'line' => 52, 'changed' => 0, 'impcount' => 0, 'vars' => '', 'opcount' => 0, 'name' => 'rfc822message' }, 'Parse::RecDescent::Rule' ), 'bcc' => bless( { 'opcount' => 0, 'name' => 'bcc', 'vars' => '', 'impcount' => 0, 'changed' => 0, 'calls' => [ 'ADDRESSES' ], 'prods' => [ bless( { 'patcount' => 0, 'number' => 0, 'strcount' => 0, 'items' => [ bless( { 'matchrule' => 0, 'subrule' => 'ADDRESSES', 'implicit' => undef, 'line' => 99, 'lookahead' => 0, 'argcode' => undef }, 'Parse::RecDescent::Subrule' ) ], 'line' => undef, 'dircount' => 0, 'uncommit' => undef, 'actcount' => 0, 'error' => undef }, 'Parse::RecDescent::Production' ) ], 'line' => 99 }, 'Parse::RecDescent::Rule' ), 'bodydisp' => bless( { 'opcount' => 0, 'name' => 'bodydisp', 'changed' => 0, 'impcount' => 0, 'vars' => '', 'line' => 67, 'calls' => [ 'NIL', 'KVPAIRS' ], 'prods' => [ bless( { 'error' => undef, 'uncommit' => undef, 'actcount' => 0, 'patcount' => 0, 'number' => 0, 'strcount' => 0, 'line' => undef, 'dircount' => 0, 'items' => [ bless( { 'matchrule' => 0, 'line' => 67, 'implicit' => undef, 'subrule' => 'NIL', 'lookahead' => 0, 'argcode' => undef }, 'Parse::RecDescent::Subrule' ) ] }, 'Parse::RecDescent::Production' ), bless( { 'error' => undef, 'strcount' => 0, 'line' => 67, 'dircount' => 0, 'items' => [ bless( { 'lookahead' => 0, 'implicit' => undef, 'line' => 67, 'subrule' => 'KVPAIRS', 'argcode' => undef, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ) ], 'patcount' => 0, 'number' => 1, 'actcount' => 0, 'uncommit' => undef }, 'Parse::RecDescent::Production' ) ] }, 'Parse::RecDescent::Rule' ), 'KVPAIRS' => bless( { 'vars' => '', 'impcount' => 0, 'changed' => 0, 'opcount' => 0, 'name' => 'KVPAIRS', 'line' => 62, 'prods' => [ bless( { 'error' => undef, 'dircount' => 0, 'line' => undef, 'items' => [ bless( { 'description' => '\'(\'', 'hashname' => '__STRING1__', 'lookahead' => 0, 'line' => 62, 'pattern' => '(' }, 'Parse::RecDescent::InterpLit' ), bless( { 'lookahead' => 0, 'line' => 62, 'subrule' => 'kvpair', 'max' => 100000000, 'min' => 1, 'argcode' => undef, 'expected' => undef, 'matchrule' => 0, 'repspec' => 's' }, 'Parse::RecDescent::Repetition' ), bless( { 'hashname' => '__STRING2__', 'description' => '\')\'', 'line' => 62, 'pattern' => ')', 'lookahead' => 0 }, 'Parse::RecDescent::InterpLit' ), bless( { 'hashname' => '__ACTION1__', 'code' => '{ $return = { map { (%$_) } @{$item{\'kvpair(s)\'}} } }', 'lookahead' => 0, 'line' => 63 }, 'Parse::RecDescent::Action' ) ], 'strcount' => 2, 'number' => 0, 'patcount' => 0, 'actcount' => 1, 'uncommit' => undef }, 'Parse::RecDescent::Production' ) ], 'calls' => [ 'kvpair' ] }, 'Parse::RecDescent::Rule' ), 'bodyMD5' => bless( { 'calls' => [ 'NIL', 'STRING' ], 'prods' => [ bless( { 'uncommit' => undef, 'actcount' => 0, 'number' => 0, 'patcount' => 0, 'line' => undef, 'items' => [ bless( { 'argcode' => undef, 'line' => 72, 'implicit' => undef, 'subrule' => 'NIL', 'lookahead' => 0, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ) ], 'dircount' => 0, 'strcount' => 0, 'error' => undef }, 'Parse::RecDescent::Production' ), bless( { 'error' => undef, 'actcount' => 0, 'uncommit' => undef, 'items' => [ bless( { 'matchrule' => 0, 'subrule' => 'STRING', 'implicit' => undef, 'line' => 72, 'lookahead' => 0, 'argcode' => undef }, 'Parse::RecDescent::Subrule' ) ], 'dircount' => 0, 'line' => 72, 'strcount' => 0, 'number' => 1, 'patcount' => 0 }, 'Parse::RecDescent::Production' ) ], 'line' => 72, 'name' => 'bodyMD5', 'opcount' => 0, 'vars' => '', 'changed' => 0, 'impcount' => 0 }, 'Parse::RecDescent::Rule' ), 'part' => bless( { 'name' => 'part', 'opcount' => 0, 'vars' => '', 'impcount' => 0, 'changed' => 0, 'line' => 177, 'prods' => [ bless( { 'error' => undef, 'number' => 0, 'patcount' => 0, 'line' => undef, 'items' => [ bless( { 'implicit' => undef, 'subrule' => 'multipart', 'line' => 177, 'lookahead' => 0, 'argcode' => undef, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ), bless( { 'line' => 177, 'lookahead' => 0, 'code' => '{ $return = bless $item{multipart}, $mibs }', 'hashname' => '__ACTION1__' }, 'Parse::RecDescent::Action' ) ], 'dircount' => 0, 'strcount' => 0, 'uncommit' => undef, 'actcount' => 1 }, 'Parse::RecDescent::Production' ), bless( { 'uncommit' => undef, 'actcount' => 1, 'number' => 1, 'patcount' => 0, 'line' => 178, 'items' => [ bless( { 'lookahead' => 0, 'implicit' => undef, 'subrule' => 'textmessage', 'line' => 178, 'argcode' => undef, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ), bless( { 'hashname' => '__ACTION1__', 'code' => '{ $return = bless $item{textmessage}, $mibs }', 'line' => 178, 'lookahead' => 0 }, 'Parse::RecDescent::Action' ) ], 'dircount' => 0, 'strcount' => 0, 'error' => undef }, 'Parse::RecDescent::Production' ), bless( { 'error' => undef, 'actcount' => 1, 'uncommit' => undef, 'strcount' => 0, 'line' => 179, 'items' => [ bless( { 'matchrule' => 0, 'implicit' => undef, 'subrule' => 'nestedmessage', 'line' => 179, 'lookahead' => 0, 'argcode' => undef }, 'Parse::RecDescent::Subrule' ), bless( { 'line' => 179, 'lookahead' => 0, 'hashname' => '__ACTION1__', 'code' => '{ $return = bless $item{nestedmessage}, $mibs }' }, 'Parse::RecDescent::Action' ) ], 'dircount' => 0, 'patcount' => 0, 'number' => 2 }, 'Parse::RecDescent::Production' ), bless( { 'error' => undef, 'actcount' => 1, 'uncommit' => undef, 'dircount' => 0, 'line' => 180, 'items' => [ bless( { 'matchrule' => 0, 'lookahead' => 0, 'implicit' => undef, 'subrule' => 'othertypemessage', 'line' => 180, 'argcode' => undef }, 'Parse::RecDescent::Subrule' ), bless( { 'lookahead' => 0, 'line' => 180, 'hashname' => '__ACTION1__', 'code' => '{ $return = bless $item{othertypemessage}, $mibs }' }, 'Parse::RecDescent::Action' ) ], 'strcount' => 0, 'number' => 3, 'patcount' => 0 }, 'Parse::RecDescent::Production' ) ], 'calls' => [ 'multipart', 'textmessage', 'nestedmessage', 'othertypemessage' ] }, 'Parse::RecDescent::Rule' ), 'TEXT' => bless( { 'line' => 27, 'prods' => [ bless( { 'uncommit' => undef, 'actcount' => 1, 'number' => 0, 'patcount' => 1, 'line' => undef, 'items' => [ bless( { 'hashname' => '__PATTERN1__', 'rdelim' => '/', 'lookahead' => 0, 'pattern' => '^"TEXT"|^TEXT', 'line' => 29, 'mod' => 'i', 'description' => '/^"TEXT"|^TEXT/i', 'ldelim' => '/' }, 'Parse::RecDescent::Token' ), bless( { 'line' => 29, 'lookahead' => 0, 'code' => '{ $return = "TEXT" }', 'hashname' => '__ACTION1__' }, 'Parse::RecDescent::Action' ) ], 'dircount' => 0, 'strcount' => 0, 'error' => undef }, 'Parse::RecDescent::Production' ) ], 'calls' => [], 'vars' => '', 'impcount' => 0, 'changed' => 0, 'name' => 'TEXT', 'opcount' => 0 }, 'Parse::RecDescent::Rule' ), 'MESSAGE' => bless( { 'name' => 'MESSAGE', 'opcount' => 0, 'impcount' => 0, 'changed' => 0, 'vars' => '', 'line' => 32, 'prods' => [ bless( { 'actcount' => 1, 'uncommit' => undef, 'strcount' => 0, 'line' => undef, 'dircount' => 0, 'items' => [ bless( { 'description' => '/^"MESSAGE"|^MESSAGE/i', 'mod' => 'i', 'ldelim' => '/', 'hashname' => '__PATTERN1__', 'rdelim' => '/', 'lookahead' => 0, 'pattern' => '^"MESSAGE"|^MESSAGE', 'line' => 32 }, 'Parse::RecDescent::Token' ), bless( { 'code' => '{ $return = "MESSAGE"}', 'hashname' => '__ACTION1__', 'lookahead' => 0, 'line' => 32 }, 'Parse::RecDescent::Action' ) ], 'patcount' => 1, 'number' => 0, 'error' => undef }, 'Parse::RecDescent::Production' ) ], 'calls' => [] }, 'Parse::RecDescent::Rule' ), 'start' => bless( { 'opcount' => 0, 'name' => 'start', 'vars' => '', 'changed' => 0, 'impcount' => 0, 'calls' => [ 'part' ], 'prods' => [ bless( { 'error' => undef, 'strcount' => 0, 'line' => undef, 'items' => [ bless( { 'hashname' => '__PATTERN1__', 'pattern' => '.*?\\(.*?BODYSTRUCTURE \\(', 'line' => 185, 'lookahead' => 0, 'rdelim' => '/', 'mod' => 'i', 'description' => '/.*?\\\\(.*?BODYSTRUCTURE \\\\(/i', 'ldelim' => '/' }, 'Parse::RecDescent::Token' ), bless( { 'lookahead' => 0, 'subrule' => 'part', 'line' => 185, 'max' => 1, 'min' => 1, 'argcode' => undef, 'expected' => undef, 'matchrule' => 0, 'repspec' => '1' }, 'Parse::RecDescent::Repetition' ), bless( { 'mod' => '', 'description' => '/\\\\).*\\\\)\\\\r?\\\\n?/', 'ldelim' => '/', 'hashname' => '__PATTERN2__', 'line' => 185, 'pattern' => '\\).*\\)\\r?\\n?', 'lookahead' => 0, 'rdelim' => '/' }, 'Parse::RecDescent::Token' ), bless( { 'hashname' => '__ACTION1__', 'code' => '{ $return = $item{\'part(1)\'}[0] }', 'line' => 186, 'lookahead' => 0 }, 'Parse::RecDescent::Action' ) ], 'dircount' => 0, 'patcount' => 2, 'number' => 0, 'actcount' => 1, 'uncommit' => undef }, 'Parse::RecDescent::Production' ) ], 'line' => 185 }, 'Parse::RecDescent::Rule' ), 'addressstruct' => bless( { 'prods' => [ bless( { 'actcount' => 1, 'uncommit' => undef, 'strcount' => 2, 'items' => [ bless( { 'line' => 82, 'pattern' => '(', 'lookahead' => 0, 'hashname' => '__STRING1__', 'description' => '\'(\'' }, 'Parse::RecDescent::InterpLit' ), bless( { 'lookahead' => 0, 'implicit' => undef, 'subrule' => 'personalname', 'line' => 82, 'argcode' => undef, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ), bless( { 'implicit' => undef, 'subrule' => 'sourceroute', 'line' => 82, 'lookahead' => 0, 'argcode' => undef, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ), bless( { 'implicit' => undef, 'line' => 82, 'subrule' => 'mailboxname', 'lookahead' => 0, 'argcode' => undef, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ), bless( { 'argcode' => undef, 'lookahead' => 0, 'implicit' => undef, 'subrule' => 'hostname', 'line' => 82, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ), bless( { 'pattern' => ')', 'line' => 82, 'lookahead' => 0, 'hashname' => '__STRING2__', 'description' => '\')\'' }, 'Parse::RecDescent::InterpLit' ), bless( { 'lookahead' => 0, 'line' => 83, 'code' => '{ bless { personalname => $item{personalname} , sourceroute => $item{sourceroute} , mailboxname => $item{mailboxname} , hostname => $item{hostname} }, \'Mail::IMAPClient::BodyStructure::Address\'; }', 'hashname' => '__ACTION1__' }, 'Parse::RecDescent::Action' ) ], 'line' => undef, 'dircount' => 0, 'patcount' => 0, 'number' => 0, 'error' => undef }, 'Parse::RecDescent::Production' ) ], 'calls' => [ 'personalname', 'sourceroute', 'mailboxname', 'hostname' ], 'line' => 82, 'changed' => 0, 'impcount' => 0, 'vars' => '', 'name' => 'addressstruct', 'opcount' => 0 }, 'Parse::RecDescent::Rule' ), 'date' => bless( { 'vars' => '', 'impcount' => 0, 'changed' => 0, 'opcount' => 0, 'name' => 'date', 'line' => 93, 'prods' => [ bless( { 'actcount' => 0, 'uncommit' => undef, 'strcount' => 0, 'dircount' => 0, 'items' => [ bless( { 'matchrule' => 0, 'line' => 93, 'implicit' => undef, 'subrule' => 'NIL', 'lookahead' => 0, 'argcode' => undef }, 'Parse::RecDescent::Subrule' ) ], 'line' => undef, 'patcount' => 0, 'number' => 0, 'error' => undef }, 'Parse::RecDescent::Production' ), bless( { 'uncommit' => undef, 'actcount' => 0, 'number' => 1, 'patcount' => 0, 'dircount' => 0, 'line' => 93, 'items' => [ bless( { 'matchrule' => 0, 'argcode' => undef, 'implicit' => undef, 'line' => 93, 'subrule' => 'STRING', 'lookahead' => 0 }, 'Parse::RecDescent::Subrule' ) ], 'strcount' => 0, 'error' => undef }, 'Parse::RecDescent::Production' ) ], 'calls' => [ 'NIL', 'STRING' ] }, 'Parse::RecDescent::Rule' ), 'hostname' => bless( { 'changed' => 0, 'impcount' => 0, 'vars' => '', 'opcount' => 0, 'name' => 'hostname', 'calls' => [ 'NIL', 'STRING' ], 'prods' => [ bless( { 'error' => undef, 'uncommit' => undef, 'actcount' => 0, 'patcount' => 0, 'number' => 0, 'strcount' => 0, 'items' => [ bless( { 'argcode' => undef, 'implicit' => undef, 'subrule' => 'NIL', 'line' => 80, 'lookahead' => 0, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ) ], 'line' => undef, 'dircount' => 0 }, 'Parse::RecDescent::Production' ), bless( { 'uncommit' => undef, 'actcount' => 0, 'patcount' => 0, 'number' => 1, 'strcount' => 0, 'items' => [ bless( { 'argcode' => undef, 'lookahead' => 0, 'line' => 80, 'implicit' => undef, 'subrule' => 'STRING', 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ) ], 'line' => 80, 'dircount' => 0, 'error' => undef }, 'Parse::RecDescent::Production' ) ], 'line' => 80 }, 'Parse::RecDescent::Rule' ), 'HTML' => bless( { 'name' => 'HTML', 'opcount' => 0, 'changed' => 0, 'impcount' => 0, 'vars' => '', 'prods' => [ bless( { 'error' => undef, 'actcount' => 1, 'uncommit' => undef, 'items' => [ bless( { 'ldelim' => '/', 'description' => '/"HTML"|HTML/i', 'mod' => 'i', 'lookahead' => 0, 'pattern' => '"HTML"|HTML', 'line' => 31, 'rdelim' => '/', 'hashname' => '__PATTERN1__' }, 'Parse::RecDescent::Token' ), bless( { 'lookahead' => 0, 'line' => 31, 'code' => '{ $return = "HTML" }', 'hashname' => '__ACTION1__' }, 'Parse::RecDescent::Action' ) ], 'line' => undef, 'dircount' => 0, 'strcount' => 0, 'number' => 0, 'patcount' => 1 }, 'Parse::RecDescent::Production' ) ], 'calls' => [], 'line' => 31 }, 'Parse::RecDescent::Rule' ), 'kvpair' => bless( { 'line' => 59, 'prods' => [ bless( { 'error' => undef, 'dircount' => 0, 'line' => undef, 'items' => [ bless( { 'hashname' => '__STRING1__', 'description' => '\')\'', 'line' => 59, 'pattern' => ')', 'lookahead' => -1 }, 'Parse::RecDescent::InterpLit' ), bless( { 'matchrule' => 0, 'implicit' => undef, 'subrule' => 'key', 'line' => 59, 'lookahead' => 0, 'argcode' => undef }, 'Parse::RecDescent::Subrule' ), bless( { 'subrule' => 'value', 'implicit' => undef, 'line' => 59, 'lookahead' => 0, 'argcode' => undef, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ), bless( { 'hashname' => '__ACTION1__', 'code' => '{ $return = { $item{key} => $item{value} } }', 'line' => 60, 'lookahead' => 0 }, 'Parse::RecDescent::Action' ) ], 'strcount' => 1, 'number' => 0, 'patcount' => 0, 'actcount' => 1, 'uncommit' => undef }, 'Parse::RecDescent::Production' ) ], 'calls' => [ 'key', 'value' ], 'name' => 'kvpair', 'opcount' => 0, 'vars' => '', 'changed' => 0, 'impcount' => 0 }, 'Parse::RecDescent::Rule' ), 'replyto' => bless( { 'opcount' => 0, 'name' => 'replyto', 'vars' => '', 'changed' => 0, 'impcount' => 0, 'line' => 101, 'calls' => [ 'ADDRESSES' ], 'prods' => [ bless( { 'error' => undef, 'strcount' => 0, 'line' => undef, 'items' => [ bless( { 'matchrule' => 0, 'argcode' => undef, 'subrule' => 'ADDRESSES', 'implicit' => undef, 'line' => 101, 'lookahead' => 0 }, 'Parse::RecDescent::Subrule' ) ], 'dircount' => 0, 'patcount' => 0, 'number' => 0, 'actcount' => 0, 'uncommit' => undef }, 'Parse::RecDescent::Production' ) ] }, 'Parse::RecDescent::Rule' ), 'mailboxname' => bless( { 'impcount' => 0, 'changed' => 0, 'vars' => '', 'opcount' => 0, 'name' => 'mailboxname', 'line' => 79, 'calls' => [ 'NIL', 'STRING' ], 'prods' => [ bless( { 'error' => undef, 'patcount' => 0, 'number' => 0, 'strcount' => 0, 'dircount' => 0, 'items' => [ bless( { 'matchrule' => 0, 'argcode' => undef, 'implicit' => undef, 'line' => 79, 'subrule' => 'NIL', 'lookahead' => 0 }, 'Parse::RecDescent::Subrule' ) ], 'line' => undef, 'uncommit' => undef, 'actcount' => 0 }, 'Parse::RecDescent::Production' ), bless( { 'number' => 1, 'patcount' => 0, 'items' => [ bless( { 'lookahead' => 0, 'implicit' => undef, 'subrule' => 'STRING', 'line' => 79, 'argcode' => undef, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ) ], 'line' => 79, 'dircount' => 0, 'strcount' => 0, 'uncommit' => undef, 'actcount' => 0, 'error' => undef }, 'Parse::RecDescent::Production' ) ] }, 'Parse::RecDescent::Rule' ), 'basicfields' => bless( { 'calls' => [ 'bodysubtype', 'bodyparms', 'bodyid', 'bodydesc', 'bodyenc', 'bodysize' ], 'prods' => [ bless( { 'error' => undef, 'number' => 0, 'patcount' => 0, 'items' => [ bless( { 'lookahead' => 0, 'implicit' => undef, 'subrule' => 'bodysubtype', 'line' => 114, 'argcode' => undef, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ), bless( { 'max' => 1, 'subrule' => 'bodyparms', 'line' => 114, 'lookahead' => 0, 'matchrule' => 0, 'expected' => undef, 'repspec' => '?', 'min' => 0, 'argcode' => undef }, 'Parse::RecDescent::Repetition' ), bless( { 'min' => 0, 'argcode' => undef, 'matchrule' => 0, 'expected' => undef, 'repspec' => '?', 'subrule' => 'bodyid', 'line' => 114, 'lookahead' => 0, 'max' => 1 }, 'Parse::RecDescent::Repetition' ), bless( { 'lookahead' => 0, 'subrule' => 'bodydesc', 'line' => 115, 'max' => 1, 'argcode' => undef, 'min' => 0, 'repspec' => '?', 'expected' => undef, 'matchrule' => 0 }, 'Parse::RecDescent::Repetition' ), bless( { 'argcode' => undef, 'min' => 0, 'repspec' => '?', 'expected' => undef, 'matchrule' => 0, 'lookahead' => 0, 'line' => 115, 'subrule' => 'bodyenc', 'max' => 1 }, 'Parse::RecDescent::Repetition' ), bless( { 'max' => 1, 'subrule' => 'bodysize', 'line' => 115, 'lookahead' => 0, 'repspec' => '?', 'matchrule' => 0, 'expected' => undef, 'argcode' => undef, 'min' => 0 }, 'Parse::RecDescent::Repetition' ), bless( { 'lookahead' => 0, 'line' => 116, 'code' => '{ $return = { bodysubtype => $item{bodysubtype} }; take_optional_items($return, \\%item, qw/bodyparms bodyid bodydesc bodyenc bodysize/); 1; }', 'hashname' => '__ACTION1__' }, 'Parse::RecDescent::Action' ) ], 'dircount' => 0, 'line' => undef, 'strcount' => 0, 'uncommit' => undef, 'actcount' => 1 }, 'Parse::RecDescent::Production' ) ], 'line' => 114, 'impcount' => 0, 'changed' => 0, 'vars' => '', 'opcount' => 0, 'name' => 'basicfields' }, 'Parse::RecDescent::Rule' ), 'bodysize' => bless( { 'opcount' => 0, 'name' => 'bodysize', 'vars' => '', 'changed' => 0, 'impcount' => 0, 'prods' => [ bless( { 'line' => undef, 'items' => [ bless( { 'hashname' => '__PATTERN1__', 'lookahead' => -1, 'pattern' => '[()]', 'line' => 70, 'rdelim' => '/', 'mod' => '', 'description' => '/[()]/', 'ldelim' => '/' }, 'Parse::RecDescent::Token' ), bless( { 'matchrule' => 0, 'argcode' => undef, 'line' => 70, 'implicit' => undef, 'subrule' => 'NIL', 'lookahead' => 0 }, 'Parse::RecDescent::Subrule' ) ], 'dircount' => 0, 'strcount' => 0, 'number' => 0, 'patcount' => 1, 'actcount' => 0, 'uncommit' => undef, 'error' => undef }, 'Parse::RecDescent::Production' ), bless( { 'error' => undef, 'actcount' => 0, 'uncommit' => undef, 'line' => 70, 'items' => [ bless( { 'matchrule' => 0, 'argcode' => undef, 'line' => 70, 'implicit' => undef, 'subrule' => 'NUMBER', 'lookahead' => 0 }, 'Parse::RecDescent::Subrule' ) ], 'dircount' => 0, 'strcount' => 0, 'number' => 1, 'patcount' => 0 }, 'Parse::RecDescent::Production' ) ], 'calls' => [ 'NIL', 'NUMBER' ], 'line' => 70 }, 'Parse::RecDescent::Rule' ), 'othertypemessage' => bless( { 'opcount' => 0, 'name' => 'othertypemessage', 'vars' => '', 'impcount' => 0, 'changed' => 0, 'line' => 132, 'prods' => [ bless( { 'error' => undef, 'uncommit' => undef, 'actcount' => 1, 'patcount' => 0, 'number' => 0, 'strcount' => 0, 'line' => undef, 'items' => [ bless( { 'matchrule' => 0, 'lookahead' => 0, 'line' => 132, 'implicit' => undef, 'subrule' => 'bodytype', 'argcode' => undef }, 'Parse::RecDescent::Subrule' ), bless( { 'matchrule' => 0, 'argcode' => undef, 'subrule' => 'basicfields', 'implicit' => undef, 'line' => 132, 'lookahead' => 0 }, 'Parse::RecDescent::Subrule' ), bless( { 'min' => 0, 'argcode' => undef, 'expected' => undef, 'matchrule' => 0, 'repspec' => '?', 'lookahead' => 0, 'line' => 132, 'subrule' => 'bodyMD5', 'max' => 1 }, 'Parse::RecDescent::Repetition' ), bless( { 'lookahead' => 0, 'subrule' => 'bodydisp', 'line' => 132, 'max' => 1, 'argcode' => undef, 'min' => 0, 'repspec' => '?', 'expected' => undef, 'matchrule' => 0 }, 'Parse::RecDescent::Repetition' ), bless( { 'repspec' => '?', 'matchrule' => 0, 'expected' => undef, 'argcode' => undef, 'min' => 0, 'max' => 1, 'line' => 133, 'subrule' => 'bodylang', 'lookahead' => 0 }, 'Parse::RecDescent::Repetition' ), bless( { 'repspec' => '?', 'matchrule' => 0, 'expected' => undef, 'argcode' => undef, 'min' => 0, 'max' => 1, 'subrule' => 'bodyextra', 'line' => 133, 'lookahead' => 0 }, 'Parse::RecDescent::Repetition' ), bless( { 'code' => '{ $return = { bodytype => $item{bodytype} }; take_optional_items($return, \\%item , qw/bodyMD5 bodydisp bodylang bodyextra/ ); merge_hash($return, $item{basicfields}); 1; }', 'hashname' => '__ACTION1__', 'line' => 134, 'lookahead' => 0 }, 'Parse::RecDescent::Action' ) ], 'dircount' => 0 }, 'Parse::RecDescent::Production' ) ], 'calls' => [ 'bodytype', 'basicfields', 'bodyMD5', 'bodydisp', 'bodylang', 'bodyextra' ] }, 'Parse::RecDescent::Rule' ), 'bodydesc' => bless( { 'impcount' => 0, 'changed' => 0, 'vars' => '', 'opcount' => 0, 'name' => 'bodydesc', 'calls' => [ 'NIL', 'STRING' ], 'prods' => [ bless( { 'uncommit' => undef, 'actcount' => 0, 'number' => 0, 'patcount' => 1, 'dircount' => 0, 'line' => undef, 'items' => [ bless( { 'description' => '/[()]/', 'mod' => '', 'ldelim' => '/', 'hashname' => '__PATTERN1__', 'lookahead' => -1, 'pattern' => '[()]', 'line' => 69, 'rdelim' => '/' }, 'Parse::RecDescent::Token' ), bless( { 'argcode' => undef, 'lookahead' => 0, 'implicit' => undef, 'subrule' => 'NIL', 'line' => 69, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ) ], 'strcount' => 0, 'error' => undef }, 'Parse::RecDescent::Production' ), bless( { 'line' => 69, 'items' => [ bless( { 'matchrule' => 0, 'lookahead' => 0, 'implicit' => undef, 'subrule' => 'STRING', 'line' => 69, 'argcode' => undef }, 'Parse::RecDescent::Subrule' ) ], 'dircount' => 0, 'strcount' => 0, 'number' => 1, 'patcount' => 0, 'actcount' => 0, 'uncommit' => undef, 'error' => undef }, 'Parse::RecDescent::Production' ) ], 'line' => 69 }, 'Parse::RecDescent::Rule' ), 'bodyenc' => bless( { 'line' => 71, 'calls' => [ 'NIL', 'STRING', 'KVPAIRS' ], 'prods' => [ bless( { 'uncommit' => undef, 'actcount' => 0, 'number' => 0, 'patcount' => 0, 'items' => [ bless( { 'argcode' => undef, 'line' => 71, 'implicit' => undef, 'subrule' => 'NIL', 'lookahead' => 0, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ) ], 'line' => undef, 'dircount' => 0, 'strcount' => 0, 'error' => undef }, 'Parse::RecDescent::Production' ), bless( { 'error' => undef, 'actcount' => 0, 'uncommit' => undef, 'strcount' => 0, 'dircount' => 0, 'line' => 71, 'items' => [ bless( { 'argcode' => undef, 'lookahead' => 0, 'implicit' => undef, 'subrule' => 'STRING', 'line' => 71, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ) ], 'patcount' => 0, 'number' => 1 }, 'Parse::RecDescent::Production' ), bless( { 'uncommit' => undef, 'actcount' => 0, 'number' => 2, 'patcount' => 0, 'items' => [ bless( { 'matchrule' => 0, 'argcode' => undef, 'lookahead' => 0, 'line' => 71, 'implicit' => undef, 'subrule' => 'KVPAIRS' }, 'Parse::RecDescent::Subrule' ) ], 'line' => 71, 'dircount' => 0, 'strcount' => 0, 'error' => undef }, 'Parse::RecDescent::Production' ) ], 'changed' => 0, 'impcount' => 0, 'vars' => '', 'name' => 'bodyenc', 'opcount' => 0 }, 'Parse::RecDescent::Rule' ), 'STRING' => bless( { 'name' => 'STRING', 'opcount' => 0, 'vars' => '', 'changed' => 0, 'impcount' => 0, 'line' => 46, 'calls' => [ 'DOUBLE_QUOTED_STRING', 'SINGLE_QUOTED_STRING', 'BARESTRING' ], 'prods' => [ bless( { 'uncommit' => undef, 'actcount' => 0, 'number' => 0, 'patcount' => 0, 'line' => undef, 'items' => [ bless( { 'lookahead' => 0, 'implicit' => undef, 'subrule' => 'DOUBLE_QUOTED_STRING', 'line' => 46, 'argcode' => undef, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ) ], 'dircount' => 0, 'strcount' => 0, 'error' => undef }, 'Parse::RecDescent::Production' ), bless( { 'patcount' => 0, 'number' => 1, 'strcount' => 0, 'dircount' => 0, 'items' => [ bless( { 'matchrule' => 0, 'argcode' => undef, 'line' => 46, 'implicit' => undef, 'subrule' => 'SINGLE_QUOTED_STRING', 'lookahead' => 0 }, 'Parse::RecDescent::Subrule' ) ], 'line' => 46, 'uncommit' => undef, 'actcount' => 0, 'error' => undef }, 'Parse::RecDescent::Production' ), bless( { 'uncommit' => undef, 'actcount' => 0, 'number' => 2, 'patcount' => 0, 'dircount' => 0, 'items' => [ bless( { 'matchrule' => 0, 'argcode' => undef, 'implicit' => undef, 'subrule' => 'BARESTRING', 'line' => 46, 'lookahead' => 0 }, 'Parse::RecDescent::Subrule' ) ], 'line' => 46, 'strcount' => 0, 'error' => undef }, 'Parse::RecDescent::Production' ) ] }, 'Parse::RecDescent::Rule' ), 'envelope' => bless( { 'prods' => [ bless( { 'uncommit' => undef, 'actcount' => 1, 'patcount' => 2, 'number' => 0, 'strcount' => 0, 'dircount' => 0, 'items' => [ bless( { 'rdelim' => '/', 'pattern' => '.*?\\(.*?ENVELOPE', 'line' => 188, 'lookahead' => 0, 'hashname' => '__PATTERN1__', 'ldelim' => '/', 'description' => '/.*?\\\\(.*?ENVELOPE/', 'mod' => '' }, 'Parse::RecDescent::Token' ), bless( { 'matchrule' => 0, 'implicit' => undef, 'line' => 188, 'subrule' => 'envelopestruct', 'lookahead' => 0, 'argcode' => undef }, 'Parse::RecDescent::Subrule' ), bless( { 'ldelim' => '/', 'description' => '/.*\\\\)/', 'mod' => '', 'line' => 188, 'pattern' => '.*\\)', 'lookahead' => 0, 'rdelim' => '/', 'hashname' => '__PATTERN2__' }, 'Parse::RecDescent::Token' ), bless( { 'lookahead' => 0, 'line' => 189, 'code' => '{ $return = $item{envelopestruct} }', 'hashname' => '__ACTION1__' }, 'Parse::RecDescent::Action' ) ], 'line' => undef, 'error' => undef }, 'Parse::RecDescent::Production' ) ], 'calls' => [ 'envelopestruct' ], 'line' => 188, 'impcount' => 0, 'changed' => 0, 'vars' => '', 'name' => 'envelope', 'opcount' => 0 }, 'Parse::RecDescent::Rule' ), 'to' => bless( { 'line' => 103, 'prods' => [ bless( { 'error' => undef, 'uncommit' => undef, 'actcount' => 0, 'patcount' => 0, 'number' => 0, 'strcount' => 0, 'items' => [ bless( { 'argcode' => undef, 'lookahead' => 0, 'subrule' => 'ADDRESSES', 'implicit' => undef, 'line' => 103, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ) ], 'line' => undef, 'dircount' => 0 }, 'Parse::RecDescent::Production' ) ], 'calls' => [ 'ADDRESSES' ], 'name' => 'to', 'opcount' => 0, 'vars' => '', 'changed' => 0, 'impcount' => 0 }, 'Parse::RecDescent::Rule' ), 'textlines' => bless( { 'vars' => '', 'changed' => 0, 'impcount' => 0, 'opcount' => 0, 'name' => 'textlines', 'calls' => [ 'NIL', 'NUMBER' ], 'prods' => [ bless( { 'patcount' => 0, 'number' => 0, 'strcount' => 0, 'items' => [ bless( { 'matchrule' => 0, 'argcode' => undef, 'lookahead' => 0, 'implicit' => undef, 'line' => 50, 'subrule' => 'NIL' }, 'Parse::RecDescent::Subrule' ) ], 'dircount' => 0, 'line' => undef, 'uncommit' => undef, 'actcount' => 0, 'error' => undef }, 'Parse::RecDescent::Production' ), bless( { 'patcount' => 0, 'number' => 1, 'strcount' => 0, 'items' => [ bless( { 'matchrule' => 0, 'lookahead' => 0, 'subrule' => 'NUMBER', 'implicit' => undef, 'line' => 50, 'argcode' => undef }, 'Parse::RecDescent::Subrule' ) ], 'dircount' => 0, 'line' => 50, 'uncommit' => undef, 'actcount' => 0, 'error' => undef }, 'Parse::RecDescent::Production' ) ], 'line' => 50 }, 'Parse::RecDescent::Rule' ), 'nestedmessage' => bless( { 'opcount' => 0, 'name' => 'nestedmessage', 'changed' => 0, 'impcount' => 0, 'vars' => '', 'prods' => [ bless( { 'line' => undef, 'items' => [ bless( { 'matchrule' => 0, 'argcode' => undef, 'lookahead' => 0, 'implicit' => undef, 'subrule' => 'rfc822message', 'line' => 141 }, 'Parse::RecDescent::Subrule' ), bless( { 'line' => 141, 'lookahead' => 0, 'hashname' => '__DIRECTIVE1__', 'name' => '', 'code' => '$commit = 1' }, 'Parse::RecDescent::Directive' ), bless( { 'argcode' => undef, 'implicit' => undef, 'line' => 141, 'subrule' => 'bodyparms', 'lookahead' => 0, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ), bless( { 'matchrule' => 0, 'argcode' => undef, 'line' => 141, 'implicit' => undef, 'subrule' => 'bodyid', 'lookahead' => 0 }, 'Parse::RecDescent::Subrule' ), bless( { 'matchrule' => 0, 'argcode' => undef, 'lookahead' => 0, 'implicit' => undef, 'line' => 141, 'subrule' => 'bodydesc' }, 'Parse::RecDescent::Subrule' ), bless( { 'subrule' => 'bodyenc', 'implicit' => undef, 'line' => 141, 'lookahead' => 0, 'argcode' => undef, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ), bless( { 'argcode' => undef, 'implicit' => undef, 'subrule' => 'bodysize', 'line' => 142, 'lookahead' => 0, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ), bless( { 'max' => 1, 'lookahead' => 0, 'subrule' => 'envelopestruct', 'line' => 143, 'repspec' => '?', 'expected' => undef, 'matchrule' => 0, 'argcode' => undef, 'min' => 0 }, 'Parse::RecDescent::Repetition' ), bless( { 'max' => 1, 'lookahead' => 0, 'line' => 143, 'subrule' => 'bodystructure', 'repspec' => '?', 'expected' => undef, 'matchrule' => 0, 'argcode' => undef, 'min' => 0 }, 'Parse::RecDescent::Repetition' ), bless( { 'argcode' => undef, 'min' => 0, 'repspec' => '?', 'matchrule' => 0, 'expected' => undef, 'line' => 143, 'subrule' => 'textlines', 'lookahead' => 0, 'max' => 1 }, 'Parse::RecDescent::Repetition' ), bless( { 'max' => 1, 'lookahead' => 0, 'subrule' => 'bodyMD5', 'line' => 144, 'expected' => undef, 'matchrule' => 0, 'repspec' => '?', 'min' => 0, 'argcode' => undef }, 'Parse::RecDescent::Repetition' ), bless( { 'max' => 1, 'line' => 144, 'subrule' => 'bodydisp', 'lookahead' => 0, 'repspec' => '?', 'matchrule' => 0, 'expected' => undef, 'argcode' => undef, 'min' => 0 }, 'Parse::RecDescent::Repetition' ), bless( { 'line' => 144, 'subrule' => 'bodylang', 'lookahead' => 0, 'max' => 1, 'min' => 0, 'argcode' => undef, 'matchrule' => 0, 'expected' => undef, 'repspec' => '?' }, 'Parse::RecDescent::Repetition' ), bless( { 'expected' => undef, 'matchrule' => 0, 'repspec' => '?', 'min' => 0, 'argcode' => undef, 'max' => 1, 'lookahead' => 0, 'subrule' => 'bodyextra', 'line' => 144 }, 'Parse::RecDescent::Repetition' ), bless( { 'line' => 145, 'lookahead' => 0, 'hashname' => '__ACTION1__', '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' ) ], 'dircount' => 1, 'strcount' => 0, 'number' => 0, 'patcount' => 0, 'actcount' => 1, 'uncommit' => undef, 'error' => undef }, 'Parse::RecDescent::Production' ) ], 'calls' => [ 'rfc822message', 'bodyparms', 'bodyid', 'bodydesc', 'bodyenc', 'bodysize', 'envelopestruct', 'bodystructure', 'textlines', 'bodyMD5', 'bodydisp', 'bodylang', 'bodyextra' ], 'line' => 141 }, 'Parse::RecDescent::Rule' ), 'sender' => bless( { 'line' => 102, 'calls' => [ 'ADDRESSES' ], 'prods' => [ bless( { 'error' => undef, 'actcount' => 0, 'uncommit' => undef, 'items' => [ bless( { 'argcode' => undef, 'subrule' => 'ADDRESSES', 'implicit' => undef, 'line' => 102, 'lookahead' => 0, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ) ], 'line' => undef, 'dircount' => 0, 'strcount' => 0, 'number' => 0, 'patcount' => 0 }, 'Parse::RecDescent::Production' ) ], 'vars' => '', 'impcount' => 0, 'changed' => 0, 'opcount' => 0, 'name' => 'sender' }, 'Parse::RecDescent::Rule' ), 'SINGLE_QUOTED_STRING' => bless( { 'calls' => [], 'prods' => [ bless( { 'strcount' => 2, 'line' => undef, 'items' => [ bless( { 'lookahead' => 0, 'line' => 40, 'pattern' => '\'', 'description' => '\'\'\'', 'hashname' => '__STRING1__' }, 'Parse::RecDescent::InterpLit' ), bless( { 'hashname' => '__PATTERN1__', 'rdelim' => '/', 'lookahead' => 0, 'pattern' => '(?:\\\\[\'\\\\]|[^\'])*', 'line' => 40, 'description' => '/(?:\\\\\\\\[\'\\\\\\\\]|[^\'])*/', 'mod' => '', 'ldelim' => '/' }, 'Parse::RecDescent::Token' ), bless( { 'hashname' => '__STRING2__', 'description' => '\'\'\'', 'line' => 40, 'pattern' => '\'', 'lookahead' => 0 }, 'Parse::RecDescent::InterpLit' ), bless( { 'code' => '{ $return = $item{__PATTERN1__} }', 'hashname' => '__ACTION1__', 'line' => 40, 'lookahead' => 0 }, 'Parse::RecDescent::Action' ) ], 'dircount' => 0, 'patcount' => 1, 'number' => 0, 'actcount' => 1, 'uncommit' => undef, 'error' => undef }, 'Parse::RecDescent::Production' ) ], 'line' => 38, 'impcount' => 0, 'changed' => 0, 'vars' => '', 'opcount' => 0, 'name' => 'SINGLE_QUOTED_STRING' }, 'Parse::RecDescent::Rule' ), 'bodystructure' => bless( { 'calls' => [ 'part' ], 'prods' => [ bless( { 'dircount' => 0, 'items' => [ bless( { 'lookahead' => 0, 'line' => 182, 'pattern' => '(', 'description' => '\'(\'', 'hashname' => '__STRING1__' }, 'Parse::RecDescent::InterpLit' ), bless( { 'min' => 1, 'argcode' => undef, 'expected' => undef, 'matchrule' => 0, 'repspec' => 's', 'lookahead' => 0, 'line' => 182, 'subrule' => 'part', 'max' => 100000000 }, 'Parse::RecDescent::Repetition' ), bless( { 'hashname' => '__STRING2__', 'description' => '\')\'', 'pattern' => ')', 'line' => 182, 'lookahead' => 0 }, 'Parse::RecDescent::InterpLit' ), bless( { 'lookahead' => 0, 'line' => 183, 'code' => '{ $return = $item{\'part(s)\'} }', 'hashname' => '__ACTION1__' }, 'Parse::RecDescent::Action' ) ], 'line' => undef, 'strcount' => 2, 'number' => 0, 'patcount' => 0, 'actcount' => 1, 'uncommit' => undef, 'error' => undef }, 'Parse::RecDescent::Production' ) ], 'line' => 182, 'impcount' => 0, 'changed' => 0, 'vars' => '', 'name' => 'bodystructure', 'opcount' => 0 }, 'Parse::RecDescent::Rule' ), 'STRINGS' => bless( { 'impcount' => 0, 'changed' => 0, 'vars' => '', 'opcount' => 0, 'name' => 'STRINGS', 'prods' => [ bless( { 'uncommit' => undef, 'actcount' => 1, 'number' => 0, 'patcount' => 0, 'items' => [ bless( { 'pattern' => '(', 'line' => 48, 'lookahead' => 0, 'hashname' => '__STRING1__', 'description' => '\'(\'' }, 'Parse::RecDescent::InterpLit' ), bless( { 'line' => 48, 'subrule' => 'STRING', 'lookahead' => 0, 'max' => 100000000, 'min' => 1, 'argcode' => undef, 'matchrule' => 0, 'expected' => undef, 'repspec' => 's' }, 'Parse::RecDescent::Repetition' ), bless( { 'hashname' => '__STRING2__', 'description' => '\')\'', 'pattern' => ')', 'line' => 48, 'lookahead' => 0 }, 'Parse::RecDescent::InterpLit' ), bless( { 'hashname' => '__ACTION1__', 'code' => '{ $return = $item{\'STRING(s)\'} }', 'lookahead' => 0, 'line' => 48 }, 'Parse::RecDescent::Action' ) ], 'line' => undef, 'dircount' => 0, 'strcount' => 2, 'error' => undef }, 'Parse::RecDescent::Production' ) ], 'calls' => [ 'STRING' ], 'line' => 48 }, 'Parse::RecDescent::Rule' ), 'BARESTRING' => bless( { 'vars' => '', 'changed' => 0, 'impcount' => 0, 'opcount' => 0, 'name' => 'BARESTRING', 'prods' => [ bless( { 'error' => undef, 'number' => 0, 'patcount' => 2, 'items' => [ bless( { 'description' => '/^[)(\'"]/', 'mod' => '', 'ldelim' => '/', 'hashname' => '__PATTERN1__', 'line' => 43, 'pattern' => '^[)(\'"]', 'lookahead' => -1, 'rdelim' => '/' }, 'Parse::RecDescent::Token' ), bless( { 'mod' => '', 'description' => '/^(?!\\\\(|\\\\))(?:\\\\\\\\ |\\\\S)+/', 'ldelim' => '/', 'hashname' => '__PATTERN2__', 'pattern' => '^(?!\\(|\\))(?:\\\\ |\\S)+', 'line' => 43, 'lookahead' => 0, 'rdelim' => '/' }, 'Parse::RecDescent::Token' ), bless( { 'lookahead' => 0, 'line' => 44, 'code' => '{ $return = $item{__PATTERN1__} }', 'hashname' => '__ACTION1__' }, 'Parse::RecDescent::Action' ) ], 'line' => undef, 'dircount' => 0, 'strcount' => 0, 'uncommit' => undef, 'actcount' => 1 }, 'Parse::RecDescent::Production' ) ], 'calls' => [], 'line' => 43 }, 'Parse::RecDescent::Rule' ), 'bodyparms' => bless( { 'line' => 66, 'calls' => [ 'NIL', 'KVPAIRS' ], 'prods' => [ bless( { 'items' => [ bless( { 'argcode' => undef, 'line' => 66, 'implicit' => undef, 'subrule' => 'NIL', 'lookahead' => 0, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ) ], 'line' => undef, 'dircount' => 0, 'strcount' => 0, 'number' => 0, 'patcount' => 0, 'actcount' => 0, 'uncommit' => undef, 'error' => undef }, 'Parse::RecDescent::Production' ), bless( { 'error' => undef, 'number' => 1, 'patcount' => 0, 'line' => 66, 'dircount' => 0, 'items' => [ bless( { 'argcode' => undef, 'subrule' => 'KVPAIRS', 'implicit' => undef, 'line' => 66, 'lookahead' => 0, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ) ], 'strcount' => 0, 'uncommit' => undef, 'actcount' => 0 }, 'Parse::RecDescent::Production' ) ], 'opcount' => 0, 'name' => 'bodyparms', 'impcount' => 0, 'changed' => 0, 'vars' => '' }, 'Parse::RecDescent::Rule' ), 'DOUBLE_QUOTED_STRING' => bless( { 'line' => 41, 'prods' => [ bless( { 'items' => [ bless( { 'lookahead' => 0, 'pattern' => '"', 'line' => 41, 'description' => '\'"\'', 'hashname' => '__STRING1__' }, 'Parse::RecDescent::Literal' ), bless( { 'hashname' => '__PATTERN1__', 'rdelim' => '/', 'line' => 41, 'pattern' => '(?:\\\\["\\\\]|[^"])*', 'lookahead' => 0, 'mod' => '', 'description' => '/(?:\\\\\\\\["\\\\\\\\]|[^"])*/', 'ldelim' => '/' }, 'Parse::RecDescent::Token' ), bless( { 'hashname' => '__STRING2__', 'description' => '\'"\'', 'line' => 41, 'pattern' => '"', 'lookahead' => 0 }, 'Parse::RecDescent::Literal' ), bless( { 'code' => '{ $return = $item{__PATTERN1__} }', 'hashname' => '__ACTION1__', 'line' => 41, 'lookahead' => 0 }, 'Parse::RecDescent::Action' ) ], 'line' => undef, 'dircount' => 0, 'strcount' => 2, 'number' => 0, 'patcount' => 1, 'actcount' => 1, 'uncommit' => undef, 'error' => undef }, 'Parse::RecDescent::Production' ) ], 'calls' => [], 'vars' => '', 'impcount' => 0, 'changed' => 0, 'opcount' => 0, 'name' => 'DOUBLE_QUOTED_STRING' }, 'Parse::RecDescent::Rule' ), 'sourceroute' => bless( { 'line' => 78, 'prods' => [ bless( { 'actcount' => 0, 'uncommit' => undef, 'line' => undef, 'items' => [ bless( { 'argcode' => undef, 'subrule' => 'NIL', 'implicit' => undef, 'line' => 78, 'lookahead' => 0, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ) ], 'dircount' => 0, 'strcount' => 0, 'number' => 0, 'patcount' => 0, 'error' => undef }, 'Parse::RecDescent::Production' ), bless( { 'error' => undef, 'actcount' => 0, 'uncommit' => undef, 'line' => 78, 'items' => [ bless( { 'matchrule' => 0, 'argcode' => undef, 'line' => 78, 'implicit' => undef, 'subrule' => 'STRING', 'lookahead' => 0 }, 'Parse::RecDescent::Subrule' ) ], 'dircount' => 0, 'strcount' => 0, 'number' => 1, 'patcount' => 0 }, 'Parse::RecDescent::Production' ) ], 'calls' => [ 'NIL', 'STRING' ], 'vars' => '', 'changed' => 0, 'impcount' => 0, 'name' => 'sourceroute', 'opcount' => 0 }, 'Parse::RecDescent::Rule' ), 'bodytype' => bless( { 'changed' => 0, 'impcount' => 0, 'vars' => '', 'name' => 'bodytype', 'opcount' => 0, 'line' => 65, 'prods' => [ bless( { 'uncommit' => undef, 'actcount' => 0, 'number' => 0, 'patcount' => 0, 'dircount' => 0, 'items' => [ bless( { 'matchrule' => 0, 'lookahead' => 0, 'subrule' => 'STRING', 'implicit' => undef, 'line' => 65, 'argcode' => undef }, 'Parse::RecDescent::Subrule' ) ], 'line' => undef, 'strcount' => 0, 'error' => undef }, 'Parse::RecDescent::Production' ) ], 'calls' => [ 'STRING' ] }, 'Parse::RecDescent::Rule' ), 'messageid' => bless( { 'line' => 92, 'prods' => [ bless( { 'line' => undef, 'dircount' => 0, 'items' => [ bless( { 'lookahead' => 0, 'subrule' => 'NIL', 'implicit' => undef, 'line' => 92, 'argcode' => undef, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ) ], 'strcount' => 0, 'number' => 0, 'patcount' => 0, 'actcount' => 0, 'uncommit' => undef, 'error' => undef }, 'Parse::RecDescent::Production' ), bless( { 'actcount' => 0, 'uncommit' => undef, 'dircount' => 0, 'items' => [ bless( { 'matchrule' => 0, 'argcode' => undef, 'lookahead' => 0, 'line' => 92, 'implicit' => undef, 'subrule' => 'STRING' }, 'Parse::RecDescent::Subrule' ) ], 'line' => 92, 'strcount' => 0, 'number' => 1, 'patcount' => 0, 'error' => undef }, 'Parse::RecDescent::Production' ) ], 'calls' => [ 'NIL', 'STRING' ], 'name' => 'messageid', 'opcount' => 0, 'vars' => '', 'impcount' => 0, 'changed' => 0 }, 'Parse::RecDescent::Rule' ), 'value' => bless( { 'vars' => '', 'changed' => 0, 'impcount' => 0, 'name' => 'value', 'opcount' => 0, 'line' => 57, 'calls' => [ 'NIL', 'NUMBER', 'STRING', 'KVPAIRS' ], 'prods' => [ bless( { 'items' => [ bless( { 'matchrule' => 0, 'argcode' => undef, 'line' => 57, 'implicit' => undef, 'subrule' => 'NIL', 'lookahead' => 0 }, 'Parse::RecDescent::Subrule' ) ], 'line' => undef, 'dircount' => 0, 'strcount' => 0, 'number' => 0, 'patcount' => 0, 'actcount' => 0, 'uncommit' => undef, 'error' => undef }, 'Parse::RecDescent::Production' ), bless( { 'error' => undef, 'items' => [ bless( { 'matchrule' => 0, 'line' => 57, 'implicit' => undef, 'subrule' => 'NUMBER', 'lookahead' => 0, 'argcode' => undef }, 'Parse::RecDescent::Subrule' ) ], 'line' => 57, 'dircount' => 0, 'strcount' => 0, 'number' => 1, 'patcount' => 0, 'actcount' => 0, 'uncommit' => undef }, 'Parse::RecDescent::Production' ), bless( { 'error' => undef, 'line' => 57, 'items' => [ bless( { 'matchrule' => 0, 'lookahead' => 0, 'subrule' => 'STRING', 'implicit' => undef, 'line' => 57, 'argcode' => undef }, 'Parse::RecDescent::Subrule' ) ], 'dircount' => 0, 'strcount' => 0, 'number' => 2, 'patcount' => 0, 'actcount' => 0, 'uncommit' => undef }, 'Parse::RecDescent::Production' ), bless( { 'patcount' => 0, 'number' => 3, 'strcount' => 0, 'line' => 57, 'items' => [ bless( { 'matchrule' => 0, 'argcode' => undef, 'lookahead' => 0, 'implicit' => undef, 'subrule' => 'KVPAIRS', 'line' => 57 }, 'Parse::RecDescent::Subrule' ) ], 'dircount' => 0, 'uncommit' => undef, 'actcount' => 0, 'error' => undef }, 'Parse::RecDescent::Production' ) ] }, 'Parse::RecDescent::Rule' ), 'personalname' => bless( { 'calls' => [ 'NIL', 'STRING' ], 'prods' => [ bless( { 'error' => undef, 'actcount' => 0, 'uncommit' => undef, 'strcount' => 0, 'items' => [ bless( { 'matchrule' => 0, 'argcode' => undef, 'lookahead' => 0, 'implicit' => undef, 'subrule' => 'NIL', 'line' => 77 }, 'Parse::RecDescent::Subrule' ) ], 'line' => undef, 'dircount' => 0, 'patcount' => 0, 'number' => 0 }, 'Parse::RecDescent::Production' ), bless( { 'error' => undef, 'uncommit' => undef, 'actcount' => 0, 'number' => 1, 'patcount' => 0, 'items' => [ bless( { 'argcode' => undef, 'lookahead' => 0, 'implicit' => undef, 'line' => 77, 'subrule' => 'STRING', 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ) ], 'line' => 77, 'dircount' => 0, 'strcount' => 0 }, 'Parse::RecDescent::Production' ) ], 'line' => 77, 'opcount' => 0, 'name' => 'personalname', 'vars' => '', 'changed' => 0, 'impcount' => 0 }, 'Parse::RecDescent::Rule' ), 'cc' => bless( { 'changed' => 0, 'impcount' => 0, 'vars' => '', 'opcount' => 0, 'name' => 'cc', 'calls' => [ 'ADDRESSES' ], 'prods' => [ bless( { 'strcount' => 0, 'dircount' => 0, 'line' => undef, 'items' => [ bless( { 'matchrule' => 0, 'argcode' => undef, 'lookahead' => 0, 'implicit' => undef, 'line' => 98, 'subrule' => 'ADDRESSES' }, 'Parse::RecDescent::Subrule' ) ], 'patcount' => 0, 'number' => 0, 'actcount' => 0, 'uncommit' => undef, 'error' => undef }, 'Parse::RecDescent::Production' ) ], 'line' => 98 }, 'Parse::RecDescent::Rule' ), 'NUMBER' => bless( { 'line' => 36, 'prods' => [ bless( { 'uncommit' => undef, 'actcount' => 1, 'number' => 0, 'patcount' => 1, 'line' => undef, 'items' => [ bless( { 'mod' => '', 'description' => '/^(\\\\d+)/', 'ldelim' => '/', 'hashname' => '__PATTERN1__', 'pattern' => '^(\\d+)', 'line' => 36, 'lookahead' => 0, 'rdelim' => '/' }, 'Parse::RecDescent::Token' ), bless( { 'code' => '{ $return = $item[1] }', 'hashname' => '__ACTION1__', 'line' => 36, 'lookahead' => 0 }, 'Parse::RecDescent::Action' ) ], 'dircount' => 0, 'strcount' => 0, 'error' => undef }, 'Parse::RecDescent::Production' ) ], 'calls' => [], 'changed' => 0, 'impcount' => 0, 'vars' => '', 'opcount' => 0, 'name' => 'NUMBER' }, 'Parse::RecDescent::Rule' ), 'textmessage' => bless( { 'changed' => 0, 'impcount' => 0, 'vars' => '', 'opcount' => 0, 'name' => 'textmessage', 'line' => 122, 'prods' => [ bless( { 'error' => undef, 'uncommit' => undef, 'actcount' => 1, 'patcount' => 0, 'number' => 0, 'strcount' => 0, 'items' => [ bless( { 'lookahead' => 0, 'implicit' => undef, 'line' => 122, 'subrule' => 'TEXT', 'argcode' => undef, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ), bless( { 'code' => '$commit = 1', 'name' => '', 'hashname' => '__DIRECTIVE1__', 'lookahead' => 0, 'line' => 122 }, 'Parse::RecDescent::Directive' ), bless( { 'argcode' => undef, 'implicit' => undef, 'subrule' => 'basicfields', 'line' => 122, 'lookahead' => 0, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ), bless( { 'argcode' => undef, 'min' => 0, 'repspec' => '?', 'matchrule' => 0, 'expected' => undef, 'subrule' => 'textlines', 'line' => 122, 'lookahead' => 0, 'max' => 1 }, 'Parse::RecDescent::Repetition' ), bless( { 'min' => 0, 'argcode' => undef, 'expected' => undef, 'matchrule' => 0, 'repspec' => '?', 'lookahead' => 0, 'line' => 122, 'subrule' => 'bodyMD5', 'max' => 1 }, 'Parse::RecDescent::Repetition' ), bless( { 'repspec' => '?', 'matchrule' => 0, 'expected' => undef, 'argcode' => undef, 'min' => 0, 'max' => 1, 'subrule' => 'bodydisp', 'line' => 123, 'lookahead' => 0 }, 'Parse::RecDescent::Repetition' ), bless( { 'max' => 1, 'lookahead' => 0, 'line' => 123, 'subrule' => 'bodylang', 'repspec' => '?', 'expected' => undef, 'matchrule' => 0, 'argcode' => undef, 'min' => 0 }, 'Parse::RecDescent::Repetition' ), bless( { 'subrule' => 'bodyextra', 'line' => 123, 'lookahead' => 0, 'max' => 1, 'min' => 0, 'argcode' => undef, 'matchrule' => 0, 'expected' => undef, 'repspec' => '?' }, 'Parse::RecDescent::Repetition' ), bless( { 'code' => '{ $return = $item{basicfields} || {}; $return->{bodytype} = \'TEXT\'; take_optional_items($return, \\%item , qw/textlines bodyMD5 bodydisp bodylang bodyextra/); 1; }', 'hashname' => '__ACTION1__', 'line' => 124, 'lookahead' => 0 }, 'Parse::RecDescent::Action' ) ], 'line' => undef, 'dircount' => 1 }, 'Parse::RecDescent::Production' ) ], 'calls' => [ 'TEXT', 'basicfields', 'textlines', 'bodyMD5', 'bodydisp', 'bodylang', 'bodyextra' ] }, 'Parse::RecDescent::Rule' ), 'RFCNONCOMPLY' => bless( { 'calls' => [], 'prods' => [ bless( { 'error' => undef, 'actcount' => 1, 'uncommit' => undef, 'strcount' => 0, 'line' => undef, 'items' => [ bless( { 'mod' => 'i', 'description' => '/^\\\\(\\\\)/i', 'ldelim' => '/', 'hashname' => '__PATTERN1__', 'rdelim' => '/', 'lookahead' => 0, 'line' => 35, 'pattern' => '^\\(\\)' }, 'Parse::RecDescent::Token' ), bless( { 'code' => '{ $return = "NIL" }', 'hashname' => '__ACTION1__', 'lookahead' => 0, 'line' => 35 }, 'Parse::RecDescent::Action' ) ], 'dircount' => 0, 'patcount' => 1, 'number' => 0 }, 'Parse::RecDescent::Production' ) ], 'line' => 35, 'vars' => '', 'changed' => 0, 'impcount' => 0, 'opcount' => 0, 'name' => 'RFCNONCOMPLY' }, 'Parse::RecDescent::Rule' ), 'subject' => bless( { 'line' => 90, 'calls' => [ 'NIL', 'STRING' ], 'prods' => [ bless( { 'items' => [ bless( { 'argcode' => undef, 'implicit' => undef, 'subrule' => 'NIL', 'line' => 90, 'lookahead' => 0, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ) ], 'line' => undef, 'dircount' => 0, 'strcount' => 0, 'number' => 0, 'patcount' => 0, 'actcount' => 0, 'uncommit' => undef, 'error' => undef }, 'Parse::RecDescent::Production' ), bless( { 'uncommit' => undef, 'actcount' => 0, 'patcount' => 0, 'number' => 1, 'strcount' => 0, 'line' => 90, 'items' => [ bless( { 'line' => 90, 'implicit' => undef, 'subrule' => 'STRING', 'lookahead' => 0, 'argcode' => undef, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ) ], 'dircount' => 0, 'error' => undef }, 'Parse::RecDescent::Production' ) ], 'opcount' => 0, 'name' => 'subject', 'changed' => 0, 'impcount' => 0, 'vars' => '' }, 'Parse::RecDescent::Rule' ), 'bodyextra' => bless( { 'impcount' => 0, 'changed' => 0, 'vars' => '', 'name' => 'bodyextra', 'opcount' => 0, 'calls' => [ 'NIL', 'STRING', 'STRINGS' ], 'prods' => [ bless( { 'error' => undef, 'line' => undef, 'items' => [ bless( { 'subrule' => 'NIL', 'implicit' => undef, 'line' => 74, 'lookahead' => 0, 'argcode' => undef, 'matchrule' => 0 }, 'Parse::RecDescent::Subrule' ) ], 'dircount' => 0, 'strcount' => 0, 'number' => 0, 'patcount' => 0, 'actcount' => 0, 'uncommit' => undef }, 'Parse::RecDescent::Production' ), bless( { 'error' => undef, 'actcount' => 0, 'uncommit' => undef, 'strcount' => 0, 'dircount' => 0, 'line' => 74, 'items' => [ bless( { 'matchrule' => 0, 'implicit' => undef, 'line' => 74, 'subrule' => 'STRING', 'lookahead' => 0, 'argcode' => undef }, 'Parse::RecDescent::Subrule' ) ], 'patcount' => 0, 'number' => 1 }, 'Parse::RecDescent::Production' ), bless( { 'error' => undef, 'actcount' => 0, 'uncommit' => undef, 'strcount' => 0, 'items' => [ bless( { 'matchrule' => 0, 'subrule' => 'STRINGS', 'implicit' => undef, 'line' => 74, 'lookahead' => 0, 'argcode' => undef }, 'Parse::RecDescent::Subrule' ) ], 'dircount' => 0, 'line' => 74, 'patcount' => 0, 'number' => 2 }, 'Parse::RecDescent::Production' ) ], 'line' => 74 }, 'Parse::RecDescent::Rule' ) }, '_check' => { 'prevoffset' => '', 'thiscolumn' => '', 'itempos' => '', 'prevline' => '', 'prevcolumn' => '', 'thisoffset' => '' }, '_AUTOACTION' => undef, 'deferrable' => 1, 'namespace' => 'Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse', '_AUTOTREE' => undef }, 'Parse::RecDescent' ); }Mail-IMAPClient-3.38/lib/Mail/IMAPClient/BodyStructure/Parse.grammar0000644000175000017500000001272512563233024024330 0ustar ppearlppearl# 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" } RFCNONCOMPLY: /^\(\)/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 | RFCNONCOMPLY | "(" 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} } Mail-IMAPClient-3.38/lib/Mail/IMAPClient.pm0000644000175000017500000031246212656251657017446 0ustar ppearlppearl # _{name} methods are undocumented and meant to be private. require 5.008_001; use strict; use warnings; package Mail::IMAPClient; our $VERSION = '3.38'; use Mail::IMAPClient::MessageSet; use IO::Socket qw(:crlf SOL_SOCKET SO_KEEPALIVE); use IO::Select (); use Carp qw(carp); #local $SIG{__WARN__} = \&Carp::cluck; #DEBUG use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK); use Errno qw(EAGAIN EBADF ECONNRESET EPIPE); 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 }; 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); # modules require(d) during runtime when applicable my %Load_Module = ( "Compress-Zlib" => "Compress::Zlib", "INET" => "IO::Socket::INET", "SSL" => "IO::Socket::SSL", "UNIX" => "IO::Socket::UNIX", "BodyStructure" => "Mail::IMAPClient::BodyStructure", "Envelope" => "Mail::IMAPClient::BodyStructure::Envelope", "Thread" => "Mail::IMAPClient::Thread", ); sub _load_module { my $self = shift; my $modkey = shift; my $module = $Load_Module{$modkey} || $modkey; my $err = do { local ($@); eval "require $module"; $@; }; if ($err) { $self->LastError("Unable to load '$module': $err"); return undef; } return $module; } 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 Compress Debug Debug_fh Domain Folder Ignoresizeerrors Keepalive Maxappendstringlength Maxcommandlength Maxtemperrors Password Peek Port Prewritemethod Proxy Ranges Readmethod Readmoremethod Reconnectretry Server Showcredentials Socketargs Ssl Starttls Supportedflags Timeout Uid User) ) { 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 =~ /NO not connected/ ) { my $lerr = $self->{LastError} || ""; my $emsg = "Trying command when NOT connected!"; $emsg .= " LastError was: $lerr" if $lerr; Carp::cluck($emsg); } } # 2.x API support requires setting $@ $@ = $self->{LastError} = $err; } sub Fast_io(;$) { my ( $self, $use ) = @_; defined $use or return $self->{Fast_io}; my $socket = $self->{Socket} or return undef; local ( $@, $! ); # avoid stomping on globals 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{ $_->{name} }++ } @_; } # the constructor: sub new { my $class = shift; my $self = { LastError => "", Uid => 1, Count => 0, Clear => 2, Keepalive => 0, Maxappendstringlength => 1024**2, Maxcommandlength => 1000, Maxtemperrors => undef, State => Unconnected, Authmechanism => 'LOGIN', Timeout => 600, History => {}, }; while (@_) { my $k = ucfirst lc shift; my $v = shift; $self->{$k} = $v if defined $v; } bless $self, ref($class) || $class; # Fast_io is enabled by default when not given a socket unless ( exists $self->{Fast_io} || $self->{Socket} || $self->{Rawsocket} ) { $self->{Fast_io} = 1; } 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}; } if ( !$self->{Socket} && $self->{Server} ) { $self->connect or return undef; } return $self; } sub connect(@) { my $self = shift; # BUG? We should restrict which keys can be passed/set here. %$self = ( %$self, @_ ) if @_; my @sockargs = $self->Timeout ? ( Timeout => $self->Timeout ) : (); push( @sockargs, $self->Debug ? ( Debug => $self->Debug ) : () ); # give caller control of IO::Socket::... args to new if desired if ( $self->Socketargs and ref $self->Socketargs eq "ARRAY" ) { push( @sockargs, @{ $self->Socketargs } ); } my $server = $self->Server; my $port = $self->Port || $self->Port( $self->Ssl ? "993" : "143" ); my ( $ioclass, $sock ); if ( File::Spec->file_name_is_absolute($server) ) { $ioclass = $self->_load_module("UNIX"); unshift( @sockargs, Peer => $server ); } else { unshift( @sockargs, PeerAddr => $server, PeerPort => $port, Proto => "tcp", ); # extra control of SSL args is supported if ( $self->Ssl ) { $ioclass = $self->_load_module("SSL"); push( @sockargs, @{ $self->Ssl } ) if ref $self->Ssl eq "ARRAY"; } else { $ioclass = $self->_load_module("INET"); } } if ($ioclass) { $self->_debug("Connecting with $ioclass @sockargs"); $sock = $ioclass->new(@sockargs); } if ($sock) { $self->_debug( "Connected to $server" . ( $! ? " errno($!)" : "" ) ); return $self->Socket($sock); } else { my $lasterr = $self->LastError || ""; $self->LastError("Unable to connect to $server: $lasterr"); return undef; } } 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 ); return $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; } if ( $self->Starttls ) { $self->starttls or return undef; } if ( defined $self->User && defined $self->Password ) { $self->login or return undef; } return $self->{Socket}; } # RFC2595 section 3.1 sub starttls { my ($self) = @_; # BUG? RFC requirement checks commented out for now... #if ( $self->IsUnconnected or $self->IsAuthenticated ) { # $self->LastError("NO must be connected but not authenticated"); # return undef; #} # BUG? strict check on capability commented out for now... #return undef unless $self->has_capability("STARTTLS"); $self->_imap_command("STARTTLS") or return undef; # MUST discard cached capability info; should re-issue capability command delete $self->{CAPABILITY}; my $ioclass = $self->_load_module("SSL") or return undef; my $sock = $self->RawSocket; my $blocking = $sock->blocking; # BUG: force blocking for now $sock->blocking(1); # give caller control of args to start_SSL if desired my @sslargs = ( $self->Starttls and ref( $self->Starttls ) eq "ARRAY" ) ? ( @{ $self->Starttls } ) : ( Timeout => 30 ); unless ( $ioclass->start_SSL( $sock, @sslargs ) ) { $self->LastError( "Unable to start TLS: " . $ioclass->errstr ); return undef; } # return blocking to previous setting $sock->blocking($blocking); return $self; } # RFC4978 COMPRESS sub compress { my ($self) = @_; # BUG? strict check on capability commented out for now... #my $can = $self->has_capability("COMPRESS") #return undef unless $can and $can eq "DEFLATE"; $self->_imap_command("COMPRESS DEFLATE") or return undef; my $zcl = $self->_load_module("Compress-Zlib") or return undef; # give caller control of args if desired $self->Compress( [ -WindowBits => -$zcl->MAX_WBITS(), -Level => $zcl->Z_BEST_SPEED() ] ) unless ( $self->Compress and ref( $self->Compress ) eq "ARRAY" ); my ( $rc, $do, $io ); ( $do, $rc ) = Compress::Zlib::deflateInit( @{ $self->Compress } ); unless ( $rc == $zcl->Z_OK ) { $self->LastError("deflateInit failed (rc=$rc)"); return undef; } ( $io, $rc ) = Compress::Zlib::inflateInit( -WindowBits => -$zcl->MAX_WBITS() ); unless ( $rc == $zcl->Z_OK ) { $self->LastError("inflateInit failed (rc=$rc)"); return undef; } $self->{Prewritemethod} = sub { my ( $imap, $string ) = @_; my ( $rc, $out1, $out2 ); ( $out1, $rc ) = $do->deflate($string); ( $out2, $rc ) = $do->flush( $zcl->Z_PARTIAL_FLUSH() ) unless ( $rc != $zcl->Z_OK ); unless ( $rc == $zcl->Z_OK ) { $self->LastError("deflate/flush failed (rc=$rc)"); return undef; } return $out1 . $out2; }; # need to retain some state for Readmoremethod/Readmethod calls my ( $Zbuf, $Ibuf ) = ( "", "" ); $self->{Readmoremethod} = sub { my $self = shift; return 1 if ( length($Zbuf) || length($Ibuf) ); $self->__read_more(@_); }; $self->{Readmethod} = sub { my ( $imap, $fh, $buf, $len, $off ) = @_; # get more data, but empty $Ibuf first if any data is left my ( $lz, $li ) = ( length $Zbuf, length $Ibuf ); if ( $lz || !$li ) { my $ret = sysread( $fh, $Zbuf, $len, length $Zbuf ); $lz = length $Zbuf; return $ret if ( !$ret && !$lz ); # $ret is undef or 0 } # accumulate inflated data in $Ibuf if ($lz) { my ( $tbuf, $rc ) = $io->inflate( \$Zbuf ); unless ( $rc == $zcl->Z_OK ) { $self->LastError("inflate failed (rc=$rc)"); return undef; } $Ibuf .= $tbuf; } # pull desired length of data from $Ibuf my $tbuf = substr( $Ibuf, 0, $len ); substr( $Ibuf, 0, $len ) = ""; substr( $$buf, $off ) = $tbuf; return length $tbuf; }; return $self; } sub login { my $self = shift; my $auth = $self->Authmechanism; if ( $auth && $auth ne 'LOGIN' ) { $self->authenticate( $auth, $self->Authcallback ) or return undef; } else { my $user = $self->User; my $passwd = $self->Password; return undef unless ( defined($passwd) and defined($user) ); # if user is passed as a literal: # 1. send passwd as a literal # 2. empty literal passwd are sent as an blank line ($CRLF) $user = $self->Quote($user); if ( $user =~ /^{/ ) { my $nopasswd = ( $passwd eq "" ) ? 1 : 0; $passwd = $self->Quote( $passwd, 1 ); # force literal $passwd .= $CRLF if ($nopasswd); # blank line } else { $passwd = $self->Quote($passwd); } $self->_imap_command("LOGIN $user $passwd") or return undef; } $self->State(Authenticated); if ( $self->Compress ) { $self->compress or return undef; } return $self; } sub noop { my ($self) = @_; $self->_imap_command("NOOP") ? $self->Results : undef; } sub proxyauth { my ( $self, $user ) = @_; $user = $self->Quote($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->Quote($target); $self->_imap_command(qq($cmd "$reference" $target)) or return undef; return wantarray ? $self->Escaped_history : $self->Escaped_results; } sub list { shift->_list_or_lsub( "LIST", @_ ) } sub lsub { shift->_list_or_lsub( "LSUB", @_ ) } # deprecated 3.34 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) || $self->separator(undef); 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; # BUG?: this behavior has been around since 2.x, why? my $cansel = $self->selectable($what); last unless defined $cansel; if ($cansel) { $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; } } }; my @clean = _remove_doubles @folders; return wantarray ? @clean : \@clean; } sub folders { my ( $self, $what ) = @_; my @folders = map( $_->{name}, $self->_folders_or_subscribed( "list", $what ) ); return wantarray ? @folders : \@folders; } sub folders_hash { my ( $self, $what ) = @_; my @folders_hash = $self->_folders_or_subscribed( "list", $what ); return wantarray ? @folders_hash : \@folders_hash; } # deprecated 3.34 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 = map( $_->{name}, $self->_folders_or_subscribed( "lsub", $what ) ); return wantarray ? @folders : \@folders; } sub deleteacl { my ( $self, $target, $user ) = @_; $target = $self->Quote($target); $user = $self->Quote($user); $self->_imap_command(qq(DELETEACL $target $user)) or return undef; return wantarray ? $self->History : $self->Results; } sub setacl { my ( $self, $target, $user, $acl ) = @_; $target ||= $self->Folder; $target = $self->Quote($target); $user ||= $self->User; $user = $self->Quote($user); $acl = $self->Quote($acl); $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->Quote($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->Quote($target); $user ||= $self->User; $user = $self->Quote($user); $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->Quote($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"; my $string; $self->message_to_file( \$string, $msg ); 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; } # message_to_file( $self, $file, @msgs ) sub message_to_file { my ( $self, $file, @msgs ) = @_; # $file can be a name or a scalar reference (for in memory file) # avoid IO::File bug handling scalar refs in perl <= 5.8.8? # - buggy: $fh = IO::File->new( $file, 'r' ) my $fh; if ( ref $file and ref $file ne "SCALAR" ) { $fh = $file; } else { $$file = "" if ( ref $file eq "SCALAR" and !defined $$file ); local ($!); open( $fh, ">>", $file ); unless ( defined($fh) ) { $self->LastError("Unable to open file '$file': $!"); return undef; } } binmode($fh); unless (@msgs) { $self->LastError("message_to_file: NO messages specified!"); return undef; } my $peek = $self->Peek ? '.PEEK' : ''; $peek = sprintf( $self->imap4rev1 ? "BODY%s\[]" : "RFC822%s", $peek ); my @args = ( join( ",", @msgs ), $peek ); return $self->_imap_uid_command( { outref => $fh }, "FETCH" => @args ) ? $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; } # cleaned up and simplified but see TODO in code... sub migrate { my ( $self, $peer, $msgs, $folder ) = @_; unless ( $peer and $peer->IsConnected ) { $self->LastError( ( $peer ? "Invalid" : "Unconnected" ) . " target " . ref($self) . " object in migrate()" . ( $peer ? ( ": " . $peer->LastError ) : "" ) ); return undef; } # sanity check to see if $self is same object as $peer if ( $self eq $peer ) { $self->LastError("dest must not be the same object as self"); return undef; } $folder = $self->Folder unless ( defined $folder ); unless ($folder) { $self->LastError("No folder selected on source mailbox."); return undef; } unless ( $peer->exists($folder) or $peer->create($folder) ) { $self->LastError( "Create folder '$folder' on target host failed: " . $peer->LastError ); return undef; } if ( !defined $msgs or uc($msgs) eq "ALL" ) { $msgs = $self->search("ALL") or return undef; } # message size and (internal) date my @headers = qw(RFC822.SIZE INTERNALDATE FLAGS); my $range = $self->Range($msgs); $self->_debug("Messages to migrate from '$folder': $range"); foreach my $mid ( $range->unfold ) { # fetch size internaldate and flags of original message # - TODO: add flags here... my $minfo = $self->fetch_hash( $mid, @headers ) or return undef; my ( $size, $date ) = @{ $minfo->{$mid} }{@headers}; return undef unless ( defined $size and defined $date ); $self->_debug("Copy message $mid (sz=$size,dt=$date) from '$folder'"); my @flags = grep !/\\Recent/i, $self->flags($mid); my $flags = join ' ', $peer->supported_flags(@flags); # TODO: - use File::Temp tempfile if $msg > bufferSize? # read message to $msg my $msg; $self->message_to_file( \$msg, $mid ) or return undef; my $newid = $peer->append_file( $folder, \$msg, undef, $flags, $date ); unless ( defined $newid ) { $self->LastError( "Append to '$folder' on target failed: " . $peer->LastError ); return undef; } $self->_debug("Copied UID $mid in '$folder' to target UID $newid"); } 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 until ( $popped && $popped =~ /^\)$CRLF$/o ) || !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->Quote($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 idle_data { my $self = shift; my $timeout = scalar(@_) ? shift : 0; my $socket = $self->Socket; # current index in Results array my $trans_c1 = $self->_next_index; # look for all untagged responses my ( $rc, $ret ); do { $ret = $self->_read_more( { error_on_timeout => 0 }, $socket, $timeout ); # set rc on first pass or on errors $rc = $ret if ( !defined($rc) or $ret < 0 ); # not using /\S+/ because that can match 0 in "* 0 RECENT" # leading the library to act as if things failed if ( $ret > 0 ) { $self->_get_response( '*', qr/(?!BAD|BYE|NO)(?:\d+\s+\w+|\S+)/ ) or return undef; $timeout = 0; # check for more data without blocking! } } while $ret > 0 and $self->IsConnected; # select returns -1 on errors return undef if $rc < 0; my $trans_c2 = $self->_next_index; # if current index in Results array has changed return data my @res; if ( $trans_c1 < $trans_c2 ) { @res = $self->Results; @res = @res[ $trans_c1 .. ( $trans_c2 - 1 ) ]; } return wantarray ? @res : \@res; } sub done { my $self = shift; my $count = shift || $self->Count; # DONE looks like a tag when sent and not already in IDLE $self->_imap_command( { addtag => 0, tag => qr/(?:$count|DONE)/ }, "DONE" ) or return undef; return $self->Results; } # tag_and_run( $self, $string, $good ) sub tag_and_run { my $self = shift; $self->_imap_command(@_) or return undef; return $self->Results; } sub reconnect { my $self = shift; if ( $self->IsAuthenticated ) { $self->_debug("reconnect called but already authenticated"); return 1; } # safeguard from deep recursion via connect if ( $self->{_doing_reconnect} ) { $self->_debug("recursive call to reconnect, returning 0\n"); $self->LastError("unexpected reconnect recursion") unless $self->LastError; return 0; } my $einfo = $self->LastError || ""; $self->_debug( "reconnecting to ", $self->Server, ", last error: $einfo" ); $self->{_doing_reconnect} = 1; # reconnect and select appropriate folder my $ret; if ( $self->connect ) { $ret = 1; if ( defined $self->Folder ) { $ret = defined( $self->select( $self->Folder ) ) ? 1 : undef; } } delete $self->{_doing_reconnect}; return $ret ? 1 : $ret; } # 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 =~ /(?:error\(.*?\)|timeout) waiting\b/ or $self->LastError =~ /(?:socket closed|\* BYE)\b/ # BUG? reconnect if caller ignored/missed earlier errors? # or $self->LastError =~ /NO not connected/ ); my $ret = $self->reconnect; if ($ret) { $self->_debug("reconnect success($ret) on try #$tries/$retry"); } elsif ( defined $ret and $ret == 0 ) { # escaping recursion return undef; } else { $self->_debug("reconnect failure on try #$tries/$retry"); 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 $self->Count # outref => ... - see _get_response() sub _imap_command_do { my $self = shift; my $opt = ref( $_[0] ) eq "HASH" ? shift : {}; my $string = shift or return undef; my $good = shift; my @gropt = ( $opt->{outref} ? { outref => $opt->{outref} } : () ); $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( @gropt, $tag, $good ) or return undef; if ( $code eq 'OK' ) { return $self; } elsif ( $good and $code eq $good ) { return $self; } else { return undef; } } sub _response_code_sub { my ( $self, $tag, $good ) = @_; # tag/good can be a ref (compiled regex) otherwise quote it my $qtag = ref($tag) ? $tag : defined($tag) ? quotemeta($tag) : undef; my $qgood = ref($good) ? $good : defined($good) ? quotemeta($good) : undef; # using closure, a variable alias, and sub returns on first match # - $_[0] is $o->[DATA] # - returns list ( $code, $byemsg ) my $getcodesub = sub { if ( defined $qgood ) { if ( $good eq '+' and $_[0] =~ /^$qgood/ ) { return ($good); } if ( defined $qtag and $_[0] =~ /^$qtag\s+($qgood)/i ) { return ( ref($qgood) ? $1 : uc($1) ); } } if ( defined $qtag ) { if ( $tag eq '+' and $_[0] =~ /^$qtag/ ) { return ($tag); } if ( $_[0] =~ /^$qtag\s+(OK|BAD|NO)\b/i ) { my $code = uc($1); $self->LastError( $_[0] ) unless ( $code eq 'OK' ); return ($code); } } if ( $_[0] =~ /^\*\s+(BYE)\b/i ) { return ( uc($1), $_[0] ); # ( 'BYE', $byemsg ) } return (undef); }; return $getcodesub; } # _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; my $outref = $opt->{outref}; my @readopt = defined($outref) ? ($outref) : (); my $getcode = $self->_response_code_sub( $tag, $good ); my ( $count, $out, $code, $byemsg ) = ( $self->Count, [], undef, undef ); until ( defined $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 ( $tcode, $tbyemsg ) = $getcode->( $o->[DATA] ); $code = $tcode if ( defined $tcode ); $byemsg = $tbyemsg if ( defined $tbyemsg ); } } if ( defined $code ) { $code =~ s/$CR?$LF?$//o; $code = uc($code) unless ( $good and $code eq $good ); # RFC 3501 7.1.5: $code on successful LOGOUT is OK not BYE # sometimes we may fail to wait long enough to read a tagged # OK so don't be strict about setting an error on LOGOUT! if ( $code eq 'BYE' ) { $self->State(Unconnected); if ($byemsg) { $self->LastError($byemsg) unless ( $good and $code eq $good ); } } } elsif ( !$self->LastError ) { my $info = "unexpected response: " . join( " ", @$out ); $self->LastError($info); } return $code; } sub _imap_uid_command { my $self = shift; my @opt = ref( $_[0] ) eq "HASH" ? (shift) : (); my $cmd = shift; my $args = @_ ? join( " ", '', @_ ) : ''; my $uid = $self->Uid ? 'UID ' : ''; $self->_imap_command( @opt, "$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; } # try to avoid exposing auth info via debug unless Showcredentials is true sub _redact_line { my ( $self, $string ) = @_; $self->Showcredentials and return undef; my ( $tag, $cmd ) = ( $self->Count, undef ); my $retext = "[Redact: Count=$tag Showcredentials=OFF]"; my $show = $retext; # tagged command? if ( $string =~ s/^($tag\s+(\S+)\s+)// ) { ( $show, $cmd ) = ( $1, $2 ); # login if ( $cmd =~ /login/i ) { # username as literal if ( $string =~ /^{/ ) { $show .= $string; } # username (possibly quoted) string, then literal? password elsif ( $string =~ s/^((?:"(?>(?:(?>[^"\\]+)|\\.)*)"|\S+)\s*)// ) { $show .= $1; $show .= ( $string =~ /^{/ ) ? $string : $retext; } } elsif ( $cmd =~ /^auth/i ) { $show .= $string; } else { return undef; # show it all } } return $show; } # _send_line handles literal data and supports the Prewritemethod sub _send_line { my ( $self, $string, $suppress ) = @_; $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; if ( $self->Debug ) { my $dat = ( $self->IsConnected and !$self->IsAuthenticated ) ? $self->_redact_line($string) : undef; $self->_debug( "Sending literal: $first\tthen: ", $dat || $string ); } $self->_send_line($first) or return undef; # look for "$tag NO" or "+ ..." my $code = $self->_get_response( $self->Count, '+' ) or return undef; return undef unless $code eq '+'; } # non-literal part continues... if ( my $prew = $self->Prewritemethod ) { $string = $prew->( $self, $string ); } if ( $self->Debug ) { my $dat = ( $self->IsConnected and !$self->IsAuthenticated ) ? $self->_redact_line($string) : undef; $self->_debug( "Sending: ", $dat || $string ); } unless ( $self->IsConnected ) { $self->LastError("NO not connected"); return undef; } $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; undef $maxagain if $maxagain and lc($maxagain) eq 'unlimited'; local $SIG{PIPE} = 'IGNORE'; # handle SIGPIPE as normal error my $socket = $self->Socket; while ( $total < length $$byteref ) { my $written = syswrite( $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 or $! == EBADF ); $self->LastError("Write failed '$emsg'"); return undef; # no luck } $self->_debug("Sent $total bytes"); return $total; } # _read_line: read one line from the socket # # $output = $self->_read_line($literal_callback) # literal_callback is optional, but if supplied it must be either # be a filehandle, coderef, or undef. # # Returns a reference to an array of arrays, i.e.: # $output = [ # [ $index, 'OUTPUT|LITERAL', $output_line ], # [ $index, 'OUTPUT|LITERAL', $output_line ], # ... # \]; # BUG?: make memory more efficient sub _read_line { my ( $self, $literal_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; my $transno = $self->Transaction; my $literal_cbtype = ""; if ($literal_callback) { if ( UNIVERSAL::isa( $literal_callback, "GLOB" ) ) { $literal_cbtype = "GLOB"; } elsif ( UNIVERSAL::isa( $literal_callback, "CODE" ) ) { $literal_cbtype = "CODE"; } else { $self->LastError( "'$literal_callback' is an " . "invalid callback; must be a filehandle or CODE" ); return undef; } } my $temperrs = 0; my $maxagain = $self->Maxtemperrors; undef $maxagain if $maxagain and lc($maxagain) eq 'unlimited'; 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: ) { if ($timeout) { my $rc = $self->_read_more( $socket, $timeout ); return undef unless ( $rc > 0 ); } my $emsg; my $ret = $self->_sysread( $socket, \$iBuffer, $readlen, length $iBuffer ); if ($timeout) { if ( defined $ret ) { $temperrs = 0; } else { $emsg = "error while reading data from server: $!"; if ( $! == ECONNRESET ) { $self->State(Unconnected); } elsif ( $! == EAGAIN ) { if ( defined $maxagain && $temperrs++ >= $maxagain ) { $emsg .= " ($temperrs)"; } else { next; # try again } } } } 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/\{(\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 = ''; my $litreadb = length($litstring); my $temperrs = 0; my $maxagain = $self->Maxtemperrors; undef $maxagain if $maxagain and lc($maxagain) eq 'unlimited'; while ( $expected_size > $litreadb ) { if ($timeout) { my $rc = $self->_read_more( $socket, $timeout ); return undef unless ( $rc > 0 ); } else { # 25 ms before retry CORE::select( undef, undef, undef, 0.025 ); } # $litstring is emptied when $literal_cbtype is GLOB my $ret = $self->_sysread( $socket, \$litstring, $expected_size - $litreadb, length($litstring) ); if ($timeout) { if ( defined $ret ) { $temperrs = 0; } else { $emsg = "error while reading data from server: $!"; if ( $! == ECONNRESET ) { $self->State(Unconnected); } elsif ( $! == EAGAIN ) { if ( defined $maxagain && $temperrs++ >= $maxagain ) { $emsg .= " ($temperrs)"; } else { undef $emsg; next; # try again } } } } # EOF: note IO::Socket::SSL does not support eof() if ( defined $ret and $ret == 0 ) { $emsg = "socket closed while reading data from server"; $self->State(Unconnected); } elsif ( defined $ret and $ret > 0 ) { $litreadb += $ret; # conserve memory when using literal_callback GLOB if ( $literal_cbtype eq "GLOB" ) { print $literal_callback $litstring; $litstring = "" unless ($emsg); } } $self->_debug( "Received ret=" . ( defined($ret) ? $ret : "" ) . " $litreadb 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 ( defined $litstring ) { if ( $literal_cbtype eq "GLOB" ) { print $literal_callback $litstring; } elsif ( $literal_cbtype eq "CODE" ) { $literal_callback->($litstring); } } push @$oBuffer, [ $index++, 'LITERAL', $litstring ] if ( $literal_cbtype ne "GLOB" ); } } $self->_debug( "Read: " . join "", map { "\t" . $_->[DATA] } @$oBuffer ) if ( $self->Debug ); @$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 $self = shift; my $rm = $self->Readmoremethod; $rm ? $rm->( $self, @_ ) : $self->__read_more(@_); } sub __read_more { my $self = shift; my $opt = ref( $_[0] ) eq "HASH" ? shift : {}; 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; my $rc = CORE::select( $rvec, undef, $rvec, $timeout ); # fast track success return $rc if $rc > 0; # by default set an error on timeout my $err_on_timeout = exists $opt->{error_on_timeout} ? $opt->{error_on_timeout} : 1; # $rc is 0 then we timed out return $rc if !$rc and !$err_on_timeout; # set the appropriate error and return my $transno = $self->Transaction; my $msg = ( $rc ? "error($rc)" : "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 $rc; } 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 _escaped_trans_data(;$) { my ( $self, $trans ) = @_; my @a; my $prevwasliteral = 0; foreach my $line ( $self->_transaction($trans) ) { next unless defined $line; my $data = $line->[DATA]; # literal is appended to previous data if ( $self->_is_literal($line) ) { $data = $self->Escape($data); $a[-1] .= qq("$data"); $prevwasliteral = 1; } else { if ($prevwasliteral) { $a[-1] .= $data; } else { push( @a, $data ); } $prevwasliteral = 0; } } return wantarray ? @a : \@a; } 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; } sub _transaction_literals() { my $self = shift; join '', map { $_->[DATA] } grep { $self->_is_literal($_) } $self->_transaction; } sub Escaped_history { my ( $self, $trans ) = @_; my ( $cmd, @a ) = $self->_escaped_trans_data($trans); return wantarray ? @a : \@a; } sub Escaped_results { my ( $self, $trans ) = @_; my @a = $self->_escaped_trans_data($trans); return wantarray ? @a : \@a; } sub Escape { my $data = $_[1]; $data =~ s/([\\\"])/\\$1/og; return $data; } sub Unescape { my $data = $_[1]; $data =~ s/\\([\\\"])/$1/og; return $data; } sub logout { my $self = shift; my $rc = $self->_imap_command( "LOGOUT", "BYE" ); $self->_disconnect; return $rc; } sub _disconnect { my $self = shift; delete $self->{CAPABILITY}; delete $self->{_IMAP4REV1}; $self->State(Unconnected); if ( my $sock = delete $self->{Socket} ) { local ($@); eval { $sock->close }; } return $self; } # LIST/XLIST/LSUB Response # Contents: name attributes, hierarchy delimiter, name # Example: * LIST (\Noselect) "/" ~/Mail/foo # NOTE: liberal matching as folder name data may be Escape()d 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; } sub exists { my ( $self, $folder ) = @_; $self->status($folder) ? $self : undef; } # Updated to handle embedded literal strings sub get_bodystructure { my ( $self, $msg ) = @_; my $class = $self->_load_module("BodyStructure") or return undef; my $out = $self->fetch( $msg, "BODYSTRUCTURE" ) or return undef; my $bs = ""; my $output = first { /BODYSTRUCTURE\s+\(/i } @$out; unless ( $output =~ /$CRLF$/o ) { $output = ''; $self->_debug("get_bodystructure: reassembling original response"); my $started = 0; foreach my $o ( $self->_transaction ) { next unless $self->_is_output_or_literal($o); $started++ if $o->[DATA] =~ /BODYSTRUCTURE \(/i; $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"); } { local ($@); $bs = eval { $class->new($output) }; } $self->_debug( "get_bodystructure: msg $msg returns: " . ( $bs || "UNDEF" ) ); $bs; } # Updated to handle embedded literal strings sub get_envelope { my ( $self, $msg ) = @_; # Envelope class is defined within BodyStructure my $class = $self->_load_module("BodyStructure") or return undef; $class .= "::Envelope"; my $out = $self->fetch( $msg, 'ENVELOPE' ) or return undef; my $bs = ""; my $output = first { /ENVELOPE \(/i } @$out; unless ( $output =~ /$CRLF$/o ) { $output = ''; $self->_debug("get_envelope: reassembling original response"); my $started = 0; foreach my $o ( $self->_transaction ) { next unless $self->_is_output_or_literal($o); $started++ if $o->[DATA] =~ /ENVELOPE \(/i; $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_envelope: reassembled output=$output"); } { local ($@); $bs = eval { $class->new($output) }; } $self->_debug( "get_envelope: msg $msg returns: " . ( $bs || "UNDEF" ) ); $bs; } # fetch( [{option},] [$seq_set|ALL], @msg_data_items ) # options: # escaped => 0|1 # return Results or Escaped_results sub fetch { my $self = shift; my $opt = ref( $_[0] ) eq "HASH" ? 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 = $opt->{escaped} ? $self->Escaped_results : $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] ) # - TODO: make more efficient use of memory on large fetch results 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 ( defined $words[0] ) { if ( ref $words[0] ) { $msgs = shift @words; } else { if ( $words[0] eq 'ALL' ) { $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 = ( @words > 1 or $words[0] =~ /\s/ ) ? "(@words)" : "@words"; # RFC 3501: # fetch = "FETCH" SP sequence-set SP ("ALL" / "FULL" / "FAST" / # fetch-att / "(" fetch-att *(SP fetch-att) ")") my $output = $self->fetch( $msgs, $what ) or return undef; my $asked_for_uid = $what =~ /[\s(]UID[)\s]/i; while ( my $l = shift @$output ) { next if $l !~ m/^\*\s(\d+)\sFETCH\s\(/g; my ( $mid, $entry ) = ( $1, {} ); my ( $key, $value ); ATTR: while ( $l and $l !~ m/\G\s*\)\s*$/gc ) { if ( $l =~ m/\G\s*([^\s\[]+(?:\[[^\]]*\])?(?:<[^>]*>)?)\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("((?>(?:(?>[^"\\]+)|\\.)*))"\s*|[()]|[^()"]+)/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; } # consume literal data if any if ( $l =~ m/\G\s*$/gc and scalar(@$output) ) { my $elit = $self->Escape( shift @$output ); $l = shift @$output; $value .= ( length($value) ? " " : "" ) . qq{"$elit"}; } } $l =~ m/\G\s*/gc; } else { $self->LastError("Invalid item value in FETCH response: $l"); return undef; } } # NOTE: old code tried to remove any "unrequested" data in $entry # - UID is sometimes not explicitly requested, are there others? if ( $self->Uid ) { $uids->{ $entry->{UID} } = $entry; delete $entry->{UID} unless $asked_for_uid; } else { $uids->{$mid} = $entry; } } return wantarray ? %$uids : $uids; } sub store { my ( $self, @a ) = @_; $self->_imap_uid_command( STORE => @a ) or return undef; return wantarray ? $self->History : $self->Results; } sub _imap_folder_command($$@) { my ( $self, $command ) = ( shift, shift ); my $folder = $self->Quote(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; $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"); unless ( $self->Uid ) { $self->LastError("Uid must be enabled for uidexpunge"); return undef; } my $msg = UNIVERSAL::isa( $msgspec, 'Mail::IMAPClient::MessageSet' ) ? $msgspec : $self->Range($msgspec); $msg->cat(@_) if @_; my ( @data, $cmd ); my ($seq_set) = $self->_split_sequence( $msg, "UID EXPUNGE" ); for ( my $x = 0 ; $x <= $#$seq_set ; $x++ ) { my $seq = $seq_set->[$x]; $self->_imap_uid_command( "EXPUNGE" => $seq ) 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+.*?EXPUNGE\s+)\S+(\s*)/$1$msg$2/; unshift( @data, $cmd ); } #wantarray ? $self->History : $self->Results; return wantarray ? @data : \@data; } sub rename { my ( $self, $from, $to ) = @_; $from = $self->Quote($from); $to = $self->Quote($to); $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->Quote($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 my $ref = $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 (@$ref) { $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 $cmd = shift @$raw; 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; # BUG: parsing this way is prone to be buggy but works most of the time # 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 ) { # Windows2003/Maillennium/others? have UID after headers 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+).*\)$/ ) { $headers{$1} = $h; # found UID win2003/Maillennium 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->Quote( shift @what ) . " " . $self->Quote( shift @what ); $or = "OR $or " . $self->Quote($_) 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($v) } ) { 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->Quote( $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 ( defined($thread_parser) and $thread_parser == 0 ); my $class = $self->_load_module("Thread"); unless ($class) { $thread_parser = 0; return undef; } $thread_parser = $class->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; } sub uidvalidity { my ( $self, $folder ) = @_; $self->status( $folder, "UIDVALIDITY" ) or return undef; my $line = first { /UIDVALIDITY/i } $self->History; defined $line && $line =~ /\(UIDVALIDITY\s+([^\)]+)/ ? $1 : undef; } sub uidnext { my ( $self, $folder ) = @_; $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 $hist = join '', $self->History; return $hist =~ /\bINTERNALDATE "([^"]*)"/i ? $1 : undef; } sub is_parent { my ( $self, $folder ) = @_; 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}; $self->_debug("unexpected attrs data: @$list\n") if $attrs; $attrs = $rec->{attrs}; } if ($attrs) { return undef if grep { /\A\\NoInferiors\Z/i } @$attrs; return 1 if grep { /\A\\HasChildren\Z/i } @$attrs; return 0 if grep { /\A\\HasNoChildren\Z/i } @$attrs; } 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 ) or return undef; return not( grep /[\s(]\\Noselect[)\s]/i, @$info ); } # append( $self, $folder, $text [, $optmsg] ) # - conserve memory and use $_[0] to avoid copying $text (it may be huge!) # - BUG?: should deprecate this method in favor of append_string sub append { my $self = shift; my $folder = shift; # $message_string is whatever is left in @_ $self->append_string( $folder, ( @_ > 1 ? join( $CRLF, @_ ) : $_[0] ) ); } sub _clean_flags { my ( $self, $flags ) = @_; $flags =~ s/^\s+//; $flags =~ s/\s+$//; $flags = "($flags)" if $flags !~ /^\(.*\)$/; return $flags; } # RFC 3501: date-day-fixed = (SP DIGIT) / 2DIGIT sub _clean_date { my ( $self, $date ) = @_; $date =~ s/^\s+// if $date !~ /^\s\d/; $date =~ s/\s+$//; $date = qq("$date") if $date !~ /^"/; return $date; } sub _append_command { my ( $self, $folder, $flags, $date, $length ) = @_; return join( " ", "APPEND $folder", ( $flags ? $flags : () ), ( $date ? $date : () ), "{" . $length . "}", ); } # append_string( $self, $folder, $text, $flags, $date ) # - conserve memory and use $_[2] to avoid copying $text (it may be huge!) sub append_string($$$;$$) { my ( $self, $folder, $flags, $date ) = @_[ 0, 1, 3, 4 ]; #my $text = $_[2]; # conserve memory and use $_[2] instead! my $maxl = $self->Maxappendstringlength; # on "large" strings use append_file to conserve memory if ( $_[2] and $maxl and length( $_[2] ) > $maxl ) { $self->_debug("append_string: using in memory file"); return $self->append_file( $folder, \( $_[2] ), undef, $flags, $date ); } my $text = defined( $_[2] ) ? $_[2] : ''; $folder = $self->Quote($folder); $flags = $self->_clean_flags($flags) if ( defined $flags ); $date = $self->_clean_date($date) if ( defined $date ); $text =~ s/\r?\n/$CRLF/og; my $cmd = $self->_append_command( $folder, $flags, $date, length($text) ); $cmd .= $CRLF . $text . $CRLF; $self->_imap_command( { addcrlf => 0 }, $cmd ) 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; } # BUG?: not much/any savings on cygwin perl 5.10 when using in memory file # BUG?: we do not retry if sending data fails after getting the OK to send sub append_file { my ( $self, $folder, $file, $control, $flags, $date ) = @_; 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) and ref($file) ne "SCALAR" ) { $fh = $file; # let the caller pass in their own file handle directly } elsif ( !ref($file) and !-f $file ) { push( @err, "file '$file' not found" ); } else { # $file can be a name or a scalar reference (for in memory file) # avoid IO::File bug handling scalar refs in perl <= 5.8.8? # - buggy: $fh = IO::File->new( $file, 'r' ) local ($!); open( $fh, "<", $file ) or push( @err, "Unable to open file '$file': $!" ); } if (@err) { $self->LastError( join( ", ", @err ) ); return undef; } binmode($fh); $folder = $self->Quote($folder) if ( defined $folder ); $flags = $self->_clean_flags($flags) if ( defined $flags ); # allow the date to be specified or even use mtime on file if ($date) { $date = $self->Rfc3501_datetime( ( stat($fh) )[9] ) if ( $date eq "1" ); $date = $self->_clean_date($date); } # 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 $cmd = $self->_append_command( $folder, $flags, $date, $length ); my $rc = $self->_imap_command( $cmd, '+' ); unless ($rc) { $self->LastError( "Error sending '$cmd': " . $self->LastError ); return undef; } # Now send the message itself my ( $buffer, $buflen ) = ( "", 0 ); until ( !$buflen and eof($fh) ) { if ( $buflen < APPEND_BUFFER_SIZE ) { FILLBUFF: while ( my $line = <$fh> ) { $line =~ s/\r?\n$/$CRLF/; $buffer .= $line; $buflen = length($buffer); last FILLBUFF if ( $buflen >= APPEND_BUFFER_SIZE ); } } # exit loop entirely if we are out of data last unless $buflen; # save anything over desired buffer size for next iteration my $savebuff = ( $buflen > APPEND_BUFFER_SIZE ) ? substr( $buffer, APPEND_BUFFER_SIZE ) : undef; # reduce buffer to desired size $buffer = substr( $buffer, 0, APPEND_BUFFER_SIZE ); my $bytes_written = $self->_send_bytes( \$buffer ); unless ($bytes_written) { $self->LastError( "Error appending message: " . $self->LastError ); return undef; } # retain any saved data and continue loop $buffer = defined($savebuff) ? $savebuff : ""; $buflen = length($buffer); } # 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( $self->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; } } # BUG? use _load_module for these too? 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( # [authname] user password join( chr(0), defined $client->Proxy ? ( $client->User, $client->Proxy ) : ( "", $client->User ), defined $client->Password ? $client->Password : "", ), '' ); }; } elsif ( $scheme eq 'NTLM' ) { $response ||= sub { my ( $code, $client ) = @_; require Authen::NTLM; Authen::NTLM::ntlm_user( $client->User ); Authen::NTLM::ntlm_password( $client->Password ); Authen::NTLM::ntlm_domain( $client->Domain ) if $client->Domain; Authen::NTLM::ntlm($code); }; } my $resp = $response->( $code, $self ); unless ( defined($resp) ) { $self->LastError( "Error getting $scheme data: " . $self->LastError ); return undef; } unless ( $self->_send_line($resp) ) { $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 ) = @_; my $msgs = $self->Ranges ? $self->Range(@msgs) : join ',', map { ref $_ ? @$_ : $_ } @msgs; $self->_imap_uid_command( COPY => $msgs, $self->Quote($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 = defined $what ? $self->Quote($what) : "INBOX"; return $self->_imap_command("GETQUOTAROOT $who") ? $self->Results : undef; } # BUG? using user/$User here and INBOX in quota/quota_usage sub getquota { my ( $self, $what ) = @_; my $who = defined $what ? $self->Quote($what) : "user/" . $self->User; return $self->_imap_command("GETQUOTA $who") ? $self->Results : undef; } # usage: $self->setquota($quotaroot, storage => 512, ...) sub setquota(@) { my ( $self, $what ) = ( shift, shift ); my $who = defined $what ? $self->Quote($what) : "user/" . $self->User; my @limits; while (@_) { my ( $k, $v ) = ( $self->Quote( uc( shift @_ ) ), shift @_ ); push( @limits, "($k $v)" ); } my $limits = join( ' ', @limits ); $self->_imap_command("SETQUOTA $who $limits") ? $self->Results : undef; } sub quota { my ( $self, $what ) = ( shift, shift || "INBOX" ); my $tref = $self->getquota($what) or return undef; shift @$tref; # pop off command return ( map { /.*STORAGE\s+\d+\s+(\d+).*\n$/ ? $1 : () } @$tref )[0]; } sub quota_usage { my ( $self, $what ) = ( shift, shift || "INBOX" ); my $tref = $self->getquota($what) or return undef; shift @$tref; # pop off command return ( map { /.*STORAGE\s+(\d+)\s+\d+.*\n$/ ? $1 : () } @$tref )[0]; } # rfc3501: # atom-specials = "(" / ")" / "{" / SP / CTL / list-wildcards / # quoted-specials / resp-specials # list-wildcards = "%" / "*" # quoted-specials = DQUOTE / "\" # resp-specials = "]" # rfc2060: # CTL ::= # Paranoia/safety: # encode strings with "}" / "[" / "]" / non-ascii chars sub Quote($;$) { my ( $self, $name, $force ) = @_; if ( $force or $name =~ /["\\[:^ascii:][:cntrl:]]/s ) { return "{" . length($name) . "}" . $CRLF . $name; } elsif ( $name =~ /[(){}\s%*\[\]]/s or $name eq "" ) { return qq("$name"); } else { return $name; } } # legacy behavior: strip double quote around folder name args! sub Massage($;$) { my ( $self, $name, $notFolder ) = @_; $name =~ s/^\"(.*)\"$/$1/s unless $notFolder; return $self->Quote($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 State($) { my ( $self, $state ) = @_; if ( defined $state ) { $self->{State} = $state; # discard cached capability info after authentication delete $self->{CAPABILITY} if ( $state == Authenticated ); } return defined( $self->{State} ) ? $self->{State} : Unconnected; } 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; Mail-IMAPClient-3.38/lib/Mail/IMAPClient.pod0000644000175000017500000042276712642551104017607 0ustar ppearlppearl=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 allows the optional use of the L parameter. RFC 4616 documents this syntax for SASL PLAIN: message = [authzid] UTF8NUL authcid UTF8NUL passwd When L is defined, L is used as 'authzid' and L is used as 'authcid'. Otherwise, L is used as 'authcid'. =item NTLM NTLM authentication requires the L module. See also L. =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. WARNING: (due to historical API behavior) on errors, many methods may return undef regardless of LIST/SCALAR context. Therefore, it may be wise to use most methods in a scalar context. Regardless, check L for details on errors. =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-quote the value 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 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_or_true = $imap->append( $folder, $msgtext ) or die "Could not append: ", $imap->LastError; WARNING: This method may be deprecated in the future, consider using L instead of this method. The B method adds a message to the specified folder. See L for details as it is effectively an alias for that method. DEPRECATED BEHAVIOR: Additional arguments are added to the message text, separated with . =head2 append_string Example: # brackets indicate optional arguments (not array refs): my $uidort = $imap->append_string( $folder, $msgtext [,$flags [,$date ] ] ) or die "Could not append_string: ", $imap->LastError; Arguments: =over 4 =item $folder the name of the folder to append the message to =item $msgtext the message text (including headers) of the message =item $flags An optional list of flags to set. The list must be specified as a space-separated list of flags, including any backslashes that may be necessary and optionally enclosed by parenthesis. =item $date An optional RFC3501 date argument 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 ($flags) argument. =back Returns: =over 4 =item error: undef On error, undef can be returned regardless of LIST/SCALAR context. Check L for details. =item success: UID or $imap With UIDPLUS the UID of the new message is returned otherwise a true value (currently $self) is returned. =back To protect against "bare newlines", B will insert a carriage return before any newline that is "bare". =head2 append_file Example: my $new_msg_uid = $imap->append_file( $folder, $file, [ undef, $flags, $date ] # optional ) or die "Could not append_file: ", $imap->LastError; The B method adds a message to the specified folder. Note: The brackets in the example indicate optional arguments; they do not mean that the argument should be an array reference. Arguments: =over 4 =item $folder the name of the folder to append the message to =item $file a filename, filehandle or SCALAR reference which holds an RFC822-formatted message =item undef a deprecated argument used as a place holder for backwards compatibility =item $flags The optional argument is handled the same as append_string. =item $date The optional argument is handled the same as append_string (RFC3501 date), with the exception that if $date is "1" (one) then the modification time (mtime) of the file will be used. =back Returns: =over 4 =item error: undef On error, undef can be returned regardless of LIST/SCALAR context. Check L for details. =item success: UID or $imap With UIDPLUS the UID of the new message is returned otherwise a true value (currently $self) is returned. =back To protect against "bare newlines", B will insert a carriage return before any newline that is "bare". The B method provides a mechanism for allowing large messages to be appended without holding the whole file in memory. Version note: In 2.x an optional third argument to use for C was allowed, however this argument is ignored/not supported as of 3.x. =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. Supported capabilities are cached by the client, however, this cache is deleted after a connection is set to I and when L is called. See also L. =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 compress Example: $imap->compress or die "Could not enable RFC4978 compression: $@\n"; The B method accepts no arguments. This method is used to instruct the server to use the DEFLATE (RFC1951) compression extension. See the L attribute for how to specify arguments for use during the initialization process. Version note: method added in Mail::IMAPClient 3.30 =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 deleteacl Example: $imap->deleteacl( $folder, $userid ) or die "Could not delete acl: $@\n"; The B method accepts two input arguments, a folder name, a user id (or authentication identifier, to use the terminology of RFC2086). See RFC2086 for more information. (This is somewhat experimental and its implementation may change.) =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 logout: $@\n"; This method calls L, see L for details. =head2 done Example: my $tag = $imap->idle or warn "idle failed: $@\n"; doSomethingA(); my $idlemsgs = $imap->idle_data() or warn "idle_data error: $@\n"; doSomethingB(); my $results = $imap->done($tag) or warn "Error from done: $@\n"; The B method tells the IMAP server to terminate the IDLE command. The only argument is the I (identifier) received from the previous call to L. If I is not specified a default I based on the B attribute is assumed to be the I to look for in the response from the server. If an invalid I is specified, or the default I is wrong, then B will hang indefinitely or until a timeout occurs. If B is called when an L command is not active then the server will likely respond with an error like I<* BAD Invalid tag>. On failure is returned and L is set. See also L, L and L. =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] ) Examples: my $hashref = $imap->fetch_hash("RFC822.SIZE"); OR my $hashref = {}; $imap->fetch_hash( "RFC822.SIZE", $hashref ); print "Msg #$_ is $hashref->{$_}->{'RFC822.SIZE'} bytes\n" for (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 tasks like obtaining the size of every message in a folder. It issues one command and receives one (possibly long!) response from the server. If the fetch request causes the server to return data in a parenthesized list, the data within the parenthesized list may be escaped via the Escape() method. Use the Unescape() method to get the raw values back in this case. =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 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 method 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 Please note that documentation previously suggested 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). However, this does not match the behavior of the existing implementation, so you will need to manually exclude the parent folder from the results. =head2 folders_hash my @fhashes = $imap->folders_hash or die "Could not get list of folder hashes.\n"; The B method 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. An array(ref) of hashes is returned that contain information about the requested folders. Each hash contains three keys (name, attrs, delim) and looks like the following: { name => 'Mail/Box/Name', attrs => [ '\Marked', '\HasNoChildren' ], delim => '/', } IMAP servers implementing RFC6154 return attributes to be used to identify special-use mailboxes (folders). my $sattr_re = /\A\\(?:All|Archive|Drafts|Flagged|Junk|Sent|Trash)\Z/; foreach my $fhash (@fhashes) { next unless defined $fhash->{name}; my @special = grep { $sattr_re } @{ $fhash->{attrs} }; print("special: $fhash->{name} : @special\n") if (@special); } Version note: method added in Mail::IMAPClient 3.34 =head2 xlist_folders (DEPRECATED) This method is deprecated as of version 3.34. Please use folders_hash instead. See RFC6154 for attributes to be used to identify special-use mailboxes (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. Version note: method added in Mail::IMAPClient 3.21 =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 $tag = $imap->idle or warn "idle failed: $@\n"; doSomethingA(); my $idlemsgs = $imap->idle_data() or warn "idle_data error: $@\n"; doSomethingB(); my $results = $imap->done($tag) or warn "Error from done: $@\n"; The B method tells the IMAP server the client is ready to accept unsolicited mailbox update messages (on the selected folder/mailbox). This method is only valid on servers that support the IMAP IDLE extension, see RFC2177 for details. The B method accepts no arguments and returns the I (identifier) that was sent by the client for this command. This tag should be supplied as the argument to L when ending the IDLE command. On failure is returned and L is set. The method L may be used once B has been successful. However, no mailbox operations may be called until the B command has been terminated by calling L. Failure to do so will result in an error and the idle command will typically be terminated by the server. See also L and L. =head2 idle_data Usage: # an optional timeout in seconds may be specified $imap->idle_data( [$timeout] ) Example: my $tag = $imap->idle or warn "idle failed: $@\n"; doSomethingA(); my $idlemsgs = $imap->idle_data() or warn "idle_data error: $@\n"; doSomethingB(); my $results = $imap->done($tag) or warn "Error from done: $@\n"; The B method can be used to accept any unsolicited mailbox update messages that have been sent by the server during an L command. This method does not send any commands to the server, it simply looks for and optionally waits for data from the server and returns that data to the caller. The B method accepts an optional $timeout argument and returns an array (or an array reference if called in scalar context) with the messages from the server. By default a timeout of 0 seconds is used (do not block). Internally the timeout is passed to L. The timeout controls how long the select call blocks if there are no messages waiting to be read from the server. On failure is returned and L is set. See also L and L. Version note: method added in Mail::IMAPClient 3.23 Warning: this method is considered experimental and the interface/output may change in a future version. =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 or undef if the call fails or internal date is not returned. =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 documentation. (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 getquotaroot Example: my $results = $imap->getquotaroot($mailboxname) or die "Could not getquotaroot for $mailboxname: $@\n"; The B method implements the RFC2087 GETQUOTAROOT command. The "$mailboxname" defaults to "INBOX" if no argument is provided. On error C is returned, otherwise L are returned. The results should have the untagged QUOTAROOT response from the server along with the QUOTAROOT's resource usage and limits in an untagged QUOTA response. See also B, L, L, L and L. =head2 getquota Example: my $results = $imap->getquota($quotaroot) or die "Could not getquota for $quotaroot: $@\n"; The B method implements the RFC2087 GETQUOTA command. The "$quotaroot" defaults to "user/I" if no argument is provided. On error C is returned, otherwise L are returned. The results from the server should have the untagged QUOTA response from the server. See also B, L, L and L. =head2 quota Example: my $limit = $imap->quota($quotaroot) or die "Could not get quota limit for $quotaroot: $@\n"; The B method takes the L from L and parses out the "STORAGE" limit returned by the server. The "$quotaroot" defaults to "INBOX" if no argument is provided. On error C is returned, otherwise the integer "STORAGE" limit provided by the server is returned. See also B, L, L and L. =head2 quota_usage Example: my $usage = $imap->quota_usage($quotaroot) or die "Could not get quota usage for $quotaroot: $@\n"; The B method takes the L from L and parses out the "STORAGE" usage returned by the server. The "$quotaroot" defaults to "INBOX" if no argument is provided. On error C is returned, otherwise the integer "STORAGE" usage provided by the server is returned. See also B, L, L and L. =head2 setquota Example: my $results = $imap->setquota( $quotaroot, $resource, $limit ) or die "Could not setquota for $quotaroot: $@\n"; The B method implements the RFC2087 SETQUOTA command. It accepts multiple pairs of $resource and $limit arguments. The "$quotaroot" defaults to "user/I" if not defined. On error C is returned, otherwise L are returned. See also B, L and L. =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: =over 4 =item C<1> (or a positive integer) The C<\HasChildren> attribute is set, indicating that the folder has children. =item C<0> (zero) The C<\HasNoChildren> attribute is set, indicating that the folder has no children at this time. =item C The C<\NoInferiors> attribute is set, indicating the folder is not permitted to have children. =back 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. If the L parameter is set, the L method will automatically be called after successful authentication. 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 command. 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. Note that RFC2683 section 3.1.2 (Severed connections) makes some recommendations on how IMAP clients should behave. It is up to the user of this module to decide on the preferred behavior and code accordingly. Version note: documentation (from 2.x through 3.23) claimed that Mail::IMAPClient would attempt to log out of the server during B if the object is in the L state. This documentation was apparently incorrect from at least 2.2.2 and possibly earlier versions on up. =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)); WARNING: This method may be deprecated in the future, consider using L instead of this method. 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. WARNING: If the first argument has double quotes at the beginning and end of its value, those double quote will be stripped unless the second argument does not evaluate to true. 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. =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_src->migrate( $imap_dest, "ALL", $targetFolder ) or die "Could not migrate: ", $imap_src->LastError; The B method copies the indicated message(s) 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 name of the destination folder on the target mailbox to receive the message(s). If this argument is not supplied or is I then the currently selected folder on the calling object will be used. The destination folder will be automatically created if necessary. =back The target ($imap_dest) Mail::IMAPClient object must not be the same object as the source ($imap_src). This method does not attempt to minimize memory usage. In the future it could be enhanced to (optionally) write message data to a temporary file to avoid storing the entire message in memory. To work around potential network timeouts on large messages, consider setting L to 1 on both $imap_src and $imap_dest. 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) a message sequence number, =item b) a comma-separated list of message sequence numbers, or =item c) 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) a message UID, =item b) a comma-separated list of message UID's, or =item c) 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 which should correspond to the order of the message UID provided by the caller. 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. Version note: method added in Mail::IMAPClient 3.17 =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($number); The I parameter specifies the number of times a read or write operation is allowed to fail on a "Resource Temporarily Available" (e.g. EAGAIN) error. The default setting is I which means there is no limit. Setting this parameter to the string "unlimited" (instead of undef) to ignore "Resource Temporarily Unavailable" errors is deprecated. B: This setting should be used with caution and may be removed in a future release. Setting this can cause methods to return to the caller before data is received (and then handled) properly thereby possibly then leaving the module in a bad state. In the future, this behavior may be changed in an attempt to avoid this situation. =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. A default value of 993 (if L is true) or 143 is set during a call to L if no value is provided by the caller. This argument 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 Readmoremethod B should contain a reference to a subroutine that will replace/enhance the behavior of the internal _read_more() method. The subroutine will be passed the following arguments: first the used Mail::IMAPClient object. Second, a reference to a socket. Third, a timeout value which is used as the timeout value for CORE::select() by default. Depending upon changes/features introduced by Readmethod changes may be required here. Version note: attribute added in Mail::IMAPClient 3.30 =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 Starttls If an IMAP connection must start TLS/SSL after connecting to a server then set this attribute. If the value is set to an arrayref then they will be used as arguments to IO::Socket::SSL->start_SSL. By default this connection is set to blocking while establishing the connection with a timeout of 30 seconds. The socket will be reset to the original blocking/non-blocking value after a successful TLS negotiation has occurred. The arguments used in the call to start_SSL can be controlled by setting this attribute to an ARRAY reference containing the desired arguments. Version note: attribute added in Mail::IMAPClient 3.22 =head2 Socketargs The arguments used in the call to IO::Socket::{UNIX|INET|SSL}->new can be controlled by setting this attribute to an ARRAY reference containing the desired arguments. For example, to always pass MultiHomed => 1 to IO::Socket::...->new the following can be used: $imap = Mail::IMAPClient->new( ..., Socketargs => [ MultiHomed => 1 ], ... ); See also L for specific control of the args to IO::Socket::SSL. Version note: attribute added in Mail::IMAPClient 3.34 =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. The arguments used in the call to IO::Socket::SSL->new can be controlled by setting this attribute to an ARRAY reference containing the desired arguments. See also L for details on connection initiation 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_history Example: my @history = $imap->Escaped_history; 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 double quotes, backslashes 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 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 double quotes, backslashes 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 Custom Authentication Mechanisms If you just want to use plain text authentication or any of the supported L then there is no need to read this section. There are 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. There are I authentication mechanisms out there, 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 and need full control. 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. If L is set, then the L method will be called by L. 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 =head1 REPORTING BUGS Please send bug reports to C or http://rt.cpan.org/Public/Dist/Display.html?Name=Mail-IMAPClient =head1 COPYRIGHT AND LICENSE Copyright (C) 1999-2003 The Kernen Group, Inc. Copyright (C) 2007-2009 Mark Overmeer Copyright (C) 2010-2016 Phil Pearl (Lobbes) All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.0 or, at your option, any later version of Perl 5 you may have available. 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. Mail-IMAPClient-3.38/META.json0000664000175000017500000000251412656252125015177 0ustar ppearlppearl{ "abstract" : "IMAP4 client library", "author" : [ "Phil Pearl (Lobbes) " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.120921", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Mail-IMAPClient", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "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", "perl" : "5.008" } } }, "release_status" : "stable", "resources" : { "homepage" : "http://sourceforge.net/projects/mail-imapclient/" }, "version" : "3.38" } Mail-IMAPClient-3.38/examples/0000755000175000017500000000000012656252125015370 5ustar ppearlppearlMail-IMAPClient-3.38/examples/sharedFolder.pl0000755000175000017500000000430712535524202020330 0ustar ppearlppearl#!/usr/local/bin/perl #$Id$ 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 # # Mail-IMAPClient-3.38/examples/cyrus_expire.pl0000755000175000017500000000657712535524202020462 0ustar ppearlppearl#!/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 # Mail-IMAPClient-3.38/examples/imtestExample.pl0000755000175000017500000001314512535524202020547 0ustar ppearlppearl#!/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 Mail-IMAPClient-3.38/examples/migrate_mbox.pl0000755000175000017500000000604012535524202020377 0ustar ppearlppearl#!/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$ # 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 # # Mail-IMAPClient-3.38/examples/imap_to_mbox.pl0000755000175000017500000001600612535524202020402 0ustar ppearlppearl#!/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$ # 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 Mail-IMAPClient-3.38/examples/migrate_mail2.pl0000755000175000017500000002566212535524202020451 0ustar ppearlppearl#!/usr/local/bin/perl #$Id$ # # 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 # Mail-IMAPClient-3.38/examples/find_dup_msgs.pl0000755000175000017500000001405212535524202020545 0ustar ppearlppearl#!/usr/local/bin/perl # $Id$ 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 # Mail-IMAPClient-3.38/examples/populate_mailbox.pl0000755000175000017500000002161712535524202021275 0ustar ppearlppearl#!/usr/local/bin/perl #$Id$ # 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$ # $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 # Mail-IMAPClient-3.38/examples/copy_folder.pl0000755000175000017500000000773512535524202020243 0ustar ppearlppearl#!/usr/local/bin/perl #$Id$ ++$|; 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 # Mail-IMAPClient-3.38/examples/idle.pl0000755000175000017500000001500412563153330016640 0ustar ppearlppearl#!/usr/bin/perl =head1 NAME idle.pl - example using IMAP idle =head1 SYNOPSIS idle.pl [options] Options: [*] == Required, [+] == Multiple vals OK, (val) == Default --o Server= *IMAP server name/IP --o User= *User account to login to --o Password= *Password to use for the User account (see security note below) --o Port= port on Server to connect to --o Ssl= use SSL on this connection --o Starttls= call STARTTLS on this connection --o Debug= enable debugging in Mail::IMAPClient --o ImapclientKey=Val any other Mail::IMAPClient attribute/value pair --folder folder (mailbox) to IMAP SELECT (INBOX) --maxidle maximum time to idle without receiving data (300) --help display a brief help message --man display the entire man page --debug enable script debugging =head1 NOTES =head2 --o Password= A password specified as a command-line option may be visible to other users via the system process table. It may alternately be given in the PASSWORD environment variable. =head2 --maxidle RFC 2177 states, "The server MAY consider a client inactive if it has an IDLE command running, and if such a server has an inactivity timeout it MAY log the client off implicitly at the end of its timeout period. Because of that, clients using IDLE are advised to terminate the IDLE and re-issue it at least every 29 minutes to avoid being logged off." The default of --maxidle 300 is used to allow the client to notice when a connection has silently been closed upstream due to network or firewall issue or configuration without missing too many idle events. =cut use strict; use warnings; use File::Basename qw(basename); use Getopt::Long qw(GetOptions); use Mail::IMAPClient qw(); use Pod::Usage qw(pod2usage); use POSIX qw(); use constant { FOLDER => "INBOX", MAXIDLE => 300, }; $| = 1; # set autoflush my $DEBUG = 0; # GLOBAL set by process_options() my $QUIT = 0; my $VERSION = "1.00"; my $Prog = basename($0); ### # main program main(); sub main { my %Opt = process_options(); pout("started $Prog\n"); my $imap = Mail::IMAPClient->new( %{ $Opt{opt} } ) or die("$Prog: error: Mail::IMAPClient->new: $@\n"); my ( $folder, $chkseen, $tag ) = ( $Opt{folder}, 1, undef ); $imap->select($folder) or die("$Prog: error: select '$folder': $@\n"); $SIG{'INT'} = \&sigint_handler; until ($QUIT) { unless ( $imap->IsConnected ) { warn("$Prog: reconnecting due to error: $@\n") if $imap->LastError; $imap->connect or last; $imap->select($folder) or last; $tag = undef; } my $ret; if ($chkseen) { $chkseen = 0; # end idle if necessary if ($tag) { $tag = undef; $ret = $imap->done or last; } my $unseen = $imap->unseen_count; last if $@; pout("$unseen unseen/new message(s) in '$folder'\n") if $unseen; } # idle for X seconds unless data was returned by done unless ($ret) { $tag ||= $imap->idle or die("$Prog: error: idle: $@\n"); warn( "$Prog: DEBUG: ", _ts(), " do idle_data($Opt{maxidle})\n" ) if $DEBUG; $ret = $imap->idle_data( $Opt{maxidle} ) or last; # connection can go stale so we exit/re-enter of idle state # - RFC 2177 mentions 29m but firewalls may be more strict unless (@$ret) { warn( "$Prog: DEBUG: ", _ts(), " force exit of idle\n" ) if $DEBUG; $tag = undef; # restarted lost connections on next iteration $ret = $imap->done or next; } } local ( $1, $2, $3 ); foreach my $resp (@$ret) { $resp =~ s/\015?\012$//; warn("$Prog: DEBUG: server response: $resp\n") if $DEBUG; # ignore: # - DONE command # - OK IDLE... next if ( $resp eq "DONE" ); next if ( $resp =~ /^\w+\s+OK\s+IDLE\b/ ); if ( $resp =~ /^\*\s+(\d+)\s+(EXISTS)\b/ ) { my ( $num, $what ) = ( $1, $2 ); pout("$what: $num message(s) in '$folder'\n"); $chkseen++; } elsif ( $resp =~ /^\*\s+(\d+)\s+(EXPUNGE)\b/ ) { my ( $num, $what ) = ( $1, $2 ); pout("$what: message $num from '$folder'\n"); } # * 83 FETCH (FLAGS (\Seen)) elsif ( $resp =~ /^\*\s+(\d+)\s+(FETCH)\s+(.*)/ ) { my ( $num, $what, $info ) = ( $1, $2, $3 ); $chkseen++ if ( $info =~ /[\(|\s]\\Seen[\)|\s]/ ); pout("$what: message $num from '$folder': $info\n"); } else { pout("server response: $resp\n"); } } } my $rc = 0; if ($@) { if ($QUIT) { warn("$Prog: caught signal\n"); } else { $rc = 1; } warn("$Prog: imap error: $@\n") if ( !$QUIT || $DEBUG ); } exit($rc); } ### # supporting routines sub pout { print( _ts(), " ", @_ ); } sub process_options { my ( %Opt, @err ); GetOptions( \%Opt, "opt=s%", "debug:1", "help", "man", "folder=s", "maxidle:i" ) or pod2usage( -verbose => 0 ); pod2usage( -message => "$Prog: version $VERSION\n", -verbose => 1 ) if ( $Opt{help} ); pod2usage( -verbose => 2 ) if ( $Opt{man} ); # set global DEBUG $DEBUG = $Opt{debug} || 0; # folder (mailbox) to watch $Opt{folder} = FOLDER unless ( exists $Opt{folder} ); # restart idle when no idle_data seen for this long $Opt{maxidle} = MAXIDLE unless ( exists $Opt{maxidle} ); $Opt{opt}->{Password} = $ENV{PASSWORD} if ( !exists $Opt{opt}->{Password} && defined $ENV{PASSWORD} ); foreach my $arg (qw(Server User Password)) { push( @err, "-o $arg= is required" ) if !exists $Opt{opt}->{$arg}; } pod2usage( -verbose => 1, -message => join( "", map( "$Prog: $_\n", @err ) ) ) if (@err); return %Opt; } # example: 2005-10-02 07:50:32 sub _ts { my %opt = @_; my $fmt = $opt{fmt} || "%Y-%m-%d %T"; return POSIX::strftime( $fmt, localtime(time) ); } sub sigint_handler { $QUIT = 1; } Mail-IMAPClient-3.38/examples/cyrus_expunge.pl0000755000175000017500000000404312535524202020623 0ustar ppearlppearl#!/usr/local/bin/perl #$Id$ 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 # # Mail-IMAPClient-3.38/examples/cleanTest.pl0000755000175000017500000000362312535524202017650 0ustar ppearlppearl#!/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 Mail-IMAPClient-3.38/examples/build_ldif.pl0000755000175000017500000001367612535524202020034 0ustar ppearlppearl#!/usr/local/bin/perl #$Id$ 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$ # $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 # Mail-IMAPClient-3.38/examples/build_dist.pl0000755000175000017500000001012512535524202020043 0ustar ppearlppearl#!/usr/local/bin/perl #$Id$ 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$ # $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 #