From 5f67654c6fb206a496730ddcac9e3f09a4bf978a Mon Sep 17 00:00:00 2001 From: Nick Bebout Date: Sat, 12 Mar 2011 02:44:51 +0000 Subject: [PATCH] 1.310 --- CREDITS | 24 +- ChangeLog | 45 +- FAQ | 362 +- Mail-IMAPClient-3.23/COPYRIGHT | 401 + Mail-IMAPClient-3.23/Changes | 2031 ++ Mail-IMAPClient-3.23/INSTALL | 82 + Mail-IMAPClient-3.23/MANIFEST | 41 + Mail-IMAPClient-3.23/META.yml | 22 + Mail-IMAPClient-3.23/Makefile.PL | 145 + Mail-IMAPClient-3.23/README | 111 + Mail-IMAPClient-3.23/TODO | 68 + Mail-IMAPClient-3.23/examples/build_dist.pl | 172 + Mail-IMAPClient-3.23/examples/build_ldif.pl | 235 + Mail-IMAPClient-3.23/examples/cleanTest.pl | 64 + Mail-IMAPClient-3.23/examples/copy_folder.pl | 147 + Mail-IMAPClient-3.23/examples/cyrus_expire.pl | 111 + .../examples/cyrus_expunge.pl | 85 + .../examples/find_dup_msgs.pl | 217 + Mail-IMAPClient-3.23/examples/imap_to_mbox.pl | 266 + .../examples/imtestExample.pl | 226 + .../examples/migrate_mail2.pl | 326 + Mail-IMAPClient-3.23/examples/migrate_mbox.pl | 131 + .../examples/populate_mailbox.pl | 319 + Mail-IMAPClient-3.23/examples/sharedFolder.pl | 88 + Mail-IMAPClient-3.23/lib/Mail/IMAPClient.pm | 3421 ++++ Mail-IMAPClient-3.23/lib/Mail/IMAPClient.pod | 3707 ++++ .../lib/Mail/IMAPClient/BodyStructure.pm | 557 + .../IMAPClient/BodyStructure/Parse.grammar | 188 + .../Mail/IMAPClient/BodyStructure/Parse.pm | 16425 ++++++++++++++++ .../Mail/IMAPClient/BodyStructure/Parse.pod | 15 + .../lib/Mail/IMAPClient/MessageSet.pm | 280 + .../lib/Mail/IMAPClient/Thread.grammar | 18 + .../lib/Mail/IMAPClient/Thread.pm | 1014 + .../lib/Mail/IMAPClient/Thread.pod | 14 + Mail-IMAPClient-3.23/prepare_dist | 37 + Mail-IMAPClient-3.23/sample.perldb | 1 + Mail-IMAPClient-3.23/t/basic.t | 343 + Mail-IMAPClient-3.23/t/bodystructure.t | 58 + Mail-IMAPClient-3.23/t/fetch_hash.t | 233 + Mail-IMAPClient-3.23/t/messageset.t | 37 + Mail-IMAPClient-3.23/t/pod.t | 10 + Mail-IMAPClient-3.23/t/simple.t | 36 + Mail-IMAPClient-3.23/t/thread.t | 30 + Mail-IMAPClient-3.23/test_template.txt | 5 + Makefile | 6 +- README | 26 +- TODO | 7 +- VERSION | 2 +- bugs/BUG_IMAPClient_3.xx | 2 +- i3 | 2 +- imapsync | 336 +- patches/FAQ_ralph.patch | 529 + tests.sh | 95 +- 53 files changed, 32864 insertions(+), 289 deletions(-) create mode 100644 Mail-IMAPClient-3.23/COPYRIGHT create mode 100644 Mail-IMAPClient-3.23/Changes create mode 100644 Mail-IMAPClient-3.23/INSTALL create mode 100644 Mail-IMAPClient-3.23/MANIFEST create mode 100644 Mail-IMAPClient-3.23/META.yml create mode 100644 Mail-IMAPClient-3.23/Makefile.PL create mode 100644 Mail-IMAPClient-3.23/README create mode 100644 Mail-IMAPClient-3.23/TODO create mode 100644 Mail-IMAPClient-3.23/examples/build_dist.pl create mode 100644 Mail-IMAPClient-3.23/examples/build_ldif.pl create mode 100644 Mail-IMAPClient-3.23/examples/cleanTest.pl create mode 100644 Mail-IMAPClient-3.23/examples/copy_folder.pl create mode 100644 Mail-IMAPClient-3.23/examples/cyrus_expire.pl create mode 100644 Mail-IMAPClient-3.23/examples/cyrus_expunge.pl create mode 100644 Mail-IMAPClient-3.23/examples/find_dup_msgs.pl create mode 100644 Mail-IMAPClient-3.23/examples/imap_to_mbox.pl create mode 100644 Mail-IMAPClient-3.23/examples/imtestExample.pl create mode 100644 Mail-IMAPClient-3.23/examples/migrate_mail2.pl create mode 100644 Mail-IMAPClient-3.23/examples/migrate_mbox.pl create mode 100644 Mail-IMAPClient-3.23/examples/populate_mailbox.pl create mode 100644 Mail-IMAPClient-3.23/examples/sharedFolder.pl create mode 100644 Mail-IMAPClient-3.23/lib/Mail/IMAPClient.pm create mode 100644 Mail-IMAPClient-3.23/lib/Mail/IMAPClient.pod create mode 100644 Mail-IMAPClient-3.23/lib/Mail/IMAPClient/BodyStructure.pm create mode 100644 Mail-IMAPClient-3.23/lib/Mail/IMAPClient/BodyStructure/Parse.grammar create mode 100644 Mail-IMAPClient-3.23/lib/Mail/IMAPClient/BodyStructure/Parse.pm create mode 100644 Mail-IMAPClient-3.23/lib/Mail/IMAPClient/BodyStructure/Parse.pod create mode 100644 Mail-IMAPClient-3.23/lib/Mail/IMAPClient/MessageSet.pm create mode 100644 Mail-IMAPClient-3.23/lib/Mail/IMAPClient/Thread.grammar create mode 100644 Mail-IMAPClient-3.23/lib/Mail/IMAPClient/Thread.pm create mode 100644 Mail-IMAPClient-3.23/lib/Mail/IMAPClient/Thread.pod create mode 100644 Mail-IMAPClient-3.23/prepare_dist create mode 100644 Mail-IMAPClient-3.23/sample.perldb create mode 100644 Mail-IMAPClient-3.23/t/basic.t create mode 100644 Mail-IMAPClient-3.23/t/bodystructure.t create mode 100644 Mail-IMAPClient-3.23/t/fetch_hash.t create mode 100644 Mail-IMAPClient-3.23/t/messageset.t create mode 100644 Mail-IMAPClient-3.23/t/pod.t create mode 100644 Mail-IMAPClient-3.23/t/simple.t create mode 100644 Mail-IMAPClient-3.23/t/thread.t create mode 100644 Mail-IMAPClient-3.23/test_template.txt create mode 100644 patches/FAQ_ralph.patch diff --git a/CREDITS b/CREDITS index ad13b5c..92dd10f 100644 --- a/CREDITS +++ b/CREDITS @@ -1,5 +1,5 @@ #!/bin/cat -# $Id: CREDITS,v 1.128 2010/01/16 01:20:06 gilles Exp gilles $ +# $Id: CREDITS,v 1.129 2010/02/15 17:41:48 gilles Exp gilles $ If you want to make a donation to the author, Gilles LAMIRAL: @@ -19,6 +19,20 @@ to remove one. I thank very much all of these people. +Gary MacIsaac +Contributed by giving the books +32.00 "The Mathematical Theory of Communication" +34.61 "Beautiful Teams: Inspiring and Cautionary Tales from Veteran Team Leaders" +91.26 "Mathematics: A Human Endeavor (3rd Edition)" + +Benjamin Clayton +Contributed by giving the book +38.20 "Beautiful Data: The Stories Behind Elegant Data Solutions" + +Sandra Hallenbeck +Contributed by giving the book +40.09 "Feynman Lectures on Computation" + Robert Bauer Contributed by giving the book 31.50 "Programming Interactivity: A Designer's Guide to Processing, Arduino, and Openframeworks" by Joshua Noble @@ -776,6 +790,12 @@ Eric Yung Total amount of book prices : c \ +32.00+\ +34.61+\ +91.26+\ +38.20+\ +40.09+\ +\ 31.50+\ 25.60+\ 23.09+\ @@ -866,4 +886,4 @@ c \ 31.20+\ 40.00 = -2136.15 +2372.31 diff --git a/ChangeLog b/ChangeLog index fbf4aaf..ac27372 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,17 +1,54 @@ RCS file: RCS/imapsync,v Working file: imapsync -head: 1.303 +head: 1.310 branch: locks: strict - gilles: 1.303 + gilles: 1.310 access list: symbolic names: keyword substitution: kv -total revisions: 303; selected revisions: 303 +total revisions: 310; selected revisions: 310 description: ---------------------------- -revision 1.303 locked by: gilles; +revision 1.310 locked by: gilles; +date: 2010/02/26 01:24:59; author: gilles; state: Exp; lines: +10 -11 +Removed modules_VERSION() call (useless) +Replaced Phil regex with /e one. +---------------------------- +revision 1.309 +date: 2010/02/25 23:18:04; author: gilles; state: Exp; lines: +63 -65 +Better imap banner handling (first line read). +removed sub myconnect_v2() +Removed Mail::IMAPClient::Socket use. +Added sub RawSocket2() (RawSocket 3.23 failed as is, do not know why) +Added Mail::IMAPClient::Ignoresizeerrors for 2.2.9 +Honot --allowsizemismatch with 2.2.9 +---------------------------- +revision 1.308 +date: 2010/02/24 01:29:11; author: gilles; state: Exp; lines: +15 -9 +Fixed STARTTLS missing imap begin line. +---------------------------- +revision 1.307 +date: 2010/02/09 17:49:34; author: gilles; state: Exp; lines: +68 -9 +Added tests_imap2_folder_name() +'s/.*?(?:(\\(?:Answered|Flagged|Deleted|Seen|Recent|Draft)\s?)|$)/$1/g' check (good!) +---------------------------- +revision 1.306 +date: 2010/02/07 21:38:15; author: gilles; state: Exp; lines: +71 -6 +Added regression test about the "keep only" --regexflag example. +Added debug to understand all the regexflag transformations. +---------------------------- +revision 1.305 +date: 2010/01/20 22:26:03; author: gilles; state: Exp; lines: +14 -14 +Better output. +---------------------------- +revision 1.304 +date: 2010/01/20 22:10:24; author: gilles; state: Exp; lines: +32 -23 +Added statistic about messages deleted +Added statistic about average bandwith rate +---------------------------- +revision 1.303 date: 2010/01/20 04:12:52; author: gilles; state: Exp; lines: +13 -12 cosmetic changes. ---------------------------- diff --git a/FAQ b/FAQ index 6ae0a6a..980a1be 100644 --- a/FAQ +++ b/FAQ @@ -1,27 +1,33 @@ #!/bin/cat -# $Id: FAQ,v 1.59 2009/04/30 02:09:09 gilles Exp gilles $ +# $Id: FAQ,v 1.65 2010/02/26 01:07:01 gilles Exp gilles $ +------------------+ | FAQ for imapsync | +------------------+ ======================================================================= -Q. How to install impasync ? +Q. How to install imapsync? R. http://www.linux-france.org/prj/imapsync/INSTALL ======================================================================= -Q. How to configure impasync ? +Q. How to configure imapsync? R. http://www.linux-france.org/prj/imapsync/README ======================================================================= -Q. Can you give some configuration examples ? +Q. Can you give some configuration examples? R. http://www.linux-france.org/prj/imapsync/FAQ ======================================================================= -Q. How can I have support ? +Q. How can I have commercial support? + +R. Ask the imapsync author and expert: Gilles LAMIRAL +Rates per hour (2010) : 81 euros (111 USD) + +======================================================================= +Q. How can I have gratis support? R. Use the mailing-list @@ -46,7 +52,7 @@ post to this list if you want to stay private. Thank you for your participation. ======================================================================= -Q. Where I can read IMAP RFCs ? +Q. Where I can read up on the various IMAP RFCs? R. Here: @@ -67,12 +73,12 @@ http://www.faqs.org/rfcs/rfc4549.html ======================================================================= -Q. Where I can find old imapsync releases ? +Q. Where I can find old imapsync releases? R. ftp://www.linux-france.org/pub/prj/imapsync/ ======================================================================= -Q. How can I try imapsync with Mail::IMAPClient 3.xx perl library? +Q. How can I try imapsync with the new Mail::IMAPClient 3.xx perl library? R. - Download latest Mail::IMAPClient 3.xx at http://search.cpan.org/dist/Mail-IMAPClient/ @@ -82,9 +88,10 @@ R. - Download latest Mail::IMAPClient 3.xx at - Download latest imapsync at http://lamiral.info/~gilles/imapsync/imapsync - - run imapsync with perl and -I option tailing to use Mail-IMAPClient-3.xx - and add also option --allow3xx: - perl -I./Mail-IMAPClient-3.16/lib imapsync ... --allow3xx + - run imapsync with perl and -I option tailing to use the perl + module Mail-IMAPClient-3.xx. Example: + + perl -I./Mail-IMAPClient-3.23/lib imapsync ... ======================================================================= Q. imapsync does not work with Mail::IMAPClient 3.xx @@ -104,9 +111,9 @@ R. - Download Mail::IMAPClient 2.2.9 at ======================================================================= Q. I am interested in creating a local clone of the IMAP on a LAN -server for faster synchronisations, Email will always be delivered -to the remote server and so the synchronisation will be one way from -remote to local. How suited is ImapSync to continouous one-way +server for faster synchronisations, email will always be delivered +to the remote server and so the synchronisation will be one way - from +remote to local. How suited is imapsync for continuous one-way synchronisation of mailboxes? Is there a better solution? R. If messages are delivered remotely and you play locally with the @@ -130,17 +137,16 @@ R. This is the case with: - Mutt - Thunderbird -Eurora shows by default the time the imap server received the email. -I think it is quite a wrong behavior since the messages can -have travelled some time before the reception. +Eurora shows by default the time the imap server received the email. I +think it is quite a wrong behavior since the messages can have +travelled some time before the reception. -The sent time and date are given by the "Date:" header -and it is set most of the time by the MUA (Mail User Agent, -Mutt, Eudora, Thunderbird etc.). +The sent time and date are given by the "Date:" header and it is set +most of the time by the MUA (Mail User Agent, Mutt, Eudora, +Thunderbird etc.). -imapsync does not touch any header since the -header is used to identify the messages in -both parts. +imapsync does not touch any header since the header is used to +identify the messages in both parts. Solutions: a) Don't use buggy Eudora. @@ -148,6 +154,31 @@ b) Use the --syncinternaldates option and keep using Eudora :-) c) Use the script learn/adjust_time.pl to change the internal dates from the "Date:" header. +======================================================================= +Q. Couldn't create [INBOX.Ops/foo/bar]: NO Invalid mailbox name: +INBOX.Ops/foo/bar + +Example: +sep1=/ +sep2=. + +imapsync revert each separator automaticaly. + +a) All / character coming from host1 are converted to . (convert the separator) +b) All . character coming from host1 are converted to / (to avoid +intermediate unwanted folder creation). + +Sometimes the sep1 character is not valid on host2 (character "/" usualy) + +R. Try : + + --regextrans2 's,/,X,g' + +It'll convert / character to X +Choose X as you wish: _ or SEP or +any string (including the empty string). + + ======================================================================= Q. The option --subscribe does not seem to work @@ -156,12 +187,39 @@ R. Use it with --subscribed ======================================================================= Q. Does imapsync retain the \Answered and $Forwarded flags? -R. imapsync retains all flags except \Recent -(RFC 3501 says "This flag can not be altered by the client.") +R. It depends on the destination server. + +a) If the destination server honors the "PERMAENTFLAGS \*" +directive or no PERMAENTFLAGS at all then imapsync synchronises +all flags except the flag \Recent +(RFC 3501 says "This flag can not be altered by the client."). + +b) If the destination server honors the "PERMAENTFLAGS without the +special "\*" (meaning it accepts any flag) then imapsync synchronises +only the flags listed in PERMANENTFLAGS. Some imap servers have problems with flags not beginning with the backslash character \ +======================================================================= +Q. I need to keep only a defind list of flags, how can I do? +The destination imap server complains about bad flags (Exchange). + +R. For example if you want to keep only the following flags +\Seen \Answered \Flagged \Deleted \Draft +then use these magic --regexflag options (thanks to Phil): + + --regexflag 's/.*?(?:(\\(?:Answered|Flagged|Deleted|Seen|Draft)\s?)|$)/defined($1)?$1:q()/eg' + +Analysis is left to the reader. + +This one is longer and may be use with old perl (no /e regex extension): + --regexflag 's/(.*)/$1 jrdH8u/' \ + --regexflag 's/.*?(\\Seen|\\Answered|\\Flagged|\\Deleted|\\Draft|jrdH8u)/$1 /g' \ + --regexflag 's/(\\Seen|\\Answered|\\Flagged|\\Deleted|\\Draft|jrdH8u) (?!(\\Seen|\\Answered|\\Flagged|\\Deleted|\\Draft|jrdH8u)).*/$1 /g' \ + --regexflag 's/jrdH8u *//' + + ====================================================================== Q. imapsync fails with the following error: flags from : [\Seen NonJunk]["10-Aug-2006 13:00:30 -0400"] @@ -180,7 +238,7 @@ System flags are just flags defined by an RFC instead of by users. Conclusion, some imap server coders don't read the RFCs (so do I). ======================================================================= -Q. Flags are not well synchonized. Is it a bug ? +Q. Flags are not well synchonized. Is it a bug? R. It happens with some servers on the first sync. Also, it was a bug from revision 1.200 to revision 1.207 @@ -188,6 +246,7 @@ Also, it was a bug from revision 1.200 to revision 1.207 Solution: run imapsync a second time. imapsync synchronizes flags on each run unless option --fast is used. +======================================================================= Q. imapsync hangs taking up 99.8% cpu right after start, after printing imapd doesn't support MD5 auth. @@ -195,11 +254,11 @@ R. Try option --noauthmd5 ======================================================================= Q. Some passwords contain * and " characters. Login fails. -R. Use +R. Use a backslash to escape the characters: imapsync --password1 \"password\" -Ii works for the star * character, +It works for the star * character, I don't know if it works for the " character. ======================================================================= @@ -222,7 +281,7 @@ kern.maxdsiz="1024M" Q. With huge account (many messages) when it comes to reading the destination server it comes out this error: "To Folder [INBOX.foobar] Not connected" -What can I do ? +What can I do? R. May be spending too much time on the source server, the connection timed out on the destination server. @@ -231,7 +290,7 @@ Try options : ======================================================================= Q. imapsync failed with a "word too long" error from the imap server, - What can I do ? + What can I do? R. Use imapsync release 1.172 or at least 1.166 with options --split1 500 --split2 500 @@ -260,7 +319,7 @@ b) Use stunnel ======================================================================= -Q: How to have an imaps server ? +Q: How to have an imaps server? R. a) Install one @@ -273,46 +332,43 @@ c) or use stunnel on inetd imaps stream tcp nowait cyrus /usr/sbin/stunnel -s cyrus -p /etc/ssl/certs/imapd.pem -r localhost:imap2 ======================================================================= -Q: I'm trying to use imapsync on win32 for gmail, but it requires ssl, -or at least claims to. Imapsync appears to require io-socket-ssl, -which doesn't seem to be available on win32. Are there any other options? +Q: I'm trying to use imapsync on win32 for gmail, but it requires ssl, +or at least claims to. Imapsync appears to require io-socket-ssl, +which doesn't seem to be available on win32. Are there any other +options? R: (Q and R come as is from Bryce Walter) -I think I'm having success using cygwin perl instead of -ActiveState Perl. I wasn't able to get CPAN working and -building IO::Socket::SSL in ActiveState, but cygwin did -all right. I had to force the install of the Net::SSLeay -dependency, because it partially failed one test, but I think -it worked anyway. In order to get working in cygwin, I -installed the entire "perl" category, lynx, ncftp, and lftp -(specified as ftp program in cpan setup). I'm not sure if I -needed all those, or if cpan just kept asking because I didn't -have any installed at the time. Anyway, cpan worked, and -I installed all dependencies that imapsync complained -about until it started working. + +I think I'm having success using cygwin perl instead of ActiveState +Perl. I wasn't able to get CPAN working and building IO::Socket::SSL +in ActiveState, but cygwin did all right. I had to force the install +of the Net::SSLeay dependency, because it partially failed one test, +but I think it worked anyway. In order to get working in cygwin, I +installed the entire "perl" category, lynx, ncftp, and lftp (specified +as ftp program in cpan setup). I'm not sure if I needed all those, or +if cpan just kept asking because I didn't have any installed at the +time. Anyway, cpan worked, and I installed all dependencies that +imapsync complained about until it started working. ======================================================================= Q: Multiple copies when I run imapsync twice ore more. -R. Multiple copies of the emails on the destination -server. Some IMAP servers (Domino for example) add some -headers for each message transfered. The message is -transfered again and again each time you run imapsync. This -is bad of course. The explanation is that imapsync considers -the message is not the same since headers have changed (one +R. Multiple copies of the emails on the destination server. Some IMAP +servers (Domino for example) add some headers for each message +transfered. The message is transfered again and again each time you +run imapsync. This is bad of course. The explanation is that imapsync +considers the message is not the same since headers have changed (one line added) and size too (the header part). -You can look at the headers found by imapsync by using the ---debug option (and search for the message on both part), -Header lines from the source server begin with a "FH:" prefix, -Header lines from the destination server begin with a "TH:" prefix. -Since --debug is very verbose I suggest to isolate a -email in a specific folder in case you want to forward -me the output. +You can look at the headers found by imapsync by using the --debug +option (and search for the message on both part), Header lines from +the source server begin with a "FH:" prefix, Header lines from the +destination server begin with a "TH:" prefix. Since --debug is very +verbose I suggest to isolate a email in a specific folder in case you +want to forward me the output. The way to avoid this problem is by using options --skipheader and ---skipsize, like this (avoid headers beginning whith the -string "X-"): +--skipsize, like this (avoid headers beginning whith the string "X-"): imapsync ... --skipheader '^X-' --skipsize @@ -325,11 +381,11 @@ If you think you have too many header to avoid just use imapsync ... --useheader 'Message-ID' --skipsize Remark. (Trick found by Tomasz Kaczmarski) -Option --useheader 'Message-ID' asks the server -to send only header lines begining with 'Message-ID'. -Some (buggy) servers send the whole header (all lines) -instead of the 'Message-ID' line. In that case, a trick -to keep the --useheader filtering behavior is to use + +Option --useheader 'Message-ID' asks the server to send only header +lines begining with 'Message-ID'. Some (buggy) servers send the whole +header (all lines) instead of the 'Message-ID' line. In that case, a +trick to keep the --useheader filtering behavior is to use --skipheader with a negative lookahead pattern : imapsync ... --skipheader '^(?!Message-ID)' --skipsize @@ -357,14 +413,14 @@ R. Use or maybe --exclude '^"public\.' -In the example given the character "." is the folder separator, -you can ommit it. Just take the string as it appears on the -imapsync output line : +In the example given the character "." is the folder separator, you +can ommit it. Just take the string as it appears on the imapsync +output line : From folders list : [INBOX] [public.dreams] [etc.] ====================================================================== -Q. I want the --folder 'MyFolder' option be recurse. +Q. I want the --folder 'MyFolder' option be recursive. R. Do not use the --folder option. Instead, use --include '^MyFolder' @@ -377,14 +433,14 @@ R. Use ====================================================================== -Q. How to migrate from uw-imap with an admin/authuser account ? +Q. How to migrate from uw-imap with an admin/authuser account? R. Use --user1="user*admin_user" --password1 "admin_user_password" ====================================================================== -Q. How to migrate from cyrus with an admin account ? +Q. How to migrate from cyrus with an admin account? R. Use --authuser1 admin_user ----password1 admin_user_password \ @@ -412,17 +468,17 @@ Here is an example: --exclude '^user\.' ====================================================================== -Q. Is anyway imapsync to purge destionation folder when the source - folder is deleted? +Q. Is there anyway of making imapsync purge the destination folder + when the source folder is deleted? -R. No, that's too much dangerous. -But if the source folder is empty (not deleted) and -options --delete2 --expunge2 are used then -the destination folder will be empty. +R. No, that's too dangerous. + +But if the source folder is empty (not deleted) and options --delete2 +--expunge2 are used then the destination folder will be empty. ====================================================================== Q. Is it possible to synchronize all messages from one server to -another whithout recreating the folder structure and the target server. +another without recreating the folder structure and the target server. R. Yes. 1) First try (safe mode): @@ -437,15 +493,15 @@ imapsync \ 3) Remove --dry Check the imap folder tree on the target side, you should - only have one : the classical INBOX. + only have one: the classical INBOX. 4) Remove --justfolders ====================================================================== -Q. I have moved from Braunschweig to Graz, so I would like to have my whole -Braunschweig mail sorted into a folder INBOX.Braunschweig of my new mail -account. +Q. I have moved from Braunschweig to Graz, so I would like to have my + whole Braunschweig mail sorted into a folder INBOX.Braunschweig of my + new mail account. R. 1) First try (safe mode): @@ -468,30 +524,29 @@ Q. Give examples about --regextrans2 R. Examples: -0) First try with --dry --justfolders options since imapsync shows the -transformations it will do without really doing them. Then when happy -with the output remove the --dry --justfolders options. +0) First try with --dry --justfolders options since imapsync shows the + transformations it will do without really doing them. Then when + happy with the output remove the --dry --justfolders options. 1) To remove INBOX. in the name of destination folders: --regextrans2 's/^INBOX\.(.+)/$1/' 2) To sync a complete account in a subfolder called FOO: - a) Separator is dot character "." and "INBOX" prefixes every folder + a) Seperator is dot character "." and "INBOX" prefixes every folder --regextrans2 's/^INBOX(.*)/INBOX.FOO$1/' Or - b) Separator is slash character "/" + b) Seperator is slash character "/" --regextrans2 's#(.*)#FOO/$1#' 3) to substitute all characters dot "." by underscores "_" --regextrans2 's/\./_/g' ======================================================================= -Q. I would like to move emails from InBox to a sub-folder -called , say "2005-InBox" based on the date (Like all emails -received in the Year 2005 should be moved to the folder -called "2005-InBox"). +Q. I would like to move emails from InBox to a sub-folder called, + say "2005-InBox" based on the date (Like all emails received in the + Year 2005 should be moved to the folder called "2005-InBox"). R. 2 ways : @@ -499,17 +554,18 @@ a) Manually: ------------ 1) You create a folder INBOX.2005-INBOX -2) Mostly every email software allow sorting by date. -In inbox, you select from 1 january to 31 december -messages with the shift key. + +2) Mostly every email software allow sorting by date. In inbox, you + select from 1 january to 31 december messages with the shift key. + (in mutt, use ~d) + 3) Cut/paste in INBOX.2005-INBOX b) With imapsync: ----------------- -You have to calculate the day of year (and -add 365). For example, running it today, -Sat Mar 11 13:06:01 CET 2006: +You have to calculate the day of year (and add 365). For example, +running it today, Sat Mar 11 13:06:01 CET 2006: imapsync ... --host1 imap.truc.org --host2 imap.trac.org \ @@ -528,9 +584,9 @@ Sat Mar 11 13:06:01 CET 2006 $ date +%j 070 -Also, you must take imapsync 1.159 at least since I tested -what I just wrote above and found 2 bugs about --mindate ---maxdate options behavior. +Also, you must take imapsync 1.159 at least since I tested what I just +wrote above and found 2 bugs about --mindate --maxdate options +behavior. ======================================================================= Q. I want to play with headers line and --regexmess but I want to leave @@ -560,7 +616,7 @@ This example just add an header line "X-Date:" based on "Date:" line. ======================================================================= Q. My imap server does not accept a message and warns - "Invalid header". What is the problem ? + "Invalid header". What is the problem? R. You fall in the classical mbox versus Maildir/ format problem. May be you use a misconfigured procmail rule. @@ -573,42 +629,39 @@ From foo@yoyo.org Sat Jun 22 01:10:21 2002 Return-Path: Received: ... -Any Maidir/ configured imap server may refuse this message -since its header is invalid. The first "From " line is not -valid. It lacks a colon character ":". -To solve this problem you have several solutions a) or b): +Any Maildir/ configured imap server may refuse this message since its +header is invalid. The first "From " line is not valid. It lacks a +colon character ":". To solve this problem you have several solutions -a) Remove these first "From " line manually for each message -before using imapsync. Don't think to add a colon to this -line since you will end with two "From:" lines (just look at -the other lines) +a) Remove these first "From " line manually for each message before + using imapsync. Don't think to add a colon to this line since you + will end with two "From:" lines (just look at the other lines) b) Run imapsync with the following options : ---regexmess 's/\AFrom \w .*\n//' --skipsize + --regexmess 's/\AFrom \w .*\n//' --skipsize ======================================================================= Q. The contact folder isn't well copied. - How to copy the contact folder ? + How to copy the contact folder? -R. Forget the destination server (chose the same) +R. Forget the destination server (choose the same) Change the script around line 1426 # ITSD $new_id = $from->copy($t_fold,$f_msg); #$new_id = $to->append_string($t_fold,$string, $flags_f, $d); -and tried a copy of the mail instead an append_string. -Because we are using the same server, we can use $from->copy -Therefore we seem to not download and upload the message and therefore -we do not have any format issues. -And now it works fine. -(Thanks to Hansjoerg.Maurer) + +and tried a copy of the mail instead an append_string. Because we are +using the same server, we can use $from->copy Therefore we seem to not +download and upload the message and therefore we do not have any +format issues. And now it works fine. (Thanks to Hansjoerg.Maurer) ======================================================================= -Q. Synchronysing from XXX to Gmail +Q. Synchronising from XXX to Gmail -R. There are some details to get the special [Gmail] -sub-folders right. Here's an example of migrating an old "Sent" -folder to Gmail's structure: +R. There are some details to get the special [Gmail] sub-folders + right. Here's an example of migrating an old "Sent" folder to + Gmail's structure: imapsync --syncinternaldates \ --host1 mail.oldhost.com \ @@ -625,9 +678,9 @@ imapsync --syncinternaldates \ The same goes for the "All Mail" archive psuedo-folder. ======================================================================= -Q. Synchronysing from Gmail to XXX +Q. Synchronising from Gmail to XXX -R. Gmail needs ssl. +R. Gmail needs SSL ./imapsync \ --host1 imap.gmail.com --ssl1 \ @@ -661,6 +714,7 @@ http://mark.ossdl.de/2009/02/migrating-from-exchange-2007-to-google-apps-mail/ Q. Syncing from Google Apps domain to Googlemail account A known bug encountered with this output (Alexander is a folder name): + ++++ Verifying [Alexander] -> [Alexander] ++++ + NO msg #16 [A96Dh4AwlLVphOAW5MS/eQ:779824] in Alexander + Copying msg #16:779824 to folder Alexander @@ -679,9 +733,9 @@ R. Just run imapsync a time like this : imapsync ... --folder Alexander ======================================================================= -Q. I'm migrating from WU to Cyrus, and the mail folders are -under /home/user/mail but the tool copies everything in -/home/user, how can i avoid that? +Q. I'm migrating from WU to Cyrus, and the mail folders are under + /home/user/mail but the tool copies everything in /home/user, how + can i avoid that? R. Use imapsync ... --include '^mail' @@ -690,12 +744,11 @@ or (better) ======================================================================= -Q. I'm migrating from WU to Cyrus, and the mail folders are -under /home/user/mail directory. When imapsync creates the -folders in the new cyrus imap server, it makes a folder -"mail" and below that folder puts all the mail folders the -user have in /home/user/mail, i would like to have all those -folders directly under INBOX. +Q. I'm migrating from WU to Cyrus, and the mail folders are under + /home/user/mail directory. When imapsync creates the folders in + the new cyrus imap server, it makes a folder "mail" and below that + folder puts all the mail folders the user have in /home/user/mail, + i would like to have all those folders directly under INBOX. R. Use imapsync ... --regextrans2 's/^mail/INBOX/' --dry @@ -719,30 +772,32 @@ following options: --skipheader '^Content-Type' - MIME separator IDs seem to change every time a mail is accessed so -this is required to stop duplicates. + this is required to stop duplicates. --maxage 3650 - some messages just don't seem to want to transfer and produce the -perl errors I mentioned before. This prevents the errors, but the bad -messages don't transfer. + perl errors I mentioned before. This prevents the errors, but the + bad messages don't transfer. Even though the mail migrated OK, there are a couple of gotchas with Groupwise IMAP: -1) Some of the GW folders are not real folders and are not available to -IMAP, the main problem one being "Sent Items". I could find no way of -coping the contents of these folders. The nearest I got was to create a -"real" folder and copy/move the sent items into it, but imapsync still -didn't see the messages (I think because there is something funny about -the reported dates/sizes). +1) Some of the GW folders are not real folders and are not available +to IMAP, the main problem one being "Sent Items". I could find no way +of coping the contents of these folders. The nearest I got was to +create a "real" folder and copy/move the sent items into it, but +imapsync still didn't see the messages (I think because there is +something funny about the reported dates/sizes). + It think this problem has been rectified in GW6.5. 2) The "skipheader '^Content-Type'" directive is required to stop -duplicate messages being created. GW seems to generate this field on the -fly for messages that have MIME separators and so it's different every time. +duplicate messages being created. GW seems to generate this field on +the fly for messages that have MIME separators and so it's different +every time. 3) Version 6.0.1 of the Groupwise Internet Connector sucks. I was -getting server abends when I pushed it a bit hard! I eventually had to +getting server aborts when I pushed it a bit hard! I eventually had to upgrade to 6.0.4 which seems to be a lot more stable. @@ -816,18 +871,19 @@ imapsync --host1 cyrus --user1 x --authuser1 x --password1 x --ssl1 \ --sep1 '/' --exclude 'user/demo/Trash' \ --regextrans2 's/^user.//' --syncinternaldates -The 'exclude user/demo/Trash' was used because there was one message -there with 8 bit headers which dbmail doesn't accept, so I had to skip -the whole folder. It would be nice to have an option to just ignore and -log unsyncable messages, but do the rest, instead of stopping. +The 'exclude user/demo/Trash' was used because there was one message +there with 8 bit headers which dbmail doesn't accept, so I had to skip +the whole folder. It would be nice to have an option to just ignore +and log unsyncable messages, but do the rest, instead of stopping. ****************** There are two other major problems: -1) dbmail doesn't accept utf8 header, while cyrus does. imapsync stops + +1) dbmail doesn't accept utf8 header, while cyrus does. imapsync stops in that case, making sync impossible -To convert the wholes messages from 8bit to 7bit, use option : +To convert the whole messages from 8bit to 7bit, use option : --regexmess 's/[\x80-\xff]/X/g' @@ -861,7 +917,7 @@ R. See and run patches/imapsync_1.267_jari Q. From any to Exchange2007 Several problems: -- Big messages: increse the "send- and receive-connector" +- Big messages: increase the "send- and receive-connector" in exchange2007 to 40 MB. R. 2 solutions diff --git a/Mail-IMAPClient-3.23/COPYRIGHT b/Mail-IMAPClient-3.23/COPYRIGHT new file mode 100644 index 0000000..ebc36eb --- /dev/null +++ b/Mail-IMAPClient-3.23/COPYRIGHT @@ -0,0 +1,401 @@ +COPYRIGHT + + Copyright 1999, 2000, 2001, 2002 , 2003 The Kernen Group, Inc. + All rights reserved. + +This program is free software; you can redistribute it and/or modify it +under the terms of either: + + +a) the "Artistic License" which comes with this Kit, or + +b) the GNU General Public License as published by the Free Software +Foundation; either version 1, or (at your option) any later version. + + +This program is distributed in the hope that it will be useful, but +WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either the GNU +General Public License or the Artistic License for more details. All your +base are belong to us. + +============= + + The "Artistic License" + + Preamble + +The intent of this document is to state the conditions under which a +Package may be copied, such that the Copyright Holder maintains some +semblance of artistic control over the development of the package, +while giving the users of the package the right to use and distribute +the Package in a more-or-less customary fashion, plus the right to make +reasonable modifications. + +Definitions: + + "Package" refers to the collection of files distributed by the + Copyright Holder, and derivatives of that collection of files + created through textual modification. + + "Standard Version" refers to such a Package if it has not been + modified, or has been modified in accordance with the wishes + of the Copyright Holder as specified below. + + "Copyright Holder" is whoever is named in the copyright or + copyrights for the package. + + "You" is you, if you're thinking about copying or distributing + this Package. + + "Reasonable copying fee" is whatever you can justify on the + basis of media cost, duplication charges, time of people involved, + and so on. (You will not be required to justify it to the + Copyright Holder, but only to the computing community at large + as a market that must bear the fee.) + + "Freely Available" means that no fee is charged for the item + itself, though there may be fees involved in handling the item. + It also means that recipients of the item may redistribute it + under the same conditions they received it. + +1. You may make and give away verbatim copies of the source form of the +Standard Version of this Package without restriction, provided that you +duplicate all of the original copyright notices and associated disclaimers. + +2. You may apply bug fixes, portability fixes and other modifications +derived from the Public Domain or from the Copyright Holder. A Package +modified in such a way shall still be considered the Standard Version. + +3. You may otherwise modify your copy of this Package in any way, provided +that you insert a prominent notice in each changed file stating how and +when you changed that file, and provided that you do at least ONE of the +following: + + a) place your modifications in the Public Domain or otherwise make them + Freely Available, such as by posting said modifications to Usenet or + an equivalent medium, or placing the modifications on a major archive + site such as uunet.uu.net, or by allowing the Copyright Holder to include + your modifications in the Standard Version of the Package. + + b) use the modified Package only within your corporation or organization. + + c) rename any non-standard executables so the names do not conflict + with standard executables, which must also be provided, and provide + a separate manual page for each non-standard executable that clearly + documents how it differs from the Standard Version. + + d) make other distribution arrangements with the Copyright Holder. + +4. You may distribute the programs of this Package in object code or +executable form, provided that you do at least ONE of the following: + + a) distribute a Standard Version of the executables and library files, + together with instructions (in the manual page or equivalent) on where + to get the Standard Version. + + b) accompany the distribution with the machine-readable source of + the Package with your modifications. + + c) give non-standard executables non-standard names, and clearly + document the differences in manual pages (or equivalent), together + with instructions on where to get the Standard Version. + + d) make other distribution arrangements with the Copyright Holder. + +5. You may charge a reasonable copying fee for any distribution of this +Package. You may charge any fee you choose for support of this +Package. You may not charge a fee for this Package itself. However, +you may distribute this Package in aggregate with other (possibly +commercial) programs as part of a larger (possibly commercial) software +distribution provided that you do not advertise this Package as a +product of your own. You may embed this Package's interpreter within +an executable of yours (by linking); this shall be construed as a mere +form of aggregation, provided that the complete Standard Version of the +interpreter is so embedded. + +6. The scripts and library files supplied as input to or produced as +output from the programs of this Package do not automatically fall +under the copyright of this Package, but belong to whoever generated +them, and may be sold commercially, and may be aggregated with this +Package. If such scripts or library files are aggregated with this +Package via the so-called "undump" or "unexec" methods of producing a +binary executable image, then distribution of such an image shall +neither be construed as a distribution of this Package nor shall it +fall under the restrictions of Paragraphs 3 and 4, provided that you do +not represent such an executable image as a Standard Version of this +Package. + +7. C subroutines (or comparably compiled subroutines in other +languages) supplied by you and linked into this Package in order to +emulate subroutines and variables of the language defined by this +Package shall not be considered part of this Package, but are the +equivalent of input as in Paragraph 6, provided these subroutines do +not change the language in any way that would cause it to fail the +regression tests for the language. + +8. Aggregation of this Package with a commercial distribution is always +permitted provided that the use of this Package is embedded; that is, +when no overt attempt is made to make this Package's interfaces visible +to the end user of the commercial distribution. Such use shall not be +construed as a distribution of this Package. + +9. The name of the Copyright Holder may not be used to endorse or promote +products derived from this software without specific prior written permission. + +10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED +WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. + + The End + +============= + + GNU GENERAL PUBLIC LICENSE + Version 1, February 1989 + + Copyright (C) 1989 Free Software Foundation, Inc. + 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The license agreements of most software companies try to keep users +at the mercy of those companies. By contrast, our General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. The +General Public License applies to the Free Software Foundation's +software and to any other program whose authors commit to using it. +You can use it for your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Specifically, the General Public License is designed to make +sure that you have the freedom to give away or sell copies of free +software, that you receive source code or can get it if you want it, +that you can change the software or use pieces of it in new free +programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of a such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must tell them their rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License Agreement applies to any program or other work which +contains a notice placed by the copyright holder saying it may be +distributed under the terms of this General Public License. The +"Program", below, refers to any such program or work, and a "work based +on the Program" means either the Program or any work containing the +Program or a portion of it, either verbatim or with modifications. Each +licensee is addressed as "you". + + 1. You may copy and distribute verbatim copies of the Program's source +code as you receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice and +disclaimer of warranty; keep intact all the notices that refer to this +General Public License and to the absence of any warranty; and give any +other recipients of the Program a copy of this General Public License +along with the Program. You may charge a fee for the physical act of +transferring a copy. + + 2. You may modify your copy or copies of the Program or any portion of +it, and copy and distribute such modifications under the terms of Paragraph +1 above, provided that you also do the following: + + a) cause the modified files to carry prominent notices stating that + you changed the files and the date of any change; and + + b) cause the whole of any work that you distribute or publish, that + in whole or in part contains the Program or any part thereof, either + with or without modifications, to be licensed at no charge to all + third parties under the terms of this General Public License (except + that you may choose to grant warranty protection to some or all + third parties, at your option). + + c) If the modified program normally reads commands interactively when + run, you must cause it, when started running for such interactive use + in the simplest and most usual way, to print or display an + announcement including an appropriate copyright notice and a notice + that there is no warranty (or else, saying that you provide a + warranty) and that users may redistribute the program under these + conditions, and telling the user how to view a copy of this General + Public License. + + d) You may charge a fee for the physical act of transferring a + copy, and you may at your option offer warranty protection in + exchange for a fee. + +Mere aggregation of another independent work with the Program (or its +derivative) on a volume of a storage or distribution medium does not bring +the other work under the scope of these terms. + + 3. You may copy and distribute the Program (or a portion or derivative of +it, under Paragraph 2) in object code or executable form under the terms of +Paragraphs 1 and 2 above provided that you also do one of the following: + + a) accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of + Paragraphs 1 and 2 above; or, + + b) accompany it with a written offer, valid for at least three + years, to give any third party free (except for a nominal charge + for the cost of distribution) a complete machine-readable copy of the + corresponding source code, to be distributed under the terms of + Paragraphs 1 and 2 above; or, + + c) accompany it with the information you received as to where the + corresponding source code may be obtained. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form alone.) + +Source code for a work means the preferred form of the work for making +modifications to it. For an executable file, complete source code means +all the source code for all modules it contains; but, as a special +exception, it need not include source code for modules which are standard +libraries that accompany the operating system on which the executable +file runs, or for standard header files or definitions files that +accompany that operating system. + + 4. You may not copy, modify, sublicense, distribute or transfer the +Program except as expressly provided under this General Public License. +Any attempt otherwise to copy, modify, sublicense, distribute or transfer +the Program is void, and will automatically terminate your rights to use +the Program under this License. However, parties who have received +copies, or rights to use copies, from you under this General Public +License will not have their licenses terminated so long as such parties +remain in full compliance. + + 5. By copying, distributing or modifying the Program (or any work based +on the Program) you indicate your acceptance of this license to do so, +and all its terms and conditions. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the original +licensor to copy, distribute or modify the Program subject to these +terms and conditions. You may not impose any further restrictions on the +recipients' exercise of the rights granted herein. + + 7. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of the license which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +the license, you may choose any version ever published by the Free Software +Foundation. + + 8. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + Appendix: How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to humanity, the best way to achieve this is to make it +free software which everyone can redistribute and change under these +terms. + + To do so, attach the following notices to the program. It is safest to +attach them to the start of each source file to most effectively convey +the exclusion of warranty; and each file should have at least the +"copyright" line and a pointer to where the full notice is found. + + + Copyright (C) 19yy + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 1, or (at your option) + any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software Foundation, + Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) 19xx name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the +appropriate parts of the General Public License. Of course, the +commands you use may be called something other than `show w' and `show +c'; they could even be mouse-clicks or menu items--whatever suits your +program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the + program `Gnomovision' (a program to direct compilers to make passes + at assemblers) written by James Hacker. + + , 1 April 1989 + Ty Coon, President of Vice + +That's all there is to it! diff --git a/Mail-IMAPClient-3.23/Changes b/Mail-IMAPClient-3.23/Changes new file mode 100644 index 0000000..45cffae --- /dev/null +++ b/Mail-IMAPClient-3.23/Changes @@ -0,0 +1,2031 @@ + +== Revision History for Mail::IMAPClient +Changes from 3.17_01 to ? made by Phil Pearl (Lobbes) +Changes from 2.99_01 to 3.16 made by Mark Overmeer +Changes from 0.09 to 2.99_01 made by David Kernen + - Potential compatibility issues from 3.17+ highlighted with '*' + +version 3.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 $ diff --git a/Mail-IMAPClient-3.23/INSTALL b/Mail-IMAPClient-3.23/INSTALL new file mode 100644 index 0000000..1b74934 --- /dev/null +++ b/Mail-IMAPClient-3.23/INSTALL @@ -0,0 +1,82 @@ +Mail::IMAPClient Installation + +The Mail::IMAPClient is written entirely in Perl, so it should install +on any reasonably recent version of Perl. See the README file for a perl +one-liner that you can run to verify that your perl has what it takes +to run Mail::IMAPClient. + +The installation is standard: + + 0) cd to installation directory + 1) perl Makefile.PL (and reply to the prompts) + 2) make (optional) + 3) make test (optional) + 4) make install + +The 'make install' and 'make test' will both do step 2 ('make') if you +haven't done it already. Currently the test script is lame (although +not as lame as in the last release!) but I hope to incorporate more +thorough testing in a future version. You should at least try it and +let me know if your tests fail. + +Version 1.0 changed the installation script so that it reuses the +parameter file for the tests if it finds one. Installation can be run in +the background if the test.txt file exists. Touching it is good enough +to prevent prompts; having a correctly formatted version (as shown in +test_template.txt) is even better, as it will allow you to do a thorough +'make test'. Invalid data in test.txt (either from precreating it or from +responding inaccurately to prompts) will cause 'make test' to report 'not +ok' results but won't break anything important (like the IMAPClient.pm +file, or your car). + +If you have tests that fail it may be more illuminating to run the +tests by hand. IE: perl -I./blib/lib t/basic.t from the installation +dir will pinpoint the failing test. Better yet, supply an argument to +basic/t (any 'true' argument will do; I use '1') to turn on debugging, +which will be placed in your installation directory in 'imap1.debug' +and 'imap2.debug'. E-mail me the results. + +If you don't have a test.txt file in your installation directory then you +will have to answer at least one prompt. If you do have a test.txt file, +and you run 'make clean', then you won't have a test.txt file anymore, +so take precautions. + +If you do have a test.txt file and you don't run 'make clean' then +a text file will be sitting around containing logon credentials, so, +again, take precautions. (It's just a test account anyway, right?) + +If, when replying to the "perl Makefile.PL" prompts, you supply server, +id, and password credentials for an id that has a ridiculously huge number +of folders and subfolders then the 'make test' may run approximately +forever. Next time try an id with less stuff. + +For examples on using Mail::IMAPClient, check out the examples +subdirectory. If you have better examples, then why haven't you e-mailed +them to me? Also, I totally recommend that you have a copy of RFC2060 +handy when using this module, since the documentation for this module is +meant to compliment, not replace, RFC2060. In fact, I am so convinced that +you'll need the RFC that I've included a copy of it in the distribution, +under the "docs/" subdirectory. It's a smashing good read so have at +it. Other IMAP related rfcs are there as well. + +One of the examples in the examples/ subdirectory is called +cleanTest.pl. If you find your 'make test' has had trouble and left some +folders named "IMAPClient_*" in your test account, you can run this +example to clean up the account. But probably only after you've fixed +any problems encountered with 'make test'! + +This module uses Damian Conway's excellent Parse::RecDescent module +for some advanced features. If you don't have that module installed +then you can still install Mail::IMAPClient but you won't have the +full functionality. If you have Parse::RecDescent installed and then +upgrade it, you may find that some features in Mail::IMAPClient suddenly +start throwing compile-time errors. Just 'make clean' and then 'make', +'make test', and 'make install'. This happens because grammers compiled +under older releases of Parse::RecDescent are sometimes incompatible +with newer Parse::RecDescent runtime engines. This would never be a +problem if Mail::IMAPClient recompiled grammers at run time, but for +performance reasons it precompiles them at install time. TANSTAAFL. + +Now go and write IMAP clients. + +Dave Kernen diff --git a/Mail-IMAPClient-3.23/MANIFEST b/Mail-IMAPClient-3.23/MANIFEST new file mode 100644 index 0000000..f71af2b --- /dev/null +++ b/Mail-IMAPClient-3.23/MANIFEST @@ -0,0 +1,41 @@ +COPYRIGHT +Changes +INSTALL +MANIFEST +Makefile.PL +README +TODO +examples/build_dist.pl +examples/build_ldif.pl +examples/cleanTest.pl +examples/copy_folder.pl +examples/cyrus_expire.pl +examples/cyrus_expunge.pl +examples/find_dup_msgs.pl +examples/imap_to_mbox.pl +examples/imtestExample.pl +examples/migrate_mail2.pl +examples/migrate_mbox.pl +examples/populate_mailbox.pl +examples/sharedFolder.pl +lib/Mail/IMAPClient.pm +lib/Mail/IMAPClient.pod +lib/Mail/IMAPClient/BodyStructure.pm +lib/Mail/IMAPClient/BodyStructure/Parse.grammar +lib/Mail/IMAPClient/BodyStructure/Parse.pm +lib/Mail/IMAPClient/BodyStructure/Parse.pod +lib/Mail/IMAPClient/MessageSet.pm +lib/Mail/IMAPClient/Thread.grammar +lib/Mail/IMAPClient/Thread.pm +lib/Mail/IMAPClient/Thread.pod +prepare_dist +sample.perldb +t/basic.t +t/bodystructure.t +t/fetch_hash.t +t/messageset.t +t/pod.t +t/simple.t +t/thread.t +test_template.txt +META.yml Module meta-data (added by MakeMaker) diff --git a/Mail-IMAPClient-3.23/META.yml b/Mail-IMAPClient-3.23/META.yml new file mode 100644 index 0000000..fe7e758 --- /dev/null +++ b/Mail-IMAPClient-3.23/META.yml @@ -0,0 +1,22 @@ +# http://module-build.sourceforge.net/META-spec.html +#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# +name: Mail-IMAPClient +version: 3.23 +version_from: lib/Mail/IMAPClient.pm +installdirs: site +requires: + Carp: 0 + Errno: 0 + Fcntl: 0 + File::Temp: 0 + IO::File: 0 + IO::Select: 0 + IO::Socket: 0 + IO::Socket::INET: 1.26 + List::Util: 0 + MIME::Base64: 0 + Parse::RecDescent: 1.94 + Test::More: 0 + +distribution_type: module +generated_by: ExtUtils::MakeMaker version 6.17 diff --git a/Mail-IMAPClient-3.23/Makefile.PL b/Mail-IMAPClient-3.23/Makefile.PL new file mode 100644 index 0000000..4cea875 --- /dev/null +++ b/Mail-IMAPClient-3.23/Makefile.PL @@ -0,0 +1,145 @@ +use ExtUtils::MakeMaker; +use warnings; +use strict; + +my @missing; +my %optional = ( + "Authen::NTLM" => { for => "Authmechanism 'NTLM'" }, + "Authen::SASL" => { for => "Authmechanism 'DIGEST-MD5'" }, + "Digest::HMAC_MD5" => { for => "Authmechanism 'CRAM-MD5'" }, + "Digest::MD5" => { for => "Authmechanism 'DIGEST-MD5'" }, + "IO::Socket::SSL" => { for => "SSL enabled connections (Ssl => 1)" }, + "Test::Pod" => { for => "Pod tests", ver => "1.00" }, +); + +foreach my $mod ( sort keys %optional ) { + my $for = $optional{$mod}->{"for"} || ""; + my $ver = $optional{$mod}->{"ver"} || ""; + eval "use $mod $ver ();"; + push @missing, $mod . ( $for ? " for $for" : "" ) if $@; +} + +# similar message to one used in DBI: +if (@missing) { + print( "The following optional modules were not found:", + map( "\n\t" . $_, @missing ), "\n" ); + + print <<'MSG'; +Optional modules are available from any CPAN mirror, reference: + http://search.cpan.org/ + http://www.perl.com/CPAN/modules/by-module + http://www.perl.org/CPAN/modules/by-module + +MSG + sleep 3; +} + +WriteMakefile( + NAME => 'Mail::IMAPClient', + , + ABSTRACT => 'IMAP4 client library', + VERSION_FROM => 'lib/Mail/IMAPClient.pm', + PREREQ_PM => { + 'Carp' => 0, + 'Errno' => 0, + 'Fcntl' => 0, + 'IO::File' => 0, + 'IO::Select' => 0, + 'IO::Socket' => 0, + 'IO::Socket::INET' => 1.26, + 'List::Util' => 0, + 'MIME::Base64' => 0, + 'Parse::RecDescent' => 1.94, + 'Test::More' => 0, + 'File::Temp' => 0, + }, + clean => { FILES => 'test.txt' }, + $] >= 5.005 + ? ## keywords supported since 5.005 + ( AUTHOR => 'Phil Lobbes ' ) + : () +); + +set_test_data(); + +exit 0; + +### +### HELPERS +### + +sub set_test_data { + unless ( -f "lib/Mail/IMAPClient.pm" ) { + warn "ERROR: not in installation directory\n"; + return; + } + + return if -f "./test.txt"; + + print <<'__INTRO'; +You have the option of running an extended suite of tests during +'make test'. This requires an IMAP server name, user account, and +password to test with. + +__INTRO + + my $yes = prompt "Do you want to run the extended tests? (n/y)"; + return if $yes !~ /^y(?:es)?$/i; + + unless ( open TST, '>', "./test.txt" ) { + warn "ERROR: couldn't open ./test.txt: $!\n"; + return; + } + + my $server = ""; + until ($server) { + $server = + prompt "\nPlease provide the hostname or IP address of " + . "a host running an\nIMAP server (or QUIT to skip " + . "the extended tests)"; + chomp $server; + return if $server =~ /^\s*quit\s*$/i; + } + + print TST "server=$server\n"; + + my $user = ""; + until ($user) { + $user = + prompt "\nProvide the username of an account on $server (or QUIT)"; + chomp $user; + return if $user =~ /^\s*quit\s*$/i; + } + print TST "user=$user\n"; + + my $passed = ""; + until ($passed) { + $passed = prompt "\nProvide the password for $user (or QUIT)"; + chomp $passed; + return if $passed =~ /^\s+$|^quit$/i; + } + + print TST "passed=$passed\n"; + + my $port = prompt "\nPlease provide the port to connect to on $server " + . "to run the test\n(default is 143)"; + chomp $port; + $port ||= 143; + print TST "port=$port\n"; + + my $authmech = prompt "\nProvide the authentication mechanism to use " + . "on $server to\nrun the test (default is LOGIN)"; + + chomp $authmech; + $authmech ||= 'LOGIN'; + print TST "authmechanism=$authmech\n"; + close TST; + + print <<'__THANKS'; + +The information you provided (including the password!) has been stored +in test.txt and SHOULD BE REMOVED (either by hand or by 'make clean') +after testing. +__THANKS + +} diff --git a/Mail-IMAPClient-3.23/README b/Mail-IMAPClient-3.23/README new file mode 100644 index 0000000..45de3fb --- /dev/null +++ b/Mail-IMAPClient-3.23/README @@ -0,0 +1,111 @@ + Mail::IMAPClient + +Copyright 1999-2003 The Kernen Group, Inc. +Copyright 2007 Mark Overmeer +All rights reserved. + +This program is free software; you can redistribute it and/or modify +it under the terms of either: + + a) the "Artistic License" which comes with this Kit, or + + b) the GNU General Public License as published by the Free Software + Foundation; either version 1, or (at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either +the GNU General Public License or the Artistic License for more details. + +DESCRIPTION + +This module provides perl routines that simplify a sockets connection +to and an IMAP conversation with an IMAP server. + +COMPATIBILITY + +[This paragraph has not been updated for many years] +This module was developed on Solaris 2.5.1 and 2.6 against Netscape IMAP +servers versions 3.6 and 4.1. However, since it is written in perl and +designed for flexibility, it should run on any OS with a TCP/IP stack and +a version of perl that includes the Socket and IO::Socket modules. It also +should be able to talk to any IMAP server, even those that have, um, +proprietary features (assuming that the programmer knows what those features +are). + +To date, I know that the test suite runs successfully with the following IMAP +servers: + +-Netscape Messenging Server v4.x +-Netscape Messenging Server v3.x +-UW-IMAP (I think it was 4.5) +-Cyrus IMAP4 v1.5.19 +-Mirapoint Message Server Appliances (OS versions 1.6.1, 1.7.1, and 2.0.2) + +Version 2.0.3 has been tested with the mdaemon server with mixed +results. It seems that mdaemon does not comply strictly with RFC2060 and +so you may have problems using this module with mdaemon, especially with +folder names with embedded spaces or embedded double quotes. You may be +able to get some simple tasks to work but you won't be able to run the +test suite successfully. Use with caution. + +If your server requires the use of the AUTHENTICATE IMAP client command +(say, for strong authentication) then you can still use this module, +provided you can come up with the appropriate responses to any challenges +offered by your server. Mark Bush's Authen::NTLM module can assist with +this if you specifically are interested in NTLM authentication. + +REPORING BUGS + +See http://rt.cpan.org/Public/Dist/Display.html?Name=Mail-IMAPClient + +INSTALLATION + +Generally, gunzipping and untarring the source file, running 'perl +Makefile.PL' and 'make install' are all it takes to install this +module. And if that's too much work you can always use the CPAN module! + +OVERVIEW OF FUNCTIONALITY + +Mail::IMAPClient.pm provides methods to simplify the connection to and +the conversation between a perl script and an IMAP server. Virtually +all IMAP Client commands (as defined in rfc2060) are supported, either +through IMAPClient object methods or the 'default method', which is an +AUTOLOAD hack that assumes a default syntax for IMAP Client commands of: + + tagvalue COMMAND [Arg1 [Arg2 [... Arg3]]]" + +By remarkable coincidence, AUTOLOAD's default syntax mimics the +general syntax of IMAP Client commands. This means that if a script +tries to use any undefined method then that method will be interpreted +as an unimplemented IMAP command, and the default syntax will be used +to create the command string. I did this as a short cut to writing a +bunch of methods that were practically the same. There are inheritance +implications because of this approach but as far as I can tell this is +not a serious limitation. However, if you decide to write modules that +inherit from this class that require AUTOLOAD logic of their own then you +will have to take the Mail::IMAPClient's AUTOLOAD strategy into account. + +Where methods are defined, they usually exist to add functionality, +perhaps by massaging output or by supplying default arguments. An example +is the search method, which accepts the same arguments as the SEARCH +IMAP Client command (as documented in RFC2060) but which massages the +results so that the return value is an array of message sequence numbers +matching the search criteria, rather than a line of text listing the +sequence numbers. + +Some methods exists solely to add functionality, such as the folders +method, which invokes the list method but then massages the results to +produce an array containing all folder names. The message_count and +delete_messsage methods are similarly examples of methods that add +function to "raw" IMAP Client commands. + +Further information is provided in the module's documentation, which you are +encouraged to read and enjoy. + +Good Luck! + +Dave Kernen +The Kernen Group, Inc. +DJKERNEN@cpan.org + diff --git a/Mail-IMAPClient-3.23/TODO b/Mail-IMAPClient-3.23/TODO new file mode 100644 index 0000000..47ff39a --- /dev/null +++ b/Mail-IMAPClient-3.23/TODO @@ -0,0 +1,68 @@ + +=== README + +Starting with release 2.99_01, I (Mark Overmeer) try to revive the +module. The original author David Kernen cannot be reached and didn't +release any fixes in four years. That is far too long. + +The code and installation procedure has been cleaned-up radically, + + and some minimal improvements in the code are made to +fix things people reported. + +=== wishlist: + +- A start was made in cleanup of the code in Mail/IMAPClient.pm + The file Mail/IMAPClient-cleanup shows the progress (30%) + But I lack the time (a weeks work at least) to complete this + task. There is a lot of code replication to be stripped. + If anyone buys me time, I will complete that task. + +=== wishlist from the original author: + +The following is a list of some items that I hope to include in a future +release: + +- Support for threaded perl programs (still pending as of version 2.2.0.). + +- Support for imaps (Imap via SSL). I don't have any way to test this + right now but if you get this to work or know someone who has I'd be + really interested in hearing from you. + +- Support for more authentication mechanisms. Currently plain + authentication and cram-md5 authentication are supported. I have + DIGEST-MD5 working at the AUTH qop, but haven't incorporated it into + a released version because I'm still trying to get at least the + integrity qop working, and maybe even privacy, but considering how + much trouble I'm having with just the integrity level I wouldn't + hold my breath if I were you ;-). + +- Currently a number of IMAP Client commands are implemented using the + 'default method', which is an AUTOLOAD hack. I'd like to reduce that + if possible to a bare minimum. (Some are still pending as of version 2.2.7.) + +- I'd like to see this module certified for more OS's and more IMAP servers. + This is (hopefully) just a matter of testing; the code should already + be compatible with the IMAP servers that are out there and with any OS + that allows the IO::Socket module to work. ** A number of platforms + have been added to the list of tested platforms since this was first + written. Please contact DJKernen@cpan.org if you have any to add. + +- Support for newer/older/other versions of IMAP. Currently only RFC2060 is + explicitly supported, although thanks to the 'default method' + (implemented via an AUTOLOAD hack) virtually any IMAP command is + supported, even proprietary commands, X- extensions, and so forth. But + not necessarily other authentication mechanisms... :-( (NOTE: the + AUTHENTICATE method partially addresses this issue.) + +- Support for piping output from (some?) imap commands directly to a + thingy of some sort (perhaps a coderef, a filehandle, or both). + +- Your thingy here!!! Send me your request, and I'll do it in the order of + ($popularity/$difficulty ). + +- Support for perl version 6. This will probably involve a rewrite that + will make portions of the Mail::IMAPClient module look more like the + Mail::IMAPClient::BodyStructure module. (Perl 6 will have built-in + support for semantics that look remarkably like Damian Conway's + Parse::RecDescent module, which will solve a lot of problems for me.) diff --git a/Mail-IMAPClient-3.23/examples/build_dist.pl b/Mail-IMAPClient-3.23/examples/build_dist.pl new file mode 100644 index 0000000..d51dc5f --- /dev/null +++ b/Mail-IMAPClient-3.23/examples/build_dist.pl @@ -0,0 +1,172 @@ +#!/usr/local/bin/perl +#$Id: //depot/main/ZimbraPS/Mail-IMAPClient/examples/build_dist.pl#1 $ + +use Mail::IMAPClient; + +=head1 DESCRIPTION + +B accepts the name of a target folder as an argument. It +then opens that folder and rummages through all the mail files in it, looking +for "Reply-to:" headers (or "From:" headers, where there is no "Reply-to:"). +It then appends a message into the folder containing all of the addresses in +thus found as a list of recipients. This message can be used to conveniently +drag and drop names into an address book, distribution list, or e-mail message, +using the GUI client of choice. + +The email appended to the folder specified in the I<-f> option will have the +subject "buid_dist.pl I Output". + +=head1 SYNTAX + +b I<-h> + +b I<-s servername -u username -p password -f folder [ -d ]> + +=over 4 + +=item -f The folder name to process. + +=item -s The servername of the IMAP server + +=item -u The user to log in as + +=item -p The password for the user specified in the I<-u> option + +=item -d Tells the IMAP client to turn on debugging info + +=item -h Prints out this document + +=back + +B You can supply defaults for the above options by updating the script. + +=cut + +use Getopt::Std; + +getopts('s:u:p:f:d'); + +# Update the following to supply defaults: + +$opt_f ||= "default folder"; +$opt_s ||= "default server"; +$opt_u ||= "default user"; +$opt_p ||= "default password"; # security risk: use with caution! + +# Let the compiler know we're serious about these two variables: +$opt_h = $opt_h or $opt_d = $opt_d ; + +exec "perldoc $0" if $opt_h; + +my $imap = Mail::IMAPClient->new( + Server => $opt_s , + User => $opt_u , + Password=> $opt_p , + Debug => $opt_d||0 , +) or die "can't connect to server\n"; + +$imap->select($opt_f); + +my @msgs = $imap->search("NOT SUBJECT",qq("buid_dist.pl $opt_f Output")); +my %list; +foreach my $m (@msgs) { + + my $ref = $imap->parse_headers($m,"Reply-to","From"); + + warn "Couldn't get recipient address from msg#$m\n" + unless scalar(@{$ref->{'Reply-to'}}) || + scalar(@{$ref->{'From'}}) ; + + my $from = scalar(@{$ref->{'Reply-to'}}) ? + $ref->{'Reply-to'}[0] : + $ref->{'From'}[0] ; + + my $addr = $from; + $addr =~ s/.*]//g; + $list{$addr} = $from unless exists $list{$addr}; +} + +$append = <<"EOMSG"; +To: ${\(join(",",values %list))} +From: $opt_u\@$opt_s +Date: ${\($imap->Rfc822_date(time))} +Subject: build_dist.pl $opt_f Output + +The above note was never actually sent to the following people: + +${\(join("\n",keys %list))} + +Interesting, eh? + +Love, +$opt_u + +EOMSG + +$imap->append($opt_f,$append) or warn "Couldn't append the message."; + +$imap->logout; + + +=head1 AUTHOR + +David J. Kernen + +The Kernen Group, Inc. + +imap@kernengroup.com + +=head1 COPYRIGHT + +This example and Mail::IMAPClient are Copyright (c) 2003 +by The Kernen Group, Inc. All rights reserved. + +This example is distributed with Mail::IMAPClient and +subject to the same licensing requirements as Mail::IMAPClient. + +imtest is a utility distributed with Cyrus IMAP server, +Copyright (c) 1994-2000 Carnegie Mellon University. +All rights reserved. + +=cut + + +# $Id: //depot/main/ZimbraPS/Mail-IMAPClient/examples/build_dist.pl#1 $ +# $Log: build_dist.pl,v $ +# Revision 19991216.7 2003/06/12 21:38:29 dkernen +# +# Preparing 2.2.8 +# Added Files: COPYRIGHT +# Modified Files: Parse.grammar +# Added Files: Makefile.old +# Makefile.PL Todo sample.perldb +# BodyStructure.pm +# Parse.grammar Parse.pod +# range.t +# Thread.grammar +# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt +# rfc2221.txt rfc2359.txt rfc2683.txt +# +# Revision 19991216.6 2000/12/11 21:58:50 dkernen +# +# Modified Files: +# build_dist.pl build_ldif.pl copy_folder.pl find_dup_msgs.pl +# imap_to_mbox.pl populate_mailbox.pl +# to add CVS data +# +# Revision 19991216.5 1999/12/16 17:19:09 dkernen +# Bring up to same level +# +# Revision 19991124.3 1999/12/16 17:14:22 dkernen +# Incorporate changes for exists method performance enhancement +# +# Revision 19991124.02 1999/11/24 17:46:16 dkernen +# More fixes to t/basic.t +# +# Revision 19991124.01 1999/11/24 16:51:46 dkernen +# Changed t/basic.t to test for UIDPLUS before trying UID cmds +# +# Revision 1.8 1999/11/23 17:51:05 dkernen +# Committing version 1.06 distribution copy +# diff --git a/Mail-IMAPClient-3.23/examples/build_ldif.pl b/Mail-IMAPClient-3.23/examples/build_ldif.pl new file mode 100644 index 0000000..aea17ec --- /dev/null +++ b/Mail-IMAPClient-3.23/examples/build_ldif.pl @@ -0,0 +1,235 @@ +#!/usr/local/bin/perl +#$Id: //depot/main/ZimbraPS/Mail-IMAPClient/examples/build_ldif.pl#1 $ +use Mail::IMAPClient; +use MIME::Lite; +use Data::Dumper; + +=head1 DESCRIPTION + +B accepts the name of a target folder as an argument. It +then opens that folder and rummages through all the mail files in it, looking +for "Reply-to:" headers (or "From:" headers, where there is no "Reply-to:"). +It then prints to STDOUT a file in ldif format containing entries for all of +the addresses that it finds. It also appends a message into the specified folder containing +all of the addresses in both the B field of the message header and in an +LDIF-format attachment. + +B requires B. + +=head1 SYNTAX + +B I<-h> + +B I<-s servername -u username -p password -f folder [ -d ]> + +=over 4 + +=item -f The folder name to process. + +=item -s The servername of the IMAP server + +=item -t Include "To" and "Cc" fields as well as "From" + +=item -u The user to log in as + +=item -p The password for the user specified in the I<-u> option + +=item -d Tells the IMAP client to turn on debugging info + +=item -n Suppress delivering message to folder + +=item -h Prints out this document + +=back + +B You can supply defaults for the above options by updating the script. + +=cut + +use Getopt::Std; + +getopts('hs:u:p:f:dtn'); + +# Update the following to supply defaults: + +$opt_f ||= "default folder"; +$opt_s ||= "default server"; +$opt_u ||= "default user"; +$opt_p ||= "default password"; # security risk: use with caution! + +# Let the compiler know we're serious about these variables: +$opt_0 = ( $opt_h or $opt_d or $opt_t or $opt_n or $opt_0); + +exec "perldoc $0" if $opt_h; + +my $imap = Mail::IMAPClient->new( + Server => $opt_s , + User => $opt_u , + Password=> $opt_p , + Debug => $opt_d||0 , +) or die "can't connect to server\n"; + +$imap->select($opt_f); $imap->expunge; + +my @msgs = $imap->search("NOT SUBJECT",qq("buid_ldif.pl $opt_f Output")); +my %list; +foreach my $m (@msgs) { + + my $ref = $imap->parse_headers($m,"Reply-to","From"); + + warn "Couldn't get recipient address from msg#$m\n" + unless scalar(@{$ref->{'Reply-to'}}) || + scalar(@{$ref->{'From'}}) ; + + my $from = scalar(@{$ref->{'Reply-to'}}) ? + $ref->{'Reply-to'}[0] : + $ref->{'From'}[0] ; + my $name = $from ; + + $name =~ s/<.*// ; + if ($name =~ /\@/) { + $name = $from ; + $name =~ s/\@.*//; ; + } + $name =~ s/\"//g ; + $name =~ s/^\s+|\s+$//g ; + my $addr = $from ; + $addr =~ s/.*]//g ; + $list{lc($addr)} = [ $addr, $name ] + unless exists $list{lc($addr)} ; + if ($opt_t) { # Do "To" and "Cc", too + my $ref = $imap->parse_headers($m,"To","Cc") ; + my @array = ( @{$ref->{To}} , @{$ref->{Cc}} ) ; + my @members = () ; + foreach my $text (@array) { + while ( $text =~ / "([^"\\]*(\\.[^"\\]*)*"[^,]*),? | + ([^",]+),? | + , + /gx + ) { + push @members, defined($1)?$1:$3 ; + } + } + foreach my $to (@members) { + + my $name = $to ; + + $name =~ s/<.*// ; + if ($name =~ /\@/) { + $name = $to ; + $name =~ s/\@.*//; ; + } + $name =~ s/\"//g ; + $name =~ s/^\s+|\s+$//g ; + my $addr = $to ; + $addr =~ s/.*]//g ; + $list{lc($addr)} = [ $addr, $name ] + unless exists $list{lc($addr)} ; + } + + } +} + +my $text = join "",map { + qq{dn: cn="} . $list{$_}[1] . + qq{", mail=$list{$_}[0]\n} . + qq{cn: } . $list{$_}[1] . qq{\n} . + qq{mail: $list{$_}[0]\n} . + qq{objectclass: top\nobjectclass: person\n\n}; +} keys %list ; + +# Create a new multipart message: +my $msg = MIME::Lite->new( + From => $opt_u, + map({ ("To" => $list{$_}[0]) } keys %list), + Subject => "LDIF file from $opt_f", + Type =>'TEXT', + Data =>"Attached is the LDIF file of addresses from folder $opt_f." +); +$msg->attach( Type =>'text/ldif', + Filename => "$opt_f.ldif", + Data => $text , +); +print $text; +$imap->append($opt_f, $msg->as_string) unless $opt_n; +print Dumper($imap) if $opt_d; +$imap->logout; + + +=head1 AUTHOR + +David J. Kernen + +The Kernen Group, Inc. + +imap@kernengroup.com + +=head1 COPYRIGHT + +This example and Mail::IMAPClient are Copyright (c) 1999,2003 +by The Kernen Group, Inc. All rights reserved. + +This example is distributed with Mail::IMAPClient and +subject to the same licensing requirements as Mail::IMAPClient. + +imtest is a utility distributed with Cyrus IMAP server, +Copyright (c) 1994-2000 Carnegie Mellon University. +All rights reserved. + +=cut + +# $Id: //depot/main/ZimbraPS/Mail-IMAPClient/examples/build_ldif.pl#1 $ +# $Log: build_ldif.pl,v $ +# Revision 19991216.11 2003/06/12 21:38:30 dkernen +# +# Preparing 2.2.8 +# Added Files: COPYRIGHT +# Modified Files: Parse.grammar +# Added Files: Makefile.old +# Makefile.PL Todo sample.perldb +# BodyStructure.pm +# Parse.grammar Parse.pod +# range.t +# Thread.grammar +# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt +# rfc2221.txt rfc2359.txt rfc2683.txt +# +# Revision 19991216.10 2002/05/24 15:47:18 dkernen +# Misc fixes +# +# Revision 19991216.9 2000/12/11 21:58:51 dkernen +# +# Modified Files: +# build_dist.pl build_ldif.pl copy_folder.pl find_dup_msgs.pl +# imap_to_mbox.pl populate_mailbox.pl +# to add CVS data +# +# Revision 19991216.8 2000/03/02 19:57:13 dkernen +# +# Modified Files: build_ldif.pl -- to support new option to all "To:" and "Cc:" to be included in ldif file +# +# Revision 19991216.7 2000/02/21 16:16:10 dkernen +# +# Modified Files: build_ldif.pl -- to allow for "To:" and "Cc:" header handling and +# to handle quoted names in headers +# +# Revision 19991216.6 1999/12/28 13:56:59 dkernen +# Fixed -h option (help). +# +# Revision 19991216.5 1999/12/16 17:19:10 dkernen +# Bring up to same level +# +# Revision 19991124.3 1999/12/16 17:14:24 dkernen +# Incorporate changes for exists method performance enhancement +# +# Revision 19991124.02 1999/11/24 17:46:18 dkernen +# More fixes to t/basic.t +# +# Revision 19991124.01 1999/11/24 16:51:48 dkernen +# Changed t/basic.t to test for UIDPLUS before trying UID cmds +# +# Revision 1.8 1999/11/23 17:51:05 dkernen +# Committing version 1.06 distribution copy +# diff --git a/Mail-IMAPClient-3.23/examples/cleanTest.pl b/Mail-IMAPClient-3.23/examples/cleanTest.pl new file mode 100644 index 0000000..a60f780 --- /dev/null +++ b/Mail-IMAPClient-3.23/examples/cleanTest.pl @@ -0,0 +1,64 @@ +#!/usr/local/bin/perl + +use Mail::IMAPClient; +use IO::File; +# +# Example that will also clean out your test account if interrupted 'make test' +# runs have left junk folders there. Run from installation dir, installation/examples +# subdir, or supply full path to the test.txt file (created during 'perl Makefile.PL' +# and left in the installation dir until 'make clean'). +# If you 've already run 'make clean' or said no to extended tests, +# then you don't have the file anyway; re-run 'perl Makefile.PL', reply 'y' to the +# extended tests prompt, then supply the test account's credentials as prompted. +# Then try this again. +# +if ( -f "./test.txt" ) { + $configFile = "./test.txt" +} elsif ( -f "../test.txt" ) { + $configFile = "../test.txt" +} elsif ( $ARGV[0] and -f "$ARGV[0]" ) { + $configFile = $ARGV[0]; +} else { + print STDERR "Can't find test.txt. Please run this from the installation directory ", + "or supply the full path to test.txt as an argument on the command line.\n"; +} +my $fh = IO::File->new("./test.txt") or die "./test.txt: $!\n"; +while (my $input = <$fh>) { + chomp $input; + my($k,$v) = split(/=/,$input,2); + $conf{$k}=$v; +} +my $imap = Mail::IMAPClient->new(Server=>$conf{server},User=>$conf{user}, + Password=>$conf{passed}) or die "Connecting to $conf{server}: $! $@\n"; + +for my $f ( grep(/^IMAPClient_/,$imap->folders) ) { + print "Deleting $f\n"; + $imap->select($f); + $imap->delete_messages(@{$imap->messages}) ; + $imap->close($f); + $imap->delete($f); +} + + +=head1 AUTHOR + +David J. Kernen + +The Kernen Group, Inc. + +imap@kernengroup.com + +=head1 COPYRIGHT + +This example and Mail::IMAPClient are Copyright (c) 2003 +by The Kernen Group, Inc. All rights reserved. + +This example is distributed with Mail::IMAPClient and +subject to the same licensing requirements as Mail::IMAPClient. + +imtest is a utility distributed with Cyrus IMAP server, +Copyright (c) 1994-2000 Carnegie Mellon University. +All rights reserved. + +=cut + diff --git a/Mail-IMAPClient-3.23/examples/copy_folder.pl b/Mail-IMAPClient-3.23/examples/copy_folder.pl new file mode 100644 index 0000000..bfa9d2a --- /dev/null +++ b/Mail-IMAPClient-3.23/examples/copy_folder.pl @@ -0,0 +1,147 @@ +#!/usr/local/bin/perl +#$Id: //depot/main/ZimbraPS/Mail-IMAPClient/examples/copy_folder.pl#1 $ +++$|; +use Getopt::Std; +use Mail::IMAPClient; +use vars qw/$opt_r $opt_h $opt_t $opt_f/; + +getopts("t:f:F:N:rh"); +if ( $opt_h ) { + print &usage; + exit; +} + +my($to_id,$to_pass,$thost) = $opt_t =~ m{ + ([^/]+) # everything up to / is the id + / # then a slash + ([^@]+) # then everything up to @ is pswd + @ # then an @-sign + (.*) # then everything else is the host + }x ; +my($from_id,$from_pass,$fhost) = + $opt_f =~ m{ + ([^/]+) # everything up to / is the id + / # then a slash + ([^@]+) # then everything up to @ is pswd + @ # then an @-sign + (.*) # then everything else is the host + }x ; +$to_id and $from_id and $to_pass and $from_pass and $thost and $fhost + or die "Error: Must specify -t and -f (to and from)\n" . &usage; +$opt_F or + die "Error: Must specify '-F folder' or how will I know what folder to copy?\n" . + &usage ; + +$opt_N ||= $opt_F; + + +print "Copying folder $opt_F from $from_id\@$fhost to ${to_id}'s $opt_N folder on $thost.\n"; + +my ($from) = Mail::IMAPClient->new( Server => $fhost, + User => $from_id, + Password=> $from_pass, + Fast_IO => 1, + Uid => 1, + Debug => 0, +); + + +my ($to) = Mail::IMAPClient->new( Server => $thost, + User => $to_id, + Password=> $to_pass, + Fast_IO => 1, + Uid => 1, + Debug => 0, +); + +my @folders = $opt_r ? @{$from->folders($opt_F)} : ( $opt_F ) ; + +foreach my $fold (@folders) { + print "Processing folder $fold\n"; + $from->select($fold); + if ($opt_F ne $opt_N) { + $fold =~s/^$opt_F/$opt_N/o; + } + unless ($to->exists($fold)) { + $to->create($fold) or warn "Couldn't create $fold\n" and next; + } + $to->select($fold); + my @msgs = $from->search("ALL"); + # my %flaghash = $from->flags(\@msgs); + foreach $msg (@msgs) { + print "Processing message $msg in folder $fold.\n"; + my $string = $from->message_string($msg); + # print "String = $string\n"; + my $new_id = $to->append($fold,$string) + or warn "Couldn't append msg #$msg to target folder $fold.\n"; + + $to->store($new_id,"+FLAGS (" . join(" ",@{$from->flags($msg)}) . ")"); + } +} + +sub usage { + return "Syntax:\n\t$0 -t to_id/to_pass\@to.host -f from_id/from_pass\@from.host \\\n" . + "\t\t-F folder [-N New_Folder] [-r]\n". + "\tor\n\t$0 -h\n\n". + "\twhere:\n\t\t". + "to_id\t\tis the id to recieve the folder\n\t\t". + "to_pass\t\tis the password for to_id\n\t\t". + "from\t\tis the uid who currently has the folder\n\t\t". + "from_pass\tis the password for from_id\n\t\t". + "to.host\t\tis the optional host where the 'to' uid has a mailbox\n\t\t". + "from.host\tis the optional host where the 'from' uid has a mailbox\n\t\t". + "folder\t\tis the folder to copy from\n\t\t". + "New_Folder\tis the folder to copy to (defaults to 'folder')\n\t\t". + "-h\t\tprints this help message\n\t\t". + "-r\t\tspecifies a recursive copy (only works on systems that support the idea " . + "\n\t\t\t\tof recursive folders)\n\t\t". + "\n" + ; +} + + +=head1 AUTHOR + +David J. Kernen + +The Kernen Group, Inc. + +imap@kernengroup.com + +=head1 COPYRIGHT + +This example and Mail::IMAPClient are Copyright (c) 1999,2000,2003 +by The Kernen Group, Inc. All rights reserved. + +This example is distributed with Mail::IMAPClient and +subject to the same licensing requirements as Mail::IMAPClient. + +imtest is a utility distributed with Cyrus IMAP server, +Copyright (c) 1994-2000 Carnegie Mellon University. +All rights reserved. + +=cut + +# History: +# $Log: copy_folder.pl,v $ +# Revision 19991216.3 2003/06/12 21:38:30 dkernen +# +# Preparing 2.2.8 +# Added Files: COPYRIGHT +# Modified Files: Parse.grammar +# Added Files: Makefile.old +# Makefile.PL Todo sample.perldb +# BodyStructure.pm +# Parse.grammar Parse.pod +# range.t +# Thread.grammar +# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt +# rfc2221.txt rfc2359.txt rfc2683.txt +# +# Revision 19991216.2 2000/12/11 21:58:51 dkernen +# +# Modified Files: +# build_dist.pl build_ldif.pl copy_folder.pl find_dup_msgs.pl +# imap_to_mbox.pl populate_mailbox.pl +# to add CVS data +# diff --git a/Mail-IMAPClient-3.23/examples/cyrus_expire.pl b/Mail-IMAPClient-3.23/examples/cyrus_expire.pl new file mode 100644 index 0000000..52a97d7 --- /dev/null +++ b/Mail-IMAPClient-3.23/examples/cyrus_expire.pl @@ -0,0 +1,111 @@ +#!/usr/local/bin/perl +#$Id + +use Mail::IMAPClient; # available from http://search.cpan.org/search?mode=module&query=IMAPClient +use IO::File; +use Getopt::Std; +use vars qw/ $opt_d $opt_s $opt_p $opt_u $opt_P $opt_h /; + +&getopts('d:s:u:p:P:h'); # -d days_to_keep -u cyrys_user -p cyrus_pswd -s cyrus_server -P port + +my $days_to_keep = $opt_d||365; # Delete msgs older than -d arg or 365 days +my $cutoff = time - ( $days_to_keep * 24 * 60 * 60 ) ; # time - arg * 24 * 60 * 60 = cutoff date in seconds + +# Change the following line (or replace it with something better): +$opt_h and die help()."\n"; +my $h = $opt_s || "localhost" ; +my $u = $opt_u || "cyrys" ; +my $p = $opt_p or die "Unable to continue. No password provided.\n" . help(); + +my $imap = Mail::IMAPClient->new( + Server => "$h", + User => "$u", # $u, + Password=> "$p", # $p, + Uid => 1, # True value + Port => $opt_P||143, # imapd + Debug => 0, # Make true to debug + Buffer => 4096*10, # True value; decrease on machines w/little memory + Fast_io => 1, # True value + Timeout => 30, # True value + # Debug_fh=> IO::File->new(">out.db"), # fhandle + ) +or die "$@"; + my $mcnt = my $fcnt = 0; +print "Deleting messages older than ",$imap->Rfc2060_date($cutoff),"\n"; +for my $f ( $imap->folders ) { + print "Expiring $f\n"; + unless ($imap->select($f) ) { + $imap->setacl($f,$u,"lrswipcda") or warn "Cannot setacl for $f: $@\n" and next; + $imap->select($f) or warn "Cannot select $f: $@" and next; + } + my @expired = $imap->search("SENTBEFORE",$imap->Rfc2060_date($cutoff)); + next unless @expired; + $mcnt += scalar(@expired); $fcnt ++; + print "Deleting ",scalar(@expired)," messages from $f\n"; + $imap->delete_message(@expired); + $imap->expunge; + $imap->close; +} + $imap->logout; + print "Deleted a total of $mcnt messages in $fcnt folders.\n"; +exit; + + +sub help { + return <<"EOHELP"; + +Usage: + + $0 [ -d days_to_keep ] [ -s mail_server ] [ -u cyrus_admin_id ] -p cyrus_password + $0 -h + + -h -- prints this here help message + -d days_to_keep -- $0 will delete messages older than "days_to_keep". (Default is 365) + -s mail_server -- hostname or IP Address of IMAP mail server (defaults to "localhost") + -u cyrus_admin_id -- user name of Unix account that owns Cyrus server (defaults to "cyrus") + -p cyrus_password -- password for the "cyrus_admin_id" user account (no default) + -P cyrus_port -- port where the cyrus imapd daemon is listening (defaults to value from + /etc/services or '143') + +EOHELP + +} + + +=head1 AUTHOR + +David J. Kernen + +The Kernen Group, Inc. + +imap@kernengroup.com + +=head1 COPYRIGHT + +This example and Mail::IMAPClient are Copyright (c) 2003 +by The Kernen Group, Inc. All rights reserved. + +This example is distributed with Mail::IMAPClient and +subject to the same licensing requirements as Mail::IMAPClient. + +imtest is a utility distributed with Cyrus IMAP server, +Copyright (c) 1994-2000 Carnegie Mellon University. +All rights reserved. + +=cut + +#$Log: cyrus_expire.pl,v $ +#Revision 19991216.2 2003/06/12 21:38:31 dkernen +# +#Preparing 2.2.8 +#Added Files: COPYRIGHT +#Modified Files: Parse.grammar +#Added Files: Makefile.old +# Makefile.PL Todo sample.perldb +# BodyStructure.pm +# Parse.grammar Parse.pod +# range.t +# Thread.grammar +# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt +# rfc2221.txt rfc2359.txt rfc2683.txt +# diff --git a/Mail-IMAPClient-3.23/examples/cyrus_expunge.pl b/Mail-IMAPClient-3.23/examples/cyrus_expunge.pl new file mode 100644 index 0000000..0016258 --- /dev/null +++ b/Mail-IMAPClient-3.23/examples/cyrus_expunge.pl @@ -0,0 +1,85 @@ +#!/usr/local/bin/perl +#$Id: //depot/main/ZimbraPS/Mail-IMAPClient/examples/cyrus_expunge.pl#1 $ + +use Mail::IMAPClient; +use IO::File; + +# Change the following line (or replace it with something better): +my($h,$u,$p) = ('cyrus_host','cyrus_admin_id','cyrus_admin_pswd'); + +my $imap = Mail::IMAPClient->new( Server => "$h", # imap host + User => "$u", # $u, + Password=> "$p", # $p, + Uid => 1, # True value + Port => 143, # Cyrus + Debug => 0, # True value + Buffer => 4096*10, # True value + Fast_io => 1, # True value + Timeout => 30, # True value + # Debug_fh=> IO::File->new(">out.db"), # fhandle + ) +or die "$@"; + +for my $f ( $imap->folders ) { + print "Expunging $f\n"; + unless ($imap->select($f) ) { + $imap->setacl($f,$u,"lrswipcda") or warn "Cannot setacl for $f: $@\n" and next; + $imap->select($f) or warn "Cannot select $f: $@" and next; + } + $imap->expunge; +} + + +=head1 AUTHOR + +David J. Kernen + +The Kernen Group, Inc. + +imap@kernengroup.com + +=head1 COPYRIGHT + +This example and Mail::IMAPClient are Copyright (c) 2003 +by The Kernen Group, Inc. All rights reserved. + +This example is distributed with Mail::IMAPClient and +subject to the same licensing requirements as Mail::IMAPClient. + +imtest is a utility distributed with Cyrus IMAP server, +Copyright (c) 1994-2000 Carnegie Mellon University. +All rights reserved. + +=cut + +# +#$Log: cyrus_expunge.pl,v $ +#Revision 19991216.3 2003/06/12 21:38:31 dkernen +# +#Preparing 2.2.8 +#Added Files: COPYRIGHT +#Modified Files: Parse.grammar +#Added Files: Makefile.old +# Makefile.PL Todo sample.perldb +# BodyStructure.pm +# Parse.grammar Parse.pod +# range.t +# Thread.grammar +# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt +# rfc2221.txt rfc2359.txt rfc2683.txt +# +#Revision 1.1 2003/06/12 21:38:14 dkernen +# +#Preparing 2.2.8 +#Added Files: COPYRIGHT +#Modified Files: Parse.grammar +#Added Files: Makefile.old +# Makefile.PL Todo sample.perldb +# BodyStructure.pm +# Parse.grammar Parse.pod +# range.t +# Thread.grammar +# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt +# rfc2221.txt rfc2359.txt rfc2683.txt +# +# diff --git a/Mail-IMAPClient-3.23/examples/find_dup_msgs.pl b/Mail-IMAPClient-3.23/examples/find_dup_msgs.pl new file mode 100644 index 0000000..1e4d8ea --- /dev/null +++ b/Mail-IMAPClient-3.23/examples/find_dup_msgs.pl @@ -0,0 +1,217 @@ +#!/usr/local/bin/perl +# $Id: //depot/main/ZimbraPS/Mail-IMAPClient/examples/find_dup_msgs.pl#1 $ + +use Mail::IMAPClient; +use Mozilla::LDAP::Conn; +use Getopt::Std; +use vars qw/$rootdn $opt_a/; +use Data::Dumper; + +# It then connects to a user's mailhost and rummages around, +# looking for duplicate messages. +# It will optionally delete messages that are duplicates (based on +# msg-id header and number of bytes). +# For help, enter: +# find_dup_msgs.pl -h +# + +getopts('ahdtvf:F:u:s:p:P:'); + +if ( $opt_h ) { + print STDERR &usage; + exit; +} + +my $uid = $opt_u or die &usage; +$opt_s||='localhost'; +$opt_p or die &usage; +$opt_P||=143; + +$opt_t and + $opt_d and + die "ERROR: Don't specify -d and -t together.\n" . &usage; + + +my($pu,$pp) = get_admin(); + +print "Connecting to $host:$opt_P\n" if $opt_v; +my $imap = Imap->new( Server => $opt_s, + User => $opt_u, + Password=> $opt_p, + Port => $opt_P, + Fast_io => 1, +) or die "couldn't connect to $host port $opt_P: $!\n"; + +my %folders; my %counts; + +FOLDER: foreach my $f ( $opt_F ? $opt_F : $imap->folders ) { + next if $opt_t and $f eq 'Trash'; + $folders{$f} = 0; + $counts{$f} = $imap->message_count($f); + print "Processing folder $f\n" if $opt_v; + unless ( $imap->select($f)) { + warn "Error selecting $f: " . $imap->LastError . "\n"; + next FOLDER; + } + my @msgs = $imap->search("ALL"); + my %hash = (); + MESSAGE: foreach my $m (@msgs) { + my $mid; + if ($opt_a) { + my $h = $imap->parse_headers( + $m,"Date","Subject","From","Message-ID" + ) or next MESSAGE; + $mid = "$h->{'Date'}[0]$;$h->{'Subject'}[0]$;". + "$h->{'From'}[0]$;$h->{'Message-ID'}[0]"; + + } else { + $mid = $imap->parse_headers( + $m, + "Message-ID" + )->{'Message-ID'}[0] + or next MESSAGE; + } + my $size = $imap->size($m); + if ( exists $hash{$mid} and $hash{$mid} == $size ) { + if ($opt_f) { + open F,">>$opt_f" or + die "can't open $opt_f: $!\n"; + print F $imap->message_string($m), + "___END OF SAVED MESSAGE___","\n"; + close F; + } + $imap->move("Trash",$m) if $opt_t; + $imap->delete_message($m) if $opt_d; + $folders{$f}++; + print "Found a duplicate in ${f}; key = $mid\n" if $opt_v; + + } else { + + $hash{$mid} = $size; + } + } + print "$f hash:\n",Data::Dumper::Dumper(\%hash) if $opt_v; + $imap->expunge if ($opt_t or $opt_d); +} + +my $total; my $totms; +map { $total += $_} values %folders; +map { $totms += $_ } values %counts; +print "Found $total duplicate messages in ${uid}'s mailbox. ", + "The breakdown is:\n", + "\tFolder\tNumber of Duplicates\tNumber of Msgs in Folder\n", + "\t------\t--------------------\t------------------------\n", + map { "\t$_\t$folders{$_}\t$counts{$_}\n" } keys %folders, + "\tTOTAL\t$total\t$totms\n" +; + + +sub usage { + return "Usage:\n" . + "\t$0 [-d|-t] [-v] [-f filename] [-a] [-P port] \\\n". + "\t\t-s server -u user -p password\n\n" . + "\t-a\t\tdo an especially aggressive search for duplicates\n". + "\t-d\t\tdelete duplicates (default is to just report them)\n". + "\t-f file\t\tsave deleted messages in file named 'file'\n" . + "\t-F fldr\t\tOnly check the folder named 'fldr' (default is to check all folders)\n" . + "\t-h\t\tprint this help message (all other options are ignored)\n" . + "\t-p password\tspecify the target user's password\n" . + "\t-P port\t\tspecify the port to connect to (default is 143)\n" . + "\t-s server\tspecify the target mail server\n" . + "\t-u uid\t\tspecify the target user\n" . + "\t-t\t\tmove deleted messages to trash folder\n" . + "\t-v\t\tprint verbose status messages while processing\n". + "\n" ; +} + + +=head1 AUTHOR + +David J. Kernen + +The Kernen Group, Inc. + +imap@kernengroup.com + +=head1 COPYRIGHT + +This example and Mail::IMAPClient are Copyright (c) 2003 +by The Kernen Group, Inc. All rights reserved. + +This example is distributed with Mail::IMAPClient and +subject to the same licensing requirements as Mail::IMAPClient. + +imtest is a utility distributed with Cyrus IMAP server, +Copyright (c) 1994-2000 Carnegie Mellon University. +All rights reserved. + +=cut + +# History: +# $Log: find_dup_msgs.pl,v $ +# Revision 19991216.5 2003/06/12 21:38:32 dkernen +# +# Preparing 2.2.8 +# Added Files: COPYRIGHT +# Modified Files: Parse.grammar +# Added Files: Makefile.old +# Makefile.PL Todo sample.perldb +# BodyStructure.pm +# Parse.grammar Parse.pod +# range.t +# Thread.grammar +# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt +# rfc2221.txt rfc2359.txt rfc2683.txt +# +# Revision 1.1 2003/06/12 21:38:14 dkernen +# +# Preparing 2.2.8 +# Added Files: COPYRIGHT +# Modified Files: Parse.grammar +# Added Files: Makefile.old +# Makefile.PL Todo sample.perldb +# BodyStructure.pm +# Parse.grammar Parse.pod +# range.t +# Thread.grammar +# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt +# rfc2221.txt rfc2359.txt rfc2683.txt +# +# Revision 19991216.4 2002/08/23 14:34:51 dkernen +# +# Modified Files: Changes IMAPClient.pm Makefile Makefile.PL test.txt for version 2.2.0 +# Added Files: Makefile Makefile.PL Parse.grammar Parse.pm Parse.pod version 2.2.0 +# Added Files: parse.t for version 2.2.0 +# Added Files: bodystructure.t for 2.2.0 +# Modified Files: find_dup_msgs.pl for v2.2.0 +# +# Revision 1.6 2001/03/08 19:00:35 dkernen +# +# ---------------------------------------------------------------------- +# Modified Files: +# copy_folder.pl delete_mailbox.pl find_dup_msgs.pl +# mbox_check.pl process_orphans.pl rename_id.pl +# scratch_indexes.pl +# to get ready for nsusmsg02 upgrade +# ---------------------------------------------------------------------- +# +# Revision 1.5 2000/11/01 15:51:58 dkernen +# +# Modified Files: copy_folder.pl find_dup_msgs.pl restore_mbox.pl +# +# Revision 1.4 2000/04/13 21:17:18 dkernen +# +# Modified Files: find_dup_msgs.pl - to add -a switch (for aggressive dup search) +# Added Files: copy_folder.pl - a utility for copying a folder from one user's +# mailbox to another's +# +# Revision 1.3 2000/03/14 16:40:21 dkernen +# +# Modified Files: find_dup_msgs.pl -- to skip msgs with no message-id +# +# Revision 1.2 2000/03/13 19:05:50 dkernen +# +# Modified Files: +# delete_mailbox.pl find_dup_msgs.pl restore_mbox.pl -- to add cvs comments +# find_dup_msgs.pl -- to fix bug that occurred when -t (move-to-trash) switch is used +# diff --git a/Mail-IMAPClient-3.23/examples/imap_to_mbox.pl b/Mail-IMAPClient-3.23/examples/imap_to_mbox.pl new file mode 100644 index 0000000..a617698 --- /dev/null +++ b/Mail-IMAPClient-3.23/examples/imap_to_mbox.pl @@ -0,0 +1,266 @@ +#!/usr/local/bin/perl +# (c) 1999 Thomas Stromberg, Research Triangle Commerce, Inc. +# This software is protected by the BSD License. No rights reserved anyhow. +# + +# DESC: Reads a users IMAP folders, and converts them to mbox +# Good for an interim switch-over from say, Exchange to Cyrus IMAP. + +# $Header: //depot/main/ZimbraPS/Mail-IMAPClient/examples/imap_to_mbox.pl#1 $ + +# History: +# -------- +# 2008/08/07 - Added SSL support, fixed From header printing, and CR +# elimination (sobek) + +# TODO: +# ----- +# lsub instead of list option + +use warnings; +use strict; + +use Mail::IMAPClient; # a nice set of perl libs for imap +use IO::Socket::SSL; # for SSL support + +use vars qw($opt_h $opt_u $opt_p $opt_P $opt_s $opt_i $opt_f $opt_m $opt_b + $opt_c $opt_r $opt_w $opt_W $opt_S $opt_D $opt_U $opt_d $opt_I + $opt_n); + +use Getopt::Std; # for the command-line overrides. good for user +use File::Path; # create full file paths. (yummy!) +use File::Basename; # find a nice basename for a folder. +use Date::Manip; # to create From header date +$| = 1; + +sub connect_imap(); +sub find_folders(); +sub write_folder($$$$); +sub help(); + +# Config for the imap migration kit. + +getopts('u:p:P:s:i:f:m:b:c:r:w:W:SDUdhIn:') or + $opt_h = 1; + +my $SSL = $opt_S || 0; +my $SERVER = $opt_s || 'machine'; +my $USER = $opt_u || 'userid'; +my $PASSWORD = $opt_p || 'password'; +my $PORT = $opt_P || '143'; +my $INBOX_PATH = $opt_i || "/var/mail/$USER"; +my $DOINBOX = $opt_I ? 0 : 1 || 1; +my $FOLDERS_PATH = $opt_f || "./folders/$USER"; +my $DONT_MOVE = $opt_m || '.mailboxlist|Trash|INBOXIIMAP|mlbxl'; +my $READ_DELIMITER = $opt_r || '/'; +my $WRITE_DELIMITER = $opt_w || '/'; +my $WRITE_MODE = $opt_W || '>'; +my $BANNED_CHARS = $opt_b || '.|^|%'; +my $CR = $opt_c || "\r"; +my $NUMBER = $opt_n || ""; +my $DELETE = $opt_D || 0; +my $DEBUG = $opt_d || "0"; +my $UNSEEN = $opt_U || 0; +my $FAIL = 0; + +my $imap; # definition for IMAP structure + +if ($opt_h) { + # print help here + help(); +} + +sub help() { + print "imap_to_mbox.pl - with the following optional arguments\: + -S Use an SSL connection (default $SSL) + -s Server specification (default $SERVER) + -u User login (default $USER) + -p

User password + -P

Server Port (default $PORT) + -i INBOX save path (default $INBOX_PATH) + -I skip INBOX (default $DOINBOX) + -f Save path for other folders (default $FOLDERS_PATH) + -m Regexp for IMAP folders not to be saved: + $DONT_MOVE + -r Read delimiter (default \"$READ_DELIMITER\") + -w Write Delimiter (default \"$WRITE_DELIMITER\") + -b Banned chars (default \"$BANNED_CHARS\") + -c Strip CRs from saved files [for Unix] (default \"$CR\") + -n Receive only messages (Default ".($NUMBER ? "$NUMBER" : "all").") + -U Unseen messages Only + -D Delete downloaded files on server + -d Debug mode (default $DEBUG)\n"; + exit 1; +} + +## do our magic tricks ###################################### +connect_imap(); +find_folders(); + + +sub connect_imap() +{ +# Open an SSL session to the IMAP server +# Handles the SSL setup, and gives us back a socket + my $ssl; + if ($opt_S) { + $ssl=IO::Socket::SSL->new( + PeerHost => "$SERVER:imaps" +# , SSL_version => 'SSLv2' # for older versions of openssl + ); + + defined $ssl + or die "Error connecting to $SERVER:imaps - $@"; + + $ssl->autoflush(1); + } + + $imap = Mail::IMAPClient->new( + Socket => ($opt_S ? $ssl : 0), + Server => $SERVER, + User => $USER, + Password => $PASSWORD, + Port => $PORT, + Debug => $DEBUG, + Uid => 0, + Clear => 1, + ) + or die ("Could not connect to $SERVER:$PORT with $USER: $! $?\n"); +} + +sub find_folders() +{ + my @folders = $imap->folders; +# push(@folders, "INBOX"); + + foreach my $folder (@folders) { + my $message_count; + + if ($folder eq "INBOX" and $DOINBOX == 0) { + print "* $folder is unwanted, skipping.\n"; + next; + } + if (!$UNSEEN) { + $message_count = $imap->message_count($folder); + } else { + $message_count = $imap->unseen_count($folder) || 0; + } + if(! $message_count) { + print "* $folder is empty, skipping.\n"; + next; + } + if($folder =~ /$DONT_MOVE/) { + warn "! $folder matches DONT_MOVE ruleset, skipping\n"; + next; + } + + my $new_folder = $folder; + $new_folder =~ s/\./_/g; + $new_folder =~ s/\Q$READ_DELIMITER/$WRITE_DELIMITER/g; + my $path + = $new_folder eq "INBOX" ? "$INBOX_PATH" + : "$FOLDERS_PATH/$new_folder"; + + if ($NUMBER && $NUMBER < $message_count) { + printf "x %4i %-45.45s => %s", $NUMBER, $folder, $path; + write_folder $folder, $path, 1, $NUMBER; + } else { + printf "x %4i %-45.45s => %s", $message_count, $folder, $path; + write_folder $folder, $path, 1, $message_count; + } + } +} + +sub write_folder($$$$) +{ my($folder, $newpath, $first_message, $last_message) = @_; + + $imap->select($folder) + or warn "Could not examine $folder: $!"; + + my $new_dir = dirname $newpath; + my $new_file = basename $newpath; + + -d $new_dir + or mkpath($new_dir, 0700) + or die "Cannot create $new_dir:$!\n"; + + open my $mbox, $WRITE_MODE, $newpath + or die "Cannot create file $newpath: $!\n"; + + my @msgs = $imap->unseen if $UNSEEN; + + for (my $i=$first_message; $i<$last_message+1; ++$i) + { my $m = ($UNSEEN ? shift @msgs : $i); + my $date = UnixDate(ParseDate($imap->internaldate($m)), + "%a %b %e %T %Y"); + my $user = $imap->get_envelope($m)->from_addresses; + $user =~ s/^.*<([^>]*)>/$1/; + $user = '-' unless $user; + print '.' if $m%25 == 0; + + my $msg_header = $imap->fetch($m, "FAST") + or warn "Could not fetch header $m from $folder\n"; + + my $msg_rfc822 = $imap->fetch($m, "RFC822"); + unless($msg_rfc822) + { warn "Could not fetch RFC822 $m from $folder\n"; + $FAIL=1 + } + + undef my $start; + foreach (@$msg_rfc822) + { my $message; + if($_ =~ /\: / && !$message) + { ++$message; + print $mbox "From $user $date\n"; + } + + if(/^\)\r/) + { undef $message; + print $mbox "\n\n"; + } + next unless $message; + $_ =~ s/\r$//; + $_ = $imap->Strip_cr($_) if $CR; + print $mbox "$_"; + + } + if($DELETE && ! $FAIL) + { $imap->delete_message($m) + or warn "Could not delete_message: $@\n"; + $FAIL = 0; + } + } + + close $mbox + or die "Write errors to $newpath: $!\n"; + + if($DELETE) + { $imap->expunge($folder) + or warn "Could not expunge: $@\n"; + } + + print "\n"; +} + +# 2008/08/07 - Added SSL support, fixed From header printing, and CR +# elimination (sobek) +# +# Revision 19991216.7 2002/08/23 13:29:48 dkernen +# +# Revision 19991216.6 2000/12/11 21:58:52 dkernen +# +# Revision 19991216.5 1999/12/16 17:19:12 dkernen +# Bring up to same level +# +# Revision 19991124.3 1999/12/16 17:14:25 dkernen +# Incorporate changes for exists method performance enhancement +# +# Revision 19991124.02 1999/11/24 17:46:19 dkernen +# More fixes to t/basic.t +# +# Revision 19991124.01 1999/11/24 16:51:49 dkernen +# Changed t/basic.t to test for UIDPLUS before trying UID cmds +# +# Revision 1.3 1999/11/23 17:51:06 dkernen +# Committing version 1.06 distribution copy diff --git a/Mail-IMAPClient-3.23/examples/imtestExample.pl b/Mail-IMAPClient-3.23/examples/imtestExample.pl new file mode 100644 index 0000000..27938e9 --- /dev/null +++ b/Mail-IMAPClient-3.23/examples/imtestExample.pl @@ -0,0 +1,226 @@ +#!/usr/local/bin/perl + +use Sys::Hostname; +use Mail::IMAPClient; +use IPC::Open3; +use IO::Socket::UNIX; +use IO::Socket; +use Socket; +use Getopt::Std; +&getopts('ha:df:i:o:p:r:m:u:x:w:p:s:'); + +if ($opt_h) { + print <<" HELP"; + $0 -- uses imtest to connect and authenticate to imap server + + Options: + -h print this help message + + -a auth authenticate as user 'auth'. This value is passed as the '-a' value + to imtest and defaults to whatever you supplied for -u. + -d turn on Mail::IMAPClient debugging + -f file write Mail::IMAPClient debugging info to file 'file' + -m mech use authentication mechanism "mech"; default is to not supply -m to + imtest + -i path path to imtest executable; default is to let your shell find it via the + PATH environmental variable. + -p port port on mail server to connect to (default is 143) + -r rlm Use realm 'rlm' (default is name of mail server) + -s srvr Name of IMAP mail server (default is the localhost's hostname) + -u usr Use 'usr' as the user id (required) + -w pswd Use 'pswd' as the password for 'usr' (required) + -x path Path to Unix socket (fifo). Default is '/tmp/$0.sock'. + -o 'ops' Pass the string 'ops' directy to imtest as additional options. + This is how you get "other" imtest options passed to imtest. (I only + included switches for options that are either really common or useful + to the IMAPClient object as well as to imtest.) + + Many of these switches have the same function here as with imtest. I added a + few extras though! + + Example: + $0 -o '-k 128 -l 128' -s imapmail -u test -w testpswd \ + -i /usr/local/src/cyrus/cyrus-imapd-2.1.11/imtest/ \ + -m DIGEST-MD5 + + It's a good idea to test your options by running imtest from the command line + (but without the -x switch) first. Once you have it working by hand you should + be able to get it to work from this script (or one remarkably like it) without + too much bloodshed. + + HELP + exit; +} + +$opt_u and $opt_w or die "No userid/password credentials supplied. I hate that.\n"; +$opt_a ||= $opt_u; + +if ($opt_i ) { + $opt_i =~ m#^[/\.]# or $opt_i = "./$opt_i"; + $opt_i =~ m#imtest$# or ( -x $opt_i and -f $opt_i ) + or $opt_i .= ( $opt_i =~ m#/$# ? "imtest" : "/imtest") ; + -x $opt_i and -f $opt_i or die "Cannot find executable $opt_i\n"; +} + + +$opt_p ||= 143; +$opt_s ||= hostname; +$opt_r ||= $opt_s; +$opt_x ||= "/tmp/$0.sock"; + + +my($rfh,$wfh,$efh) ; + + +my($imt) = ($opt_i ? "$opt_i " : "imtest ") . + ($opt_m ? "-m $opt_m ":"" ) . + qq(-r $opt_r -a $opt_a -u $opt_u ). + qq(-x $opt_x -w $opt_w -p $opt_p $opt_s); + +open3($wfh,$rfh,$efh,$imt); + +my $line; + +until ($line =~ /^Security strength factor:/i ) { + $line = <$rfh> or die "EOF\n"; + print STDERR "Prolog: $line" if $opt_d; +} +sleep 5; +my $sock = IO::Socket::UNIX->new("$opt_x") + or warn "No socket: $!\n" and exit; + +print STDERR "<<>>\n" if $opt_d; +my $imap = Mail::IMAPClient->new; +$imap->Prewritemethod(\&Mail::IMAPClient::Strip_cr); +$imap->User("$opt_u"); +$imap->Server("$opt_s"); +$imap->Port("$opt_p"); +$imap->Debug($opt_d); +$imap->Debug_fh($opt_f||\*STDERR); +$imap->State($imap->Connected); +$imap->Socket($sock); + +# Your code goes here: + +$imap->Select("INBOX"); +for my $m (@{$imap->search("TEXT SUBJECT")} ) { + print "Message $m:\t",$imap->subject($m),"\n"; +} +# You should have finished your code by about here +$imap->logout; + +print STDERR "<<>>\n" if $opt_d; + +exit; + +=head1 NAME + +imtestExample.pl -- uses imtest to connect and authenticate to imap server + + +=head1 DESCRIPTION + + +=head2 Options + +=over 4 + +=item -h + +print this help message + +=item -a auth + +authenticate as user 'auth'. This value is passed as the '-a' value +to imtest and defaults to whatever you supplied for -u. + +=item -d + +turn on Mail::IMAPClient debugging + +=item -f file + +write Mail::IMAPClient debugging info to file 'file' + +=item -m mech + +use authentication mechanism "mech"; default is to not supply -m to + imtest + +=item -i path + +path to imtest executable; default is to let your shell find it via the +PATH environmental variable. + +=item -p port + +port on mail server to connect to (default is 143) + +=item -r rlm + +Use realm 'rlm' (default is name of mail server) + +=item -s srvr + +Name of IMAP mail server (default is the localhost's hostname) + +=item -u usr + +Use 'usr' as the user id (required) + +=item -w pswd + +Use 'pswd' as the password for 'usr' (required) + +=item -x path + +Path to Unix socket (fifo). Default is '/tmp/$0.sock'. + +=item -o 'ops' + +Pass the string 'ops' directy to imtest as additional options. +This is how you get "other" imtest options passed to imtest. (I only +included switches for options that are either really common or useful +to the IMAPClient object as well as to imtest.) + +Many of these switches have the same function here as with imtest. I added a +few extras though! + +=back + +Example: + + imtestExample.pl -o '-k 128 -l 128' -s imapmail -u test -w testpswd \ + -i /usr/local/src/cyrus/cyrus-imapd-2.1.11/imtest/ \ + -m DIGEST-MD5 + +It's a good idea to test your options by running imtest from the command line +(but without the -x switch) first. Once you have it working by hand you should +be able to get it to work from this script (or one remarkably like it) without +too much bloodshed. + + +=head1 AUTHOR + +David J. Kernen + +The Kernen Group, Inc. + +imap@kernengroup.com + +Based on a suggestion by Tara L. Andrews. + +=head1 COPYRIGHT + +This example and Mail::IMAPClient are Copyright (c) 2003 +by The Kernen Group, Inc. All rights reserved. + +This example is distributed with Mail::IMAPClient and +subject to the same licensing requirements as Mail::IMAPClient. + +imtest is a utility distributed with Cyrus IMAP server, +Copyright (c) 1994-2000 Carnegie Mellon University. +All rights reserved. + +=cut + diff --git a/Mail-IMAPClient-3.23/examples/migrate_mail2.pl b/Mail-IMAPClient-3.23/examples/migrate_mail2.pl new file mode 100644 index 0000000..d656ae5 --- /dev/null +++ b/Mail-IMAPClient-3.23/examples/migrate_mail2.pl @@ -0,0 +1,326 @@ +#!/usr/local/bin/perl +#$Id: //depot/main/ZimbraPS/Mail-IMAPClient/examples/migrate_mail2.pl#1 $ +# +# An example of how to migrate from a Netscape server +# (which uses a slash as a separator and which does +# not allow subfolders under the INBOX, only next to it) +# to a Cyrus server (which uses a dot (.) as a separator +# and which requires subfolders to be under "INBOX"). +# There are also some allowed-character differences taken +# into account but this is by no means complete AFAIK. +# +# This is an example. If you are doing mail migrations +# then this may in fact be a very helpful example but +# it is unlikely to work 100% correctly as-is. +# A good place to start is by testing a rather large-volume +# transfer of actual mail from the source server with the +# -v option turned on and redirect output to a file for +# perusal. Examine the output carefully for unexpected +# results, such as a number of messages being skipped because +# they're already in the target folder when you know darn +# well this is the first time you ran the script. This +# would indicate an incompatibility with the logic for +# detecting duplicates, unless for some reason the source +# mailbox contains a lot of duplicate messages to begin with. +# (The latter case is an example of why you should use an +# actual mailbox stuffed with actual mail for test; if you +# generate test messages and then test migrating those you +# will only prove that your test messages are migratable. +# +# Also, you may need to play with the rules +# for translating folder names based on what kind of +# names your target server and source server support. +# +# You may also need to play with the logic that determines +# whether or not a message has already been migrated, +# especially if your source server has messages that +# did not come from an SMTP gateway or something like that. +# +# Some servers allow folders to contain mail and subfolders, +# some allow folders to only contain either mail or subfolders. +# If you are migrating from a "mixed use" type to a "single use" +# type server then you'll have to figure out how to deal +# with this. (This script deals with this by creating folders like +# "/blah_mail", "/blah/blah_mail", and "/blah/blah/blah_mail" +# to hold mail if the source folder contains mail and subfolders +# and the target server supports only single-use folders. +# You may not choose a different strategy.) +# +# Finally, it's possible that in some server-to-server +# copies, the source server supports messages that the +# target server considers unacceptable. For example, some +# but not all IMAP servers flat out refuse to accept +# messages with "base newlines", which is to say messages +# whose lines are match the pattern /[^\r]\n$/. There is +# no logic in this script that deals with the situation; +# you will have to identify it if it exists and figure +# out how you want to handle it. +# +# This is probably not an exhaustive list of issues you'll +# face in a migration, but it's a start. +# +# If you're just migrating from an old version to a newer +# version of the same server then you'll probably have +# a much easier time of it. +# +# + +use Mail::IMAPClient; +use Data::Dumper; +use IO::File; +use File::Basename ; +use Getopt::Std; +use strict; +use vars qw/ $opt_B $opt_D $opt_T $opt_U + $opt_W $opt_b $opt_d $opt_h + $opt_t $opt_u $opt_w $opt_v + $opt_s $opt_S $opt_W $opt_p + $opt_P $opt_f $opt_F $opt_m + $opt_M +/; + +getopts('vs:S:u:U:dDb:B:f:F:w:W:p:P:t:T:hm:M:'); + +if ( $opt_h ) { + print STDERR <<"HELP"; + +$0 - an example script demonstrating the use of the Mail::IMAPClient's + migrate method. + +Syntax: + $0 -s source_server -u source_user -w source_password -p source_port \ + -d debug_source -f source_debugging_file -b source_buffsize \ + -t source_timeout -m source_auth_mechanism \ + -S target_server -U target_user -W target_password -P target_port \ + -D debug_target -F target_debugging_file -B target_buffsize \ + -T target_timeout -M target_auth_mechanism \ + -v + +where "source" refers to the "copied from" mailbox, target is the +"copied to" mailbox, and -v turns on verbose output. +Authentication mechanisms default to "PLAIN". + +HELP + exit; +} +$opt_v and ++$|; +print "$0: Started at ",scalar(localtime),"\n" if $opt_v; + +$opt_p||=143; +$opt_P||=143; + +# Make a connection to the source mailbox: +my $imap = Mail::IMAPClient->new( + Server => $opt_s, + User => $opt_u, + Password=> $opt_w, + Uid => 1, + Port => $opt_p, + Debug => $opt_d||0, + Buffer => $opt_b||4096, + Fast_io => 1, + ( $opt_m ? ( Authmechanism => $opt_m) : () ), + Timeout => $opt_t, + ($opt_f ? ( Debug_fh=>IO::File->new(">$opt_f" )) : ()), +) or die "$@"; + +# Make a connection to the target mailbox: +my $imap2 = Mail::IMAPClient->new( + Server => $opt_S, + User => $opt_U, + Password=> $opt_W, + Port => $opt_P, + Uid => 1, + Debug => $opt_D||0, + ( $opt_M ? ( Authmechanism => $opt_M) : () ), + ($opt_F ? ( Debug_fh=>IO::File->new(">$opt_F")) : ()), + Buffer => $opt_B||4096, + Fast_io => 1, + Timeout => $opt_T, # True value +) or die "$@"; + +# Turn off buffering on debug files: +$imap->Debug_fh->autoflush; +$imap2->Debug_fh->autoflush; + +# Get folder hierarchy separator characters from source and target: +my $sep1 = $imap->separator; +my $sep2 = $imap2->separator; + +# Find out if source and target support subfolders inside INBOX: +my $inferiorFlag1 = $imap->is_parent("INBOX"); +my $inferiorFlag2 = $imap2->is_parent("INBOX"); + +# Set up a test folders to see if the source and target support mixed-use +# folders (i.e. folders with both subfolders and mail messages): +my $testFolder1 = "Migrate_Test_$$" ; # Ex: Migrate_Test_1234 +$testFolder1 = $inferiorFlag2 ? + "INBOX" . $sep2 . $testFolder1 : + $testFolder1 ; + +# The following folder will be a subfolder of $testFolder1: +my $testFolder2 = "Migrate_Test_$$" . $sep2 . "Migrate_test_subfolder_$$" ; +$testFolder2 = $inferiorFlag2 ? "INBOX" . $sep2 . $testFolder2 : $testFolder2 ; + +$imap2->create($testFolder2) ; # Create the subfolder first; RFC2060 dictates that + # the parent folder should be created at the same time + + +# The following line inspired the selectable method. It was also made obsolete by it, +# but I'm leaving it as is to demonstrate use of lower-level method calls: +my $mixedUse2 = grep(/NoSelect/i,$imap2->list("",$testFolder1))? 0 : 1; + +# Repeat the above with the source mailbox: +$testFolder2 = "Migrate_Test_$$" . $sep1 . "Migrate_test_subfolder_$$" ; +$testFolder2 = $inferiorFlag1 ? "INBOX" . $sep1 . $testFolder1 : $testFolder1 ; + +$imap->create($testFolder2) ; + +my $mixedUse1 = grep(/NoSelect/i,$imap->list("",$testFolder1))? 0 : 1; + +print "Imap host $opt_s:$opt_p uses a '$sep1' as a separator and ", + ( defined($inferiorFlag1) ? "allows " : "does not allow "), + "children in the INBOX. It supports ", + ($mixedUse1?"mixed use ":"single use "), "folders.\n" if $opt_v; + +print "Imap host $opt_S:$opt_P uses a '$sep2' as a separator and ", + ( defined($inferiorFlag2) ? "allows " : "does not allow "), + "children in the INBOX. It supports ", + ($mixedUse2?"mixed use ":"single use "), "folders.\n" if $opt_v; + +for ($testFolder1,$testFolder2) {$imap->delete($_); $imap2->delete($_);} + +my($totalMsgs, $totalBytes) = (0,0); + +# Now we will migrate the folder. Here we are doing one message at a time +# so that we can do more granular status reporting and error checking. +# A lazier way would be to do all the messages in one migrate method call +# (specifying "ALL" as the message number) but then we wouldn't be able +# to print out which message we were migrating and it would be a little +# bit tougher to control checking for duplicates and stuff like that. +# We could also check the size of the message on the target right after +# the migrate as an extra safety check if we wanted to but I didn't bother +# here. (I saved as an exercise for the reader. Yeah! That's it! An exercise!) + +# Iterate over all the folders in the source mailbox: +for my $f ($imap->folders) { + # Select the folder on the source side: + $imap->select($f) ; + + # Massage the foldername into an acceptable target-side foldername: + my $targF = ""; + my $srcF = $f; + $srcF =~ s/^INBOX$sep1//i; + if ( $inferiorFlag2 ) { + $targF = $srcF eq "INBOX" ? "INBOX" : "INBOX.$f" ; + } else { + $targF = $srcF ; + } + + $targF =~ s/$sep1/$sep2/go unless $sep1 eq $sep2; + $targF =~ tr/#\$\& '"/\@\@+_/; + if ( $imap->is_parent($f) and !$mixedUse2 ) { + $targF .= "_mail" ; + } + print "Migrating folder $f to $targF\n" if $opt_v; + + # Create the (massaged) folder on the target side: + unless ( $imap2->exists($targF) ) { + $imap2->create($imap2->Massage($targF)) + or warn "Cannot create $targF on " . $imap2->Server . ": $@\n" and next; + } + + # ... and select it + $imap2->select($imap2->Massage($targF)) + or warn "Cannot select $targF on " . $imap2->Server . ": $@\n" and next; + + # now that we know the target folder is selectable, we can close it again: + $imap2->close; + my $count = 0; + my $expectedTotal = $imap->message_count($f) ; + + # Now start iterating over all the messages on the source side... + for my $msg ($imap->messages) { + ++$count; + my $h = ""; + # Get some basic info about the message: + eval { $h = ($imap->parse_headers($msg,"Message-id")||{})->{'Message-id'}[0]}; + my $tsize = $imap->size($msg); + my $ret = 0 ; my $h2 = []; + + # Make sure we didn't already migrate the message in a previous pass: + $imap2->select($targF); + if ( $tsize and $h and $h2 = $imap2->search( + HEADER => 'Message-id' => $imap2->Quote($h), + NOT => SMALLER => $tsize, + NOT => LARGER => $tsize + ) + ) { + print + "Skipping $f/$msg to $targF. ", + "One or more messages (" ,join(", ",@$h2), + ") with the same size and message id ($h) ", + "is already on the server. ", + "\n" + if $opt_v; + $imap2->close; + + } else { + + print + "Migrating $f/$msg to $targF. ", + "Message #$count of $expectedTotal has ", + $tsize , " bytes.", + "\n" if $opt_v; + $imap2->close; + + # Migrate the message: + my $ret = $imap->migrate($imap2,$msg,"$targF") ; + $ret and ( $totalMsgs++ , $totalBytes += $tsize); + $ret or warn "Cannot migrate $f/$msg to $targF on " . $imap2->Server . ": $@\n" ; + } + } +} + +print "$0: Finished migrating $totalMsgs messages and $totalBytes bytes at ",scalar(localtime),"\n" + if $opt_v; +exit; + + +=head1 AUTHOR + +David J. Kernen + +The Kernen Group, Inc. + +imap@kernengroup.com + +=head1 COPYRIGHT + +This example and Mail::IMAPClient are Copyright (c) 2003 +by The Kernen Group, Inc. All rights reserved. + +This example is distributed with Mail::IMAPClient and +subject to the same licensing requirements as Mail::IMAPClient. + +imtest is a utility distributed with Cyrus IMAP server, +Copyright (c) 1994-2000 Carnegie Mellon University. +All rights reserved. + +=cut + +#$Log: migrate_mail2.pl,v $ +#Revision 19991216.4 2003/06/12 21:38:33 dkernen +# +#Preparing 2.2.8 +#Added Files: COPYRIGHT +#Modified Files: Parse.grammar +#Added Files: Makefile.old +# Makefile.PL Todo sample.perldb +# BodyStructure.pm +# Parse.grammar Parse.pod +# range.t +# Thread.grammar +# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt +# rfc2221.txt rfc2359.txt rfc2683.txt +# diff --git a/Mail-IMAPClient-3.23/examples/migrate_mbox.pl b/Mail-IMAPClient-3.23/examples/migrate_mbox.pl new file mode 100644 index 0000000..59b71bf --- /dev/null +++ b/Mail-IMAPClient-3.23/examples/migrate_mbox.pl @@ -0,0 +1,131 @@ +#!/usr/local/bin/perl +# +# This is an example demonstrating the use of the migrate method. +# Note that the migrate method is considered experimental and should +# be used with caution. +# +#$Id: //depot/main/ZimbraPS/Mail-IMAPClient/examples/migrate_mbox.pl#1 $ +# + +use Mail::IMAPClient; +use IO::File; +use File::Basename ; +use Getopt::Std; +use warnings; +use vars qw/$opt_h $opt_H + $opt_s $opt_u $opt_p $opt_d $opt_b $opt_o + $opt_S $opt_U $opt_P $opt_D $opt_B $opt_O +/; + +getopts('Hhs:S:u:U:p:P:d:D:b:B:o:O:'); +if ($opt_h or $opt_H ) { +print << "HELP"; + + +Usage: + +$0 -[h|H] -- prints this message + +Lower-case options are for source server; upper-case options are for the target server. + +$0 -s server -S server -u uid -U uid -p passwd -P passwd \ + -b buffersize -B buffersize -o debugFile -O debugFile > error_file + +All uppercase options except -O default to the lowercase option that was specified. +If you don't specify any uppercase options at all then God help you, I don't know +what will happen. + +Always capture STDERR so that you'll be able to resolve any problems that come up. + + +HELP + +exit; +} + +my $imap = Mail::IMAPClient->new( + Server => $opt_s, + User => $opt_u, + Password=> $opt_p, + Uid => 1, + Debug => $opt_d, + Buffer => $opt_b||4096, + Fast_io => 1, + Timeout => 160, # True value + Debug_fh=> ( + $opt_o ? IO::File->new(">$opt_o")||die "can't open $opt_o: $!\n" : undef ) +) or die "Error opening source connection: $@\n"; + +my $imap2 = Mail::IMAPClient->new( + Server => $opt_S||$opt_s, + User => $opt_U||$opt_u, + Password=> $opt_P||$opt_p, + Uid => 1, + Debug => $opt_D||$opt_d, + Buffer => $opt_B||$opt_b||4096, + Fast_io => 1, + Timeout => 160, + Debug_fh=> ( + $opt_O ? IO::File->new(">$opt_O")||die "can't open $opt_O: $!\n" : undef ) +) or die "Error opening target connection: $@\n"; + + +$imap->Debug_fh->autoflush; +$imap2->Debug_fh->autoflush; + +for my $f ($imap->folders) { $imap->select($f) ; $imap->migrate($imap2,"ALL") ;} + + +=head1 AUTHOR + +David J. Kernen + +The Kernen Group, Inc. + +imap@kernengroup.com + +=head1 COPYRIGHT + +This example and Mail::IMAPClient are Copyright (c) 2003 +by The Kernen Group, Inc. All rights reserved. + +This example is distributed with Mail::IMAPClient and +subject to the same licensing requirements as Mail::IMAPClient. + +imtest is a utility distributed with Cyrus IMAP server, +Copyright (c) 1994-2000 Carnegie Mellon University. +All rights reserved. + +=cut + +# +#$Log: migrate_mbox.pl,v $ +#Revision 19991216.2 2003/06/12 21:38:33 dkernen +# +#Preparing 2.2.8 +#Added Files: COPYRIGHT +#Modified Files: Parse.grammar +#Added Files: Makefile.old +# Makefile.PL Todo sample.perldb +# BodyStructure.pm +# Parse.grammar Parse.pod +# range.t +# Thread.grammar +# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt +# rfc2221.txt rfc2359.txt rfc2683.txt +# +#Revision 1.1 2003/06/12 21:38:15 dkernen +# +#Preparing 2.2.8 +#Added Files: COPYRIGHT +#Modified Files: Parse.grammar +#Added Files: Makefile.old +# Makefile.PL Todo sample.perldb +# BodyStructure.pm +# Parse.grammar Parse.pod +# range.t +# Thread.grammar +# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt +# rfc2221.txt rfc2359.txt rfc2683.txt +# +# diff --git a/Mail-IMAPClient-3.23/examples/populate_mailbox.pl b/Mail-IMAPClient-3.23/examples/populate_mailbox.pl new file mode 100644 index 0000000..b612de2 --- /dev/null +++ b/Mail-IMAPClient-3.23/examples/populate_mailbox.pl @@ -0,0 +1,319 @@ +#!/usr/local/bin/perl +#$Id: //depot/main/ZimbraPS/Mail-IMAPClient/examples/populate_mailbox.pl#1 $ # +use Time::Local ; +use FileHandle ; +use File::Copy ; +use Mail::IMAPClient; +use Sys::Hostname ; + # +my $default_user = 'default' ; +my $default_pswd = 'default' ; + # +######################################################################### +# ARGS: DATE = YYYYMMDDHHMM (defaults to current system date) # +# UID = IMAP account id (defaults to $default_user) # +# PSWD = uid's password (defaults to $default_pswd) # +# HOST = Target host (defaults to localhost) # +# CLEAN = 1 (defaults to 0; used to clean out mailbox 1st) # +# CLEANONLY= 1 (defaults to 0; if 1 then only CLEAN is done) # +# DOMAIN = x.com (no default) the mail domain for UID's address # +# # +# EG: populate_mailbox.pl DATE=200001010100 UID=testuser # +# # +######################################################################### + # +(my($x)= join(" ",@ARGV)) ; +$x=~s~=~ ~g ; +chomp($x) ; + # +my %hash = split(/\s+/, $x) if $x ; + # +while (my ($k,$v) = each %hash ) { + $hash{uc $k} = $v ; + } + +while (my ($k,$v) = each %hash ) { + delete $hash{$k} if $k =~ tr/[a-z]// ; + } + ; +$hash{UID} ||= "$default_user" ; +$hash{PSWD} ||= "$default_pswd" ; +$hash{HOST} ||= hostname ; + # +while (my ($k,$v) = each %hash ) { + print "Running with $k set to $v\n" ; + } + # +my $domain = $hash{DOMAIN} or die "No mail domain provided.\n" ; +my $now = seconds($hash{DATE}) || time ; + # +my $six = $now - ( 6 * 24 * 60 * 60 ) ; +my $seven = $now - ( 7 * 24 * 60 * 60 ) ; +my $notthirty = $now - ( 29 * 24 * 60 * 60 ) ; +my $thirty = $now - ( 30 * 24 * 60 * 60 ) ; +my $notsixty = $now - ( 59 * 24 * 60 * 60 ) ; +my $sixty = $now - ( 60 * 24 * 60 * 60 ) ; +my $notd365 = $now - ( 364 * 24 * 60 * 60 ) ; +my $d365 = $now - ( 365 * 24 * 60 * 60 ) ; + # +$hash{SUBJECTS} = [ "Sixty days old", "Less than sixty days old" , + "365 days old", "Less than 365 days old" , + "Trash/Incinerator -- 7 days old" , + "Sent -- 29 days old" , + "Sent -- 30 days old" , + "Trash -- 6 days old" , + ] ; +$hash{FOLDERS} = [ "Sent", "INBOX", "Trash" , + "365_folder", "Trash/Incinerator" , + "not_365_folder" , + ] ; + # +&clean_mailbox if $hash{CLEANONLY} || $hash{CLEAN} ; +exit if $hash{CLEANONLY} ; + # +#send to: date: subject: # +#-------- --- ----- --------- # +sendmail( $hash{UID}, $sixty, "Sixty days old" ) ; +sendmail( $hash{UID}, $notsixty, "Less than sixty days old") ; +sendmail( $hash{UID}, $d365, "365 days old" ) ; +sendmail( $hash{UID}, $notd365, "Less than 365 days old" ) ; + # +populate_trash("Trash/Incinerator",$hash{UID}, $seven, 7 ) ; +populate_trash( "Trash" , $hash{UID}, $six, 6 ) ; +populate_trash( "Sent" , $hash{UID}, $thirty, 30 ) ; +populate_trash( "Sent" , $hash{UID}, $notthirty, 29 ) ; + # +movemail( "365 days old" , + "365_folder" ) ; + # +movemail( "Less than 365 days old" , + "not_365_folder" ) ; + # +exit ; + # + # +sub seconds { + my $d = shift or return undef ; + my($yy,$moy,$dom,$hr,$min) = + # + $d =~ m! ^ # anchor at start # + (\d\d\d\d) # year # + (\d\d) # month # + (\d\d) # day # + (\d\d) # hour # + (\d\d) # minute # + !x ; + # + return timegm(0,$min,$hr,$dom,$moy-1,($yy>99?$yy-1900:$yy)) ; + } + # +sub sendmail { + # + my($to,$date,$subject) = @_ ; + my $text = <new ( + Server => $hash{HOST} , + User => $hash{UID} , + Password=> $hash{PSWD} ) + or die "can't connect: $!\n" ; + # + $imap->append("INBOX",$text) ; + $imap->logout ; + } + } + # +sub populate_trash { + my $where = shift ; + my $to = shift ; + my $date = shift ; + my $d = shift ; + # + my($ss,$min,$hr,$day,$mon,$year)=gmtime($date) ; + $mon++ ; + $year += 1900 ; + my $fn =sprintf("%4.4d%2.2d%2.2d%2.2d%2.2d%2.2d" , + $year,$mon,$day,$hr,$min,$ss ) ; + my $x = 0 ; + my $subject = "$where -- $d days old" ; + while ($x++ < 10) { + my $fh ; + $fh .= "Date: @{[&rfc822_date($date)]}\n" ; + $fh .= <new ( + Server => $hash{HOST} , + User => $hash{UID} , + Password=> $hash{PSWD} ) + or die "can't connect: $!\n" ; + $imap->append($where, $fh) ; + # + } + # + } + # +sub movemail { + # + my ($subj,$fold) = @_ ; + my $fh = Mail::IMAPClient->new ( + Debug => 0 , + Server => $hash{HOST} , + User => $hash{UID} , + Password => $hash{PSWD} , + ) + ; + # + $fh->select("inbox") or die "cannot open inbox: $!\n" ; + # + foreach my $f ($fh->search(qq(SUBJECT "$subj")) ) { + # + $fh->move($fold,$f) ; + # + } + # + } + # +sub clean_mailbox { + # + my $fh =Mail::IMAPClient->new ( + Debug => 0 , + Server => $hash{HOST} , + User => $hash{UID} , + Password => $hash{PSWD} , + ) + ; + for my $x (@{$hash{FOLDERS}}) { + my @msgs ; + $fh->create($x) unless $fh->exists($x) ; + $fh->select($x) ; + for my $s (@{$hash{SUBJECTS}}) { + push @msgs, $fh->search(qq(SUBJECT "$s")) ; + } + $fh->delete_message(@msgs) if scalar(@msgs) ; + $fh->expunge ; + } + } + # +sub rfc822_date { +#Date: Fri, 09 Jul 1999 13:10:55 -0400 # +my $date = shift ; +my @date = localtime($date) ; +my @dow = qw{ Sun Mon Tue Wed Thu Fri Sat } ; +my @mnt = qw{ Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec} ; + # +return sprintf ( + "%s, %2.2d %s %4.4s %2.2d:%2.2d:%2.2d -0400" , + $dow[$date[6]] , + $date[3] , + $mnt[$date[4]] , + $date[5]+=1900 , + $date[2] , + $date[1] , + $date[0] ) + ; + } + + +=head1 AUTHOR + +David J. Kernen + +The Kernen Group, Inc. + +imap@kernengroup.com + +=head1 COPYRIGHT + +This example and Mail::IMAPClient are Copyright (c) 2003 +by The Kernen Group, Inc. All rights reserved. + +This example is distributed with Mail::IMAPClient and +subject to the same licensing requirements as Mail::IMAPClient. + +imtest is a utility distributed with Cyrus IMAP server, +Copyright (c) 1994-2000 Carnegie Mellon University. +All rights reserved. + +=cut + +# $Id: //depot/main/ZimbraPS/Mail-IMAPClient/examples/populate_mailbox.pl#1 $ +# $Log: populate_mailbox.pl,v $ +# Revision 19991216.8 2003/06/12 21:38:34 dkernen +# +# Preparing 2.2.8 +# Added Files: COPYRIGHT +# Modified Files: Parse.grammar +# Added Files: Makefile.old +# Makefile.PL Todo sample.perldb +# BodyStructure.pm +# Parse.grammar Parse.pod +# range.t +# Thread.grammar +# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt +# rfc2221.txt rfc2359.txt rfc2683.txt +# +# Revision 1.1 2003/06/12 21:38:16 dkernen +# +# Preparing 2.2.8 +# Added Files: COPYRIGHT +# Modified Files: Parse.grammar +# Added Files: Makefile.old +# Makefile.PL Todo sample.perldb +# BodyStructure.pm +# Parse.grammar Parse.pod +# range.t +# Thread.grammar +# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt +# rfc2221.txt rfc2359.txt rfc2683.txt +# +# Revision 19991216.7 2002/08/23 13:29:49 dkernen +# +# Modified Files: Changes IMAPClient.pm INSTALL MANIFEST Makefile Makefile.PL README Todo test.txt +# Made changes to create version 2.1.6. +# Modified Files: +# imap_to_mbox.pl populate_mailbox.pl +# Added Files: +# cleanTest.pl migrate_mbox.pl +# +# Revision 19991216.6 2000/12/11 21:58:53 dkernen +# +# Modified Files: +# build_dist.pl build_ldif.pl copy_folder.pl find_dup_msgs.pl +# imap_to_mbox.pl populate_mailbox.pl +# to add CVS data +# +# Revision 19991216.5 1999/12/16 17:19:15 dkernen +# Bring up to same level +# +# Revision 19991124.3 1999/12/16 17:14:26 dkernen +# Incorporate changes for exists method performance enhancement +# +# Revision 19991124.02 1999/11/24 17:46:21 dkernen +# More fixes to t/basic.t +# +# Revision 19991124.01 1999/11/24 16:51:51 dkernen +# Changed t/basic.t to test for UIDPLUS before trying UID cmds +# +# Revision 1.4 1999/11/23 17:51:06 dkernen +# Committing version 1.06 distribution copy +# diff --git a/Mail-IMAPClient-3.23/examples/sharedFolder.pl b/Mail-IMAPClient-3.23/examples/sharedFolder.pl new file mode 100644 index 0000000..96666cc --- /dev/null +++ b/Mail-IMAPClient-3.23/examples/sharedFolder.pl @@ -0,0 +1,88 @@ +#!/usr/local/bin/perl +#$Id: //depot/main/ZimbraPS/Mail-IMAPClient/examples/sharedFolder.pl#1 $ + +use Mail::IMAPClient; +use Getopt::Std; +use File::Basename; +getopts('s:u:p:f:dh'); + +if ($opt_h) { + + print STDERR "$0 -- example of how to select shared folder\n", + "\n\nUsage:\n", + "\t-s server -- specify name or ip address of mail server\n", + "\t-u userid -- specify login name of authenticating user\n", + "\t-p passwd -- specify login password of authenticating user\n", + "\t-f folder -- specify shared folder to access (i.e. '-f frank/INBOX')\n", + "\t-h display this help message\n\n"; + "\t-d turn on debugging output\n\n"; + exit; +} + +my $server = $opt_s or die "No server name specified\n"; +my $user = $opt_u or die "No user name specified\n"; +my $pass = $opt_p or die "No password specified\n"; +my $folder = $opt_f or die "No shared folder specified\n"; + +chomp $pass; +my $imap = Mail::IMAPClient->new(Server=>$server,User=>$user,Password=>$pass,Debug=>$opt_d) + or die "Can't connect to $user\@$server: $@ $!\n"; + +my($prefix,$prefSep) = @{$imap->namespace->[1][0]} + or die "Can't get shared folder namespace or separator: $@\n"; + + +my $target = $prefix . + ( $prefix =~ /\Q$prefSep\E$/ || $opt_f =~ /^\Q$prefSep/ ? "" : $prefSep ) . + $opt_f ; + +print "Selecting $target\n"; + +$imap->select($target) + or die "Cannot select $target: $@\n"; + +print "Ok: $target has ", $imap->message_count($target)," messages.\n"; + +$imap->logout; +exit; + + +=head1 AUTHOR + +David J. Kernen + +The Kernen Group, Inc. + +imap@kernengroup.com + +=head1 COPYRIGHT + +This example and Mail::IMAPClient are Copyright (c) 2003 +by The Kernen Group, Inc. All rights reserved. + +This example is distributed with Mail::IMAPClient and +subject to the same licensing requirements as Mail::IMAPClient. + +imtest is a utility distributed with Cyrus IMAP server, +Copyright (c) 1994-2000 Carnegie Mellon University. +All rights reserved. + +=cut + +# +#$Log: sharedFolder.pl,v $ +#Revision 19991216.1 2003/06/12 21:38:35 dkernen +# +#Preparing 2.2.8 +#Added Files: COPYRIGHT +#Modified Files: Parse.grammar +#Added Files: Makefile.old +# Makefile.PL Todo sample.perldb +# BodyStructure.pm +# Parse.grammar Parse.pod +# range.t +# Thread.grammar +# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt +# rfc2221.txt rfc2359.txt rfc2683.txt +# +# diff --git a/Mail-IMAPClient-3.23/lib/Mail/IMAPClient.pm b/Mail-IMAPClient-3.23/lib/Mail/IMAPClient.pm new file mode 100644 index 0000000..68366c9 --- /dev/null +++ b/Mail-IMAPClient-3.23/lib/Mail/IMAPClient.pm @@ -0,0 +1,3421 @@ + +# _{name} methods are undocumented and meant to be private. + +use strict; +use warnings; + +package Mail::IMAPClient; +our $VERSION = '3.23'; + +use Mail::IMAPClient::MessageSet; + +use IO::Socket qw(:crlf SOL_SOCKET SO_KEEPALIVE); +use IO::Select (); +use IO::File (); +use Carp qw(carp); #local $SIG{__WARN__} = \&Carp::cluck; #DEBUG + +use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK); +use Errno qw(EAGAIN EPIPE ECONNRESET); +use List::Util qw(first min max sum); +use MIME::Base64 qw(encode_base64 decode_base64); +use File::Spec (); + +use constant APPEND_BUFFER_SIZE => 1024 * 1024; + +use constant { + Unconnected => 0, + Connected => 1, # connected; not logged in + Authenticated => 2, # logged in; no mailbox selected + Selected => 3, # mailbox selected +}; + +use constant { + INDEX => 0, # Array index for output line number + TYPE => 1, # Array index for line type (OUTPUT, INPUT, or LITERAL) + DATA => 2, # Array index for output line data +}; + +use constant NonFolderArg => 1; # for Massage indicating non-folder arguments + +my %SEARCH_KEYS = map { ( $_ => 1 ) } qw( + ALL ANSWERED BCC BEFORE BODY CC DELETED DRAFT FLAGGED + FROM HEADER KEYWORD LARGER NEW NOT OLD ON OR RECENT + SEEN SENTBEFORE SENTON SENTSINCE SINCE SMALLER SUBJECT + TEXT TO UID UNANSWERED UNDELETED UNDRAFT UNFLAGGED + UNKEYWORD UNSEEN); + +# modules require(d) during runtime when applicable +my %Load_Module = ( + "SSL" => "IO::Socket::SSL", + "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; + + local ($@); # avoid stomping on global $@ + eval "require $module"; + if ($@) { + $self->LastError("Unable to load '$module': $@"); + 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 Debug + Debug_fh Domain Folder Ignoresizeerrors Keepalive + Maxcommandlength Maxtemperrors Password Peek Port + Prewritemethod Proxy Ranges Readmethod Reconnectretry + Server Showcredentials State Supportedflags Timeout Uid + User Ssl Starttls) + ) + { + no strict 'refs'; + *$datum = sub { + @_ > 1 ? ( $_[0]->{$datum} = $_[1] ) : $_[0]->{$datum}; + }; + } +} + +sub LastError { + my $self = shift; + @_ or return $self->{LastError}; + my $err = shift; + + # allow LastError to be reset with undef + if ( defined $err ) { + $err =~ s/$CRLF$//og; + local ($!); # old versions of Carp could reset $! + $self->_debug( Carp::longmess("ERROR: $err") ); + + # hopefully this is rare... + if ( $err eq "NO not connected" ) { + my $lerr = $self->{LastError} || ""; + my $emsg = "Trying command when NOT connected!"; + $emsg .= " LastError was: $lerr" if $lerr; + Carp::cluck($emsg); + } + } + $@ = $self->{LastError} = $err; +} + +sub Fast_io(;$) { + my ( $self, $use ) = @_; + defined $use + or return $self->{Fast_io}; + + my $socket = $self->{Socket} + or return undef; + + local ($@); # avoid stomping on global $@ + unless ($use) { + eval { fcntl( $socket, F_SETFL, delete $self->{_fcntl} ) } + if exists $self->{_fcntl}; + $self->{Fast_io} = 0; + return undef; + } + + my $fcntl = eval { fcntl( $socket, F_GETFL, 0 ) }; + if ($@) { + $self->{Fast_io} = 0; + $self->_debug("not using Fast_IO; not available on this platform") + unless $self->{_fastio_warning_}++; + return undef; + } + + $self->{Fast_io} = 1; + my $newflags = $self->{_fcntl} = $fcntl; + $newflags |= O_NONBLOCK; + fcntl( $socket, F_SETFL, $newflags ); +} + +# removed +sub EnableServerResponseInLiteral { undef } + +sub Wrap { shift->Clear(@_) } + +# The following class method is for creating valid dates in appended msgs: +my @dow = qw(Sun Mon Tue Wed Thu Fri Sat); +my @mnt = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); + +sub Rfc822_date { + my $class = shift; + my $date = $class =~ /^\d+$/ ? $class : shift; # method or function? + my @date = gmtime($date); + + #Date: Fri, 09 Jul 1999 13:10:55 -0000 + sprintf( + "%s, %02d %s %04d %02d:%02d:%02d -%04d", + $dow[ $date[6] ], + $date[3], + $mnt[ $date[4] ], + $date[5] + 1900, + $date[2], $date[1], $date[0], $date[8] + ); +} + +# The following methods create valid dates for use in IMAP search strings +# - provide Rfc2060* methods/functions for backwards compatibility +sub Rfc2060_date { + $_[0] =~ /^\d+$/ ? Rfc3501_date(@_) : shift->Rfc3501_date(@_); +} + +sub Rfc3501_date { + my $class = shift; + my $stamp = $class =~ /^\d+$/ ? $class : shift; + my @date = gmtime($stamp); + + # 11-Jan-2000 + sprintf( "%02d-%s-%04d", $date[3], $mnt[ $date[4] ], $date[5] + 1900 ); +} + +sub Rfc2060_datetime($;$) { + $_[0] =~ /^\d+$/ ? Rfc3501_datetime(@_) : shift->Rfc3501_datetime(@_); +} + +sub Rfc3501_datetime($;$) { + my $class = shift; + my $stamp = $class =~ /^\d+$/ ? $class : shift; + my $zone = shift || '+0000'; + my @date = gmtime($stamp); + + # 11-Jan-2000 04:04:04 +0000 + sprintf( + "%02d-%s-%04d %02d:%02d:%02d %s", + $date[3], + $mnt[ $date[4] ], + $date[5] + 1900, + $date[2], $date[1], $date[0], $zone + ); +} + +# Change CRLF into \n +sub Strip_cr { + my $class = shift; + if ( !ref $_[0] && @_ == 1 ) { + ( my $string = $_[0] ) =~ s/$CRLF/\n/og; + return $string; + } + + return wantarray + ? map { s/$CRLF/\n/og; $_ } ( ref $_[0] ? @{ $_[0] } : @_ ) + : [ map { s/$CRLF/\n/og; $_ } ( ref $_[0] ? @{ $_[0] } : @_ ) ]; +} + +# The following defines a special method to deal with the Clear parameter: +sub Clear { + my ( $self, $clear ) = @_; + defined $clear or return $self->{Clear}; + + my $oldclear = $self->{Clear}; + $self->{Clear} = $clear; + + my @keys = reverse $self->_trans_index; + + for ( my $i = $clear ; $i < @keys ; $i++ ) { + delete $self->{History}{ $keys[$i] }; + } + + return $oldclear; +} + +# read-only access to the transaction number +sub Transaction { shift->Count } + +# remove doubles from list +sub _remove_doubles(@) { + my %seen; + grep { !$seen{$_}++ } @_; +} + +# the constructor: +sub new { + my $class = shift; + my $self = { + LastError => "", + Uid => 1, + Count => 0, + Fast_io => 1, + Clear => 5, + Keepalive => 0, + Maxcommandlength => 1000, + Maxtemperrors => undef, + State => Unconnected, + Authmechanism => 'LOGIN', + Port => 143, + Timeout => 600, + History => {}, + }; + while (@_) { + my $k = ucfirst lc shift; + my $v = shift; + $self->{$k} = $v if defined $v; + } + bless $self, ref($class) || $class; + + if ( my $sup = $self->{Supportedflags} ) { # unpack into case-less HASH + my %sup = map { m/^\\?(\S+)/ ? lc $1 : () } @$sup; + $self->{Supportedflags} = \%sup; + } + + $self->{Debug_fh} ||= \*STDERR; + CORE::select( ( select( $self->{Debug_fh} ), $|++ )[0] ); + + if ( $self->Debug ) { + $self->_debug( "Started at " . localtime() ); + $self->_debug("Using Mail::IMAPClient version $VERSION on perl $]"); + } + + # BUG? return undef on Socket() failure? + $self->Socket( $self->{Socket} ) + if $self->{Socket}; + + if ( $self->{Rawsocket} ) { + my $sock = delete $self->{Rawsocket}; + + # Ignore Rawsocket if Socket is set. BUG? should we carp/croak? + $self->RawSocket($sock) unless $self->{Socket}; + } + + !$self->{Socket} && $self->{Server} ? $self->connect : $self; +} + +sub connect(@) { + my $self = shift; + + # BUG? We should restrict which keys can be passed/set here. + %$self = ( %$self, @_ ) if @_; + + my $server = $self->Server; + my $port = $self->Port; + my @timeout = $self->Timeout ? ( Timeout => $self->Timeout ) : (); + my $sock; + + if ( File::Spec->file_name_is_absolute($server) ) { + $self->_debug("Connecting to unix socket $server @timeout"); + $sock = IO::Socket::UNIX->new( + Peer => $server, + Debug => $self->Debug, + @timeout + ); + } + else { + my $ioclass = "IO::Socket::INET"; + if ( $self->Ssl ) { + $ioclass = $self->_load_module("SSL") or return undef; + } + + $self->_debug("Connecting via $ioclass to $server:$port @timeout"); + $sock = $ioclass->new( + PeerAddr => $server, + PeerPort => $port, + Proto => 'tcp', + Debug => $self->Debug, + @timeout + ); + } + + unless ($sock) { + $self->LastError("Unable to connect to $server: $@"); + return undef; + } + + $self->_debug( "Connected to $server" . ( $! ? " errno($!)" : "" ) ); + $self->Socket($sock); +} + +sub RawSocket(;$) { + my ( $self, $sock ) = @_; + defined $sock + or return $self->{Socket}; + + $self->{Socket} = $sock; + $self->{_select} = IO::Select->new($sock); + + delete $self->{_fcntl}; + $self->Fast_io( $self->Fast_io ); + + $sock; +} + +sub Socket($) { + my ( $self, $sock ) = @_; + defined $sock + or return $self->{Socket}; + + $self->RawSocket($sock); + $self->State(Connected); + + setsockopt( $sock, SOL_SOCKET, SO_KEEPALIVE, 1 ) if $self->Keepalive; + + # LastError may be set by _read_line via _get_response + # look for "* (OK|BAD|NO|PREAUTH)" + my $code = $self->_get_response( '*', 'PREAUTH' ) or return undef; + + if ( $code eq 'BYE' || $code eq 'NO' ) { + $self->State(Unconnected); + return undef; + } + elsif ( $code eq 'PREAUTH' ) { + $self->State(Authenticated); + return $self; + } + + if ( $self->Starttls ) { + $self->starttls or return undef; + } + + $self->User && $self->Password ? $self->login : $self; +} + +# 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; +} + +sub login { + my $self = shift; + my $auth = $self->Authmechanism; + return $self->authenticate( $auth, $self->Authcallback ) + if $auth && $auth ne 'LOGIN'; + + my $passwd = $self->Password; + my $id = $self->User; + + return undef unless ( defined($passwd) and defined($id) ); + + # BUG: should use Quote() with $passwd and $id + if ( $passwd eq "" or $passwd =~ m/\W/ ) { + $passwd =~ s/(["\\])/\\$1/g; + $passwd = qq("$passwd"); + } + + $id = qq("$id") if $id !~ /^".*"$/; + + $self->_imap_command("LOGIN $id $passwd") + or return undef; + + $self->State(Authenticated); + $self; +} + +sub noop { + my ( $self, $user ) = @_; + $self->_imap_command("NOOP") ? $self->Results : undef; +} + +sub proxyauth { + my ( $self, $user ) = @_; + $self->_imap_command("PROXYAUTH $user") ? $self->Results : undef; +} + +sub separator { + my ( $self, $target ) = @_; + unless ( defined $target ) { + + # separator is namespace's 1st thing's 1st thing's 2nd thing: + my $ns = $self->namespace or return undef; + if ($ns) { + my $sep = $ns->[0][0][1]; + return $sep if $sep; + } + $target = ''; + } + + return $self->{separators}{$target} + if exists $self->{separators}{$target}; + + my $list = $self->list( undef, $target ) or return undef; + + foreach my $line (@$list) { + my $rec = $self->_list_or_lsub_response_parse($line); + next unless defined $rec->{name}; + $self->{separators}{ $rec->{name} } = $rec->{delim}; + } + return $self->{separators}{$target}; +} + +# BUG? caller gets empty list even if Error +# - returning an array with a single undef value seems even worse though +sub sort { + my ( $self, $crit, @a ) = @_; + + $crit =~ /^\(.*\)$/ # wrap criteria in parens + or $crit = "($crit)"; + + my @hits; + if ( $self->_imap_uid_command( SORT => $crit, @a ) ) { + my @results = $self->History; + foreach (@results) { + chomp; + s/$CR$//; + s/^\*\s+SORT\s+// or next; + push @hits, grep /\d/, split; + } + } + return wantarray ? @hits : \@hits; +} + +sub _list_or_lsub { + my ( $self, $cmd, $reference, $target ) = @_; + defined $reference or $reference = ''; + defined $target or $target = '*'; + length $target or $target = '""'; + + $target eq '*' || $target eq '""' + or $target = $self->Massage($target); + + $self->_imap_command(qq($cmd "$reference" $target)) + or return undef; + + # cleanup any literal data that may be returned + my $ret = wantarray ? [ $self->History ] : $self->Results; + if ($ret) { + my $cmd = wantarray ? undef : shift @$ret; + $self->_list_response_preprocess($ret); + unshift( @$ret, $cmd ) if defined($cmd); + } + + #return wantarray ? $self->History : $self->Results; + return wantarray ? @$ret : $ret; +} + +sub list { shift->_list_or_lsub( "LIST", @_ ) } +sub lsub { shift->_list_or_lsub( "LSUB", @_ ) } + +sub xlist { + my ($self) = @_; + return undef unless $self->has_capability("XLIST"); + shift->_list_or_lsub( "XLIST", @_ ); +} + +sub _folders_or_subscribed { + my ( $self, $method, $what ) = @_; + my @folders; + + # do BLOCK allowing use of "last if undef/error" and avoiding dup code + do { + { + my @list; + if ($what) { + my $sep = $self->separator($what); + last unless defined $sep; + + my $whatsub = $what =~ m/\Q${sep}\E$/ ? "$what*" : "$what$sep*"; + + my $tref = $self->$method( undef, $whatsub ) or last; + shift @$tref; # remove command + push @list, @$tref; + + my $exists = $self->exists($what) or last; + if ($exists) { + $tref = $self->$method( undef, $what ) or last; + shift @$tref; # remove command + push @list, @$tref; + } + } + else { + my $tref = $self->$method( undef, undef ) or last; + shift @$tref; # remove command + push @list, @$tref; + } + + foreach my $resp (@list) { + my $rec = $self->_list_or_lsub_response_parse($resp); + next unless defined $rec->{name}; + push @folders, $rec->{name}; + } + } + }; + + my @clean = _remove_doubles @folders; + return wantarray ? @clean : \@clean; +} + +sub folders { + my ( $self, $what ) = @_; + + return wantarray ? @{ $self->{Folders} } : $self->{Folders} + if !$what && $self->{Folders}; + + my @folders = $self->_folders_or_subscribed( "list", $what ); + $self->{Folders} = \@folders unless $what; + return wantarray ? @folders : \@folders; +} + +sub xlist_folders { + my ($self) = @_; + my $xlist = $self->xlist; + return undef unless defined $xlist; + + my %xlist; + my $xlist_re = qr/\A\\(Inbox|AllMail|Trash|Drafts|Sent|Spam|Starred)\Z/; + + for my $resp (@$xlist) { + my $rec = $self->_list_or_lsub_response_parse($resp); + next unless defined $rec->{name}; + for my $attr ( @{ $rec->{attrs} } ) { + $xlist{$1} = $rec->{name} if ( $attr =~ $xlist_re ); + } + } + + return wantarray ? %xlist : \%xlist; +} + +sub subscribed { + my ( $self, $what ) = @_; + my @folders = $self->_folders_or_subscribed( "lsub", $what ); + return wantarray ? @folders : \@folders; +} + +# BUG? cleanup escaping/quoting +sub deleteacl { + my ( $self, $target, $user ) = @_; + $target = $self->Massage($target); + $user =~ s/^"(.*)"$/$1/; + $user =~ s/"/\\"/g; + + $self->_imap_command(qq(DELETEACL $target "$user")) + or return undef; + + return wantarray ? $self->History : $self->Results; +} + +# BUG? cleanup escaping/quoting +sub setacl { + my ( $self, $target, $user, $acl ) = @_; + $target ||= $self->Folder; + $target = $self->Massage($target); + + $user ||= $self->User; + $user =~ s/^"(.*)"$/$1/; + $user =~ s/"/\\"/g; + + $acl =~ s/^"(.*)"$/$1/; + $acl =~ s/"/\\"/g; + + $self->_imap_command(qq(SETACL $target "$user" "$acl")) + or return undef; + + return wantarray ? $self->History : $self->Results; +} + +sub getacl { + my ( $self, $target ) = @_; + defined $target or $target = $self->Folder; + my $mtarget = $self->Massage($target); + $self->_imap_command(qq(GETACL $mtarget)) + or return undef; + + my @history = $self->History; + my $hash; + for ( my $x = 0 ; $x < @history ; $x++ ) { + next if $history[$x] !~ /^\* ACL/; + + my $perm = + $history[$x] =~ /^\* ACL $/ + ? $history[ ++$x ] . $history[ ++$x ] + : $history[$x]; + + $perm =~ s/\s?$CRLF$//o; + until ( $perm =~ /\Q$target\E"?$/ || !$perm ) { + $perm =~ s/\s([^\s]+)\s?$// or last; + my $p = $1; + $perm =~ s/\s([^\s]+)\s?$// or last; + my $u = $1; + $hash->{$u} = $p; + $self->_debug("Permissions: $u => $p"); + } + } + return $hash; +} + +sub listrights { + my ( $self, $target, $user ) = @_; + $target ||= $self->Folder; + $target = $self->Massage($target); + + $user ||= $self->User; + $user =~ s/^"(.*)"$/$1/; + $user =~ s/"/\\"/g; + + $self->_imap_command(qq(LISTRIGHTS $target "$user")) + or return undef; + + my $resp = first { /^\* LISTRIGHTS/ } $self->History; + my @rights = split /\s/, $resp; + my $rights = join '', @rights[ 4 .. $#rights ]; + $rights =~ s/"//g; + return wantarray ? split( //, $rights ) : $rights; +} + +sub select { + my ( $self, $target ) = @_; + defined $target or return undef; + + my $qqtarget = $self->Massage($target); + my $old = $self->Folder; + + $self->_imap_command("SELECT $qqtarget") + or return undef; + + $self->State(Selected); + $self->Folder($target); + return $old || $self; # ??$self?? +} + +sub message_string { + my ( $self, $msg ) = @_; + + return undef unless defined $self->imap4rev1; + my $peek = $self->Peek ? '.PEEK' : ''; + my $cmd = $self->imap4rev1 ? "BODY$peek\[]" : "RFC822$peek"; + + $self->fetch( $msg, $cmd ) + or return undef; + + my $string = $self->_transaction_literals; + + unless ( $self->Ignoresizeerrors ) { # Check size with expected size + my $expected_size = $self->size($msg); + return undef unless defined $expected_size; + + # RFC822.SIZE may be wrong, see RFC2683 3.4.5 "RFC822.SIZE" + if ( length($string) != $expected_size ) { + $self->LastError( "message_string() " + . "expected $expected_size bytes but received " + . length($string) + . " you may need the IgnoreSizeErrors option" ); + return undef; + } + } + + return $string; +} + +sub bodypart_string { + my ( $self, $msg, $partno, $bytes, $offset ) = @_; + + unless ( $self->imap4rev1 ) { + $self->LastError( "Unable to get body part; server " + . $self->Server + . " does not support IMAP4REV1" ) + unless $self->LastError; + return undef; + } + + $offset ||= 0; + my $cmd = "BODY" + . ( $self->Peek ? '.PEEK' : '' ) + . "[$partno]" + . ( $bytes ? "<$offset.$bytes>" : '' ); + + $self->fetch( $msg, $cmd ) + or return undef; + + $self->_transaction_literals; +} + +sub message_to_file { + my $self = shift; + my $fh = shift; + my $msgs = join ',', @_; + + my $handle; + if ( ref $fh ) { $handle = $fh } + else { + $handle = IO::File->new(">>$fh"); + unless ( defined($handle) ) { + $self->LastError("Unable to open $fh: $!"); + return undef; + } + binmode $handle; # For those of you who need something like this... + } + + my $clear = $self->Clear; + $self->Clear($clear) + if $self->Count >= $clear && $clear > 0; + + return undef unless defined $self->imap4rev1; + my $peek = $self->Peek ? '.PEEK' : ''; + my $cmd = $self->imap4rev1 ? "BODY$peek\[]" : "RFC822$peek"; + + my $uid = $self->Uid ? "UID " : ""; + my $trans = $self->Count( $self->Count + 1 ); + my $string = "$trans ${uid}FETCH $msgs $cmd"; + + $self->_record( $trans, [ 0, "INPUT", $string ] ); + + my $feedback = $self->_send_line($string); + unless ($feedback) { + $self->LastError( "Error sending '$string': " . $self->LastError ); + return undef; + } + + # look for " (OK|BAD|NO)" + my $code = $self->_get_response( { outref => $handle }, $trans ) + or return undef; + + return $code eq 'OK' ? $self : undef; +} + +sub message_uid { + my ( $self, $msg ) = @_; + + my $ref = $self->fetch( $msg, "UID" ) or return undef; + foreach (@$ref) { + return $1 if m/\(UID\s+(\d+)\s*\)$CR?$/o; + } + return undef; +} + +#???? this code is very clumsy, and currently probably broken. +# Why not use a pipe??? +# Is a quadratic slowdown not much simpler and better??? +# Shouldn't the slowdowns extend over multiple messages? +# --> create clean read and write methods + +sub migrate { + my ( $self, $peer, $msgs, $folder ) = @_; + my $toSock = $peer->Socket, my $fromSock = $self->Socket; + my $bufferSize = $self->Buffer || 4096; + + local $SIG{PIPE} = 'IGNORE'; # avoid SIGPIPE on syswrite, handle as error + + unless ( $peer and $peer->IsConnected ) { + $self->LastError( "Invalid or unconnected peer " + . ref($self) + . " object used as target for migrate. $@" ); + return undef; + } + + unless ($folder) { + unless ( $folder = $self->Folder ) { + $self->LastError("No folder selected on source mailbox."); + return undef; + } + + unless ( $peer->exists($folder) || $peer->create($folder) ) { + $self->LastError( "Unable to create folder '$folder' on target " + . "mailbox: " + . $peer->LastError ); + return undef; + } + } + + defined $msgs or $msgs = "ALL"; + $msgs = $self->search("ALL") + if uc $msgs eq 'ALL'; + return undef unless defined $msgs; + + my $range = $self->Range($msgs); + my $clear = $self->Clear; + + $self->_debug("Migrating the following msgs from $folder: $range"); + MSG: + foreach my $mid ( $range->unfold ) { + $self->_debug("Migrating message $mid in folder $folder"); + + my $leftSoFar = my $size = $self->size($mid); + return undef unless defined $size; + + # fetch internaldate and flags of original message: + my $intDate = $self->internaldate($mid); + return undef unless defined $intDate; + + my @flags = grep !/\\Recent/i, $self->flags($mid); + my $flags = join ' ', $peer->supported_flags(@flags); + + # set up transaction numbers for from and to connections: + my $trans = $self->Count( $self->Count + 1 ); + my $ptrans = $peer->Count( $peer->Count + 1 ); + + # If msg size is less than buffersize then do whole msg in one + # transaction: + if ( $size <= $bufferSize ) { + my $new_mid = + $peer->append_string( $folder, $self->message_string($mid), + $flags, $intDate ); + + unless ( defined $new_mid ) { + $self->LastError( "Unable to append to $folder " + . "on target mailbox. " + . $peer->LastError ); + return undef; + } + + $self->_debug( "Copied message $mid in folder $folder to " + . $peer->User . '@' + . $peer->Server + . ". New message UID is $new_mid" ) + if $self->Debug; + + $peer->_debug( "Copied message $mid in folder $folder from " + . $self->User . '@' + . $self->Server + . ". New message UID is $new_mid" ) + if $peer->Debug; + + next MSG; + } + + # otherwise break it up into digestible pieces: + return undef unless defined $self->imap4rev1; + my ( $cmd, $extract_size ); + if ( $self->imap4rev1 ) { + $cmd = $self->Peek ? 'BODY.PEEK[]' : 'BODY[]'; + $extract_size = sub { $_[0] =~ /\(.*BODY\[\]<\d+> \{(\d+)\}/i; $1 }; + } + else { + $cmd = $self->Peek ? 'RFC822.PEEK' : 'RFC822'; + $extract_size = sub { $_[0] =~ /\(RFC822\[\]<\d+> \{(\d+)\}/i; $1 }; + } + + # Now let's warn the peer that there's a message coming: + my $pstring = + "$ptrans APPEND " + . $self->Massage($folder) + . ( length $flags ? " ($flags)" : '' ) + . qq( "$intDate" {$size}); + + $self->_debug("About to issue APPEND command to peer for msg $mid"); + + $peer->_record( $ptrans, [ 0, "INPUT", $pstring ] ); + unless ( $peer->_send_line($pstring) ) { + $self->LastError( "Error sending '$pstring': " . $self->LastError ); + return undef; + } + + # Get the "+ Go ahead" response: + my $code; + until ( defined $code ) { + my $readSoFar = 0; + my $fromBuffer = ''; + $readSoFar += sysread( $toSock, $fromBuffer, 1, $readSoFar ) || 0 + until $fromBuffer =~ /$CRLF/o; + + $code = + $fromBuffer =~ /^\+/ ? 'OK' + : $fromBuffer =~ /^\d+\s+(BAD|NO|OK)\b/ ? $1 + : undef; + + $peer->_debug("$folder: received $fromBuffer from server"); + + if ( $fromBuffer =~ /^(\*\s+BYE.*?)$CR?$LF/oi ) { + $self->State(Unconnected); + $self->LastError($1); + return undef; + } + + # ... and log it in the history buffers + $self->_record( + $trans, + [ + 0, + "OUTPUT", +"Mail::IMAPClient migrating message $mid to $peer->User\@$peer->Server" + ] + ); + $peer->_record( $ptrans, [ 0, "OUTPUT", $fromBuffer ] ); + } + + if ( $code ne 'OK' ) { + $self->_debug("Error writing to target host: $@"); + next MIGMSG; + } + + # Here is where we start sticking in UID if that parameter + # is turned on: + my $string = ( $self->Uid ? "UID " : "" ) . "FETCH $mid $cmd"; + + # Clean up history buffer if necessary: + $self->Clear($clear) + if $self->Count >= $clear && $clear > 0; + + # position will tell us how far from beginning of msg the + # next IMAP FETCH should start (1st time start at offset zero): + my $position = 0; + my $chunkCount = 0; + my $readSoFar = 0; + while ( $leftSoFar > 0 ) { + my $take = min $leftSoFar, $bufferSize; + my $newstring = "$trans $string<$position.$take>"; + + $self->_record( $trans, [ 0, "INPUT", $newstring ] ); + $self->_debug("Issuing migration command: $newstring"); + + unless ( $self->_send_line($newstring) ) { + $self->LastError( "Error sending '$newstring' to source IMAP: " + . $self->LastError ); + return undef; + } + + my $chunk; + my $fromBuffer = ""; + until ( $chunk = $extract_size->($fromBuffer) ) { + $fromBuffer = ''; + sysread( $fromSock, $fromBuffer, 1, length $fromBuffer ) + until $fromBuffer =~ /$CRLF$/o; + + $self->_record( $trans, [ 0, "OUTPUT", $fromBuffer ] ); + + if ( $fromBuffer =~ /^$trans\s+(?:NO|BAD)/ ) { + $self->LastError($fromBuffer); + next MIGMSG; + } + elsif ( $fromBuffer =~ /^$trans\s+OK/ ) { + $self->LastError( "Unexpected good return code " + . "from source host: $fromBuffer" ); + next MIGMSG; + } + } + + $fromBuffer = ""; + while ( $readSoFar < $chunk ) { + $readSoFar += + sysread( $fromSock, $fromBuffer, $chunk - $readSoFar, + $readSoFar ) + || 0; + } + + my $wroteSoFar = 0; + my $temperrs = 0; + my $waittime = .02; + my $maxwrite = 0; + my $maxagain = $self->Maxtemperrors; + undef $maxagain if $maxagain and lc($maxagain) eq 'unlimited'; + my @previous_writes; + + while ( $wroteSoFar < $chunk ) { + while ( $wroteSoFar < $readSoFar ) { + my $ret = + syswrite( $toSock, $fromBuffer, $chunk - $wroteSoFar, + $wroteSoFar ); + + if ( defined $ret ) { + $wroteSoFar += $ret; + $maxwrite = max $maxwrite, $ret; + $temperrs = 0; + } + + if ( $! == EPIPE or $! == ECONNRESET ) { + $self->State(Unconnected); + $self->LastError("Write failed '$!'"); + return undef; + } + + if ( $! == EAGAIN || $ret == 0 ) { + if ( defined $maxagain && $temperrs++ > $maxagain ) { + $self->LastError("Persistent error '$!'"); + return undef; + } + + $waittime = $self->_optimal_sleep( $maxwrite, $waittime, + \@previous_writes ); + next; + } + + $self->State(Unconnected) + if ( $! == EPIPE or $! == ECONNRESET ); + $self->LastError("Write failed '$!'"); + return; # no luck + } + + $peer->_debug( + "Chunk $chunkCount: wrote $wroteSoFar (of $chunk)"); + } + } + + $position += $readSoFar; + $leftSoFar -= $readSoFar; + my $fromBuffer = ""; + + # Finish up reading the server fetch response from the source system: + # look for " (OK|BAD|NO)" + $self->_debug("Reading from source: expecting 'OK' response"); + $code = $self->_get_response($trans) or return undef; + return undef unless $code eq 'OK'; + + # Now let's send a CRLF to the peer to signal end of APPEND cmd: + unless ( $peer->_send_bytes( \$CRLF ) ) { + $self->LastError( "Error appending CRLF: " . $self->LastError ); + return undef; + } + + # Finally, let's get the new message's UID from the peer: + # look for " (OK|BAD|NO)" + $peer->_debug("Reading from target: expect new uid in response"); + $code = $peer->_get_response($ptrans) or return undef; + + my $new_mid = "unknown"; + if ( $code eq 'OK' ) { + my $data = join '', $self->Results; + + # look for something like return size or self if no size found: + # OK [APPENDUID ] APPEND completed + my $ret = $data =~ m#\s+(\d+)\]# ? $1 : undef; + $new_mid = $ret; + } + + if ( $self->Debug ) { + $self->_debug( "Copied message $mid in folder $folder to " + . $peer->User . '@' + . $peer->Server + . ". New Message UID is $new_mid" ); + + $peer->_debug( "Copied message $mid in folder $folder from " + . $self->User . '@' + . $self->Server + . ". New Message UID is $new_mid" ); + } + } + + return $self; +} + +# Optimization of wait time between syswrite calls only runs if syscalls +# run too fast and fill the buffer causing "EAGAIN: Resource Temp. Unavail" +# errors. The premise is that $maxwrite will be approx. the same as the +# smallest buffer between the sending and receiving side. Waiting time +# between syscalls should ideally be exactly as long as it takes the +# receiving side to empty that buffer, minus a little bit to prevent it +# from emptying completely and wasting time in the select call. + +sub _optimal_sleep($$$) { + my ( $self, $maxwrite, $waittime, $last5writes ) = @_; + + push @$last5writes, $waittime; + shift @$last5writes if @$last5writes > 5; + + my $bufferavail = ( sum @$last5writes ) / @$last5writes; + + if ( $bufferavail < .4 * $maxwrite ) { + + # Buffer is staying pretty full; we should increase the wait + # period to reduce transmission overhead/number of packets sent + $waittime *= 1.3; + } + elsif ( $bufferavail > .9 * $maxwrite ) { + + # Buffer is nearly or totally empty; we're wasting time in select + # call that could be used to send data, so reduce the wait period + $waittime *= .5; + } + + CORE::select( undef, undef, undef, $waittime ); + $waittime; +} + +sub body_string { + my ( $self, $msg ) = @_; + my $ref = + $self->fetch( $msg, "BODY" . ( $self->Peek ? ".PEEK" : "" ) . "[TEXT]" ) + or return undef; + + my $string = join '', map { $_->[DATA] } + grep { $self->_is_literal($_) } @$ref; + + return $string + if $string; + + my $head; + while ( $head = shift @$ref ) { + $self->_debug("body_string: head = '$head'"); + + last + if $head =~ + /(?:.*FETCH .*\(.*BODY\[TEXT\])|(?:^\d+ BAD )|(?:^\d NO )/i; + } + + unless (@$ref) { + $self->LastError( + "Unable to parse server response from " . $self->LastIMAPCommand ); + return undef; + } + + my $popped; + $popped = pop @$ref # (-: vi + until ( $popped && $popped =~ /\)$CRLF$/o ) # (-: vi + || !grep /\)$CRLF$/o, @$ref; + + if ( $head =~ /BODY\[TEXT\]\s*$/i ) { # Next line is a literal + $string .= shift @$ref while @$ref; + $self->_debug("String is now $string") + if $self->Debug; + } + + $string; +} + +sub examine { + my ( $self, $target ) = @_; + defined $target or return undef; + + $self->_imap_command( 'EXAMINE ' . $self->Massage($target) ) + or return undef; + + my $old = $self->Folder; + $self->Folder($target); + $self->State(Selected); + $old || $self; +} + +sub idle { + my $self = shift; + my $good = '+'; + my $count = $self->Count + 1; + $self->_imap_command( "IDLE", $good ) ? $count : undef; +} + +sub idle_data { + my $self = shift; + my $timeout = defined( $_[0] ) ? shift : 0.025; + my $socket = $self->Socket; + + # current index in Results array + my $trans_c1 = $self->_next_index; + + # look for all untagged responses + my $rc; + while ( + ( + $rc = + $self->_read_more( { error_on_timeout => 0 }, $socket, $timeout ) + ) > 0 + ) + { + $self->_get_response( '*', qr/\S+/ ) or return undef; + } + + # 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; + $self->_imap_command( { addtag => 0, tag => $count }, "DONE" ) + or return undef; + return $self->Results; +} + +sub tag_and_run { + my ( $self, $string, $good ) = @_; + $self->_imap_command( $string, $good ) or return undef; + return $self->Results; +} + +sub reconnect { + my $self = shift; + + if ( $self->IsAuthenticated ) { + $self->_debug("reconnect called but already authenticated"); + return $self; + } + + my $einfo = $self->LastError || ""; + $self->_debug( "reconnecting to ", $self->Server, ", last error: $einfo" ); + + # reconnect and select appropriate folder + $self->connect or return undef; + + return ( defined $self->Folder ) ? $self->select( $self->Folder ) : $self; +} + +# wrapper for _imap_command_do to enable retrying on lost connections +sub _imap_command { + my $self = shift; + + my $tries = 0; + my $retry = $self->Reconnectretry || 0; + my ( $rc, @err ); + + # LastError (if set) will be overwritten masking any earlier errors + while ( $tries++ <= $retry ) { + + # do command on the first try or if Connected (reconnect ongoing) + if ( $tries == 1 or $self->IsConnected ) { + $rc = $self->_imap_command_do(@_); + push( @err, $self->LastError ) if $self->LastError; + } + + if ( !defined($rc) and $retry and $self->IsUnconnected ) { + last + unless ( + $! == EPIPE + or $! == ECONNRESET + or $self->LastError =~ /(?: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/ + ); + if ( $self->reconnect ) { + $self->_debug("reconnect successful on try #$tries"); + } + else { + $self->_debug("reconnect failed on try #$tries"); + push( @err, $self->LastError ) if $self->LastError; + } + } + else { + last; + } + } + + unless ($rc) { + my ( %seen, @keep, @info ); + + foreach my $str (@err) { + my ( $sz, $len ) = ( 96, length($str) ); + $str =~ s/$CR?$LF$/\\n/omg; + if ( !$self->Debug and $len > $sz * 2 ) { + my $beg = substr( $str, 0, $sz ); + my $end = substr( $str, -$sz, $sz ); + $str = $beg . "..." . $end; + } + next if $seen{$str}++; + push( @keep, $str ); + } + foreach my $msg (@keep) { + push( @info, $msg . ( $seen{$msg} > 1 ? " ($seen{$msg}x)" : "" ) ); + } + $self->LastError( join( "; ", @info ) ); + } + + return $rc; +} + +# _imap_command_do runs a command, inserting a tag and CRLF as requested +# options: +# addcrlf => 0|1 - suppress adding CRLF to $string +# addtag => 0|1 - suppress adding $tag to $string +# tag => $tag - use this $tag instead of incrementing $self->Count +sub _imap_command_do { + my $self = shift; + my $opt = ref( $_[0] ) eq "HASH" ? shift : {}; + my $string = shift or return undef; + my $good = shift; + + $opt->{addcrlf} = 1 unless exists $opt->{addcrlf}; + $opt->{addtag} = 1 unless exists $opt->{addtag}; + + # reset error in case the last error was non-fatal but never cleared + if ( $self->LastError ) { + + #DEBUG $self->_debug( "Reset LastError: " . $self->LastError ); + $self->LastError(undef); + } + + my $clear = $self->Clear; + $self->Clear($clear) + if $self->Count >= $clear && $clear > 0; + + my $count = $self->Count( $self->Count + 1 ); + my $tag = $opt->{tag} || $count; + $string = "$tag $string" if $opt->{addtag}; + + # for APPEND (append_string) only log first line of command + my $logstr = ( $string =~ /^($tag\s+APPEND\s+.*?)$CR?$LF/ ) ? $1 : $string; + + # BUG? use $self->_next_index($tag) ? or 0 ??? + # $self->_record($tag, [$self->_next_index($tag), "INPUT", $logstr] ); + $self->_record( $count, [ 0, "INPUT", $logstr ] ); + + # $suppress (adding CRLF) set to 0 if $opt->{addcrlf} is TRUE + unless ( $self->_send_line( $string, $opt->{addcrlf} ? 0 : 1 ) ) { + $self->LastError( "Error sending '$logstr': " . $self->LastError ); + return undef; + } + + # look for " (OK|BAD|NO|$good)" (or "+..." if $good is '+') + my $code = $self->_get_response( $tag, $good ) or return undef; + + if ( $code eq 'OK' ) { + return $self; + } + elsif ( $good and $code eq $good ) { + return $self; + } + else { + return undef; + } +} + +# _get_response get IMAP response optionally send data somewhere +# options: +# outref => GLOB|CODE - reference to send output to (see _read_line) +sub _get_response { + my $self = shift; + my $opt = ref( $_[0] ) eq "HASH" ? shift : {}; + my $tag = shift; + my $good = shift; + + # tag can be a ref (compiled regex) or we quote it or default to \S+ + my $qtag = ref($tag) ? $tag : defined($tag) ? quotemeta($tag) : qr/\S+/; + my $qgood = ref($good) ? $good : defined($good) ? quotemeta($good) : undef; + my @readopt = defined( $opt->{outref} ) ? ( $opt->{outref} ) : (); + + my ( $count, $out, $code, $byemsg ) = ( $self->Count, [], undef, undef ); + until ($code) { + my $output = $self->_read_line(@readopt) or return undef; + $out = $output; # keep last response just in case + + # not using last on first match? paranoia or right thing? + # only uc() when match is not on case where $tag|$good is a ref() + foreach my $o (@$output) { + $self->_record( $count, $o ); + $self->_is_output($o) or next; + + my $data = $o->[DATA]; + if ( $good and $good ne '+' and $data =~ /^$qtag\s+($qgood)/i ) { + $code = $1; + $code = uc($code) unless ref($good); + } + elsif ( $good and $good eq '+' and $data =~ /^$qgood/ ) { + $code = $good; + } + elsif ( $tag eq '+' and $data =~ /^$qtag/ ) { + $code = $tag; + } + elsif ( $data =~ /^$qtag\s+(OK|BAD|NO)\b/i ) { + $code = uc($1); + $self->LastError($data) unless ( $code eq 'OK' ); + } + elsif ( $data =~ /^\*\s+(BYE)\b/i ) { + $code = uc($1); + $byemsg = $data; + } + } + } + + if ($code) { + $code =~ s/$CR?$LF?$//o; + $code = uc($code) unless ( $good and $code eq $good ); + + # on successful LOGOUT $code is OK (not BYE!) see RFC 3501 sect 7.1.5 + if ( $code eq 'BYE' ) { + $self->State(Unconnected); + $self->LastError($byemsg) if $byemsg; + } + } + elsif ( !$self->LastError ) { + my $info = "unexpected response: " . join( " ", @$out ); + $self->LastError($info); + } + + return $code; +} + +sub _imap_uid_command { + my ( $self, $cmd ) = ( shift, shift ); + my $args = @_ ? join( " ", '', @_ ) : ''; + my $uid = $self->Uid ? 'UID ' : ''; + $self->_imap_command("$uid$cmd$args"); +} + +sub run { + my $self = shift; + my $string = shift or return undef; + + my $tag = $string =~ /^(\S+) / ? $1 : undef; + unless ($tag) { + $self->LastError("No tag found in string passed to run(): $string"); + return undef; + } + + $self->_imap_command( { addtag => 0, addcrlf => 0, tag => $tag }, $string ) + or return undef; + + $self->{History}{$tag} = $self->{History}{ $self->Count } + unless $tag eq $self->Count; + + return $self->Results; +} + +# _record saves the conversation into the History structure: +sub _record { + my ( $self, $count, $array ) = @_; + if ( $array->[DATA] =~ /^\d+ LOGIN/i && !$self->Showcredentials ) { + $array->[DATA] =~ s/LOGIN.*/LOGIN XXXXXXXX XXXXXXXX/i; + } + + push @{ $self->{History}{$count} }, $array; +} + +# _send_line handles literal data and supports the Prewritemethod +sub _send_line { + my ( $self, $string, $suppress ) = ( shift, shift, shift ); + + $string =~ s/$CR?$LF?$/$CRLF/o + unless $suppress; + + # handle case where string contains a literal + if ( $string =~ s/^([^$LF\{]*\{\d+\}$CRLF)(?=.)//o ) { + my $first = $1; + $self->_debug("Sending literal: $first\tthen: $string"); + $self->_send_line($first) or return undef; + + # look for " OK|NO|BAD" or "+..." + my $code = $self->_get_response( qr(\S+), '+' ) or return undef; + return undef unless $code eq '+'; + } + + # non-literal part continues... + unless ( $self->IsConnected ) { + $self->LastError("NO not connected"); + return undef; + } + + if ( my $prew = $self->Prewritemethod ) { + $string = $prew->( $self, $string ); + } + + $self->_debug("Sending: $string"); + $self->_send_bytes( \$string ); +} + +sub _send_bytes($) { + my ( $self, $byteref ) = @_; + my ( $total, $temperrs, $maxwrite ) = ( 0, 0, 0 ); + my $waittime = .02; + my @previous_writes; + + my $maxagain = $self->Maxtemperrors; + undef $maxagain if $maxagain and lc($maxagain) eq 'unlimited'; + + local $SIG{PIPE} = 'IGNORE'; # handle SIGPIPE as normal error + + while ( $total < length $$byteref ) { + my $written = + syswrite( $self->Socket, $$byteref, length($$byteref) - $total, + $total ); + + if ( defined $written ) { + $temperrs = 0; + $total += $written; + next; + } + + if ( $! == EAGAIN ) { + if ( defined $maxagain && $temperrs++ > $maxagain ) { + $self->LastError("Persistent error '$!'"); + return undef; + } + + $waittime = + $self->_optimal_sleep( $maxwrite, $waittime, \@previous_writes ); + next; + } + + # Unconnected might be apropos for more than just these? + my $emsg = $! ? "$!" : "no error caught"; + $self->State(Unconnected) if ( $! == EPIPE or $! == ECONNRESET ); + $self->LastError("Write failed '$emsg'"); + + return undef; # no luck + } + + $self->_debug("Sent $total bytes"); + return $total; +} + +# _read_line: read one line from the socket + +# It is also re-implemented in: message_to_file +# +# $output = $self->_read_line($literal_callback, $output_callback) +# Both input arguments are optional, but if supplied must either +# be a filehandle, coderef, or undef. +# +# Returned argument is a reference to an array of arrays, ie: +# $output = [ +# [ $index, 'OUTPUT'|'LITERAL', $output_line ] , +# [ $index, 'OUTPUT'|'LITERAL', $output_line ] , +# ... # etc, +# ]; + +sub _read_line { + my ( $self, $literal_callback, $output_callback ) = @_; + + my $socket = $self->Socket; + unless ( $self->IsConnected && $socket ) { + $self->LastError("NO not connected"); + return undef; + } + + my $iBuffer = ""; + my $oBuffer = []; + my $index = $self->_next_index; + my $timeout = $self->Timeout; + my $readlen = $self->{Buffer} || 4096; + + 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: + ) + { + my $transno = $self->Transaction; + + 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/\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 $temperrs = 0; + my $maxagain = $self->Maxtemperrors; + undef $maxagain if $maxagain and lc($maxagain) eq 'unlimited'; + + while ( $expected_size > length $litstring ) { + 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 ); + } + + my $ret = $self->_sysread( + $socket, \$litstring, + $expected_size - length $litstring, + 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 && $ret == 0 ) { + $emsg = "socket closed while reading data from server"; + $self->State(Unconnected); + } + + $self->_debug( "Received ret=" + . ( defined($ret) ? "$ret " : " " ) + . length($litstring) + . " of $expected_size" ); + + # save errors and return + if ($emsg) { + $self->LastError($emsg); + $self->_record( + $transno, + [ + $self->_next_index($transno), "ERROR", + "$transno * NO $emsg" + ] + ); + $litstring = "" unless defined $litstring; + $self->_debug( "ERROR while processing LITERAL, " + . " buffer=\n" + . $litstring + . "\n" ); + return undef; + } + } + } + + if ( !$literal_callback ) { ; } + elsif ( UNIVERSAL::isa( $literal_callback, 'GLOB' ) ) { + print $literal_callback $litstring; + $litstring = ""; + } + elsif ( UNIVERSAL::isa( $literal_callback, 'CODE' ) ) { + $literal_callback->($litstring) + if defined $litstring; + } + else { + $self->LastError( "'$literal_callback' is an " + . "invalid callback; must be a filehandle or CODE" ); + } + + push @$oBuffer, [ $index++, 'LITERAL', $litstring ]; + } + } + + $self->_debug( "Read: " . join "", map { "\t" . $_->[DATA] } @$oBuffer ); + @$oBuffer ? $oBuffer : undef; +} + +sub _sysread($$$$) { + my ( $self, $fh, $buf, $len, $off ) = @_; + my $rm = $self->Readmethod; + $rm ? $rm->(@_) : sysread( $fh, $$buf, $len, $off ); +} + +sub _read_more { + my $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 Report { + my $self = shift; + map { $self->_trans_data($_) } $self->_trans_index; +} + +sub LastIMAPCommand(;$) { + my ( $self, $trans ) = @_; + my $msg = ( $self->_transaction($trans) )[0]; + $msg ? $msg->[DATA] : undef; +} + +sub History(;$) { + my ( $self, $trans ) = @_; + my ( $cmd, @a ) = $self->_trans_data($trans); + return wantarray ? @a : \@a; +} + +sub Results(;$) { + my ( $self, $trans ) = @_; + my @a = $self->_trans_data($trans); + return wantarray ? @a : \@a; +} + +# Don't know what it does, but used a few times. +sub _transaction_literals() { + my $self = shift; + join '', map { $_->[DATA] } + grep { $self->_is_literal($_) } $self->_transaction; +} + +sub Escaped_results { + my ( $self, $trans ) = @_; + my @a; + foreach my $line ( grep defined, $self->Results($trans) ) { + if ( $self->_is_literal($line) ) { + $line->[DATA] =~ s/([\\\(\)"$CRLF])/\\$1/og; + push @a, qq("$line->[DATA]"); + } + else { push @a, $line->[DATA] } + } + + shift @a; # remove cmd + return wantarray ? @a : \@a; +} + +sub Unescape { + my $whatever = $_[1]; + $whatever =~ s/\\([\\\(\)"$CRLF])/$1/og; + $whatever; +} + +sub logout { + my $self = shift; + my $rc = $self->_imap_command("LOGOUT"); + $self->_disconnect; + return $rc; +} + +sub _disconnect { + my $self = shift; + + delete $self->{CAPABILITY}; + delete $self->{Folders}; + delete $self->{_IMAP4REV1}; + $self->State(Unconnected); + if ( my $sock = delete $self->{Socket} ) { + local ($@); # avoid stomping on global $@ + eval { $sock->close }; + } + $self; +} + +# LIST/XLIST/LSUB Response +# Contents: name attributes, hierarchy delimiter, name +# Example: * LIST (\Noselect) "/" ~/Mail/foo +# NOTE: in _list_response_preprocess we append literal data so we need +# to be liberal about our matching of folder name data +sub _list_or_lsub_response_parse { + my ( $self, $resp ) = @_; + + return undef unless defined $resp; + my %info; + + $resp =~ s/\015?\012$//; + if ( + $resp =~ / ^\* \s+ (?:LIST|XLIST|LSUB) \s+ # * LIST|XLIST|LSUB + \( ([^\)]*) \) \s+ # (attrs) + (?: \" ([^"]*) \" | NIL ) \s # "delimiter" or NIL + (?:\s*\" (.*) \" | (.*) ) # "name" or name + /ix + ) + { + @info{qw(attrs delim name)} = + ( [ split( / /, $1 ) ], $2, defined($3) ? $self->Unescape($3) : $4 ); + } + return wantarray ? %info : \%info; +} + +# handle listeral data returned in list/lsub responses +# some example responses: +# * LIST () "/" "My Folder" # nothing to do here... +# * LIST () "/" {9} # the {9} is already removed by _read_line() +# Special % # we append this to the previous line +sub _list_response_preprocess { + my ( $self, $data ) = @_; + return undef unless defined $data; + + for ( my $m = 0 ; $m < @$data ; $m++ ) { + if ( $data->[$m] && $data->[$m] !~ /$CR?$LF$/o ) { + $self->_debug("concatenating '$data->[$m]' and '$data->[$m+1]'"); + $data->[$m] .= " " . $data->[ $m + 1 ]; + splice @$data, $m + 1, 1; + } + } + return $data; +} + +sub exists { + my ( $self, $folder ) = @_; + $self->status($folder) ? $self : undef; +} + +# Updated to handle embedded literal strings +sub get_bodystructure { + my ( $self, $msg ) = @_; + + 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; # Wee! ;-) + if ( $output =~ /$CRLF$/o ) { + $bs = eval { $class->new($output) }; # BUG? localize $@ here? + } + else { + $self->_debug("get_bodystructure: reassembling original response"); + my $started = 0; + my $output = ''; + foreach my $o ( $self->_transaction ) { + next unless $self->_is_output_or_literal($o); + $started++ if $o->[DATA] =~ /BODYSTRUCTURE \(/i; + ; # Hi, vi! ;-) + $started or next; + + if ( length $output && $self->_is_literal($o) ) { + my $data = $o->[DATA]; + $data =~ s/"/\\"/g; + $data =~ s/\(/\\\(/g; + $data =~ s/\)/\\\)/g; + $output .= qq("$data"); + } + else { $output .= $o->[DATA] } + + $self->_debug("get_bodystructure: reassembled output=$output"); + } + eval { $bs = $class->new($output) }; # BUG? localize $@ here? + } + + $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; # vi ;-) + + unless ($output) { + $self->LastError("Unable to use get_envelope: $@"); + return undef; + } + + if ( $output =~ /$CRLF$/o ) { + eval { $bs = $class->new($output) }; # BUG? localize $@ here? + } + else { + $self->_debug("get_envelope: reassembling original response"); + my $started = 0; + $output = ''; + foreach my $o ( $self->_transaction ) { + next unless $self->_is_output_or_literal($o); + $self->_debug("o->[DATA] is $o->[DATA]"); + + $started++ if $o->[DATA] =~ /ENVELOPE \(/i; # Hi, vi! ;-) + $started or next; + + if ( length($output) && $self->_is_literal($o) ) { + my $data = $o->[DATA]; + $data =~ s/"/\\"/g; + $data =~ s/\(/\\\(/g; + $data =~ s/\)/\\\)/g; + $output .= '"' . $data . '"'; + } + else { + $output .= $o->[DATA]; + } + $self->_debug("get_envelope: reassembled output=$output"); + } + + eval { $bs = $class->new($output) }; # BUG? localize $@ here? + } + + $self->_debug( "get_envelope: msg $msg returns ref: " . $bs || "UNDEF" ); + $bs; +} + +# fetch( [$seq_set|ALL], @msg_data_items ) +sub fetch { + my $self = shift; + my $what = shift || "ALL"; + + my $take = $what; + if ( $what eq 'ALL' ) { + my $msgs = $self->messages or return undef; + $take = $self->Range($msgs); + } + elsif ( ref $what || $what =~ /^[,:\d]+\w*$/ ) { + $take = $self->Range($what); + } + + my ( @data, $cmd ); + my ( $seq_set, @fetch_att ) = $self->_split_sequence( $take, "FETCH", @_ ); + + for ( my $x = 0 ; $x <= $#$seq_set ; $x++ ) { + my $seq = $seq_set->[$x]; + $self->_imap_uid_command( FETCH => $seq, @fetch_att, @_ ) + or return undef; + my $res = $self->Results; + + # only keep last command and last response (* OK ...) + $cmd = shift(@$res); + pop(@$res) if ( $x != $#{$seq_set} ); + push( @data, @$res ); + } + + if ( $cmd and !wantarray ) { + $cmd =~ s/^(\d+\s+.*?FETCH\s+)\S+(\s*)/$1$take$2/; + unshift( @data, $cmd ); + } + + #wantarray ? $self->History : $self->Results; + return wantarray ? @data : \@data; +} + +# Some servers have a maximum command length. If Maxcommandlength is +# set, split a sequence to fit within the length restriction. +sub _split_sequence { + my ( $self, $take, @args ) = @_; + + # split take => sequence-set and (optional) fetch-att + my ( $seq, @att ) = split( / /, $take, 2 ); + + # use the entire sequence unless Maxcommandlength is set + my @seqs; + my $maxl = $self->Maxcommandlength; + if ($maxl) { + + # estimate command length, the sum of the lengths of: + # tag, command, fetch-att + $CRLF + push @args, $self->Transaction, $self->Uid ? "UID" : (), "\015\012"; + + # do not split on anything smaller than 64 chars + my $clen = length join( " ", @att, @args ); + my $diff = $maxl - $clen; + my $most = $diff > 64 ? $diff : 64; + + @seqs = ( $seq =~ m/(.{1,$most})(?:,|$)/g ) if defined $seq; + $self->_debug( "split_sequence: length($maxl-$clen) parts: ", + $#seqs + 1 ) + if ( $#seqs != 0 ); + } + else { + push( @seqs, $seq ) if defined $seq; + } + return \@seqs, @att; +} + +# fetch_hash( [$seq_set|ALL], @msg_data_items, [\%msg_by_ids] ) +sub fetch_hash { + my $self = shift; + my $uids = ref $_[-1] ? pop @_ : {}; + my @words = @_; + + # take an optional leading list of messages argument or default to + # ALL let fetch turn that list of messages into a msgref as needed + # fetch has similar logic for dealing with message list + my $msgs = 'ALL'; + if ( $words[0] ) { + if ( $words[0] eq 'ALL' || ref $words[0] ) { + $msgs = shift @words; + } + elsif ( $words[0] =~ s/^([,:\d]+)\s*// ) { + $msgs = $1; + shift @words if $words[0] eq ""; + } + } + + # message list (if any) is now removed from @words + my $what = join ' ', @words; + + for (@words) { + s/([\( ])FAST([\) ])/${1}FLAGS INTERNALDATE RFC822\.SIZE$2/i; +s/([\( ])FULL([\) ])/${1}FLAGS INTERNALDATE RFC822\.SIZE ENVELOPE BODY$2/i; + } + my %words = map { uc($_) => 1 } @words; + + my $output = $self->fetch( $msgs, "($what)" ) or return undef; + + while ( my $l = shift @$output ) { + next if $l !~ m/^\*\s(\d+)\sFETCH\s\(/g; + my ( $mid, $entry ) = ( $1, {} ); + my ( $key, $value ); + ATTR: + while ( $l !~ m/\G\s*\)\s*$/gc ) { + if ( $l =~ m/\G\s*([\w\d\.]+(?:\[[^\]]*\])?)\s*/gc ) { + $key = uc($1); + } + elsif ( !defined $key ) { + + # some kind of malformed response + $self->LastError("Invalid item name in FETCH response: $l"); + return undef; + } + + if ( $l =~ m/\G\s*$/gc ) { + $value = shift @$output; + $entry->{$key} = $value; + $l = shift @$output; + next ATTR; + } + elsif ( $l =~ m/\G(?:"([^"]+)"|([^()\s]+))\s*/gc ) { + $value = defined $1 ? $1 : $2; + $entry->{$key} = $value; + next ATTR; + } + elsif ( $l =~ m/\G\(/gc ) { + my $depth = 1; + $value = ""; + while ( $l =~ m/\G(\(|\)|[^()]+)/gc ) { + my $stuff = $1; + if ( $stuff eq "(" ) { + $depth++; + $value .= "("; + } + elsif ( $stuff eq ")" ) { + $depth--; + if ( $depth == 0 ) { + $entry->{$key} = $value; + next ATTR; + } + $value .= ")"; + } + else { + $value .= $stuff; + } + } + m/\G\s*/gc; + } + else { + $self->LastError("Invalid item value in FETCH response: $l"); + return undef; + } + } + + if ( $self->Uid ) { + $uids->{ $entry->{UID} } = $entry; + } + else { + $uids->{$mid} = $entry; + } + + for my $word ( keys %$entry ) { + next if exists $words{$word}; + + if ( my ($stuff) = $word =~ m/^BODY(\[.*)$/ ) { + next if exists $words{ "BODY.PEEK" . $stuff }; + } + + delete $entry->{$word}; + } + } + + return wantarray ? %$uids : $uids; +} + +sub store { + my ( $self, @a ) = @_; + delete $self->{Folders}; + $self->_imap_uid_command( STORE => @a ) + or return undef; + return wantarray ? $self->History : $self->Results; +} + +sub _imap_folder_command($$@) { + my ( $self, $command ) = ( shift, shift ); + delete $self->{Folders}; + my $folder = $self->Massage(shift); + + $self->_imap_command( join ' ', $command, $folder, @_ ) + or return undef; + + return wantarray ? $self->History : $self->Results; +} + +sub subscribe($) { shift->_imap_folder_command( SUBSCRIBE => @_ ) } +sub unsubscribe($) { shift->_imap_folder_command( UNSUBSCRIBE => @_ ) } +sub create($) { shift->_imap_folder_command( CREATE => @_ ) } + +sub delete($) { + my $self = shift; + $self->_imap_folder_command( DELETE => @_ ) or return undef; + $self->Folder(undef); + return wantarray ? $self->History : $self->Results; +} + +# rfc2086 +sub myrights($) { $_[0]->_imap_folder_command( MYRIGHTS => $_[1] ) } + +sub close { + my $self = shift; + delete $self->{Folders}; + $self->_imap_command('CLOSE') + or return undef; + return wantarray ? $self->History : $self->Results; +} + +sub expunge { + my ( $self, $folder ) = @_; + + return undef unless ( defined $folder or defined $self->Folder ); + + my $old = defined $self->Folder ? $self->Folder : ''; + + if ( !defined($folder) || $folder eq $old ) { + $self->_imap_command('EXPUNGE') + or return undef; + } + else { + $self->select($folder) or return undef; + my $succ = $self->_imap_command('EXPUNGE'); + + # if $old eq '' IMAP4 select should close $folder without EXPUNGE + return undef unless ( $self->select($old) and $succ ); + } + + return wantarray ? $self->History : $self->Results; +} + +sub uidexpunge { + my ( $self, $msgspec ) = ( shift, shift ); + + return undef unless $self->has_capability("UIDPLUS"); + + my $msg = + UNIVERSAL::isa( $msgspec, 'Mail::IMAPClient::MessageSet' ) + ? $msgspec + : $self->Range($msgspec); + + $msg->cat(@_) if @_; + + if ( $self->Uid ) { + $self->_imap_command("UID EXPUNGE $msg") + or return undef; + } + else { + $self->LastError("Uid must be enabled for uidexpunge"); + return undef; + } + + return wantarray ? $self->History : $self->Results; +} + +# BUG? cleanup escaping/quoting +sub rename { + my ( $self, $from, $to ) = @_; + + if ( $from =~ /^"(.*)"$/ ) { + $from = $1 unless $self->exists($from); + $from =~ s/"/\\"/g; + } + + if ( $to =~ /^"(.*)"$/ ) { + $to = $1 unless $self->exists($from) && $from =~ /^".*"$/; + $to =~ s/"/\\"/g; + } + + $self->_imap_command(qq(RENAME "$from" "$to")) ? $self : undef; +} + +sub status { + my ( $self, $folder ) = ( shift, shift ); + defined $folder or return undef; + + my $which = @_ ? join( " ", @_ ) : 'MESSAGES'; + + my $box = $self->Massage($folder); + $self->_imap_command("STATUS $box ($which)") + or return undef; + + return wantarray ? $self->History : $self->Results; +} + +sub flags { + my ( $self, $msgspec ) = ( shift, shift ); + my $msg = + UNIVERSAL::isa( $msgspec, 'Mail::IMAPClient::MessageSet' ) + ? $msgspec + : $self->Range($msgspec); + + $msg->cat(@_) if @_; + + # Send command + $self->fetch( $msg, "FLAGS" ) or return undef; + + my $u_f = $self->Uid; + my $flagset = {}; + + # Parse results, setting entry in result hash for each line + foreach my $line ( $self->Results ) { + $self->_debug("flags: line = '$line'"); + if ( + $line =~ /\* \s+ (\d+) \s+ FETCH \s+ # * nnn FETCH + \( + (?:\s* UID \s+ (\d+) \s* )? # optional: UID nnn + FLAGS \s* \( (.*?) \) \s* # FLAGS (\Flag1 \Flag2) + (?:\s* UID \s+ (\d+) \s* )? # optional: UID nnn + \) + /x + ) + { + my $mailid = $u_f ? ( $2 || $4 ) : $1; + $flagset->{$mailid} = [ split " ", $3 ]; + } + } + + # Or did he want a hash from msgid to flag array? + return $flagset + if ref $msgspec; + + # or did the guy want just one response? Return it if so + my $flagsref = $flagset->{$msgspec}; + return wantarray ? @$flagsref : $flagsref; +} + +# reduce a list, stripping undeclared flags. Flags with or without +# leading backslash. +sub supported_flags(@) { + my $self = shift; + my $sup = $self->Supportedflags + or return @_; + + return map { $sup->($_) } @_ + if ref $sup eq 'CODE'; + + grep { $sup->{ /^\\(\S+)/ ? lc $1 : () } } @_; +} + +sub parse_headers { + my ( $self, $msgspec, @fields ) = @_; + my $fields = join ' ', @fields; + my $msg = ref $msgspec eq 'ARRAY' ? $self->Range($msgspec) : $msgspec; + my $peek = !defined $self->Peek || $self->Peek ? '.PEEK' : ''; + + my $string = "$msg BODY$peek" + . ( $fields eq 'ALL' ? '[HEADER]' : "[HEADER.FIELDS ($fields)]" ); + + my $raw = $self->fetch($string) or return undef; + my $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->Massage( shift @what ) . " " + . $self->Massage( shift @what ); + + $or = "OR $or " . $self->Massage($_) for @what; + + $self->_imap_uid_command( SEARCH => $or ) + or return undef; + + my @hits; + foreach ( $self->History ) { + chomp; + s/$CR?$LF$//o; + s/^\*\s+SEARCH\s+//i or next; + push @hits, grep /\d/, split; + } + $self->_debug("Hits are now: @hits"); + + return wantarray ? @hits : \@hits; +} + +sub disconnect { shift->logout } + +sub _quote_search { + my ( $self, @args ) = @_; + my @ret; + foreach my $v (@args) { + if ( ref($v) eq "SCALAR" ) { + push( @ret, $$v ); + } + elsif ( exists $SEARCH_KEYS{ uc($_) } ) { + push( @ret, $v ); + } + elsif ( @args == 1 ) { + push( @ret, $v ); # <3.17 compat: caller responsible for quoting + } + else { + push( @ret, $self->Quote($v) ); + } + } + return @ret; +} + +sub search { + my ( $self, @args ) = @_; + + @args = $self->_quote_search(@args); + + $self->_imap_uid_command( SEARCH => @args ) + or return undef; + + my @hits; + foreach ( $self->History ) { + chomp; + s/$CR?$LF$//o; + s/^\*\s+SEARCH\s+(?=.*?\d)// or next; + push @hits, grep /^\d+$/, split; + } + + @hits + or $self->_debug("Search successful but found no matching messages"); + + # return empty list + return + wantarray ? @hits + : !@hits ? \@hits + : $self->Ranges ? $self->Range( \@hits ) + : \@hits; +} + +# returns a Thread data structure +my $thread_parser; + +sub thread { + my $self = shift; + + return undef unless defined $self->has_capability("THREAD=REFERENCES"); + my $algorythm = shift + || ( + $self->has_capability("THREAD=REFERENCES") + ? 'REFERENCES' + : 'ORDEREDSUBJECT' + ); + + my $charset = shift || 'UTF-8'; + my @a = @_ ? @_ : 'ALL'; + + $a[-1] = $self->Massage( $a[-1], 1 ) + if @a > 1 && !exists $SEARCH_KEYS{ uc $a[-1] }; + + $self->_imap_uid_command( THREAD => $algorythm, $charset, @a ) + or return undef; + + unless ($thread_parser) { + return if $thread_parser == 0; + + 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; +} + +#??? compare to uidnext. Why is Massage missing? +sub uidvalidity { + my ( $self, $folder ) = @_; + $self->status( $folder, "UIDVALIDITY" ) or return undef; + my $vline = first { /UIDVALIDITY/i } $self->History; + defined $vline && $vline =~ /\(UIDVALIDITY\s+([^\)]+)/ ? $1 : undef; +} + +sub uidnext { + my $self = shift; + my $folder = $self->Massage(shift); + $self->status( $folder, "UIDNEXT" ) or return undef; + my $line = first { /UIDNEXT/i } $self->History; + defined $line && $line =~ /\(UIDNEXT\s+([^\)]+)/ ? $1 : undef; +} + +sub capability { + my $self = shift; + + if ( $self->{CAPABILITY} ) { + my @caps = keys %{ $self->{CAPABILITY} }; + return wantarray ? @caps : \@caps; + } + + $self->_imap_command('CAPABILITY') + or return undef; + + my @caps = map { split } grep s/^\*\s+CAPABILITY\s+//, $self->History; + foreach (@caps) { + $self->{CAPABILITY}{ uc $_ }++; + $self->{ uc $1 } = uc $2 if /(.*?)\=(.*)/; + } + + return wantarray ? @caps : \@caps; +} + +# use "" not undef when lookup fails to differentiate imap command +# failure vs lack of capability +sub has_capability { + my ( $self, $which ) = @_; + $self->capability or return undef; + $which ? $self->{CAPABILITY}{ uc $which } : ""; +} + +sub imap4rev1 { + my $self = shift; + return $self->{_IMAP4REV1} if exists $self->{_IMAP4REV1}; + $self->{_IMAP4REV1} = $self->has_capability('IMAP4REV1'); +} + +#??? what a horror! +sub namespace { + + # Returns a nested list as follows: + # [ + # [ + # [ $user_prefix, $user_delim ] (,[$user_prefix2 ,$user_delim ],...), + # ], + # [ + # [ $shared_prefix,$shared_delim] (,[$shared_prefix2,$shared_delim],... ), + # ], + # [ + # [$public_prefix, $public_delim] (,[$public_prefix2,$public_delim],...), + # ], + # ]; + + my $self = shift; + unless ( $self->has_capability("NAMESPACE") ) { + $self->LastError( "NO NAMESPACE not supported by " . $self->Server ) + unless $self->LastError; + return undef; + } + + my $got = $self->_imap_command("NAMESPACE") or return undef; + my @namespaces = map { /^\* NAMESPACE (.*)/ ? $1 : () } $got->Results; + + my $namespace = shift @namespaces; + $namespace =~ s/$CR?$LF$//o; + + my ( $personal, $shared, $public ) = $namespace =~ m# + (NIL|\((?:\([^\)]+\)\s*)+\))\s + (NIL|\((?:\([^\)]+\)\s*)+\))\s + (NIL|\((?:\([^\)]+\)\s*)+\)) + #xi; + + my @ns; + $self->_debug("NAMESPACE: pers=$personal, shared=$shared, pub=$public"); + foreach ( $personal, $shared, $public ) { + uc $_ ne 'NIL' or next; + s/^\((.*)\)$/$1/; + + my @pieces = m#\(([^\)]*)\)#g; + $self->_debug("NAMESPACE pieces: @pieces"); + + push @ns, [ map { [m#"([^"]*)"\s*#g] } @pieces ]; + } + + return wantarray ? @ns : \@ns; +} + +sub internaldate { + my ( $self, $msg ) = @_; + $self->_imap_uid_command( FETCH => $msg, 'INTERNALDATE' ) + or return undef; + my $internalDate = join '', $self->History; + $internalDate =~ s/^.*INTERNALDATE "//si; + $internalDate =~ s/\".*$//s; + $internalDate; +} + +sub is_parent { + my ( $self, $folder ) = ( shift, shift ); + my $list = $self->list( undef, $folder ) or return undef; + + my $attrs; + foreach my $resp (@$list) { + my $rec = $self->_list_or_lsub_response_parse($resp); + next unless defined $rec->{attrs}; + return 0 if $rec->{attrs} =~ /\bNoInferior\b/i; + $attrs = $rec->{attrs}; + } + + if ($attrs) { + return 1 if $attrs =~ /HasChildren/i; + return 0 if $attrs =~ /HasNoChildren/i; + } + else { + $self->_debug( join( "\n\t", "no attrs for '$folder' in:", @$list ) ); + } + + # BUG? This may be overkill for normal use cases... + # flag not supported or not returned for some reason, try via folders() + my $sep = $self->separator($folder) || $self->separator(undef); + return undef unless defined $sep; + + my $lead = $folder . $sep; + my $len = length $lead; + scalar grep { $lead eq substr( $_, 0, $len ) } $self->folders; +} + +sub selectable { + my ( $self, $f ) = @_; + my $info = $self->list( "", $f ); + defined $info ? not( grep /NoSelect/i, @$info ) : undef; +} + +sub append { + my $self = shift; + my $folder = shift; + my $text = @_ > 1 ? join( $CRLF, @_ ) : shift; + + $self->append_string( $folder, $text ); +} + +sub append_string($$$;$$) { + my $self = shift; + my $folder = $self->Massage(shift); + my ( $text, $flags, $date ) = @_; + defined $text or $text = ''; + + if ( defined $flags ) { + $flags =~ s/^\s+//g; + $flags =~ s/\s+$//g; + $flags = "($flags)" if $flags !~ /^\(.*\)$/; + } + + if ( defined $date ) { + $date =~ s/^\s+//g; + $date =~ s/\s+$//g; + $date = qq("$date") if $date !~ /^"/; + } + + $text =~ s/\r?\n/$CRLF/og; + + my $command = + "APPEND $folder " + . ( $flags ? "$flags " : "" ) + . ( $date ? "$date " : "" ) . "{" + . length($text) + . "}$CRLF"; + + $command .= $text . $CRLF; + $self->_imap_command( { addcrlf => 0 }, $command ) or return undef; + + my $data = join '', $self->Results; + + # look for something like return size or self if no size found: + # OK [APPENDUID ] APPEND completed + my $ret = $data =~ m#\s+(\d+)\]# ? $1 : $self; + + return $ret; +} + +sub append_file { + my ( $self, $folder, $file, $control, $flags, $use_filetime ) = @_; + my $mfolder = $self->Massage($folder); + + $flags ||= ''; + my $fflags = $flags =~ m/^\(.*\)$/ ? $flags : "($flags)"; + + my @err; + push( @err, "folder not specified" ) + unless ( defined($folder) and $folder ne "" ); + + my $fh; + if ( !defined($file) ) { + push( @err, "file not specified" ); + } + elsif ( ref($file) ) { + $fh = $file; # let the caller pass in their own file handle directly + } + elsif ( !-f $file ) { + push( @err, "file '$file' not found" ); + } + else { + $fh = IO::File->new( $file, 'r' ) + or push( @err, "Unable to open file '$file': $!" ); + } + + if (@err) { + $self->LastError( join( ", ", @err ) ); + return undef; + } + + my $date; + if ( $fh and $use_filetime ) { + my $f = $self->Rfc2060_datetime( ( stat($fh) )[9] ); + $date = qq("$f"); + } + + # BUG? seems wasteful to do this always, provide a "fast path" option? + my $length = 0; + { + local $/ = "\n"; # just in case global is not default + while ( my $line = <$fh> ) { # do no read the whole file at once! + $line =~ s/\r?\n$/$CRLF/; + $length += length($line); + } + seek( $fh, 0, 0 ); + } + + my $string = "APPEND $mfolder"; + $string .= " $fflags" if ( $fflags ne "" ); + $string .= " $date" if ( defined($date) ); + $string .= " {$length}"; + + my $rc = $self->_imap_command( $string, '+' ); + unless ($rc) { + $self->LastError( "Error sending '$string': " . $self->LastError ); + return undef; + } + + my $count = $self->Count; + + # Now send the message itself + my $buffer; + while ( $fh->sysread( $buffer, APPEND_BUFFER_SIZE ) ) { + $buffer =~ s/\r?\n/$CRLF/og; + + $self->_record( + $count, + [ + $self->_next_index($count), "INPUT", + '{' . length($buffer) . " bytes from $file}" + ] + ); + + my $bytes_written = $self->_send_bytes( \$buffer ); + unless ($bytes_written) { + $self->LastError( "Error appending message: " . $self->LastError ); + return undef; + } + } + + # finish off append + unless ( $self->_send_bytes( \$CRLF ) ) { + $self->LastError( "Error appending CRLF: " . $self->LastError ); + return undef; + } + + # Now for the crucial test: Did the append work or not? + # look for " (OK|BAD|NO)" + my $code = $self->_get_response($count) or return undef; + + if ( $code eq 'OK' ) { + my $data = join '', $self->Results; + + # look for something like return size or self if no size found: + # OK [APPENDUID ] APPEND completed + my $ret = $data =~ m#\s+(\d+)\]# ? $1 : $self; + + return $ret; + } + else { + return undef; + } +} + +# BUG? we should retry if "socket closed while..." but do not currently +sub authenticate { + my ( $self, $scheme, $response ) = @_; + $scheme ||= $self->Authmechanism; + $response ||= $self->Authcallback; + my $clear = $self->Clear; + $self->Clear($clear) + if $self->Count >= $clear && $clear > 0; + + if ( !$scheme ) { + $self->LastError("Authmechanism not set"); + return undef; + } + elsif ( $scheme eq 'LOGIN' ) { + $self->LastError("Authmechanism LOGIN is invalid, use login()"); + return undef; + } + + my $string = "AUTHENTICATE $scheme"; + + # use _imap_command for retry mechanism... + $self->_imap_command( $string, '+' ) or return undef; + + my $count = $self->Count; + my $code; + + # look for "+ " or just "+" + foreach my $line ( $self->Results ) { + if ( $line =~ /^\+\s*(.*?)\s*$/ ) { + $code = $1; + last; + } + } + + # 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( + $client->User + . chr(0) + . $client->Proxy + . chr(0) + . $client->Password, + '' + ); + }; + } + elsif ( $scheme eq 'NTLM' ) { + $response ||= sub { + my ( $code, $client ) = @_; + + require Authen::NTLM; + Authen::NTLM::ntlm_user( $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 ) = @_; + + $target = $self->Massage($target); + @msgs = + $self->Ranges + ? $self->Range(@msgs) + : sort { $a <=> $b } map { ref $_ ? @$_ : split( ',', $_ ) } @msgs; + + my $msgs = + $self->Ranges + ? $self->Range(@msgs) + : join ',', map { ref $_ ? @$_ : $_ } @msgs; + + $self->_imap_uid_command( COPY => $msgs, $target ) + or return undef; + + my @results = $self->History; + + my @uids; + foreach (@results) { + chomp; + s/$CR?$LF$//o; + s/^.*\[COPYUID\s+\d+\s+[\d:,]+\s+([\d:,]+)\].*/$1/ or next; + push @uids, /(\d+):(\d+)/ ? ( $1 ... $2 ) : ( split /\,/ ); + + } + return @uids ? join( ",", @uids ) : $self; +} + +sub move { + my ( $self, $target, @msgs ) = @_; + + $self->exists($target) + or $self->create($target) && $self->subscribe($target); + + my $uids = + $self->copy( $target, map { ref $_ eq 'ARRAY' ? @$_ : $_ } @msgs ) + or return undef; + + unless ( $self->delete_message(@msgs) ) { + local ($!); # old versions of Carp could reset $! + carp $self->LastError; + } + + return $uids; +} + +sub set_flag { + my ( $self, $flag, @msgs ) = @_; + @msgs = @{ $msgs[0] } if ref $msgs[0] eq 'ARRAY'; + $flag = "\\$flag" + if $flag =~ /^(?:Answered|Flagged|Deleted|Seen|Draft)$/i; + + my $which = $self->Ranges ? $self->Range(@msgs) : join( ',', @msgs ); + return $self->store( $which, '+FLAGS.SILENT', "($flag)" ); +} + +sub see { + my ( $self, @msgs ) = @_; + @msgs = @{ $msgs[0] } if ref $msgs[0] eq 'ARRAY'; + return $self->set_flag( '\\Seen', @msgs ); +} + +sub mark { + my ( $self, @msgs ) = @_; + @msgs = @{ $msgs[0] } if ref $msgs[0] eq 'ARRAY'; + return $self->set_flag( '\\Flagged', @msgs ); +} + +sub unmark { + my ( $self, @msgs ) = @_; + @msgs = @{ $msgs[0] } if ref $msgs[0] eq 'ARRAY'; + return $self->unset_flag( '\\Flagged', @msgs ); +} + +sub unset_flag { + my ( $self, $flag, @msgs ) = @_; + @msgs = @{ $msgs[0] } if ref $msgs[0] eq 'ARRAY'; + + $flag = "\\$flag" + if $flag =~ /^(?:Answered|Flagged|Deleted|Seen|Draft)$/i; + + return $self->store( join( ",", @msgs ), "-FLAGS.SILENT ($flag)" ); +} + +sub deny_seeing { + my ( $self, @msgs ) = @_; + @msgs = @{ $msgs[0] } if ref $msgs[0] eq 'ARRAY'; + return $self->unset_flag( '\\Seen', @msgs ); +} + +sub size { + my ( $self, $msg ) = @_; + my $data = $self->fetch( $msg, "(RFC822.SIZE)" ) or return undef; + + # beware of response like: * NO Cannot open message $msg + my $cmd = shift @$data; + my $err; + foreach my $line (@$data) { + return $1 if ( $line =~ /RFC822\.SIZE\s+(\d+)/ ); + $err = $line if ( $line =~ /\* NO\b/ ); + } + + if ($err) { + my $info = "$err was returned for $cmd"; + $info =~ s/$CR?$LF//og; + $self->LastError($info); + } + elsif ( !$self->LastError ) { + my $info = "no RFC822.SIZE found in: " . join( " ", @$data ); + $self->LastError($info); + } + return undef; +} + +sub getquotaroot { + my ( $self, $what ) = @_; + my $who = $what ? $self->Massage($what) : "INBOX"; + return $self->_imap_command("GETQUOTAROOT $who") ? $self->Results : undef; +} + +sub getquota { + my ( $self, $what ) = @_; + my $who = $what ? $self->Massage($what) : "user/$self->{User}"; + return $self->_imap_command("GETQUOTA $who") ? $self->Results : undef; +} + +# usage: $self->setquota($folder, storage => 512) +sub setquota(@) { + my ( $self, $what ) = ( shift, shift ); + my $who = $what ? $self->Massage($what) : "user/$self->{User}"; + my @limits; + while (@_) { + my $key = uc shift @_; + push @limits, $key => shift @_; + } + local $" = ' '; + $self->_imap_command("SETQUOTA $who (@limits)") ? $self->Results : undef; +} + +sub quota { + my $self = shift; + my $what = shift || "INBOX"; + $self->_imap_command("GETQUOTA $what") or $self->getquotaroot($what); + ( map { /.*STORAGE\s+\d+\s+(\d+).*\n$/ ? $1 : () } $self->Results )[0]; +} + +sub quota_usage { + my $self = shift; + my $what = shift || "INBOX"; + $self->_imap_command("GETQUOTA $what") || $self->getquotaroot($what); + ( map { /.*STORAGE\s+(\d+)\s+\d+.*\n$/ ? $1 : () } $self->Results )[0]; +} + +sub Quote($) { $_[0]->Massage( $_[1], NonFolderArg ) } + +# rfc3501: +# atom-specials = "(" / ")" / "{" / SP / CTL / list-wildcards / +# quoted-specials / resp-specials +# list-wildcards = "%" / "*" +# quoted-specials = DQUOTE / "\" +# resp-specials = "]" +# rfc2060: +# CTL ::= +# Additionally, we encode strings with } and [, be less than minimal +sub Massage($;$) { + my ( $self, $name, $notFolder ) = @_; + $name =~ s/^\"(.*)\"$/$1/ unless $notFolder; + + if ( $name =~ /["\\]/ ) { + return "{" . length($name) . "}" . $CRLF . $name; + } + elsif ( $name =~ /[(){}\s[:cntrl:]%*\[\]]/ ) { + return qq("$name"); + } + else { + return $name; + } +} + +sub unseen_count { + my ( $self, $folder ) = ( shift, shift ); + $folder ||= $self->Folder; + $self->status( $folder, 'UNSEEN' ) or return undef; + + my $r = + first { s/\*\s+STATUS\s+.*\(UNSEEN\s+(\d+)\s*\)/$1/ } $self->History; + + $r =~ s/\D//g; + return $r; +} + +sub Status { shift->State } +sub IsUnconnected { shift->State == Unconnected } +sub IsConnected { shift->State >= Connected } +sub IsAuthenticated { shift->State >= Authenticated } +sub IsSelected { shift->State == Selected } + +# The following private methods all work on an output line array. +# _data returns the data portion of an output array: +sub _data { ref $_[1] && defined $_[1]->[TYPE] ? $_[1]->[DATA] : undef } + +# _index returns the index portion of an output array: +sub _index { ref $_[1] && defined $_[1]->[TYPE] ? $_[1]->[INDEX] : undef } + +# _type returns the type portion of an output array: +sub _type { ref $_[1] && $_[1]->[TYPE] } + +# _is_literal returns true if this is a literal: +sub _is_literal { ref $_[1] && $_[1]->[TYPE] && $_[1]->[TYPE] eq 'LITERAL' } + +# _is_output_or_literal returns true if this is an +# output line (or the literal part of one): + +sub _is_output_or_literal { + ref $_[1] + && defined $_[1]->[TYPE] + && ( $_[1]->[TYPE] eq "OUTPUT" || $_[1]->[TYPE] eq "LITERAL" ); +} + +# _is_output returns true if this is an output line: +sub _is_output { ref $_[1] && $_[1]->[TYPE] && $_[1]->[TYPE] eq "OUTPUT" } + +# _is_input returns true if this is an input line: +sub _is_input { ref $_[1] && $_[1]->[TYPE] && $_[1]->[TYPE] eq "INPUT" } + +# _next_index returns next_index for a transaction; may legitimately +# return 0 when successful. +sub _next_index { my $r = $_[0]->_transaction( $_[1] ); $r } + +sub Range { + my ( $self, $targ ) = ( shift, shift ); + + UNIVERSAL::isa( $targ, 'Mail::IMAPClient::MessageSet' ) + ? $targ->cat(@_) + : Mail::IMAPClient::MessageSet->new( $targ, @_ ); +} + +1; diff --git a/Mail-IMAPClient-3.23/lib/Mail/IMAPClient.pod b/Mail-IMAPClient-3.23/lib/Mail/IMAPClient.pod new file mode 100644 index 0000000..763556d --- /dev/null +++ b/Mail-IMAPClient-3.23/lib/Mail/IMAPClient.pod @@ -0,0 +1,3707 @@ +=head1 NAME + +Mail::IMAPClient - An IMAP Client API + +=head1 SYNOPSIS + + use Mail::IMAPClient; + + my $imap = Mail::IMAPClient->new( + Server => 'localhost', + User => 'username', + Password => 'password', + Ssl => 1, + Uid => 1, + ); + + my $folders = $imap->folders + or die "List folders error: ", $imap->LastError, "\n"; + print "Folders: @$folders\n"; + + $imap->select( $Opt{folder} ) + or die "Select '$Opt{folder}' error: ", $imap->LastError, "\n"; + + $imap->fetch_hash("FLAGS", "INTERNALDATE", "RFC822.SIZE") + or die "Fetch hash '$Opt{folder}' error: ", $imap->LastError, "\n"; + + $imap->logout + or die "Logout error: ", $imap->LastError, "\n"; + +=head1 DESCRIPTION + +This module provides methods implementing the IMAP protocol to support +interacting with IMAP message stores. + +The module is used by constructing or instantiating a new IMAPClient +object via the L constructor method. Once the object has been +instantiated, the L method is either implicitly or +explicitly called. At that point methods are available that implement +the IMAP client commands as specified in B. When processing +is complete, the L object method should be called. + +This documentation is not meant to be a replacement for RFC3501 nor +any other IMAP related RFCs. + +Note that this documentation uses the term I in place of +RFC3501's use of I. This documentation reserves the use of +the term I to refer to the set of folders owned by a specific +IMAP id. + +=head2 Connection State + +RFC3501 defines four possible states for an IMAP connection: not +authenticated, authenticated, selected, and logged out. These +correspond to the IMAPClient constants C, C, +C, and C, respectively. These constants can be +used in conjunction with the L method to determine the status +of an IMAPClient object and its underlying IMAP session. + +Note that an IMAPClient object can be in the C state both +before a server connection is made and after it has ended. This +differs slightly from RFC3501, which does not define a pre-connection +status. For a discussion of the methods available for examining the +IMAPClient object's status, see the section labeled +L, below. + +=head2 Advanced Authentication Mechanisms + +RFC3501 defines two commands for authenticating to an IMAP server: + +=over 4 + +=item LOGIN + +LOGIN is for plain text authentication. + +=item AUTHENTICATE + +AUTHENTICATE for more advanced and/or secure authentication mechanisms. + +=back + +Mail::IMAPClient supports the following AUTHENTICATE mechanisms: + +=over 4 + +=item DIGEST-MD5 + +DIGEST-MD5 authentication requires the L and +L modules. See also L. + +=item CRAM-MD5 + +CRAM-MD5 requires the L module. + +=item PLAIN (SASL) + +PLAIN (SASL) authentication requires the use of the L parameter. + +=item NTLM + +NTLM authentication requires the L module. See also +L. + +=back + +=head2 Custom Authentication Mechanisms + +There are also a number of methods and parameters that you can use to +build your own authentication mechanism. All of the methods and +parameters discussed in this section are described in more detail +elsewhere in this document. This section provides a starting point +for building your own authentication mechanism. + +First of all, if you just want to do plain text authentication and +your server is okay with that idea then you don't even need to read +this section. + +Second of all, the intent of this section is to help you implement the +authentication mechanism of your choice, but you will have to +understand how that mechanism works. There are I of +authentication mechanisms, if your preferred mechanism is not +currently supported but you manage to get it working please consider +donating them to this module. Patches and suggestions are always +welcome. + +Support for add-on authentication mechanisms in Mail::IMAPClient is +pretty straight forward. You create a callback to be used to provide +the response to the server's challenge. The L parameter +contains a reference to the callback, which can be an anonymous +subroutine or a named subroutine. Then, you identify your +authentication mechanism, either via the L parameter or +as an argument to L. + +You may also need to provide a subroutine to encrypt (or whatever) +data before it is sent to the server. The L parameter +must contain a reference to this subroutine. And, you will need to +decrypt data from the server; a reference to the subroutine that does +this must be stored in the L parameter. + +This framework is based on the assumptions that a) the mechanism you +are using requires a challenge-response exchange, and b) the mechanism +does not fundamentally alter the exchange between client and server +but merely wraps the exchange in a layer of encryption. It also +assumes that the line-oriented nature of the IMAP conversation is +preserved; authentication mechanisms that break up messages into +blocks of a predetermined size may still be possible but will +certainly be more difficult to implement. + +Alternatively, if you have access to B, a utility included in +the Cyrus IMAP distribution, you can use that utility to broker your +communications with the IMAP server. This is quite easy to implement. +An example, F, can be found in the +C subdirectory of the source distribution. + +The following list summarizes the methods and parameters that you may +find useful in implementing advanced authentication: + +=over 4 + +=item The authenticate method + +The L method uses the L parameter to +determine how to authenticate with the server see the method +documentation for details. + +=item Socket and RawSocket + +The L and L methods provide access to the socket +connection. The socket is typically automatically created by the +L method, but if you are implementing an advanced +authentication technique you may choose to set up your own socket +connection and then set this parameter manually, bypassing the +B method completely. This is also useful if you want to use +L alternatives like L 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 + +=head2 Errors + +If you attempt an operation that results in an error, then you can +retrieve the text of the error message by using the L +method. However, the L method is an object method (not a +class method) and can only be used once an object is successfully +created. In cases where an object is not successfully created the +C<$@> variable is set with an error message. + +Mail::IMAPClient resets C<$@> and L to undef before most +IMAP requests, so the values only have a short lifespan. +L will always contain error info from the last error, +until another error is encountered, another IMAP command is issued or +it is explicitly cleared. + +Please note that the use of C<$@> is subject to change in the future +release so it is best to use L for error checking once a +Mail::IMAPClient object has been created. + +Errors in the L method can prevent your object from ever being +created. If the L, L, and L parameters are +supplied to L, it will attempt to call L and +L. Any of these methods could fail and cause the L +method call to return C and leaving the variable C<$@> is set +to an error message. + +=head2 Transactions + +RFC3501 requires that each line in an IMAP conversation be prefixed +with a tag. A typical conversation consists of the client issuing a +tag-prefixed command string, and the server replying with one of more +lines of output. Those lines of output will include a command +completion status code prefixed by the same tag as the original +command string. + +The IMAPClient module uses a simple counter to ensure that each client +command is issued with a unique tag value. This tag value is referred +to by the IMAPClient module as the transaction number. A history is +maintained by the IMAPClient object documenting each transaction. The +L method returns the number of the last transaction, and +can be used to retrieve lines of text from the object's history. + +The L parameter is used to control the size of the session +history so that long-running sessions do not eat up unreasonable +amounts of memory. See the discussion of L parameter for more +information. + +The L transaction returns the history of the entire IMAP +session since the initial connection or for the last L +transactions. This provides a record of the entire conversation, +including client command strings and server responses, and is a +wonderful debugging tool as well as a useful source of raw data for +custom parsing. + +=head1 CLASS METHODS + +There are a couple of methods that can be invoked as class methods. +Generally they can be invoked as an object method as well. Note that +if the L method is called as an object method, the object +returned is identical to what have would been returned if L had +been called as a class method. It doesn't give you a copy of the +original object. + +=head2 new + +Example: + + my $imap = Mail::IMAPClient->new(%args) + or die "new failed: $@\n"; + +The L method creates a new instance of an IMAPClient object. + +If the L parameter is passed as an argument to B, then +B will implicitly call the L method, placing the new +object in the I state. If L and L values +are also provided, then L will in turn call L, and +the resulting object will be returned from B in the +I state. + +If the L parameter is not supplied then the IMAPClient +object is created in the I state. + +If the B method is passed arguments then those arguments will be +treated as a list of key=>value pairs. The key should be one of the +parameters as documented under L below. + +Here are some examples: + + use Mail::IMAPClient; + + # returns an unconnected Mail::IMAPClient object: + my $imap = Mail::IMAPClient->new; + # ... + # intervening code using the 1st object, then: + # (returns a new, authenticated Mail::IMAPClient object) + $imap = Mail::IMAPClient->new( + Server => $host, + User => $id, + Password => $pass, + Clear => 5, # Unnecessary since '5' is the default + # ... # Other key=>value pairs go here + ) + or die "Cannot connect to $host as $id: $@"; + +See also L, L and L for more +information on how to manually connect and login after B. + +=head2 Quote + +Example: + + $imap->search( HEADER => 'Message-id' => \$imap->Quote($msg_id) ); + +The B method accepts a value as an argument and returns its +argument as a correctly quoted string or a literal string. Since +version 3.17 Mail::IMAPClient automatically quotes search arguments we +use a SCALARREF so search will not modify or re-quite the valaue +returned by B. + +Note this method should not be used on folder names for +Mail::IMAPClient methods, since methods that accept folder names as an +argument will quote the folder name arguments appropriately +automatically. + +If you are getting unexpected results when running methods with values +that have (or might have) embedded spaces, double quotes, braces, or +parentheses, then calling B may be necessary. This method +should B be used with arguments that are wrapped in quotes or +parens if those quotes or parens are required by RFC3501. For +example, if the RFC requires an argument in this format: + + ( argument ) + +and the argument is (or might be) "pennies (from heaven)", then one +could use: + + $argument = "(" . $imap->Quote($argument) . ")" + +Of course, the fact that sometimes these characters are sometimes +required delimiters is precisely the reason you must quote them when +they are I delimiting. + +However, there are times when a method fails unexpectedly and may +require the use of B to work. Should this happen, you can +probably file a bug/enhancement request for Mail::IMAPClient to +safeguard the particular call/case better. + +An example is RFC822 Message-id's, which I don't contain +quotes or parens. When dealing with these it is usually best to take +proactive, defensive measures from the very start and use B. + +=head2 Range + +Example: + + my $parsed = $imap->parse_headers( + $imap->Range( $imap->messages ), "Date", "Subject" + ); + +The B method will condense a list of message sequence numbers +or message UID's into the most compact format supported by RFC3501. +It accepts one or more arguments, each of which can be: + +=over 4 + +=item a) a message number, + +=item b) a comma-separated list of message numbers, + +=item c) a colon-separated range of message numbers (i.e. "$begin:$end") + +=item d) a combination of messages and message ranges, separated by commas +(i.e. 1,3,5:8,10), or + +=item e) a reference to an array whose elements are like I through I. + +=back + +The B method returns a L object. +The object uses L and if treated as a string it will act +like a string. This means you can ignore its objectivity and just +treat it like a string whose value is your message set expressed in +compact format. + +This method provides an easy way to add or remove messages from a +message set. + +For more information see L. + +=head2 Rfc3501_date + +Example: + + $Rfc3501_date = $imap->Rfc3501_date($seconds); + # or: + $Rfc3501_date = Mail::IMAPClient->Rfc3501_date($seconds); + +The B method accepts one input argument, a number of +seconds since the epoch date. It returns an RFC3501 compliant date +string for that date (as required in date-related arguments to SEARCH, +such as "since", "before", etc.). + +=head2 Rfc3501_datetime + +Example: + + $date = $imap->Rfc3501_datetime($seconds); + # or: + $date = Mail::IMAPClient->Rfc3501_datetime($seconds); + +The B method accepts one or two arguments: a +obligatory timestamp and an optional zone. The zone shall be +formatted as C<< [+-]\d{4} >>, and defaults to C<< +0000 >>. The +timestamp follows the definition of the output of the platforms +specific C +method and cannot be invoked as class methods. + +There object methods typically fall into one of two categories. There +are mailbox methods which participate in the IMAP session's +conversation (i.e. they issue IMAP client commands) and object control +methods which do not result in IMAP commands but which may affect +later commands or provide details of previous ones. + +This object control methods can be further broken down into two +types, Parameter accessor methods, which affect the behavior of future +mailbox methods, and L, which report on the affects +of previous mailbox methods. + +Methods that do not result in new IMAP client commands being issued +(such as the L, L, and L methods) all +begin with an uppercase letter, to distinguish them from methods that +do correspond to IMAP client commands. Class methods and eponymous +parameter methods likewise begin with an uppercase letter because they +also do not correspond to an IMAP client command. + +As a general rule, mailbox control methods return C on failure +and something besides C when they succeed. This rule is +modified in the case of methods that return search results. When +called in a list context, searches that do not find matching results +return an empty list. When called in a scalar context, searches with +no hits return 'undef' instead of an array reference. If you want to +know why you received no hits, you should check L or +C<$@>, which will be empty if the search was successful but had no +matching results but populated with an error message if the search +encountered a problem (such as invalid parameters). + +A number of IMAP commands do not have corresponding Mail::IMAPClient +methods. Patches are welcome. In the pre-2.99 releases of this +module, they were automatically created (AUTOLOAD), but that was very +error-prone and stalled the progress of this module. + +=head1 Mailbox Control Methods + +=head2 append + +Example: + + my $uid = $imap->append($folder,$msg_text) + or die "Could not append: ", $imap->LastError; + +The B method adds a message to the specified folder. It takes +two arguments, the name of the folder to append the message to, and +the text of the message (including headers). Additional arguments are +added to the message text, separated with . + +The B method returns the UID of the new message (a true value) +if successful, or C if not, if the IMAP server has the UIDPLUS +capability. If it doesn't then you just get true on success and undef +on failure. + +Note that many servers will get really ticked off if you try to append +a message that contains "bare newlines", which is the titillating term +given to newlines that are not preceded by a carriage return. To +protect against this, B will insert a carriage return before +any newline that is "bare". If you don't like this behavior then you +can avoid it by not passing naked newlines to B. + +Note that B does not allow you to specify the internal date or +initial flags of an appended message. If you need this capability +then use L, below. + +=head2 append_file + +Example: + + my $new_msg_uid = $imap->append_file( + $folder, + $filename, + [ $input_record_separator, flags, date ] # optional + ) or die "Could not append_file: ", $imap->LastError; + +The B method adds a message to the specified folder. It +takes two arguments, the name of the folder to append the message to, +and the file name of an RFC822-formatted message. + +An optional third argument is the value to use for +C. The default is to use "" for the first +read (to get the headers) and "\n" for the rest. Any valid value for +C<$/> is acceptable, even the funky stuff, like C<\1024>. (See +L for more information on C<$/>). (The brackets in +the example indicate that this argument is optional; they do not mean +that the argument should be an array reference.) + +The B method returns the UID of the new message (a true +value) if successful, or C if not, if the IMAP server has the +UIDPLUS capability. If it doesn't then you just get true on success +and undef on failure. If you supply a filename that doesn't exist +then you get an automatic C. The L method will +remind you of this if you forget that your file doesn't exist but +somehow manage to remember to check L. + +In case you're wondering, B is provided mostly as a way +to allow large messages to be appended without having to have the +whole file in memory. It uses the C<-s> operator to obtain the size +of the file and then reads and sends the contents line by line (or +not, depending on whether you supplied that optional third argument). + +=head2 append_string + +Example: + + # brackets indicate optional arguments (not array refs): + my $uid = $imap->append_string( $folder, $text [,$flags [,$date ] ]) + or die "Could not append_string: $@\n"; + +The B method adds a message to the specified folder. +It requires two arguments, the name of the folder to append the +message to, and the text of the message (including headers). The +message text must be included in a single string (unlike L, +above). + +You can optionally specify a third and fourth argument to +B. The third argument, if supplied, is the list of +flags to set for the appended message. The list must be specified as +a space-separated list of flags, including any backslashes that may be +necessary. The enclosing parentheses that are required by RFC3501 are +optional for B. The fourth argument, if specified, is +the date to set as the internal date. It should be in the format +described for I fields in RFC3501, i.e. "dd-Mon-yyyy +hh:mm:ss +0000". + +If you want to specify a date/time but you don't want any flags then +specify I as the third argument. + +The B method returns the UID of the new message (a true +value) if successful, or C if not, if the IMAP server has the +UIDPLUS capability. If it doesn't then you just get true on success +and undef on failure. + +Note that many servers will get really ticked off if you try to append +a message that contains "bare newlines", which is the titillating term +given to newlines that are not preceded by a carriage return. To +protect against this, B will insert a carriage return +before any newline that is "bare". If you don't like this behavior +then you can avoid it by not passing naked newlines to +B. + +=head2 authenticate + +Example: + + $imap->authenticate( $authentication_mechanism, $coderef ) + or die "Could not authenticate: ", $imap->LastError; + +This method implements the AUTHENTICATE IMAP client command. It can +be called directly or may be called by L if the +L parameter is set to anything except 'LOGIN'. + +The B method accepts two arguments, an authentication +type to be used (ie CRAM-MD5) and a code or subroutine reference to +execute to obtain a response. The B method assumes that +the authentication type specified in the first argument follows a +challenge-response flow. The B method issues the IMAP +Client AUTHENTICATE command and receives a challenge from the server. +That challenge (minus any tag prefix or enclosing '+' characters but +still in the original base64 encoding) is passed as the only argument +to the code or subroutine referenced in the second argument. The +return value from the 2nd argument's code is written to the server as +is, except that a sequence is appended if necessary. + +If one or both of the arguments are not specified in the call to +B but their corresponding parameters have been set +(L and L, respectively) then the parameter +values are used. Arguments provided to the method call however will +override parameter settings. + +If you do not specify a second argument and you have not set the +L parameter, then the first argument must be +one of the authentication mechanisms for which Mail::IMAPClient +has built in support. + +See also the L method, which is the simplest form of +authentication defined by RFC3501. + +=head2 before + +Example: + + my @msgs = $imap->before($Rfc3501_date) + or warn "No messages found before $Rfc3501_date.\n"; + +The B method works just like the L method, below, +except it returns a list of messages whose internal system dates are +before the date supplied as the argument to the B method. + +=head2 body_string + +Example: + + my $string = $imap->body_string($msgId) + or die "Could not body_string: ", $imap->LastError; + +The B method accepts a message sequence number (or a +message UID, if the L parameter is set to true) as an argument +and returns the message body as a string. The returned value contains +the entire message in one scalar variable, without the message +headers. + +=head2 bodypart_string + +Example: + + my $string = $imap->bodypart_string( + $msgid, $part_number, $length, $offset + ) or die "Could not get bodypart string: ", $imap->LastError; + +The B method accepts a message sequence number (or a +message UID, if the L parameter is set to true) and a body part +as arguments and returns the message part as a string. The returned +value contains the entire message part (or, optionally, a portion of +the part) in one scalar variable. + +If an optional third argument is provided, that argument is the number +of bytes to fetch. (The default is the whole message part.) If an +optional fourth argument is provided then that fourth argument is the +offset into the part at which the fetch should begin. The default is +offset zero, or the beginning of the message part. + +If you specify an offset without specifying a length then the offset +will be ignored and the entire part will be returned. + +B will return C if it encounters an error. + +=head2 capability + +Example: + + my $features = $imap->capability + or die "Could not determine capability: ", $imap->LastError; + +The B method returns an array of capabilities as returned +by the CAPABILITY IMAP Client command, or a reference to an array of +capabilities if called in scalar context. If the CAPABILITY IMAP +Client command fails for any reason then the B method will +return C. + +=head2 close + +Example: + + $imap->close or die "Could not close: $@\n"; + +The B method is used to close the currently selected folder via +the CLOSE IMAP client command. According to RFC3501, the CLOSE +command performs an implicit EXPUNGE, which means that any messages +that are flagged as I<\Deleted> (i.e. with the L +method) will now be deleted. If you haven't deleted any messages then +B can be thought of as an "unselect". + +Note: this closes the currently selected folder, not the IMAP session. + +See also L, L, and RFC3501. + +=head2 connect + +Example: + + $imap->connect or die "Could not connect: $@\n"; + +The B method connects an imap object to the server. It +returns C if it fails to connect for any reason. If values are +available for the L and L parameters at the time +that B is invoked, then B will call the L +method after connecting and return the result of the L method +to B's caller. If either or both of the L and +L parameters are unavailable but the connection to the +server succeeds then B returns a pointer to the IMAPClient +object. + +The L parameter must be set (either during L method +invocation or via the L object method) before invoking +B. When the parameter is an absolute file path, an UNIX +socket will get opened. If the L parameter is supplied to +the L method then B is implicitly called during object +construction. + +The B method sets the state of the object to C if +it successfully connects to the server. It returns C on +failure. + +=head2 copy + +Example: + + # Here brackets indicate optional arguments: + my $uidList = $imap->copy($folder, $msg_1 [ , ... , $msg_n ]) + or die "Could not copy: $@\n"; + +Or: + + # Now brackets indicate an array ref! + my $uidList = $imap->copy($folder, [ $msg_1, ... , $msg_n ]) + or die "Could not copy: $@\n"; + +The B method requires a folder name as the first argument, and a +list of one or more messages sequence numbers (or messages UID's, if +the I parameter is set to a true value). The message sequence +numbers or UID's should refer to messages in the currently selected +folder. Those messages will be copied into the folder named in the +first argument. + +The B method returns C on failure and a true value if +successful. If the server to which the current Mail::IMAPClient +object is connected supports the UIDPLUS capability then the true +value returned by B will be a comma separated list of UID's, +which are the UID's of the newly copied messages in the target folder. + +=head2 create + +Example: + + $imap->create($new_folder) + or die "Could not create $new_folder: $@\n"; + +The B method accepts one argument, the name of a folder (or +what RFC3501 calls a "mailbox") to create. If you specify additional +arguments to the B method and your server allows additional +arguments to the CREATE IMAP client command then the extra argument(s) +will be passed to your server. + +If you specify additional arguments to the B method and your +server does not allow additional arguments to the CREATE IMAP client +command then the extra argument(s) will still be passed to your server +and the create will fail. + +B returns a true value on success and C on failure. + +=head2 date + +Example: + + my $date = $imap->date($msg); + +The B method accepts one argument, a message sequence number (or +a message UID if the L parameter is set to a true value). It +returns the date of message as specified in the message's RFC822 +"Date: " header, without the "Date: " prefix. + +The B method is a short-cut for: + + my $date = $imap->get_header($msg,"Date"); + +=head2 delete + +Example: + + $imap->delete($folder) or die "Could not delete $folder: $@\n"; + +The B method accepts a single argument, the name of a folder +to delete. It returns a true value on success and C on +failure. + +=head2 delete_message + +Example: + + my @msgs = $imap->seen; + scalar(@msgs) and $imap->delete_message(\@msgs) + or die "Could not delete_message: $@\n"; + +The above could also be rewritten like this: + + # scalar context returns array ref + my $msgs = scalar($imap->seen); + + scalar(@$msgs) and $imap->delete_message($msgs) + or die "Could not delete_message: $@\n"; + +Or, as a one-liner: + + $imap->delete_message( scalar($imap->seen) ) + or warn "Could not delete_message: $@\n"; + # just give warning in case failure is + # due to having no 'seen' msgs in the 1st place! + +The B method accepts a list of arguments. If the +L parameter is not set to a true value, then each item in the +list should be either: + +=over 4 + +=item * + +a message sequence number, + +=item * + +a comma-separated list of message sequence numbers, + +=item * + +a reference to an array of message sequence numbers, or + +=back + +If the L parameter is set to a true value, then each item in the +list should be either: + +=over 4 + +=item * + +a message UID, + +=item * + +a comma-separated list of UID's, or + +=item * + +a reference to an array of message UID's. + +=back + +The messages identified by the sequence numbers or UID's will be +deleted. If successful, B returns the number of +messages it was told to delete. However, since the delete is done by +issuing the I<+FLAGS.SILENT> option of the STORE IMAP client command, +there is no guarantee that the delete was successful for every +message. In this manner the B method sacrifices +accuracy for speed. Generally, though, if a single message in a list +of messages fails to be deleted it's because it was already deleted, +which is what you wanted anyway so why worry about it? If there is a +more severe error, i.e. the server replies "NO", "BAD", or, banish the +thought, "BYE", then B will return C. + +If you must have guaranteed results then use the IMAP STORE client +command (via the default method) and use the +FLAGS (\Deleted) option, +and then parse your results manually. + +Eg: + + $imap->store( $msg_id, '+FLAGS (\Deleted)' ); + my @results = $imap->History( $imap->Transaction ); + ... # code to parse output goes here + +(Frankly I see no reason to bother with any of that; if a message +doesn't get deleted it's almost always because it's already not there, +which is what you want anyway. But 'your mileage may vary' and all +that.) + +The IMAPClient object must be in C status to use the +B method. + +B: All the messages identified in the input argument(s) must be in +the currently selected folder. Failure to comply with this +requirement will almost certainly result in the wrong message(s) being +deleted. + +B: In the grand tradition of the IMAP protocol, +deleting a message doesn't actually delete the message. Really. If +you want to make sure the message has been deleted, you need to +expunge the folder (via the L method, which is implemented +via the default method). Or at least L it. This is generally +considered a feature, since after deleting a message, you can change +your mind and undelete it at any time before your L or +L. + +See also: the L method, to delete a folder, the L +method, to expunge a folder, the L method to +undelete a message, and the L method (implemented here via the +default method) to close a folder. Oh, and don't forget about RFC3501. + +=head2 deny_seeing + +Example: + + # Reset all read msgs to unread + # (produces error if there are no seen msgs): + $imap->deny_seeing( scalar($imap->seen) ) + or die "Could not deny_seeing: $@\n"; + +The B method accepts a list of one or more message +sequence numbers, or a single reference to an array of one or more +message sequence numbers, as its argument(s). It then unsets the +"\Seen" flag for those messages (so that you can "deny" that you ever +saw them). Of course, if the L parameter is set to a true value +then those message sequence numbers should be unique message id's. + +Note that specifying C<$imap-Edeny_seeing(@msgs)> is just a +shortcut for specifying C<$imap-Eunset_flag("Seen",@msgs)>. + +=head2 disconnect + +Example: + + $imap->disconnect or warn "Could not 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] ) + +Example: + + my $hashref = {}; + $imap->fetch_hash( "RFC822.SIZE", $hashref ); + print "Msg #$m is $hashref->{$m} bytes\n" foreach my $m (keys %$hashref); + +The B method accepts a list of message attributes to be +fetched (as described in RFC3501). It returns a hash whose keys are +all the messages in the currently selected folder and whose values are +key-value pairs of fetch keywords and the message's value for that +keyword (see sample output below). + +If B is called in scalar context, it returns a reference +to the hash instead of the hash itself. If the last argument is a hash +reference, then that hash reference will be used as the place where +results are stored (and that reference will be returned upon +successful completion). If the last argument is not a reference then +it will be treated as one of the FETCH attributes and a new hash will +be created and returned (either by value or by reference, depending on +the context in which B was called). + +For example, if you have a folder with 3 messages and want the size +and internal date for each of them, you could do the following: + + use Mail::IMAPClient; + use Data::Dumper; + # ... other code goes here + $imap->select($folder); + my $hash = $imap->fetch_hash("RFC822.SIZE","INTERNALDATE"); + # (Same as: + # my $hash = $imap->fetch_hash("RFC822.SIZE"); + # $imap->fetch_hash("INTERNALDATE",$hash); + # ). + print Data::Dumper->Dumpxs([$hash],['$hash']); + +This would result in L output similar to the following: + + $hash = { + '1' => { + 'INTERNALDATE' => '21-Sep-2002 18:21:56 +0000', + 'RFC822.SIZE' => '1586', + }, + '2' => { + 'INTERNALDATE' => '22-Sep-2002 11:29:42 +0000', + 'RFC822.SIZE' => '1945', + }, + '3' => { + 'INTERNALDATE' => '23-Sep-2002 09:16:51 +0000', + 'RFC822.SIZE' => '134314', + } + }; + +By itself this method may be useful for, say, speeding up programs that +want the size of every message in a folder. It issues one command and +receives one (possibly long!) response from the server. However, it's +true power lies in the as-yet-unwritten methods that will rely on this +method to deliver even more powerful result hashes. Look for more new +function in later releases. + +This method is new with version 2.2.3 and is thus still experimental. +If you decide to try this method and run into problems, please see the +section on L. + +=head2 flags + +Example: + + my @flags = $imap->flags($msgid) + or die "Could not flags: $@\n"; + +The B method implements the FETCH IMAP client command to list a +single message's flags. It accepts one argument, a message sequence +number (or a message UID, if the L parameter is true), and +returns an array (or a reference to an array, if called in scalar +context) listing the flags that have been set. Flag names are +provided with leading backslashes. + +As of version 1.11, you can supply either a list of message id's or a +reference to an array of of message id's (which means either sequence +number, if the Uid parameter is false, or message UID's, if the Uid +parameter is true) instead of supplying a single message sequence +number or UID. If you do, then the return value will not be an array +or array reference; instead, it will be a hash reference, with each +key being a message sequence number (or UID) and each value being a +reference to an array of flags set for that message. + +For example, if you want to display the flags for every message in the +folder where you store e-mail related to your plans for world +domination, you could do something like this: + + use Mail::IMAPClient; + my $imap = Mail::IMAPClient->new( + Server => $imaphost, + User => $login, + Password => $pass, + Uid => 1, # optional + ); + + $imap->select("World Domination"); + # get the flags for every message in my 'World Domination' folder + $flaghash = $imap->flags( scalar( $imap->search("ALL") ) ); + + # pump through sorted hash keys to print results: + for my $k (sort { $flaghash->{$a} <=> $flaghash->{$b} } keys %$flaghash) { + # print: Message 1: \Flag1, \Flag2, \Flag3 + print "Message $k:\t",join(", ",@{$flaghash->{$k}}),"\n"; + } + +=head2 folders + +Example: + + $imap->folders or die "Could not list folders: $@\n"; + +The B method returns an array listing the available folders. +It will only be successful if the object is in the I or +I states. + +The B argument accepts one optional argument, which is a +prefix. If a prefix is supplied to the B method, then only +folders beginning with the prefix will be returned. + +For example: + + print join(", ",$imap->folders),".\n"; + # Prints: + # INBOX, Sent, Projects, Projects/Completed, Projects/Ongoing, Projects Software. + print join(", ",$imap->folders("Projects"),".\n"; + # Prints: + # Projects, Projects/Completed, Projects/Ongoing, Projects Software. + print join(", ",$imap->folders("Projects" . $imap->separator),".\n"; + # Prints: + # Projects/Completed, Projects/Ongoing + +Notice that if you just want to list a folder's subfolders (and not +the folder itself), then you need to include the hierarchy separator +character (as returned by the L method). + +=head2 xlist_folders + +Example: + + my $xlist = $imap->xlist_folders + or die "Could not get xlist folders.\n"; + +IMAP servers implementing the XLIST extension (such as Gmail) +designate particular folders to be used for particular functions. +This is useful in the case where you want to know which folder should +be used for Trash when the actual folder name can't be predicted +(e.g. in the case of Gmail, the folder names change depending on the +user's locale settings). + +The B method returns a hash listing any "xlist" folder +names, with the values listing the actual folders that should be used +for those names. For example, using this method with a Gmail user +using the English (US) locale might give this output from +L: + + $VAR1 = { + 'Inbox' => 'Inbox', + 'AllMail' => '[Gmail]/All Mail', + 'Trash' => '[Gmail]/Trash', + 'Drafts' => '[Gmail]/Drafts', + 'Sent' => '[Gmail]/Sent Mail', + 'Spam' => '[Gmail]/Spam', + 'Starred' => '[Gmail]/Starred' + }; + +The same list for a user using the French locale might look like this: + + $VAR1 = { + 'Inbox' => 'Bo&AO4-te de r&AOk-ception', + 'AllMail' => '[Gmail]/Tous les messages', + 'Trash' => '[Gmail]/Corbeille', + 'Drafts' => '[Gmail]/Brouillons', + 'Sent' => '[Gmail]/Messages envoy&AOk-s', + 'Spam' => '[Gmail]/Spam', + 'Starred' => '[Gmail]/Suivis' + }; + +Mail::IMAPClient recognizes the following "xlist" folder names: + +=over 4 + +=item Inbox + +=item AllMail + +=item Trash + +=item Drafts + +=item Sent + +=item Spam + +=item Starred + +=back + +These are currently the only ones supported by Gmail. The XLIST +extension is not documented, and there are no other known +implementations other than Gmail, so this list is based on what Gmail +provides. + +If the server does not support the XLIST extension, this method +returns undef. + +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. 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 + +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 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. + +=head2 get_bodystructure + +Example: + + my $bodyStructObject = $imap->get_bodystructure($msgid) + or die "Could not get_bodystructure: $@\n"; + +The B method accepts one argument, a message +sequence number or, if L is true, a message UID. It obtains the +message's body structure and returns a parsed +L object for the message. + +=head2 get_envelope + +Example: + + my $envObject = $imap->get_envelope(@args) + or die "Could not get_envelope: $@\n"; + +The B method accepts one argument, a message sequence +number or, if L is true, a message UID. It obtains the +message's envelope and returns a +B object for the envelope, +which is just a version of the envelope that's been parsed into a Perl +object. + +For more information on how to use this object once you've gotten it, +see the L documention. (As of this +writing there is no separate pod document for +B.) + +=head2 getacl + +Example: + + my $hash = $imap->getacl($folder) + or die "Could not getacl for $folder: $@\n"; + +B accepts one argument, the name of a folder. If no argument +is provided then the currently selected folder is used as the default. +It returns a reference to a hash. The keys of the hash are userids +that have access to the folder, and the value of each element are the +permissions for that user. The permissions are listed in a string in +the order returned from the server with no white space or punctuation +between them. + +=head2 get_header + +Example: + + my $messageId = $imap->get_header( $msg, "Message-Id" ); + +The B method accepts two arguments, a message sequence +number or UID and the name of an RFC822 header (without the trailing +colon). It returns the value for that header in the message whose +sequence number or UID was passed as the first argument. If no value +can be found it returns C; if multiple values are found it +returns the first one. Its return value is always a scalar. +B uses case insensitive matching to get the value, so you +do not have to worry about the case of your second argument. + +The B method is a short-cut for: + + my $messageId = $imap->parse_headers($msg,"Subject")->{"Subject"}[0]; + +=head2 is_parent + +Example: + + my $hasKids = $imap->is_parent($folder); + +The B method accepts one argument, the name of a folder. It +returns a value that indicates whether or not the folder has children. +The value it returns is either 1) a true value (indicating that the +folder has children), 2) 0 if the folder has no children at this time, +or 3) C if the folder is not permitted to have children. + +Eg: + + my $parenthood = $imap->is_parent($folder); + if (defined($parenthood)) { + if ($parenthood) { + print "$folder has children.\n"; + } else { + print "$folder is permitted children, but has none.\n"; + } + } else { + print "$folder is not permitted to have children.\n"; + } + +=head2 list + +Example: + + my @raw_output = $imap->list(@args) + or die "Could not list: $@\n"; + +The B method implements the IMAP LIST client command. Arguments +are passed to the IMAP server as received, separated from each other +by spaces. If no arguments are supplied then the default list command +C is issued. + +The B method returns an array (or an array reference, if called +in a scalar context). The array is the unadulterated output of the +LIST command. (If you want your output adulterated then see the +L method, above.) + +An C value is returned in case of errors. Be sure to check for +it. + +=head2 listrights + +Example: + + $imap->listrights($folder,$user) + or die "Could not listrights: $@\n"; + +The B method implements the IMAP LISTRIGHTS client command +(L). It accepts two arguments, the foldername and a user id. +It returns the rights the specified user has for the specified folder. +If called in a scalar context then the rights are returned a strings, +with no punctuation or white space or any nonsense like that. If called +in array context then B returns an array in which each +element is one right. + +=head2 login + +Example: + + $imap->login or die "Could not login: $@\n"; + +The B method implements the IMAP LOGIN client command to log +into the server. It automatically calls L if the +I parameter is set to anything except 'LOGIN' otherwise +a clear text LOGIN is attempted. + +The I and I parameters must be set before the B +method can be invoked. On success, a Mail::IMAPClient object with the +Status of I is returned. On failure, undef is returned +and $@ is set. The methods L, L, and L may +automatically invoke B see the documentation of each method for +details. + +See also L and L for additional information +regarding ways of authenticating with a server via SASL and/or +PROXYAUTH. + +=head2 proxyauth + +Example: + + $imap->login("admin", "password"); + $imap->proxyauth("someuser"); + +The B method implements the IMAP PROXYAUTH client command. +The command is used by Sun/iPlanet/Netscape IMAP servers to allow an +administrative user to masquerade as another user. + +=head2 logout + +Example: + + $imap->logout or die "Could not logout: $@\n"; + +The B method implements the LOGOUT IMAP client commmand. This +method causes the server to end the connection and the IMAPClient +client enters the I state. This method does not, destroy +the IMAPClient object, thus the L and L methods can +be used to establish a new IMAP session. + +Per RFC2683, Mail::IMAPClient will attempt to log out of the server +during B if the object is in the L state. + +=head2 lsub + +Example: + + $imap->lsub(@args) or die "Could not lsub: $@\n"; + +The B method implements the IMAP LSUB client command. Arguments +are passed to the IMAP server as received, separated from each other +by spaces. If no arguments are supplied then the default lsub command +C is issued. + +The B method returns an array (or an array reference, if called +in a scalar context). The array is the unaltered output of the LSUB +command. If you want an array of subscribed folders then see the +L method, below. + +=head2 mark + +Example: + + $imap->mark(@msgs) or die "Could not mark: $@\n"; + +The B method accepts a list of one or more messages sequence +numbers, or a single reference to an array of one or more message +sequence numbers, as its argument(s). It then sets the "\Flagged" +flag for those message(s). Of course, if the L parameter is set +to a true value then those message sequence numbers had better be +unique message id's. + +Note that specifying C<$imap-Esee(@msgs)> is just a shortcut for +specifying C<$imap-Eset_flag("Flagged",@msgs)>. + +=head2 Massage + +Example: + + $imap->search(HEADER => 'Message-id' => $imap->Massage($msg_id,1)); + +The B method accepts a value as an argument and, optionally, +a second value that, when true, indicates that the first argument is +not the name of an existing folder. + +It returns its argument as a correctly quoted string or a literal +string. + +Note that you should rarely use this on folder names, since methods +that accept folder names as an argument will call B for +you. In fact, it was originally developed as an undocumented helper +method meant for internal Mail::IMAPClient methods only. + +You may also want to see the L method, which is related to +this method. + +=head2 message_count + +Example: + + my $msgcount = $imap->message_count($folder); + defined($msgcount) or die "Could not message_count: $@\n"; + +The B method accepts the name of a folder as an +argument and returns the number of messages in that folder. +Internally, it invokes the L method (see above) and parses +out the results to obtain the number of messages. If you don't supply +an argument to B then it will return the number of +messages in the currently selected folder (assuming of course that +you've used the L or L method to select it instead +of trying something funky). Note that RFC2683 contains warnings about +the use of the IMAP I command (and thus the L method +and therefore the B method) against the currently +selected folder. You should carefully consider this before using +B on the currently selected folder. You may be better +off using L or one of its variants (especially L), +and then counting the results. On the other hand, I regularly violate +this rule on my server without suffering any dire consequences. Your +mileage may vary. + +=head2 message_string + +Example: + + my $string = $imap->message_string($msgid) + or die "Could not message_string: $@\n"; + +The B method accepts a message sequence number (or +message UID if L is true) as an argument and returns the message +as a string. The returned value contains the entire message in one +scalar variable, including the message headers. Note that using this +method will set the message's "\Seen" flag as a side effect, unless +I is set to a true value. + +=head2 message_to_file + +Example: + + $imap->message_to_file($file,@msgs) + or die "Could not message_to_file: $@\n"; + +The B method accepts a filename or file handle and +one or more message sequence numbers (or message UIDs if L is +true) as arguments and places the message string(s) (including RFC822 +headers) into the file named in the first argument (or prints them to +the file handle, if a file handle is passed). The returned value is +true on success and C on failure. + +If the first argument is a reference, it is assumed to be an open +file handle and will not be closed when the method completes, If it is +a file, it is opened in append mode, written to, then closed. + +Note that using this method will set the message's "\Seen" flag as a +side effect. But you can use the L method to set it +back, or set the L parameter to a true value to prevent setting +the "\Seen" flag at all. + +This method currently works by making some basic assumptions about the +server's behavior, notably that the message text will be returned as a +literal string but that nothing else will be. If you have a better +idea then I'd like to hear it. + +=head2 message_uid + +Example: + + my $msg_uid = $imap->message_uid($msg_seq_no) + or die "Could not get uid for $msg_seq_no: $@\n"; + +The B method accepts a message sequence number (or +message UID if L is true) as an argument and returns the +message's UID. Yes, if L is true then it will use the IMAP UID +FETCH UID client command to obtain and return the very same argument +you supplied. This is an IMAP feature so don't complain to me about +it. + +=head2 messages + +Example: + + # Get a list of messages in the current folder: + my @msgs = $imap->messages or die "Could not messages: $@\n"; + # Get a reference to an array of messages in the current folder: + my $msgs = $imap->messages or die "Could not messages: $@\n"; + +If called in list context, the B method returns a list of +all the messages in the currently selected folder. If called in +scalar context, it returns a reference to an array containing all the +messages in the folder. If you have the L parameter turned off, +then this is the same as specifying C<1 ... $imap-EL>; +if you have UID set to true then this is the same as specifying +C<$imap-EL("ALL")>. + +=head2 migrate + +Example: + + $imap->migrate($imap_2, "ALL", $targetFolder ) + or die "Could not migrate: $@\n"; + +The B method copies the indicated messages B the +currently selected folder B another Mail::IMAPClient object's +session. It requires these arguments: + +=over 4 + +=item 1. + +a reference to the target Mail::IMAPClient object (not the calling +object, which is connected to the source account); + +=item 2. + +the message(s) to be copied, specified as either a) the message +sequence number (or message UID if the UID parameter is true) of a +single message, b) a reference to an array of message sequence numbers +(or message UID's if the UID parameter is true) or c) the special +string "ALL", which is a shortcut for the results of +C("ALL")>. + +=item 3. + +the folder name of a folder on the target mailbox to receive the +message(s). If this argument is not supplied or if I is +supplied then a folder with the same name as the currently selected +folder on the calling object will be created if necessary and used. +If you specify something other then I for this argument, even +if it's '$imap1-EFolder' or the name of the currently selected +folder, then that folder will only be used if it exists on the target +object's mailbox; if it does not exist then B will fail. + +=back + +The target Mail::IMAPClient object should not be the same as the +source. The source object is the calling object, i.e. the one whose +B method will be used. It cannot be the same object as the +one specified as the target, even if you are for some reason migrating +between folders on the same account (which would be silly anyway, +since L can do that much more efficiently). If you try to use +the same Mail::IMAPClient object for both the caller and the receiver +then they'll both get all screwed up and it will be your fault because +I just warned you and you didn't listen. + +B will download messages from the source in chunks to +minimize memory usage. The size of the chunks can be controlled by +changing the source Mail::IMAPClient object's the L +parameter. The higher the L value, the faster the migration, +but the more memory your program will require. TANSTAAFL. (See the +L parameter and eponymous accessor method, described above +under the L section.) + +The B method uses Black Magic to hardwire the I/O between the +two Mail::IMAPClient objects in order to minimize resource +consumption. If you have older scripts that used L +and L to move large messages between IMAP mailboxes then +you may want to try this method as a possible replacement. + +See also C. + +=head2 move + +Example: + + my $newUid = $imap->move($newFolder, $oldUid) + or die "Could not move: $@\n"; + $imap->expunge; + +The B method moves messages from the currently selected folder +to the folder specified in the first argument to B. If the +L parameter is not true, then the rest of the arguments should +be either: + +=over 4 + +=item > + +a message sequence number, + +=item > + +a comma-separated list of message sequence numbers, or + +=item > + +a reference to an array of message sequence numbers. + +=back + +If the L parameter is true, then the arguments should be: + +=over 4 + +=item > + +a message UID, + +=item > + +a comma-separated list of message UID's, or + +=item > + +a reference to an array of message UID's. + +=back + +If the target folder does not exist then it will be created. + +If move is successful, then it returns a true value. Furthermore, if +the Mail::IMAPClient object is connected to a server that has the +UIDPLUS capability, then the true value will be the comma-separated +list of UID's for the newly copied messages. The list will be in the +order in which the messages were moved. (Since B uses the copy +method, the messages will be moved in numerical order.) + +If the move is not successful then B returns C. + +Note that a move really just involves copying the message to the new +folder and then setting the I<\Deleted> flag. To actually delete the +original message you will need to run L (or L). + +=head2 namespace + +Example: + + my $refs = $imap->namespace + or die "Could not namespace: $@\n"; + +The namespace method runs the NAMESPACE IMAP command (as defined in +RFC 2342). When called in a list context, it returns a list of three +references. Each reference looks like this: + + [ + [ $prefix_1, $separator_1 ], + [ $prefix_2, $separator_2 ], + [ $prefix_n, $separator_n ], + ] + +The first reference provides a list of prefixes and separator +characters for the available personal namespaces. The second +reference provides a list of prefixes and separator characters for the +available shared namespaces. The third reference provides a list of +prefixes and separator characters for the available public namespaces. + +If any of the three namespaces are unavailable on the current server +then an 'undef' is returned instead of a reference. So for example if +shared folders were not supported on the server but personal and +public namespaces were both available (with one namespace each), the +returned value might resemble this: + + [ [ "", "/" ] , undef, [ "#news", "." ] ]; + +If the B method is called in scalar context, it returns a +reference to the above-mentioned list of three references, thus +creating a single structure that would pretty-print something like +this: + + $VAR1 = [ + [ + [ $user_prefix_1, $user_separator_1 ], + [ $user_prefix_2, $user_separator_2 ], + [ $user_prefix_n, $user_separator_n ], + ], # or undef + [ + [ $shared_prefix_1, $shared_separator_1 ], + [ $shared_prefix_2, $shared_separator_2 ], + [ $shared_prefix_n, $shared_separator_n ], + ], # or undef + [ + [ $public_prefix_1, $public_separator_1 ], + [ $public_prefix_2, $public_separator_2 ], + [ $public_prefix_n, $public_separator_n ], + ], # or undef + ]; + +=head2 on + +Example: + + my @msgs = $imap->on($Rfc3501_date) + or warn "Could not find messages sent on $Rfc3501_date: $@\n"; + +The B method works just like the L method, below, except +it returns a list of messages whose internal system dates are the same +as the date supplied as the argument. + +=head2 parse_headers + +Example: + + my $hashref = $imap->parse_headers($msg||\@msgs, "Date", "Subject") + or die "Could not parse_headers: $@\n"; + +The B method accepts as arguments a message sequence +number and a list of header fields. It returns a hash reference in +which the keys are the header field names (without the colon) and the +values are references to arrays of values. A picture would look +something like this: + + $hashref = $imap->parse_headers(1,"Date","Received","Subject","To"); + $hashref = { + "Date" => [ "Thu, 09 Sep 1999 09:49:04 -0400" ] , + "Received" => [ q/ + from mailhub ([111.11.111.111]) by mailhost.bigco.com + (Netscape Messaging Server 3.6) with ESMTP id AAA527D for + ; Fri, 18 Jun 1999 16:29:07 +0000 + /, q/ + from directory-daemon by mailhub.bigco.com (PMDF V5.2-31 #38473) + id <0FDJ0010174HF7@mailhub.bigco.com> for bigshot@bigco.com + (ORCPT rfc822;big.shot@bigco.com); Fri, 18 Jun 1999 16:29:05 +0000 (GMT) + /, q/ + from someplace ([999.9.99.99]) by smtp-relay.bigco.com (PMDF V5.2-31 #38473) + with ESMTP id <0FDJ0000P74H0W@smtp-relay.bigco.com> for big.shot@bigco.com; Fri, + 18 Jun 1999 16:29:05 +0000 (GMT) + /] , + "Subject" => [ qw/ Help! I've fallen and I can't get up!/ ] , + "To" => [ "Big Shot ] , + }; + +The text in the example for the "Received" array has been formatted to +make reading the example easier. The actual values returned are just +strings of words separated by spaces and with newlines and carriage +returns stripped off. The I header is probably the main +reason that the B method creates a hash of lists rather +than a hash of values. + +If the second argument to B is 'ALL' or if it is +unspecified then all available headers are included in the returned +hash of lists. + +If you're not emotionally prepared to deal with a hash of lists then +you can always call the L method yourself with the appropriate +parameters and parse the data out any way you want to. Also, in the +case of headers whose contents are also reflected in the envelope, you +can use the L method as an alternative to +L. + +If the L parameter is true then the first argument will be +treated as a message UID. If the first argument is a reference to an +array of message sequence numbers (or UID's if L is true), then +B will be run against each message in the array. In +this case the return value is a hash, in which the key is the message +sequence number (or UID) and the value is a reference to a hash as +described above. + +An example of using B to print the date and subject of +every message in your smut folder could look like this: + + use Mail::IMAPClient; + my $imap = Mail::IMAPClient->new( + Server => $imaphost, User => $login, Password => $pass, Uid => 1 + ); + + $imap->select("demo"); + + my $msgs = $imap->search("ALL"); + for my $h ( + + # get the Subject and Date from every message in folder "demo" the + # first arg is a reference to an array listing all messages in the + # folder (which is what gets returned by the $imap->search("ALL") + # method when called in scalar context) and the remaining arguments + # are the fields to parse out The key is the message number, which + # in this case we don't care about: + + values %{ $imap->parse_headers( $msgs , "Subject", "Date") } ) + { + # $h is the value of each element in the hash ref returned + # from parse_headers, and $h is also a reference to a hash. + # We'll only print the first occurrence of each field because + # we don't expect more than one Date: or Subject: line per + # message. + print map { "$_:\t$h->{$_}[0]\n"} keys %$h; + } + +=head2 recent + +Example: + + my @recent = $imap->recent or warn "No recent msgs: $@\n"; + +The B method performs an IMAP SEARCH RECENT search against the +selected folder and returns an array of sequence numbers (or UID's, if +the L parameter is true) of messages that are recent. + +=head2 recent_count + +Example: + + my $count = 0; + defined($count = $imap->recent_count($folder)) + or die "Could not recent_count: $@\n"; + +The B method accepts as an argument a folder name. It +returns the number of recent messages in the folder (as returned by +the IMAP client command "STATUS folder RECENT"), or C in the +case of an error. The B method was contributed by Rob +Deker (deker@ikimbo.com). + +=head2 reconnect + +Example: + $imap->noop or $imap->reconnect or die "noop failed: $@\n"; + +Attempt to reconnect if the IMAP connection unless $imap is already in +the IsConnected state. This method calls L and optionally +L if a Folder was previously selected. On success, returns +the (same) $imap object. On failure is returned and +L is set. + +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. The default +is 143, which is the standard IMAP port. Can be supplied with the +L method call or separately by calling the L object +method. + +=head2 Prewritemethod + +I parameter should contain a reference to a subroutine +that will do "special things" to data before it is sent to the IMAP +server (such as encryption or signing). + +This method will be called immediately prior to sending an IMAP client +command to the server. Its first argument is a reference to the +I object and the second argument is a string +containing the command that will be sent to the server. Your +I should return a string that has been signed or +encrypted or whatever; this returned string is what will actually be +sent to the server. + +Your I will probably need to know more than this to do +whatever it does. It is recommended that you tuck all other pertinent +information into a hash, and store a reference to this hash somewhere +where your method can get to it, possibly in the I +object itself. + +Note that this method should not actually send anything over the +socket connection to the server; it merely converts data prior to +sending. + +See also L. + +=head2 Ranges + +Example: + + $imap->Ranges(1); + # or: + my $search = $imap->search(@search_args); + if ( $imap->Ranges) { # $search is a MessageSet object + print "This is my condensed search result: $search\n"; + print "This is every message in the search result: ", + join(",",@$search),"\n; + } + +If set to a true value, then the L method will return a +L object if called in a scalar context, +instead of the array reference that B normally returns when +called in a scalar context. If set to zero or if undefined, then +B will continue to return an array reference when called in +scalar context. + +This parameter has no affect on the B method when B +is called in a list context. + +=head2 RawSocket + +Example: + $socket = $imap->RawSocket; + # or: + $imap->RawSocket($socketh); + +The I method can be used to obtain the socket handle of the +current connection (say, to do I/O on the connection that is not +otherwise supported by Mail::IMAPClient) or to replace the current +socket with a new handle (for instance an SSL handle, see +L, but be sure to see the L method as well). + +If you supply a socket handle yourself, either by doing something like: + + $imap=Mail::IMAPClient->new(RawSocket => $sock, User => ... ); + +or by doing something like: + + $imap = Mail::IMAPClient->new(User => $user, + Password => $pass, Server => $host); + # blah blah blah + $imap->RawSocket($ssl); + +then it will be up to you to establish the connection AND to +authenticate, either via the L method, or the fancier +L, or, since you know so much anyway, by just doing raw +I/O against the socket until you're logged in. If you do any of this +then you should also set the L parameter yourself to reflect +the current state of the object (i.e. Connected, Authenticated, etc). + +Note that no operation will be attempted on the socket when this +method is called. In particular, after the TCP connections towards +the IMAP server is established, the protocol mandates the server to +send an initial greeting message, and you will have to explicitly cope +with this message before doing any other operation, e.g. trying to +call L. Caveat emptor. + +For a more DWIM approach to setting the socket see L. + +=head2 Readmethod + +Example: + + $imap->Readmethod( # IMAP, HANDLE, BUFFER, LENGTH, OFFSET + sub { + my ( $self, $handle, $buffer, $count, $offset ) = @_; + my $rc = sysread( $handle, $$buffer, $count, $offset ); + # do something useful here... + } + ); + +B should contain a reference to a subroutine that will +replace sysread. The subroutine will be passed the following +arguments: first the used Mail::IMAPClient object. Second, a +reference to a socket. Third, a reference to a scalar variable into +which data is read (BUFFER). The data placed here should be "finished +data", so if you are decrypting or removing signatures then be sure to +do that before you place data into this buffer. Fourth, the number of +bytes requested to be read; the LENGTH of the request. Lastly, the +OFFSET into the BUFFER where the data should be read. If not supplied +it should default to zero. + +Note that this method completely replaces reads from the connection +to the server, so if you define one of these then your subroutine will +have to actually do the read. It is for things like this that we have +the L parameter and eponymous accessor method. + +Your I will probably need to know more than this to do +whatever it does. It is recommended that you tuck all other pertinent +information into a hash, and store a reference to this hash somewhere +where your method can get to it, possibly in the I +object itself. + +See also L. + +=head2 Reconnectretry + +If an IMAP connection sits idle too long, the connection may be closed +by the server or firewall, etc. The B parameter, when +given a positive integer value, will cause Mail::IMAPClient to +retrying IMAP commands up to X times when an EPIPE or ECONNRESET error +occurs. This is disabled (0) by default. + +See also L + +Version note: attribute added in Mail::IMAPClient 3.17 + +=head2 Server + +Example: + + $Server = $imap->Server(); + # or: + $imap->Server($hostname); + +Specifies the hostname or IP address of the host running the IMAP +server. If provided as part of the L method call, then the new +IMAP object will automatically be connected at the time of +instantiation. (See the L method, below.) Can be supplied with +the L method call or separately by calling the B object +method. + +=head2 Showcredentials + +Normally debugging output will mask the login credentials when the +plain text login mechanism is used. Setting I to a +true value will suppress this, so that you can see the string being +passed back and forth during plain text login. Only set this to true +when you are debugging problems with the IMAP LOGIN command, and then +turn it off right away when you're finished working on that problem. + +Example: + + print "This is very risky!\n" if $imap->Showcredentials(); + # or: + $imap->Showcredentials(0); # mask credentials again + +=head2 Socket + +B The semantics of this method has changed as of version +2.99_04 of this module. If you need the old semantics use +L. + +Example: + + $Socket = $imap->Socket(); + # or: + $imap->Socket($socket_fh); + +The I method can be used to obtain the socket handle of the +current connection. This may be necessary to do I/O on the connection +that is not otherwise supported by Mail::IMAPClient) or to replace the +current socket with a new handle (for instance an SSL handle, see +IO::Socket::SSL). + +If you supply a socket handle yourself, either by doing something like: + + $imap = Mail::IMAPClient->new( Socket => $sock, User => ... ); + +or by doing something like: + + $imap = Mail::IMAPClient->new( + User => $user, Password => $pass, Server => $host + ); + $imap->Socket($ssl); + +then you are responsible for establishing the connection, i.e. make +sure that C<$ssl> in the example is a valid and connected socket. + +This method is primarily used to provide a drop-in replacement for +L, used by L by default. In fact, this +method is called by L itself after having established a +suitable L socket connection towards the target +server; for this reason, this method also carries the normal +operations associated with L, namely: + +=over 4 + +=item * + +read the initial greeting message from the server; + +=item * + +call L if the conditions apply (see L for details); + +=item * + +leave the I object in a suitable state. + +=back + +For these reasons, the following example will work "out of the box": + + use IO::Socket::SSL; + my $imap = Mail::IMAPClient->new + ( User => 'your-username', + Password => 'your-password', + Socket => IO::Socket::SSL->new + ( Proto => 'tcp', + PeerAddr => 'some.imap.server', + PeerPort => 993, # IMAP over SSL standard port + ), + ); + +If you need more control over the socket, e.g. you have to implement a +fancier authentication method, see L. + +=head2 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 occured. + +Version note: attribute added in Mail::IMAPClient 3.22 + +=head2 Ssl + +If an IMAP connection requires SSL you can set the Ssl attribute to +'1' and Mail::IMAPClient will automatically use L +instead of L to connect to the server. This +attribute is used in the L method. + +See also L for details on connection initiatiation and +L and L if you need to take more control of +connection management. + +Version note: attribute added in Mail::IMAPClient 3.18 + +=head2 Supportedflags + +Especially when C is used, the receiving peer may need to +be configured explicitly with the list of supported flags; that may +be different from the source IMAP server. + +The names are to be specified as an ARRAY. Black-slashes and casing +will be ignored. + +You may also specify a CODE reference, which will be called for each +of the flags separately. In this case, the flags are not (yet) +normalized. The returned lists of the CODE calls are shape the +resulting flag list. + +=head2 Timeout + +Example: + + $Timeout = $imap->Timeout(); + # or: + $imap->Timeout($seconds); + +Specifies the timeout value in seconds for reads (default is 600). +Specifying a I will prevent Mail::IMAPClient from blocking +in a read. + +Since timeouts are implemented via the Perl L +operator, the I parameter may be set to a fractional number +of seconds. Setting I to 0 (zero) disables the timeout +feature. + +=head2 Uid + +Example: + + $Uid = $imap->Uid(); + # or: + $imap->Uid($true_or_false); + +If L is set to a true value (i.e. 1) then the behavior of the +L, L, L, and L methods (and their +derivatives) is changed so that arguments that would otherwise be +message sequence numbers are treated as message UID's and so that +return values (in the case of the L method and its +derivatives) that would normally be message sequence numbers are +instead message UID's. + +Internally this is implemented as a switch that, if turned on, causes +methods that would otherwise issue an IMAP FETCH, STORE, SEARCH, or +COPY client command to instead issue UID FETCH, UID STORE, UID SEARCH, +or UID COPY, respectively. The main difference between message +sequence numbers and message UID's is that, according to RFC3501, +UID's must not change during a session and should not change between +sessions, and must never be reused. Sequence numbers do not have that +same guarantee and in fact may be reused right away. + +Since folder names also have a unique identifier (UIDVALIDITY), which +is provided when the folder is Led or Ld or by +doing something like "$imap->status($folder,"UIDVALIDITY"), it is +possible to uniquely identify every message on the server, although +normally you won't need to bother. + +The methods currently affected by turning on the L flag are: + + copy fetch + search store + message_string message_uid + body_string flags + move size + parse_headers thread + +Note that if for some reason you only want the L parameter turned +on for one command, then you can choose between the following two +snippets, which are equivalent: + +Example 1: + + $imap->Uid(1); + my @uids = $imap->search('SUBJECT',"Just a silly test"); # + $imap->Uid(0); + +Example 2: + + my @uids; + foreach $r ($imap->UID("SEARCH","SUBJECT","Just a silly test") { + chomp $r; + $r =~ s/\r$//; + $r =~ s/^\*\s+SEARCH\s+// or next; + push @uids, grep(/\d/,(split(/\s+/,$r))); + } + +In the second example, we used the default method to issue the UID +IMAP Client command, being careful to use an all-uppercase method name +so as not to inadvertently call the L accessor method. Then we +parsed out the message UIDs manually, since we don't have the benefit +of the built-in L method doing it for us. + +Please be very careful when turning the L parameter on and off +throughout a script. If you loose track of whether you've got the +L parameter turned on you might do something sad, like deleting +the wrong message. Remember, like all eponymous accessor methods, the +B method without arguments will return the current value for the +L parameter, so do yourself a favor and check. The safest +approach is probably to turn it on at the beginning (or just let it +default to being on) and then leave it on. (Remember that leaving it +turned off can lead to problems if changes to a folder's contents +cause resequencing.) + +By default, the L parameter is turned on. + +=head2 User + +Example: + + $User = $imap->User(); + # or: + $imap->User($userid); + +Specifies the userid to use when logging into the IMAP service. Can +be supplied with the L method call or separately by calling the +B object method. + +Parameters can be set during L method invocation by passing named +parameter/value pairs to the method, or later by calling the +parameter's eponymous object method. + +=head1 Status Methods + +There are several object methods that return the status of the object. +They can be used at any time to check the status of an IMAPClient +object, but are particularly useful for determining the cause of +failure when a connection and login are attempted as part of a single +L method invocation. The status methods are: + +=head2 Escaped_results + +Example: + + my @results = $imap->Escaped_results; + +The B method is almost identical to the B +method. Unlike the B method, however, server output +transmitted literally will be wrapped in double quotes, with all of +the parentheses, double quotes, backslashes, newlines, and carriage +returns escaped. If called in a scalar context, B +returns an array reference rather than an array. + +B is useful if you are retrieving output and +processing it manually, and you are depending on the above special +characters to delimit the data. It is not useful when retrieving +message contents; use B or B for that. + +=head2 History + +Example: + + my @history = $imap->History; + +The B method is almost identical to the L method. +Unlike the L method, however, the IMAP command that was +issued to create the results being returned is not included in the +returned results. If called in a scalar context, B returns +an array reference rather than an array. + +=head2 IsUnconnected + +returns a true value if the object is currently in an L +state. + +=head2 IsConnected + +returns a true value if the object is currently in either a +L, L, or L state. + +=head2 IsAuthenticated + +returns a true value if the object is currently in either an +L or L state. + +=head2 IsSelected + +returns a true value if the object is currently in a L +state. + +=head2 LastError + +Internally B is implemented just like a parameter (as +described in L, above). There is a I +attribute and an eponymous accessor method which returns the +I text string describing the last error condition +encountered by the server. + +Note that some errors are more serious than others, so I's +value is only meaningful if you encounter an error condition that you +don't like. For example, if you use the L method to see if a +folder exists and the folder does not exist, then an error message +will be recorded in I even though this is not a +particularly serious error. On the other hand, if you didn't use +L and just tried to L a non-existing folder, then +L would return C after setting I to +something like C. At this point it would be useful to print out the +contents of I as you L. + +=head2 LastIMAPCommand + +New in version 2.0.4, B returns the exact IMAP +command string to be sent to the server. Useful mainly in +constructing error messages when L just isn't enough. + +=head2 Report + +The B method returns an array containing a history of the IMAP +session up to the point that B was called. It is primarily +meant to assist in debugging but can also be used to retrieve raw +output for manual parsing. The value of the L parameter +controls how many transactions are in the report. + +=head2 Results + +The B method returns an array containing the results of one +IMAP client command. It accepts one argument, the transaction number +of the command whose results are to be returned. If transaction +number is unspecified then B returns the results of the last +IMAP client command issued. If called in a scalar context, B +returns an array reference rather than an array. + +=head2 State + +The B method returns a numerical value that indicates the +current status of the IMAPClient object. If invoked with an argument, +it will set the object's state to that value. If invoked without an +argument, it behaves just like L, below. + +Normally you will not have to invoke this function. An exception is +if you are bypassing the Mail::IMAPClient module's L and/or +L modules to set up your own connection (say, for example, +over a secure socket), in which case you must manually do what the +L and L methods would otherwise do for you. + +=head2 Status + +The B method returns a numerical value that indicates the +current status of the IMAPClient object. (Not to be confused with the +L method, all lower-case, which is the implementation of the +I IMAP client command.) + +=head2 Transaction + +The B method returns the tag value (or transaction +number) of the last IMAP client command. + +=head1 REPORTING BUGS + +Please send bug reports to C + +=head1 COPYRIGHT + + Copyright 1999, 2000, 2001, 2002 The Kernen Group, Inc. + All rights reserved. + + Copyright 2007, 2008, 2009 Mark Overmeer + + Copyright 2010 Phil Pearl (Lobbes) + +This program is free software; you can redistribute under the same +terms as Perl itself. + +This program is distributed in the hope that it will be useful, but +WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either the +GNU General Public License or the Artistic License for more +details. All your base are belong to us. diff --git a/Mail-IMAPClient-3.23/lib/Mail/IMAPClient/BodyStructure.pm b/Mail-IMAPClient-3.23/lib/Mail/IMAPClient/BodyStructure.pm new file mode 100644 index 0000000..31dc16e --- /dev/null +++ b/Mail-IMAPClient-3.23/lib/Mail/IMAPClient/BodyStructure.pm @@ -0,0 +1,557 @@ +use warnings; +use strict; + +package Mail::IMAPClient::BodyStructure; +use Mail::IMAPClient::BodyStructure::Parse; + +# my has file scope, not limited to package! +my $parser = Mail::IMAPClient::BodyStructure::Parse->new + or die "Cannot parse rules: $@\n" + . "Try remaking Mail::IMAPClient::BodyStructure::Parse.\n"; + +sub new +{ my $class = shift; + my $bodystructure = shift; + + my $self = $parser->start($bodystructure) + or return undef; + + $self->{_prefix} = ""; + $self->{_id} = exists $self->{bodystructure} ? 'HEAD' : 1; + $self->{_top} = 1; + + bless $self, ref($class)||$class; +} + +sub _get_thingy +{ my $thingy = shift; + my $object = shift || (ref $thingy ? $thingy : undef); + + unless ($object && ref $object) + { warn $@ = "No argument passed to $thingy method."; + return undef; + } + + unless(UNIVERSAL::isa($object, 'HASH') && exists $object->{$thingy}) + { my $a = $thingy =~ /^[aeiou]/i ? 'an' : 'a'; + my $has = ref $object eq 'HASH' ? join(", ",keys %$object) : ''; + warn $@ = ref($object)." $object does not have $a $thingy. " + . ($has ? "It has $has" : ''); + return undef; + } + + my $value = $object->{$thingy}; + $value =~ s/\\ ( [\\\(\)"\x0d\x0a] )/$1/gx; + $value =~ s/^"(.*)"$/$1/; + $value; +} + +BEGIN +{ no strict 'refs'; + foreach my $datum ( + qw/ bodytype bodysubtype bodyparms bodydisp bodyid bodydesc bodyenc + bodysize bodylang envelopestruct textlines / ) + { *$datum = sub { _get_thingy($datum, @_) }; + } +} + +sub parts +{ my $self = shift; + return wantarray ? @{$self->{PartsList}} : $self->{PartsList} + if exists $self->{PartsList}; + + my @parts; + $self->{PartsList} = \@parts; + + unless(exists $self->{bodystructure}) + { $self->{PartsIndex}{1} = $self; + @parts = ("HEAD", 1); + return wantarray ? @parts : \@parts; + } + + foreach my $p ($self->bodystructure) + { my $id = $p->id; + push @parts, $id; + $self->{PartsIndex}{$id} = $p ; + my $type = uc $p->bodytype || ''; + + push @parts, "$id.HEAD" + if $type eq 'MESSAGE'; + } + + wantarray ? @parts : \@parts; +} + +sub bodystructure +{ my $self = shift; + my $partno = 0; + my @parts; + + if($self->{_top}) + { $self->{_id} ||= "HEAD"; + $self->{_prefix} ||= "HEAD"; + $partno = 0; + foreach my $b ( @{$self->{bodystructure}} ) + { $b->{_id} = ++$partno; + $b->{_prefix} = $partno; + push @parts, $b, $b->bodystructure; + } + return wantarray ? @parts : \@parts; + } + + my $prefix = $self->{_prefix} || ""; + $prefix =~ s/\.?$/./; + + foreach my $p ( @{$self->{bodystructure}} ) + { $partno++; + $p->{_prefix} = "$prefix$partno"; + $p->{_id} ||= "$prefix$partno"; + push @parts, $p, $p->{bodystructure} ? $p->bodystructure : (); + } + + wantarray ? @parts : \@parts; +} + +sub id +{ my $self = shift; + return $self->{_id} + if exists $self->{_id}; + + return "HEAD" + if $self->{_top}; + + if ($self->{bodytype} eq 'MULTIPART') + { my $p = $self->{_id} || $self->{_prefix}; + $p =~ s/\.$//; + return $p; + } + else + { return $self->{_id} ||= 1; + } +} + +package Mail::IMAPClient::BodyStructure::Part; +our @ISA = qw/Mail::IMAPClient::BodyStructure/; + +package Mail::IMAPClient::BodyStructure::Envelope; +our @ISA = qw/Mail::IMAPClient::BodyStructure/; + +sub new +{ my ($class, $envelope) = @_; + $parser->envelope($envelope); +} + +sub from_addresses { shift->_addresses(from => 1) } +sub sender_addresses { shift->_addresses(sender => 1) } +sub replyto_addresses { shift->_addresses(replyto => 1) } +sub to_addresses { shift->_addresses(to => 0) } +sub cc_addresses { shift->_addresses(cc => 0) } +sub bcc_addresses { shift->_addresses(bcc => 0) } + +sub _addresses($$$) +{ my ($self, $name, $isSender) = @_; + ref $self->{$name} eq 'ARRAY' + or return (); + + my @list; + foreach ( @{$self->{$name}} ) + { my $pn = $_->personalname; + my $name = $pn && $pn ne 'NIL' ? "$pn " : ''; + push @list, $name . '<' . $_->mailboxname . '@' . $_->hostname . '>'; + } + + wantarray ? @list + : $isSender ? $list[0] + : \@list; +} + +BEGIN +{ no strict 'refs'; + for my $datum ( qw(subject inreplyto from messageid bcc date + replyto to sender cc)) + { *$datum = sub { @_ > 1 ? $_[0]->{$datum} = $_[1] : $_[0]->{$datum} } + } +} + + +package Mail::IMAPClient::BodyStructure::Address; +our @ISA = qw/Mail::IMAPClient::BodyStructure/; + +for my $datum ( qw(personalname mailboxname hostname sourcename) ) +{ no strict 'refs'; + *$datum = sub { shift->{$datum}; }; +} + +1; + +__END__ + +=head1 NAME + +Mail::IMAPClient::BodyStructure - parse fetched results + +=head1 SYNOPSIS + + use Mail::IMAPClient::BodyStructure; + use Mail::IMAPClient; + + my $imap = Mail::IMAPClient->new(Server=>$serv,User=>$usr,Password=>$pwd); + $imap->select("INBOX") or die "cannot select the inbox for $usr: $@\n"; + + my @recent = $imap->search("recent"); + + foreach my $id (@recent) + { my $fetched = $imap->fetch($id, "bodystructure"); + my $struct = Mail::IMAPClient::BodyStructure->new($fetched); + + my $mime = $struct->bodytype."/".$struct->bodysubtype; + my $parts =join "\n\t", $struct->parts; + print "Msg $id (Content-type: $mime) contains these parts:\n\t$parts\n"; + } + +=head1 DESCRIPTION + +This extension will parse the result of an IMAP FETCH BODYSTRUCTURE +command into a perl data structure. It also provides helper methods that +will help you pull information out of the data structure. + +Use of this extension requires Parse::RecDescent. If you don't have +Parse::RecDescent then you must either get it or refrain from using +this module. + +=head2 EXPORT + +Nothing is exported by default. C<$parser> is exported upon +request. C<$parser> is the BodyStucture object's Parse::RecDescent object, +which you'll probably only need for debugging purposes. + +=head1 Class Methods + +The following class method is available: + +=head2 new + +This class method is the constructor method for instantiating new +Mail::IMAPClient::BodyStructure objects. The B method accepts one +argument, a string containing a server response to a FETCH BODYSTRUCTURE +directive. Only one message's body structure should be described in this +string, although that message may contain an arbitrary number of parts. + +If you know the messages sequence number or unique ID (UID) +but haven't got its body structure, and you want to get the body +structure and parse it into a B +object, then you might as well save yourself some work and use +B's B method, which accepts +a message sequence number (or UID if I is true) and returns a +B object. It's functionally equivalent +to issuing the FETCH BODYSTRUCTURE IMAP client command and then passing +the results to B's B method but +it does those things in one simple method call. + +=head1 Object Methods + +The following object methods are available: + +=head2 bodytype + +The B object method requires no arguments. It returns the +bodytype for the message whose structure is described by the calling +B object. + +=head2 bodysubtype + +The B object method requires no arguments. It returns the +bodysubtype for the message whose structure is described by the calling +B object. + +=head2 bodyparms + +The B object method requires no arguments. It returns the +bodyparms for the message whose structure is described by the calling +B object. + +=head2 bodydisp + +The B object method requires no arguments. It returns the +bodydisp for the message whose structure is described by the calling +B object. + +=head2 bodyid + +The B object method requires no arguments. It returns the +bodyid for the message whose structure is described by the calling +B object. + +=head2 bodydesc + +The B object method requires no arguments. It returns the +bodydesc for the message whose structure is described by the calling +B object. + +=head2 bodyenc + +The B object method requires no arguments. It returns the +bodyenc for the message whose structure is described by the calling +B object. + +=head2 bodysize + +The B object method requires no arguments. It returns the +bodysize for the message whose structure is described by the calling +B object. + +=head2 bodylang + +The B object method requires no arguments. It returns the +bodylang for the message whose structure is described by the calling +B object. + +=head2 bodystructure + +The B object method requires no arguments. It returns +the bodystructure for the message whose structure is described by the +calling B object. + +=head2 envelopestruct + +The B object method requires no arguments. It returns +the envelopestruct for the message whose structure is described by the +calling B object. This envelope structure +is blessed into the B subclass, +which is explained more fully below. + +=head2 textlines + +The B object method requires no arguments. It returns the +textlines for the message whose structure is described by the calling +B object. + +=head1 Envelopes and the Mail::IMAPClient::BodyStructure::Envelope Subclass + +The IMAP standard specifies that output from the IMAP B command will be an RFC2060 envelope structure. It further +specifies that output from the B command may also +contain embedded envelope structures (if, for example, a message's +subparts contain one or more included messages). Objects belonging to +B are Perl representations +of these envelope structures, which is to say the nested parenthetical +lists of RFC2060 translated into a Perl datastructure. + +Note that all of the fields relate to the specific part to which they +belong. In other words, output from a FETCH nnnn ENVELOPE command (or, +in B, C<$imap->fetch($msgid,"ENVELOPE")> or Cget_envelope($msgid)>) are for the message, but fields from within +a bodystructure relate to the message subpart and not the parent message. + +An envelope structure's B +representation is a hash of thingies that looks like this: + + { + subject => "subject", + inreplyto => "reference_message_id", + from => [ addressStruct1 ], + messageid => "message_id", + bcc => [ addressStruct1, addressStruct2 ], + date => "Tue, 09 Jul 2002 14:15:53 -0400", + replyto => [ adressStruct1, addressStruct2 ], + to => [ adressStruct1, addressStruct2 ], + sender => [ adressStruct1 ], + cc => [ adressStruct1, addressStruct2 ], + } + +The B<...::Envelope> object also has methods for accessing data in the +structure. They are: + +=over 4 + +=item date + +Returns the date of the message. + +=item inreplyto + +Returns the message id of the message to which this message is a reply. + +=item subject + +Returns the subject of the message. + +=item messageid + +Returns the message id of the message. + +=back + +You can also use the following methods to get addressing +information. Each of these methods returns an array of +B objects, which are perl +data structures representing RFC2060 address structures. Some of these +arrays would naturally contain one element (such as B, which +normally contains a single "From:" address); others will often contain +more than one address. However, because RFC2060 defines all of these as +"lists of address structures", they are all translated into arrays of +B<...::Address> objects. + +See the section on B", below, +for alternate (and preferred) ways of accessing these data. + +The methods available are: + +=over 4 + +=item bcc + +Returns an array of blind cc'ed recipients' address structures. (Don't +expect much in here unless the message was sent from the mailbox you're +poking around in, by the way.) + +=item cc + +Returns an array of cc'ed recipients' address structures. + +=item from + +Returns an array of "From:" address structures--usually just one. + +=item replyto + +Returns an array of "Reply-to:" address structures. Once again there is +usually just one address in the list. + +=item sender + +Returns an array of senders' address structures--usually just one and +usually the same as B. + +=item to + +Returns an array of recipients' address structures. + +=back + +Each of the methods that returns a list of address structures (i.e. a +list of B arrays) also has an +analagous method that will return a list of E-Mail addresses instead. The +addresses are in the format Cmailboxname@hostnameE> +(see the section on B, +below) However, if the personal name is 'NIL' then it is omitted from +the address. + +These methods are: + +=over 4 + +=item bcc_addresses + +Returns a list (or an array reference if called in scalar context) +of blind cc'ed recipients' email addresses. (Don't expect much in here +unless the message was sent from the mailbox you're poking around in, +by the way.) + +=item cc_addresses + +Returns a list of cc'ed recipients' email addresses. If called in a scalar +context it returns a reference to an array of email addresses. + +=item from_addresses + +Returns a list of "From:" email addresses. If called in a scalar context +it returns the first email address in the list. (It's usually a list of just +one anyway.) + +=item replyto_addresses + +Returns a list of "Reply-to:" email addresses. If called in a scalar context +it returns the first email address in the list. + +=item sender_addresses + +Returns a list of senders' email addresses. If called in a scalar context +it returns the first email address in the list. + +=item to_addresses + +Returns a list of recipients' email addresses. If called in a scalar context +it returns a reference to an array of email addresses. + +=back + +Note that context affects the behavior of all of the above methods. + +Those fields that will commonly contain multiple entries (i.e. they are +recipients) will return an array reference when called in scalar context. +You can use this behavior to optimize performance. + +Those fields that will commonly contain just one address (the sender's) will +return the first (and usually only) address. You can use this behavior to +optimize your development time. + +=head1 Addresses and the Mail::IMAPClient::BodyStructure::Address + +Several components of an envelope structure are address +structures. They are each parsed into their own object, +B, which looks like this: + + { mailboxname => 'somebody.special' + , hostname => 'somplace.weird.com' + , personalname => 'Somebody Special + , sourceroute => 'NIL' + } + +RFC2060 specifies that each address component of a bodystructure is a +list of address structures, so B parses +each of these into an array of B +objects. + +Each of these objects has the following methods available to it: + +=over 4 + +=item mailboxname + +Returns the "mailboxname" portion of the address, which is the part to +the left of the '@' sign. + +=item hostname + +Returns the "hostname" portion of the address, which is the part to the +right of the '@' sign. + +=item personalname + +Returns the "personalname" portion of the address, which is the part of +the address that's treated like a comment. + +=item sourceroute + +Returns the "sourceroute" portion of the address, which is typically "NIL". + +=back + +Taken together, the parts of an address structure form an address that will +look something like this: + +Cmailboxname@hostnameE> + +Note that because the B +objects come in arrays, it's generally easier to use the methods +available to B to obtain +all of the addresses in a particular array in one operation. These +methods are provided, however, in case you'd rather do things +the hard way. (And also because the aforementioned methods from +B need them anyway.) + +=cut + +=head1 AUTHOR + +David J. Kernen + +Reworked and maintained by Mark Overmeer. + +=head1 SEE ALSO + +perl(1), Mail::IMAPClient, and RFC2060. See also Parse::RecDescent if you +want to understand the internals of this module. + +=cut diff --git a/Mail-IMAPClient-3.23/lib/Mail/IMAPClient/BodyStructure/Parse.grammar b/Mail-IMAPClient-3.23/lib/Mail/IMAPClient/BodyStructure/Parse.grammar new file mode 100644 index 0000000..853d092 --- /dev/null +++ b/Mail-IMAPClient-3.23/lib/Mail/IMAPClient/BodyStructure/Parse.grammar @@ -0,0 +1,188 @@ +# Directives +# ( none) +# Start-up Actions + +{ + my $mibs = "Mail::IMAPClient::BodyStructure"; + my $subpartCount = 0; + my $partCount = 0; + + sub take_optional_items($$@) + { my ($r, $items) = (shift, shift); + foreach (@_) + { my $opt = $_ .'(?)'; + exists $items->{$opt} or next; + $r->{$_} = UNIVERSAL::isa($items->{$opt}, 'ARRAY') + ? $items->{$opt}[0] : $items->{$opt}; + } + } + + sub merge_hash($$) + { my $to = shift; + my $from = shift or return; + while( my($k,$v) = each %$from) { $to->{$k} = $v } + } +} + +# Atoms + +TEXT: /^"TEXT"|^TEXT/i { $return = "TEXT" } +PLAIN: /^"PLAIN"|^PLAIN/i { $return = "PLAIN" } +HTML: /"HTML"|HTML/i { $return = "HTML" } +MESSAGE: /^"MESSAGE"|^MESSAGE/i { $return = "MESSAGE"} +RFC822: /^"RFC822"|^RFC822/i { $return = "RFC822" } +NIL: /^NIL/i { $return = "NIL" } +NUMBER: /^(\d+)/ { $return = $item[1] } + +# Strings: + +SINGLE_QUOTED_STRING: "'" /(?:\\'|[^'])*/ "'" { $return = $item{__PATTERN1__} } +DOUBLE_QUOTED_STRING: '"' /(?:\\"|[^"])*/ '"' { $return = $item{__PATTERN1__} } + +BARESTRING: ...!/^[)('"]/ /^(?!\(|\))(?:\\ |\S)+/ + { $return = $item{__PATTERN1__} } + +STRING: DOUBLE_QUOTED_STRING | SINGLE_QUOTED_STRING | BARESTRING + +STRINGS: "(" STRING(s) ")" { $return = $item{'STRING(s)'} } + +textlines: NIL | NUMBER + +rfc822message: MESSAGE RFC822 { $return = "MESSAGE RFC822" } + +bodysubtype: PLAIN | HTML | NIL | STRING + +key: STRING +value: NIL | NUMBER | STRING | KVPAIRS + +kvpair: ...!")" key value + { $return = { $item{key} => $item{value} } } + +KVPAIRS: "(" kvpair(s) ")" + { $return = { map { (%$_) } @{$item{'kvpair(s)'}} } } + +bodytype: STRING +bodyparms: NIL | KVPAIRS +bodydisp: NIL | KVPAIRS +bodyid: ...!/[()]/ NIL | STRING +bodydesc: ...!/[()]/ NIL | STRING +bodysize: ...!/[()]/ NIL | NUMBER +bodyenc: NIL | STRING | KVPAIRS +bodyMD5: NIL | STRING +bodylang: NIL | STRING | STRINGS +bodyextra: NIL | STRING | STRINGS +bodyloc: NIL | STRING + +personalname: NIL | STRING +sourceroute: NIL | STRING +mailboxname: NIL | STRING +hostname: NIL | STRING + +addressstruct: "(" personalname sourceroute mailboxname hostname ")" + { bless { personalname => $item{personalname} + , sourceroute => $item{sourceroute} + , mailboxname => $item{mailboxname} + , hostname => $item{hostname} + }, 'Mail::IMAPClient::BodyStructure::Address'; + } + +subject: NIL | STRING +inreplyto: NIL | STRING +messageid: NIL | STRING +date: NIL | STRING + +ADDRESSES: NIL + | "(" addressstruct(s) ")" { $return = $item{'addressstruct(s)'} } + +cc: ADDRESSES +bcc: ADDRESSES +from: ADDRESSES +replyto: ADDRESSES +sender: ADDRESSES +to: ADDRESSES + +envelopestruct: "(" date subject from sender replyto to cc + bcc inreplyto messageid ")" + { $return = bless {}, "Mail::IMAPClient::BodyStructure::Envelope"; + $return->{$_} = $item{$_} + for qw/date subject from sender replyto to cc/ + , qw/bcc inreplyto messageid/; + 1; + } + +basicfields: bodysubtype bodyparms(?) bodyid(?) + bodydesc(?) bodyenc(?) bodysize(?) + { $return = { bodysubtype => $item{bodysubtype} }; + take_optional_items($return, \%item, + qw/bodyparms bodyid bodydesc bodyenc bodysize/); + 1; + } + +textmessage: TEXT basicfields textlines(?) bodyMD5(?) + bodydisp(?) bodylang(?) bodyextra(?) + { + $return = $item{basicfields} || {}; + $return->{bodytype} = 'TEXT'; + take_optional_items($return, \%item + , qw/textlines bodyMD5 bodydisp bodylang bodyextra/); + 1; + } + +othertypemessage: bodytype basicfields bodyMD5(?) bodydisp(?) + bodylang(?) bodyextra(?) + { $return = { bodytype => $item{bodytype} }; + take_optional_items($return, \%item + , qw/bodyMD5 bodydisp bodylang bodyextra/ ); + merge_hash($return, $item{basicfields}); + 1; + } + +nestedmessage: rfc822message bodyparms bodyid bodydesc bodyenc +# bodysize envelopestruct bodystructure textlines + bodysize envelopestruct(?) bodystructure(?) textlines(?) + bodyMD5(?) bodydisp(?) bodylang(?) bodyextra(?) + { + $return = {}; + $return->{$_} = $item{$_} + for qw/bodyparms bodyid bodydesc bodyenc bodysize/; +# envelopestruct bodystructure textlines/; + + take_optional_items($return, \%item + , qw/envelopestruct bodystructure textlines/ + , qw/bodyMD5 bodydisp bodylang bodyextra/); + + merge_hash($return, $item{bodystructure}[0]); + merge_hash($return, $item{basicfields}); + $return->{bodytype} = "MESSAGE" ; + $return->{bodysubtype} = "RFC822" ; + 1; + } + +multipart: subpart(s) bodysubtype + bodyparms(?) bodydisp(?) bodylang(?) bodyloc(?) bodyextra(?) + + { $return = + { bodysubtype => $item{bodysubtype} + , bodytype => 'MULTIPART' + , bodystructure => $item{'subpart(s)'} + }; + take_optional_items($return, \%item + , qw/bodyparms bodydisp bodylang bodyloc bodyextra/); + 1; + } + +subpart: "(" part ")" {$return = $item{part}} + +part: multipart { $return = bless $item{multipart}, $mibs } + | textmessage { $return = bless $item{textmessage}, $mibs } + | nestedmessage { $return = bless $item{nestedmessage}, $mibs } + | othertypemessage { $return = bless $item{othertypemessage}, $mibs } + +bodystructure: "(" part(s) ")" + { $return = $item{'part(s)'} } + +start: /.*?\(.*?BODYSTRUCTURE \(/i part(1) /\).*\)\r?\n?/ + { $return = $item{'part(1)'}[0] } + +envelope: /.*?\(.*?ENVELOPE/ envelopestruct /.*\)/ + { $return = $item{envelopestruct} } diff --git a/Mail-IMAPClient-3.23/lib/Mail/IMAPClient/BodyStructure/Parse.pm b/Mail-IMAPClient-3.23/lib/Mail/IMAPClient/BodyStructure/Parse.pm new file mode 100644 index 0000000..c710d9b --- /dev/null +++ b/Mail-IMAPClient-3.23/lib/Mail/IMAPClient/BodyStructure/Parse.pm @@ -0,0 +1,16425 @@ +package Mail::IMAPClient::BodyStructure::Parse; +use Parse::RecDescent; + +{ my $ERRORS; + + +package Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse; +use strict; +use vars qw($skip $AUTOLOAD ); +$skip = '\s*'; + + my $mibs = "Mail::IMAPClient::BodyStructure"; + my $subpartCount = 0; + my $partCount = 0; + + sub take_optional_items($$@) + { my ($r, $items) = (shift, shift); + foreach (@_) + { my $opt = $_ .'(?)'; + exists $items->{$opt} or next; + $r->{$_} = UNIVERSAL::isa($items->{$opt}, 'ARRAY') + ? $items->{$opt}[0] : $items->{$opt}; + } + } + + sub merge_hash($$) + { my $to = shift; + my $from = shift or return; + while( my($k,$v) = each %$from) { $to->{$k} = $v } + } +; + + +{ +local $SIG{__WARN__} = sub {0}; +# PRETEND TO BE IN Parse::RecDescent NAMESPACE +*Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::AUTOLOAD = sub +{ + no strict 'refs'; + $AUTOLOAD =~ s/^Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse/Parse::RecDescent/; + goto &{$AUTOLOAD}; +} +} + +push @Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::ISA, 'Parse::RecDescent'; +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodyparms +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"bodyparms"}; + + Parse::RecDescent::_trace(q{Trying rule: [bodyparms]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodyparms}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodyparms}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{bodyparms}); + %item = (__RULE__ => q{bodyparms}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{bodyparms}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodyparms}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodyparms}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodyparms}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [KVPAIRS]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodyparms}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{bodyparms}); + %item = (__RULE__ => q{bodyparms}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [KVPAIRS]}, + Parse::RecDescent::_tracefirst($text), + q{bodyparms}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::KVPAIRS($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodyparms}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [KVPAIRS]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodyparms}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{KVPAIRS}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [KVPAIRS]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodyparms}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodyparms}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{bodyparms}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{bodyparms}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{bodyparms}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::date +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"date"}; + + Parse::RecDescent::_trace(q{Trying rule: [date]}, + Parse::RecDescent::_tracefirst($_[1]), + q{date}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{date}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{date}); + %item = (__RULE__ => q{date}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{date}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{date}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{date}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{date}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{date}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{date}); + %item = (__RULE__ => q{date}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [STRING]}, + Parse::RecDescent::_tracefirst($text), + q{date}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::STRING($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{date}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [STRING]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{date}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{STRING}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [STRING]<<}, + Parse::RecDescent::_tracefirst($text), + q{date}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{date}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{date}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{date}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{date}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodysubtype +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"bodysubtype"}; + + Parse::RecDescent::_trace(q{Trying rule: [bodysubtype]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [PLAIN]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{bodysubtype}); + %item = (__RULE__ => q{bodysubtype}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [PLAIN]}, + Parse::RecDescent::_tracefirst($text), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::PLAIN($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [PLAIN]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{PLAIN}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [PLAIN]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [HTML]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{bodysubtype}); + %item = (__RULE__ => q{bodysubtype}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [HTML]}, + Parse::RecDescent::_tracefirst($text), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::HTML($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [HTML]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{HTML}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [HTML]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[2]; + $text = $_[1]; + my $_savetext; + @item = (q{bodysubtype}); + %item = (__RULE__ => q{bodysubtype}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[3]; + $text = $_[1]; + my $_savetext; + @item = (q{bodysubtype}); + %item = (__RULE__ => q{bodysubtype}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [STRING]}, + Parse::RecDescent::_tracefirst($text), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::STRING($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [STRING]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{STRING}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [STRING]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{bodysubtype}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{bodysubtype}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{bodysubtype}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::hostname +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"hostname"}; + + Parse::RecDescent::_trace(q{Trying rule: [hostname]}, + Parse::RecDescent::_tracefirst($_[1]), + q{hostname}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{hostname}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{hostname}); + %item = (__RULE__ => q{hostname}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{hostname}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{hostname}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{hostname}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{hostname}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{hostname}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{hostname}); + %item = (__RULE__ => q{hostname}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [STRING]}, + Parse::RecDescent::_tracefirst($text), + q{hostname}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::STRING($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{hostname}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [STRING]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{hostname}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{STRING}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [STRING]<<}, + Parse::RecDescent::_tracefirst($text), + q{hostname}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{hostname}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{hostname}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{hostname}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{hostname}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::basicfields +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"basicfields"}; + + Parse::RecDescent::_trace(q{Trying rule: [basicfields]}, + Parse::RecDescent::_tracefirst($_[1]), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [bodysubtype bodyparms bodyid bodydesc bodyenc bodysize]}, + Parse::RecDescent::_tracefirst($_[1]), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{basicfields}); + %item = (__RULE__ => q{basicfields}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [bodysubtype]}, + Parse::RecDescent::_tracefirst($text), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodysubtype($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [bodysubtype]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodysubtype}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying repeated subrule: [bodyparms]}, + Parse::RecDescent::_tracefirst($text), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{bodyparms})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodyparms, 0, 1, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodyparms]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodyparms(?)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [bodyid]}, + Parse::RecDescent::_tracefirst($text), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{bodyid})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodyid, 0, 1, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodyid]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodyid(?)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [bodydesc]}, + Parse::RecDescent::_tracefirst($text), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{bodydesc})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodydesc, 0, 1, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodydesc]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodydesc(?)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [bodyenc]}, + Parse::RecDescent::_tracefirst($text), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{bodyenc})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodyenc, 0, 1, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodyenc]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodyenc(?)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [bodysize]}, + Parse::RecDescent::_tracefirst($text), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{bodysize})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodysize, 0, 1, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodysize]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodysize(?)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = { bodysubtype => $item{bodysubtype} }; + take_optional_items($return, \%item, + qw/bodyparms bodyid bodydesc bodyenc bodysize/); + 1; + }; + unless (defined $_tok) + { + Parse::RecDescent::_trace(q{<> (return value: [undef])}) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $_tok; + $item{__ACTION1__}=$_tok; + + + + Parse::RecDescent::_trace(q{>>Matched production: [bodysubtype bodyparms bodyid bodydesc bodyenc bodysize]<<}, + Parse::RecDescent::_tracefirst($text), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{basicfields}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{basicfields}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{basicfields}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::personalname +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"personalname"}; + + Parse::RecDescent::_trace(q{Trying rule: [personalname]}, + Parse::RecDescent::_tracefirst($_[1]), + q{personalname}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{personalname}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{personalname}); + %item = (__RULE__ => q{personalname}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{personalname}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{personalname}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{personalname}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{personalname}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{personalname}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{personalname}); + %item = (__RULE__ => q{personalname}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [STRING]}, + Parse::RecDescent::_tracefirst($text), + q{personalname}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::STRING($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{personalname}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [STRING]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{personalname}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{STRING}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [STRING]<<}, + Parse::RecDescent::_tracefirst($text), + q{personalname}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{personalname}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{personalname}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{personalname}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{personalname}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::key +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"key"}; + + Parse::RecDescent::_trace(q{Trying rule: [key]}, + Parse::RecDescent::_tracefirst($_[1]), + q{key}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{key}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{key}); + %item = (__RULE__ => q{key}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [STRING]}, + Parse::RecDescent::_tracefirst($text), + q{key}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::STRING($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{key}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [STRING]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{key}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{STRING}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [STRING]<<}, + Parse::RecDescent::_tracefirst($text), + q{key}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{key}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{key}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{key}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{key}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::cc +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"cc"}; + + Parse::RecDescent::_trace(q{Trying rule: [cc]}, + Parse::RecDescent::_tracefirst($_[1]), + q{cc}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [ADDRESSES]}, + Parse::RecDescent::_tracefirst($_[1]), + q{cc}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{cc}); + %item = (__RULE__ => q{cc}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [ADDRESSES]}, + Parse::RecDescent::_tracefirst($text), + q{cc}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::ADDRESSES($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{cc}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [ADDRESSES]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{cc}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{ADDRESSES}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [ADDRESSES]<<}, + Parse::RecDescent::_tracefirst($text), + q{cc}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{cc}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{cc}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{cc}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{cc}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodyMD5 +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"bodyMD5"}; + + Parse::RecDescent::_trace(q{Trying rule: [bodyMD5]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodyMD5}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodyMD5}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{bodyMD5}); + %item = (__RULE__ => q{bodyMD5}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{bodyMD5}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodyMD5}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodyMD5}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodyMD5}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodyMD5}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{bodyMD5}); + %item = (__RULE__ => q{bodyMD5}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [STRING]}, + Parse::RecDescent::_tracefirst($text), + q{bodyMD5}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::STRING($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodyMD5}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [STRING]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodyMD5}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{STRING}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [STRING]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodyMD5}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodyMD5}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{bodyMD5}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{bodyMD5}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{bodyMD5}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::envelope +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"envelope"}; + + Parse::RecDescent::_trace(q{Trying rule: [envelope]}, + Parse::RecDescent::_tracefirst($_[1]), + q{envelope}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [/.*?\\(.*?ENVELOPE/ envelopestruct /.*\\)/]}, + Parse::RecDescent::_tracefirst($_[1]), + q{envelope}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{envelope}); + %item = (__RULE__ => q{envelope}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: [/.*?\\(.*?ENVELOPE/]}, Parse::RecDescent::_tracefirst($text), + q{envelope}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:.*?\(.*?ENVELOPE)//) + { + + $expectation->failed(); + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + + last; + } + Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} + . $& . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $item{__PATTERN1__}=$&; + + + Parse::RecDescent::_trace(q{Trying subrule: [envelopestruct]}, + Parse::RecDescent::_tracefirst($text), + q{envelope}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{envelopestruct})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::envelopestruct($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{envelope}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [envelopestruct]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{envelope}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{envelopestruct}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying terminal: [/.*\\)/]}, Parse::RecDescent::_tracefirst($text), + q{envelope}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{/.*\\)/})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:.*\))//) + { + + $expectation->failed(); + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + + last; + } + Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} + . $& . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $item{__PATTERN2__}=$&; + + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{envelope}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = $item{envelopestruct} }; + unless (defined $_tok) + { + Parse::RecDescent::_trace(q{<> (return value: [undef])}) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $_tok; + $item{__ACTION1__}=$_tok; + + + + Parse::RecDescent::_trace(q{>>Matched production: [/.*?\\(.*?ENVELOPE/ envelopestruct /.*\\)/]<<}, + Parse::RecDescent::_tracefirst($text), + q{envelope}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{envelope}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{envelope}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{envelope}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{envelope}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::MESSAGE +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"MESSAGE"}; + + Parse::RecDescent::_trace(q{Trying rule: [MESSAGE]}, + Parse::RecDescent::_tracefirst($_[1]), + q{MESSAGE}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [/^"MESSAGE"|^MESSAGE/i]}, + Parse::RecDescent::_tracefirst($_[1]), + q{MESSAGE}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{MESSAGE}); + %item = (__RULE__ => q{MESSAGE}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: [/^"MESSAGE"|^MESSAGE/i]}, Parse::RecDescent::_tracefirst($text), + q{MESSAGE}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:^"MESSAGE"|^MESSAGE)//i) + { + + $expectation->failed(); + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + + last; + } + Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} + . $& . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $item{__PATTERN1__}=$&; + + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{MESSAGE}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = "MESSAGE"}; + unless (defined $_tok) + { + Parse::RecDescent::_trace(q{<> (return value: [undef])}) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $_tok; + $item{__ACTION1__}=$_tok; + + + + Parse::RecDescent::_trace(q{>>Matched production: [/^"MESSAGE"|^MESSAGE/i]<<}, + Parse::RecDescent::_tracefirst($text), + q{MESSAGE}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{MESSAGE}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{MESSAGE}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{MESSAGE}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{MESSAGE}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::DOUBLE_QUOTED_STRING +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"DOUBLE_QUOTED_STRING"}; + + Parse::RecDescent::_trace(q{Trying rule: [DOUBLE_QUOTED_STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{DOUBLE_QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: ['"' /(?:\\\\"|[^"])*/ '"']}, + Parse::RecDescent::_tracefirst($_[1]), + q{DOUBLE_QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{DOUBLE_QUOTED_STRING}); + %item = (__RULE__ => q{DOUBLE_QUOTED_STRING}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: ['"']}, + Parse::RecDescent::_tracefirst($text), + q{DOUBLE_QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A\"//) + { + + $expectation->failed(); + Parse::RecDescent::_trace(qq{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} + . $& . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $item{__STRING1__}=$&; + + + Parse::RecDescent::_trace(q{Trying terminal: [/(?:\\\\"|[^"])*/]}, Parse::RecDescent::_tracefirst($text), + q{DOUBLE_QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{/(?:\\\\"|[^"])*/})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:(?:\\"|[^"])*)//) + { + + $expectation->failed(); + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + + last; + } + Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} + . $& . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $item{__PATTERN1__}=$&; + + + Parse::RecDescent::_trace(q{Trying terminal: ['"']}, + Parse::RecDescent::_tracefirst($text), + q{DOUBLE_QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{'"'})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A\"//) + { + + $expectation->failed(); + Parse::RecDescent::_trace(qq{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} + . $& . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $item{__STRING2__}=$&; + + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{DOUBLE_QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = $item{__PATTERN1__} }; + unless (defined $_tok) + { + Parse::RecDescent::_trace(q{<> (return value: [undef])}) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $_tok; + $item{__ACTION1__}=$_tok; + + + + Parse::RecDescent::_trace(q{>>Matched production: ['"' /(?:\\\\"|[^"])*/ '"']<<}, + Parse::RecDescent::_tracefirst($text), + q{DOUBLE_QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{DOUBLE_QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{DOUBLE_QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{DOUBLE_QUOTED_STRING}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{DOUBLE_QUOTED_STRING}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::subject +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"subject"}; + + Parse::RecDescent::_trace(q{Trying rule: [subject]}, + Parse::RecDescent::_tracefirst($_[1]), + q{subject}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{subject}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{subject}); + %item = (__RULE__ => q{subject}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{subject}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{subject}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{subject}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{subject}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{subject}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{subject}); + %item = (__RULE__ => q{subject}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [STRING]}, + Parse::RecDescent::_tracefirst($text), + q{subject}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::STRING($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{subject}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [STRING]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{subject}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{STRING}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [STRING]<<}, + Parse::RecDescent::_tracefirst($text), + q{subject}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{subject}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{subject}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{subject}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{subject}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::value +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"value"}; + + Parse::RecDescent::_trace(q{Trying rule: [value]}, + Parse::RecDescent::_tracefirst($_[1]), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{value}); + %item = (__RULE__ => q{value}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [NUMBER]}, + Parse::RecDescent::_tracefirst($_[1]), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{value}); + %item = (__RULE__ => q{value}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NUMBER]}, + Parse::RecDescent::_tracefirst($text), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NUMBER($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NUMBER]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NUMBER}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NUMBER]<<}, + Parse::RecDescent::_tracefirst($text), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[2]; + $text = $_[1]; + my $_savetext; + @item = (q{value}); + %item = (__RULE__ => q{value}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [STRING]}, + Parse::RecDescent::_tracefirst($text), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::STRING($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [STRING]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{STRING}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [STRING]<<}, + Parse::RecDescent::_tracefirst($text), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [KVPAIRS]}, + Parse::RecDescent::_tracefirst($_[1]), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[3]; + $text = $_[1]; + my $_savetext; + @item = (q{value}); + %item = (__RULE__ => q{value}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [KVPAIRS]}, + Parse::RecDescent::_tracefirst($text), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::KVPAIRS($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [KVPAIRS]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{KVPAIRS}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [KVPAIRS]<<}, + Parse::RecDescent::_tracefirst($text), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{value}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{value}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{value}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{value}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::inreplyto +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"inreplyto"}; + + Parse::RecDescent::_trace(q{Trying rule: [inreplyto]}, + Parse::RecDescent::_tracefirst($_[1]), + q{inreplyto}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{inreplyto}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{inreplyto}); + %item = (__RULE__ => q{inreplyto}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{inreplyto}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{inreplyto}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{inreplyto}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{inreplyto}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{inreplyto}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{inreplyto}); + %item = (__RULE__ => q{inreplyto}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [STRING]}, + Parse::RecDescent::_tracefirst($text), + q{inreplyto}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::STRING($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{inreplyto}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [STRING]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{inreplyto}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{STRING}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [STRING]<<}, + Parse::RecDescent::_tracefirst($text), + q{inreplyto}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{inreplyto}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{inreplyto}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{inreplyto}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{inreplyto}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::messageid +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"messageid"}; + + Parse::RecDescent::_trace(q{Trying rule: [messageid]}, + Parse::RecDescent::_tracefirst($_[1]), + q{messageid}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{messageid}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{messageid}); + %item = (__RULE__ => q{messageid}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{messageid}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{messageid}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{messageid}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{messageid}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{messageid}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{messageid}); + %item = (__RULE__ => q{messageid}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [STRING]}, + Parse::RecDescent::_tracefirst($text), + q{messageid}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::STRING($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{messageid}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [STRING]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{messageid}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{STRING}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [STRING]<<}, + Parse::RecDescent::_tracefirst($text), + q{messageid}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{messageid}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{messageid}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{messageid}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{messageid}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::sender +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"sender"}; + + Parse::RecDescent::_trace(q{Trying rule: [sender]}, + Parse::RecDescent::_tracefirst($_[1]), + q{sender}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [ADDRESSES]}, + Parse::RecDescent::_tracefirst($_[1]), + q{sender}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{sender}); + %item = (__RULE__ => q{sender}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [ADDRESSES]}, + Parse::RecDescent::_tracefirst($text), + q{sender}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::ADDRESSES($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{sender}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [ADDRESSES]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{sender}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{ADDRESSES}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [ADDRESSES]<<}, + Parse::RecDescent::_tracefirst($text), + q{sender}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{sender}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{sender}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{sender}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{sender}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::multipart +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"multipart"}; + + Parse::RecDescent::_trace(q{Trying rule: [multipart]}, + Parse::RecDescent::_tracefirst($_[1]), + q{multipart}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [subpart bodysubtype bodyparms bodydisp bodylang bodyloc bodyextra ]}, + Parse::RecDescent::_tracefirst($_[1]), + q{multipart}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{multipart}); + %item = (__RULE__ => q{multipart}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [subpart]}, + Parse::RecDescent::_tracefirst($text), + q{multipart}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::subpart, 1, 100000000, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{multipart}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [subpart]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{multipart}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{subpart(s)}} = $_tok; + push @item, $_tok; + + + + + + Parse::RecDescent::_trace(q{Trying directive: []}, + Parse::RecDescent::_tracefirst($text), + q{multipart}, + $tracelevel) + if defined $::RD_TRACE; + $_tok = do { $commit = 1 }; + if (defined($_tok)) + { + Parse::RecDescent::_trace(q{>>Matched directive<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + } + else + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + } + + last unless defined $_tok; + push @item, $item{__DIRECTIVE1__}=$_tok; + + + Parse::RecDescent::_trace(q{Trying subrule: [bodysubtype]}, + Parse::RecDescent::_tracefirst($text), + q{multipart}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{bodysubtype})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodysubtype($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{multipart}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [bodysubtype]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{multipart}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodysubtype}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying repeated subrule: [bodyparms]}, + Parse::RecDescent::_tracefirst($text), + q{multipart}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{bodyparms})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodyparms, 0, 1, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{multipart}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodyparms]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{multipart}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodyparms(?)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [bodydisp]}, + Parse::RecDescent::_tracefirst($text), + q{multipart}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{bodydisp})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodydisp, 0, 1, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{multipart}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodydisp]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{multipart}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodydisp(?)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [bodylang]}, + Parse::RecDescent::_tracefirst($text), + q{multipart}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{bodylang})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodylang, 0, 1, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{multipart}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodylang]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{multipart}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodylang(?)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [bodyloc]}, + Parse::RecDescent::_tracefirst($text), + q{multipart}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{bodyloc})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodyloc, 0, 1, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{multipart}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodyloc]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{multipart}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodyloc(?)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [bodyextra]}, + Parse::RecDescent::_tracefirst($text), + q{multipart}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{bodyextra})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodyextra, 0, 1, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{multipart}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodyextra]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{multipart}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodyextra(?)}} = $_tok; + push @item, $_tok; + + + + + + Parse::RecDescent::_trace(q{Trying directive: []}, + Parse::RecDescent::_tracefirst($text), + q{multipart}, + $tracelevel) + if defined $::RD_TRACE; + $_tok = do { push @{$thisparser->{deferred}}, sub { $subpartCount = 0 }; }; + if (defined($_tok)) + { + Parse::RecDescent::_trace(q{>>Matched directive<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + } + else + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + } + + last unless defined $_tok; + push @item, $item{__DIRECTIVE2__}=$_tok; + + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{multipart}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = + { bodysubtype => $item{bodysubtype} + , bodytype => 'MULTIPART' + , bodystructure => $item{'subpart(s)'} + }; + take_optional_items($return, \%item + , qw/bodyparms bodydisp bodylang bodyloc bodyextra/); + 1; + }; + unless (defined $_tok) + { + Parse::RecDescent::_trace(q{<> (return value: [undef])}) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $_tok; + $item{__ACTION1__}=$_tok; + + + + Parse::RecDescent::_trace(q{>>Matched production: [subpart bodysubtype bodyparms bodydisp bodylang bodyloc bodyextra ]<<}, + Parse::RecDescent::_tracefirst($text), + q{multipart}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{multipart}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{multipart}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{multipart}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{multipart}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodyenc +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"bodyenc"}; + + Parse::RecDescent::_trace(q{Trying rule: [bodyenc]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodyenc}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodyenc}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{bodyenc}); + %item = (__RULE__ => q{bodyenc}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{bodyenc}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodyenc}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodyenc}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodyenc}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodyenc}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{bodyenc}); + %item = (__RULE__ => q{bodyenc}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [STRING]}, + Parse::RecDescent::_tracefirst($text), + q{bodyenc}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::STRING($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodyenc}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [STRING]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodyenc}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{STRING}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [STRING]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodyenc}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [KVPAIRS]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodyenc}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[2]; + $text = $_[1]; + my $_savetext; + @item = (q{bodyenc}); + %item = (__RULE__ => q{bodyenc}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [KVPAIRS]}, + Parse::RecDescent::_tracefirst($text), + q{bodyenc}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::KVPAIRS($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodyenc}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [KVPAIRS]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodyenc}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{KVPAIRS}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [KVPAIRS]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodyenc}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodyenc}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{bodyenc}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{bodyenc}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{bodyenc}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodydesc +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"bodydesc"}; + + Parse::RecDescent::_trace(q{Trying rule: [bodydesc]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodydesc}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [/[()]/ NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodydesc}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{bodydesc}); + %item = (__RULE__ => q{bodydesc}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: [/[()]/]}, Parse::RecDescent::_tracefirst($text), + q{bodydesc}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + $_savetext = $text; + + if ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:[()])//) + { + $text = $_savetext; + $expectation->failed(); + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + + last; + } + Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} + . $& . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $item{__PATTERN1__}=$&; + $text = $_savetext; + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{bodydesc}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{NIL})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodydesc}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodydesc}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [/[()]/ NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodydesc}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodydesc}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{bodydesc}); + %item = (__RULE__ => q{bodydesc}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [STRING]}, + Parse::RecDescent::_tracefirst($text), + q{bodydesc}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::STRING($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodydesc}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [STRING]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodydesc}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{STRING}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [STRING]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodydesc}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodydesc}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{bodydesc}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{bodydesc}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{bodydesc}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::start +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"start"}; + + Parse::RecDescent::_trace(q{Trying rule: [start]}, + Parse::RecDescent::_tracefirst($_[1]), + q{start}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [/.*?\\(.*?BODYSTRUCTURE \\(/i part /\\).*\\)\\r?\\n?/]}, + Parse::RecDescent::_tracefirst($_[1]), + q{start}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{start}); + %item = (__RULE__ => q{start}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: [/.*?\\(.*?BODYSTRUCTURE \\(/i]}, Parse::RecDescent::_tracefirst($text), + q{start}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:.*?\(.*?BODYSTRUCTURE \()//i) + { + + $expectation->failed(); + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + + last; + } + Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} + . $& . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $item{__PATTERN1__}=$&; + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [part]}, + Parse::RecDescent::_tracefirst($text), + q{start}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{part})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::part, 1, 1, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{start}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [part]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{start}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{part(1)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying terminal: [/\\).*\\)\\r?\\n?/]}, Parse::RecDescent::_tracefirst($text), + q{start}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{/\\).*\\)\\r?\\n?/})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:\).*\)\r?\n?)//) + { + + $expectation->failed(); + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + + last; + } + Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} + . $& . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $item{__PATTERN2__}=$&; + + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{start}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = $item{'part(1)'}[0] }; + unless (defined $_tok) + { + Parse::RecDescent::_trace(q{<> (return value: [undef])}) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $_tok; + $item{__ACTION1__}=$_tok; + + + + Parse::RecDescent::_trace(q{>>Matched production: [/.*?\\(.*?BODYSTRUCTURE \\(/i part /\\).*\\)\\r?\\n?/]<<}, + Parse::RecDescent::_tracefirst($text), + q{start}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{start}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{start}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{start}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{start}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::RFC822 +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"RFC822"}; + + Parse::RecDescent::_trace(q{Trying rule: [RFC822]}, + Parse::RecDescent::_tracefirst($_[1]), + q{RFC822}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [/^"RFC822"|^RFC822/i]}, + Parse::RecDescent::_tracefirst($_[1]), + q{RFC822}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{RFC822}); + %item = (__RULE__ => q{RFC822}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: [/^"RFC822"|^RFC822/i]}, Parse::RecDescent::_tracefirst($text), + q{RFC822}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:^"RFC822"|^RFC822)//i) + { + + $expectation->failed(); + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + + last; + } + Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} + . $& . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $item{__PATTERN1__}=$&; + + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{RFC822}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = "RFC822" }; + unless (defined $_tok) + { + Parse::RecDescent::_trace(q{<> (return value: [undef])}) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $_tok; + $item{__ACTION1__}=$_tok; + + + + Parse::RecDescent::_trace(q{>>Matched production: [/^"RFC822"|^RFC822/i]<<}, + Parse::RecDescent::_tracefirst($text), + q{RFC822}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{RFC822}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{RFC822}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{RFC822}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{RFC822}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::textmessage +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"textmessage"}; + + Parse::RecDescent::_trace(q{Trying rule: [textmessage]}, + Parse::RecDescent::_tracefirst($_[1]), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [TEXT basicfields textlines bodyMD5 bodydisp bodylang bodyextra]}, + Parse::RecDescent::_tracefirst($_[1]), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{textmessage}); + %item = (__RULE__ => q{textmessage}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [TEXT]}, + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::TEXT($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [TEXT]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{TEXT}} = $_tok; + push @item, $_tok; + + } + + + + Parse::RecDescent::_trace(q{Trying directive: []}, + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + $_tok = do { $commit = 1 }; + if (defined($_tok)) + { + Parse::RecDescent::_trace(q{>>Matched directive<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + } + else + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + } + + last unless defined $_tok; + push @item, $item{__DIRECTIVE1__}=$_tok; + + + Parse::RecDescent::_trace(q{Trying subrule: [basicfields]}, + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{basicfields})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::basicfields($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [basicfields]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{basicfields}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying repeated subrule: [textlines]}, + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{textlines})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::textlines, 0, 1, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [textlines]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{textlines(?)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [bodyMD5]}, + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{bodyMD5})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodyMD5, 0, 1, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodyMD5]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodyMD5(?)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [bodydisp]}, + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{bodydisp})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodydisp, 0, 1, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodydisp]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodydisp(?)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [bodylang]}, + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{bodylang})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodylang, 0, 1, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodylang]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodylang(?)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [bodyextra]}, + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{bodyextra})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodyextra, 0, 1, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodyextra]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodyextra(?)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { + $return = $item{basicfields} || {}; + $return->{bodytype} = 'TEXT'; + take_optional_items($return, \%item + , qw/textlines bodyMD5 bodydisp bodylang bodyextra/); + 1; + }; + unless (defined $_tok) + { + Parse::RecDescent::_trace(q{<> (return value: [undef])}) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $_tok; + $item{__ACTION1__}=$_tok; + + + + Parse::RecDescent::_trace(q{>>Matched production: [TEXT basicfields textlines bodyMD5 bodydisp bodylang bodyextra]<<}, + Parse::RecDescent::_tracefirst($text), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{textmessage}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{textmessage}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{textmessage}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodyid +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"bodyid"}; + + Parse::RecDescent::_trace(q{Trying rule: [bodyid]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodyid}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [/[()]/ NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodyid}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{bodyid}); + %item = (__RULE__ => q{bodyid}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: [/[()]/]}, Parse::RecDescent::_tracefirst($text), + q{bodyid}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + $_savetext = $text; + + if ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:[()])//) + { + $text = $_savetext; + $expectation->failed(); + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + + last; + } + Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} + . $& . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $item{__PATTERN1__}=$&; + $text = $_savetext; + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{bodyid}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{NIL})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodyid}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodyid}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [/[()]/ NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodyid}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodyid}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{bodyid}); + %item = (__RULE__ => q{bodyid}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [STRING]}, + Parse::RecDescent::_tracefirst($text), + q{bodyid}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::STRING($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodyid}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [STRING]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodyid}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{STRING}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [STRING]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodyid}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodyid}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{bodyid}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{bodyid}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{bodyid}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodyextra +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"bodyextra"}; + + Parse::RecDescent::_trace(q{Trying rule: [bodyextra]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodyextra}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodyextra}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{bodyextra}); + %item = (__RULE__ => q{bodyextra}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{bodyextra}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodyextra}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodyextra}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodyextra}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodyextra}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{bodyextra}); + %item = (__RULE__ => q{bodyextra}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [STRING]}, + Parse::RecDescent::_tracefirst($text), + q{bodyextra}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::STRING($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodyextra}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [STRING]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodyextra}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{STRING}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [STRING]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodyextra}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [STRINGS]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodyextra}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[2]; + $text = $_[1]; + my $_savetext; + @item = (q{bodyextra}); + %item = (__RULE__ => q{bodyextra}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [STRINGS]}, + Parse::RecDescent::_tracefirst($text), + q{bodyextra}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::STRINGS($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodyextra}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [STRINGS]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodyextra}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{STRINGS}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [STRINGS]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodyextra}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodyextra}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{bodyextra}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{bodyextra}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{bodyextra}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::othertypemessage +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"othertypemessage"}; + + Parse::RecDescent::_trace(q{Trying rule: [othertypemessage]}, + Parse::RecDescent::_tracefirst($_[1]), + q{othertypemessage}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [bodytype basicfields bodyMD5 bodydisp bodylang bodyextra]}, + Parse::RecDescent::_tracefirst($_[1]), + q{othertypemessage}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{othertypemessage}); + %item = (__RULE__ => q{othertypemessage}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [bodytype]}, + Parse::RecDescent::_tracefirst($text), + q{othertypemessage}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodytype($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{othertypemessage}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [bodytype]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{othertypemessage}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodytype}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying subrule: [basicfields]}, + Parse::RecDescent::_tracefirst($text), + q{othertypemessage}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{basicfields})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::basicfields($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{othertypemessage}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [basicfields]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{othertypemessage}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{basicfields}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying repeated subrule: [bodyMD5]}, + Parse::RecDescent::_tracefirst($text), + q{othertypemessage}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{bodyMD5})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodyMD5, 0, 1, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{othertypemessage}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodyMD5]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{othertypemessage}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodyMD5(?)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [bodydisp]}, + Parse::RecDescent::_tracefirst($text), + q{othertypemessage}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{bodydisp})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodydisp, 0, 1, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{othertypemessage}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodydisp]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{othertypemessage}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodydisp(?)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [bodylang]}, + Parse::RecDescent::_tracefirst($text), + q{othertypemessage}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{bodylang})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodylang, 0, 1, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{othertypemessage}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodylang]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{othertypemessage}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodylang(?)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [bodyextra]}, + Parse::RecDescent::_tracefirst($text), + q{othertypemessage}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{bodyextra})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodyextra, 0, 1, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{othertypemessage}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodyextra]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{othertypemessage}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodyextra(?)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{othertypemessage}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = { bodytype => $item{bodytype} }; + take_optional_items($return, \%item + , qw/bodyMD5 bodydisp bodylang bodyextra/ ); + merge_hash($return, $item{basicfields}); + 1; + }; + unless (defined $_tok) + { + Parse::RecDescent::_trace(q{<> (return value: [undef])}) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $_tok; + $item{__ACTION1__}=$_tok; + + + + Parse::RecDescent::_trace(q{>>Matched production: [bodytype basicfields bodyMD5 bodydisp bodylang bodyextra]<<}, + Parse::RecDescent::_tracefirst($text), + q{othertypemessage}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{othertypemessage}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{othertypemessage}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{othertypemessage}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{othertypemessage}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::kvpair +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"kvpair"}; + + Parse::RecDescent::_trace(q{Trying rule: [kvpair]}, + Parse::RecDescent::_tracefirst($_[1]), + q{kvpair}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [')' key value]}, + Parse::RecDescent::_tracefirst($_[1]), + q{kvpair}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{kvpair}); + %item = (__RULE__ => q{kvpair}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: [')']}, + Parse::RecDescent::_tracefirst($text), + q{kvpair}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + $_savetext = $text; + + if ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and do { $_tok = ")"; 1 } and + substr($text,0,length($_tok)) eq $_tok and + do { substr($text,0,length($_tok)) = ""; 1; } + ) + { + $text = $_savetext; + $expectation->failed(); + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $item{__STRING1__}=$_tok; + $text = $_savetext; + + Parse::RecDescent::_trace(q{Trying subrule: [key]}, + Parse::RecDescent::_tracefirst($text), + q{kvpair}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{key})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::key($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{kvpair}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [key]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{kvpair}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{key}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying subrule: [value]}, + Parse::RecDescent::_tracefirst($text), + q{kvpair}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{value})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::value($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{kvpair}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [value]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{kvpair}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{value}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{kvpair}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = { $item{key} => $item{value} } }; + unless (defined $_tok) + { + Parse::RecDescent::_trace(q{<> (return value: [undef])}) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $_tok; + $item{__ACTION1__}=$_tok; + + + + Parse::RecDescent::_trace(q{>>Matched production: [')' key value]<<}, + Parse::RecDescent::_tracefirst($text), + q{kvpair}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{kvpair}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{kvpair}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{kvpair}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{kvpair}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodysize +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"bodysize"}; + + Parse::RecDescent::_trace(q{Trying rule: [bodysize]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodysize}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [/[()]/ NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodysize}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{bodysize}); + %item = (__RULE__ => q{bodysize}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: [/[()]/]}, Parse::RecDescent::_tracefirst($text), + q{bodysize}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + $_savetext = $text; + + if ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:[()])//) + { + $text = $_savetext; + $expectation->failed(); + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + + last; + } + Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} + . $& . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $item{__PATTERN1__}=$&; + $text = $_savetext; + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{bodysize}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{NIL})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodysize}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodysize}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [/[()]/ NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodysize}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [NUMBER]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodysize}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{bodysize}); + %item = (__RULE__ => q{bodysize}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NUMBER]}, + Parse::RecDescent::_tracefirst($text), + q{bodysize}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NUMBER($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodysize}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NUMBER]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodysize}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NUMBER}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NUMBER]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodysize}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodysize}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{bodysize}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{bodysize}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{bodysize}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::STRING +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"STRING"}; + + Parse::RecDescent::_trace(q{Trying rule: [STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{STRING}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [DOUBLE_QUOTED_STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{STRING}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{STRING}); + %item = (__RULE__ => q{STRING}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [DOUBLE_QUOTED_STRING]}, + Parse::RecDescent::_tracefirst($text), + q{STRING}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::DOUBLE_QUOTED_STRING($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{STRING}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [DOUBLE_QUOTED_STRING]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{STRING}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{DOUBLE_QUOTED_STRING}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [DOUBLE_QUOTED_STRING]<<}, + Parse::RecDescent::_tracefirst($text), + q{STRING}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [SINGLE_QUOTED_STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{STRING}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{STRING}); + %item = (__RULE__ => q{STRING}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [SINGLE_QUOTED_STRING]}, + Parse::RecDescent::_tracefirst($text), + q{STRING}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::SINGLE_QUOTED_STRING($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{STRING}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [SINGLE_QUOTED_STRING]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{STRING}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{SINGLE_QUOTED_STRING}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [SINGLE_QUOTED_STRING]<<}, + Parse::RecDescent::_tracefirst($text), + q{STRING}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [BARESTRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{STRING}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[2]; + $text = $_[1]; + my $_savetext; + @item = (q{STRING}); + %item = (__RULE__ => q{STRING}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [BARESTRING]}, + Parse::RecDescent::_tracefirst($text), + q{STRING}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::BARESTRING($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{STRING}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [BARESTRING]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{STRING}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{BARESTRING}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [BARESTRING]<<}, + Parse::RecDescent::_tracefirst($text), + q{STRING}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{STRING}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{STRING}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{STRING}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{STRING}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodytype +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"bodytype"}; + + Parse::RecDescent::_trace(q{Trying rule: [bodytype]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodytype}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodytype}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{bodytype}); + %item = (__RULE__ => q{bodytype}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [STRING]}, + Parse::RecDescent::_tracefirst($text), + q{bodytype}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::STRING($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodytype}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [STRING]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodytype}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{STRING}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [STRING]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodytype}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodytype}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{bodytype}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{bodytype}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{bodytype}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::TEXT +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"TEXT"}; + + Parse::RecDescent::_trace(q{Trying rule: [TEXT]}, + Parse::RecDescent::_tracefirst($_[1]), + q{TEXT}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [/^"TEXT"|^TEXT/i]}, + Parse::RecDescent::_tracefirst($_[1]), + q{TEXT}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{TEXT}); + %item = (__RULE__ => q{TEXT}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: [/^"TEXT"|^TEXT/i]}, Parse::RecDescent::_tracefirst($text), + q{TEXT}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:^"TEXT"|^TEXT)//i) + { + + $expectation->failed(); + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + + last; + } + Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} + . $& . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $item{__PATTERN1__}=$&; + + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{TEXT}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = "TEXT" }; + unless (defined $_tok) + { + Parse::RecDescent::_trace(q{<> (return value: [undef])}) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $_tok; + $item{__ACTION1__}=$_tok; + + + + Parse::RecDescent::_trace(q{>>Matched production: [/^"TEXT"|^TEXT/i]<<}, + Parse::RecDescent::_tracefirst($text), + q{TEXT}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{TEXT}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{TEXT}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{TEXT}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{TEXT}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::to +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"to"}; + + Parse::RecDescent::_trace(q{Trying rule: [to]}, + Parse::RecDescent::_tracefirst($_[1]), + q{to}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [ADDRESSES]}, + Parse::RecDescent::_tracefirst($_[1]), + q{to}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{to}); + %item = (__RULE__ => q{to}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [ADDRESSES]}, + Parse::RecDescent::_tracefirst($text), + q{to}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::ADDRESSES($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{to}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [ADDRESSES]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{to}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{ADDRESSES}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [ADDRESSES]<<}, + Parse::RecDescent::_tracefirst($text), + q{to}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{to}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{to}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{to}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{to}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"NIL"}; + + Parse::RecDescent::_trace(q{Trying rule: [NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{NIL}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [/^NIL/i]}, + Parse::RecDescent::_tracefirst($_[1]), + q{NIL}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{NIL}); + %item = (__RULE__ => q{NIL}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: [/^NIL/i]}, Parse::RecDescent::_tracefirst($text), + q{NIL}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:^NIL)//i) + { + + $expectation->failed(); + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + + last; + } + Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} + . $& . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $item{__PATTERN1__}=$&; + + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{NIL}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = "NIL" }; + unless (defined $_tok) + { + Parse::RecDescent::_trace(q{<> (return value: [undef])}) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $_tok; + $item{__ACTION1__}=$_tok; + + + + Parse::RecDescent::_trace(q{>>Matched production: [/^NIL/i]<<}, + Parse::RecDescent::_tracefirst($text), + q{NIL}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{NIL}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{NIL}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{NIL}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{NIL}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::KVPAIRS +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"KVPAIRS"}; + + Parse::RecDescent::_trace(q{Trying rule: [KVPAIRS]}, + Parse::RecDescent::_tracefirst($_[1]), + q{KVPAIRS}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: ['(' kvpair ')']}, + Parse::RecDescent::_tracefirst($_[1]), + q{KVPAIRS}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{KVPAIRS}); + %item = (__RULE__ => q{KVPAIRS}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: ['(']}, + Parse::RecDescent::_tracefirst($text), + q{KVPAIRS}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and do { $_tok = "("; 1 } and + substr($text,0,length($_tok)) eq $_tok and + do { substr($text,0,length($_tok)) = ""; 1; } + ) + { + + $expectation->failed(); + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $item{__STRING1__}=$_tok; + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [kvpair]}, + Parse::RecDescent::_tracefirst($text), + q{KVPAIRS}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{kvpair})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::kvpair, 1, 100000000, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{KVPAIRS}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [kvpair]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{KVPAIRS}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{kvpair(s)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying terminal: [')']}, + Parse::RecDescent::_tracefirst($text), + q{KVPAIRS}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{')'})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and do { $_tok = ")"; 1 } and + substr($text,0,length($_tok)) eq $_tok and + do { substr($text,0,length($_tok)) = ""; 1; } + ) + { + + $expectation->failed(); + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $item{__STRING2__}=$_tok; + + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{KVPAIRS}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = { map { (%$_) } @{$item{'kvpair(s)'}} } }; + unless (defined $_tok) + { + Parse::RecDescent::_trace(q{<> (return value: [undef])}) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $_tok; + $item{__ACTION1__}=$_tok; + + + + Parse::RecDescent::_trace(q{>>Matched production: ['(' kvpair ')']<<}, + Parse::RecDescent::_tracefirst($text), + q{KVPAIRS}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{KVPAIRS}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{KVPAIRS}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{KVPAIRS}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{KVPAIRS}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::from +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"from"}; + + Parse::RecDescent::_trace(q{Trying rule: [from]}, + Parse::RecDescent::_tracefirst($_[1]), + q{from}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [ADDRESSES]}, + Parse::RecDescent::_tracefirst($_[1]), + q{from}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{from}); + %item = (__RULE__ => q{from}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [ADDRESSES]}, + Parse::RecDescent::_tracefirst($text), + q{from}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::ADDRESSES($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{from}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [ADDRESSES]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{from}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{ADDRESSES}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [ADDRESSES]<<}, + Parse::RecDescent::_tracefirst($text), + q{from}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{from}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{from}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{from}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{from}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodystructure +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"bodystructure"}; + + Parse::RecDescent::_trace(q{Trying rule: [bodystructure]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodystructure}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: ['(' part ')']}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodystructure}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{bodystructure}); + %item = (__RULE__ => q{bodystructure}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: ['(']}, + Parse::RecDescent::_tracefirst($text), + q{bodystructure}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and do { $_tok = "("; 1 } and + substr($text,0,length($_tok)) eq $_tok and + do { substr($text,0,length($_tok)) = ""; 1; } + ) + { + + $expectation->failed(); + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $item{__STRING1__}=$_tok; + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [part]}, + Parse::RecDescent::_tracefirst($text), + q{bodystructure}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{part})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::part, 1, 100000000, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodystructure}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [part]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{bodystructure}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{part(s)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying terminal: [')']}, + Parse::RecDescent::_tracefirst($text), + q{bodystructure}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{')'})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and do { $_tok = ")"; 1 } and + substr($text,0,length($_tok)) eq $_tok and + do { substr($text,0,length($_tok)) = ""; 1; } + ) + { + + $expectation->failed(); + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $item{__STRING2__}=$_tok; + + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{bodystructure}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = $item{'part(s)'} }; + unless (defined $_tok) + { + Parse::RecDescent::_trace(q{<> (return value: [undef])}) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $_tok; + $item{__ACTION1__}=$_tok; + + + + Parse::RecDescent::_trace(q{>>Matched production: ['(' part ')']<<}, + Parse::RecDescent::_tracefirst($text), + q{bodystructure}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodystructure}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{bodystructure}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{bodystructure}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{bodystructure}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::PLAIN +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"PLAIN"}; + + Parse::RecDescent::_trace(q{Trying rule: [PLAIN]}, + Parse::RecDescent::_tracefirst($_[1]), + q{PLAIN}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [/^"PLAIN"|^PLAIN/i]}, + Parse::RecDescent::_tracefirst($_[1]), + q{PLAIN}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{PLAIN}); + %item = (__RULE__ => q{PLAIN}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: [/^"PLAIN"|^PLAIN/i]}, Parse::RecDescent::_tracefirst($text), + q{PLAIN}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:^"PLAIN"|^PLAIN)//i) + { + + $expectation->failed(); + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + + last; + } + Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} + . $& . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $item{__PATTERN1__}=$&; + + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{PLAIN}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = "PLAIN" }; + unless (defined $_tok) + { + Parse::RecDescent::_trace(q{<> (return value: [undef])}) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $_tok; + $item{__ACTION1__}=$_tok; + + + + Parse::RecDescent::_trace(q{>>Matched production: [/^"PLAIN"|^PLAIN/i]<<}, + Parse::RecDescent::_tracefirst($text), + q{PLAIN}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{PLAIN}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{PLAIN}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{PLAIN}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{PLAIN}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NUMBER +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"NUMBER"}; + + Parse::RecDescent::_trace(q{Trying rule: [NUMBER]}, + Parse::RecDescent::_tracefirst($_[1]), + q{NUMBER}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [/^(\\d+)/]}, + Parse::RecDescent::_tracefirst($_[1]), + q{NUMBER}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{NUMBER}); + %item = (__RULE__ => q{NUMBER}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: [/^(\\d+)/]}, Parse::RecDescent::_tracefirst($text), + q{NUMBER}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:^(\d+))//) + { + + $expectation->failed(); + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + + last; + } + Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} + . $& . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $item{__PATTERN1__}=$&; + + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{NUMBER}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = $item[1] }; + unless (defined $_tok) + { + Parse::RecDescent::_trace(q{<> (return value: [undef])}) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $_tok; + $item{__ACTION1__}=$_tok; + + + + Parse::RecDescent::_trace(q{>>Matched production: [/^(\\d+)/]<<}, + Parse::RecDescent::_tracefirst($text), + q{NUMBER}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{NUMBER}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{NUMBER}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{NUMBER}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{NUMBER}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::STRINGS +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"STRINGS"}; + + Parse::RecDescent::_trace(q{Trying rule: [STRINGS]}, + Parse::RecDescent::_tracefirst($_[1]), + q{STRINGS}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: ['(' STRING ')']}, + Parse::RecDescent::_tracefirst($_[1]), + q{STRINGS}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{STRINGS}); + %item = (__RULE__ => q{STRINGS}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: ['(']}, + Parse::RecDescent::_tracefirst($text), + q{STRINGS}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and do { $_tok = "("; 1 } and + substr($text,0,length($_tok)) eq $_tok and + do { substr($text,0,length($_tok)) = ""; 1; } + ) + { + + $expectation->failed(); + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $item{__STRING1__}=$_tok; + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [STRING]}, + Parse::RecDescent::_tracefirst($text), + q{STRINGS}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{STRING})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::STRING, 1, 100000000, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{STRINGS}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [STRING]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{STRINGS}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{STRING(s)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying terminal: [')']}, + Parse::RecDescent::_tracefirst($text), + q{STRINGS}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{')'})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and do { $_tok = ")"; 1 } and + substr($text,0,length($_tok)) eq $_tok and + do { substr($text,0,length($_tok)) = ""; 1; } + ) + { + + $expectation->failed(); + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $item{__STRING2__}=$_tok; + + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{STRINGS}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = $item{'STRING(s)'} }; + unless (defined $_tok) + { + Parse::RecDescent::_trace(q{<> (return value: [undef])}) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $_tok; + $item{__ACTION1__}=$_tok; + + + + Parse::RecDescent::_trace(q{>>Matched production: ['(' STRING ')']<<}, + Parse::RecDescent::_tracefirst($text), + q{STRINGS}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{STRINGS}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{STRINGS}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{STRINGS}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{STRINGS}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::HTML +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"HTML"}; + + Parse::RecDescent::_trace(q{Trying rule: [HTML]}, + Parse::RecDescent::_tracefirst($_[1]), + q{HTML}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [/"HTML"|HTML/i]}, + Parse::RecDescent::_tracefirst($_[1]), + q{HTML}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{HTML}); + %item = (__RULE__ => q{HTML}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: [/"HTML"|HTML/i]}, Parse::RecDescent::_tracefirst($text), + q{HTML}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:"HTML"|HTML)//i) + { + + $expectation->failed(); + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + + last; + } + Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} + . $& . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $item{__PATTERN1__}=$&; + + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{HTML}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = "HTML" }; + unless (defined $_tok) + { + Parse::RecDescent::_trace(q{<> (return value: [undef])}) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $_tok; + $item{__ACTION1__}=$_tok; + + + + Parse::RecDescent::_trace(q{>>Matched production: [/"HTML"|HTML/i]<<}, + Parse::RecDescent::_tracefirst($text), + q{HTML}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{HTML}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{HTML}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{HTML}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{HTML}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodydisp +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"bodydisp"}; + + Parse::RecDescent::_trace(q{Trying rule: [bodydisp]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodydisp}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodydisp}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{bodydisp}); + %item = (__RULE__ => q{bodydisp}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{bodydisp}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodydisp}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodydisp}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodydisp}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [KVPAIRS]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodydisp}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{bodydisp}); + %item = (__RULE__ => q{bodydisp}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [KVPAIRS]}, + Parse::RecDescent::_tracefirst($text), + q{bodydisp}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::KVPAIRS($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodydisp}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [KVPAIRS]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodydisp}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{KVPAIRS}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [KVPAIRS]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodydisp}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodydisp}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{bodydisp}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{bodydisp}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{bodydisp}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::part +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"part"}; + + Parse::RecDescent::_trace(q{Trying rule: [part]}, + Parse::RecDescent::_tracefirst($_[1]), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [multipart]}, + Parse::RecDescent::_tracefirst($_[1]), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{part}); + %item = (__RULE__ => q{part}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [multipart]}, + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::multipart($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [multipart]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{multipart}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = bless $item{multipart}, $mibs }; + unless (defined $_tok) + { + Parse::RecDescent::_trace(q{<> (return value: [undef])}) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $_tok; + $item{__ACTION1__}=$_tok; + + + + Parse::RecDescent::_trace(q{>>Matched production: [multipart]<<}, + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [textmessage]}, + Parse::RecDescent::_tracefirst($_[1]), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{part}); + %item = (__RULE__ => q{part}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [textmessage]}, + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::textmessage($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [textmessage]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{textmessage}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = bless $item{textmessage}, $mibs }; + unless (defined $_tok) + { + Parse::RecDescent::_trace(q{<> (return value: [undef])}) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $_tok; + $item{__ACTION1__}=$_tok; + + + + Parse::RecDescent::_trace(q{>>Matched production: [textmessage]<<}, + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [nestedmessage]}, + Parse::RecDescent::_tracefirst($_[1]), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[2]; + $text = $_[1]; + my $_savetext; + @item = (q{part}); + %item = (__RULE__ => q{part}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [nestedmessage]}, + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::nestedmessage($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [nestedmessage]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{nestedmessage}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = bless $item{nestedmessage}, $mibs }; + unless (defined $_tok) + { + Parse::RecDescent::_trace(q{<> (return value: [undef])}) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $_tok; + $item{__ACTION1__}=$_tok; + + + + Parse::RecDescent::_trace(q{>>Matched production: [nestedmessage]<<}, + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [othertypemessage]}, + Parse::RecDescent::_tracefirst($_[1]), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[3]; + $text = $_[1]; + my $_savetext; + @item = (q{part}); + %item = (__RULE__ => q{part}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [othertypemessage]}, + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::othertypemessage($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [othertypemessage]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{othertypemessage}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = bless $item{othertypemessage}, $mibs }; + unless (defined $_tok) + { + Parse::RecDescent::_trace(q{<> (return value: [undef])}) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $_tok; + $item{__ACTION1__}=$_tok; + + + + Parse::RecDescent::_trace(q{>>Matched production: [othertypemessage]<<}, + Parse::RecDescent::_tracefirst($text), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{part}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{part}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{part}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{part}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::nestedmessage +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"nestedmessage"}; + + Parse::RecDescent::_trace(q{Trying rule: [nestedmessage]}, + Parse::RecDescent::_tracefirst($_[1]), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [rfc822message bodyparms bodyid bodydesc bodyenc bodysize envelopestruct bodystructure textlines bodyMD5 bodydisp bodylang bodyextra]}, + Parse::RecDescent::_tracefirst($_[1]), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{nestedmessage}); + %item = (__RULE__ => q{nestedmessage}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [rfc822message]}, + Parse::RecDescent::_tracefirst($text), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::rfc822message($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [rfc822message]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{rfc822message}} = $_tok; + push @item, $_tok; + + } + + + + Parse::RecDescent::_trace(q{Trying directive: []}, + Parse::RecDescent::_tracefirst($text), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + $_tok = do { $commit = 1 }; + if (defined($_tok)) + { + Parse::RecDescent::_trace(q{>>Matched directive<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + } + else + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + } + + last unless defined $_tok; + push @item, $item{__DIRECTIVE1__}=$_tok; + + + Parse::RecDescent::_trace(q{Trying subrule: [bodyparms]}, + Parse::RecDescent::_tracefirst($text), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{bodyparms})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodyparms($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [bodyparms]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodyparms}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying subrule: [bodyid]}, + Parse::RecDescent::_tracefirst($text), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{bodyid})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodyid($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [bodyid]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodyid}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying subrule: [bodydesc]}, + Parse::RecDescent::_tracefirst($text), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{bodydesc})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodydesc($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [bodydesc]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodydesc}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying subrule: [bodyenc]}, + Parse::RecDescent::_tracefirst($text), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{bodyenc})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodyenc($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [bodyenc]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodyenc}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying subrule: [bodysize]}, + Parse::RecDescent::_tracefirst($text), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{bodysize})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodysize($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [bodysize]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodysize}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying repeated subrule: [envelopestruct]}, + Parse::RecDescent::_tracefirst($text), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{envelopestruct})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::envelopestruct, 0, 1, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [envelopestruct]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{envelopestruct(?)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [bodystructure]}, + Parse::RecDescent::_tracefirst($text), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{bodystructure})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodystructure, 0, 1, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodystructure]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodystructure(?)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [textlines]}, + Parse::RecDescent::_tracefirst($text), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{textlines})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::textlines, 0, 1, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [textlines]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{textlines(?)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [bodyMD5]}, + Parse::RecDescent::_tracefirst($text), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{bodyMD5})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodyMD5, 0, 1, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodyMD5]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodyMD5(?)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [bodydisp]}, + Parse::RecDescent::_tracefirst($text), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{bodydisp})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodydisp, 0, 1, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodydisp]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodydisp(?)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [bodylang]}, + Parse::RecDescent::_tracefirst($text), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{bodylang})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodylang, 0, 1, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodylang]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodylang(?)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [bodyextra]}, + Parse::RecDescent::_tracefirst($text), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{bodyextra})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodyextra, 0, 1, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [bodyextra]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bodyextra(?)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { + $return = {}; + $return->{$_} = $item{$_} + for qw/bodyparms bodyid bodydesc bodyenc bodysize/; +# envelopestruct bodystructure textlines/; + + take_optional_items($return, \%item + , qw/envelopestruct bodystructure textlines/ + , qw/bodyMD5 bodydisp bodylang bodyextra/); + + merge_hash($return, $item{bodystructure}[0]); + merge_hash($return, $item{basicfields}); + $return->{bodytype} = "MESSAGE" ; + $return->{bodysubtype} = "RFC822" ; + 1; + }; + unless (defined $_tok) + { + Parse::RecDescent::_trace(q{<> (return value: [undef])}) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $_tok; + $item{__ACTION1__}=$_tok; + + + + Parse::RecDescent::_trace(q{>>Matched production: [rfc822message bodyparms bodyid bodydesc bodyenc bodysize envelopestruct bodystructure textlines bodyMD5 bodydisp bodylang bodyextra]<<}, + Parse::RecDescent::_tracefirst($text), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{nestedmessage}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{nestedmessage}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{nestedmessage}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::SINGLE_QUOTED_STRING +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"SINGLE_QUOTED_STRING"}; + + Parse::RecDescent::_trace(q{Trying rule: [SINGLE_QUOTED_STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{SINGLE_QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [''' /(?:\\\\'|[^'])*/ ''']}, + Parse::RecDescent::_tracefirst($_[1]), + q{SINGLE_QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{SINGLE_QUOTED_STRING}); + %item = (__RULE__ => q{SINGLE_QUOTED_STRING}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: [''']}, + Parse::RecDescent::_tracefirst($text), + q{SINGLE_QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and do { $_tok = "'"; 1 } and + substr($text,0,length($_tok)) eq $_tok and + do { substr($text,0,length($_tok)) = ""; 1; } + ) + { + + $expectation->failed(); + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $item{__STRING1__}=$_tok; + + + Parse::RecDescent::_trace(q{Trying terminal: [/(?:\\\\'|[^'])*/]}, Parse::RecDescent::_tracefirst($text), + q{SINGLE_QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{/(?:\\\\'|[^'])*/})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:(?:\\'|[^'])*)//) + { + + $expectation->failed(); + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + + last; + } + Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} + . $& . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $item{__PATTERN1__}=$&; + + + Parse::RecDescent::_trace(q{Trying terminal: [''']}, + Parse::RecDescent::_tracefirst($text), + q{SINGLE_QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{'''})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and do { $_tok = "'"; 1 } and + substr($text,0,length($_tok)) eq $_tok and + do { substr($text,0,length($_tok)) = ""; 1; } + ) + { + + $expectation->failed(); + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $item{__STRING2__}=$_tok; + + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{SINGLE_QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = $item{__PATTERN1__} }; + unless (defined $_tok) + { + Parse::RecDescent::_trace(q{<> (return value: [undef])}) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $_tok; + $item{__ACTION1__}=$_tok; + + + + Parse::RecDescent::_trace(q{>>Matched production: [''' /(?:\\\\'|[^'])*/ ''']<<}, + Parse::RecDescent::_tracefirst($text), + q{SINGLE_QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{SINGLE_QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{SINGLE_QUOTED_STRING}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{SINGLE_QUOTED_STRING}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{SINGLE_QUOTED_STRING}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::ADDRESSES +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"ADDRESSES"}; + + Parse::RecDescent::_trace(q{Trying rule: [ADDRESSES]}, + Parse::RecDescent::_tracefirst($_[1]), + q{ADDRESSES}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{ADDRESSES}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{ADDRESSES}); + %item = (__RULE__ => q{ADDRESSES}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{ADDRESSES}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{ADDRESSES}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{ADDRESSES}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{ADDRESSES}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: ['(' addressstruct ')']}, + Parse::RecDescent::_tracefirst($_[1]), + q{ADDRESSES}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{ADDRESSES}); + %item = (__RULE__ => q{ADDRESSES}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: ['(']}, + Parse::RecDescent::_tracefirst($text), + q{ADDRESSES}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and do { $_tok = "("; 1 } and + substr($text,0,length($_tok)) eq $_tok and + do { substr($text,0,length($_tok)) = ""; 1; } + ) + { + + $expectation->failed(); + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $item{__STRING1__}=$_tok; + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [addressstruct]}, + Parse::RecDescent::_tracefirst($text), + q{ADDRESSES}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{addressstruct})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::addressstruct, 1, 100000000, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{ADDRESSES}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [addressstruct]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{ADDRESSES}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{addressstruct(s)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying terminal: [')']}, + Parse::RecDescent::_tracefirst($text), + q{ADDRESSES}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{')'})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and do { $_tok = ")"; 1 } and + substr($text,0,length($_tok)) eq $_tok and + do { substr($text,0,length($_tok)) = ""; 1; } + ) + { + + $expectation->failed(); + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $item{__STRING2__}=$_tok; + + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{ADDRESSES}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = $item{'addressstruct(s)'} }; + unless (defined $_tok) + { + Parse::RecDescent::_trace(q{<> (return value: [undef])}) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $_tok; + $item{__ACTION1__}=$_tok; + + + + Parse::RecDescent::_trace(q{>>Matched production: ['(' addressstruct ')']<<}, + Parse::RecDescent::_tracefirst($text), + q{ADDRESSES}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{ADDRESSES}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{ADDRESSES}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{ADDRESSES}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{ADDRESSES}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bcc +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"bcc"}; + + Parse::RecDescent::_trace(q{Trying rule: [bcc]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bcc}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [ADDRESSES]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bcc}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{bcc}); + %item = (__RULE__ => q{bcc}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [ADDRESSES]}, + Parse::RecDescent::_tracefirst($text), + q{bcc}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::ADDRESSES($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bcc}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [ADDRESSES]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bcc}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{ADDRESSES}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [ADDRESSES]<<}, + Parse::RecDescent::_tracefirst($text), + q{bcc}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{bcc}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{bcc}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{bcc}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{bcc}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::rfc822message +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"rfc822message"}; + + Parse::RecDescent::_trace(q{Trying rule: [rfc822message]}, + Parse::RecDescent::_tracefirst($_[1]), + q{rfc822message}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [MESSAGE RFC822]}, + Parse::RecDescent::_tracefirst($_[1]), + q{rfc822message}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{rfc822message}); + %item = (__RULE__ => q{rfc822message}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [MESSAGE]}, + Parse::RecDescent::_tracefirst($text), + q{rfc822message}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::MESSAGE($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{rfc822message}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [MESSAGE]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{rfc822message}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{MESSAGE}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying subrule: [RFC822]}, + Parse::RecDescent::_tracefirst($text), + q{rfc822message}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{RFC822})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::RFC822($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{rfc822message}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [RFC822]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{rfc822message}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{RFC822}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{rfc822message}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = "MESSAGE RFC822" }; + unless (defined $_tok) + { + Parse::RecDescent::_trace(q{<> (return value: [undef])}) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $_tok; + $item{__ACTION1__}=$_tok; + + + + Parse::RecDescent::_trace(q{>>Matched production: [MESSAGE RFC822]<<}, + Parse::RecDescent::_tracefirst($text), + q{rfc822message}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{rfc822message}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{rfc822message}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{rfc822message}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{rfc822message}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::addressstruct +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"addressstruct"}; + + Parse::RecDescent::_trace(q{Trying rule: [addressstruct]}, + Parse::RecDescent::_tracefirst($_[1]), + q{addressstruct}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: ['(' personalname sourceroute mailboxname hostname ')']}, + Parse::RecDescent::_tracefirst($_[1]), + q{addressstruct}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{addressstruct}); + %item = (__RULE__ => q{addressstruct}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: ['(']}, + Parse::RecDescent::_tracefirst($text), + q{addressstruct}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and do { $_tok = "("; 1 } and + substr($text,0,length($_tok)) eq $_tok and + do { substr($text,0,length($_tok)) = ""; 1; } + ) + { + + $expectation->failed(); + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $item{__STRING1__}=$_tok; + + + Parse::RecDescent::_trace(q{Trying subrule: [personalname]}, + Parse::RecDescent::_tracefirst($text), + q{addressstruct}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{personalname})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::personalname($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{addressstruct}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [personalname]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{addressstruct}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{personalname}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying subrule: [sourceroute]}, + Parse::RecDescent::_tracefirst($text), + q{addressstruct}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{sourceroute})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::sourceroute($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{addressstruct}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [sourceroute]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{addressstruct}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{sourceroute}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying subrule: [mailboxname]}, + Parse::RecDescent::_tracefirst($text), + q{addressstruct}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{mailboxname})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::mailboxname($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{addressstruct}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [mailboxname]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{addressstruct}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{mailboxname}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying subrule: [hostname]}, + Parse::RecDescent::_tracefirst($text), + q{addressstruct}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{hostname})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::hostname($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{addressstruct}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [hostname]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{addressstruct}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{hostname}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying terminal: [')']}, + Parse::RecDescent::_tracefirst($text), + q{addressstruct}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{')'})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and do { $_tok = ")"; 1 } and + substr($text,0,length($_tok)) eq $_tok and + do { substr($text,0,length($_tok)) = ""; 1; } + ) + { + + $expectation->failed(); + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $item{__STRING2__}=$_tok; + + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{addressstruct}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { bless { personalname => $item{personalname} + , sourceroute => $item{sourceroute} + , mailboxname => $item{mailboxname} + , hostname => $item{hostname} + }, 'Mail::IMAPClient::BodyStructure::Address'; + }; + unless (defined $_tok) + { + Parse::RecDescent::_trace(q{<> (return value: [undef])}) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $_tok; + $item{__ACTION1__}=$_tok; + + + + Parse::RecDescent::_trace(q{>>Matched production: ['(' personalname sourceroute mailboxname hostname ')']<<}, + Parse::RecDescent::_tracefirst($text), + q{addressstruct}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{addressstruct}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{addressstruct}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{addressstruct}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{addressstruct}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::sourceroute +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"sourceroute"}; + + Parse::RecDescent::_trace(q{Trying rule: [sourceroute]}, + Parse::RecDescent::_tracefirst($_[1]), + q{sourceroute}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{sourceroute}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{sourceroute}); + %item = (__RULE__ => q{sourceroute}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{sourceroute}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{sourceroute}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{sourceroute}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{sourceroute}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{sourceroute}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{sourceroute}); + %item = (__RULE__ => q{sourceroute}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [STRING]}, + Parse::RecDescent::_tracefirst($text), + q{sourceroute}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::STRING($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{sourceroute}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [STRING]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{sourceroute}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{STRING}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [STRING]<<}, + Parse::RecDescent::_tracefirst($text), + q{sourceroute}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{sourceroute}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{sourceroute}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{sourceroute}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{sourceroute}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::subpart +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"subpart"}; + + Parse::RecDescent::_trace(q{Trying rule: [subpart]}, + Parse::RecDescent::_tracefirst($_[1]), + q{subpart}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: ['(' part ')' ]}, + Parse::RecDescent::_tracefirst($_[1]), + q{subpart}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{subpart}); + %item = (__RULE__ => q{subpart}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: ['(']}, + Parse::RecDescent::_tracefirst($text), + q{subpart}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and do { $_tok = "("; 1 } and + substr($text,0,length($_tok)) eq $_tok and + do { substr($text,0,length($_tok)) = ""; 1; } + ) + { + + $expectation->failed(); + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $item{__STRING1__}=$_tok; + + + Parse::RecDescent::_trace(q{Trying subrule: [part]}, + Parse::RecDescent::_tracefirst($text), + q{subpart}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{part})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::part($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{subpart}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [part]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{subpart}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{part}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying terminal: [')']}, + Parse::RecDescent::_tracefirst($text), + q{subpart}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{')'})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and do { $_tok = ")"; 1 } and + substr($text,0,length($_tok)) eq $_tok and + do { substr($text,0,length($_tok)) = ""; 1; } + ) + { + + $expectation->failed(); + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $item{__STRING2__}=$_tok; + + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{subpart}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do {$return = $item{part}}; + unless (defined $_tok) + { + Parse::RecDescent::_trace(q{<> (return value: [undef])}) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $_tok; + $item{__ACTION1__}=$_tok; + + + + + Parse::RecDescent::_trace(q{Trying directive: []}, + Parse::RecDescent::_tracefirst($text), + q{subpart}, + $tracelevel) + if defined $::RD_TRACE; + $_tok = do { push @{$thisparser->{deferred}}, sub { ++$subpartCount; }; }; + if (defined($_tok)) + { + Parse::RecDescent::_trace(q{>>Matched directive<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + } + else + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + } + + last unless defined $_tok; + push @item, $item{__DIRECTIVE1__}=$_tok; + + + + Parse::RecDescent::_trace(q{>>Matched production: ['(' part ')' ]<<}, + Parse::RecDescent::_tracefirst($text), + q{subpart}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{subpart}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{subpart}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{subpart}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{subpart}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::textlines +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"textlines"}; + + Parse::RecDescent::_trace(q{Trying rule: [textlines]}, + Parse::RecDescent::_tracefirst($_[1]), + q{textlines}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{textlines}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{textlines}); + %item = (__RULE__ => q{textlines}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{textlines}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{textlines}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{textlines}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{textlines}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [NUMBER]}, + Parse::RecDescent::_tracefirst($_[1]), + q{textlines}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{textlines}); + %item = (__RULE__ => q{textlines}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NUMBER]}, + Parse::RecDescent::_tracefirst($text), + q{textlines}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NUMBER($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{textlines}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NUMBER]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{textlines}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NUMBER}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NUMBER]<<}, + Parse::RecDescent::_tracefirst($text), + q{textlines}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{textlines}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{textlines}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{textlines}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{textlines}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::BARESTRING +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"BARESTRING"}; + + Parse::RecDescent::_trace(q{Trying rule: [BARESTRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{BARESTRING}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [/^[)('"]/ /^(?!\\(|\\))(?:\\\\ |\\S)+/]}, + Parse::RecDescent::_tracefirst($_[1]), + q{BARESTRING}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{BARESTRING}); + %item = (__RULE__ => q{BARESTRING}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: [/^[)('"]/]}, Parse::RecDescent::_tracefirst($text), + q{BARESTRING}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + $_savetext = $text; + + if ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:^[)('"])//) + { + $text = $_savetext; + $expectation->failed(); + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + + last; + } + Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} + . $& . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $item{__PATTERN1__}=$&; + $text = $_savetext; + + Parse::RecDescent::_trace(q{Trying terminal: [/^(?!\\(|\\))(?:\\\\ |\\S)+/]}, Parse::RecDescent::_tracefirst($text), + q{BARESTRING}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{/^(?!\\(|\\))(?:\\\\ |\\S)+/})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:^(?!\(|\))(?:\\ |\S)+)//) + { + + $expectation->failed(); + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + + last; + } + Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} + . $& . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $item{__PATTERN2__}=$&; + + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{BARESTRING}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = $item{__PATTERN1__} }; + unless (defined $_tok) + { + Parse::RecDescent::_trace(q{<> (return value: [undef])}) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $_tok; + $item{__ACTION1__}=$_tok; + + + + Parse::RecDescent::_trace(q{>>Matched production: [/^[)('"]/ /^(?!\\(|\\))(?:\\\\ |\\S)+/]<<}, + Parse::RecDescent::_tracefirst($text), + q{BARESTRING}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{BARESTRING}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{BARESTRING}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{BARESTRING}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{BARESTRING}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodyloc +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"bodyloc"}; + + Parse::RecDescent::_trace(q{Trying rule: [bodyloc]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodyloc}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodyloc}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{bodyloc}); + %item = (__RULE__ => q{bodyloc}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{bodyloc}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodyloc}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodyloc}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodyloc}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodyloc}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{bodyloc}); + %item = (__RULE__ => q{bodyloc}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [STRING]}, + Parse::RecDescent::_tracefirst($text), + q{bodyloc}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::STRING($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodyloc}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [STRING]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodyloc}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{STRING}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [STRING]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodyloc}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodyloc}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{bodyloc}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{bodyloc}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{bodyloc}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bodylang +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"bodylang"}; + + Parse::RecDescent::_trace(q{Trying rule: [bodylang]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodylang}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodylang}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{bodylang}); + %item = (__RULE__ => q{bodylang}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{bodylang}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodylang}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodylang}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodylang}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodylang}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{bodylang}); + %item = (__RULE__ => q{bodylang}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [STRING]}, + Parse::RecDescent::_tracefirst($text), + q{bodylang}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::STRING($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodylang}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [STRING]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodylang}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{STRING}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [STRING]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodylang}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [STRINGS]}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodylang}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[2]; + $text = $_[1]; + my $_savetext; + @item = (q{bodylang}); + %item = (__RULE__ => q{bodylang}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [STRINGS]}, + Parse::RecDescent::_tracefirst($text), + q{bodylang}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::STRINGS($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{bodylang}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [STRINGS]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{bodylang}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{STRINGS}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [STRINGS]<<}, + Parse::RecDescent::_tracefirst($text), + q{bodylang}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{bodylang}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{bodylang}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{bodylang}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{bodylang}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::envelopestruct +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"envelopestruct"}; + + Parse::RecDescent::_trace(q{Trying rule: [envelopestruct]}, + Parse::RecDescent::_tracefirst($_[1]), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: ['(' date subject from sender replyto to cc bcc inreplyto messageid ')']}, + Parse::RecDescent::_tracefirst($_[1]), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{envelopestruct}); + %item = (__RULE__ => q{envelopestruct}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: ['(']}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and do { $_tok = "("; 1 } and + substr($text,0,length($_tok)) eq $_tok and + do { substr($text,0,length($_tok)) = ""; 1; } + ) + { + + $expectation->failed(); + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $item{__STRING1__}=$_tok; + + + Parse::RecDescent::_trace(q{Trying subrule: [date]}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{date})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::date($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [date]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{date}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying subrule: [subject]}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{subject})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::subject($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [subject]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{subject}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying subrule: [from]}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{from})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::from($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [from]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{from}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying subrule: [sender]}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{sender})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::sender($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [sender]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{sender}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying subrule: [replyto]}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{replyto})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::replyto($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [replyto]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{replyto}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying subrule: [to]}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{to})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::to($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [to]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{to}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying subrule: [cc]}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{cc})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::cc($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [cc]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{cc}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying subrule: [bcc]}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{bcc})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::bcc($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [bcc]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{bcc}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying subrule: [inreplyto]}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{inreplyto})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::inreplyto($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [inreplyto]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{inreplyto}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying subrule: [messageid]}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{messageid})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::messageid($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [messageid]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{messageid}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying terminal: [')']}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{')'})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and do { $_tok = ")"; 1 } and + substr($text,0,length($_tok)) eq $_tok and + do { substr($text,0,length($_tok)) = ""; 1; } + ) + { + + $expectation->failed(); + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $item{__STRING2__}=$_tok; + + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = bless {}, "Mail::IMAPClient::BodyStructure::Envelope"; + $return->{$_} = $item{$_} + for qw/date subject from sender replyto to cc/ + , qw/bcc inreplyto messageid/; + 1; + }; + unless (defined $_tok) + { + Parse::RecDescent::_trace(q{<> (return value: [undef])}) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $_tok; + $item{__ACTION1__}=$_tok; + + + + Parse::RecDescent::_trace(q{>>Matched production: ['(' date subject from sender replyto to cc bcc inreplyto messageid ')']<<}, + Parse::RecDescent::_tracefirst($text), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{envelopestruct}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{envelopestruct}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{envelopestruct}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::replyto +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"replyto"}; + + Parse::RecDescent::_trace(q{Trying rule: [replyto]}, + Parse::RecDescent::_tracefirst($_[1]), + q{replyto}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [ADDRESSES]}, + Parse::RecDescent::_tracefirst($_[1]), + q{replyto}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{replyto}); + %item = (__RULE__ => q{replyto}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [ADDRESSES]}, + Parse::RecDescent::_tracefirst($text), + q{replyto}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::ADDRESSES($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{replyto}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [ADDRESSES]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{replyto}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{ADDRESSES}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [ADDRESSES]<<}, + Parse::RecDescent::_tracefirst($text), + q{replyto}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{replyto}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{replyto}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{replyto}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{replyto}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::mailboxname +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"mailboxname"}; + + Parse::RecDescent::_trace(q{Trying rule: [mailboxname]}, + Parse::RecDescent::_tracefirst($_[1]), + q{mailboxname}, + $tracelevel) + if defined $::RD_TRACE; + + my $def_at = @{$thisparser->{deferred}}; + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [NIL]}, + Parse::RecDescent::_tracefirst($_[1]), + q{mailboxname}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{mailboxname}); + %item = (__RULE__ => q{mailboxname}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NIL]}, + Parse::RecDescent::_tracefirst($text), + q{mailboxname}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::NIL($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{mailboxname}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NIL]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{mailboxname}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NIL}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [NIL]<<}, + Parse::RecDescent::_tracefirst($text), + q{mailboxname}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [STRING]}, + Parse::RecDescent::_tracefirst($_[1]), + q{mailboxname}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{mailboxname}); + %item = (__RULE__ => q{mailboxname}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [STRING]}, + Parse::RecDescent::_tracefirst($text), + q{mailboxname}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse::STRING($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{mailboxname}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [STRING]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{mailboxname}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{STRING}} = $_tok; + push @item, $_tok; + + } + + + Parse::RecDescent::_trace(q{>>Matched production: [STRING]<<}, + Parse::RecDescent::_tracefirst($text), + q{mailboxname}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + + unless ( $_matched || defined($return) || defined($score) ) + { + splice @{$thisparser->{deferred}}, $def_at; + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{mailboxname}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{mailboxname}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{mailboxname}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{mailboxname}, + $tracelevel) + } + $_[1] = $text; + return $return; +} +} +package Mail::IMAPClient::BodyStructure::Parse; sub new { my $self = bless( { + '_AUTOTREE' => undef, + 'localvars' => '', + 'startcode' => '', + '_check' => { + 'thisoffset' => '', + 'itempos' => '', + 'prevoffset' => '', + 'prevline' => '', + 'prevcolumn' => '', + 'thiscolumn' => '' + }, + 'namespace' => 'Parse::RecDescent::Mail::IMAPClient::BodyStructure::Parse', + 'deferrable' => 1, + '_AUTOACTION' => undef, + 'rules' => { + 'bodyparms' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'KVPAIRS' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 65 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'KVPAIRS', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 65 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => 65 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'bodyparms', + 'vars' => '', + 'line' => 65 + }, 'Parse::RecDescent::Rule' ), + 'date' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'STRING' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 92 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'STRING', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 92 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => 92 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'date', + 'vars' => '', + 'line' => 92 + }, 'Parse::RecDescent::Rule' ), + 'bodysubtype' => bless( { + 'impcount' => 0, + 'calls' => [ + 'PLAIN', + 'HTML', + 'NIL', + 'STRING' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'PLAIN', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 53 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'HTML', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 53 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => 53 + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '2', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 53 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => 53 + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '3', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'STRING', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 53 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => 53 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'bodysubtype', + 'vars' => '', + 'line' => 53 + }, 'Parse::RecDescent::Rule' ), + 'hostname' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'STRING' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 79 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'STRING', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 79 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => 79 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'hostname', + 'vars' => '', + 'line' => 79 + }, 'Parse::RecDescent::Rule' ), + 'basicfields' => bless( { + 'impcount' => 0, + 'calls' => [ + 'bodysubtype', + 'bodyparms', + 'bodyid', + 'bodydesc', + 'bodyenc', + 'bodysize' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'subrule' => 'bodysubtype', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 113 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'bodyparms', + 'expected' => undef, + 'min' => 0, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '?', + 'lookahead' => 0, + 'line' => 113 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'subrule' => 'bodyid', + 'expected' => undef, + 'min' => 0, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '?', + 'lookahead' => 0, + 'line' => 113 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'subrule' => 'bodydesc', + 'expected' => undef, + 'min' => 0, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '?', + 'lookahead' => 0, + 'line' => 114 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'subrule' => 'bodyenc', + 'expected' => undef, + 'min' => 0, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '?', + 'lookahead' => 0, + 'line' => 114 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'subrule' => 'bodysize', + 'expected' => undef, + 'min' => 0, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '?', + 'lookahead' => 0, + 'line' => 114 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 115, + 'code' => '{ $return = { bodysubtype => $item{bodysubtype} }; + take_optional_items($return, \\%item, + qw/bodyparms bodyid bodydesc bodyenc bodysize/); + 1; + }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'basicfields', + 'vars' => '', + 'line' => 113 + }, 'Parse::RecDescent::Rule' ), + 'personalname' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'STRING' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 76 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'STRING', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 76 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => 76 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'personalname', + 'vars' => '', + 'line' => 76 + }, 'Parse::RecDescent::Rule' ), + 'key' => bless( { + 'impcount' => 0, + 'calls' => [ + 'STRING' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'STRING', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 55 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'key', + 'vars' => '', + 'line' => 55 + }, 'Parse::RecDescent::Rule' ), + 'cc' => bless( { + 'impcount' => 0, + 'calls' => [ + 'ADDRESSES' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'ADDRESSES', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 97 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'cc', + 'vars' => '', + 'line' => 97 + }, 'Parse::RecDescent::Rule' ), + 'bodyMD5' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'STRING' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 71 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'STRING', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 71 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => 71 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'bodyMD5', + 'vars' => '', + 'line' => 71 + }, 'Parse::RecDescent::Rule' ), + 'envelope' => bless( { + 'impcount' => 0, + 'calls' => [ + 'envelopestruct' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 2, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => '.*?\\(.*?ENVELOPE', + 'hashname' => '__PATTERN1__', + 'description' => '/.*?\\\\(.*?ENVELOPE/', + 'lookahead' => 0, + 'rdelim' => '/', + 'line' => 187, + 'mod' => '', + 'ldelim' => '/' + }, 'Parse::RecDescent::Token' ), + bless( { + 'subrule' => 'envelopestruct', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 187 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'pattern' => '.*\\)', + 'hashname' => '__PATTERN2__', + 'description' => '/.*\\\\)/', + 'lookahead' => 0, + 'rdelim' => '/', + 'line' => 187, + 'mod' => '', + 'ldelim' => '/' + }, 'Parse::RecDescent::Token' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 188, + 'code' => '{ $return = $item{envelopestruct} }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'envelope', + 'vars' => '', + 'line' => 187 + }, 'Parse::RecDescent::Rule' ), + 'MESSAGE' => bless( { + 'impcount' => 0, + 'calls' => [], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 1, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => '^"MESSAGE"|^MESSAGE', + 'hashname' => '__PATTERN1__', + 'description' => '/^"MESSAGE"|^MESSAGE/i', + 'lookahead' => 0, + 'rdelim' => '/', + 'line' => 32, + 'mod' => 'i', + 'ldelim' => '/' + }, 'Parse::RecDescent::Token' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 32, + 'code' => '{ $return = "MESSAGE"}' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'MESSAGE', + 'vars' => '', + 'line' => 32 + }, 'Parse::RecDescent::Rule' ), + 'DOUBLE_QUOTED_STRING' => bless( { + 'impcount' => 0, + 'calls' => [], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 2, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 1, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => '"', + 'hashname' => '__STRING1__', + 'description' => '\'"\'', + 'lookahead' => 0, + 'line' => 40 + }, 'Parse::RecDescent::Literal' ), + bless( { + 'pattern' => '(?:\\\\"|[^"])*', + 'hashname' => '__PATTERN1__', + 'description' => '/(?:\\\\\\\\"|[^"])*/', + 'lookahead' => 0, + 'rdelim' => '/', + 'line' => 40, + 'mod' => '', + 'ldelim' => '/' + }, 'Parse::RecDescent::Token' ), + bless( { + 'pattern' => '"', + 'hashname' => '__STRING2__', + 'description' => '\'"\'', + 'lookahead' => 0, + 'line' => 40 + }, 'Parse::RecDescent::Literal' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 40, + 'code' => '{ $return = $item{__PATTERN1__} }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'DOUBLE_QUOTED_STRING', + 'vars' => '', + 'line' => 40 + }, 'Parse::RecDescent::Rule' ), + 'subject' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'STRING' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 89 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'STRING', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 89 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => 89 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'subject', + 'vars' => '', + 'line' => 89 + }, 'Parse::RecDescent::Rule' ), + 'value' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'NUMBER', + 'STRING', + 'KVPAIRS' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 56 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NUMBER', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 56 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => 56 + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '2', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'STRING', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 56 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => 56 + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '3', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'KVPAIRS', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 56 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => 56 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'value', + 'vars' => '', + 'line' => 56 + }, 'Parse::RecDescent::Rule' ), + 'inreplyto' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'STRING' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 90 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'STRING', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 90 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => 90 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'inreplyto', + 'vars' => '', + 'line' => 90 + }, 'Parse::RecDescent::Rule' ), + 'messageid' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'STRING' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 91 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'STRING', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 91 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => 91 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'messageid', + 'vars' => '', + 'line' => 91 + }, 'Parse::RecDescent::Rule' ), + 'sender' => bless( { + 'impcount' => 0, + 'calls' => [ + 'ADDRESSES' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'ADDRESSES', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 101 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'sender', + 'vars' => '', + 'line' => 101 + }, 'Parse::RecDescent::Rule' ), + 'multipart' => bless( { + 'impcount' => 0, + 'calls' => [ + 'subpart', + 'bodysubtype', + 'bodyparms', + 'bodydisp', + 'bodylang', + 'bodyloc', + 'bodyextra' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 2, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'subrule' => 'subpart', + 'expected' => undef, + 'min' => 1, + 'argcode' => undef, + 'max' => 100000000, + 'matchrule' => 0, + 'repspec' => 's', + 'lookahead' => 0, + 'line' => 161 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'hashname' => '__DIRECTIVE1__', + 'name' => '', + 'lookahead' => 0, + 'line' => 161, + 'code' => '$commit = 1' + }, 'Parse::RecDescent::Directive' ), + bless( { + 'subrule' => 'bodysubtype', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 161 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'bodyparms', + 'expected' => undef, + 'min' => 0, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '?', + 'lookahead' => 0, + 'line' => 162 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'subrule' => 'bodydisp', + 'expected' => undef, + 'min' => 0, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '?', + 'lookahead' => 0, + 'line' => 162 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'subrule' => 'bodylang', + 'expected' => undef, + 'min' => 0, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '?', + 'lookahead' => 0, + 'line' => 162 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'subrule' => 'bodyloc', + 'expected' => undef, + 'min' => 0, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '?', + 'lookahead' => 0, + 'line' => 162 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'subrule' => 'bodyextra', + 'expected' => undef, + 'min' => 0, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '?', + 'lookahead' => 0, + 'line' => 162 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'hashname' => '__DIRECTIVE2__', + 'name' => '', + 'lookahead' => 0, + 'line' => 163, + 'code' => 'push @{$thisparser->{deferred}}, sub { $subpartCount = 0 };' + }, 'Parse::RecDescent::Directive' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 164, + 'code' => '{ $return = + { bodysubtype => $item{bodysubtype} + , bodytype => \'MULTIPART\' + , bodystructure => $item{\'subpart(s)\'} + }; + take_optional_items($return, \\%item + , qw/bodyparms bodydisp bodylang bodyloc bodyextra/); + 1; + }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'multipart', + 'vars' => '', + 'line' => 161 + }, 'Parse::RecDescent::Rule' ), + 'bodyenc' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'STRING', + 'KVPAIRS' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 70 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'STRING', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 70 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => 70 + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '2', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'KVPAIRS', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 70 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => 70 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'bodyenc', + 'vars' => '', + 'line' => 70 + }, 'Parse::RecDescent::Rule' ), + 'bodydesc' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'STRING' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 1, + 'actcount' => 0, + 'items' => [ + bless( { + 'pattern' => '[()]', + 'hashname' => '__PATTERN1__', + 'description' => '/[()]/', + 'lookahead' => -1, + 'rdelim' => '/', + 'line' => 68, + 'mod' => '', + 'ldelim' => '/' + }, 'Parse::RecDescent::Token' ), + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 68 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'STRING', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 68 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => 68 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'bodydesc', + 'vars' => '', + 'line' => 68 + }, 'Parse::RecDescent::Rule' ), + 'start' => bless( { + 'impcount' => 0, + 'calls' => [ + 'part' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 2, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => '.*?\\(.*?BODYSTRUCTURE \\(', + 'hashname' => '__PATTERN1__', + 'description' => '/.*?\\\\(.*?BODYSTRUCTURE \\\\(/i', + 'lookahead' => 0, + 'rdelim' => '/', + 'line' => 184, + 'mod' => 'i', + 'ldelim' => '/' + }, 'Parse::RecDescent::Token' ), + bless( { + 'subrule' => 'part', + 'expected' => undef, + 'min' => 1, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '1', + 'lookahead' => 0, + 'line' => 184 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'pattern' => '\\).*\\)\\r?\\n?', + 'hashname' => '__PATTERN2__', + 'description' => '/\\\\).*\\\\)\\\\r?\\\\n?/', + 'lookahead' => 0, + 'rdelim' => '/', + 'line' => 184, + 'mod' => '', + 'ldelim' => '/' + }, 'Parse::RecDescent::Token' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 185, + 'code' => '{ $return = $item{\'part(1)\'}[0] }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'start', + 'vars' => '', + 'line' => 184 + }, 'Parse::RecDescent::Rule' ), + 'RFC822' => bless( { + 'impcount' => 0, + 'calls' => [], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 1, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => '^"RFC822"|^RFC822', + 'hashname' => '__PATTERN1__', + 'description' => '/^"RFC822"|^RFC822/i', + 'lookahead' => 0, + 'rdelim' => '/', + 'line' => 33, + 'mod' => 'i', + 'ldelim' => '/' + }, 'Parse::RecDescent::Token' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 33, + 'code' => '{ $return = "RFC822" }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'RFC822', + 'vars' => '', + 'line' => 33 + }, 'Parse::RecDescent::Rule' ), + 'textmessage' => bless( { + 'impcount' => 0, + 'calls' => [ + 'TEXT', + 'basicfields', + 'textlines', + 'bodyMD5', + 'bodydisp', + 'bodylang', + 'bodyextra' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 1, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'subrule' => 'TEXT', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 121 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'hashname' => '__DIRECTIVE1__', + 'name' => '', + 'lookahead' => 0, + 'line' => 121, + 'code' => '$commit = 1' + }, 'Parse::RecDescent::Directive' ), + bless( { + 'subrule' => 'basicfields', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 121 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'textlines', + 'expected' => undef, + 'min' => 0, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '?', + 'lookahead' => 0, + 'line' => 121 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'subrule' => 'bodyMD5', + 'expected' => undef, + 'min' => 0, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '?', + 'lookahead' => 0, + 'line' => 121 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'subrule' => 'bodydisp', + 'expected' => undef, + 'min' => 0, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '?', + 'lookahead' => 0, + 'line' => 122 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'subrule' => 'bodylang', + 'expected' => undef, + 'min' => 0, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '?', + 'lookahead' => 0, + 'line' => 122 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'subrule' => 'bodyextra', + 'expected' => undef, + 'min' => 0, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '?', + 'lookahead' => 0, + 'line' => 122 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 123, + 'code' => '{ + $return = $item{basicfields} || {}; + $return->{bodytype} = \'TEXT\'; + take_optional_items($return, \\%item + , qw/textlines bodyMD5 bodydisp bodylang bodyextra/); + 1; + }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'textmessage', + 'vars' => '', + 'line' => 121 + }, 'Parse::RecDescent::Rule' ), + 'bodyid' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'STRING' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 1, + 'actcount' => 0, + 'items' => [ + bless( { + 'pattern' => '[()]', + 'hashname' => '__PATTERN1__', + 'description' => '/[()]/', + 'lookahead' => -1, + 'rdelim' => '/', + 'line' => 67, + 'mod' => '', + 'ldelim' => '/' + }, 'Parse::RecDescent::Token' ), + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 67 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'STRING', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 67 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => 67 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'bodyid', + 'vars' => '', + 'line' => 67 + }, 'Parse::RecDescent::Rule' ), + 'bodyextra' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'STRING', + 'STRINGS' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 73 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'STRING', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 73 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => 73 + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '2', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'STRINGS', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 73 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => 73 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'bodyextra', + 'vars' => '', + 'line' => 73 + }, 'Parse::RecDescent::Rule' ), + 'othertypemessage' => bless( { + 'impcount' => 0, + 'calls' => [ + 'bodytype', + 'basicfields', + 'bodyMD5', + 'bodydisp', + 'bodylang', + 'bodyextra' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'subrule' => 'bodytype', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 131 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'basicfields', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 131 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'bodyMD5', + 'expected' => undef, + 'min' => 0, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '?', + 'lookahead' => 0, + 'line' => 131 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'subrule' => 'bodydisp', + 'expected' => undef, + 'min' => 0, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '?', + 'lookahead' => 0, + 'line' => 131 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'subrule' => 'bodylang', + 'expected' => undef, + 'min' => 0, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '?', + 'lookahead' => 0, + 'line' => 132 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'subrule' => 'bodyextra', + 'expected' => undef, + 'min' => 0, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '?', + 'lookahead' => 0, + 'line' => 132 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 133, + 'code' => '{ $return = { bodytype => $item{bodytype} }; + take_optional_items($return, \\%item + , qw/bodyMD5 bodydisp bodylang bodyextra/ ); + merge_hash($return, $item{basicfields}); + 1; + }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'othertypemessage', + 'vars' => '', + 'line' => 131 + }, 'Parse::RecDescent::Rule' ), + 'kvpair' => bless( { + 'impcount' => 0, + 'calls' => [ + 'key', + 'value' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 1, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => ')', + 'hashname' => '__STRING1__', + 'description' => '\')\'', + 'lookahead' => -1, + 'line' => 58 + }, 'Parse::RecDescent::InterpLit' ), + bless( { + 'subrule' => 'key', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 58 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'value', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 58 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 59, + 'code' => '{ $return = { $item{key} => $item{value} } }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'kvpair', + 'vars' => '', + 'line' => 58 + }, 'Parse::RecDescent::Rule' ), + 'bodysize' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'NUMBER' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 1, + 'actcount' => 0, + 'items' => [ + bless( { + 'pattern' => '[()]', + 'hashname' => '__PATTERN1__', + 'description' => '/[()]/', + 'lookahead' => -1, + 'rdelim' => '/', + 'line' => 69, + 'mod' => '', + 'ldelim' => '/' + }, 'Parse::RecDescent::Token' ), + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 69 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NUMBER', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 69 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => 69 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'bodysize', + 'vars' => '', + 'line' => 69 + }, 'Parse::RecDescent::Rule' ), + 'STRING' => bless( { + 'impcount' => 0, + 'calls' => [ + 'DOUBLE_QUOTED_STRING', + 'SINGLE_QUOTED_STRING', + 'BARESTRING' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'DOUBLE_QUOTED_STRING', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 45 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'SINGLE_QUOTED_STRING', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 45 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => 45 + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '2', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'BARESTRING', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 45 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => 45 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'STRING', + 'vars' => '', + 'line' => 45 + }, 'Parse::RecDescent::Rule' ), + 'bodytype' => bless( { + 'impcount' => 0, + 'calls' => [ + 'STRING' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'STRING', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 64 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'bodytype', + 'vars' => '', + 'line' => 64 + }, 'Parse::RecDescent::Rule' ), + 'TEXT' => bless( { + 'impcount' => 0, + 'calls' => [], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 1, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => '^"TEXT"|^TEXT', + 'hashname' => '__PATTERN1__', + 'description' => '/^"TEXT"|^TEXT/i', + 'lookahead' => 0, + 'rdelim' => '/', + 'line' => 29, + 'mod' => 'i', + 'ldelim' => '/' + }, 'Parse::RecDescent::Token' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 29, + 'code' => '{ $return = "TEXT" }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'TEXT', + 'vars' => '', + 'line' => 27 + }, 'Parse::RecDescent::Rule' ), + 'to' => bless( { + 'impcount' => 0, + 'calls' => [ + 'ADDRESSES' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'ADDRESSES', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 102 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'to', + 'vars' => '', + 'line' => 102 + }, 'Parse::RecDescent::Rule' ), + 'NIL' => bless( { + 'impcount' => 0, + 'calls' => [], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 1, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => '^NIL', + 'hashname' => '__PATTERN1__', + 'description' => '/^NIL/i', + 'lookahead' => 0, + 'rdelim' => '/', + 'line' => 34, + 'mod' => 'i', + 'ldelim' => '/' + }, 'Parse::RecDescent::Token' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 34, + 'code' => '{ $return = "NIL" }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'NIL', + 'vars' => '', + 'line' => 34 + }, 'Parse::RecDescent::Rule' ), + 'KVPAIRS' => bless( { + 'impcount' => 0, + 'calls' => [ + 'kvpair' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 2, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => '(', + 'hashname' => '__STRING1__', + 'description' => '\'(\'', + 'lookahead' => 0, + 'line' => 61 + }, 'Parse::RecDescent::InterpLit' ), + bless( { + 'subrule' => 'kvpair', + 'expected' => undef, + 'min' => 1, + 'argcode' => undef, + 'max' => 100000000, + 'matchrule' => 0, + 'repspec' => 's', + 'lookahead' => 0, + 'line' => 61 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'pattern' => ')', + 'hashname' => '__STRING2__', + 'description' => '\')\'', + 'lookahead' => 0, + 'line' => 61 + }, 'Parse::RecDescent::InterpLit' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 62, + 'code' => '{ $return = { map { (%$_) } @{$item{\'kvpair(s)\'}} } }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'KVPAIRS', + 'vars' => '', + 'line' => 61 + }, 'Parse::RecDescent::Rule' ), + 'from' => bless( { + 'impcount' => 0, + 'calls' => [ + 'ADDRESSES' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'ADDRESSES', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 99 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'from', + 'vars' => '', + 'line' => 99 + }, 'Parse::RecDescent::Rule' ), + 'bodystructure' => bless( { + 'impcount' => 0, + 'calls' => [ + 'part' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 2, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => '(', + 'hashname' => '__STRING1__', + 'description' => '\'(\'', + 'lookahead' => 0, + 'line' => 181 + }, 'Parse::RecDescent::InterpLit' ), + bless( { + 'subrule' => 'part', + 'expected' => undef, + 'min' => 1, + 'argcode' => undef, + 'max' => 100000000, + 'matchrule' => 0, + 'repspec' => 's', + 'lookahead' => 0, + 'line' => 181 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'pattern' => ')', + 'hashname' => '__STRING2__', + 'description' => '\')\'', + 'lookahead' => 0, + 'line' => 181 + }, 'Parse::RecDescent::InterpLit' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 182, + 'code' => '{ $return = $item{\'part(s)\'} }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'bodystructure', + 'vars' => '', + 'line' => 181 + }, 'Parse::RecDescent::Rule' ), + 'PLAIN' => bless( { + 'impcount' => 0, + 'calls' => [], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 1, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => '^"PLAIN"|^PLAIN', + 'hashname' => '__PATTERN1__', + 'description' => '/^"PLAIN"|^PLAIN/i', + 'lookahead' => 0, + 'rdelim' => '/', + 'line' => 30, + 'mod' => 'i', + 'ldelim' => '/' + }, 'Parse::RecDescent::Token' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 30, + 'code' => '{ $return = "PLAIN" }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'PLAIN', + 'vars' => '', + 'line' => 30 + }, 'Parse::RecDescent::Rule' ), + 'NUMBER' => bless( { + 'impcount' => 0, + 'calls' => [], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 1, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => '^(\\d+)', + 'hashname' => '__PATTERN1__', + 'description' => '/^(\\\\d+)/', + 'lookahead' => 0, + 'rdelim' => '/', + 'line' => 35, + 'mod' => '', + 'ldelim' => '/' + }, 'Parse::RecDescent::Token' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 35, + 'code' => '{ $return = $item[1] }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'NUMBER', + 'vars' => '', + 'line' => 35 + }, 'Parse::RecDescent::Rule' ), + 'STRINGS' => bless( { + 'impcount' => 0, + 'calls' => [ + 'STRING' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 2, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => '(', + 'hashname' => '__STRING1__', + 'description' => '\'(\'', + 'lookahead' => 0, + 'line' => 47 + }, 'Parse::RecDescent::InterpLit' ), + bless( { + 'subrule' => 'STRING', + 'expected' => undef, + 'min' => 1, + 'argcode' => undef, + 'max' => 100000000, + 'matchrule' => 0, + 'repspec' => 's', + 'lookahead' => 0, + 'line' => 47 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'pattern' => ')', + 'hashname' => '__STRING2__', + 'description' => '\')\'', + 'lookahead' => 0, + 'line' => 47 + }, 'Parse::RecDescent::InterpLit' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 47, + 'code' => '{ $return = $item{\'STRING(s)\'} }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'STRINGS', + 'vars' => '', + 'line' => 47 + }, 'Parse::RecDescent::Rule' ), + 'HTML' => bless( { + 'impcount' => 0, + 'calls' => [], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 1, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => '"HTML"|HTML', + 'hashname' => '__PATTERN1__', + 'description' => '/"HTML"|HTML/i', + 'lookahead' => 0, + 'rdelim' => '/', + 'line' => 31, + 'mod' => 'i', + 'ldelim' => '/' + }, 'Parse::RecDescent::Token' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 31, + 'code' => '{ $return = "HTML" }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'HTML', + 'vars' => '', + 'line' => 31 + }, 'Parse::RecDescent::Rule' ), + 'bodydisp' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'KVPAIRS' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 66 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'KVPAIRS', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 66 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => 66 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'bodydisp', + 'vars' => '', + 'line' => 66 + }, 'Parse::RecDescent::Rule' ), + 'part' => bless( { + 'impcount' => 0, + 'calls' => [ + 'multipart', + 'textmessage', + 'nestedmessage', + 'othertypemessage' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'subrule' => 'multipart', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 176 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 176, + 'code' => '{ $return = bless $item{multipart}, $mibs }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'subrule' => 'textmessage', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 177 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 177, + 'code' => '{ $return = bless $item{textmessage}, $mibs }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => 177 + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '2', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'subrule' => 'nestedmessage', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 178 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 178, + 'code' => '{ $return = bless $item{nestedmessage}, $mibs }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => 178 + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '3', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'subrule' => 'othertypemessage', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 179 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 179, + 'code' => '{ $return = bless $item{othertypemessage}, $mibs }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => 179 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'part', + 'vars' => '', + 'line' => 176 + }, 'Parse::RecDescent::Rule' ), + 'nestedmessage' => bless( { + 'impcount' => 0, + 'calls' => [ + 'rfc822message', + 'bodyparms', + 'bodyid', + 'bodydesc', + 'bodyenc', + 'bodysize', + 'envelopestruct', + 'bodystructure', + 'textlines', + 'bodyMD5', + 'bodydisp', + 'bodylang', + 'bodyextra' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 1, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'subrule' => 'rfc822message', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 140 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'hashname' => '__DIRECTIVE1__', + 'name' => '', + 'lookahead' => 0, + 'line' => 140, + 'code' => '$commit = 1' + }, 'Parse::RecDescent::Directive' ), + bless( { + 'subrule' => 'bodyparms', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 140 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'bodyid', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 140 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'bodydesc', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 140 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'bodyenc', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 140 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'bodysize', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 141 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'envelopestruct', + 'expected' => undef, + 'min' => 0, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '?', + 'lookahead' => 0, + 'line' => 142 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'subrule' => 'bodystructure', + 'expected' => undef, + 'min' => 0, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '?', + 'lookahead' => 0, + 'line' => 142 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'subrule' => 'textlines', + 'expected' => undef, + 'min' => 0, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '?', + 'lookahead' => 0, + 'line' => 142 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'subrule' => 'bodyMD5', + 'expected' => undef, + 'min' => 0, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '?', + 'lookahead' => 0, + 'line' => 143 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'subrule' => 'bodydisp', + 'expected' => undef, + 'min' => 0, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '?', + 'lookahead' => 0, + 'line' => 143 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'subrule' => 'bodylang', + 'expected' => undef, + 'min' => 0, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '?', + 'lookahead' => 0, + 'line' => 143 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'subrule' => 'bodyextra', + 'expected' => undef, + 'min' => 0, + 'argcode' => undef, + 'max' => 1, + 'matchrule' => 0, + 'repspec' => '?', + 'lookahead' => 0, + 'line' => 143 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 144, + 'code' => '{ + $return = {}; + $return->{$_} = $item{$_} + for qw/bodyparms bodyid bodydesc bodyenc bodysize/; +# envelopestruct bodystructure textlines/; + + take_optional_items($return, \\%item + , qw/envelopestruct bodystructure textlines/ + , qw/bodyMD5 bodydisp bodylang bodyextra/); + + merge_hash($return, $item{bodystructure}[0]); + merge_hash($return, $item{basicfields}); + $return->{bodytype} = "MESSAGE" ; + $return->{bodysubtype} = "RFC822" ; + 1; + }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'nestedmessage', + 'vars' => '', + 'line' => 140 + }, 'Parse::RecDescent::Rule' ), + 'SINGLE_QUOTED_STRING' => bless( { + 'impcount' => 0, + 'calls' => [], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 2, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 1, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => '\'', + 'hashname' => '__STRING1__', + 'description' => '\'\'\'', + 'lookahead' => 0, + 'line' => 39 + }, 'Parse::RecDescent::InterpLit' ), + bless( { + 'pattern' => '(?:\\\\\'|[^\'])*', + 'hashname' => '__PATTERN1__', + 'description' => '/(?:\\\\\\\\\'|[^\'])*/', + 'lookahead' => 0, + 'rdelim' => '/', + 'line' => 39, + 'mod' => '', + 'ldelim' => '/' + }, 'Parse::RecDescent::Token' ), + bless( { + 'pattern' => '\'', + 'hashname' => '__STRING2__', + 'description' => '\'\'\'', + 'lookahead' => 0, + 'line' => 39 + }, 'Parse::RecDescent::InterpLit' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 39, + 'code' => '{ $return = $item{__PATTERN1__} }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'SINGLE_QUOTED_STRING', + 'vars' => '', + 'line' => 37 + }, 'Parse::RecDescent::Rule' ), + 'ADDRESSES' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'addressstruct' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 94 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 2, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => '(', + 'hashname' => '__STRING1__', + 'description' => '\'(\'', + 'lookahead' => 0, + 'line' => 95 + }, 'Parse::RecDescent::InterpLit' ), + bless( { + 'subrule' => 'addressstruct', + 'expected' => undef, + 'min' => 1, + 'argcode' => undef, + 'max' => 100000000, + 'matchrule' => 0, + 'repspec' => 's', + 'lookahead' => 0, + 'line' => 95 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'pattern' => ')', + 'hashname' => '__STRING2__', + 'description' => '\')\'', + 'lookahead' => 0, + 'line' => 95 + }, 'Parse::RecDescent::InterpLit' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 95, + 'code' => '{ $return = $item{\'addressstruct(s)\'} }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => 95 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'ADDRESSES', + 'vars' => '', + 'line' => 94 + }, 'Parse::RecDescent::Rule' ), + 'bcc' => bless( { + 'impcount' => 0, + 'calls' => [ + 'ADDRESSES' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'ADDRESSES', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 98 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'bcc', + 'vars' => '', + 'line' => 98 + }, 'Parse::RecDescent::Rule' ), + 'rfc822message' => bless( { + 'impcount' => 0, + 'calls' => [ + 'MESSAGE', + 'RFC822' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'subrule' => 'MESSAGE', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 51 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'RFC822', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 51 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 51, + 'code' => '{ $return = "MESSAGE RFC822" }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'rfc822message', + 'vars' => '', + 'line' => 51 + }, 'Parse::RecDescent::Rule' ), + 'addressstruct' => bless( { + 'impcount' => 0, + 'calls' => [ + 'personalname', + 'sourceroute', + 'mailboxname', + 'hostname' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 2, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => '(', + 'hashname' => '__STRING1__', + 'description' => '\'(\'', + 'lookahead' => 0, + 'line' => 81 + }, 'Parse::RecDescent::InterpLit' ), + bless( { + 'subrule' => 'personalname', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 81 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'sourceroute', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 81 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'mailboxname', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 81 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'hostname', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 81 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'pattern' => ')', + 'hashname' => '__STRING2__', + 'description' => '\')\'', + 'lookahead' => 0, + 'line' => 81 + }, 'Parse::RecDescent::InterpLit' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 82, + 'code' => '{ bless { personalname => $item{personalname} + , sourceroute => $item{sourceroute} + , mailboxname => $item{mailboxname} + , hostname => $item{hostname} + }, \'Mail::IMAPClient::BodyStructure::Address\'; + }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'addressstruct', + 'vars' => '', + 'line' => 81 + }, 'Parse::RecDescent::Rule' ), + 'sourceroute' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'STRING' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 77 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'STRING', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 77 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => 77 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'sourceroute', + 'vars' => '', + 'line' => 77 + }, 'Parse::RecDescent::Rule' ), + 'subpart' => bless( { + 'impcount' => 0, + 'calls' => [ + 'part' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 2, + 'dircount' => 1, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => '(', + 'hashname' => '__STRING1__', + 'description' => '\'(\'', + 'lookahead' => 0, + 'line' => 174 + }, 'Parse::RecDescent::InterpLit' ), + bless( { + 'subrule' => 'part', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 174 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'pattern' => ')', + 'hashname' => '__STRING2__', + 'description' => '\')\'', + 'lookahead' => 0, + 'line' => 174 + }, 'Parse::RecDescent::InterpLit' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 174, + 'code' => '{$return = $item{part}}' + }, 'Parse::RecDescent::Action' ), + bless( { + 'hashname' => '__DIRECTIVE1__', + 'name' => '', + 'lookahead' => 0, + 'line' => 174, + 'code' => 'push @{$thisparser->{deferred}}, sub { ++$subpartCount; };' + }, 'Parse::RecDescent::Directive' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'subpart', + 'vars' => '', + 'line' => 174 + }, 'Parse::RecDescent::Rule' ), + 'textlines' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'NUMBER' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 49 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NUMBER', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 49 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => 49 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'textlines', + 'vars' => '', + 'line' => 49 + }, 'Parse::RecDescent::Rule' ), + 'BARESTRING' => bless( { + 'impcount' => 0, + 'calls' => [], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 2, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => '^[)(\'"]', + 'hashname' => '__PATTERN1__', + 'description' => '/^[)(\'"]/', + 'lookahead' => -1, + 'rdelim' => '/', + 'line' => 42, + 'mod' => '', + 'ldelim' => '/' + }, 'Parse::RecDescent::Token' ), + bless( { + 'pattern' => '^(?!\\(|\\))(?:\\\\ |\\S)+', + 'hashname' => '__PATTERN2__', + 'description' => '/^(?!\\\\(|\\\\))(?:\\\\\\\\ |\\\\S)+/', + 'lookahead' => 0, + 'rdelim' => '/', + 'line' => 42, + 'mod' => '', + 'ldelim' => '/' + }, 'Parse::RecDescent::Token' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 43, + 'code' => '{ $return = $item{__PATTERN1__} }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'BARESTRING', + 'vars' => '', + 'line' => 42 + }, 'Parse::RecDescent::Rule' ), + 'bodyloc' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'STRING' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 74 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'STRING', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 74 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => 74 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'bodyloc', + 'vars' => '', + 'line' => 74 + }, 'Parse::RecDescent::Rule' ), + 'bodylang' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'STRING', + 'STRINGS' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 72 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'STRING', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 72 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => 72 + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '2', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'STRINGS', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 72 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => 72 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'bodylang', + 'vars' => '', + 'line' => 72 + }, 'Parse::RecDescent::Rule' ), + 'envelopestruct' => bless( { + 'impcount' => 0, + 'calls' => [ + 'date', + 'subject', + 'from', + 'sender', + 'replyto', + 'to', + 'cc', + 'bcc', + 'inreplyto', + 'messageid' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 2, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => '(', + 'hashname' => '__STRING1__', + 'description' => '\'(\'', + 'lookahead' => 0, + 'line' => 104 + }, 'Parse::RecDescent::InterpLit' ), + bless( { + 'subrule' => 'date', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 104 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'subject', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 104 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'from', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 104 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'sender', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 104 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'replyto', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 104 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'to', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 104 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'cc', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 104 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'bcc', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 105 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'inreplyto', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 105 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'subrule' => 'messageid', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 105 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'pattern' => ')', + 'hashname' => '__STRING2__', + 'description' => '\')\'', + 'lookahead' => 0, + 'line' => 105 + }, 'Parse::RecDescent::InterpLit' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 106, + 'code' => '{ $return = bless {}, "Mail::IMAPClient::BodyStructure::Envelope"; + $return->{$_} = $item{$_} + for qw/date subject from sender replyto to cc/ + , qw/bcc inreplyto messageid/; + 1; + }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'envelopestruct', + 'vars' => '', + 'line' => 104 + }, 'Parse::RecDescent::Rule' ), + 'replyto' => bless( { + 'impcount' => 0, + 'calls' => [ + 'ADDRESSES' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'ADDRESSES', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 100 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'replyto', + 'vars' => '', + 'line' => 100 + }, 'Parse::RecDescent::Rule' ), + 'mailboxname' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NIL', + 'STRING' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'NIL', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 78 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 0, + 'items' => [ + bless( { + 'subrule' => 'STRING', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 78 + }, 'Parse::RecDescent::Subrule' ) + ], + 'line' => 78 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'mailboxname', + 'vars' => '', + 'line' => 78 + }, 'Parse::RecDescent::Rule' ) + } + }, 'Parse::RecDescent' ); +} \ No newline at end of file diff --git a/Mail-IMAPClient-3.23/lib/Mail/IMAPClient/BodyStructure/Parse.pod b/Mail-IMAPClient-3.23/lib/Mail/IMAPClient/BodyStructure/Parse.pod new file mode 100644 index 0000000..418259c --- /dev/null +++ b/Mail-IMAPClient-3.23/lib/Mail/IMAPClient/BodyStructure/Parse.pod @@ -0,0 +1,15 @@ +=head1 NAME + +Mail::IMAPClient::BodyStructure::Parse - used internally by Mail::IMAPClient::BodyStructure + +=head1 DESCRIPTION + +This module is used internally by L +and is generated using L. It is not meant to be used +directly by other scripts nor is there much point in debugging it. + +=head1 SYNOPSIS + +This module is used internally by L +and is not meant to be used or called directly from applications. So +don't do that. diff --git a/Mail-IMAPClient-3.23/lib/Mail/IMAPClient/MessageSet.pm b/Mail-IMAPClient-3.23/lib/Mail/IMAPClient/MessageSet.pm new file mode 100644 index 0000000..28405ad --- /dev/null +++ b/Mail-IMAPClient-3.23/lib/Mail/IMAPClient/MessageSet.pm @@ -0,0 +1,280 @@ +use warnings; +use strict; + +package Mail::IMAPClient::MessageSet; + +=head1 NAME + +Mail::IMAPClient::MessageSet - ranges of message sequence nummers + +=cut + +use overload + '""' => "str" + , '.=' => sub {$_[0]->cat($_[1])} + , '+=' => sub {$_[0]->cat($_[1])} + , '-=' => sub {$_[0]->rem($_[1])} + , '@{}' => "unfold" + , fallback => 1; + +sub new +{ my $class = shift; + my $range = $class->range(@_); + bless \$range, $class; +} + +sub str { overload::StrVal( ${$_[0]} ) } + +sub _unfold_range($) +# { my $x = shift; return if $x =~ m/[^0-9,:]$/; $x =~ s/\:/../g; eval $x; } +{ map { /(\d+)\s*\:\s*(\d+)/ ? ($1..$2) : $_ } + split /\,/, shift; +} + +sub rem +{ my $self = shift; + my %delete = map { ($_ => 1) } map { _unfold_range $_ } @_; + $$self = $self->range(grep {not $delete{$_}} $self->unfold); + $self; +} + +sub cat +{ my $self = shift; + $$self = $self->range($$self, @_); + $self; +} + +sub range +{ my $self = shift; + + my @msgs; + foreach my $m (@_) + { defined $m && length $m + or next; + + foreach my $mm (ref $m eq 'ARRAY' ? @$m : $m) + { push @msgs, _unfold_range $mm; + } + } + + @msgs + or return undef; + + @msgs = sort {$a <=> $b} @msgs; + my $low = my $high = shift @msgs; + + my @ranges; + foreach my $m (@msgs) + { next if $m == $high; # double + + if($m == $high + 1) { $high = $m } + else + { push @ranges, $low == $high ? $low : "$low:$high"; + $low = $high = $m; + } + } + + push @ranges, $low == $high ? $low : "$low:$high" ; + join ",", @ranges; +} + +sub unfold +{ my $self = shift; + wantarray ? ( _unfold_range $$self ) : [ _unfold_range $$self ]; +} + +=head1 SYNOPSIS + + my @msgs = $imap->search("SUBJECT","Virus"); # returns 1,3,4,5,6,9,10 + my $msgset = Mail::IMAPClient::MessageSet->new(@msgs); + print $msgset; # prints "1,3:6,9:10" + + # add message 14 to the set: + $msgset += 14; + print $msgset; # prints "1,3:6,9:10,14" + + # add messages 16,17,18,19, and 20 to the set: + $msgset .= "16,17,18:20"; + print $msgset; # prints "1,3:6,9:10,14,16:20" + + # Hey, I didn't really want message 17 in there; let's take it out: + $msgset -= 17; + print $msgset; # prints "1,3:6,9:10,14,16,18:20" + + # Now let's iterate over each message: + for my $msg (@$msgset) + { print "$msg\n"; # Prints: "1\n3\n4\n5\n6..16\n18\n19\n20\n" + } + print join("\n", @$msgset)."\n"; # same simpler + local $" = "\n"; print "@$msgset\n"; # even more simple + +=head1 DESCRIPTION + +The B module is designed to make life easier +for programmers who need to manipulate potentially large sets of IMAP +message UID's or sequence numbers. + +This module presents an object-oriented interface into handling your +message sets. The object reference returned by the L method is an +overloaded reference to a scalar variable that contains the message set's +compact RFC2060 representation. The object is overloaded so that using +it like a string returns this compact message set representation. You +can also add messages to the set (using either a '.=' operator or a '+=' +operator) or remove messages (with the '-=' operator). And if you use +it as an array reference, it will humor you and act like one by calling +L for you. + +RFC2060 specifies that multiple messages can be provided to certain IMAP +commands by separating them with commas. For example, "1,2,3,4,5" would +specify messages 1, 2, 3, 4, and (you guessed it!) 5. However, if you are +performing an operation on lots of messages, this string can get quite long. +So long that it may slow down your transaction, and perhaps even cause the +server to reject it. So RFC2060 also permits you to specifiy a range of +messages, so that messages 1, 2, 3, 4 and 5 can also be specified as +"1:5". + +This is where B comes in. It will convert +your message set into the shortest correct syntax. This could potentially +save you tons of network I/O, as in the case where you want to fetch the +flags for all messages in a 10000 message folder, where the messages +are all numbered sequentially. Delimited as commas, and making the +best-case assumption that the first message is message "1", it would take +48893 bytes to specify the whole message set using the comma-delimited +method. To specify it as a range, it takes just seven bytes (1:10000). + +Note that the L B method can be used as +a short-cut to specifying Cnew(@etc)>.) + +=head1 CLASS METHODS + +The only class method you need to worry about is B. And if you create +your B objects via L's +B method then you don't even need to worry about B. + +=head2 new + +Example: + + my $msgset = Mail::IMAPClient::MessageSet->new(@msgs); + +The B method requires at least one argument. That argument can be +either a message, a comma-separated list of messages, a colon-separated +range of messages, or a combination of comma-separated messages and +colon-separated ranges. It can also be a reference to an array of messages, +comma-separated message lists, and colon separated ranges. + +If more then one argument is supplied to B, then those arguments should +be more message numbers, lists, and ranges (or references to arrays of them) +just as in the first argument. + +The message numbers passed to B can really be any kind of number at +all but to be useful in a L session they should be either +message UID's (if your I parameter is true) or message sequence numbers. + +The B method will return a reference to a B +object. That object, when double quoted, will act just like a string whose +value is the message set expressed in the shortest possible way, with the +message numbers sorted in ascending order and with duplicates removed. + +=head1 OBJECT METHODS + +The only object method currently available to a B +object is the L method. + +=head2 unfold + +Example: + + my $msgset = $imap->Range( $imap->messages ) ; + my @all_messages = $msgset->unfold; + +The B method returns an array of messages that belong to the +message set. If called in a scalar context it returns a reference to the +array instead. + +=head1 OVERRIDDEN OPERATIONS + +B overrides a number of operators in order +to make manipulating your message sets easier. The overridden operations are: + +=head2 stringify + +Attempts to stringify a B object will result in +the compact message specification being returned, which is almost certainly +what you will want. + +=head2 Auto-increment + +Attempts to autoincrement a B object will +result in a message (or messages) being added to the object's message set. + +Example: + + $msgset += 34; + # Message #34 is now in the message set + +=head2 Concatenate + +Attempts to concatenate to a B object will +result in a message (or messages) being added to the object's message set. + +Example: + + $msgset .= "34,35,36,40:45"; + # Messages 34,35,36,40,41,42,43,44,and 45 are now in the message set + +The C<.=> operator and the C<+=> operator can be used interchangeably, but +as you can see by looking at the examples there are times when use of one +has an aesthetic advantage over use of the other. + +=head2 Autodecrement + +Attempts to autodecrement a B object will +result in a message being removed from the object's message set. + +Examples: + + $msgset -= 34; + # Message #34 is no longer in the message set + $msgset -= "1:10"; + # Messages 1 through 10 are no longer in the message set + +If you attempt to remove a message that was not in the original message set +then your resulting message set will be the same as the original, only more +expensive. However, if you attempt to remove several messages from the message +set and some of those messages were in the message set and some were not, +the additional overhead of checking for the messages that were not there +is negligable. In either case you get back the message set you want regardless +of whether it was already like that or not. + +=head1 AUTHOR + + David J. Kernen + The Kernen Consulting Group, Inc + +=head1 COPYRIGHT + + Copyright 1999, 2000, 2001, 2002 The Kernen Group, Inc. + All rights reserved. + +This program is free software; you can redistribute it and/or modify it +under the terms of either: + +=over 4 + +=item a) the "Artistic License" which comes with this Kit, or + +=item b) the GNU General Public License as published by the Free Software +Foundation; either version 1, or (at your option) any later version. + +=back + +This program is distributed in the hope that it will be useful, but +WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either the GNU +General Public License or the Artistic License for more details. All your +base are belong to us. + +=cut + +1; diff --git a/Mail-IMAPClient-3.23/lib/Mail/IMAPClient/Thread.grammar b/Mail-IMAPClient-3.23/lib/Mail/IMAPClient/Thread.grammar new file mode 100644 index 0000000..543c182 --- /dev/null +++ b/Mail-IMAPClient-3.23/lib/Mail/IMAPClient/Thread.grammar @@ -0,0 +1,18 @@ +# Atoms: + +NUMBER: /\d+/ + +# Rules: + +threadmember: NUMBER { $return = $item{NUMBER} ; } | + thread { $return = $item{thread} ; } + +thread: "(" threadmember(s) ")" + { + $return = $item{'threadmember(s)'}||undef; + } + +# Start: +start: /^\* THREAD /i thread(s?) { + $return=$item{'thread(s?)'}||undef; +} diff --git a/Mail-IMAPClient-3.23/lib/Mail/IMAPClient/Thread.pm b/Mail-IMAPClient-3.23/lib/Mail/IMAPClient/Thread.pm new file mode 100644 index 0000000..67fa663 --- /dev/null +++ b/Mail-IMAPClient-3.23/lib/Mail/IMAPClient/Thread.pm @@ -0,0 +1,1014 @@ +package Mail::IMAPClient::Thread; +use Parse::RecDescent; + +{ my $ERRORS; + + +package Parse::RecDescent::Mail::IMAPClient::Thread; +use strict; +use vars qw($skip $AUTOLOAD ); +$skip = '\s*'; + + +{ +local $SIG{__WARN__} = sub {0}; +# PRETEND TO BE IN Parse::RecDescent NAMESPACE +*Parse::RecDescent::Mail::IMAPClient::Thread::AUTOLOAD = sub +{ + no strict 'refs'; + $AUTOLOAD =~ s/^Parse::RecDescent::Mail::IMAPClient::Thread/Parse::RecDescent/; + goto &{$AUTOLOAD}; +} +} + +push @Parse::RecDescent::Mail::IMAPClient::Thread::ISA, 'Parse::RecDescent'; +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::Thread::thread +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"thread"}; + + Parse::RecDescent::_trace(q{Trying rule: [thread]}, + Parse::RecDescent::_tracefirst($_[1]), + q{thread}, + $tracelevel) + if defined $::RD_TRACE; + + + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: ['(' threadmember ')']}, + Parse::RecDescent::_tracefirst($_[1]), + q{thread}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{thread}); + %item = (__RULE__ => q{thread}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: ['(']}, + Parse::RecDescent::_tracefirst($text), + q{thread}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and do { $_tok = "("; 1 } and + substr($text,0,length($_tok)) eq $_tok and + do { substr($text,0,length($_tok)) = ""; 1; } + ) + { + + $expectation->failed(); + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $item{__STRING1__}=$_tok; + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [threadmember]}, + Parse::RecDescent::_tracefirst($text), + q{thread}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{threadmember})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::Thread::threadmember, 1, 100000000, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{thread}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [threadmember]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{thread}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{threadmember(s)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying terminal: [')']}, + Parse::RecDescent::_tracefirst($text), + q{thread}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{')'})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and do { $_tok = ")"; 1 } and + substr($text,0,length($_tok)) eq $_tok and + do { substr($text,0,length($_tok)) = ""; 1; } + ) + { + + $expectation->failed(); + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $item{__STRING2__}=$_tok; + + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{thread}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { + $return = $item{'threadmember(s)'}||undef; + }; + unless (defined $_tok) + { + Parse::RecDescent::_trace(q{<> (return value: [undef])}) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $_tok; + $item{__ACTION1__}=$_tok; + + + + Parse::RecDescent::_trace(q{>>Matched production: ['(' threadmember ')']<<}, + Parse::RecDescent::_tracefirst($text), + q{thread}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + + unless ( $_matched || defined($return) || defined($score) ) + { + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{thread}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{thread}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{thread}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{thread}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::Thread::NUMBER +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"NUMBER"}; + + Parse::RecDescent::_trace(q{Trying rule: [NUMBER]}, + Parse::RecDescent::_tracefirst($_[1]), + q{NUMBER}, + $tracelevel) + if defined $::RD_TRACE; + + + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [/\\d+/]}, + Parse::RecDescent::_tracefirst($_[1]), + q{NUMBER}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{NUMBER}); + %item = (__RULE__ => q{NUMBER}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: [/\\d+/]}, Parse::RecDescent::_tracefirst($text), + q{NUMBER}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:\d+)//) + { + + $expectation->failed(); + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + + last; + } + Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} + . $& . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $item{__PATTERN1__}=$&; + + + + Parse::RecDescent::_trace(q{>>Matched production: [/\\d+/]<<}, + Parse::RecDescent::_tracefirst($text), + q{NUMBER}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + + unless ( $_matched || defined($return) || defined($score) ) + { + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{NUMBER}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{NUMBER}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{NUMBER}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{NUMBER}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::Thread::start +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"start"}; + + Parse::RecDescent::_trace(q{Trying rule: [start]}, + Parse::RecDescent::_tracefirst($_[1]), + q{start}, + $tracelevel) + if defined $::RD_TRACE; + + + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [/^\\* THREAD /i thread]}, + Parse::RecDescent::_tracefirst($_[1]), + q{start}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{start}); + %item = (__RULE__ => q{start}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying terminal: [/^\\* THREAD /i]}, Parse::RecDescent::_tracefirst($text), + q{start}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{})->at($text); + + + unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:^\* THREAD )//i) + { + + $expectation->failed(); + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + + last; + } + Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} + . $& . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $item{__PATTERN1__}=$&; + + + Parse::RecDescent::_trace(q{Trying repeated subrule: [thread]}, + Parse::RecDescent::_tracefirst($text), + q{start}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(q{thread})->at($text); + + unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::Mail::IMAPClient::Thread::thread, 0, 100000000, $_noactions,$expectation,undef))) + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{start}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [thread]<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{start}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{thread(s?)}} = $_tok; + push @item, $_tok; + + + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{start}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { + $return=$item{'thread(s?)'}||undef; +}; + unless (defined $_tok) + { + Parse::RecDescent::_trace(q{<> (return value: [undef])}) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $_tok; + $item{__ACTION1__}=$_tok; + + + + Parse::RecDescent::_trace(q{>>Matched production: [/^\\* THREAD /i thread]<<}, + Parse::RecDescent::_tracefirst($text), + q{start}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + + unless ( $_matched || defined($return) || defined($score) ) + { + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{start}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{start}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{start}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{start}, + $tracelevel) + } + $_[1] = $text; + return $return; +} + +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub Parse::RecDescent::Mail::IMAPClient::Thread::threadmember +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"threadmember"}; + + Parse::RecDescent::_trace(q{Trying rule: [threadmember]}, + Parse::RecDescent::_tracefirst($_[1]), + q{threadmember}, + $tracelevel) + if defined $::RD_TRACE; + + + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [NUMBER]}, + Parse::RecDescent::_tracefirst($_[1]), + q{threadmember}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[0]; + $text = $_[1]; + my $_savetext; + @item = (q{threadmember}); + %item = (__RULE__ => q{threadmember}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [NUMBER]}, + Parse::RecDescent::_tracefirst($text), + q{threadmember}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::Thread::NUMBER($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{threadmember}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [NUMBER]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{threadmember}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{NUMBER}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{threadmember}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = $item{NUMBER} ; }; + unless (defined $_tok) + { + Parse::RecDescent::_trace(q{<> (return value: [undef])}) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $_tok; + $item{__ACTION1__}=$_tok; + + + + Parse::RecDescent::_trace(q{>>Matched production: [NUMBER]<<}, + Parse::RecDescent::_tracefirst($text), + q{threadmember}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + + while (!$_matched && !$commit) + { + + Parse::RecDescent::_trace(q{Trying production: [thread]}, + Parse::RecDescent::_tracefirst($_[1]), + q{threadmember}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[1]; + $text = $_[1]; + my $_savetext; + @item = (q{threadmember}); + %item = (__RULE__ => q{threadmember}); + my $repcount = 0; + + + Parse::RecDescent::_trace(q{Trying subrule: [thread]}, + Parse::RecDescent::_tracefirst($text), + q{threadmember}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(q{})->at($text); + unless (defined ($_tok = Parse::RecDescent::Mail::IMAPClient::Thread::thread($thisparser,$text,$repeating,$_noactions,sub { \@arg }))) + { + + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text), + q{threadmember}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [thread]<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{threadmember}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{thread}} = $_tok; + push @item, $_tok; + + } + + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{threadmember}, + $tracelevel) + if defined $::RD_TRACE; + + + $_tok = ($_noactions) ? 0 : do { $return = $item{thread} ; }; + unless (defined $_tok) + { + Parse::RecDescent::_trace(q{<> (return value: [undef])}) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $_tok; + $item{__ACTION1__}=$_tok; + + + + Parse::RecDescent::_trace(q{>>Matched production: [thread]<<}, + Parse::RecDescent::_tracefirst($text), + q{threadmember}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + + + unless ( $_matched || defined($return) || defined($score) ) + { + + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{threadmember}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{threadmember}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{threadmember}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{threadmember}, + $tracelevel) + } + $_[1] = $text; + return $return; +} +} +package Mail::IMAPClient::Thread; sub new { my $self = bless( { + '_AUTOTREE' => undef, + 'localvars' => '', + 'startcode' => '', + '_check' => { + 'thisoffset' => '', + 'itempos' => '', + 'prevoffset' => '', + 'prevline' => '', + 'prevcolumn' => '', + 'thiscolumn' => '' + }, + 'namespace' => 'Parse::RecDescent::Mail::IMAPClient::Thread', + '_AUTOACTION' => undef, + 'rules' => { + 'thread' => bless( { + 'impcount' => 0, + 'calls' => [ + 'threadmember' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 2, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => '(', + 'hashname' => '__STRING1__', + 'description' => '\'(\'', + 'lookahead' => 0, + 'line' => 180 + }, 'Parse::RecDescent::InterpLit' ), + bless( { + 'subrule' => 'threadmember', + 'expected' => undef, + 'min' => 1, + 'argcode' => undef, + 'max' => 100000000, + 'matchrule' => 0, + 'repspec' => 's', + 'lookahead' => 0, + 'line' => 180 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'pattern' => ')', + 'hashname' => '__STRING2__', + 'description' => '\')\'', + 'lookahead' => 0, + 'line' => 180 + }, 'Parse::RecDescent::InterpLit' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 181, + 'code' => '{ + $return = $item{\'threadmember(s)\'}||undef; + }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'thread', + 'vars' => '', + 'line' => 180 + }, 'Parse::RecDescent::Rule' ), + 'NUMBER' => bless( { + 'impcount' => 0, + 'calls' => [], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 1, + 'actcount' => 0, + 'items' => [ + bless( { + 'pattern' => '\\d+', + 'hashname' => '__PATTERN1__', + 'description' => '/\\\\d+/', + 'lookahead' => 0, + 'rdelim' => '/', + 'line' => 173, + 'mod' => '', + 'ldelim' => '/' + }, 'Parse::RecDescent::Token' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'NUMBER', + 'vars' => '', + 'line' => 171 + }, 'Parse::RecDescent::Rule' ), + 'start' => bless( { + 'impcount' => 0, + 'calls' => [ + 'thread' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 1, + 'actcount' => 1, + 'items' => [ + bless( { + 'pattern' => '^\\* THREAD ', + 'hashname' => '__PATTERN1__', + 'description' => '/^\\\\* THREAD /i', + 'lookahead' => 0, + 'rdelim' => '/', + 'line' => 186, + 'mod' => 'i', + 'ldelim' => '/' + }, 'Parse::RecDescent::Token' ), + bless( { + 'subrule' => 'thread', + 'expected' => undef, + 'min' => 0, + 'argcode' => undef, + 'max' => 100000000, + 'matchrule' => 0, + 'repspec' => 's?', + 'lookahead' => 0, + 'line' => 186 + }, 'Parse::RecDescent::Repetition' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 186, + 'code' => '{ + $return=$item{\'thread(s?)\'}||undef; +}' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'start', + 'vars' => '', + 'line' => 185 + }, 'Parse::RecDescent::Rule' ), + 'threadmember' => bless( { + 'impcount' => 0, + 'calls' => [ + 'NUMBER', + 'thread' + ], + 'changed' => 0, + 'opcount' => 0, + 'prods' => [ + bless( { + 'number' => '0', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'subrule' => 'NUMBER', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 177 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 177, + 'code' => '{ $return = $item{NUMBER} ; }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => undef + }, 'Parse::RecDescent::Production' ), + bless( { + 'number' => '1', + 'strcount' => 0, + 'dircount' => 0, + 'uncommit' => undef, + 'error' => undef, + 'patcount' => 0, + 'actcount' => 1, + 'items' => [ + bless( { + 'subrule' => 'thread', + 'matchrule' => 0, + 'implicit' => undef, + 'argcode' => undef, + 'lookahead' => 0, + 'line' => 178 + }, 'Parse::RecDescent::Subrule' ), + bless( { + 'hashname' => '__ACTION1__', + 'lookahead' => 0, + 'line' => 178, + 'code' => '{ $return = $item{thread} ; }' + }, 'Parse::RecDescent::Action' ) + ], + 'line' => 177 + }, 'Parse::RecDescent::Production' ) + ], + 'name' => 'threadmember', + 'vars' => '', + 'line' => 175 + }, 'Parse::RecDescent::Rule' ) + } + }, 'Parse::RecDescent' ); +} \ No newline at end of file diff --git a/Mail-IMAPClient-3.23/lib/Mail/IMAPClient/Thread.pod b/Mail-IMAPClient-3.23/lib/Mail/IMAPClient/Thread.pod new file mode 100644 index 0000000..46a5a26 --- /dev/null +++ b/Mail-IMAPClient-3.23/lib/Mail/IMAPClient/Thread.pod @@ -0,0 +1,14 @@ +=head1 NAME + +Mail::IMAPClient::Thread - used internally by Mail::IMAPClient->thread + +=head1 DESCRIPTION + +This module is used internally by L and is +generated using L. It is not meant to be used directly by +other scripts nor is there much point in debugging it. + +=head1 SYNOPSIS + +This module is used internally by L and is not meant to +be used or called directly from applications. So don't do that. diff --git a/Mail-IMAPClient-3.23/prepare_dist b/Mail-IMAPClient-3.23/prepare_dist new file mode 100644 index 0000000..fddf7da --- /dev/null +++ b/Mail-IMAPClient-3.23/prepare_dist @@ -0,0 +1,37 @@ +#!/usr/bin/perl + +use warnings; +use strict; + +use Parse::RecDescent 1.94; +use File::Slurp qw/read_file/; +use File::Copy qw/move/; + +sub build_parser($$); + +build_parser 'lib/Mail/IMAPClient/BodyStructure/Parse.grammar' + , 'Mail::IMAPClient::BodyStructure::Parse'; + +build_parser 'lib/Mail/IMAPClient/Thread.grammar' + , 'Mail::IMAPClient::Thread'; + +sub build_parser($$) +{ my ($grammarfn, $package) = @_; + + print "* building $package\n"; + + my $grammar = read_file $grammarfn + or die "cannot read grammar from $grammarfn: $!\n"; + + Parse::RecDescent->Precompile($grammar, $package); + + # clumpsy output by Parse::RecDescent + my $outfn = $package . '.pm'; + $outfn =~ s/.*\:\://; + + my $realfn = $grammarfn; + $realfn =~ s/\.\w+$/.pm/; + + move $outfn, $realfn + or die "cannot move $outfn to $realfn: $!\n"; +} diff --git a/Mail-IMAPClient-3.23/sample.perldb b/Mail-IMAPClient-3.23/sample.perldb new file mode 100644 index 0000000..0c299ec --- /dev/null +++ b/Mail-IMAPClient-3.23/sample.perldb @@ -0,0 +1 @@ +&parse_options("NonStop=1 LineInfo=mail_imapclient_db.out"); diff --git a/Mail-IMAPClient-3.23/t/basic.t b/Mail-IMAPClient-3.23/t/basic.t new file mode 100644 index 0000000..366e406 --- /dev/null +++ b/Mail-IMAPClient-3.23/t/basic.t @@ -0,0 +1,343 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use Test::More; +use File::Temp qw(tempfile); + +my $debug = $ARGV[0]; + +my %parms; +my $range = 0; +my $uidplus = 0; +my $fast = 1; + +BEGIN { + open TST, 'test.txt' + or plan skip_all => 'test parameters not provided in test.txt'; + + while ( my $l = ) { + chomp $l; + my ( $p, $v ) = split /\=/, $l, 2; + s/^\s+//, s/\s+$// for $p, $v; + $parms{$p} = $v if $v; + } + + close TST; + + my @missing; + foreach my $p (qw/server user passed/) { + push( @missing, $p ) unless defined $parms{$p}; + } + + @missing + ? plan skip_all => "missing value for: @missing" + : plan tests => 67; +} + +BEGIN { use_ok('Mail::IMAPClient') or exit; } + +my @new_args = ( + Server => $parms{server}, + Port => $parms{port}, + User => $parms{user}, + Password => $parms{passed}, + Authmechanism => $parms{authmech}, + Clear => 0, + Fast_IO => $fast, + Uid => $uidplus, + Debug => $debug, +); + +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 $parms{server} as $parms{user}.\n" + . "Are server/user/password correct?\n"; + +isa_ok( $imap, 'Mail::IMAPClient' ); + +$imap->Debug_fh->autoflush() if $imap->Debug_fh; + +my $testmsg = <<__TEST_MSG; +Date: @{[$imap->Rfc822_date(time)]} +To: <$parms{user}\@$parms{server}> +From: Perl <$parms{user}\@$parms{server}> +Subject: Testing from pid $$ + +This is a test message generated by $0 during a 'make test' as part of +the installation of the Mail::IMAPClient module from CPAN. +__TEST_MSG + +ok( $imap->noop, "noop" ); + +my $sep = $imap->separator; +ok( defined $sep, "separator is '$sep'" ); + +my $ispar = $imap->is_parent('INBOX'); +my ( $target, $target2 ) = + $ispar + ? ( "INBOX${sep}IMAPClient_$$", "INBOX${sep}IMAPClient_2_$$" ) + : ( "IMAPClient_$$", "IMAPClient_2_$$" ); + +ok( defined $ispar, "INBOX is_parent '$ispar' (note: target '$target')" ); + +ok( $imap->select('inbox'), "select inbox" ); +ok( $imap->create($target), "create target" ); + +{ + my $list = $imap->list(); + is( ref($list), "ARRAY", "list" ); + + my $lsub = $imap->lsub(); + is( ref($lsub), "ARRAY", "lsub" ); + + ok( $imap->subscribe($target), "subscribe target" ); + + my $sub1 = $imap->subscribed(); + is( ( grep( /^\Q$target\E$/, @$sub1 ) )[0], "$target", "subscribed" ); + + ok( $imap->unsubscribe($target), "unsubscribe target" ); + + my $sub2 = $imap->subscribed(); + is( ( grep( /^\Q$target\E$/, @$sub2 ) )[0], undef, "unsubscribed" ); + + ok( $imap->tag_and_run("NOOP\r\n"), "tag_and_run" ); +} + +my $fwquotes = qq($target${sep}has "quotes"); +if ( !$imap->is_parent($target) ) { + ok( 1, "not parent, skipping quote test 1/3" ); + ok( 1, "not parent, skipping quote test 2/3" ); + ok( 1, "not parent, skipping quote test 3/3" ); +} +elsif ( $imap->create($fwquotes) ) { + ok( 1, "create $fwquotes" ); + ok( $imap->select($fwquotes), 'select $fwquotes' ); + ok( $imap->close, 'close $fwquotes' ); + $imap->select('inbox'); + ok( $imap->delete($fwquotes), 'delete $fwquotes' ); +} +else { + if ( $imap->LastError =~ /NO Invalid.*name/ ) { + ok( 1, "$parms{server} doesn't support quotes in folder names" ); + } + else { ok( 0, "failed creation with quotes" ) } + ok( 1, "skipping 1/2 tests" ); + ok( 1, "skipping 2/2 tests" ); +} + +ok( $imap->exists($target), "exists $target" ); +ok( $imap->create($target2), "create $target2" ); +ok( $imap->exists($target2), "exists $target2" ); + +my $uid = $imap->append( $target, $testmsg ); +ok( defined $uid, "append test message to $target" ); + +ok( $imap->select($target), "select $target" ); + +my $msg = ( $uidplus and $uid ) ? $uid : ( $imap->messages )[0]; +my $size = $imap->size($msg); + +cmp_ok( $size, '>', 0, "has size $size" ); + +my $string = $imap->message_string($msg); +ok( defined $string, "returned string" ); + +cmp_ok( length($string), '==', $size, "string has size" ); + +{ + my ( $fh, $fn ) = tempfile UNLINK => 1; + ok( $imap->message_to_file( $fn, $msg ), "to file $fn" ); + + cmp_ok( -s $fn, '==', $size, "correct size" ); +} + +my $fields = $imap->search( "HEADER", "Message-id", "NOT_A_MESSAGE_ID" ); +is( scalar @$fields, 0, 'bogus message id does not exist' ); + +my @seen = $imap->seen; +cmp_ok( scalar @seen, '==', 1, 'have seen 1' ); + +ok( $imap->deny_seeing( \@seen ), 'deny seeing' ); +my @unseen = $imap->unseen; +cmp_ok( scalar @unseen, '==', 1, 'have unseen 1' ); + +ok( $imap->see( \@seen ), "let's see one" ); +cmp_ok( scalar @seen, '==', 1, 'have seen 1' ); + +$imap->deny_seeing(@seen); # reset + +$imap->Peek(1); +my $subject = $imap->parse_headers( $seen[0], "Subject" )->{Subject}[0]; +unlike( join( "", $imap->flags( $seen[0] ) ), qr/\\Seen/i, 'Peek==1' ); + +$imap->deny_seeing(@seen); +$imap->Peek(0); +$subject = $imap->parse_headers( $seen[0], "Subject" )->{Subject}[0]; +like( join( "", $imap->flags( $seen[0] ) ), qr/\\Seen/i, 'Peek==0' ); + +$imap->deny_seeing(@seen); +$imap->Peek(undef); +$subject = $imap->parse_headers( $seen[0], "Subject" )->{Subject}[0]; +unlike( join( "", $imap->flags( $seen[0] ) ), qr/\\Seen/i, 'Peek==undef' ); + +my $uid2 = $imap->copy( $target2, 1 ); +ok( $uid2, "copy $target2" ); + +my @res = $imap->fetch( 1, "RFC822.TEXT" ); +ok( scalar @res, "fetch rfc822" ); + +my $res1 = $imap->fetch_hash("RFC822.SIZE"); +is( ref($res1), "HASH", "fetch_hash(RFC822.SIZE)" ); + +my $res2 = $imap->fetch_hash( 1, "RFC822.SIZE" ); +is( ref($res2), "HASH", "fetch_hash(1,RFC822.SIZE)" ); + +my $h = $imap->parse_headers( 1, "Subject" ); +ok( $h, "got subject" ); +like( $h->{Subject}[0], qr/^Testing from pid/, "subject matched" ); + +ok( $imap->select($target), "select $target" ); +my @hits = $imap->search( SUBJECT => 'Testing' ); +cmp_ok( scalar @hits, '==', 1, 'hit subject Testing' ); +ok( defined $hits[0], "subject is defined" ); + +ok( $imap->delete_message(@hits), 'delete hits' ); +my $flaghash = $imap->flags( \@hits ); +my $flagflag = 0; +foreach my $v ( values %$flaghash ) { + $flagflag += grep /\\Deleted/, @$v; +} +cmp_ok( $flagflag, '==', scalar @hits, "delete verified" ); + +my @nohits = $imap->search( \qq(SUBJECT "Productioning") ); +cmp_ok( scalar @nohits, '==', 0, 'no hits expected' ); + +ok( $imap->restore_message(@hits), 'restore messages' ); + +$flaghash = $imap->flags( \@hits ); +foreach my $v ( values %$flaghash ) { + $flagflag-- unless grep /\\Deleted/, @$v; +} +cmp_ok( $flagflag, '==', 0, "restore verified" ); + +$imap->select($target2); +ok( + $imap->delete_message( scalar( $imap->search("ALL") ) ) + && $imap->close + && $imap->delete($target2), + "delete $target2" +); + +$imap->select("INBOX"); +$@ = undef; +@hits = + $imap->search( BEFORE => Mail::IMAPClient::Rfc2060_date(time), "UNDELETED" ); +ok( !$@, "search undeleted" ) or diag( '$@:' . $@ ); + +# +# Test migrate method +# + +my $im2 = Mail::IMAPClient->new( + @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( $im2->logout, "logout" ) or diag("logout error: $@"); + +# 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" ); + +# Test STARTTLS - an optional feature so tests always succeed +{ + ok( $imap->logout, "logout" ) or diag("logout error: $@"); + $imap->connect( Starttls => 1 ); + ok( 1, "OPTIONAL connect(Starttls=>1)" . ( $@ ? ": (error) $@ " : "" ) ); +} diff --git a/Mail-IMAPClient-3.23/t/bodystructure.t b/Mail-IMAPClient-3.23/t/bodystructure.t new file mode 100644 index 0000000..1f3bc08 --- /dev/null +++ b/Mail-IMAPClient-3.23/t/bodystructure.t @@ -0,0 +1,58 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use Test::More tests => 11; + +BEGIN { use_ok('Mail::IMAPClient::BodyStructure') or exit; } + +my $bs = <<'END_OF_BS'; +(BODYSTRUCTURE ("TEXT" "PLAIN" ("CHARSET" "us-ascii") NIL NIL "7BIT" 511 20 NIL NIL NIL))^M +END_OF_BS + +my $bsobj = Mail::IMAPClient::BodyStructure->new($bs); +ok( defined $bsobj, 'parsed first' ); +is( $bsobj->bodytype, 'TEXT', 'bodytype' ); +is( $bsobj->bodysubtype, 'PLAIN', 'bodysubtype' ); + +my $bs2 = <<'END_OF_BS2'; +(BODYSTRUCTURE (("TEXT" "PLAIN" ("CHARSET" 'us-ascii') NIL NIL "7BIT" 2 1 NIL NIL NIL)("MESSAGE" "RFC822" NIL NIL NIL "7BIT" 3930 ("Tue, 16 Jul 2002 15:29:17 -0400" "Re: [Fwd: Here is the the list of uids]" (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("David J Kavid" NIL "david.kavid" "generic.com")) NIL NIL "<72f9a217.a21772f9@generic.com>") (("TEXT" "PLAIN" ("CHARSET" "us-ascii") NIL NIL "7BIT" 369 11 NIL NIL NIL)("MESSAGE" "RFC822" NIL NIL NIL "7BIT" 2599 ("Tue, 9 Jul 2002 13:42:04 -0400" "Here is the the list of uids" (("Nicholas Kringle" NIL "nicholas.kringle" "generic.com")) (("Nicholas Kringle" NIL "nicholas.kringle" "generic.com")) (("Nicholas Kringle" NIL "nicholas.kringle" "generic.com")) (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("Richard W Continued" NIL "richard.continued" "generic.com")) NIL NIL "<015401c2276f$f09b7c10$59cab08c@one.two.generic.com>") ((("TEXT" "PLAIN" ("CHARSET" "iso-8859-1") NIL NIL "QUOTED-PRINTABLE" 256 10 NIL NIL NIL)("TEXT" "HTML" ("CHARSET" "iso-8859-1") NIL NIL "QUOTED-PRINTABLE" 791 22 NIL NIL NIL) "ALTERNATIVE" ("BOUNDARY" "----=_NextPart_001_0151_01C2274E.6969D0F0") NIL NIL) "MIXED" ("BOUNDARY" "----=_NextPart_000_0150_01C2274E.6969D0F0") NIL NIL) 75 NIL NIL NIL) "MIXED" ("BOUNDARY" "--1f34eac2082b02") NIL ("EN")) 118 NIL NIL NIL) "MIXED" ("BOUNDARY" "------------F600BD8FDDD648ABA72A09E0") NIL NIL)) +END_OF_BS2 + +$bsobj = Mail::IMAPClient::BodyStructure->new($bs2); +ok( defined $bsobj, 'parsed second' ); +is( $bsobj->bodytype, 'MULTIPART', 'bodytype' ); +is( $bsobj->bodysubtype, 'MIXED', 'bodysubtype' ); + +is( + join( "#", $bsobj->parts ), + + # Better parsing in version 3.03, changed this outcome + # "1#2#2.HEAD#2.1#2.2#2.2.HEAD#2.2.1#2.2.1.1#2.2.1.2" +"1#2#2.HEAD#2.1#2.1.1#2.1.2#2.1.2.HEAD#2.1.2.1#2.1.2.1.1#2.1.2.1.1.1#2.1.2.1.1.2", + 'parts' +); + +my $bs3 = <<'END_OF_BS3'; +FETCH (UID 1 BODYSTRUCTURE (("TEXT" "PLAIN" ("charset" "ISO-8859-1") +NIL NIL "quoted-printable" 1744 0)("TEXT" "HTML" ("charset" +"ISO-8859-1") NIL NIL "quoted-printable" 1967 0) "ALTERNATIVE")) +END_OF_BS3 + +$bsobj = Mail::IMAPClient::BodyStructure->new($bs3); +ok( defined $bsobj, 'parsed third' ); + +my $bs4 = <<'END_OF_BS4'; +* 9 FETCH (UID 9 BODYSTRUCTURE (("TEXT" "PLAIN" ("charset" "us-ascii") NIL "Notification" "7BIT" 588 0)("MESSAGE" "DELIVERY-STATUS" NIL NIL "Delivery report" "7BIT" 459)("MESSAGE" "RFC822" NIL NIL "Undelivered Message" "8bit" 10286 ("Thu, 31 May 2007 11:25:56 +0200 (CEST)" "*****SPAM***** RE: Daily News" (("admin@activtrades.com" NIL "polettld" "ensma.fr")) (("admin@activtrades.com" NIL "polettld" "ensma.fr")) (("admin@activtrades.com" NIL "polettld" "ensma.fr")) ((NIL NIL "polettld" "ensma.fr")) NIL NIL "NIL" "<20070531133257.92825.qmail@cc299962-a.haaks1.ov.home.nl>") (("TEXT" "PLAIN" ("charset" "iso-8859-1") NIL NIL "7bit" 1510 0)("MESSAGE" "RFC822" ("name" "message" "x-spam-type" "original") NIL "Original message" "8bit" 5718) "MIXED")) "REPORT")) +END_OF_BS4 + +$bsobj = Mail::IMAPClient::BodyStructure->new($bs4); +ok( defined $bsobj, 'parsed fourth' ); + +# test bodyMD5, contributed by Micheal Stok +my $bs5 = <<'END_OF_BS5'; +* 6 FETCH (UID 17280 BODYSTRUCTURE ((("text" "plain" ("charset" "utf-8") NIL NIL "quoted-printable" 1143 37 NIL NIL NIL)("text" "html" ("charset" "utf-8") NIL NIL "quoted-printable" 4618 106 NIL NIL NIL) "alternative" ("boundary" "Boundary-00=_Z7P340MWKGMMYJ0CCJD0") NIL NIL)("image" "tiff" ("name" "8dd0e430.tif") NIL NIL "base64" 204134 "pmZp5QOBa9BIqFNmvxUiyQ==" ("attachment" ("filename" "8dd0e430.tif")) NIL) "mixed" ("boundary" "Boundary-00=_T7P340MWKGMMYJ0CCJD0") NIL NIL)) +END_OF_BS5 + +$bsobj = Mail::IMAPClient::BodyStructure->new($bs5); +ok( defined $bsobj, 'parsed fifth' ); diff --git a/Mail-IMAPClient-3.23/t/fetch_hash.t b/Mail-IMAPClient-3.23/t/fetch_hash.t new file mode 100644 index 0000000..179ebf5 --- /dev/null +++ b/Mail-IMAPClient-3.23/t/fetch_hash.t @@ -0,0 +1,233 @@ +#!/usr/bin/perl +# +# +# tests for fetch_hash() +# +# fetch_hash() calls fetch() internally. rather than refactor +# fetch_hash() just for testing, we instead subclass M::IC and use the +# overidden fetch() to feed it test data. + +use strict; +use warnings; +use Test::More tests => 18; + +BEGIN { use_ok('Mail::IMAPClient') or exit; } + +my @tests = ( + [ + "unquoted value", + [ q{* 1 FETCH (UNQUOTED foobar)}, ], + [ [1], qw(UNQUOTED) ], + { "1" => { "UNQUOTED" => q{foobar}, } }, + ], + [ + "quoted value", + [ q{* 1 FETCH (QUOTED "foo bar baz")}, ], + [ [1], qw(QUOTED) ], + { "1" => { "QUOTED" => q{foo bar baz}, }, }, + ], + [ + "parenthesized value", + [ q{* 1 FETCH (PARENS (foo bar))}, ], + [ [1], qw(PARENS) ], + { "1" => { "PARENS" => q{foo bar}, }, }, + ], + [ + "parenthesized value with quotes", + [ q{* 1 FETCH (PARENS (foo "bar" baz))}, ], + [ [1], qw(PARENS) ], + { "1" => { "PARENS" => q{foo "bar" baz}, }, }, + ], + [ + "parenthesized value with parens at start", + [ q{* 1 FETCH (PARENS ((foo) bar baz))}, ], + [ [1], qw(PARENS) ], + { "1" => { "PARENS" => q{(foo) bar baz}, }, }, + ], + [ + "parenthesized value with parens in middle", + [ q{* 1 FETCH (PARENS (foo (bar) baz))}, ], + [ [1], qw(PARENS) ], + { "1" => { "PARENS" => q{foo (bar) baz}, }, }, + ], + [ + "parenthesized value with parens at end", + [ q{* 1 FETCH (PARENS (foo bar (baz)))}, ], + [ [1], qw(PARENS) ], + { "1" => { "PARENS" => q{foo bar (baz)}, }, }, + ], + [ + "complex parens", + [ q{* 1 FETCH (PARENS ((((foo) "bar") baz (quux))))}, ], + [ [1], qw(PARENS) ], + { "1" => { "PARENS" => q{(((foo) "bar") baz (quux))}, }, }, + ], + [ + "basic literal value", + [ q{* 1 FETCH (LITERAL}, q{foo}, q{)}, ], + [ [1], qw(LITERAL) ], + { "1" => { "LITERAL" => q{foo}, }, }, + ], + [ + "multiline literal value", + [ q{* 1 FETCH (LITERAL}, q{foo\r\nbar\r\nbaz\r\n}, q{)}, ], + [ [1], qw(LITERAL) ], + { "1" => { "LITERAL" => q{foo\r\nbar\r\nbaz\r\n}, }, }, + ], + [ + "multiple attributes", + [ q{* 1 FETCH (FOO foo BAR bar BAZ baz)}, ], + [ [1], qw(FOO BAR BAZ) ], + { + "1" => { + "FOO" => q{foo}, + "BAR" => q{bar}, + "BAZ" => q{baz}, + }, + }, + ], + [ + "dotted attribute", + [ q{* 1 FETCH (FOO.BAR foobar)}, ], + [ [1], qw(FOO.BAR) ], + { "1" => { "FOO.BAR" => q{foobar}, }, }, + ], + [ + "complex attribute", + [ q{* 1 FETCH (FOO.BAR[BAZ (QUUX)] quuz)}, ], + [ [1], q{FOO.BAR[BAZ (QUUX)]} ], + { "1" => { q{FOO.BAR[BAZ (QUUX)]} => q{quuz}, }, }, + ], + [ + "BODY.PEEK[] requests match BODY[] responses", + [ q{* 1 FETCH (BODY[] foo)} ], + [ [1], qw(BODY.PEEK[]) ], + { "1" => { "BODY[]" => q{foo}, }, }, + ], + [ + "BODY.PEEK[] requests match BODY.PEEK[] responses also", + [ q{* 1 FETCH (BODY.PEEK[] foo)} ], + [ [1], qw(BODY.PEEK[]) ], + { "1" => { "BODY.PEEK[]" => q{foo}, }, }, + ], + [ + "real life example", + [ +'* 1 FETCH (UID 541 FLAGS (\\Seen) INTERNALDATE "15-Sep-2009 20:05:45 +1000" RFC822.SIZE 771 BODY[HEADER.FIELDS (TO FROM DATE SUBJECT)]', + 'Date: Tue, 15 Sep 2009 20:05:45 +1000 +To: rob@pyro +From: rob@pyro +Subject: test Tue, 15 Sep 2009 20:05:45 +1000 + +', + ' BODY[]', + 'Return-Path: +X-Spam-Checker-Version: SpamAssassin 3.2.5 (2008-06-10) on pyro.home +X-Spam-Level: +X-Spam-Status: No, score=-0.5 required=5.0 tests=ALL_TRUSTED,BAYES_00, + FH_FROMEML_NOTLD,TO_MALFORMED autolearn=no version=3.2.5 +X-Original-To: rob@pyro +Delivered-To: rob@pyro +Received: from pyro (pyro [127.0.0.1]) + by pyro.home (Postfix) with ESMTP id A5C8115A066 + for ; Tue, 15 Sep 2009 20:05:45 +1000 (EST) +Date: Tue, 15 Sep 2009 20:05:45 +1000 +To: rob@pyro +From: rob@pyro +Subject: test Tue, 15 Sep 2009 20:05:45 +1000 +X-Mailer: swaks v20061116.0 jetmore.org/john/code/#swaks +Message-Id: <20090915100545.A5C8115A066@pyro.home> +X-Bogosity: Spam, tests=bogofilter, spamicity=0.999693, version=1.2.1 +Lines: 1 + +This is a test mailing +', + ') +', + ], + [ + [1], + q{BODY.PEEK[HEADER.FIELDS (To From Date Subject)]}, + qw(FLAGS INTERNALDATE RFC822.SIZE BODY[]) + ], + { + "1" => { + 'BODY[]' => 'Return-Path: +X-Spam-Checker-Version: SpamAssassin 3.2.5 (2008-06-10) on pyro.home +X-Spam-Level: +X-Spam-Status: No, score=-0.5 required=5.0 tests=ALL_TRUSTED,BAYES_00, + FH_FROMEML_NOTLD,TO_MALFORMED autolearn=no version=3.2.5 +X-Original-To: rob@pyro +Delivered-To: rob@pyro +Received: from pyro (pyro [127.0.0.1]) + by pyro.home (Postfix) with ESMTP id A5C8115A066 + for ; Tue, 15 Sep 2009 20:05:45 +1000 (EST) +Date: Tue, 15 Sep 2009 20:05:45 +1000 +To: rob@pyro +From: rob@pyro +Subject: test Tue, 15 Sep 2009 20:05:45 +1000 +X-Mailer: swaks v20061116.0 jetmore.org/john/code/#swaks +Message-Id: <20090915100545.A5C8115A066@pyro.home> +X-Bogosity: Spam, tests=bogofilter, spamicity=0.999693, version=1.2.1 +Lines: 1 + +This is a test mailing +', + 'INTERNALDATE' => '15-Sep-2009 20:05:45 +1000', + 'FLAGS' => '\\Seen', + 'BODY[HEADER.FIELDS (TO FROM DATE SUBJECT)]' => + 'Date: Tue, 15 Sep 2009 20:05:45 +1000 +To: rob@pyro +From: rob@pyro +Subject: test Tue, 15 Sep 2009 20:05:45 +1000 + +', + 'RFC822.SIZE' => '771' + }, + }, + ], +); + +my @uid_tests = ( + [ + "uid enabled", + [ q{* 1 FETCH (UID 123 UNQUOTED foobar)}, ], + [ [123], qw(UNQUOTED) ], + { "123" => { "UNQUOTED" => q{foobar}, } }, + ], +); + +package Test::Mail::IMAPClient; + +use vars qw(@ISA); +@ISA = qw(Mail::IMAPClient); + +sub new { + my ( $class, %args ) = @_; + my %me = %args; + return bless \%me, $class; +} + +sub fetch { + my ( $self, @args ) = @_; + return $self->{_next_fetch_response} || []; +} + +package main; + +sub run_tests { + my ( $imap, $tests ) = @_; + + for my $test (@$tests) { + my ( $comment, $fetch, $request, $response ) = @$test; + $imap->{_next_fetch_response} = $fetch; + my $r = $imap->fetch_hash(@$request); + is_deeply( $r, $response, $comment ); + } +} + +my $imap = Test::Mail::IMAPClient->new( Uid => 0 ); +run_tests( $imap, \@tests ); + +$imap->Uid(1); +run_tests( $imap, \@uid_tests ); diff --git a/Mail-IMAPClient-3.23/t/messageset.t b/Mail-IMAPClient-3.23/t/messageset.t new file mode 100644 index 0000000..9d3520e --- /dev/null +++ b/Mail-IMAPClient-3.23/t/messageset.t @@ -0,0 +1,37 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use Test::More tests => 7; + +BEGIN { use_ok('Mail::IMAPClient::MessageSet') or exit; } + +my $one = q/1:4,3:6,10:15,20:25,2:8/; +my $range = Mail::IMAPClient::MessageSet->new($one); +is( $range, "1:8,10:15,20:25", 'range simplify' ); + +is( + join( ",", $range->unfold ), + "1,2,3,4,5,6,7,8,10,11,12,13,14,15,20,21,22,23,24,25", + 'range unfold' +); + +$range .= "30,31,32,31:34,40:44"; +is( $range, "1:8,10:15,20:25,30:34,40:44", 'overload concat' ); + +is( + join( ",", $range->unfold ), + "1,2,3,4,5,6,7,8,10,11,12,13,14,15,20,21,22,23,24,25," + . "30,31,32,33,34,40,41,42,43,44", + 'unfold extended' +); + +$range -= "1:2"; +is( $range, "3:8,10:15,20:25,30:34,40:44", 'overload subtract' ); + +is( + join( ",", $range->unfold ), + "3,4,5,6,7,8,10,11,12,13,14,15,20,21,22,23,24,25," + . "30,31,32,33,34,40,41,42,43,44", + 'subtract unfold' +); diff --git a/Mail-IMAPClient-3.23/t/pod.t b/Mail-IMAPClient-3.23/t/pod.t new file mode 100644 index 0000000..a79ef22 --- /dev/null +++ b/Mail-IMAPClient-3.23/t/pod.t @@ -0,0 +1,10 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use Test::More; + +eval "use Test::Pod 1.00"; +plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; + +all_pod_files_ok(); diff --git a/Mail-IMAPClient-3.23/t/simple.t b/Mail-IMAPClient-3.23/t/simple.t new file mode 100644 index 0000000..335e121 --- /dev/null +++ b/Mail-IMAPClient-3.23/t/simple.t @@ -0,0 +1,36 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use Test::More tests => 13; + +BEGIN { use_ok('Mail::IMAPClient') or exit; } + +{ + my $obj = Mail::IMAPClient->new(); + + my %t = ( 0 => "01-Jan-1970" ); + foreach my $k ( sort keys %t ) { + my $v = $t{$k}; + my $s = $v . ' 00:00:00 +0000'; + + is( Mail::IMAPClient::Rfc2060_date($k), $v, "Rfc2060_date($k)=$v" ); + is( Mail::IMAPClient::Rfc3501_date($k), $v, "Rfc3501_date($k)=$v" ); + is( Mail::IMAPClient::Rfc3501_datetime($k), + $s, "Rfc3501_datetime($k)=$s" ); + is( Mail::IMAPClient::Rfc2060_datetime($k), + $s, "Rfc3501_datetime($k)=$s" ); + is( $obj->Rfc3501_date($k), $v, "->Rfc3501_date($k)=$v" ); + is( $obj->Rfc2060_date($k), $v, "->Rfc2060_date($k)=$v" ); + is( $obj->Rfc3501_datetime($k), $s, "->Rfc3501_datetime($k)=$s" ); + is( $obj->Rfc2060_datetime($k), $s, "->Rfc2060_datetime($k)=$s" ); + + foreach my $z (qw(+0000 -0500)) { + my $vz = $v . ' 00:00:00 ' . $z; + is( Mail::IMAPClient::Rfc2060_datetime( $k, $z ), + $vz, "Rfc2060_datetime($k)=$vz" ); + is( Mail::IMAPClient::Rfc3501_datetime( $k, $z ), + $vz, "Rfc3501_datetime($k)=$vz" ); + } + } +} diff --git a/Mail-IMAPClient-3.23/t/thread.t b/Mail-IMAPClient-3.23/t/thread.t new file mode 100644 index 0000000..2e569b8 --- /dev/null +++ b/Mail-IMAPClient-3.23/t/thread.t @@ -0,0 +1,30 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use Test::More tests => 7; + +BEGIN { use_ok('Mail::IMAPClient::Thread') or exit; } + +my $t1 = <<'e1'; +* THREAD (166)(167)(168)(169)(172)(170)(171)(173)(174 175 176 178 181 180)(179)(177 183 182 188 184 185 186 187 189)(190)(191)(192)(193)(194 195)(196 197 198)(199)(200 202)(201)(203)(204)(205)(206 207)(208) +e1 + +my $t2 = <<'e2'; +* THREAD (166)(167)(168)(169)(172)((170)(179))(171)(173)((174)(175)(176)(178)(181)(180))((177)(183)(182)(188 (184)(189))(185 186)(187))(190)(191)(192)(193)((194)(195 196))(197 198)(199)(200 202)(201)(203)(204)(205 206 207)(208) +e2 + +my $parser = Mail::IMAPClient::Thread->new; +ok( defined $parser, 'created parser' ); + +isa_ok( $parser, 'Parse::RecDescent' ); # !!! + +my $thr1 = $parser->start($t1); +ok( defined $thr1, 'thread1 start' ); + +cmp_ok( scalar(@$thr1), '==', 25 ); + +my $thr2 = $parser->start($t2); +ok( defined $thr2, 'thread2 start' ); + +cmp_ok( scalar(@$thr2), '==', 23 ); diff --git a/Mail-IMAPClient-3.23/test_template.txt b/Mail-IMAPClient-3.23/test_template.txt new file mode 100644 index 0000000..6c6db28 --- /dev/null +++ b/Mail-IMAPClient-3.23/test_template.txt @@ -0,0 +1,5 @@ +server=imap.server.hostname +user=username +passed=password +port=143 +authmechanism=LOGIN diff --git a/Makefile b/Makefile index faa39cd..ba82f04 100644 --- a/Makefile +++ b/Makefile @@ -1,5 +1,5 @@ -# $Id: Makefile,v 1.27 2010/01/19 15:26:12 gilles Exp gilles $ +# $Id: Makefile,v 1.28 2010/02/25 23:17:25 gilles Exp gilles $ TARGET=imapsync @@ -25,7 +25,7 @@ all: ChangeLog README VERSION touch .test .test_3xx: $(TARGET) tests.sh - CMD_PERL='perl -I./Mail-IMAPClient-3.21/lib' /usr/bin/time sh tests.sh 1>/dev/null + CMD_PERL='perl -I./Mail-IMAPClient-3.23/lib' /usr/bin/time sh tests.sh 1>/dev/null touch .test_3xx test_quick : test_quick_229 test_quick_3xx @@ -34,7 +34,7 @@ test_quick_229: $(TARGET) tests.sh CMD_PERL='perl -I./Mail-IMAPClient-2.2.9' /usr/bin/time sh tests.sh locallocal 1>/dev/null test_quick_3xx: $(TARGET) tests.sh - CMD_PERL='perl -I./Mail-IMAPClient-3.21/lib' /usr/bin/time sh tests.sh locallocal 1>/dev/null + CMD_PERL='perl -I./Mail-IMAPClient-3.23/lib' /usr/bin/time sh tests.sh locallocal 1>/dev/null testv: nice -40 sh -x tests.sh diff --git a/README b/README index 58caabb..636c6c0 100644 --- a/README +++ b/README @@ -3,7 +3,7 @@ NAME Synchronise mailboxes between two imap servers. Good at IMAP migration. More than 32 different IMAP server softwares supported with success. - $Revision: 1.303 $ + $Revision: 1.310 $ INSTALL imapsync works fine under any Unix OS with perl. @@ -24,8 +24,8 @@ INSTALL Go into the directory imapsync-x.xx and read the INSTALL file. The INSTALL file is also at http://www.linux-france.org/prj/imapsync/INSTALL (for windows users) - - The freshmeat record is at http://freshmeat.net/projects/imapsync/ + + The freshmeat record is at http://freshmeat.net/projects/imapsync/ SYNOPSIS imapsync [options] @@ -74,7 +74,7 @@ SYNOPSIS [--split1] [--split2] [--reconnectretry1 ] [--reconnectretry2 ] [--version] [--help] - + DESCRIPTION The command imapsync is a tool allowing incremental and recursive imap transfer from one mailbox to another. @@ -209,6 +209,9 @@ BUGS and BUG REPORT Help us to help you: follow the following guidelines. + Read the paper "How To Ask Questions The Smart Way" + http://www.catb.org/~esr/faqs/smart-questions.html + Before reporting bugs, read the FAQ, the README and the TODO files. http://www.linux-france.org/prj/imapsync/ @@ -246,10 +249,10 @@ IMAP SERVERS Success stories reported with the following 35 imap servers (software names are in alphabetic order): - - Archiveopteryx 2.03, 2.04, 2.09, 2.10 [dest], 3.0.0 [dest] + - Archiveopteryx 2.03, 2.04, 2.09, 2.10 [host2], 3.0.0 [host2] (OSL 3.0) http://www.archiveopteryx.org/ - BincImap 1.2.3 (GPL) (http://www.bincimap.org/) - - CommuniGatePro server (Redhat 8.0) (Solaris) + - CommuniGatePro server (Redhat 8.0) (Solaris), CommuniGate Pro 5.2.17[host2] (CentOS 5.4) - Courier IMAP 1.5.1, 2.2.0, 2.1.1, 2.2.1, 3.0.8, 3.0.3, 4.1.1 (GPL) (http://www.courier-mta.org/) - Critical Path (7.0.020) @@ -265,10 +268,10 @@ IMAP SERVERS - David Tobit V8 (proprietary Message system). - DBMail 1.2.1, 2.0.4, 2.0.9, 2.2rc1 (GPL) (http://www.dbmail.org/). 2.0.7 seems buggy. - - Deerfield VisNetic MailServer 5.8.6 [from] + - Deerfield VisNetic MailServer 5.8.6 [host1] + - Domino (Notes) 4.61[host1], 6.5, 5.0.6, 5.0.7, 7.0.2, 6.0.2CF1, 7.0.1[host1], 8.0.1[host1] - Dovecot 0.99.10.4, 0.99.14, 0.99.14-8.fc4, 1.0-0.beta2.7, 1.0.0 [dest/source] (LGPL) (http://www.dovecot.org/) - - Domino (Notes) 4.61[from], 6.5, 5.0.6, 5.0.7, 7.0.2, 6.0.2CF1, 7.0.1 [from] - Eudora WorldMail v2 - GMX IMAP4 StreamProxy. - Groupwise IMAP (Novell) 6.x and 7.0. Buggy so see the FAQ. @@ -276,7 +279,10 @@ IMAP SERVERS - IMail 7.15 (Ipswitch/Win2003), 8.12 - MDaemon 7.0.1, 8.0.2, 8.1, 9.5.4 (Windows server 2003 R2 platform) - Mercury 4.1 (Windows server 2000 platform) - - Microsoft Exchange Server 5.5, 6.0.6249.0[from], 6.0.6487.0[from], 6.5.7638.1 [dest] + - Microsoft Exchange Server 5.5, 6.0.6249.0[host1], 6.0.6487.0[host1], + 6.5.7638.1 [host2], Exchange 2007 SP1 (with Update Rollup 2), + Exchange2007-EP-SP2, + Exchange 2010 RTM (Release to Manufacturing) [host2] - Netscape Mail Server 3.6 (Wintel !) - Netscape Messaging Server 4.15 Patch 7 - OpenMail IMAP server B.07.00.k0 (Samsung Contact ?) @@ -363,5 +369,5 @@ SIMILAR SOFTWARES Feedback (good or bad) will always be welcome. - $Id: imapsync,v 1.303 2010/01/20 04:12:52 gilles Exp gilles $ + $Id: imapsync,v 1.310 2010/02/26 01:24:59 gilles Exp gilles $ diff --git a/TODO b/TODO index e625b7c..9d21724 100644 --- a/TODO +++ b/TODO @@ -1,5 +1,5 @@ #!/bin/cat -# $Id: TODO,v 1.72 2010/01/20 04:13:42 gilles Exp gilles $ +# $Id: TODO,v 1.73 2010/02/07 22:03:06 gilles Exp gilles $ TODO file for imapsync ---------------------- @@ -13,6 +13,11 @@ Start a wiki for imapsync. Add a best practice migration tips document. +Fix the mailing-list archive bug with From at +the beginning of a line +http://www.linux-france.org/prj/imapsync_list/msg00307.html + + Add "output to reflect everything that imapsync was doing". Not everything but flag synchronization will be nice" diff --git a/VERSION b/VERSION index 47cecd0..f8f19eb 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -1.303 +1.310 diff --git a/bugs/BUG_IMAPClient_3.xx b/bugs/BUG_IMAPClient_3.xx index 291b5cf..06ff8bc 100644 --- a/bugs/BUG_IMAPClient_3.xx +++ b/bugs/BUG_IMAPClient_3.xx @@ -19,5 +19,5 @@ Fixed in Mail-IMAPClient-3.10/ Wrong. Lacks isUnconnected() method. 5) Mail-IMAPClient-3.19 is a good one. - No known bug +--expunge does not expunge anything diff --git a/i3 b/i3 index 4c190b7..f5d0dc5 100755 --- a/i3 +++ b/i3 @@ -1,4 +1,4 @@ #!/bin/sh -perl -IMail-IMAPClient-3.19/lib ./imapsync "$@" +perl -IMail-IMAPClient-3.23/lib ./imapsync "$@" diff --git a/imapsync b/imapsync index 1732676..0a05f96 100755 --- a/imapsync +++ b/imapsync @@ -9,7 +9,7 @@ tool. Synchronise mailboxes between two imap servers. Good at IMAP migration. More than 32 different IMAP server softwares supported with success. -$Revision: 1.303 $ +$Revision: 1.310 $ =head1 INSTALL @@ -243,6 +243,9 @@ or to the author. Help us to help you: follow the following guidelines. +Read the paper "How To Ask Questions The Smart Way" +http://www.catb.org/~esr/faqs/smart-questions.html + Before reporting bugs, read the FAQ, the README and the TODO files. http://www.linux-france.org/prj/imapsync/ @@ -281,10 +284,10 @@ Failure stories reported with the following 4 imap servers: Success stories reported with the following 35 imap servers (software names are in alphabetic order): - - Archiveopteryx 2.03, 2.04, 2.09, 2.10 [dest], 3.0.0 [dest] + - Archiveopteryx 2.03, 2.04, 2.09, 2.10 [host2], 3.0.0 [host2] (OSL 3.0) http://www.archiveopteryx.org/ - BincImap 1.2.3 (GPL) (http://www.bincimap.org/) - - CommuniGatePro server (Redhat 8.0) (Solaris) + - CommuniGatePro server (Redhat 8.0) (Solaris), CommuniGate Pro 5.2.17[host2] (CentOS 5.4) - Courier IMAP 1.5.1, 2.2.0, 2.1.1, 2.2.1, 3.0.8, 3.0.3, 4.1.1 (GPL) (http://www.courier-mta.org/) - Critical Path (7.0.020) @@ -300,10 +303,10 @@ Success stories reported with the following 35 imap servers - David Tobit V8 (proprietary Message system). - DBMail 1.2.1, 2.0.4, 2.0.9, 2.2rc1 (GPL) (http://www.dbmail.org/). 2.0.7 seems buggy. - - Deerfield VisNetic MailServer 5.8.6 [from] + - Deerfield VisNetic MailServer 5.8.6 [host1] + - Domino (Notes) 4.61[host1], 6.5, 5.0.6, 5.0.7, 7.0.2, 6.0.2CF1, 7.0.1[host1], 8.0.1[host1] - Dovecot 0.99.10.4, 0.99.14, 0.99.14-8.fc4, 1.0-0.beta2.7, 1.0.0 [dest/source] (LGPL) (http://www.dovecot.org/) - - Domino (Notes) 4.61[from], 6.5, 5.0.6, 5.0.7, 7.0.2, 6.0.2CF1, 7.0.1 [from] - Eudora WorldMail v2 - GMX IMAP4 StreamProxy. - Groupwise IMAP (Novell) 6.x and 7.0. Buggy so see the FAQ. @@ -311,7 +314,10 @@ Success stories reported with the following 35 imap servers - IMail 7.15 (Ipswitch/Win2003), 8.12 - MDaemon 7.0.1, 8.0.2, 8.1, 9.5.4 (Windows server 2003 R2 platform) - Mercury 4.1 (Windows server 2000 platform) - - Microsoft Exchange Server 5.5, 6.0.6249.0[from], 6.0.6487.0[from], 6.5.7638.1 [dest] + - Microsoft Exchange Server 5.5, 6.0.6249.0[host1], 6.0.6487.0[host1], + 6.5.7638.1 [host2], Exchange 2007 SP1 (with Update Rollup 2), + Exchange2007-EP-SP2, + Exchange 2010 RTM (Release to Manufacturing) [host2] - Netscape Mail Server 3.6 (Wintel !) - Netscape Messaging Server 4.15 Patch 7 - OpenMail IMAP server B.07.00.k0 (Samsung Contact ?) @@ -420,7 +426,7 @@ Entries for imapsync: Feedback (good or bad) will always be welcome. -$Id: imapsync,v 1.303 2010/01/20 04:12:52 gilles Exp gilles $ +$Id: imapsync,v 1.310 2010/02/26 01:24:59 gilles Exp gilles $ =cut @@ -473,6 +479,7 @@ my( $mess_size_total_skipped, $mess_size_total_error, $mess_trans, $mess_skipped, $mess_skipped_dry, + $h1_mess_deleted, $h2_mess_deleted, $timeout, # whr (ESS/PRW) $timestart, $timeend, $timediff, $timesize, $timebefore, @@ -490,7 +497,7 @@ my( use vars qw ($opt_G); # missing code for this will be option. -$rcs = '$Id: imapsync,v 1.303 2010/01/20 04:12:52 gilles Exp gilles $ '; +$rcs = '$Id: imapsync,v 1.310 2010/02/26 01:24:59 gilles Exp gilles $ '; $rcs =~ m/,v (\d+\.\d+)/; $VERSION = ($1) ? $1: "UNKNOWN"; @@ -500,6 +507,7 @@ $mess_size_total_trans = 0; $mess_size_total_skipped = 0; $mess_size_total_error = 0; $mess_trans = $mess_skipped = $mess_skipped_dry = 0; +$h1_mess_deleted = $h2_mess_deleted = 0; @@ -554,8 +562,8 @@ while (@argv_copy) { my $banner = join("", '$RCSfile: imapsync,v $ ', - '$Revision: 1.303 $ ', - '$Date: 2010/01/20 04:12:52 $ ', + '$Revision: 1.310 $ ', + '$Date: 2010/02/26 01:24:59 $ ', "\n",localhost_info(), " and the module Mail::IMAPClient version used here is ", $VERSION_IMAPClient,"\n", @@ -638,8 +646,8 @@ sub localhost_info { ), ")\n", "with perl ", - sprintf("%vd", $PERL_VERSION), - modules_VERSION() + sprintf("%vd", $PERL_VERSION),"\n", + "Mail::IMAPClient $Mail::IMAPClient::VERSION", ); return($infos); @@ -851,11 +859,8 @@ sub plainauth() { sub server_banner { my $imap = shift; - for my $line ($imap->Results()) { - #print "LR: $line"; - return $line if $line =~ /^\* (OK|NO|BAD)/; - } - return "No banner\n"; + my $banner = $imap->Banner() || "No banner\n"; + return $banner; } @@ -1209,7 +1214,7 @@ sub foldersizes { foreach my $h1_fold (@h1_folders) { my $h2_fold; - $h2_fold = to_folder_name($h1_fold); + $h2_fold = imap2_folder_name($h1_fold); $h2_folders{$h2_fold}++; } @@ -1266,23 +1271,60 @@ sub separator_invert { return($h2_fold); } -sub to_folder_name { + +sub tests_imap2_folder_name { + +$h1_prefix = $h2_prefix = ''; +$h1_sep = '/'; +$h2_sep = '.'; + +$debug and print +"prefix1: [$h1_prefix] +prefix2: [$h2_prefix] +sep1:[$h1_sep] +sep2:[$h2_sep] +"; + +ok('' eq imap2_folder_name(''), 'imap2_folder_name: empty string'); +ok('blabla' eq imap2_folder_name('blabla'), 'imap2_folder_name: blabla'); +ok('spam.spam' eq imap2_folder_name('spam/spam'), 'imap2_folder_name: spam/spam'); +ok('spam/spam' eq imap2_folder_name('spam.spam'), 'imap2_folder_name: spam.spam'); +ok('spam.spam/spam' eq imap2_folder_name('spam/spam.spam'), 'imap2_folder_name: spam/spam.spam'); +@regextrans2 = ('s,/,X,g'); +ok('' eq imap2_folder_name(''), 'imap2_folder_name: empty string [s,/,X,g]'); +ok('blabla' eq imap2_folder_name('blabla'), 'imap2_folder_name: blabla [s,/,X,g]'); +ok('spam.spam' eq imap2_folder_name('spam/spam'), 'imap2_folder_name: spam/spam [s,/,X,g]'); +ok('spamXspam' eq imap2_folder_name('spam.spam'), 'imap2_folder_name: spam.spam [s,/,X,g]'); +ok('spam.spamXspam' eq imap2_folder_name('spam/spam.spam'), 'imap2_folder_name: spam/spam.spam [s,/,X,g]'); + +@regextrans2 = ('s, ,_,g'); +ok('blabla' eq imap2_folder_name('blabla'), 'imap2_folder_name: blabla [s, ,_,g]'); +ok('bla_bla' eq imap2_folder_name('bla bla'), 'imap2_folder_name: blabla [s, ,_,g]'); + +@regextrans2 = ('s,(.*),\U$1,'); +ok('BLABLA' eq imap2_folder_name('blabla'), 'imap2_folder_name: blabla [s,\U(.*)\E,$1,]'); + + +} + +sub imap2_folder_name { my ($h2_fold); my ($x_fold) = @_; # first we remove the prefix $x_fold =~ s/^\Q$h1_prefix\E//; - $debug and print "removed source prefix: [$x_fold]\n"; + $debug and print "removed host1 prefix: [$x_fold]\n"; $h2_fold = separator_invert($x_fold,$h1_sep, $h2_sep); - $debug and print "inverted separators: [$h2_fold]\n"; + $debug and print "inverted separators: [$h2_fold]\n"; # Adding the prefix supplied by namespace or the --prefix2 option $h2_fold = $h2_prefix . $h2_fold unless(($h2_prefix eq "INBOX" . $h2_sep) and ($h2_fold =~ m/^INBOX$/i)); - $debug and print "added target prefix: [$h2_fold]\n"; + $debug and print "added host2 prefix: [$h2_fold]\n"; # Transforming the folder name by the --regextrans2 option(s) foreach my $regextrans2 (@regextrans2) { - $debug and print "eval \$h2_fold =~ $regextrans2\n"; + my $h2_fold_before = $h2_fold; eval("\$h2_fold =~ $regextrans2"); + $debug and print "[$h2_fold_before] -> [$h2_fold] using re [$regextrans2]\n"; die("error: eval regextrans2 '$regextrans2': $@\n") if $@; } return($h2_fold); @@ -1306,14 +1348,98 @@ sub tests_flags_regex { @regexflag = ('s/(\s|^)[^\\\\]\w+//g'); ok('\Seen \Middle \End' eq flags_regex('\Seen NonJunk \Middle $Spam \End'), 'flags_regex, only \word [' . flags_regex('\Seen NonJunk \Middle $Spam \End'.']')); ok(' \Seen \Middle \End1' eq flags_regex('Begin \Seen NonJunk \Middle $Spam \End1 End'), 'flags_regex, only \word [' . flags_regex('Begin \Seen NonJunk \Middle $Spam \End1 End'.']')); + + @regexflag = ('s/.*?(Keep1|Keep2|Keep3)/$1 /g'); + ok('Keep1 Keep2 ReB' eq flags_regex('ReA Keep1 REM Keep2 ReB'), "Keep only regex"); + #ok('Keep1 Keep2' eq flags_regex('Keep1 Keep2 Remove1'), "Keep only regex"); + ok('Keep1 Keep2 ' eq flags_regex('REM REM Keep1 Keep2'), "Keep only regex"); + ok('Keep1 Keep2 ' eq flags_regex('Keep1 REM REM Keep2'), "Keep only regex"); + ok('Keep1 Keep2 ' eq flags_regex('REM Keep1 REM REM Keep2'), "Keep only regex"); + ok('Keep1 Keep2 ' eq flags_regex('Keep1 Keep2'), "Keep only regex"); + ok('Keep1 ' eq flags_regex('REM Keep1'), "Keep only regex"); + + @regexflag = ('s/(Keep1|Keep2|Keep3) (?!(Keep1|Keep2|Keep3)).*/$1 /g'); + ok('Keep1 Keep2 ' eq flags_regex('Keep1 Keep2 ReB'), "Keep only regex"); + ok('Keep1 Keep2 ' eq flags_regex('Keep1 Keep2 REM REM REM'), "Keep only regex"); + ok('Keep2 ' eq flags_regex('Keep2 REM REM REM'), "Keep only regex"); + #ok('' eq flags_regex('REM REM'), "Keep only regex"); + + @regexflag = ('s/.*?(Keep1|Keep2|Keep3)/$1 /g', + 's/(Keep1|Keep2|Keep3) (?!(Keep1|Keep2|Keep3)).*/$1 /g'); + ok('Keep1 Keep2 ' eq flags_regex('REM Keep1 REM Keep2 REM'), "Keep only regex"); + ok('Keep1 Keep2 ' eq flags_regex('Keep1 REM Keep2 REM'), "Keep only regex"); + ok('Keep1 Keep2 ' eq flags_regex('REM Keep1 Keep2 REM'), "Keep only regex"); + ok('Keep1 Keep2 ' eq flags_regex('REM Keep1 REM Keep2'), "Keep only regex"); + ok('Keep1 Keep2 Keep3 ' eq flags_regex('REM Keep1 REM Keep2 REM REM Keep3 REM'), "Keep only regex"); + ok('Keep1 ' eq flags_regex('REM REM Keep1 REM REM REM '), "Keep only regex"); + ok('Keep1 Keep3 ' eq flags_regex('RE1 Keep1 RE2 Keep3 RE3 RE4 RE5 '), "Keep only regex"); + + @regexflag = ('s/(.*)/$1 jrdH8u/'); + ok('REM REM REM REM REM jrdH8u' eq flags_regex('REM REM REM REM REM'), "Keep only regex 's/(.*)/\$1 jrdH8u/'"); + @regexflag = ('s/jrdH8u *//'); + ok('REM REM REM REM REM ' eq flags_regex('REM REM REM REM REM jrdH8u'), "Keep only regex s/jrdH8u *//"); + + @regexflag = ( + 's/(.*)/$1 jrdH8u/', + 's/.*?(Keep1|Keep2|Keep3|jrdH8u)/$1 /g', + 's/(Keep1|Keep2|Keep3|jrdH8u) (?!(Keep1|Keep2|Keep3|jrdH8u)).*/$1 /g', + 's/jrdH8u *//' + ); + + ok('Keep1 Keep2 ' eq flags_regex('REM Keep1 REM Keep2 REM'), "Keep only regex 'REM Keep1 REM Keep2 REM'"); + ok('Keep1 Keep2 ' eq flags_regex('Keep1 REM Keep2 REM'), "Keep only regex"); + ok('Keep1 Keep2 ' eq flags_regex('REM Keep1 Keep2 REM'), "Keep only regex"); + ok('Keep1 Keep2 ' eq flags_regex('REM Keep1 REM Keep2'), "Keep only regex"); + ok('Keep1 Keep2 Keep3 ' eq flags_regex('REM Keep1 REM Keep2 REM REM Keep3 REM'), "Keep only regex"); + ok('Keep1 ' eq flags_regex('REM REM Keep1 REM REM REM '), "Keep only regex"); + ok('Keep1 Keep3 ' eq flags_regex('RE1 Keep1 RE2 Keep3 RE3 RE4 RE5 '), "Keep only regex"); + ok('' eq flags_regex('REM REM REM REM REM'), "Keep only regex"); + + @regexflag = ( + 's/(.*)/$1 jrdH8u/', + 's/.*?(\\\\Seen|\\\\Answered|\\\\Flagged|\\\\Deleted|\\\\Draft|jrdH8u)/$1 /g', + 's/(\\\\Seen|\\\\Answered|\\\\Flagged|\\\\Deleted|\\\\Draft|jrdH8u) (?!(\\\\Seen|\\\\Answered|\\\\Flagged|\\\\Deleted|\\\\Draft|jrdH8u)).*/$1 /g', + 's/jrdH8u *//' + ); + + ok('\\Deleted \\Answered ' + eq flags_regex('Blabla $Junk \\Deleted machin \\Answered truc'), "Keep only regex: Exchange case"); + ok('' eq flags_regex(''), "Keep only regex: Exchange case, null string"); + ok('' + eq flags_regex('Blabla $Junk machin truc'), "Keep only regex: Exchange case, no accepted flags "); + ok('\\Deleted \\Answered \\Draft \\Flagged ' + eq flags_regex('\\Deleted \\Answered \\Draft \\Flagged '), "Keep only regex: Exchange case"); + + + @regexflag = ( + 's/.*?(?:(\\\\(?:Answered|Flagged|Deleted|Seen|Draft)\s?)|$)/defined($1)?$1:q()/eg' + ); + + ok('\\Deleted \\Answered ' + eq flags_regex('Blabla \$Junk \\Deleted machin \\Answered truc'), + "Keep only regex: Exchange case (Phil)"); + + ok('' eq flags_regex(''), "Keep only regex: Exchange case, null string (Phil)"); + + ok('' + eq flags_regex('Blabla $Junk machin truc'), + "Keep only regex: Exchange case, no accepted flags (Phil)"); + + ok('\\Deleted \\Answered \\Draft \\Flagged ' + eq flags_regex('\\Deleted \\Answered \\Draft \\Flagged '), + "Keep only regex: Exchange case (Phil)"); + + } sub flags_regex { my ($h1_flags) = @_; foreach my $regexflag (@regexflag) { + my $h1_flags_orig = $h1_flags; $debug and print "eval \$h1_flags =~ $regexflag\n"; eval("\$h1_flags =~ $regexflag"); die("error: eval regexflag '$regexflag': $@\n") if $@; + $debug and print "regexflag $regexflag [$h1_flags_orig] -> [$h1_flags]\n"; } return($h1_flags); } @@ -1402,7 +1528,7 @@ print "++++ Looping on each folder ++++\n"; FOLDER: foreach my $h1_fold (@h1_folders) { my $h2_fold; print "Host1 Folder [$h1_fold]\n"; - $h2_fold = to_folder_name($h1_fold); + $h2_fold = imap2_folder_name($h1_fold); print "Host2 Folder [$h2_fold]\n"; last FOLDER if $imap1->IsUnconnected(); @@ -1528,7 +1654,7 @@ FOLDER: foreach my $h1_fold (@h1_folders) { if (!$rc) { my $reason = !defined($rc) ? "no header" : "duplicate"; my $h2_size = $h2_fir->{$m}->{"RFC822.SIZE"} || 0; - print "+ Skipping msg #$m:$h2_size in 'to' folder $h2_fold ($reason so we ignore this message)\n"; + print "+ Skipping msg #$m:$h2_size in host2 folder $h2_fold ($reason so we ignore this message)\n"; #$mess_size_total_skipped += $msize; #$mess_skipped += 1; } @@ -1555,11 +1681,12 @@ FOLDER: foreach my $h1_fold (@h1_folders) { my $h2_msg = $h2_hash{$m_id}{'m'}; my $h2_flags = $h2_hash{$m_id}{'F'} || ""; my $isdel = $h2_flags =~ /\B\\Deleted\b/ ? 1 : 0; - print "deleting message $m_id $h2_msg\n" + print "deleting message [$m_id] #$h2_msg in host2 folder $h2_fold\n" if ! $isdel; push(@expunge,$h2_msg) if $uidexpunge2; unless ($dry or $isdel) { $imap2->delete_message($h2_msg); + $h2_mess_deleted += 1; last FOLDER if $imap2->IsUnconnected(); } } @@ -1581,7 +1708,7 @@ FOLDER: foreach my $h1_fold (@h1_folders) { my $h1_idate = $h1_hash{$m_id}{'D'}; if (defined $maxsize and $h1_size > $maxsize) { - print "+ Skipping msg #$h1_msg:$h1_size in folder $h1_fold (exceeds maxsize limit $maxsize bytes)\n"; + print "+ Skipping msg #$h1_msg:$h1_size in host1 folder $h1_fold (exceeds maxsize limit $maxsize bytes)\n"; $mess_size_total_skipped += $h1_size; $mess_skipped += 1; next MESS; @@ -1715,9 +1842,10 @@ FOLDER: foreach my $h1_fold (@h1_folders) { $mess_size_total_trans += $h1_size; $mess_trans += 1; if($delete) { - print "Deleting msg #$h1_msg in folder $h1_fold\n"; + print "Deleting msg #$h1_msg in host1 folder $h1_fold\n"; unless($dry) { $imap1->delete_message($h1_msg); + $h1_mess_deleted += 1; last FOLDER if $imap1->IsUnconnected(); $imap1->expunge() if ($expunge); last FOLDER if $imap1->IsUnconnected(); @@ -1800,7 +1928,7 @@ FOLDER: foreach my $h1_fold (@h1_folders) { # NO recopy CODE HERE. to be written if needed. $error++; if ($opt_G){ - print "Deleting msg f:#$h2_msg in folder $h2_fold\n"; + print "Deleting msg f:#$h2_msg in host2 folder $h2_fold\n"; $imap2->delete_message($h2_msg) unless ($dry); last FOLDER if $imap2->IsUnconnected(); } @@ -1810,9 +1938,10 @@ FOLDER: foreach my $h1_fold (@h1_folders) { $debug and print "Message $m_id SZ_GOOD f:$h1_msg:$h1_size t:$h2_msg:$h2_size\n"; if($delete) { - print "Deleting msg #$h1_msg in folder $h1_fold\n"; + print "Deleting msg #$h1_msg in host1 folder $h1_fold\n"; unless($dry) { $imap1->delete_message($h1_msg); + $h1_mess_deleted += 1; last FOLDER if $imap1->IsUnconnected(); $imap1->expunge() if ($expunge); last FOLDER if $imap1->IsUnconnected(); @@ -1821,11 +1950,11 @@ FOLDER: foreach my $h1_fold (@h1_folders) { } } if ($expunge1){ - print "Expunging source folder $h1_fold\n"; + print "Expunging host1 folder $h1_fold\n"; unless($dry) { $imap1->expunge() }; } if ($expunge2){ - print "Expunging target folder $h2_fold\n"; + print "Expunging host2 folder $h2_fold\n"; unless($dry) { $imap2->expunge() }; } @@ -1914,17 +2043,21 @@ sub select_msgs { } sub stats { - print "++++ Statistics ++++\n"; - print "Time : $timediff sec\n"; - print "Messages transferred : $mess_trans "; - print "(could be $mess_skipped_dry without dry mode)" if ($dry); - print "\n"; - print "Messages skipped : $mess_skipped\n"; - print "Total bytes transferred: $mess_size_total_trans\n"; - print "Total bytes skipped : $mess_size_total_skipped\n"; - print "Total bytes error : $mess_size_total_error\n"; - print "Detected $error errors\n\n"; - print thank_author(); + print "++++ Statistics ++++\n"; + print "Time : $timediff sec\n"; + print "Messages transferred : $mess_trans "; + print "(could be $mess_skipped_dry without dry mode)" if ($dry); + print "\n"; + print "Messages skipped : $mess_skipped\n"; + print "Messages deleted on host1: $h1_mess_deleted\n"; + print "Messages deleted on host2: $h2_mess_deleted\n"; + print "Total bytes transferred : $mess_size_total_trans\n"; + print "Total bytes skipped : $mess_size_total_skipped\n"; + print "Total bytes error : $mess_size_total_error\n"; + $timediff ||= 1; # No division per 0 + printf ("Average bandwith rate : %.1f Ko/s\n", $mess_size_total_trans / 1024 / $timediff); + print "Detected $error errors\n\n"; + print thank_author(); } sub thank_author { @@ -2327,6 +2460,7 @@ sub tests { tests_flags_regex(); tests_permanentflags(); tests_flags_filter(); + tests_imap2_folder_name(); } } @@ -2869,18 +3003,21 @@ use constant NonFolderArg => 1; # Value to pass to Massage to # BUG? should probably return undef if length != expected # No bug, somme servers are buggy. - if ( length($string) != $expected_size ) { - warn "message_string: " . - "expected $expected_size bytes but received " . - length($string) . "\n"; - $self->LastError("message_string: expected ". - "$expected_size bytes but received " . - length($string)."\n"); - } + if (! $self->Ignoresizeerrors ) { + if ( length($string) != $expected_size ) { + warn "message_string: " . + "expected $expected_size bytes but received " . + length($string) . "\n"; + $self->LastError("message_string: expected ". + "$expected_size bytes but received " . + length($string)."\n"); + } + } return $string; }; + { no warnings 'once'; @@ -2899,6 +3036,16 @@ no warnings 'once'; return $self->{AUTHUSER}; }; + + +*Mail::IMAPClient::Ignoresizeerrors = sub { + my $self = shift; + + if (@_) { $self->{IGNORESIZEERRORS} = shift } + return $self->{IGNORESIZEERRORS}; +}; + + } # End of sub override_imapclient (yes, very bad indentation) @@ -2928,32 +3075,24 @@ sub myconnect { unless defined wantarray; return undef; } + $sock->autoflush(1); + + my $banner = $sock->getline(); + $debug and print "Read: $banner"; + + $self->Banner($banner); + $self->RawSocket2($sock); + $self->State(Connected); if ($self->Tls) { $debug and print "Calling starttls\n"; - $sock->autoflush(1); - my $banner = starttls($sock); + + my $banner = starttls($self); $debug and print "End starttls: $banner\n"; - $self->State(Mail::IMAPClient::Connected); } - $debug and print "Calling Socket\n"; + $self->Ignoresizeerrors($allowsizemismatch); - if ($Mail::IMAPClient::VERSION =~ /^3/ and $self->Tls) { - $self->RawSocket($sock); - }else{ - $self->Socket($sock); - } - - - if ( $Mail::IMAPClient::VERSION =~ /^2/ ) { - $debug and print "Calling myconnect_v2\n"; - return undef unless myconnect_v2($self); - $debug and print "End myconnect_v2\n"; - } - else { - $self->Ignoresizeerrors($allowsizemismatch); - } if ($self->User and $self->Password) { $debug and print "Calling login\n"; return $self->login ; @@ -2964,45 +3103,23 @@ sub myconnect { } -sub myconnect_v2 { - my $self = shift; - return $self if $self->Tls; - $self->State(Connected); - $self->Socket->autoflush(1); - my ($code, $output); - $output = ""; - until ( $code ) { - $output = $self->_read_line or return undef; - for my $o (@$output) { - $self->_debug("Connect: Received this from readline: " . - join("/",@$o) . "\n"); - $self->_record($self->Count,$o); # $o is a ref - next unless $o->[TYPE] eq "OUTPUT"; - ($code) = $o->[DATA] =~ /^\*\s+(OK|BAD|NO)/i ; - } - - } - - if ($code =~ /BYE|NO /) { - $self->State(Unconnected); - return undef ; - } - return $self; -} sub starttls { - my $socket = shift; + my $self = shift; + my $socket = $self->RawSocket2(); $debug and print "Entering starttls\n"; - my $banner = $socket->getline(); + my $banner = $self->Banner(); + $debug and print $banner; unless ($banner =~ /^\* OK \[CAPABILITY.*STARTTLS.*\]/) { die "No STARTTLS capability: $banner"; } - print $socket "STARTTLS\015\012"; + print $socket, "\n"; + print $socket "z00 STARTTLS\015\012"; my $txt = $socket->getline(); - $debug and print "$txt"; - unless($txt =~ /^STARTTLS OK/){ + $debug and print "Read: $txt"; + unless($txt =~ /^z00 OK/){ die "Invalid response for STARTTLS: $txt\n"; } $debug and print "Calling start_SSL\n"; @@ -3042,3 +3159,22 @@ sub Tls { return $self->{TLS}; } +sub Banner { + my $self = shift; + + if (@_) { $self->{BANNER} = shift } + return $self->{BANNER}; +} + + +sub RawSocket2 { + my ( $self, $sock ) = @_; + defined $sock + or return $self->{Socket}; + + $self->{Socket} = $sock; + $self->{_select} = IO::Select->new($sock); + delete $self->{_fcntl}; + #$self->Fast_io( $self->Fast_io ); + $sock; +} diff --git a/patches/FAQ_ralph.patch b/patches/FAQ_ralph.patch new file mode 100644 index 0000000..83ed56a --- /dev/null +++ b/patches/FAQ_ralph.patch @@ -0,0 +1,529 @@ +--- FAQ.orig 2009-04-30 04:09:14.000000000 +0200 ++++ FAQ 2010-02-02 08:53:04.000000000 +0100 +@@ -6,12 +6,12 @@ + +------------------+ + + ======================================================================= +-Q. How to install impasync ? ++Q. How to install imapsync ? + + R. http://www.linux-france.org/prj/imapsync/INSTALL + + ======================================================================= +-Q. How to configure impasync ? ++Q. How to configure imapsync ? + + R. http://www.linux-france.org/prj/imapsync/README + +@@ -46,7 +46,7 @@ + Thank you for your participation. + + ======================================================================= +-Q. Where I can read IMAP RFCs ? ++Q. Where I can read up on the various IMAP RFCs ? + + R. Here: + +@@ -67,12 +67,12 @@ + + + ======================================================================= +-Q. Where I can find old imapsync releases ? ++Q. Where I can find old imapsync releases? + + R. ftp://www.linux-france.org/pub/prj/imapsync/ + + ======================================================================= +-Q. How can I try imapsync with Mail::IMAPClient 3.xx perl library? ++Q. How can I try imapsync with the new Mail::IMAPClient 3.xx perl library? + + R. - Download latest Mail::IMAPClient 3.xx at + http://search.cpan.org/dist/Mail-IMAPClient/ +@@ -105,8 +105,8 @@ + ======================================================================= + Q. I am interested in creating a local clone of the IMAP on a LAN + server for faster synchronisations, Email will always be delivered +-to the remote server and so the synchronisation will be one way from +-remote to local. How suited is ImapSync to continouous one-way ++to the remote server and so the synchronisation will be one way - from ++remote to local. How suited is ImapSync for continuous one-way + synchronisation of mailboxes? Is there a better solution? + + R. If messages are delivered remotely and you play locally with the +@@ -130,17 +130,16 @@ + - Mutt + - Thunderbird + +-Eurora shows by default the time the imap server received the email. +-I think it is quite a wrong behavior since the messages can +-have travelled some time before the reception. +- +-The sent time and date are given by the "Date:" header +-and it is set most of the time by the MUA (Mail User Agent, +-Mutt, Eudora, Thunderbird etc.). +- +-imapsync does not touch any header since the +-header is used to identify the messages in +-both parts. ++Eurora shows by default the time the imap server received the email. I ++think it is quite a wrong behavior since the messages can have ++travelled some time before the reception. ++ ++The sent time and date are given by the "Date:" header and it is set ++most of the time by the MUA (Mail User Agent, Mutt, Eudora, ++Thunderbird etc.). ++ ++imapsync does not touch any header since the header is used to ++identify the messages in both parts. + + Solutions: + a) Don't use buggy Eudora. +@@ -156,7 +155,7 @@ + ======================================================================= + Q. Does imapsync retain the \Answered and $Forwarded flags? + +-R. imapsync retains all flags except \Recent ++R. imapsync retains ALL flags except \Recent + (RFC 3501 says "This flag can not be altered by the client.") + + Some imap servers have problems with flags not beginning with +@@ -195,11 +194,11 @@ + + ======================================================================= + Q. Some passwords contain * and " characters. Login fails. +-R. Use ++R. Use a backslash to escape the characters: + + imapsync --password1 \"password\" + +-Ii works for the star * character, ++It works for the star * character, + I don't know if it works for the " character. + + ======================================================================= +@@ -273,46 +272,43 @@ + imaps stream tcp nowait cyrus /usr/sbin/stunnel -s cyrus -p /etc/ssl/certs/imapd.pem -r localhost:imap2 + + ======================================================================= +-Q: I'm trying to use imapsync on win32 for gmail, but it requires ssl, +-or at least claims to. Imapsync appears to require io-socket-ssl, +-which doesn't seem to be available on win32. Are there any other options? ++Q: I'm trying to use imapsync on win32 for gmail, but it requires ssl, ++or at least claims to. Imapsync appears to require io-socket-ssl, ++which doesn't seem to be available on win32. Are there any other ++options? + + R: (Q and R come as is from Bryce Walter) +-I think I'm having success using cygwin perl instead of +-ActiveState Perl. I wasn't able to get CPAN working and +-building IO::Socket::SSL in ActiveState, but cygwin did +-all right. I had to force the install of the Net::SSLeay +-dependency, because it partially failed one test, but I think +-it worked anyway. In order to get working in cygwin, I +-installed the entire "perl" category, lynx, ncftp, and lftp +-(specified as ftp program in cpan setup). I'm not sure if I +-needed all those, or if cpan just kept asking because I didn't +-have any installed at the time. Anyway, cpan worked, and +-I installed all dependencies that imapsync complained +-about until it started working. ++ ++I think I'm having success using cygwin perl instead of ActiveState ++Perl. I wasn't able to get CPAN working and building IO::Socket::SSL ++in ActiveState, but cygwin did all right. I had to force the install ++of the Net::SSLeay dependency, because it partially failed one test, ++but I think it worked anyway. In order to get working in cygwin, I ++installed the entire "perl" category, lynx, ncftp, and lftp (specified ++as ftp program in cpan setup). I'm not sure if I needed all those, or ++if cpan just kept asking because I didn't have any installed at the ++time. Anyway, cpan worked, and I installed all dependencies that ++imapsync complained about until it started working. + + ======================================================================= + Q: Multiple copies when I run imapsync twice ore more. + +-R. Multiple copies of the emails on the destination +-server. Some IMAP servers (Domino for example) add some +-headers for each message transfered. The message is +-transfered again and again each time you run imapsync. This +-is bad of course. The explanation is that imapsync considers +-the message is not the same since headers have changed (one ++R. Multiple copies of the emails on the destination server. Some IMAP ++servers (Domino for example) add some headers for each message ++transfered. The message is transfered again and again each time you ++run imapsync. This is bad of course. The explanation is that imapsync ++considers the message is not the same since headers have changed (one + line added) and size too (the header part). + +-You can look at the headers found by imapsync by using the +---debug option (and search for the message on both part), +-Header lines from the source server begin with a "FH:" prefix, +-Header lines from the destination server begin with a "TH:" prefix. +-Since --debug is very verbose I suggest to isolate a +-email in a specific folder in case you want to forward +-me the output. ++You can look at the headers found by imapsync by using the --debug ++option (and search for the message on both part), Header lines from ++the source server begin with a "FH:" prefix, Header lines from the ++destination server begin with a "TH:" prefix. Since --debug is very ++verbose I suggest to isolate a email in a specific folder in case you ++want to forward me the output. + + The way to avoid this problem is by using options --skipheader and +---skipsize, like this (avoid headers beginning whith the +-string "X-"): ++--skipsize, like this (avoid headers beginning whith the string "X-"): + + imapsync ... --skipheader '^X-' --skipsize + +@@ -325,11 +321,11 @@ + imapsync ... --useheader 'Message-ID' --skipsize + + Remark. (Trick found by Tomasz Kaczmarski) +-Option --useheader 'Message-ID' asks the server +-to send only header lines begining with 'Message-ID'. +-Some (buggy) servers send the whole header (all lines) +-instead of the 'Message-ID' line. In that case, a trick +-to keep the --useheader filtering behavior is to use ++ ++Option --useheader 'Message-ID' asks the server to send only header ++lines begining with 'Message-ID'. Some (buggy) servers send the whole ++header (all lines) instead of the 'Message-ID' line. In that case, a ++trick to keep the --useheader filtering behavior is to use + --skipheader with a negative lookahead pattern : + + imapsync ... --skipheader '^(?!Message-ID)' --skipsize +@@ -357,14 +353,14 @@ + or maybe + --exclude '^"public\.' + +-In the example given the character "." is the folder separator, +-you can ommit it. Just take the string as it appears on the +-imapsync output line : ++In the example given the character "." is the folder separator, you ++can ommit it. Just take the string as it appears on the imapsync ++output line : + + From folders list : [INBOX] [public.dreams] [etc.] + + ====================================================================== +-Q. I want the --folder 'MyFolder' option be recurse. ++Q. I want the --folder 'MyFolder' option be recursive. + + R. Do not use the --folder option. + Instead, use --include '^MyFolder' +@@ -412,17 +408,17 @@ + --exclude '^user\.' + + ====================================================================== +-Q. Is anyway imapsync to purge destionation folder when the source +- folder is deleted? ++Q. Is there anyway of making imapsync purge the destination folder ++ when the source folder is deleted? ++ ++R. No, that's too dangerous. + +-R. No, that's too much dangerous. +-But if the source folder is empty (not deleted) and +-options --delete2 --expunge2 are used then +-the destination folder will be empty. ++But if the source folder is empty (not deleted) and options --delete2 ++--expunge2 are used then the destination folder will be empty. + + ====================================================================== + Q. Is it possible to synchronize all messages from one server to +-another whithout recreating the folder structure and the target server. ++another without recreating the folder structure and the target server. + + R. Yes. + 1) First try (safe mode): +@@ -437,15 +433,15 @@ + + 3) Remove --dry + Check the imap folder tree on the target side, you should +- only have one : the classical INBOX. ++ only have one: the classical INBOX. + + 4) Remove --justfolders + + + ====================================================================== +-Q. I have moved from Braunschweig to Graz, so I would like to have my whole +-Braunschweig mail sorted into a folder INBOX.Braunschweig of my new mail +-account. ++Q. I have moved from Braunschweig to Graz, so I would like to have my ++ whole Braunschweig mail sorted into a folder INBOX.Braunschweig of my ++ new mail account. + + R. + 1) First try (safe mode): +@@ -468,30 +464,29 @@ + + R. Examples: + +-0) First try with --dry --justfolders options since imapsync shows the +-transformations it will do without really doing them. Then when happy +-with the output remove the --dry --justfolders options. ++0) First try with --dry --justfolders options since imapsync shows the ++ transformations it will do without really doing them. Then when ++ happy with the output remove the --dry --justfolders options. + + 1) To remove INBOX. in the name of destination folders: + --regextrans2 's/^INBOX\.(.+)/$1/' + + 2) To sync a complete account in a subfolder called FOO: + +- a) Separator is dot character "." and "INBOX" prefixes every folder ++ a) Seperator is dot character "." and "INBOX" prefixes every folder + --regextrans2 's/^INBOX(.*)/INBOX.FOO$1/' + + Or +- b) Separator is slash character "/" ++ b) Seperator is slash character "/" + --regextrans2 's#(.*)#FOO/$1#' + + 3) to substitute all characters dot "." by underscores "_" + --regextrans2 's/\./_/g' + + ======================================================================= +-Q. I would like to move emails from InBox to a sub-folder +-called , say "2005-InBox" based on the date (Like all emails +-received in the Year 2005 should be moved to the folder +-called "2005-InBox"). ++Q. I would like to move emails from InBox to a sub-folder called, ++ say "2005-InBox" based on the date (Like all emails received in the ++ Year 2005 should be moved to the folder called "2005-InBox"). + + R. 2 ways : + +@@ -499,17 +494,18 @@ + ------------ + + 1) You create a folder INBOX.2005-INBOX +-2) Mostly every email software allow sorting by date. +-In inbox, you select from 1 january to 31 december +-messages with the shift key. ++ ++2) Mostly every email software allow sorting by date. In inbox, you ++ select from 1 january to 31 december messages with the shift key. ++ (in mutt, use ~d) ++ + 3) Cut/paste in INBOX.2005-INBOX + + b) With imapsync: + ----------------- + +-You have to calculate the day of year (and +-add 365). For example, running it today, +-Sat Mar 11 13:06:01 CET 2006: ++You have to calculate the day of year (and add 365). For example, ++running it today, Sat Mar 11 13:06:01 CET 2006: + + imapsync ... + --host1 imap.truc.org --host2 imap.trac.org \ +@@ -528,9 +524,9 @@ + $ date +%j + 070 + +-Also, you must take imapsync 1.159 at least since I tested +-what I just wrote above and found 2 bugs about --mindate +---maxdate options behavior. ++Also, you must take imapsync 1.159 at least since I tested what I just ++wrote above and found 2 bugs about --mindate --maxdate options ++behavior. + + ======================================================================= + Q. I want to play with headers line and --regexmess but I want to leave +@@ -573,42 +569,39 @@ + Return-Path: + Received: ... + +-Any Maidir/ configured imap server may refuse this message +-since its header is invalid. The first "From " line is not +-valid. It lacks a colon character ":". +-To solve this problem you have several solutions a) or b): +- +-a) Remove these first "From " line manually for each message +-before using imapsync. Don't think to add a colon to this +-line since you will end with two "From:" lines (just look at +-the other lines) ++Any Maildir/ configured imap server may refuse this message since its ++header is invalid. The first "From " line is not valid. It lacks a ++colon character ":". To solve this problem you have several solutions ++ ++a) Remove these first "From " line manually for each message before ++ using imapsync. Don't think to add a colon to this line since you ++ will end with two "From:" lines (just look at the other lines) + + b) Run imapsync with the following options : +---regexmess 's/\AFrom \w .*\n//' --skipsize ++ --regexmess 's/\AFrom \w .*\n//' --skipsize + + ======================================================================= + Q. The contact folder isn't well copied. +- How to copy the contact folder ? ++ How to copy the contact folder? + +-R. Forget the destination server (chose the same) ++R. Forget the destination server (choose the same) + Change the script around line 1426 + # ITSD + $new_id = $from->copy($t_fold,$f_msg); + #$new_id = $to->append_string($t_fold,$string, $flags_f, $d); +-and tried a copy of the mail instead an append_string. +-Because we are using the same server, we can use $from->copy +-Therefore we seem to not download and upload the message and therefore +-we do not have any format issues. +-And now it works fine. +-(Thanks to Hansjoerg.Maurer) ++ ++and tried a copy of the mail instead an append_string. Because we are ++using the same server, we can use $from->copy Therefore we seem to not ++download and upload the message and therefore we do not have any ++format issues. And now it works fine. (Thanks to Hansjoerg.Maurer) + + + ======================================================================= +-Q. Synchronysing from XXX to Gmail ++Q. Synchronising from XXX to Gmail + +-R. There are some details to get the special [Gmail] +-sub-folders right. Here's an example of migrating an old "Sent" +-folder to Gmail's structure: ++R. There are some details to get the special [Gmail] sub-folders ++ right. Here's an example of migrating an old "Sent" folder to ++ Gmail's structure: + + imapsync --syncinternaldates \ + --host1 mail.oldhost.com \ +@@ -625,9 +618,9 @@ + The same goes for the "All Mail" archive psuedo-folder. + + ======================================================================= +-Q. Synchronysing from Gmail to XXX ++Q. Synchronising from Gmail to XXX + +-R. Gmail needs ssl. ++R. Gmail needs SSL + + ./imapsync \ + --host1 imap.gmail.com --ssl1 \ +@@ -661,6 +654,7 @@ + Q. Syncing from Google Apps domain to Googlemail account + + A known bug encountered with this output (Alexander is a folder name): ++ + ++++ Verifying [Alexander] -> [Alexander] ++++ + + NO msg #16 [A96Dh4AwlLVphOAW5MS/eQ:779824] in Alexander + + Copying msg #16:779824 to folder Alexander +@@ -679,9 +673,9 @@ + imapsync ... --folder Alexander + + ======================================================================= +-Q. I'm migrating from WU to Cyrus, and the mail folders are +-under /home/user/mail but the tool copies everything in +-/home/user, how can i avoid that? ++Q. I'm migrating from WU to Cyrus, and the mail folders are under ++ /home/user/mail but the tool copies everything in /home/user, how ++ can i avoid that? + + R. Use + imapsync ... --include '^mail' +@@ -690,12 +684,11 @@ + + + ======================================================================= +-Q. I'm migrating from WU to Cyrus, and the mail folders are +-under /home/user/mail directory. When imapsync creates the +-folders in the new cyrus imap server, it makes a folder +-"mail" and below that folder puts all the mail folders the +-user have in /home/user/mail, i would like to have all those +-folders directly under INBOX. ++Q. I'm migrating from WU to Cyrus, and the mail folders are under ++ /home/user/mail directory. When imapsync creates the folders in ++ the new cyrus imap server, it makes a folder "mail" and below that ++ folder puts all the mail folders the user have in /home/user/mail, ++ i would like to have all those folders directly under INBOX. + + R. Use + imapsync ... --regextrans2 's/^mail/INBOX/' --dry +@@ -719,30 +712,32 @@ + + --skipheader '^Content-Type' + - MIME separator IDs seem to change every time a mail is accessed so +-this is required to stop duplicates. ++ this is required to stop duplicates. + + --maxage 3650 + - some messages just don't seem to want to transfer and produce the +-perl errors I mentioned before. This prevents the errors, but the bad +-messages don't transfer. ++ perl errors I mentioned before. This prevents the errors, but the ++ bad messages don't transfer. + + Even though the mail migrated OK, there are a couple of gotchas with + Groupwise IMAP: + +-1) Some of the GW folders are not real folders and are not available to +-IMAP, the main problem one being "Sent Items". I could find no way of +-coping the contents of these folders. The nearest I got was to create a +-"real" folder and copy/move the sent items into it, but imapsync still +-didn't see the messages (I think because there is something funny about +-the reported dates/sizes). ++1) Some of the GW folders are not real folders and are not available ++to IMAP, the main problem one being "Sent Items". I could find no way ++of coping the contents of these folders. The nearest I got was to ++create a "real" folder and copy/move the sent items into it, but ++imapsync still didn't see the messages (I think because there is ++something funny about the reported dates/sizes). ++ + It think this problem has been rectified in GW6.5. + + 2) The "skipheader '^Content-Type'" directive is required to stop +-duplicate messages being created. GW seems to generate this field on the +-fly for messages that have MIME separators and so it's different every time. ++duplicate messages being created. GW seems to generate this field on ++the fly for messages that have MIME separators and so it's different ++every time. + + 3) Version 6.0.1 of the Groupwise Internet Connector sucks. I was +-getting server abends when I pushed it a bit hard! I eventually had to ++getting server aborts when I pushed it a bit hard! I eventually had to + upgrade to 6.0.4 which seems to be a lot more stable. + + +@@ -816,18 +811,19 @@ + --sep1 '/' --exclude 'user/demo/Trash' \ + --regextrans2 's/^user.//' --syncinternaldates + +-The 'exclude user/demo/Trash' was used because there was one message +-there with 8 bit headers which dbmail doesn't accept, so I had to skip +-the whole folder. It would be nice to have an option to just ignore and +-log unsyncable messages, but do the rest, instead of stopping. ++The 'exclude user/demo/Trash' was used because there was one message ++there with 8 bit headers which dbmail doesn't accept, so I had to skip ++the whole folder. It would be nice to have an option to just ignore ++and log unsyncable messages, but do the rest, instead of stopping. + + ****************** + + There are two other major problems: +-1) dbmail doesn't accept utf8 header, while cyrus does. imapsync stops ++ ++1) dbmail doesn't accept utf8 header, while cyrus does. imapsync stops + in that case, making sync impossible + +-To convert the wholes messages from 8bit to 7bit, use option : ++To convert the whole messages from 8bit to 7bit, use option : + + --regexmess 's/[\x80-\xff]/X/g' + +@@ -861,7 +857,7 @@ + Q. From any to Exchange2007 + + Several problems: +-- Big messages: increse the "send- and receive-connector" ++- Big messages: increase the "send- and receive-connector" + in exchange2007 to 40 MB. + + R. 2 solutions + diff --git a/tests.sh b/tests.sh index 3f1d671..e363690 100644 --- a/tests.sh +++ b/tests.sh @@ -1,6 +1,6 @@ #!/bin/sh -# $Id: tests.sh,v 1.98 2010/01/20 04:13:59 gilles Exp gilles $ +# $Id: tests.sh,v 1.101 2010/02/25 23:16:45 gilles Exp gilles $ # Example: # CMD_PERL='perl -I./Mail-IMAPClient-3.14/lib' sh -x tests.sh @@ -370,7 +370,7 @@ ll_authmd5() --passfile1 ../../var/pass/secret.tata \ --host2 $HOST2 --user2 titi \ --passfile2 ../../var/pass/secret.titi \ - --justfoldersizes --authmd5 \ + --justlogin --authmd5 \ --allow3xx } @@ -509,10 +509,46 @@ ll_regextrans2() --passfile1 ../../var/pass/secret.tata \ --host2 $HOST2 --user2 titi \ --passfile2 ../../var/pass/secret.titi \ - --regextrans2 's/yop/yopX/' \ - --allow3xx + --justfolders \ + --nofoldersize \ + --regextrans2 's/yop/yoX/' \ + --folder 'INBOX.yop.yap' } +ll_regextrans2_slash() +{ + $CMD_PERL ./imapsync \ + --host1 $HOST1 --user1 tata \ + --passfile1 ../../var/pass/secret.tata \ + --host2 $HOST2 --user2 titi \ + --passfile2 ../../var/pass/secret.titi \ + --justfolders \ + --nofoldersize \ + --folder 'INBOX.yop.yap' \ + --sep1 '/' \ + --regextrans2 's,/,_,' + +} + + +ll_regextrans2_remove_space() +{ + $CMD_PERL ./imapsync \ + --host1 $HOST1 --user1 tata \ + --passfile1 ../../var/pass/secret.tata \ + --host2 $HOST2 --user2 titi \ + --passfile2 ../../var/pass/secret.titi \ + --justfolders \ + --nofoldersize \ + --folder 'INBOX.yop.y p' \ + --regextrans2 's, ,,' \ + --dry + +} + + + + ll_sep2() { $CMD_PERL ./imapsync \ @@ -679,6 +715,23 @@ ll_regex_flag3() echo 'rm -f /home/vmail/titi/.yop.yap/cur/*' } +ll_regex_flag_keep_only() +{ + $CMD_PERL ./imapsync \ + --host1 $HOST1 --user1 tata \ + --passfile1 ../../var/pass/secret.tata \ + --host2 $HOST2 --user2 titi \ + --passfile2 ../../var/pass/secret.titi \ + --folder INBOX.yop.yap \ + --debug \ + --regexflag 's/(.*)/$1 jrdH8u/' \ + --regexflag 's/.*?(\\Seen|\\Answered|\\Flagged|\\Deleted|\\Draft|jrdH8u)/$1 /g' \ + --regexflag 's/(\\Seen|\\Answered|\\Flagged|\\Deleted|\\Draft|jrdH8u) (?!(\\Seen|\\Answered|\\Flagged|\\Deleted|\\Draft|jrdH8u)).*/$1 /g' \ + --regexflag 's/jrdH8u *//' + + echo 'rm -f /home/vmail/titi/.yop.yap/cur/*' +} + ll_tls_justconnect() { $CMD_PERL ./imapsync \ @@ -702,9 +755,9 @@ ll_tls_justlogin() { ll_tls_devel() { CMD_PERL='perl -I./Mail-IMAPClient-2.2.9' ll_justlogin ll_ssl_justlogin \ -&& CMD_PERL='perl -I./Mail-IMAPClient-3.19/lib' ll_justlogin ll_ssl_justlogin \ +&& CMD_PERL='perl -I./Mail-IMAPClient-3.23/lib' ll_justlogin ll_ssl_justlogin \ && CMD_PERL='perl -I./Mail-IMAPClient-2.2.9' ll_tls_justconnect ll_tls_justlogin \ -&& CMD_PERL='perl -I./Mail-IMAPClient-3.19/lib' ll_tls_justconnect ll_tls_justlogin +&& CMD_PERL='perl -I./Mail-IMAPClient-3.23/lib' ll_tls_justconnect ll_tls_justlogin } ll_tls() { @@ -805,7 +858,6 @@ ll_authmech_CRAMMD5() { ll_delete2() { if can_send; then - #echo3 Here is plume sendtestmessage titi else : @@ -816,10 +868,25 @@ ll_delete2() { --host2 $HOST2 --user2 titi \ --passfile2 ../../var/pass/secret.titi \ --folder INBOX \ - --delete2 --expunge2 \ - --allow3xx + --delete2 --expunge2 } +ll_delete() { + if can_send; then + sendtestmessage titi + else + : + fi + $CMD_PERL ./imapsync \ + --host1 $HOST1 --user1 titi \ + --passfile1 ../../var/pass/secret.titi \ + --host2 $HOST2 --user2 tata \ + --passfile2 ../../var/pass/secret.tata \ + --folder INBOX \ + --delete --expunge +} + + ll_bigmail() { $CMD_PERL ./imapsync \ --host1 $HOST1 --user1 tata \ @@ -903,21 +970,21 @@ gmail_gmail2() { allow3xx() { - perl -I./Mail-IMAPClient-3.19/lib ./imapsync \ + $CMD_PERL ./imapsync \ --host1 $HOST1 --user1 tata \ --passfile1 ../../var/pass/secret.tata \ --host2 $HOST2 --user2 titi \ --passfile2 ../../var/pass/secret.titi \ - --allow3xx + --allow3xx --justlogin } noallow3xx() { - ! perl -I./Mail-IMAPClient-3.19/lib ./imapsync \ + ! perl -I./Mail-IMAPClient-3.23/lib ./imapsync \ --host1 $HOST1 --user1 tata \ --passfile1 ../../var/pass/secret.tata \ --host2 $HOST2 --user2 titi \ --passfile2 ../../var/pass/secret.titi \ - --noallow3xx + --noallow3xx --justlogin } @@ -1234,6 +1301,7 @@ test $# -eq 0 && run_tests \ ll_regexmess_scwchu \ ll_flags \ ll_regex_flag \ + ll_regex_flag_keep_only \ ll_justconnect \ ll_justlogin \ ll_ssl \ @@ -1247,6 +1315,7 @@ test $# -eq 0 && run_tests \ ll_authmech_CRAMMD5 \ ll_authuser \ ll_delete2 \ + ll_delete \ ll_folderrec \ ll_bigmail \ gmail \