zydronium/imapsync
1
0
Fork 0
mirror of https://github.com/imapsync/imapsync.git synced 2025-06-03 19:27:14 +02:00
Code Issues Projects Releases Packages Wiki Activity

1.233

Browse source
This commit is contained in:
Nick Bebout 2011-03-12 02:44:35 +00:00
parent d96755f174
commit 6576e43299
76 changed files with 58645 additions and 2197 deletions
Download patch file Download diff file Expand all files Collapse all files

17
BUG_219_windows Normal file
View file

@ -0,0 +1,17 @@
Users reported a problem with Windows and the imapsync release 1.219
To fix the problem try this :
Near line 1170 there are 2 lines :
#unless($new_id = $to->append_string($t_fold,$string, $flags_f, $d)){
unless($new_id = $to->append_file2($t_fold, $message_file, "", $flags_f, $d)){
The first is commented with a # character, the second is not.
Remove the # on the first line and add a # at the beginning
of the second line. Run imapsync again and tell me if
your problem is solved.
This bug is fixed in revision 1.231

47
CREDITS
View file

@ -2,11 +2,48 @@
I thank very much all of these people.
If you want to make a donation to the author, Gilles LAMIRAL,
you can use the imapsync wishlist :
http://www.amazon.com/gp/registry/wishlist/1C9UNDIH3P7R7/
(Use the lowest postal cost)
or its paypal account gilles.lamiral@laposte.net
If you want to make a donation to the author, Gilles LAMIRAL:
- you can use the imapsync wishlist :
http://www.amazon.com/gp/registry/wishlist/1C9UNDIH3P7R7/
(Use the lowest postal cost)
- its paypal account gilles.lamiral@laposte.net
- If you can read french, please use the following wishlist :
http://amazon.fr/gp/registry/wishlist/37RZF7PPCD7YL
(free postal cost)
Patrick Ben Koetter
Gave link to imapmigrate : http://sourceforge.net/projects/cyrus-utils/
Will wrote an article about imapsync, imapmigrate, offline-imap
in German Linuxmagazin http://www.linuxmagazin.de/ January 2008
Julien MARY
From Dovecot 0.99.14 to Courier 3.0.8 (success)
John Owens
FAQ "Does imapsync retain the \Answered and $Forwarded flags?"
From ??? imap server to gmail. Success or failure ?
Lorenz Wallner
Had success from "GMX IMAP4 StreamProxy" to Courier-IMAP.
Stan Larson
Contributed by giving the book "Biting and Humorous Tales of a
Software Engineering Manager".
Daniel I. Meiron
Contributed by giving the book "Asterisk: The future of Telephony"
Todd Minnella
Contributed by giving the book "Agile and Iterative Development".
Balázs Bárány
Suggested to update documentation about --authuserX:
avoid use of --authmechX with --authuserX
Peer Heinlein
Suggested the --justlogin* options.
Chris Weinhaupl
Had problems from courier to zimbra

53
ChangeLog
View file

@ -1,17 +1,62 @@
RCS file: RCS/imapsync,v
Working file: imapsync
head: 1.223
head: 1.233
branch:
locks: strict
gilles: 1.223
gilles: 1.233
access list:
symbolic names:
keyword substitution: kv
total revisions: 223; selected revisions: 223
total revisions: 233; selected revisions: 233
description:
----------------------------
revision 1.223 locked by: gilles;
revision 1.233 locked by: gilles;
date: 2007/10/30 03:20:53; author: gilles; state: Exp; lines: +69 -7
Added connect2() to replace buggy connect() with bad hostname.
----------------------------
revision 1.232
date: 2007/10/30 01:41:17; author: gilles; state: Exp; lines: +24 -23
Added imapmigrate link (cyrus-utils)
Checked each SIMILAR SOFTWARES link and fixed bad ones.
Courier IMAP 3.0.8 success
Fixed Mail::IMAPClient version output.
----------------------------
revision 1.231
date: 2007/10/30 00:28:40; author: gilles; state: Exp; lines: +12 -11
bug fix avoid append_file2 on MSWin32, not the opposite :-)
----------------------------
revision 1.230
date: 2007/10/30 00:01:34; author: gilles; state: Exp; lines: +14 -9
Added bug fix to MSWin32 system and append_file2() problem.
----------------------------
revision 1.229
date: 2007/10/29 23:02:46; author: gilles; state: Exp; lines: +15 -11
Added OS name in --help
----------------------------
revision 1.228
date: 2007/10/29 22:49:07; author: gilles; state: Exp; lines: +8 -8
Added DBMail 0.9 failure.
Commented lib_version check.
----------------------------
revision 1.227
date: 2007/10/20 02:30:31; author: gilles; state: Exp; lines: +7 -6
GMX IMAP4 StreamProxy success.
----------------------------
revision 1.226
date: 2007/10/20 01:33:34; author: gilles; state: Exp; lines: +11 -9
Updated help message about --authuser : avoid --authmech1 SOMETHING
----------------------------
revision 1.225
date: 2007/08/21 03:04:08; author: gilles; state: Exp; lines: +10 -6
Uppercase authmech input.
----------------------------
revision 1.224
date: 2007/08/16 23:54:26; author: gilles; state: Exp; lines: +9 -10
Ubuntu package.
Date with minus %d-%b-%Y
----------------------------
revision 1.223
date: 2007/06/15 04:08:44; author: gilles; state: Exp; lines: +7 -7
Domino 7.0.1
Exchange 6.5.7638.1

73
FAQ
View file

@ -21,6 +21,11 @@ RFC 4549 - Synchronization Operations for Disconnected IMAP4 Clients
http://www.faqs.org/rfcs/rfc4549.html
=======================================================================
Q. Where I can find old imapsync releases ?
R. ftp://www.linux-france.org/pub/prj/imapsync/
=======================================================================
Q. We have found that the sent time and date have been changed to the
time at which the file was synchronised.
@ -29,6 +34,7 @@ R. This is the case with:
- Eudora
- Zimbra
- Outlook 2003
- Gmail
but not with
- Mutt
- Thunderbird
@ -51,6 +57,25 @@ b) Use the --syncinternaldates option and keep using Eudora :-)
c) Use the script learn/adjust_time.pl to change the internal dates
from the "Date:" header.
=======================================================================
Q. Does imapsync retain the \Answered and $Forwarded flags?
R. imapsync retains all flags except \Recent
(RFC 3501 says "This flag can not be altered by the client.")
Some imap servers have problems with flags not beginning with
the backslash character \
======================================================================
Q. imapsync fails with the following error:
flags from : [\Seen NonJunk]["10-Aug-2006 13:00:30 -0400"]
Error trying to append string: 58 NO APPEND Invalid flag list
R. Flags have to begin with a \ character.
The flag "NonJunk" is not a valid flag so use for example:
imapsync ... --regexflag 's/NonJunk//g'
=======================================================================
Q. Flags are not well synchonized. Is it a bug ?
@ -65,6 +90,31 @@ Q. imapsync hangs taking up 99.8% cpu right after start,
R. Try option --noauthmd5
=======================================================================
Q. Some passwords contain * and " characters. Login fails.
R. Use
imapsync --password1 \"password\"
Ii works for the star * character,
I don't know if it works for the " character.
=======================================================================
Q. Out of memory on FreeBSD
R. http://groups.google.com/group/lucky.freebsd.questions/browse_thread/thread/f4218e4252863328
See the user limit with the command
ulimit -a
To change it, try
ulimit -d 1000000000
Also
http://www.unixadmintalk.com/f41/perl-out-memory-sbrk-9112/
The default hard datasize limit on FreeBSD is 512MB. To raise it, put this
(or more) in /boot/loader.conf and reboot:
kern.maxdsiz="1024M"
=======================================================================
Q. imapsync failed with a "word too long" error from the imap server,
What can I do ?
@ -195,14 +245,14 @@ Here is an example:
--exclude '^user\.'
======================================================================
Q. imapsync fails with the following error:
flags from : [\Seen NonJunk]["10-Aug-2006 13:00:30 -0400"]
Error trying to append string: 58 NO APPEND Invalid flag list
Q. Is anyway imapsync to purge destionation folder when the source
folder is deleted?
R. Flags have to begin with a \ character.
The flag "NonJunk" is not a valid flag so use for example:
R. No, that's too much dangerous.
But if the source folder is empty (not deleted) and
options --delete2 --expunge2 are used then
the destination folder will be empty.
imapsync ... --regexflag 's/NonJunk//g'
======================================================================
Q. I have moved from Braunschweig to Graz, so I would like to have my whole
@ -230,12 +280,18 @@ Q. Give examples about --regextrans2
R. Examples:
0) First try with --dry option since imapsync shows the transformation
it will do. Then when happy with the output remove the --dry option
1) To remove INBOX. in the name of destination folders:
--regextrans2 's/^INBOX\.(.+)/$1/'
2) To sync a complete account in a subfolder called FOO:
--regextrans2 's/^INBOX(.*)/INBOX.FOO$1/'
3) to substitute all characters dot "." by underscores "_"
--regextrans2 's/\./_/g'
=======================================================================
Q. I would like to move emails from InBox to a sub-folder
called , say "2005-InBox" based on the date (Like all emails
@ -471,6 +527,11 @@ R: --sep1 "/" --prefix1 ""
Q: From MailEnable 2.2
R: --sep1 "." --prefix1 ""
======================================================================
Q. From GMX IMAP4 StreamProxy
R. Use:
--prefix1 INBOX and --sep1 .
======================================================================
Q: How can I write an .rpm with imapsync
R: I don't know but Neil Brown wrote one rpm package and you'll find

12
INSTALL
View file

@ -1,4 +1,4 @@
# $Id: INSTALL,v 1.11 2007/06/11 04:08:51 gilles Exp gilles $
# $Id: INSTALL,v 1.12 2007/10/30 00:49:03 gilles Exp gilles $
#
# INSTALL file for imapsync
# imapsync : IMAP sync or copy tool.
@ -74,6 +74,16 @@ make install
or copy the file imapsync where you want it to be.
WINDOWS
-------
- Install Perl if it isn't already installed.
ActivePerl from ActiveState is a good candidate if
you understand nothing at free/open software
and want to run imapsync with success.
- Use PPM to install modules listed in the PREREQUISITES section.
PPM is Perl Package Manager.
TESTING
-------

401
Mail-IMAPClient-2.99_02/COPYRIGHT Normal file
View file

@ -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.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) 19yy <name of author>
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.
<signature of Ty Coon>, 1 April 1989
Ty Coon, President of Vice
That's all there is to it!

1435
Mail-IMAPClient-2.99_02/Changes Normal file
View file

File diff suppressed because it is too large Load diff

82
Mail-IMAPClient-2.99_02/INSTALL Normal file
View file

@ -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

39
Mail-IMAPClient-2.99_02/MANIFEST Normal file
View file

@ -0,0 +1,39 @@
Changes
COPYRIGHT
Todo
Makefile.PL
MANIFEST
README
examples/build_dist.pl
examples/build_ldif.pl
examples/cleanTest.pl
examples/copy_folder.pl
examples/cyrus_expire.pl
examples/cyrus_expunge.pl
examples/find_dup_msgs.pl
examples/imap_to_mbox.pl
examples/imtestExample.pl
examples/migrate_mail2.pl
examples/migrate_mbox.pl
examples/populate_mailbox.pl
examples/sharedFolder.pl
INSTALL
sample.perldb
test_template.txt
prepare_dist
lib/Mail/IMAPClient/BodyStructure/Parse.grammar
lib/Mail/IMAPClient/BodyStructure/Parse.pm
lib/Mail/IMAPClient/BodyStructure/Parse.pod
lib/Mail/IMAPClient/BodyStructure.pm
lib/Mail/IMAPClient/MessageSet.pm
lib/Mail/IMAPClient.pm
lib/Mail/IMAPClient.pod
lib/Mail/IMAPClient/Thread.grammar
lib/Mail/IMAPClient/Thread.pm
lib/Mail/IMAPClient/Thread.pod
t/basic.t
t/bodystructure.t
t/messageset.t
t/thread.t
t/pod.t
META.yml Module meta-data (added by MakeMaker)

25
Mail-IMAPClient-2.99_02/META.yml Normal file
View file

@ -0,0 +1,25 @@
--- #YAML:1.0
name: Mail-IMAPClient
version: 2.99_02
abstract: IMAP4 client library
license: ~
generated_by: ExtUtils::MakeMaker version 6.32
distribution_type: module
requires:
Carp: 0
Data::Dumper: 0
Digest::HMAC_MD5: 0
Errno: 0
Fcntl: 0
File::Temp: 0.18
IO::File: 0
IO::Select: 0
IO::Socket: 0
IO::Socket::INET: 1.26
MIME::Base64: 0
Parse::RecDescent: 1.94
Test::More: 0
Test::Pod: 0
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.2.html
version: 1.2

850
Mail-IMAPClient-2.99_02/Makefile Normal file
View file

@ -0,0 +1,850 @@
# This Makefile is for the Mail::IMAPClient extension to perl.
#
# It was generated automatically by MakeMaker version
# 6.30_01 (Revision: Revision: 4535 ) from the contents of
# Makefile.PL. Don't edit this file, edit Makefile.PL instead.
#
# ANY CHANGES MADE HERE WILL BE LOST!
#
# MakeMaker ARGV: ()
#
# MakeMaker Parameters:
# ABSTRACT => q[IMAP4 client library]
# NAME => q[Mail::IMAPClient]
# PREREQ_PM => { IO::File=>q[0], IO::Socket::INET=>q[1.26], Data::Dumper=>q[0], Fcntl=>q[0], Test::Pod=>q[0], Parse::RecDescent=>q[1.94], Carp=>q[0], Test::More=>q[0], Digest::HMAC_MD5=>q[0], MIME::Base64=>q[0], IO::Socket=>q[0], IO::Select=>q[0], File::Temp=>q[0.18], Errno=>q[0] }
# VERSION_FROM => q[lib/Mail/IMAPClient.pm]
# clean => { FILES=>q[test.txt] }
# --- MakeMaker post_initialize section:
# --- MakeMaker const_config section:
# These definitions are from config.sh (via /usr/lib/perl/5.8/Config.pm)
# They may have been overridden via Makefile.PL or on the command line
AR = ar
CC = cc
CCCDLFLAGS = -fPIC
CCDLFLAGS = -Wl,-E
DLEXT = so
DLSRC = dl_dlopen.xs
LD = cc
LDDLFLAGS = -shared -L/usr/local/lib
LDFLAGS = -L/usr/local/lib
LIBC = /lib/libc-2.3.6.so
LIB_EXT = .a
OBJ_EXT = .o
OSNAME = linux
OSVERS = 2.6.18.3
RANLIB = :
SITELIBEXP = /usr/local/share/perl/5.8.8
SITEARCHEXP = /usr/local/lib/perl/5.8.8
SO = so
EXE_EXT =
FULL_AR = /usr/bin/ar
VENDORARCHEXP = /usr/lib/perl5
VENDORLIBEXP = /usr/share/perl5
# --- MakeMaker constants section:
AR_STATIC_ARGS = cr
DIRFILESEP = /
DFSEP = $(DIRFILESEP)
NAME = Mail::IMAPClient
NAME_SYM = Mail_IMAPClient
VERSION = 2.99_02
VERSION_MACRO = VERSION
VERSION_SYM = 2_99_02
DEFINE_VERSION = -D$(VERSION_MACRO)=\"$(VERSION)\"
XS_VERSION = 2.99_02
XS_VERSION_MACRO = XS_VERSION
XS_DEFINE_VERSION = -D$(XS_VERSION_MACRO)=\"$(XS_VERSION)\"
INST_ARCHLIB = blib/arch
INST_SCRIPT = blib/script
INST_BIN = blib/bin
INST_LIB = blib/lib
INST_MAN1DIR = blib/man1
INST_MAN3DIR = blib/man3
MAN1EXT = 1p
MAN3EXT = 3pm
INSTALLDIRS = site
DESTDIR =
PREFIX = /usr
PERLPREFIX = $(PREFIX)
SITEPREFIX = $(PREFIX)/local
VENDORPREFIX = $(PREFIX)
INSTALLPRIVLIB = $(PERLPREFIX)/share/perl/5.8
DESTINSTALLPRIVLIB = $(DESTDIR)$(INSTALLPRIVLIB)
INSTALLSITELIB = $(SITEPREFIX)/share/perl/5.8.8
DESTINSTALLSITELIB = $(DESTDIR)$(INSTALLSITELIB)
INSTALLVENDORLIB = $(VENDORPREFIX)/share/perl5
DESTINSTALLVENDORLIB = $(DESTDIR)$(INSTALLVENDORLIB)
INSTALLARCHLIB = $(PERLPREFIX)/lib/perl/5.8
DESTINSTALLARCHLIB = $(DESTDIR)$(INSTALLARCHLIB)
INSTALLSITEARCH = $(SITEPREFIX)/lib/perl/5.8.8
DESTINSTALLSITEARCH = $(DESTDIR)$(INSTALLSITEARCH)
INSTALLVENDORARCH = $(VENDORPREFIX)/lib/perl5
DESTINSTALLVENDORARCH = $(DESTDIR)$(INSTALLVENDORARCH)
INSTALLBIN = $(PERLPREFIX)/bin
DESTINSTALLBIN = $(DESTDIR)$(INSTALLBIN)
INSTALLSITEBIN = $(SITEPREFIX)/bin
DESTINSTALLSITEBIN = $(DESTDIR)$(INSTALLSITEBIN)
INSTALLVENDORBIN = $(VENDORPREFIX)/bin
DESTINSTALLVENDORBIN = $(DESTDIR)$(INSTALLVENDORBIN)
INSTALLSCRIPT = $(PERLPREFIX)/bin
DESTINSTALLSCRIPT = $(DESTDIR)$(INSTALLSCRIPT)
INSTALLSITESCRIPT = $(SITEPREFIX)/bin
DESTINSTALLSITESCRIPT = $(DESTDIR)$(INSTALLSITESCRIPT)
INSTALLVENDORSCRIPT = $(VENDORPREFIX)/bin
DESTINSTALLVENDORSCRIPT = $(DESTDIR)$(INSTALLVENDORSCRIPT)
INSTALLMAN1DIR = $(PERLPREFIX)/share/man/man1
DESTINSTALLMAN1DIR = $(DESTDIR)$(INSTALLMAN1DIR)
INSTALLSITEMAN1DIR = $(SITEPREFIX)/man/man1
DESTINSTALLSITEMAN1DIR = $(DESTDIR)$(INSTALLSITEMAN1DIR)
INSTALLVENDORMAN1DIR = $(VENDORPREFIX)/share/man/man1
DESTINSTALLVENDORMAN1DIR = $(DESTDIR)$(INSTALLVENDORMAN1DIR)
INSTALLMAN3DIR = $(PERLPREFIX)/share/man/man3
DESTINSTALLMAN3DIR = $(DESTDIR)$(INSTALLMAN3DIR)
INSTALLSITEMAN3DIR = $(SITEPREFIX)/man/man3
DESTINSTALLSITEMAN3DIR = $(DESTDIR)$(INSTALLSITEMAN3DIR)
INSTALLVENDORMAN3DIR = $(VENDORPREFIX)/share/man/man3
DESTINSTALLVENDORMAN3DIR = $(DESTDIR)$(INSTALLVENDORMAN3DIR)
PERL_LIB = /usr/share/perl/5.8
PERL_ARCHLIB = /usr/lib/perl/5.8
LIBPERL_A = libperl.a
FIRST_MAKEFILE = Makefile
MAKEFILE_OLD = Makefile.old
MAKE_APERL_FILE = Makefile.aperl
PERLMAINCC = $(CC)
PERL_INC = /usr/lib/perl/5.8/CORE
PERL = /usr/bin/perl
FULLPERL = /usr/bin/perl
ABSPERL = $(PERL)
PERLRUN = $(PERL)
FULLPERLRUN = $(FULLPERL)
ABSPERLRUN = $(ABSPERL)
PERLRUNINST = $(PERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)"
FULLPERLRUNINST = $(FULLPERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)"
ABSPERLRUNINST = $(ABSPERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)"
PERL_CORE = 0
PERM_RW = 644
PERM_RWX = 755
MAKEMAKER = /usr/share/perl/5.8/ExtUtils/MakeMaker.pm
MM_VERSION = 6.30_01
MM_REVISION = Revision: 4535
# FULLEXT = Pathname for extension directory (eg Foo/Bar/Oracle).
# BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. (eg Oracle)
# PARENT_NAME = NAME without BASEEXT and no trailing :: (eg Foo::Bar)
# DLBASE = Basename part of dynamic library. May be just equal BASEEXT.
FULLEXT = Mail/IMAPClient
BASEEXT = IMAPClient
PARENT_NAME = Mail
DLBASE = $(BASEEXT)
VERSION_FROM = lib/Mail/IMAPClient.pm
OBJECT =
LDFROM = $(OBJECT)
LINKTYPE = dynamic
BOOTDEP =
# Handy lists of source code files:
XS_FILES =
C_FILES =
O_FILES =
H_FILES =
MAN1PODS =
MAN3PODS = lib/Mail/IMAPClient.pod \
lib/Mail/IMAPClient/BodyStructure.pm \
lib/Mail/IMAPClient/BodyStructure/Parse.pod \
lib/Mail/IMAPClient/MessageSet.pm \
lib/Mail/IMAPClient/Thread.pod
# Where is the Config information that we are using/depend on
CONFIGDEP = $(PERL_ARCHLIB)$(DFSEP)Config.pm $(PERL_INC)$(DFSEP)config.h
# Where to build things
INST_LIBDIR = $(INST_LIB)/Mail
INST_ARCHLIBDIR = $(INST_ARCHLIB)/Mail
INST_AUTODIR = $(INST_LIB)/auto/$(FULLEXT)
INST_ARCHAUTODIR = $(INST_ARCHLIB)/auto/$(FULLEXT)
INST_STATIC =
INST_DYNAMIC =
INST_BOOT =
# Extra linker info
EXPORT_LIST =
PERL_ARCHIVE =
PERL_ARCHIVE_AFTER =
TO_INST_PM = lib/Mail/IMAPClient.pm \
lib/Mail/IMAPClient.pod \
lib/Mail/IMAPClient/BodyStructure.pm \
lib/Mail/IMAPClient/BodyStructure/Parse.grammar \
lib/Mail/IMAPClient/BodyStructure/Parse.pm \
lib/Mail/IMAPClient/BodyStructure/Parse.pod \
lib/Mail/IMAPClient/MessageSet.pm \
lib/Mail/IMAPClient/Thread.grammar \
lib/Mail/IMAPClient/Thread.pm \
lib/Mail/IMAPClient/Thread.pod
PM_TO_BLIB = lib/Mail/IMAPClient/BodyStructure/Parse.pm \
blib/lib/Mail/IMAPClient/BodyStructure/Parse.pm \
lib/Mail/IMAPClient/Thread.pm \
blib/lib/Mail/IMAPClient/Thread.pm \
lib/Mail/IMAPClient/BodyStructure/Parse.grammar \
blib/lib/Mail/IMAPClient/BodyStructure/Parse.grammar \
lib/Mail/IMAPClient.pod \
blib/lib/Mail/IMAPClient.pod \
lib/Mail/IMAPClient/Thread.pod \
blib/lib/Mail/IMAPClient/Thread.pod \
lib/Mail/IMAPClient/MessageSet.pm \
blib/lib/Mail/IMAPClient/MessageSet.pm \
lib/Mail/IMAPClient/BodyStructure.pm \
blib/lib/Mail/IMAPClient/BodyStructure.pm \
lib/Mail/IMAPClient/Thread.grammar \
blib/lib/Mail/IMAPClient/Thread.grammar \
lib/Mail/IMAPClient/BodyStructure/Parse.pod \
blib/lib/Mail/IMAPClient/BodyStructure/Parse.pod \
lib/Mail/IMAPClient.pm \
blib/lib/Mail/IMAPClient.pm
# --- MakeMaker platform_constants section:
MM_Unix_VERSION = 1.50_01
PERL_MALLOC_DEF = -DPERL_EXTMALLOC_DEF -Dmalloc=Perl_malloc -Dfree=Perl_mfree -Drealloc=Perl_realloc -Dcalloc=Perl_calloc
# --- MakeMaker tool_autosplit section:
# Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto
AUTOSPLITFILE = $(ABSPERLRUN) -e 'use AutoSplit; autosplit($$ARGV[0], $$ARGV[1], 0, 1, 1)'
# --- MakeMaker tool_xsubpp section:
# --- MakeMaker tools_other section:
SHELL = /bin/sh
CHMOD = chmod
CP = cp
MV = mv
NOOP = $(SHELL) -c true
NOECHO = @
RM_F = rm -f
RM_RF = rm -rf
TEST_F = test -f
TOUCH = touch
UMASK_NULL = umask 0
DEV_NULL = > /dev/null 2>&1
MKPATH = $(ABSPERLRUN) "-MExtUtils::Command" -e mkpath
EQUALIZE_TIMESTAMP = $(ABSPERLRUN) "-MExtUtils::Command" -e eqtime
ECHO = echo
ECHO_N = echo -n
UNINST = 0
VERBINST = 0
MOD_INSTALL = $(ABSPERLRUN) -MExtUtils::Install -e 'install({@ARGV}, '\''$(VERBINST)'\'', 0, '\''$(UNINST)'\'');'
DOC_INSTALL = $(ABSPERLRUN) "-MExtUtils::Command::MM" -e perllocal_install
UNINSTALL = $(ABSPERLRUN) "-MExtUtils::Command::MM" -e uninstall
WARN_IF_OLD_PACKLIST = $(ABSPERLRUN) "-MExtUtils::Command::MM" -e warn_if_old_packlist
MACROSTART =
MACROEND =
USEMAKEFILE = -f
FIXIN = $(PERLRUN) "-MExtUtils::MY" -e "MY->fixin(shift)"
# --- MakeMaker makemakerdflt section:
makemakerdflt: all
$(NOECHO) $(NOOP)
# --- MakeMaker dist section:
TAR = tar
TARFLAGS = cvf
ZIP = zip
ZIPFLAGS = -r
COMPRESS = gzip --best
SUFFIX = .gz
SHAR = shar
PREOP = $(NOECHO) $(NOOP)
POSTOP = $(NOECHO) $(NOOP)
TO_UNIX = $(NOECHO) $(NOOP)
CI = ci -u
RCS_LABEL = rcs -Nv$(VERSION_SYM): -q
DIST_CP = best
DIST_DEFAULT = tardist
DISTNAME = Mail-IMAPClient
DISTVNAME = Mail-IMAPClient-2.99_02
# --- MakeMaker macro section:
# --- MakeMaker depend section:
# --- MakeMaker cflags section:
# --- MakeMaker const_loadlibs section:
# --- MakeMaker const_cccmd section:
# --- MakeMaker post_constants section:
# --- MakeMaker pasthru section:
PASTHRU = LIBPERL_A="$(LIBPERL_A)"\
LINKTYPE="$(LINKTYPE)"\
PREFIX="$(PREFIX)"
# --- MakeMaker special_targets section:
.SUFFIXES : .xs .c .C .cpp .i .s .cxx .cc $(OBJ_EXT)
.PHONY: all config static dynamic test linkext manifest blibdirs clean realclean disttest distdir
# --- MakeMaker c_o section:
# --- MakeMaker xs_c section:
# --- MakeMaker xs_o section:
# --- MakeMaker top_targets section:
all :: pure_all manifypods
$(NOECHO) $(NOOP)
pure_all :: config pm_to_blib subdirs linkext
$(NOECHO) $(NOOP)
subdirs :: $(MYEXTLIB)
$(NOECHO) $(NOOP)
config :: $(FIRST_MAKEFILE) blibdirs
$(NOECHO) $(NOOP)
help :
perldoc ExtUtils::MakeMaker
# --- MakeMaker blibdirs section:
blibdirs : $(INST_LIBDIR)$(DFSEP).exists $(INST_ARCHLIB)$(DFSEP).exists $(INST_AUTODIR)$(DFSEP).exists $(INST_ARCHAUTODIR)$(DFSEP).exists $(INST_BIN)$(DFSEP).exists $(INST_SCRIPT)$(DFSEP).exists $(INST_MAN1DIR)$(DFSEP).exists $(INST_MAN3DIR)$(DFSEP).exists
$(NOECHO) $(NOOP)
# Backwards compat with 6.18 through 6.25
blibdirs.ts : blibdirs
$(NOECHO) $(NOOP)
$(INST_LIBDIR)$(DFSEP).exists :: Makefile.PL
$(NOECHO) $(MKPATH) $(INST_LIBDIR)
$(NOECHO) $(CHMOD) 755 $(INST_LIBDIR)
$(NOECHO) $(TOUCH) $(INST_LIBDIR)$(DFSEP).exists
$(INST_ARCHLIB)$(DFSEP).exists :: Makefile.PL
$(NOECHO) $(MKPATH) $(INST_ARCHLIB)
$(NOECHO) $(CHMOD) 755 $(INST_ARCHLIB)
$(NOECHO) $(TOUCH) $(INST_ARCHLIB)$(DFSEP).exists
$(INST_AUTODIR)$(DFSEP).exists :: Makefile.PL
$(NOECHO) $(MKPATH) $(INST_AUTODIR)
$(NOECHO) $(CHMOD) 755 $(INST_AUTODIR)
$(NOECHO) $(TOUCH) $(INST_AUTODIR)$(DFSEP).exists
$(INST_ARCHAUTODIR)$(DFSEP).exists :: Makefile.PL
$(NOECHO) $(MKPATH) $(INST_ARCHAUTODIR)
$(NOECHO) $(CHMOD) 755 $(INST_ARCHAUTODIR)
$(NOECHO) $(TOUCH) $(INST_ARCHAUTODIR)$(DFSEP).exists
$(INST_BIN)$(DFSEP).exists :: Makefile.PL
$(NOECHO) $(MKPATH) $(INST_BIN)
$(NOECHO) $(CHMOD) 755 $(INST_BIN)
$(NOECHO) $(TOUCH) $(INST_BIN)$(DFSEP).exists
$(INST_SCRIPT)$(DFSEP).exists :: Makefile.PL
$(NOECHO) $(MKPATH) $(INST_SCRIPT)
$(NOECHO) $(CHMOD) 755 $(INST_SCRIPT)
$(NOECHO) $(TOUCH) $(INST_SCRIPT)$(DFSEP).exists
$(INST_MAN1DIR)$(DFSEP).exists :: Makefile.PL
$(NOECHO) $(MKPATH) $(INST_MAN1DIR)
$(NOECHO) $(CHMOD) 755 $(INST_MAN1DIR)
$(NOECHO) $(TOUCH) $(INST_MAN1DIR)$(DFSEP).exists
$(INST_MAN3DIR)$(DFSEP).exists :: Makefile.PL
$(NOECHO) $(MKPATH) $(INST_MAN3DIR)
$(NOECHO) $(CHMOD) 755 $(INST_MAN3DIR)
$(NOECHO) $(TOUCH) $(INST_MAN3DIR)$(DFSEP).exists
# --- MakeMaker linkext section:
linkext :: $(LINKTYPE)
$(NOECHO) $(NOOP)
# --- MakeMaker dlsyms section:
# --- MakeMaker dynamic section:
dynamic :: $(FIRST_MAKEFILE) $(INST_DYNAMIC) $(INST_BOOT)
$(NOECHO) $(NOOP)
# --- MakeMaker dynamic_bs section:
BOOTSTRAP =
# --- MakeMaker dynamic_lib section:
# --- MakeMaker static section:
## $(INST_PM) has been moved to the all: target.
## It remains here for awhile to allow for old usage: "make static"
static :: $(FIRST_MAKEFILE) $(INST_STATIC)
$(NOECHO) $(NOOP)
# --- MakeMaker static_lib section:
# --- MakeMaker manifypods section:
POD2MAN_EXE = $(PERLRUN) "-MExtUtils::Command::MM" -e pod2man "--"
POD2MAN = $(POD2MAN_EXE)
manifypods : pure_all \
lib/Mail/IMAPClient/Thread.pod \
lib/Mail/IMAPClient/MessageSet.pm \
lib/Mail/IMAPClient/BodyStructure.pm \
lib/Mail/IMAPClient/BodyStructure/Parse.pod \
lib/Mail/IMAPClient.pod \
lib/Mail/IMAPClient/Thread.pod \
lib/Mail/IMAPClient/MessageSet.pm \
lib/Mail/IMAPClient/BodyStructure.pm \
lib/Mail/IMAPClient/BodyStructure/Parse.pod \
lib/Mail/IMAPClient.pod
$(NOECHO) $(POD2MAN) --section=$(MAN3EXT) --perm_rw=$(PERM_RW) \
lib/Mail/IMAPClient/Thread.pod $(INST_MAN3DIR)/Mail::IMAPClient::Thread.$(MAN3EXT) \
lib/Mail/IMAPClient/MessageSet.pm $(INST_MAN3DIR)/Mail::IMAPClient::MessageSet.$(MAN3EXT) \
lib/Mail/IMAPClient/BodyStructure.pm $(INST_MAN3DIR)/Mail::IMAPClient::BodyStructure.$(MAN3EXT) \
lib/Mail/IMAPClient/BodyStructure/Parse.pod $(INST_MAN3DIR)/Mail::IMAPClient::BodyStructure::Parse.$(MAN3EXT) \
lib/Mail/IMAPClient.pod $(INST_MAN3DIR)/Mail::IMAPClient.$(MAN3EXT)
# --- MakeMaker processPL section:
# --- MakeMaker installbin section:
# --- MakeMaker subdirs section:
# none
# --- MakeMaker clean_subdirs section:
clean_subdirs :
$(NOECHO) $(NOOP)
# --- MakeMaker clean section:
# Delete temporary files but do not touch installed files. We don't delete
# the Makefile here so a later make realclean still has a makefile to use.
clean :: clean_subdirs
- $(RM_F) \
*$(LIB_EXT) core \
core.[0-9] $(INST_ARCHAUTODIR)/extralibs.all \
core.[0-9][0-9] $(BASEEXT).bso \
pm_to_blib.ts core.[0-9][0-9][0-9][0-9] \
$(BASEEXT).x $(BOOTSTRAP) \
perl$(EXE_EXT) tmon.out \
*$(OBJ_EXT) pm_to_blib \
$(INST_ARCHAUTODIR)/extralibs.ld blibdirs.ts \
core.[0-9][0-9][0-9][0-9][0-9] *perl.core \
core.*perl.*.? $(MAKE_APERL_FILE) \
perl $(BASEEXT).def \
core.[0-9][0-9][0-9] mon.out \
lib$(BASEEXT).def perlmain.c \
perl.exe so_locations \
$(BASEEXT).exp
- $(RM_RF) \
test.txt blib
- $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD) $(DEV_NULL)
# --- MakeMaker realclean_subdirs section:
realclean_subdirs :
$(NOECHO) $(NOOP)
# --- MakeMaker realclean section:
# Delete temporary files (via clean) and also delete dist files
realclean purge :: clean realclean_subdirs
- $(RM_F) \
$(MAKEFILE_OLD) $(FIRST_MAKEFILE)
- $(RM_RF) \
$(DISTVNAME)
# --- MakeMaker metafile section:
metafile : create_distdir
$(NOECHO) $(ECHO) Generating META.yml
$(NOECHO) $(ECHO) '# http://module-build.sourceforge.net/META-spec.html' > META_new.yml
$(NOECHO) $(ECHO) '#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#' >> META_new.yml
$(NOECHO) $(ECHO) 'name: Mail-IMAPClient' >> META_new.yml
$(NOECHO) $(ECHO) 'version: 2.99_02' >> META_new.yml
$(NOECHO) $(ECHO) 'version_from: lib/Mail/IMAPClient.pm' >> META_new.yml
$(NOECHO) $(ECHO) 'installdirs: site' >> META_new.yml
$(NOECHO) $(ECHO) 'requires:' >> META_new.yml
$(NOECHO) $(ECHO) ' Carp: 0' >> META_new.yml
$(NOECHO) $(ECHO) ' Data::Dumper: 0' >> META_new.yml
$(NOECHO) $(ECHO) ' Digest::HMAC_MD5: 0' >> META_new.yml
$(NOECHO) $(ECHO) ' Errno: 0' >> META_new.yml
$(NOECHO) $(ECHO) ' Fcntl: 0' >> META_new.yml
$(NOECHO) $(ECHO) ' File::Temp: 0.18' >> META_new.yml
$(NOECHO) $(ECHO) ' IO::File: 0' >> META_new.yml
$(NOECHO) $(ECHO) ' IO::Select: 0' >> META_new.yml
$(NOECHO) $(ECHO) ' IO::Socket: 0' >> META_new.yml
$(NOECHO) $(ECHO) ' IO::Socket::INET: 1.26' >> META_new.yml
$(NOECHO) $(ECHO) ' MIME::Base64: 0' >> META_new.yml
$(NOECHO) $(ECHO) ' Parse::RecDescent: 1.94' >> META_new.yml
$(NOECHO) $(ECHO) ' Test::More: 0' >> META_new.yml
$(NOECHO) $(ECHO) ' Test::Pod: 0' >> META_new.yml
$(NOECHO) $(ECHO) '' >> META_new.yml
$(NOECHO) $(ECHO) 'distribution_type: module' >> META_new.yml
$(NOECHO) $(ECHO) 'generated_by: ExtUtils::MakeMaker version 6.30_01' >> META_new.yml
-$(NOECHO) $(MV) META_new.yml $(DISTVNAME)/META.yml
# --- MakeMaker signature section:
signature :
cpansign -s
# --- MakeMaker dist_basics section:
distclean :: realclean distcheck
$(NOECHO) $(NOOP)
distcheck :
$(PERLRUN) "-MExtUtils::Manifest=fullcheck" -e fullcheck
skipcheck :
$(PERLRUN) "-MExtUtils::Manifest=skipcheck" -e skipcheck
manifest :
$(PERLRUN) "-MExtUtils::Manifest=mkmanifest" -e mkmanifest
veryclean : realclean
$(RM_F) *~ *.orig */*~ */*.orig
# --- MakeMaker dist_core section:
dist : $(DIST_DEFAULT) $(FIRST_MAKEFILE)
$(NOECHO) $(ABSPERLRUN) -l -e 'print '\''Warning: Makefile possibly out of date with $(VERSION_FROM)'\''' \
-e ' if -e '\''$(VERSION_FROM)'\'' and -M '\''$(VERSION_FROM)'\'' < -M '\''$(FIRST_MAKEFILE)'\'';'
tardist : $(DISTVNAME).tar$(SUFFIX)
$(NOECHO) $(NOOP)
uutardist : $(DISTVNAME).tar$(SUFFIX)
uuencode $(DISTVNAME).tar$(SUFFIX) $(DISTVNAME).tar$(SUFFIX) > $(DISTVNAME).tar$(SUFFIX)_uu
$(DISTVNAME).tar$(SUFFIX) : distdir
$(PREOP)
$(TO_UNIX)
$(TAR) $(TARFLAGS) $(DISTVNAME).tar $(DISTVNAME)
$(RM_RF) $(DISTVNAME)
$(COMPRESS) $(DISTVNAME).tar
$(POSTOP)
zipdist : $(DISTVNAME).zip
$(NOECHO) $(NOOP)
$(DISTVNAME).zip : distdir
$(PREOP)
$(ZIP) $(ZIPFLAGS) $(DISTVNAME).zip $(DISTVNAME)
$(RM_RF) $(DISTVNAME)
$(POSTOP)
shdist : distdir
$(PREOP)
$(SHAR) $(DISTVNAME) > $(DISTVNAME).shar
$(RM_RF) $(DISTVNAME)
$(POSTOP)
# --- MakeMaker distdir section:
create_distdir :
$(RM_RF) $(DISTVNAME)
$(PERLRUN) "-MExtUtils::Manifest=manicopy,maniread" \
-e "manicopy(maniread(),'$(DISTVNAME)', '$(DIST_CP)');"
distdir : create_distdir distmeta
$(NOECHO) $(NOOP)
# --- MakeMaker dist_test section:
disttest : distdir
cd $(DISTVNAME) && $(ABSPERLRUN) Makefile.PL
cd $(DISTVNAME) && $(MAKE) $(PASTHRU)
cd $(DISTVNAME) && $(MAKE) test $(PASTHRU)
# --- MakeMaker dist_ci section:
ci :
$(PERLRUN) "-MExtUtils::Manifest=maniread" \
-e "@all = keys %{ maniread() };" \
-e "print(qq{Executing $(CI) @all\n}); system(qq{$(CI) @all});" \
-e "print(qq{Executing $(RCS_LABEL) ...\n}); system(qq{$(RCS_LABEL) @all});"
# --- MakeMaker distmeta section:
distmeta : create_distdir metafile
$(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'eval { maniadd({q{META.yml} => q{Module meta-data (added by MakeMaker)}}) } ' \
-e ' or print "Could not add META.yml to MANIFEST: $${'\''@'\''}\n"'
# --- MakeMaker distsignature section:
distsignature : create_distdir
$(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'eval { maniadd({q{SIGNATURE} => q{Public-key signature (added by MakeMaker)}}) } ' \
-e ' or print "Could not add SIGNATURE to MANIFEST: $${'\''@'\''}\n"'
$(NOECHO) cd $(DISTVNAME) && $(TOUCH) SIGNATURE
cd $(DISTVNAME) && cpansign -s
# --- MakeMaker install section:
install :: all pure_install doc_install
$(NOECHO) $(NOOP)
install_perl :: all pure_perl_install doc_perl_install
$(NOECHO) $(NOOP)
install_site :: all pure_site_install doc_site_install
$(NOECHO) $(NOOP)
install_vendor :: all pure_vendor_install doc_vendor_install
$(NOECHO) $(NOOP)
pure_install :: pure_$(INSTALLDIRS)_install
$(NOECHO) $(NOOP)
doc_install :: doc_$(INSTALLDIRS)_install
$(NOECHO) $(NOOP)
pure__install : pure_site_install
$(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
doc__install : doc_site_install
$(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
pure_perl_install ::
$(NOECHO) umask 022; $(MOD_INSTALL) \
$(INST_LIB) $(DESTINSTALLPRIVLIB) \
$(INST_ARCHLIB) $(DESTINSTALLARCHLIB) \
$(INST_BIN) $(DESTINSTALLBIN) \
$(INST_SCRIPT) $(DESTINSTALLSCRIPT) \
$(INST_MAN1DIR) $(DESTINSTALLMAN1DIR) \
$(INST_MAN3DIR) $(DESTINSTALLMAN3DIR)
$(NOECHO) $(WARN_IF_OLD_PACKLIST) \
$(SITEARCHEXP)/auto/$(FULLEXT)
pure_site_install ::
$(NOECHO) umask 02; $(MOD_INSTALL) \
read $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist \
write $(DESTINSTALLSITEARCH)/auto/$(FULLEXT)/.packlist \
$(INST_LIB) $(DESTINSTALLSITELIB) \
$(INST_ARCHLIB) $(DESTINSTALLSITEARCH) \
$(INST_BIN) $(DESTINSTALLSITEBIN) \
$(INST_SCRIPT) $(DESTINSTALLSITESCRIPT) \
$(INST_MAN1DIR) $(DESTINSTALLSITEMAN1DIR) \
$(INST_MAN3DIR) $(DESTINSTALLSITEMAN3DIR)
$(NOECHO) $(WARN_IF_OLD_PACKLIST) \
$(PERL_ARCHLIB)/auto/$(FULLEXT)
pure_vendor_install ::
$(NOECHO) umask 022; $(MOD_INSTALL) \
$(INST_LIB) $(DESTINSTALLVENDORLIB) \
$(INST_ARCHLIB) $(DESTINSTALLVENDORARCH) \
$(INST_BIN) $(DESTINSTALLVENDORBIN) \
$(INST_SCRIPT) $(DESTINSTALLVENDORSCRIPT) \
$(INST_MAN1DIR) $(DESTINSTALLVENDORMAN1DIR) \
$(INST_MAN3DIR) $(DESTINSTALLVENDORMAN3DIR)
doc_perl_install ::
doc_site_install ::
$(NOECHO) $(ECHO) Appending installation info to $(DESTINSTALLSITEARCH)/perllocal.pod
-$(NOECHO) umask 02; $(MKPATH) $(DESTINSTALLSITEARCH)
-$(NOECHO) umask 02; $(DOC_INSTALL) \
"Module" "$(NAME)" \
"installed into" "$(INSTALLSITELIB)" \
LINKTYPE "$(LINKTYPE)" \
VERSION "$(VERSION)" \
EXE_FILES "$(EXE_FILES)" \
>> $(DESTINSTALLSITEARCH)/perllocal.pod
doc_vendor_install ::
uninstall :: uninstall_from_$(INSTALLDIRS)dirs
$(NOECHO) $(NOOP)
uninstall_from_perldirs ::
uninstall_from_sitedirs ::
$(NOECHO) $(UNINSTALL) $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist
uninstall_from_vendordirs ::
# --- MakeMaker force section:
# Phony target to force checking subdirectories.
FORCE:
$(NOECHO) $(NOOP)
# --- MakeMaker perldepend section:
# --- MakeMaker makefile section:
# We take a very conservative approach here, but it's worth it.
# We move Makefile to Makefile.old here to avoid gnu make looping.
$(FIRST_MAKEFILE) : Makefile.PL $(CONFIGDEP)
$(NOECHO) $(ECHO) "Makefile out-of-date with respect to $?"
$(NOECHO) $(ECHO) "Cleaning current config before rebuilding Makefile..."
-$(NOECHO) $(RM_F) $(MAKEFILE_OLD)
-$(NOECHO) $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD)
- $(MAKE) $(USEMAKEFILE) $(MAKEFILE_OLD) clean $(DEV_NULL)
$(PERLRUN) Makefile.PL
$(NOECHO) $(ECHO) "==> Your Makefile has been rebuilt. <=="
$(NOECHO) $(ECHO) "==> Please rerun the $(MAKE) command. <=="
false
# --- MakeMaker staticmake section:
# --- MakeMaker makeaperl section ---
MAP_TARGET = perl
FULLPERL = /usr/bin/perl
$(MAP_TARGET) :: static $(MAKE_APERL_FILE)
$(MAKE) $(USEMAKEFILE) $(MAKE_APERL_FILE) $@
$(MAKE_APERL_FILE) : $(FIRST_MAKEFILE) pm_to_blib
$(NOECHO) $(ECHO) Writing \"$(MAKE_APERL_FILE)\" for this $(MAP_TARGET)
$(NOECHO) $(PERLRUNINST) \
Makefile.PL DIR= \
MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \
MAKEAPERL=1 NORECURS=1 CCCDLFLAGS=
# --- MakeMaker test section:
TEST_VERBOSE=0
TEST_TYPE=test_$(LINKTYPE)
TEST_FILE = test.pl
TEST_FILES = t/*.t
TESTDB_SW = -d
testdb :: testdb_$(LINKTYPE)
test :: $(TEST_TYPE)
test_dynamic :: pure_all
PERL_DL_NONLAZY=1 $(FULLPERLRUN) "-MExtUtils::Command::MM" "-e" "test_harness($(TEST_VERBOSE), '$(INST_LIB)', '$(INST_ARCHLIB)')" $(TEST_FILES)
testdb_dynamic :: pure_all
PERL_DL_NONLAZY=1 $(FULLPERLRUN) $(TESTDB_SW) "-I$(INST_LIB)" "-I$(INST_ARCHLIB)" $(TEST_FILE)
test_ : test_dynamic
test_static :: test_dynamic
testdb_static :: testdb_dynamic
# --- MakeMaker ppd section:
# Creates a PPD (Perl Package Description) for a binary distribution.
ppd:
$(NOECHO) $(ECHO) '<SOFTPKG NAME="$(DISTNAME)" VERSION="2,99_02,0,0">' > $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' <TITLE>$(DISTNAME)</TITLE>' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' <ABSTRACT>IMAP4 client library</ABSTRACT>' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' <AUTHOR></AUTHOR>' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' <IMPLEMENTATION>' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' <DEPENDENCY NAME="Carp" VERSION="0,0,0,0" />' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' <DEPENDENCY NAME="Data-Dumper" VERSION="0,0,0,0" />' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' <DEPENDENCY NAME="Digest-HMAC_MD5" VERSION="0,0,0,0" />' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' <DEPENDENCY NAME="Errno" VERSION="0,0,0,0" />' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' <DEPENDENCY NAME="Fcntl" VERSION="0,0,0,0" />' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' <DEPENDENCY NAME="File-Temp" VERSION="0,18,0,0" />' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' <DEPENDENCY NAME="IO-File" VERSION="0,0,0,0" />' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' <DEPENDENCY NAME="IO-Select" VERSION="0,0,0,0" />' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' <DEPENDENCY NAME="IO-Socket" VERSION="0,0,0,0" />' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' <DEPENDENCY NAME="IO-Socket-INET" VERSION="1,26,0,0" />' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' <DEPENDENCY NAME="MIME-Base64" VERSION="0,0,0,0" />' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' <DEPENDENCY NAME="Parse-RecDescent" VERSION="1,94,0,0" />' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' <DEPENDENCY NAME="Test-More" VERSION="0,0,0,0" />' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' <DEPENDENCY NAME="Test-Pod" VERSION="0,0,0,0" />' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' <OS NAME="$(OSNAME)" />' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' <ARCHITECTURE NAME="i486-linux-gnu-thread-multi" />' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' <CODEBASE HREF="" />' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' </IMPLEMENTATION>' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) '</SOFTPKG>' >> $(DISTNAME).ppd
# --- MakeMaker pm_to_blib section:
pm_to_blib : $(TO_INST_PM)
$(NOECHO) $(ABSPERLRUN) -MExtUtils::Install -e 'pm_to_blib({@ARGV}, '\''$(INST_LIB)/auto'\'', '\''$(PM_FILTER)'\'')' \
lib/Mail/IMAPClient/BodyStructure/Parse.pm blib/lib/Mail/IMAPClient/BodyStructure/Parse.pm \
lib/Mail/IMAPClient/Thread.pm blib/lib/Mail/IMAPClient/Thread.pm \
lib/Mail/IMAPClient/BodyStructure/Parse.grammar blib/lib/Mail/IMAPClient/BodyStructure/Parse.grammar \
lib/Mail/IMAPClient.pod blib/lib/Mail/IMAPClient.pod \
lib/Mail/IMAPClient/Thread.pod blib/lib/Mail/IMAPClient/Thread.pod \
lib/Mail/IMAPClient/MessageSet.pm blib/lib/Mail/IMAPClient/MessageSet.pm \
lib/Mail/IMAPClient/BodyStructure.pm blib/lib/Mail/IMAPClient/BodyStructure.pm \
lib/Mail/IMAPClient/Thread.grammar blib/lib/Mail/IMAPClient/Thread.grammar \
lib/Mail/IMAPClient/BodyStructure/Parse.pod blib/lib/Mail/IMAPClient/BodyStructure/Parse.pod \
lib/Mail/IMAPClient.pm blib/lib/Mail/IMAPClient.pm
$(NOECHO) $(TOUCH) pm_to_blib
# --- MakeMaker selfdocument section:
# --- MakeMaker postamble section:
# End.

110
Mail-IMAPClient-2.99_02/Makefile.PL Normal file
View file

@ -0,0 +1,110 @@
use ExtUtils::MakeMaker;
use warnings;
use strict;
eval "require Parse::RecDescent";
$@ and warn <<'__NO_BODY';
*** NOTE ***
Unable to find and load Parse::RecDescent.
Mail::IMAPClient will be installed without support for the
get_bodystructure() method.
__NO_BODY
WriteMakefile
( NAME => 'Mail::IMAPClient',
, ABSTRACT => 'IMAP4 client library'
, VERSION_FROM => 'lib/Mail/IMAPClient.pm'
, PREREQ_PM =>
{ 'Errno' => 0
, 'IO::Socket' => 0
, 'Fcntl' => 0
, 'IO::Select' => 0
, 'IO::File' => 0
, 'Data::Dumper' => 0
, 'Carp' => 0
, 'IO::Socket::INET' => 1.26
, 'Parse::RecDescent' => 1.94
, 'Digest::HMAC_MD5' => 0
, 'MIME::Base64' => 0
, 'Test::More' => 0
, 'File::Temp' => 0.18
, 'Test::Pod' => 0
}
, clean => { FILES => 'test.txt' }
);
set_test_data();
sub set_test_data {
unless(-f "lib/Mail/IMAPClient.pm")
{ warn "ERROR: not in installation directory\n";
return;
}
return if -f "./test.txt";
print <<'__INTRO';
You have the option of running an extended suite of tests during
'make test'. This requires an IMAP server name, user account, and
password to test with.
__INTRO
my $yes = prompt "Do you want to run the extended tests? (n/y)";
return if $yes !~ /^[Yy](?:[Ee]:[Ss]?)?$/ ;
unless(open TST,">./test.txt")
{ warn "ERROR: couldn't open ./test.txt: $!\n";
return;
}
my $server = "";
until($server)
{ $server = prompt "\nPlease provide the hostname or IP address of "
. "a host running an\nIMAP server (or QUIT to skip "
. "the extended tests)";
chomp $server;
return if $server =~ /^\s*quit\s*$/i ;
}
print TST "server=$server\n";
my $user = "";
until($user)
{ $user = prompt "\nProvide the username of an account on $server (or QUIT)";
chomp $user;
return if $user =~ /^\s*quit\s*$/i ;
}
print TST "user=$user\n";
my $passed = "";
until($passed)
{ $passed = prompt "\nProvide the password for $user (or QUIT)";
chomp $passed;
return if $passed =~ /^\s+$|^quit$/i ;
}
print TST "passed=$passed\n";
my $port = prompt "\nPlease provide the port to connect to on $server"
. "to run the test\n(default is 143)";
chomp $port;
$port ||= 143;
print TST "port=$port\n";
my $authmech = prompt "\nProvide the authentication mechanism to use "
. "on $server to\nrun the test (default is 'LOGIN', "
. "which uses the plain text LOGIN command)";
chomp $authmech;
$authmech ||= 'LOGIN';
print TST "authmechanism=$authmech\n";
close TST;
print <<'__THANKS';
Gracias! The information you provided (including the password!) has
been stored in test.txt and should be removed (either by hand or by
'make clean') after testing.
__THANKS
}

147
Mail-IMAPClient-2.99_02/README Normal file
View file

@ -0,0 +1,147 @@
Mail::IMAPClient
Copyright 1999-2003 The Kernen Group, Inc.
Copyright 2007 Mark Overmeer
All rights reserved.
This program is free software; you can redistribute it and/or modify
it under the terms of either:
a) the "Artistic License" which comes with this Kit, or
b) the GNU General Public License as published by the Free Software
Foundation; either version 1, or (at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either
the GNU General Public License or the Artistic License for more details.
DESCRIPTION
This module provides perl routines that simplify a sockets connection
to and an IMAP conversation with an IMAP server.
COMPATIBILITY
This module was developed on Solaris 2.5.1 and 2.6 against Netscape IMAP
servers versions 3.6 and 4.1. However, since it is written in perl and
designed for flexibility, it should run on any OS with a TCP/IP stack and
a version of perl that includes the Socket and IO::Socket modules. It also
should be able to talk to any IMAP server, even those that have, um,
proprietary features (assuming that the programmer knows what those features
are).
To date, I know that the test suite runs successfully with the following IMAP
servers:
-Netscape Messenging Server v4.x
-Netscape Messenging Server v3.x
-UW-IMAP (I think it was 4.5)
-Cyrus IMAP4 v1.5.19
-Mirapoint Message Server Appliances (OS versions 1.6.1, 1.7.1, and 2.0.2)
I also know that it has some problems running against the InterMail
server vM.4.001.02.00 (and probably other versions of InterMail as well).
Version 2.0.3 has been tested with the mdaemon server with mixed
results. It seems that mdaemon does not comply strictly with RFC2060 and
so you may have problems using this module with mdaemon, especially with
folder names with embedded spaces or embedded double quotes. You may be
able to get some simple tasks to work but you won't be able to run the
test suite successfully. Use with caution.
If your server requires the use of the AUTHENTICATE IMAP client command
(say, for strong authentication) then you can still use this module,
provided you can come up with the appropriate responses to any challenges
offered by your server. Mark Bush's Authen::NTLM module can assist with
this if you specifically are interested in NTLM authentication.
DEPENDENCIES
The Mail::IMAPClient module uses the IO::Socket module to make a socket
connection to an IMAP server and the Socket module to get some constants.
It also uses Errno, Fcntl (for faster I/O) and IO::Select, IO::File,
Data::Dumper, and Carp.
You can verify that your system has a sufficient perl installation by
entering on the command line:
perl -e "use constant; use Socket; use IO::Socket; use IO::File; \
use IO::Select; use Fcntl; use Errno; use Carp; use Data::Dumper;"
If you get compile errors then you'll have trouble using Mail::IMAPClient.
If you need to use the bodystructure helper module
Mail::IMAPClient::BodyStructure then you also need Parse::RecDescent. Try
this on the command line:
perl -e "use Parse::RecDescent;"
If you get compile errors then you will not be able to use the
Mail::IMAPClient::BodyStructure module (or the get_bodystructure method
in Mail::IMAPClient). You will also get errors when you run 'make test'
in t/bodystructure and/or t/parse. If these tests fail you can still
use Mail::IMAPClient safely (assuming the other tests passed!) but
you will not be able to use Mail::IMAPClient::BodyStructure or the
get_bodystructure method in Mail::IMAPClient.
(Note that as of version 2.2.0 the above is somewhat obsolete, since
Makefile.PL will detect whether or not you have Parse::RecDescent and
will either choose to or decline to install the ::BodyStructure stuff
accordingly.)
REPORING BUGS
See http://rt.cpan.org/Public/Dist/Display.html?Name=Mail-IMAPClient
INSTALLATION
Generally, gunzipping and untarring the source file, running 'perl
Makefile.PL' and 'make install' are all it takes to install this
module. And if that's too much work you can always use the CPAN module!
OVERVIEW OF FUNCTIONALITY
Mail::IMAPClient.pm provides methods to simplify the connection to and
the conversation between a perl script and an IMAP server. Virtually
all IMAP Client commands (as defined in rfc2060) are supported, either
through IMAPClient object methods or the 'default method', which is an
AUTOLOAD hack that assumes a default syntax for IMAP Client commands of:
tagvalue COMMAND [Arg1 [Arg2 [... Arg3]]]"
By remarkable coincidence, AUTOLOAD's default syntax mimics the
general syntax of IMAP Client commands. This means that if a script
tries to use any undefined method then that method will be interpreted
as an unimplemented IMAP command, and the default syntax will be used
to create the command string. I did this as a short cut to writing a
bunch of methods that were practically the same. There are inheritance
implications because of this approach but as far as I can tell this is
not a serious limitation. However, if you decide to write modules that
inherit from this class that require AUTOLOAD logic of their own then you
will have to take the Mail::IMAPClient's AUTOLOAD strategy into account.
Where methods are defined, they usually exist to add functionality,
perhaps by massaging output or by supplying default arguments. An example
is the search method, which accepts the same arguments as the SEARCH
IMAP Client command (as documented in RFC2060) but which massages the
results so that the return value is an array of message sequence numbers
matching the search criteria, rather than a line of text listing the
sequence numbers.
Some methods exists solely to add functionality, such as the folders
method, which invokes the list method but then massages the results to
produce an array containing all folder names. The message_count and
delete_messsage methods are similarly examples of methods that add
function to "raw" IMAP Client commands.
Further information is provided in the module's documentation, which you are
encouraged to read and enjoy.
Good Luck!
Dave Kernen
The Kernen Group, Inc.
DJKERNEN@cpan.org

65
Mail-IMAPClient-2.99_02/Todo Normal file
View file

@ -0,0 +1,65 @@
Starting with release 2.99_01, I (Mark Overmeer) try to revive the
module. The original author David Kernen cannot be reached and didn't
release any fixes in four years. That is too long.
In version 3.0, the installation procedure is been cleaned-up
radically, and some minimal improvements in the code are made to
fix things people reported.
=== wishlist:
- A start was made in cleanup of the code in Mail/IMAPClient.pm
The file Mail/IMAPClient-cleanup shows the progress (30%)
But I lack the time (a weeks work at least) to complete this
task. There is a lot of code replication to be stripped.
If anyone buys me time, I will complete that task.
=== wishlist from the original author:
The following is a list of some items that I hope to include in a future
release:
- Support for threaded perl programs (still pending as of version 2.2.0.).
- Support for imaps (Imap via SSL). I don't have any way to test this
right now but if you get this to work or know someone who has I'd be
really interested in hearing from you.
- Support for more authentication mechanisms. Currently plain
authentication and cram-md5 authentication are supported. I have
DIGEST-MD5 working at the AUTH qop, but haven't incorporated it into
a released version because I'm still trying to get at least the
integrity qop working, and maybe even privacy, but considering how
much trouble I'm having with just the integrity level I wouldn't
hold my breath if I were you ;-).
- Currently a number of IMAP Client commands are implemented using the
'default method', which is an AUTOLOAD hack. I'd like to reduce that
if possible to a bare minimum. (Some are still pending as of version 2.2.7.)
- I'd like to see this module certified for more OS's and more IMAP servers.
This is (hopefully) just a matter of testing; the code should already
be compatible with the IMAP servers that are out there and with any OS
that allows the IO::Socket module to work. ** A number of platforms
have been added to the list of tested platforms since this was first
written. Please contact DJKernen@cpan.org if you have any to add.
- Support for newer/older/other versions of IMAP. Currently only RFC2060 is
explicitly supported, although thanks to the 'default method'
(implemented via an AUTOLOAD hack) virtually any IMAP command is
supported, even proprietary commands, X- extensions, and so forth. But
not necessarily other authentication mechanisms... :-( (NOTE: the
AUTHENTICATE method partially addresses this issue.)
- Support for piping output from (some?) imap commands directly to a
thingy of some sort (perhaps a coderef, a filehandle, or both).
- Your thingy here!!! Send me your request, and I'll do it in the order of
($popularity/$difficulty ).
- Support for perl version 6. This will probably involve a rewrite that
will make portions of the Mail::IMAPClient module look more like the
Mail::IMAPClient::BodyStructure module. (Perl 6 will have built-in
support for semantics that look remarkably like Damian Conway's
Parse::RecDescent module, which will solve a lot of problems for me.)

0
Mail-IMAPClient-2.99_02/blib/arch/.exists Normal file
View file

0
Mail-IMAPClient-2.99_02/blib/arch/auto/Mail/IMAPClient/.exists Normal file
View file

0
Mail-IMAPClient-2.99_02/blib/bin/.exists Normal file
View file

0
Mail-IMAPClient-2.99_02/blib/lib/Mail/.exists Normal file
View file

2856
Mail-IMAPClient-2.99_02/blib/lib/Mail/IMAPClient.pm Normal file
View file

File diff suppressed because it is too large Load diff

3746
Mail-IMAPClient-2.99_02/blib/lib/Mail/IMAPClient.pod Normal file
View file

File diff suppressed because it is too large Load diff

661
Mail-IMAPClient-2.99_02/blib/lib/Mail/IMAPClient/BodyStructure.pm Executable file
View file

@ -0,0 +1,661 @@
package Mail::IMAPClient::BodyStructure;
use base 'Exporter';
use Mail::IMAPClient;
use Mail::IMAPClient::BodyStructure::Parse;
our $VERSION = '0.0.3';
our @EXPORT_OK = '$parser';
our $parser = Mail::IMAPClient::BodyStructure::Parse->new()
or die "Cannot parse rules: $@\n"
. "Try remaking Mail::IMAPClient::BodyStructure::Parse.\n";
sub new {
my $class = shift;
my $bodystructure = shift;
my $self = $parser->start($bodystructure) or return undef;
$self->{_prefix} = "";
if ( exists $self->{bodystructure} ) {
$self->{_id} = 'HEAD' ;
} else {
$self->{_id} = 1;
}
$self->{_top} = 1;
bless $self, ref($class)||$class;
}
sub _get_thingy {
my $thingy = shift;
my $object = shift||(ref($thingy)?$thingy:undef);
unless ( defined($object) and ref($object) ) {
$@ = "No argument passed to $thingy method." ;
$^W and print STDERR "$@\n" ;
return undef;
}
unless ( "$object" =~ /HASH/
and exists($object->{$thingy})
) {
$@ = ref($object) .
" $object does not have " .
( $thingy =~ /^[aeiou]/i ? "an " : "a " ) .
"${thingy}. " .
( ref($object) =~ /HASH/ ? "It has " . join(", ",keys(%$object)) : "") ;
$^W and print STDERR "$@\n" ;
return undef;
}
return Unwrapped($object->{$thingy});
}
BEGIN {
foreach my $datum (qw/ bodytype bodysubtype bodyparms bodydisp bodyid
bodydesc bodyenc bodysize bodylang
envelopestruct textlines
/
) {
no strict 'refs';
*$datum = sub { _get_thingy($datum, @_); };
}
}
sub parts {
my $self = shift;
if ( exists $self->{PartsList} ) {
return wantarray ? @{$self->{PartsList}} : $self->{PartsList} ;
}
my @parts = ();
$self->{PartsList} = \@parts;
unless ( exists($self->{bodystructure}) ) {
$self->{PartsIndex}{1} = $self ;
@parts = ("HEAD",1);
return wantarray ? @parts : \@parts;
}
#@parts = ( 1 );
#} else {
foreach my $p ($self->bodystructure()) {
push @parts, $p->id();
$self->{PartsIndex}{$p->id()} = $p ;
if ( uc($p->bodytype()||"") eq "MESSAGE" ) {
#print "Part $parts[-1] is a ",$p->bodytype,"\n";
push @parts,$parts[-1] . ".HEAD";
#} else {
# print "Part $parts[-1] is a ",$p->bodytype,"\n";
}
}
#}
return wantarray ? @parts : \@parts;
}
sub oldbodystructure {
my $self = shift;
if ( exists $self->{_bodyparts} ) {
return wantarray ? @{$self->{_bodyparts}} : $self->{_bodyparts} ;
}
my @bodyparts = ( $self );
$self->{_id} ||= "HEAD"; # aka "0"
my $count = 0;
#print STDERR "Analyzing a ",$self->bodytype, " part which I think is part number ",
# $self->{_id},"\n";
my $dump = Data::Dumper->new( [ $self ] , [ 'bodystructure' ] );
$dump->Indent(1);
foreach my $struct (@{$self->{bodystructure}}) {
$struct->{_prefix} ||= $self->{_prefix} . +$count . "." unless $struct->{_top};
$struct->{_id} ||= $self->{_prefix} . $count unless $struct->{_top};
#if (
# uc($struct->bodytype) eq 'MULTIPART' or
# uc($struct->bodytype) eq 'MESSAGE'
#) {
#} else {
#}
push @bodyparts, $struct,
ref($struct->{bodystructure}) ? $struct->bodystructure : () ;
}
$self->{_bodyparts} = \@bodyparts ;
return wantarray ? @bodyparts : $self->bodyparts ;
}
sub bodystructure {
my $self = shift;
my @parts = ();
my $partno = 0;
my $prefix = $self->{_prefix} || "";
#print STDERR "Analyzing a ",($self->bodytype||"unknown ") ,
# " part which I think is part number ",
# $self->{_id},"\n";
my $bs = $self;
$prefix = "$prefix." if ( $prefix and $prefix !~ /\.$/);
if ( $self->{_top} ) {
$self->{_id} ||= "HEAD";
$self->{_prefix} ||= "HEAD";
$partno = 0;
for (my $x = 0; $x < scalar(@{$self->{bodystructure}}) ; $x++) {
$self->{bodystructure}[$x]{_id} = ++$partno ;
$self->{bodystructure}[$x]{_prefix} = $partno ;
push @parts, $self->{bodystructure}[$x] ,
$self->{bodystructure}[$x]->bodystructure;
}
} else {
$partno = 0;
foreach my $p ( @{$self->{bodystructure}} ) {
$partno++;
if (
! exists $p->{_prefix}
) {
$p->{_prefix} = "$prefix$partno";
}
$p->{_prefix} = "$prefix$partno";
$p->{_id} ||= "$prefix$partno";
#my $bt = $p->bodytype;
#if ($bt eq 'MESSAGE') {
#$p->{_id} = $prefix .
#$partno = 0;
#}
push @parts, $p, $p->{bodystructure} ? $p->bodystructure : ();
}
}
return wantarray ? @parts : \@parts;
}
sub id {
my $self = shift;
return $self->{_id} if exists $self->{_id};
return "HEAD" if $self->{_top};
#if ($self->bodytype eq 'MESSAGE') {
# return
#}
if ($self->{bodytype} eq 'MULTIPART') {
my $p = $self->{_id}||$self->{_prefix} ;
$p =~ s/\.$//;
return $p;
} else {
return $self->{_id} ||= 1;
}
}
sub Unwrapped {
my $unescape = Mail::IMAPClient::Unescape(@_);
$unescape =~ s/^"(.*)"$/$1/ if defined($unescape);
return $unescape;
}
package Mail::IMAPClient::BodyStructure::Part;
@ISA = qw/Mail::IMAPClient::BodyStructure/;
package Mail::IMAPClient::BodyStructure::Envelope;
@ISA = qw/Mail::IMAPClient::BodyStructure/;
sub new {
my $class = shift;
my $envelope = shift;
my $self = $Mail::IMAPClient::BodyStructure::parser->envelope($envelope);
return $self;
}
sub _do_accessor {
my $datum = shift;
if (scalar(@_) > 1) {
return $_[0]->{$datum} = $_[1] ;
} else {
return $_[0]->{$datum};
}
}
# the following for loop sets up accessor methods for
# the object's address attributes:
sub _mk_address_method {
my $datum = shift;
my $method1 = $datum . "_addresses" ;
no strict 'refs';
*$method1 = sub {
my $self = shift;
return undef unless ref($self->{$datum}) eq 'ARRAY';
my @list = map {
my $pn = $_->personalname ;
$pn = "" if $pn eq 'NIL' ;
( $pn ? "$pn " : "" ) .
"<" .
$_->mailboxname .
'@' .
$_->hostname .
">"
} @{$self->{$datum}} ;
if ( $senderFields{$datum} ) {
return wantarray ? @list : $list[0] ;
} else {
return wantarray ? @list : \@list ;
}
};
}
BEGIN {
for my $datum (
qw( subject inreplyto from messageid bcc date replyto to sender cc )
) {
no strict 'refs';
*$datum = sub { _do_accessor($datum, @_); };
}
my %senderFields = map { ($_ => 1) } qw/from sender replyto/ ;
for my $datum (
qw( from bcc replyto to sender cc )
) {
_mk_address_method($datum);
}
}
package Mail::IMAPClient::BodyStructure::Address;
@ISA = qw/Mail::IMAPClient::BodyStructure/;
for my $datum (
qw( personalname mailboxname hostname sourcename )
) {
no strict 'refs';
*$datum = sub { return $_[0]->{$datum}; };
}
1;
__END__
=head1 NAME
Mail::IMAPClient::BodyStructure - Perl extension to Mail::IMAPClient to facilitate
the parsing of server responses to the FETCH BODYSTRUCTURE and FETCH ENVELOPE
IMAP client commands.
=head1 SYNOPSIS
use Mail::IMAPClient::BodyStructure;
use Mail::IMAPClient;
my $imap = Mail::IMAPClient->new(Server=>$serv,User=>$usr,Password=>$pwd);
$imap->select("INBOX") or die "cannot select the inbox for $usr: $@\n";
my @recent = $imap->search("recent");
foreach my $new (@recent) {
my $struct = Mail::IMAPClient::BodyStructure->new(
$imap->fetch($new,"bodystructure")
);
print "Msg $new (Content-type: ",$struct->bodytype,"/",$struct->bodysubtype,
") contains these parts:\n\t",join("\n\t",$struct->parts),"\n\n";
}
=head1 DESCRIPTION
This extension will parse the result of an IMAP FETCH BODYSTRUCTURE
command into a perl data structure. It also provides helper methods that
will help you pull information out of the data structure.
Use of this extension requires Parse::RecDescent. If you don't have
Parse::RecDescent then you must either get it or refrain from using
this module.
=head2 EXPORT
Nothing is exported by default. C<$parser> is exported upon
request. C<$parser> is the BodyStucture object's Parse::RecDescent object,
which you'll probably only need for debugging purposes.
=head1 Class Methods
The following class method is available:
=head2 new
This class method is the constructor method for instantiating new
Mail::IMAPClient::BodyStructure objects. The B<new> 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<Mail::IMAPClient::BodyStructure>
object, then you might as well save yourself some work and use
B<Mail::IMAPClient>'s B<get_bodystructure> method, which accepts
a message sequence number (or UID if I<Uid> is true) and returns a
B<Mail::IMAPClient::BodyStructure> object. It's functionally equivalent
to issuing the FETCH BODYSTRUCTURE IMAP client command and then passing
the results to B<Mail::IMAPClient::BodyStructure>'s B<new> method but
it does those things in one simple method call.
=head1 Object Methods
The following object methods are available:
=head2 bodytype
The B<bodytype> object method requires no arguments. It returns the
bodytype for the message whose structure is described by the calling
B<Mail::IMAPClient::Bodystructure> object.
=head2 bodysubtype
The B<bodysubtype> object method requires no arguments. It returns the
bodysubtype for the message whose structure is described by the calling
B<Mail::IMAPClient::Bodystructure> object.
=head2 bodyparms
The B<bodyparms> object method requires no arguments. It returns the
bodyparms for the message whose structure is described by the calling
B<Mail::IMAPClient::Bodystructure> object.
=head2 bodydisp
The B<bodydisp> object method requires no arguments. It returns the
bodydisp for the message whose structure is described by the calling
B<Mail::IMAPClient::Bodystructure> object.
=head2 bodyid
The B<bodyid> object method requires no arguments. It returns the
bodyid for the message whose structure is described by the calling
B<Mail::IMAPClient::Bodystructure> object.
=head2 bodydesc
The B<bodydesc> object method requires no arguments. It returns the
bodydesc for the message whose structure is described by the calling
B<Mail::IMAPClient::Bodystructure> object.
=head2 bodyenc
The B<bodyenc> object method requires no arguments. It returns the
bodyenc for the message whose structure is described by the calling
B<Mail::IMAPClient::Bodystructure> object.
=head2 bodysize
The B<bodysize> object method requires no arguments. It returns the
bodysize for the message whose structure is described by the calling
B<Mail::IMAPClient::Bodystructure> object.
=head2 bodylang
The B<bodylang> object method requires no arguments. It returns the
bodylang for the message whose structure is described by the calling
B<Mail::IMAPClient::Bodystructure> object.
=head2 bodystructure
The B<bodystructure> object method requires no arguments. It returns
the bodystructure for the message whose structure is described by the
calling B<Mail::IMAPClient::Bodystructure> object.
=head2 envelopestruct
The B<envelopestruct> object method requires no arguments. It returns
the envelopestruct for the message whose structure is described by the
calling B<Mail::IMAPClient::Bodystructure> object. This envelope structure
is blessed into the B<Mail::IMAPClient::BodyStructure::Envelope> subclass,
which is explained more fully below.
=head2 textlines
The B<textlines> object method requires no arguments. It returns the
textlines for the message whose structure is described by the calling
B<Mail::IMAPClient::Bodystructure> object.
=head1 Envelopes and the Mail::IMAPClient::BodyStructure::Envelope Subclass
The IMAP standard specifies that output from the IMAP B<FETCH
ENVELOPE> command will be an RFC2060 envelope structure. It further
specifies that output from the B<FETCH BODYSTRUCTURE> command may also
contain embedded envelope structures (if, for example, a message's
subparts contain one or more included messages). Objects belonging to
B<Mail::IMAPClient::BodyStructure::Envelope> 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<Mail::IMAPClient>, C<$imap->fetch($msgid,"ENVELOPE")> or C<my $env =
$imap->get_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<Mail::IMAPClient::BodyStructure::Envelope>
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<Mail::IMAPClient::BodyStructure::Address> objects, which are perl
data structures representing RFC2060 address structures. Some of these
arrays would naturally contain one element (such as B<from>, 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<Mail::IMAPClient::BodyStructure::Address>", 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<from>.
=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<Mail::IMAPClient::BodyStructure::Address> arrays) also has an
analagous method that will return a list of E-Mail addresses instead. The
addresses are in the format C<personalname E<lt>mailboxname@hostnameE<gt>>
(see the section on B<Mail::IMAPClient::BodyStructure::Address>,
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<Mail::IMAPClient::BodyStructure::Address>, 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<Mail::IMAPClient::BodyStructure> parses
each of these into an array of B<Mail::IMAPClient::BodyStructure::Address>
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:
C<personalname E<lt>mailboxname@hostnameE<gt>>
Note that because the B<Mail::IMAPClient::BodyStructure::Address>
objects come in arrays, it's generally easier to use the methods
available to B<Mail::IMAPClient::BodyStructure::Envelope> 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<Mail::IMAPClient::BodyStructure::Envelope> need them anyway.)
=cut
=head1 AUTHOR
David J. Kernen
=head1 SEE ALSO
perl(1), Mail::IMAPClient, and RFC2060. See also Parse::RecDescent if you want
to understand the internals of this module.
=cut
1;

288
Mail-IMAPClient-2.99_02/blib/lib/Mail/IMAPClient/BodyStructure/Parse.grammar Executable file
View file

@ -0,0 +1,288 @@
# Directives
# ( none)
# Start-up Actions
{
my $subpartCount = 0;
my $partCount = 0;
}
#
# Atoms
TEXT: /^"TEXT"|^TEXT/i { $return = "TEXT" }
PLAIN: /^"PLAIN"|^PLAIN/i { $return = "PLAIN" }
HTML: /"HTML"|HTML/i { $return = "HTML" }
MESSAGE: /^"MESSAGE"|^MESSAGE/i { $return = "MESSAGE" }
RFC822: /^"RFC822"|^RFC822/i { $return = "RFC822" }
NIL: /^NIL/i { $return = "NIL" }
NUMBER: /^(\d+)/ { $return = $item[1]; $return||defined($return);}
# Strings:
SINGLE_QUOTED_STRING: "'" /(?:\\'|[^'])*/ "'" {
$return = $item{__PATTERN1__} ;
$return||defined($return);
}
DOUBLE_QUOTED_STRING: '"' /(?:\\"|[^"])*/ '"' {
$return = $item{__PATTERN1__} ;
$return||defined($return);
}
QUOTED_STRING: DOUBLE_QUOTED_STRING | SINGLE_QUOTED_STRING {
$return = $item{DOUBLE_QUOTED_STRING}||$item{SINGLE_QUOTED_STRING} ;
$return||defined($return);
}
BARESTRING: ...!/^[)('"]/ /^(?!\(|\))(?:\\ |\S)+/ {
$return = $item{__PATTERN1__} ; $return||defined($return);
}
STRING: QUOTED_STRING | BARESTRING {
$return = $item{QUOTED_STRING}||$item{BARESTRING} ;
$return||defined($return);
}
OLDSTRING: /^"((?:[^"\\]|\\.)*)"/ | /^([^ \(\)]+)/
{ $item{__PATTERN1__} =~ s/^"(.*)"$/$1/;
$return = $item{__PATTERN1__} || $item{__PATTERN2__} ;
$return||defined($return);
}
#BARESTRING: /^[^(]+\s+(?=\()/
# { $return = $item[1] ; $return||defined($return);}
textlines: NIL | NUMBER { $return = $item[1] || $item[2]; $return||defined($return); }
rfc822message: MESSAGE RFC822 { $return = "MESSAGE RFC822" }
key: STRING { $return = $item{STRING} ; $return||defined($return);}
value: NIL | '(' <commit> kvpair(s) ')'| NUMBER | STRING
{ $return = $item{NIL} ||
$item{NUMBER} ||
$item{STRING} ||
{ map { (%$_) } @{$item{'kvpair(s)'}} } ;
$return||defined($return);
}
kvpair: ...!")" key value
{ $return = { $item{key} => $item{value} }; $return||defined($return);}
bodytype: STRING
{ $return = $item{STRING} ; $return||defined($return);}
bodysubtype: PLAIN | HTML | NIL | STRING
{ $return = $item{PLAIN}||$item{HTML}||$item{NIL}||$item{STRING} ;
$return||defined($return);
}
bodyparms: NIL | '(' kvpair(s) ')'
{
$return = $item{NIL} ||
{ map { (%$_) } @{$item{'kvpair(s)'}} };
$return || defined($return);
}
bodydisp: NIL | '(' kvpair(s) ')'
{
$return = $item{NIL} ||
{ map { (%$_) } @{$item{'kvpair(s)'}} };
$return || defined($return);
}
bodyid: ...!/[()]/ NIL | STRING
{ $return = $item{NIL} || $item{STRING} ; $return||defined($return);}
bodydesc: ...!/[()]/ NIL | STRING
{ $return = $item{NIL} || $item{STRING} ; $return||defined($return);}
bodyenc: NIL | STRING | '(' kvpair(s) ')'
{
$return = $item{NIL} ||
$item{STRING} ||
{ map { (%$_) } @{$item{'kvpair(s)'}} };
$return||defined($return);
}
bodysize: ...!/[()]/ NIL | NUMBER
{ $return = $item{NIL} || $item{NUMBER} ;$return||defined($return);}
bodyMD5: NIL | STRING
{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}
bodylang: NIL | STRING | "(" STRING(s) ")"
{ $return = $item{NIL} || $item{'STRING(s)'} ;$return||defined($return);}
personalname: NIL | STRING
{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}
sourceroute: NIL | STRING
{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}
mailboxname: NIL | STRING
{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}
hostname: NIL | STRING
{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}
addressstruct: "(" personalname sourceroute mailboxname hostname ")"
{ $return = {
personalname => $item{personalname} ,
sourceroute => $item{sourceroute} ,
mailboxname => $item{mailboxname} ,
hostname => $item{hostname} ,
} ;
bless($return, "Mail::IMAPClient::BodyStructure::Address");
}
subject: NIL | STRING
{
$return = $item{NIL} || $item{STRING} ;
$return||defined($return);
}
inreplyto: NIL | STRING
{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}
messageid: NIL | STRING
{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}
date: NIL | STRING
{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}
cc: NIL | "(" addressstruct(s) ")"
{ $return = $item{NIL} || $item{'addressstruct(s)'} }
bcc: NIL | "(" addressstruct(s) ")"
{ $return = $item{NIL} || $item{'addressstruct(s)'} }
from: NIL | "(" addressstruct(s) ")"
{ $return = $item{NIL} || $item{'addressstruct(s)'} }
replyto: NIL | "(" addressstruct(s) ")"
{ $return = $item{NIL} || $item{'addressstruct(s)'} }
sender: NIL | "(" addressstruct(s) ")"
{ $return = $item{NIL} || $item{'addressstruct(s)'} }
to: NIL | "(" addressstruct(s) ")"
{ $return = $item{NIL} || $item{'addressstruct(s)'} }
envelopestruct: "(" date subject from sender replyto to cc bcc inreplyto messageid ")"
{ $return = {};
foreach my $what (qw/date subject from sender replyto to cc bcc inreplyto messageid/) {
$return->{$what} = $item{$what};
}
bless $return, "Mail::IMAPClient::BodyStructure::Envelope";
$return||defined($return);
}
basicfields: bodysubtype bodyparms bodyid(?)
bodydesc(?) bodyenc(?)
bodysize(?) {
$return = {
bodysubtype => $item{bodysubtype} ,
bodyparms => $item{bodyparms} ,
bodyid => (ref $item{'bodyid(?)'} ?
$item{'bodyid(?)'}[0] :
$item{'bodyid(?)'} ),
'bodydesc' => (ref $item{'bodydesc(?)'} ?
$item{'bodydesc(?)'}[0] :
$item{'bodydesc(?)'} ),
'bodyenc' => (ref $item{'bodyenc(?)'} ?
$item{'bodyenc(?)'}[0] :
$item{'bodyenc(?)'} ),
'bodysize' => (ref $item{'bodysize(?)'} ?
$item{'bodysize(?)'}[0] :
$item{'bodysize(?)'} ),
};
$return;
}
textmessage: TEXT <commit> basicfields textlines(?) bodyMD5(?) bodydisp(?) bodylang(?)
{
$return = $item{basicfields}||{};
$return->{bodytype} = 'TEXT';
foreach my $what (qw/textlines(?) bodyMD5(?) bodydisp(?) bodylang(?)/) {
my $k = $what; $k =~ s/\(\?\)$//;
ref($item{$what}) and $return->{$k} = $item{$what}[0];
}
$return||defined($return);
}
othertypemessage: bodytype basicfields bodyparms(?) bodydisp(?) bodylang(?)
{ $return = {};
foreach my $what (qw/bodytype bodyparms(?) bodydisp(?) bodylang(?)/) {
my $k = $what; $k =~ s/\(\?\)$//;
$return->{$k} = ref($item{$what})? $item{$what}[0] : $item{$what} ;
}
while ( my($k,$v) = each %{$item{basicfields}} ) { $return->{$k} = $v }
$return||defined($return);
}
messagerfc822message:
rfc822message <commit> bodyparms bodyid bodydesc bodyenc bodysize
envelopestruct bodystructure textlines
bodyMD5(?) bodydisp(?) bodylang(?)
{
$return = {};
foreach my $what (qw/ bodyparms bodyid bodydesc bodyenc bodysize
envelopestruct bodystructure textlines
bodyMD5(?) bodydisp(?) bodylang(?)
/
) {
my $k = $what; $k =~ s/\(\?\)$//;
$return->{$k} = ref $item{$what} =~ 'ARRAY'?
$item{$what}[0] : $item{$what};
}
while ( my($k,$v) = each %{$item{bodystructure}[0]} ) { $return->{$k} = $v }
while ( my($k,$v) = each %{$item{basicfields}} ) { $return->{$k} = $v }
$return->{bodytype} = "MESSAGE" ;
$return->{bodysubtype}= "RFC822" ;
$return||defined($return);
}
subpart: "(" part ")"
{
$return = $item{part} ;
$return||defined($return);
} <defer: ++$subpartCount;>
part: subpart(s) <commit> basicfields
bodyparms(?) bodydisp(?) bodylang(?)
<defer: $subpartCount = 0>
{
$return = bless($item{basicfields},
"Mail::IMAPClient::BodyStructure");
$return->{bodytype} = "MULTIPART";
$return->{bodystructure} = $item{'subpart(s)'};
foreach my $b (qw/bodyparms(?) bodydisp(?) bodylang(?)/) {
my $k = $b; $k =~ s/\(\?\)$//;
$return->{$k} = ref($item{$b}) ? $item{$b}[0] : $item{$b};
}
$return||defined($return) ;
}
| textmessage
{
$return = bless $item{textmessage}, "Mail::IMAPClient::BodyStructure";
$return||defined($return);
}
| messagerfc822message
{
$return = bless $item{messagerfc822message}, "Mail::IMAPClient::BodyStructure";
$return||defined($return);
}
| othertypemessage
{
$return = bless $item{othertypemessage}, "Mail::IMAPClient::BodyStructure";
$return||defined($return);
}
bodystructure: "(" part(s) ")"
{
$return = $item{'part(s)'} ;
$return||defined($return);
}
start: /.*\(.*BODYSTRUCTURE \(/i part(1) /\).*\)\r?\n?/
{
#print STDERR "item = ",Data::Dumper->Dump([\%item],['$item']);
$return = $item{'part(1)'}[0];
$return||defined($return);
}
envelope: /.*\(.*ENVELOPE/ envelopestruct /.*\)/ {
$return = $item{envelopestruct} ;
$return||defined($return) ;
}

17245
Mail-IMAPClient-2.99_02/blib/lib/Mail/IMAPClient/BodyStructure/Parse.pm Normal file
View file

File diff suppressed because it is too large Load diff

17
Mail-IMAPClient-2.99_02/blib/lib/Mail/IMAPClient/BodyStructure/Parse.pod Executable file
View file

@ -0,0 +1,17 @@
=head1 NAME
Mail::IMAPClient::BodyStructure::Parse -- used internally by Mail::IMAPClient::BodyStructure
=head1 DESCRIPTION
This module is used internally by L<Mail::IMAPClient::BodyStructure>
and is generated using L<Parse::RecDescent>. 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<Mail::IMAPClient::BodyStructure>
and is not meant to be used or called directly from applications. So
don't do that.
=cut

285
Mail-IMAPClient-2.99_02/blib/lib/Mail/IMAPClient/MessageSet.pm Normal file
View file

@ -0,0 +1,285 @@
package Mail::IMAPClient::MessageSet;
use warnings;
use strict;
=head1 NAME
Mail::IMAPClient::MessageSet -- ranges of message sequence nummers
=cut
use overload
'""' => "str"
, '.=' => sub {$_[0]->cat($_[1])}
, '+=' => sub {$_[0]->cat($_[1])}
, '-=' => sub {$_[0]->rem($_[1])}
, '@{}' => "unfold"
, fallback => 1;
sub new
{ my $class = shift;
my $range = $class->range(@_);
bless \$range, $class;
}
sub str { overload::StrVal( ${$_[0]} ) }
sub _unfold_range($)
{ map { /(\d+)\:(\d+)/ ? ($1..$2) : $_ }
split /\,/, shift;
}
sub rem
{ my $self = shift;
my %delete = map { ($_ => 1) } map { _unfold_range $_ } @_;
$$self = $self->range(map {$delete{$_} ? () : $_ } $self->unfold);
$self;
}
sub cat
{ my $self = shift;
$$self = $self->range($$self, @_);
$self;
}
sub range
{ my $class = shift;
return $_[0]
if @_== 1 && ref $_[0] eq __PACKAGE__;
my @msgs;
foreach my $m (@_)
{ defined $m && length $m
or next;
foreach my $mm (ref $m eq 'ARRAY' ? @$m : $m)
{ push @msgs, _unfold_range $mm;
}
}
@msgs
or return undef;
@msgs = sort {$a <=> $b} @msgs;
my $low = my $high = shift @msgs;
my @ranges;
foreach my $m (@msgs)
{ next if $m == $high; # double
if($m == $high + 1) { $high = $m }
else
{ push @ranges, $low == $high ? $low : "$low:$high";
$low = $high = $m;
}
}
push @ranges, $low == $high ? $low : "$low:$high" ;
join ",", @ranges;
}
sub unfold
{ my $self = shift;
wantarray ? ( _unfold_range $$self ) : [ _unfold_range $$self ];
}
=head2 SYNOPSIS
my @msgs = $imap->search("SUBJECT","Virus"); # returns 1,3,4,5,6,9,10
my $msgset = Mail::IMAPClient::MessageSet->new(@msgs);
print $msgset; # prints "1,3:6,9:10"
# add message 14 to the set:
$msgset += 14;
print $msgset; # prints "1,3:6,9:10,14"
# add messages 16,17,18,19, and 20 to the set:
$msgset .= "16,17,18:20";
print $msgset; # prints "1,3:6,9:10,14,16:20"
# Hey, I didn't really want message 17 in there; let's take it out:
$msgset -= 17;
print $msgset; # prints "1,3:6,9:10,14,16,18:20"
# Now let's iterate over each message:
for my $msg (@$msgset)
{ print "$msg\n"; # Prints: "1\n3\n4\n5\n6..16\n18\n19\n20\n"
}
print join("\n", @$msgset)."\n"; # same simpler
local $" = "\n"; print "@$msgset\n"; # even more simple
=head2 DESCRIPTION
The B<Mail::IMAPClient::MessageSet> 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<new> 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<unfold> 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<Mail::IMAPClient::MessageSet> 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<Mail::IMAPClient> B<Range> method can be used as
a short-cut to specifying C<Mail::IMAPClient::MessageSet-E<gt>new(@etc)>.)
=head1 CLASS METHODS
The only class method you need to worry about is B<new>. And if you create
your B<Mail::IMAPClient::MessageSet> objects via L<Mail::IMAPClient>'s
B<Range> method then you don't even need to worry about B<new>.
=head2 new
Example:
my $msgset = Mail::IMAPClient::MessageSet->new(@msgs);
The B<new> 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<new>, 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<new> can really be any kind of number at
all but to be useful in a L<Mail::IMAPClient> session they should be either
message UID's (if your I<Uid> parameter is true) or message sequence numbers.
The B<new> method will return a reference to a B<Mail::IMAPClient::MessageSet>
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<Mail::IMAPClient::MessageSet>
object is the L<unfold> method.
=head2 unfold
Example:
my $msgset = $imap->Range( $imap->messages ) ;
my @all_messages = $msgset->unfold;
The B<unfold> 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<Mail::IMAPClient::MessageSet> 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<Mail::IMAPClient::MessageSet> 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<Mail::IMAPClient::MessageSet> 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<Mail::IMAPClient::MessageSet> 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<Mail::IMAPClient::MessageSet> 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;

18
Mail-IMAPClient-2.99_02/blib/lib/Mail/IMAPClient/Thread.grammar Normal file
View file

@ -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;
}

1014
Mail-IMAPClient-2.99_02/blib/lib/Mail/IMAPClient/Thread.pm Normal file
View file

File diff suppressed because it is too large Load diff

21
Mail-IMAPClient-2.99_02/blib/lib/Mail/IMAPClient/Thread.pod Executable file
View file

@ -0,0 +1,21 @@
package Mail::IMAPClient::Thread;
$Mail::IMAPClient::Thread::VERSION = "0.0.1";
$Mail::IMAPClient::Thread::VERSION = "0.0.1";
=head1 NAME
Mail::IMAPClient::Thread -- used internally by Mail::IMAPClient->thread
=head1 DESCRIPTION
This module is used internally by L<Mail::IMAPClient> and is
generated using L<Parse::RecDescent>. 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<Mail::IMAPClient> and is not meant to
be used or called directly from applications. So don't do that.
=cut

0
Mail-IMAPClient-2.99_02/blib/lib/auto/Mail/IMAPClient/.exists Normal file
View file

0
Mail-IMAPClient-2.99_02/blib/man1/.exists Normal file
View file

0
Mail-IMAPClient-2.99_02/blib/man3/.exists Normal file
View file

0
Mail-IMAPClient-2.99_02/blib/script/.exists Normal file
View file

172
Mail-IMAPClient-2.99_02/examples/build_dist.pl Executable file
View file

@ -0,0 +1,172 @@
#!/usr/local/bin/perl
#$Id: build_dist.pl,v 19991216.7 2003/06/12 21:38:29 dkernen Exp $
use Mail::IMAPClient;
=head1 DESCRIPTION
B<build_dist.pl> 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<folder> Output".
=head1 SYNTAX
b<build_dist.pl> I<-h>
b<build_dist.pl> 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<NOTE:> 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/.*<//;
$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: build_dist.pl,v 19991216.7 2003/06/12 21:38:29 dkernen Exp $
# $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
#

235
Mail-IMAPClient-2.99_02/examples/build_ldif.pl Executable file
View file

@ -0,0 +1,235 @@
#!/usr/local/bin/perl
#$Id: build_ldif.pl,v 19991216.11 2003/06/12 21:38:30 dkernen Exp $
use Mail::IMAPClient;
use MIME::Lite;
use Data::Dumper;
=head1 DESCRIPTION
B<build_ldif.pl> 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<To:> field of the message header and in an
LDIF-format attachment.
B<build_ldif.pl> requires B<MIME::Lite>.
=head1 SYNTAX
B<build_ldif.pl> I<-h>
B<build_ldif.pl> 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<NOTE:> 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/.*<// ;
$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/.*<// ;
$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: build_ldif.pl,v 19991216.11 2003/06/12 21:38:30 dkernen Exp $
# $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
#

64
Mail-IMAPClient-2.99_02/examples/cleanTest.pl Executable file
View file

@ -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

147
Mail-IMAPClient-2.99_02/examples/copy_folder.pl Normal file
View file

@ -0,0 +1,147 @@
#!/usr/local/bin/perl
#$Id: copy_folder.pl,v 19991216.3 2003/06/12 21:38:30 dkernen Exp $
++$|;
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
#

111
Mail-IMAPClient-2.99_02/examples/cyrus_expire.pl Executable file
View file

@ -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
#

85
Mail-IMAPClient-2.99_02/examples/cyrus_expunge.pl Normal file
View file

@ -0,0 +1,85 @@
#!/usr/local/bin/perl
#$Id: cyrus_expunge.pl,v 19991216.3 2003/06/12 21:38:31 dkernen Exp $
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
#
#

217
Mail-IMAPClient-2.99_02/examples/find_dup_msgs.pl Normal file
View file

@ -0,0 +1,217 @@
#!/usr/local/bin/perl
# $Id: find_dup_msgs.pl,v 19991216.5 2003/06/12 21:38:32 dkernen Exp $
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
#

154
Mail-IMAPClient-2.99_02/examples/imap_to_mbox.pl Executable file
View file

@ -0,0 +1,154 @@
#!/usr/bin/perl
# (c) 1999 Thomas Stromberg, Research Triangle Commerce, Inc.
# This software is protected by the BSD License. No rights reserved anyhow.
# <tstromberg@rtci.com>
# DESC: Reads a users IMAP folders, and converts them to mbox
# Good for an interim switch-over from say, Exchange to Cyrus IMAP.
# $Header: /usr/CvsRepository/Mail/IMAPClient/examples/imap_to_mbox.pl,v 19991216.7 2002/08/23 13:29:48 dkernen Exp $
# TODO:
# -----
# lsub instead of list option
# correct header printing From
use Mail::IMAPClient; # a nice set of perl libs for imap
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.
$| = 1;
# Config for the imap migration kit.
getopts('u:p:P:s:i:f::b:dh');
if ($opt_h) {
# print help here
}
$SERVER = $opt_s || 'mailhost';
$USER = $opt_u || 'userid';
$PASSWORD = $opt_p || 'password';
$PORT = $opt_P || '143';
$INBOX_PATH = $opt_i || "./mail/$USER";
$FOLDERS_PATH = $opt_f || "./folders/$USER";
$DONT_MOVE = $opt_m || '.mailboxlist|Trash|INBOXIIMAP|mlbxl';
$READ_DELIMITER = $opt_r || '/';
$WRITE_DELIMITER= $opt_w || '/';
$BANNED_CHARS = $opt_b || '.|^|%';
$DEBUG = $opt_d || "0";
## do our magic tricks ######################################
&connect_imap;
&find_folders;
sub connect_imap {
$imap = Mail::IMAPClient->new(
Server => "$SERVER",
User => "$USER",
Password => "$PASSWORD",
Port => "$PORT",
Debug => "$DEBUG",
Uid => '0',
Clear => '1',
)
|| die ("Could not connect to $SERVER:$PORT with $USER: $! $?\n");
};
sub find_folders {
my (@folders, $folder, $message_count, $new_folder, $path);
@folders = $imap->folders;
push(@folders, "INBOX");
foreach $folder (@folders) {
$message_count = $imap->message_count($folder);
if (! $message_count) {
print("* $folder is empty, skipping.\n");
next;
}
if ($folder =~ /$DONT_MOVE/) {
print("! $folder matches DONT_MOVE ruleset, skipping\n");
next;
}
$new_folder = $folder;
$new_folder =~ s/\./_/g;
$new_folder =~ s/$READ_DELIMITER/$WRITE_DELIMITER/g;
if ($new_folder eq "INBOX") {
$path = "$INBOX_PATH";
} else {
$path = "$FOLDERS_PATH/$new_folder";
}
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) = @_;
my($msg_header, $msg_body);
$imap->select($folder) || print("Could not examine $folder: $!");
$new_dir = dirname($newpath);
$new_file = basename($newpath);
mkpath("$new_dir", 0700) unless -d "$new_dir";
open(mbox, ">$newpath");
for ($i=$first_message; $i<$last_message+1; ++$i) {
if ( ($i / 25) == int($i / 25) ) { print("."); }
$msg_header = $imap->fetch($i, "FAST") || print("Could not fetch header $i from $folder\n");
$msg_rfc822 = $imap->fetch($i, "RFC822") || print("Could not fetch RFC822 $i from $folder\n");
undef $start;
foreach (@$msg_rfc822) {
if (($_ =~ /: /) && (! $message)) { ++$message; print(mbox "From imap\@to.mbox Wed Oct 27 17:02:53 1999\n");}
if (/^\)\r/) { undef $message; print(mbox "\n\n");}
next unless $message;
$_ =~ s/\r$//;
print(mbox "$_");
}
}
close(mbox);
print("\n");
}
# $Id: imap_to_mbox.pl,v 19991216.7 2002/08/23 13:29:48 dkernen Exp $
# $Log: imap_to_mbox.pl,v $
# Revision 19991216.7 2002/08/23 13:29:48 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:52 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: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
#

226
Mail-IMAPClient-2.99_02/examples/imtestExample.pl Executable file
View file

@ -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 "<<<END OF PROLOG>>>\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 "<<<END>>>\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

326
Mail-IMAPClient-2.99_02/examples/migrate_mail2.pl Executable file
View file

@ -0,0 +1,326 @@
#!/usr/local/bin/perl
#$Id: migrate_mail2.pl,v 19991216.4 2003/06/12 21:38:33 dkernen Exp $
#
# 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
#

131
Mail-IMAPClient-2.99_02/examples/migrate_mbox.pl Executable file
View file

@ -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: migrate_mbox.pl,v 19991216.2 2003/06/12 21:38:33 dkernen Exp $
#
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
#
#

319
Mail-IMAPClient-2.99_02/examples/populate_mailbox.pl Executable file
View file

@ -0,0 +1,319 @@
#!/usr/local/bin/perl
#$Id: populate_mailbox.pl,v 19991216.8 2003/06/12 21:38:34 dkernen Exp $ #
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 = <<EOTEXT ;
To: $to\@$hash{DOMAIN}
Date: @{[&rfc822_date($date)]}
Subject: $subject
Dear mail tester,
This is a test message to test mail for messages \l$subject.
I hope you like it!
Love,
The E-Mail Engineering Team
EOTEXT
#
for (my $x = 0; $x < 10 ; $x ++ ) {
my $imap = Mail::IMAPClient->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 .= <<EOTRAH ;
Subject: $subject
This note was put in the $where folder $d days ago. (My how time flies!)
I hope you enjoyed testing with it!
EOTRAH
my $imap = Mail::IMAPClient->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: populate_mailbox.pl,v 19991216.8 2003/06/12 21:38:34 dkernen Exp $
# $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
#

88
Mail-IMAPClient-2.99_02/examples/sharedFolder.pl Executable file
View file

@ -0,0 +1,88 @@
#!/usr/local/bin/perl
#$Id: sharedFolder.pl,v 19991216.1 2003/06/12 21:38:35 dkernen Exp $
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
#
#

2856
Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pm Normal file
View file

File diff suppressed because it is too large Load diff

3746
Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient.pod Normal file
View file

File diff suppressed because it is too large Load diff

661
Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/BodyStructure.pm Executable file
View file

@ -0,0 +1,661 @@
package Mail::IMAPClient::BodyStructure;
use base 'Exporter';
use Mail::IMAPClient;
use Mail::IMAPClient::BodyStructure::Parse;
our $VERSION = '0.0.3';
our @EXPORT_OK = '$parser';
our $parser = Mail::IMAPClient::BodyStructure::Parse->new()
or die "Cannot parse rules: $@\n"
. "Try remaking Mail::IMAPClient::BodyStructure::Parse.\n";
sub new {
my $class = shift;
my $bodystructure = shift;
my $self = $parser->start($bodystructure) or return undef;
$self->{_prefix} = "";
if ( exists $self->{bodystructure} ) {
$self->{_id} = 'HEAD' ;
} else {
$self->{_id} = 1;
}
$self->{_top} = 1;
bless $self, ref($class)||$class;
}
sub _get_thingy {
my $thingy = shift;
my $object = shift||(ref($thingy)?$thingy:undef);
unless ( defined($object) and ref($object) ) {
$@ = "No argument passed to $thingy method." ;
$^W and print STDERR "$@\n" ;
return undef;
}
unless ( "$object" =~ /HASH/
and exists($object->{$thingy})
) {
$@ = ref($object) .
" $object does not have " .
( $thingy =~ /^[aeiou]/i ? "an " : "a " ) .
"${thingy}. " .
( ref($object) =~ /HASH/ ? "It has " . join(", ",keys(%$object)) : "") ;
$^W and print STDERR "$@\n" ;
return undef;
}
return Unwrapped($object->{$thingy});
}
BEGIN {
foreach my $datum (qw/ bodytype bodysubtype bodyparms bodydisp bodyid
bodydesc bodyenc bodysize bodylang
envelopestruct textlines
/
) {
no strict 'refs';
*$datum = sub { _get_thingy($datum, @_); };
}
}
sub parts {
my $self = shift;
if ( exists $self->{PartsList} ) {
return wantarray ? @{$self->{PartsList}} : $self->{PartsList} ;
}
my @parts = ();
$self->{PartsList} = \@parts;
unless ( exists($self->{bodystructure}) ) {
$self->{PartsIndex}{1} = $self ;
@parts = ("HEAD",1);
return wantarray ? @parts : \@parts;
}
#@parts = ( 1 );
#} else {
foreach my $p ($self->bodystructure()) {
push @parts, $p->id();
$self->{PartsIndex}{$p->id()} = $p ;
if ( uc($p->bodytype()||"") eq "MESSAGE" ) {
#print "Part $parts[-1] is a ",$p->bodytype,"\n";
push @parts,$parts[-1] . ".HEAD";
#} else {
# print "Part $parts[-1] is a ",$p->bodytype,"\n";
}
}
#}
return wantarray ? @parts : \@parts;
}
sub oldbodystructure {
my $self = shift;
if ( exists $self->{_bodyparts} ) {
return wantarray ? @{$self->{_bodyparts}} : $self->{_bodyparts} ;
}
my @bodyparts = ( $self );
$self->{_id} ||= "HEAD"; # aka "0"
my $count = 0;
#print STDERR "Analyzing a ",$self->bodytype, " part which I think is part number ",
# $self->{_id},"\n";
my $dump = Data::Dumper->new( [ $self ] , [ 'bodystructure' ] );
$dump->Indent(1);
foreach my $struct (@{$self->{bodystructure}}) {
$struct->{_prefix} ||= $self->{_prefix} . +$count . "." unless $struct->{_top};
$struct->{_id} ||= $self->{_prefix} . $count unless $struct->{_top};
#if (
# uc($struct->bodytype) eq 'MULTIPART' or
# uc($struct->bodytype) eq 'MESSAGE'
#) {
#} else {
#}
push @bodyparts, $struct,
ref($struct->{bodystructure}) ? $struct->bodystructure : () ;
}
$self->{_bodyparts} = \@bodyparts ;
return wantarray ? @bodyparts : $self->bodyparts ;
}
sub bodystructure {
my $self = shift;
my @parts = ();
my $partno = 0;
my $prefix = $self->{_prefix} || "";
#print STDERR "Analyzing a ",($self->bodytype||"unknown ") ,
# " part which I think is part number ",
# $self->{_id},"\n";
my $bs = $self;
$prefix = "$prefix." if ( $prefix and $prefix !~ /\.$/);
if ( $self->{_top} ) {
$self->{_id} ||= "HEAD";
$self->{_prefix} ||= "HEAD";
$partno = 0;
for (my $x = 0; $x < scalar(@{$self->{bodystructure}}) ; $x++) {
$self->{bodystructure}[$x]{_id} = ++$partno ;
$self->{bodystructure}[$x]{_prefix} = $partno ;
push @parts, $self->{bodystructure}[$x] ,
$self->{bodystructure}[$x]->bodystructure;
}
} else {
$partno = 0;
foreach my $p ( @{$self->{bodystructure}} ) {
$partno++;
if (
! exists $p->{_prefix}
) {
$p->{_prefix} = "$prefix$partno";
}
$p->{_prefix} = "$prefix$partno";
$p->{_id} ||= "$prefix$partno";
#my $bt = $p->bodytype;
#if ($bt eq 'MESSAGE') {
#$p->{_id} = $prefix .
#$partno = 0;
#}
push @parts, $p, $p->{bodystructure} ? $p->bodystructure : ();
}
}
return wantarray ? @parts : \@parts;
}
sub id {
my $self = shift;
return $self->{_id} if exists $self->{_id};
return "HEAD" if $self->{_top};
#if ($self->bodytype eq 'MESSAGE') {
# return
#}
if ($self->{bodytype} eq 'MULTIPART') {
my $p = $self->{_id}||$self->{_prefix} ;
$p =~ s/\.$//;
return $p;
} else {
return $self->{_id} ||= 1;
}
}
sub Unwrapped {
my $unescape = Mail::IMAPClient::Unescape(@_);
$unescape =~ s/^"(.*)"$/$1/ if defined($unescape);
return $unescape;
}
package Mail::IMAPClient::BodyStructure::Part;
@ISA = qw/Mail::IMAPClient::BodyStructure/;
package Mail::IMAPClient::BodyStructure::Envelope;
@ISA = qw/Mail::IMAPClient::BodyStructure/;
sub new {
my $class = shift;
my $envelope = shift;
my $self = $Mail::IMAPClient::BodyStructure::parser->envelope($envelope);
return $self;
}
sub _do_accessor {
my $datum = shift;
if (scalar(@_) > 1) {
return $_[0]->{$datum} = $_[1] ;
} else {
return $_[0]->{$datum};
}
}
# the following for loop sets up accessor methods for
# the object's address attributes:
sub _mk_address_method {
my $datum = shift;
my $method1 = $datum . "_addresses" ;
no strict 'refs';
*$method1 = sub {
my $self = shift;
return undef unless ref($self->{$datum}) eq 'ARRAY';
my @list = map {
my $pn = $_->personalname ;
$pn = "" if $pn eq 'NIL' ;
( $pn ? "$pn " : "" ) .
"<" .
$_->mailboxname .
'@' .
$_->hostname .
">"
} @{$self->{$datum}} ;
if ( $senderFields{$datum} ) {
return wantarray ? @list : $list[0] ;
} else {
return wantarray ? @list : \@list ;
}
};
}
BEGIN {
for my $datum (
qw( subject inreplyto from messageid bcc date replyto to sender cc )
) {
no strict 'refs';
*$datum = sub { _do_accessor($datum, @_); };
}
my %senderFields = map { ($_ => 1) } qw/from sender replyto/ ;
for my $datum (
qw( from bcc replyto to sender cc )
) {
_mk_address_method($datum);
}
}
package Mail::IMAPClient::BodyStructure::Address;
@ISA = qw/Mail::IMAPClient::BodyStructure/;
for my $datum (
qw( personalname mailboxname hostname sourcename )
) {
no strict 'refs';
*$datum = sub { return $_[0]->{$datum}; };
}
1;
__END__
=head1 NAME
Mail::IMAPClient::BodyStructure - Perl extension to Mail::IMAPClient to facilitate
the parsing of server responses to the FETCH BODYSTRUCTURE and FETCH ENVELOPE
IMAP client commands.
=head1 SYNOPSIS
use Mail::IMAPClient::BodyStructure;
use Mail::IMAPClient;
my $imap = Mail::IMAPClient->new(Server=>$serv,User=>$usr,Password=>$pwd);
$imap->select("INBOX") or die "cannot select the inbox for $usr: $@\n";
my @recent = $imap->search("recent");
foreach my $new (@recent) {
my $struct = Mail::IMAPClient::BodyStructure->new(
$imap->fetch($new,"bodystructure")
);
print "Msg $new (Content-type: ",$struct->bodytype,"/",$struct->bodysubtype,
") contains these parts:\n\t",join("\n\t",$struct->parts),"\n\n";
}
=head1 DESCRIPTION
This extension will parse the result of an IMAP FETCH BODYSTRUCTURE
command into a perl data structure. It also provides helper methods that
will help you pull information out of the data structure.
Use of this extension requires Parse::RecDescent. If you don't have
Parse::RecDescent then you must either get it or refrain from using
this module.
=head2 EXPORT
Nothing is exported by default. C<$parser> is exported upon
request. C<$parser> is the BodyStucture object's Parse::RecDescent object,
which you'll probably only need for debugging purposes.
=head1 Class Methods
The following class method is available:
=head2 new
This class method is the constructor method for instantiating new
Mail::IMAPClient::BodyStructure objects. The B<new> 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<Mail::IMAPClient::BodyStructure>
object, then you might as well save yourself some work and use
B<Mail::IMAPClient>'s B<get_bodystructure> method, which accepts
a message sequence number (or UID if I<Uid> is true) and returns a
B<Mail::IMAPClient::BodyStructure> object. It's functionally equivalent
to issuing the FETCH BODYSTRUCTURE IMAP client command and then passing
the results to B<Mail::IMAPClient::BodyStructure>'s B<new> method but
it does those things in one simple method call.
=head1 Object Methods
The following object methods are available:
=head2 bodytype
The B<bodytype> object method requires no arguments. It returns the
bodytype for the message whose structure is described by the calling
B<Mail::IMAPClient::Bodystructure> object.
=head2 bodysubtype
The B<bodysubtype> object method requires no arguments. It returns the
bodysubtype for the message whose structure is described by the calling
B<Mail::IMAPClient::Bodystructure> object.
=head2 bodyparms
The B<bodyparms> object method requires no arguments. It returns the
bodyparms for the message whose structure is described by the calling
B<Mail::IMAPClient::Bodystructure> object.
=head2 bodydisp
The B<bodydisp> object method requires no arguments. It returns the
bodydisp for the message whose structure is described by the calling
B<Mail::IMAPClient::Bodystructure> object.
=head2 bodyid
The B<bodyid> object method requires no arguments. It returns the
bodyid for the message whose structure is described by the calling
B<Mail::IMAPClient::Bodystructure> object.
=head2 bodydesc
The B<bodydesc> object method requires no arguments. It returns the
bodydesc for the message whose structure is described by the calling
B<Mail::IMAPClient::Bodystructure> object.
=head2 bodyenc
The B<bodyenc> object method requires no arguments. It returns the
bodyenc for the message whose structure is described by the calling
B<Mail::IMAPClient::Bodystructure> object.
=head2 bodysize
The B<bodysize> object method requires no arguments. It returns the
bodysize for the message whose structure is described by the calling
B<Mail::IMAPClient::Bodystructure> object.
=head2 bodylang
The B<bodylang> object method requires no arguments. It returns the
bodylang for the message whose structure is described by the calling
B<Mail::IMAPClient::Bodystructure> object.
=head2 bodystructure
The B<bodystructure> object method requires no arguments. It returns
the bodystructure for the message whose structure is described by the
calling B<Mail::IMAPClient::Bodystructure> object.
=head2 envelopestruct
The B<envelopestruct> object method requires no arguments. It returns
the envelopestruct for the message whose structure is described by the
calling B<Mail::IMAPClient::Bodystructure> object. This envelope structure
is blessed into the B<Mail::IMAPClient::BodyStructure::Envelope> subclass,
which is explained more fully below.
=head2 textlines
The B<textlines> object method requires no arguments. It returns the
textlines for the message whose structure is described by the calling
B<Mail::IMAPClient::Bodystructure> object.
=head1 Envelopes and the Mail::IMAPClient::BodyStructure::Envelope Subclass
The IMAP standard specifies that output from the IMAP B<FETCH
ENVELOPE> command will be an RFC2060 envelope structure. It further
specifies that output from the B<FETCH BODYSTRUCTURE> command may also
contain embedded envelope structures (if, for example, a message's
subparts contain one or more included messages). Objects belonging to
B<Mail::IMAPClient::BodyStructure::Envelope> 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<Mail::IMAPClient>, C<$imap->fetch($msgid,"ENVELOPE")> or C<my $env =
$imap->get_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<Mail::IMAPClient::BodyStructure::Envelope>
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<Mail::IMAPClient::BodyStructure::Address> objects, which are perl
data structures representing RFC2060 address structures. Some of these
arrays would naturally contain one element (such as B<from>, 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<Mail::IMAPClient::BodyStructure::Address>", 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<from>.
=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<Mail::IMAPClient::BodyStructure::Address> arrays) also has an
analagous method that will return a list of E-Mail addresses instead. The
addresses are in the format C<personalname E<lt>mailboxname@hostnameE<gt>>
(see the section on B<Mail::IMAPClient::BodyStructure::Address>,
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<Mail::IMAPClient::BodyStructure::Address>, 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<Mail::IMAPClient::BodyStructure> parses
each of these into an array of B<Mail::IMAPClient::BodyStructure::Address>
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:
C<personalname E<lt>mailboxname@hostnameE<gt>>
Note that because the B<Mail::IMAPClient::BodyStructure::Address>
objects come in arrays, it's generally easier to use the methods
available to B<Mail::IMAPClient::BodyStructure::Envelope> 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<Mail::IMAPClient::BodyStructure::Envelope> need them anyway.)
=cut
=head1 AUTHOR
David J. Kernen
=head1 SEE ALSO
perl(1), Mail::IMAPClient, and RFC2060. See also Parse::RecDescent if you want
to understand the internals of this module.
=cut
1;

288
Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/BodyStructure/Parse.grammar Executable file
View file

@ -0,0 +1,288 @@
# Directives
# ( none)
# Start-up Actions
{
my $subpartCount = 0;
my $partCount = 0;
}
#
# Atoms
TEXT: /^"TEXT"|^TEXT/i { $return = "TEXT" }
PLAIN: /^"PLAIN"|^PLAIN/i { $return = "PLAIN" }
HTML: /"HTML"|HTML/i { $return = "HTML" }
MESSAGE: /^"MESSAGE"|^MESSAGE/i { $return = "MESSAGE" }
RFC822: /^"RFC822"|^RFC822/i { $return = "RFC822" }
NIL: /^NIL/i { $return = "NIL" }
NUMBER: /^(\d+)/ { $return = $item[1]; $return||defined($return);}
# Strings:
SINGLE_QUOTED_STRING: "'" /(?:\\'|[^'])*/ "'" {
$return = $item{__PATTERN1__} ;
$return||defined($return);
}
DOUBLE_QUOTED_STRING: '"' /(?:\\"|[^"])*/ '"' {
$return = $item{__PATTERN1__} ;
$return||defined($return);
}
QUOTED_STRING: DOUBLE_QUOTED_STRING | SINGLE_QUOTED_STRING {
$return = $item{DOUBLE_QUOTED_STRING}||$item{SINGLE_QUOTED_STRING} ;
$return||defined($return);
}
BARESTRING: ...!/^[)('"]/ /^(?!\(|\))(?:\\ |\S)+/ {
$return = $item{__PATTERN1__} ; $return||defined($return);
}
STRING: QUOTED_STRING | BARESTRING {
$return = $item{QUOTED_STRING}||$item{BARESTRING} ;
$return||defined($return);
}
OLDSTRING: /^"((?:[^"\\]|\\.)*)"/ | /^([^ \(\)]+)/
{ $item{__PATTERN1__} =~ s/^"(.*)"$/$1/;
$return = $item{__PATTERN1__} || $item{__PATTERN2__} ;
$return||defined($return);
}
#BARESTRING: /^[^(]+\s+(?=\()/
# { $return = $item[1] ; $return||defined($return);}
textlines: NIL | NUMBER { $return = $item[1] || $item[2]; $return||defined($return); }
rfc822message: MESSAGE RFC822 { $return = "MESSAGE RFC822" }
key: STRING { $return = $item{STRING} ; $return||defined($return);}
value: NIL | '(' <commit> kvpair(s) ')'| NUMBER | STRING
{ $return = $item{NIL} ||
$item{NUMBER} ||
$item{STRING} ||
{ map { (%$_) } @{$item{'kvpair(s)'}} } ;
$return||defined($return);
}
kvpair: ...!")" key value
{ $return = { $item{key} => $item{value} }; $return||defined($return);}
bodytype: STRING
{ $return = $item{STRING} ; $return||defined($return);}
bodysubtype: PLAIN | HTML | NIL | STRING
{ $return = $item{PLAIN}||$item{HTML}||$item{NIL}||$item{STRING} ;
$return||defined($return);
}
bodyparms: NIL | '(' kvpair(s) ')'
{
$return = $item{NIL} ||
{ map { (%$_) } @{$item{'kvpair(s)'}} };
$return || defined($return);
}
bodydisp: NIL | '(' kvpair(s) ')'
{
$return = $item{NIL} ||
{ map { (%$_) } @{$item{'kvpair(s)'}} };
$return || defined($return);
}
bodyid: ...!/[()]/ NIL | STRING
{ $return = $item{NIL} || $item{STRING} ; $return||defined($return);}
bodydesc: ...!/[()]/ NIL | STRING
{ $return = $item{NIL} || $item{STRING} ; $return||defined($return);}
bodyenc: NIL | STRING | '(' kvpair(s) ')'
{
$return = $item{NIL} ||
$item{STRING} ||
{ map { (%$_) } @{$item{'kvpair(s)'}} };
$return||defined($return);
}
bodysize: ...!/[()]/ NIL | NUMBER
{ $return = $item{NIL} || $item{NUMBER} ;$return||defined($return);}
bodyMD5: NIL | STRING
{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}
bodylang: NIL | STRING | "(" STRING(s) ")"
{ $return = $item{NIL} || $item{'STRING(s)'} ;$return||defined($return);}
personalname: NIL | STRING
{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}
sourceroute: NIL | STRING
{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}
mailboxname: NIL | STRING
{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}
hostname: NIL | STRING
{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}
addressstruct: "(" personalname sourceroute mailboxname hostname ")"
{ $return = {
personalname => $item{personalname} ,
sourceroute => $item{sourceroute} ,
mailboxname => $item{mailboxname} ,
hostname => $item{hostname} ,
} ;
bless($return, "Mail::IMAPClient::BodyStructure::Address");
}
subject: NIL | STRING
{
$return = $item{NIL} || $item{STRING} ;
$return||defined($return);
}
inreplyto: NIL | STRING
{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}
messageid: NIL | STRING
{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}
date: NIL | STRING
{ $return = $item{NIL} || $item{STRING} ;$return||defined($return);}
cc: NIL | "(" addressstruct(s) ")"
{ $return = $item{NIL} || $item{'addressstruct(s)'} }
bcc: NIL | "(" addressstruct(s) ")"
{ $return = $item{NIL} || $item{'addressstruct(s)'} }
from: NIL | "(" addressstruct(s) ")"
{ $return = $item{NIL} || $item{'addressstruct(s)'} }
replyto: NIL | "(" addressstruct(s) ")"
{ $return = $item{NIL} || $item{'addressstruct(s)'} }
sender: NIL | "(" addressstruct(s) ")"
{ $return = $item{NIL} || $item{'addressstruct(s)'} }
to: NIL | "(" addressstruct(s) ")"
{ $return = $item{NIL} || $item{'addressstruct(s)'} }
envelopestruct: "(" date subject from sender replyto to cc bcc inreplyto messageid ")"
{ $return = {};
foreach my $what (qw/date subject from sender replyto to cc bcc inreplyto messageid/) {
$return->{$what} = $item{$what};
}
bless $return, "Mail::IMAPClient::BodyStructure::Envelope";
$return||defined($return);
}
basicfields: bodysubtype bodyparms bodyid(?)
bodydesc(?) bodyenc(?)
bodysize(?) {
$return = {
bodysubtype => $item{bodysubtype} ,
bodyparms => $item{bodyparms} ,
bodyid => (ref $item{'bodyid(?)'} ?
$item{'bodyid(?)'}[0] :
$item{'bodyid(?)'} ),
'bodydesc' => (ref $item{'bodydesc(?)'} ?
$item{'bodydesc(?)'}[0] :
$item{'bodydesc(?)'} ),
'bodyenc' => (ref $item{'bodyenc(?)'} ?
$item{'bodyenc(?)'}[0] :
$item{'bodyenc(?)'} ),
'bodysize' => (ref $item{'bodysize(?)'} ?
$item{'bodysize(?)'}[0] :
$item{'bodysize(?)'} ),
};
$return;
}
textmessage: TEXT <commit> basicfields textlines(?) bodyMD5(?) bodydisp(?) bodylang(?)
{
$return = $item{basicfields}||{};
$return->{bodytype} = 'TEXT';
foreach my $what (qw/textlines(?) bodyMD5(?) bodydisp(?) bodylang(?)/) {
my $k = $what; $k =~ s/\(\?\)$//;
ref($item{$what}) and $return->{$k} = $item{$what}[0];
}
$return||defined($return);
}
othertypemessage: bodytype basicfields bodyparms(?) bodydisp(?) bodylang(?)
{ $return = {};
foreach my $what (qw/bodytype bodyparms(?) bodydisp(?) bodylang(?)/) {
my $k = $what; $k =~ s/\(\?\)$//;
$return->{$k} = ref($item{$what})? $item{$what}[0] : $item{$what} ;
}
while ( my($k,$v) = each %{$item{basicfields}} ) { $return->{$k} = $v }
$return||defined($return);
}
messagerfc822message:
rfc822message <commit> bodyparms bodyid bodydesc bodyenc bodysize
envelopestruct bodystructure textlines
bodyMD5(?) bodydisp(?) bodylang(?)
{
$return = {};
foreach my $what (qw/ bodyparms bodyid bodydesc bodyenc bodysize
envelopestruct bodystructure textlines
bodyMD5(?) bodydisp(?) bodylang(?)
/
) {
my $k = $what; $k =~ s/\(\?\)$//;
$return->{$k} = ref $item{$what} =~ 'ARRAY'?
$item{$what}[0] : $item{$what};
}
while ( my($k,$v) = each %{$item{bodystructure}[0]} ) { $return->{$k} = $v }
while ( my($k,$v) = each %{$item{basicfields}} ) { $return->{$k} = $v }
$return->{bodytype} = "MESSAGE" ;
$return->{bodysubtype}= "RFC822" ;
$return||defined($return);
}
subpart: "(" part ")"
{
$return = $item{part} ;
$return||defined($return);
} <defer: ++$subpartCount;>
part: subpart(s) <commit> basicfields
bodyparms(?) bodydisp(?) bodylang(?)
<defer: $subpartCount = 0>
{
$return = bless($item{basicfields},
"Mail::IMAPClient::BodyStructure");
$return->{bodytype} = "MULTIPART";
$return->{bodystructure} = $item{'subpart(s)'};
foreach my $b (qw/bodyparms(?) bodydisp(?) bodylang(?)/) {
my $k = $b; $k =~ s/\(\?\)$//;
$return->{$k} = ref($item{$b}) ? $item{$b}[0] : $item{$b};
}
$return||defined($return) ;
}
| textmessage
{
$return = bless $item{textmessage}, "Mail::IMAPClient::BodyStructure";
$return||defined($return);
}
| messagerfc822message
{
$return = bless $item{messagerfc822message}, "Mail::IMAPClient::BodyStructure";
$return||defined($return);
}
| othertypemessage
{
$return = bless $item{othertypemessage}, "Mail::IMAPClient::BodyStructure";
$return||defined($return);
}
bodystructure: "(" part(s) ")"
{
$return = $item{'part(s)'} ;
$return||defined($return);
}
start: /.*\(.*BODYSTRUCTURE \(/i part(1) /\).*\)\r?\n?/
{
#print STDERR "item = ",Data::Dumper->Dump([\%item],['$item']);
$return = $item{'part(1)'}[0];
$return||defined($return);
}
envelope: /.*\(.*ENVELOPE/ envelopestruct /.*\)/ {
$return = $item{envelopestruct} ;
$return||defined($return) ;
}

17245
Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/BodyStructure/Parse.pm Normal file
View file

File diff suppressed because it is too large Load diff

17
Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/BodyStructure/Parse.pod Executable file
View file

@ -0,0 +1,17 @@
=head1 NAME
Mail::IMAPClient::BodyStructure::Parse -- used internally by Mail::IMAPClient::BodyStructure
=head1 DESCRIPTION
This module is used internally by L<Mail::IMAPClient::BodyStructure>
and is generated using L<Parse::RecDescent>. 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<Mail::IMAPClient::BodyStructure>
and is not meant to be used or called directly from applications. So
don't do that.
=cut

285
Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/MessageSet.pm Normal file
View file

@ -0,0 +1,285 @@
package Mail::IMAPClient::MessageSet;
use warnings;
use strict;
=head1 NAME
Mail::IMAPClient::MessageSet -- ranges of message sequence nummers
=cut
use overload
'""' => "str"
, '.=' => sub {$_[0]->cat($_[1])}
, '+=' => sub {$_[0]->cat($_[1])}
, '-=' => sub {$_[0]->rem($_[1])}
, '@{}' => "unfold"
, fallback => 1;
sub new
{ my $class = shift;
my $range = $class->range(@_);
bless \$range, $class;
}
sub str { overload::StrVal( ${$_[0]} ) }
sub _unfold_range($)
{ map { /(\d+)\:(\d+)/ ? ($1..$2) : $_ }
split /\,/, shift;
}
sub rem
{ my $self = shift;
my %delete = map { ($_ => 1) } map { _unfold_range $_ } @_;
$$self = $self->range(map {$delete{$_} ? () : $_ } $self->unfold);
$self;
}
sub cat
{ my $self = shift;
$$self = $self->range($$self, @_);
$self;
}
sub range
{ my $class = shift;
return $_[0]
if @_== 1 && ref $_[0] eq __PACKAGE__;
my @msgs;
foreach my $m (@_)
{ defined $m && length $m
or next;
foreach my $mm (ref $m eq 'ARRAY' ? @$m : $m)
{ push @msgs, _unfold_range $mm;
}
}
@msgs
or return undef;
@msgs = sort {$a <=> $b} @msgs;
my $low = my $high = shift @msgs;
my @ranges;
foreach my $m (@msgs)
{ next if $m == $high; # double
if($m == $high + 1) { $high = $m }
else
{ push @ranges, $low == $high ? $low : "$low:$high";
$low = $high = $m;
}
}
push @ranges, $low == $high ? $low : "$low:$high" ;
join ",", @ranges;
}
sub unfold
{ my $self = shift;
wantarray ? ( _unfold_range $$self ) : [ _unfold_range $$self ];
}
=head2 SYNOPSIS
my @msgs = $imap->search("SUBJECT","Virus"); # returns 1,3,4,5,6,9,10
my $msgset = Mail::IMAPClient::MessageSet->new(@msgs);
print $msgset; # prints "1,3:6,9:10"
# add message 14 to the set:
$msgset += 14;
print $msgset; # prints "1,3:6,9:10,14"
# add messages 16,17,18,19, and 20 to the set:
$msgset .= "16,17,18:20";
print $msgset; # prints "1,3:6,9:10,14,16:20"
# Hey, I didn't really want message 17 in there; let's take it out:
$msgset -= 17;
print $msgset; # prints "1,3:6,9:10,14,16,18:20"
# Now let's iterate over each message:
for my $msg (@$msgset)
{ print "$msg\n"; # Prints: "1\n3\n4\n5\n6..16\n18\n19\n20\n"
}
print join("\n", @$msgset)."\n"; # same simpler
local $" = "\n"; print "@$msgset\n"; # even more simple
=head2 DESCRIPTION
The B<Mail::IMAPClient::MessageSet> 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<new> 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<unfold> 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<Mail::IMAPClient::MessageSet> 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<Mail::IMAPClient> B<Range> method can be used as
a short-cut to specifying C<Mail::IMAPClient::MessageSet-E<gt>new(@etc)>.)
=head1 CLASS METHODS
The only class method you need to worry about is B<new>. And if you create
your B<Mail::IMAPClient::MessageSet> objects via L<Mail::IMAPClient>'s
B<Range> method then you don't even need to worry about B<new>.
=head2 new
Example:
my $msgset = Mail::IMAPClient::MessageSet->new(@msgs);
The B<new> 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<new>, 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<new> can really be any kind of number at
all but to be useful in a L<Mail::IMAPClient> session they should be either
message UID's (if your I<Uid> parameter is true) or message sequence numbers.
The B<new> method will return a reference to a B<Mail::IMAPClient::MessageSet>
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<Mail::IMAPClient::MessageSet>
object is the L<unfold> method.
=head2 unfold
Example:
my $msgset = $imap->Range( $imap->messages ) ;
my @all_messages = $msgset->unfold;
The B<unfold> 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<Mail::IMAPClient::MessageSet> 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<Mail::IMAPClient::MessageSet> 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<Mail::IMAPClient::MessageSet> 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<Mail::IMAPClient::MessageSet> 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<Mail::IMAPClient::MessageSet> 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;

18
Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/Thread.grammar Normal file
View file

@ -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;
}

1014
Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/Thread.pm Normal file
View file

File diff suppressed because it is too large Load diff

21
Mail-IMAPClient-2.99_02/lib/Mail/IMAPClient/Thread.pod Executable file
View file

@ -0,0 +1,21 @@
package Mail::IMAPClient::Thread;
$Mail::IMAPClient::Thread::VERSION = "0.0.1";
$Mail::IMAPClient::Thread::VERSION = "0.0.1";
=head1 NAME
Mail::IMAPClient::Thread -- used internally by Mail::IMAPClient->thread
=head1 DESCRIPTION
This module is used internally by L<Mail::IMAPClient> and is
generated using L<Parse::RecDescent>. 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<Mail::IMAPClient> and is not meant to
be used or called directly from applications. So don't do that.
=cut

0
Mail-IMAPClient-2.99_02/pm_to_blib Normal file
View file

37
Mail-IMAPClient-2.99_02/prepare_dist Executable file
View file

@ -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";
}

1
Mail-IMAPClient-2.99_02/sample.perldb Executable file
View file

@ -0,0 +1 @@
&parse_options("NonStop=1 LineInfo=mail_imapclient_db.out");

305
Mail-IMAPClient-2.99_02/t/basic.t Executable file
View file

@ -0,0 +1,305 @@
#!/usr/bin/perl
my $uid;
use warnings;
use strict;
use Test::More;
use File::Temp 'tempfile';
my $debug = $ARGV[0];
my %parms;
my $range = 0;
my $uidplus = 0;
my $fast = 0;
BEGIN
{ open TST, 'test.txt'
or plan skip_all => 'test parameters not provided';
while(my $l = <TST>)
{ chomp $l;
my($p,$v) = split /\=/, $l, 2;
s/(?:^\s+)|(?:\s+$)//g for $p, $v;
$parms{$p} = $v if $v;
}
close TST;
foreach my $p ( qw/server user passed/ )
{ $parms{$p}
or plan skip_all => "missing value for $_"
}
plan tests => 40;
}
use_ok('Mail::IMAPClient');
my $imap = Mail::IMAPClient->new
( Server => $parms{server}
, Port => $parms{port}
, User => $parms{user}
, Password => $parms{passed}
, Authmechanism => $parms{authmechanism}
, Clear => 0
, Timeout => 30
, Fast_IO => $fast
, Uid => $uidplus
, Range => $range
, Debug => 1
, Debug_fh => ($debug ? IO::File->new('imap1.debug', 'w') : undef)
);
ok(defined $imap, 'created client');
die "Cannot log into $parms{server} as $parms{user}.\n"
. "Are server/user/password correct?\n" ;
isa_ok($imap, 'Mail::IMAPClient');
$imap->Debug_fh->autoflush() if $imap->Debug_fh ;
my $testmsg = <<__TEST_MSG;
Date: @{[$imap->Rfc822_date(time)]}
To: <$parms{user}\@$parms{server}>
From: Perl <$parms{user}\@$parms{server}>
Subject: Testing from pid $$
This is a test message generated by $0 during a 'make test' as part of
the installation of that nifty Mail::IMAPClient module from CPAN. Like
all things perl, it's way cool.
__TEST_MSG
my $sep = $imap->separator;
ok(defined $sep, "separator is '$sep'");
my $isparent = $imap->is_parent("INBOX") || 0;
my ($target, $target2) = $isparent
? ("INBOX${sep}IMAPClient_$$", "INBOX${sep}IMAPClient_2_$$")
: ("IMAPClient_$$", "IMAPClient_2_$$");
ok(1, "parent $isparent, target $target");
ok($imap->select('inbox'), "select inbox");
ok($imap->create($target), "create target");
if(!$imap->is_parent($target))
{ ok(1, "not parent, skipping quote test 1/3");
ok(1, "not parent, skipping quote test 2/3");
ok(1, "not parent, skipping quote test 3/3");
}
elsif( eval {$imap->create( qq[ $target${sep}has "quotes" ] )} )
{ ok(1, "supports quotes, create");
ok($imap->select( qq[$target${sep}has "quotes"] ), 'select');
$imap->close;
$imap->select('inbox');
ok($imap->delete(qq($target${sep}has "quotes")), 'delete');
}
else
{ if($imap->LastError =~ /NO Invalid.*name/)
{ ok(1, "$parms{server} doesn't support quotes in folder names") }
else { ok(0, "failed creation with quotes") }
ok(1, "skipping 1/2 tests");
ok(1, "skipping 2/2 tests");
}
ok($imap->exists($target), "exists $target");
ok($imap->create($target2), "create $target2");
ok($imap->exists($target2), "exists $target2");
$uid = $imap->append($target, $testmsg);
ok(defined $uid, "append test message to $target");
ok($imap->select($target), "select $target");
$target = ref $uid ? ($imap->search("ALL"))[0] : $uid;
my $size = $imap->size($target);
cmp_ok($size, '>', 0, "has size $size");
my $string = $imap->message_string($target);
ok($string, "returned string");
cmp_ok($size, '==', length($string), "string has size");
{ my ($fh, $fn) = tempfile UNLINK => 1;
ok($imap->message_to_file($fn, $target), "to file $fn");
cmp_ok(-s $fn, '==', $size, "correct size");
}
my $fields = $imap->search("HEADER","Message-id","NOT_A_MESSAGE_ID");
ok(!defined $fields, 'message id does not exist');
my @seen = $imap->seen;
cmp_ok(scalar @seen, '==', 1, 'have seen 1');
ok($imap->deny_seeing(\@seen), 'deny seeing');
my @unseen = $imap->unseen;
cmp_ok(scalar @unseen, '==', 1, 'have unseen 1');
ok($imap->see(\@seen), "let's see one");
cmp_ok(scalar @seen, '==', 1, 'have seen 1');
$imap->deny_seeing(@seen); # reset
$imap->Peek(1);
my $subject = $imap->parse_headers($seen[0],"Subject")->{Subject}[0];
unlike(join("",$imap->flags($seen[0])), qr/\\Seen/i, 'Peek==1');
$imap->deny_seeing(@seen);
$imap->Peek(0);
$subject = $imap->parse_headers($seen[0],"Subject")->{Subject}[0];
like(join("",$imap->flags($seen[0])), qr/\\Seen/i, 'Peek==0');
$imap->deny_seeing(@seen);
$imap->Peek(undef);
$subject = $imap->parse_headers($seen[0],"Subject")->{Subject}[0];
unlike(join("",$imap->flags($seen[0])), qr/\\Seen/i, 'Peek==undef');
my $uid2 = $imap->copy($target2, 1);
ok($uid2, "copy $target2");
my @res = $imap->fetch(1,"RFC822.TEXT");
ok(scalar @res, "fetch rfc822");
my $h = $imap->parse_headers(1, "Subject");
ok($h, "got subject");
like($h->{Subject}[0], qr/^Testing from pid/);
$imap->select($target);
my @hits = $imap->search(SUBJECT => 'Testing');
cmp_ok(scalar @hits, '==', 1);
ok($imap->delete_message(@hits), 'delete hits');
my $flaghash = $imap->flags(\@hits);
my $flagflag = 0;
foreach my $v ( values %$flaghash )
{ $flagflag += grep /\\Deleted/, @$v;
}
cmp_ok($flagflag, '==', scalar @hits);
my @nohits = $imap->search(qq(SUBJECT "Productioning"));
cmp_ok(scalar @nohits, '==', 0, 'no hits expected');
ok($imap->restore_message(@hits), 'restore messages');
$flaghash = $imap->flags(\@hits);
$flagflag = 0;
foreach my $v (values(%$flaghash)){
$flagflag += grep /\\Deleted/, @$v;
}
cmp_ok($flagflag, '==', scalar @hits);
$imap->select($target2);
ok( $imap->delete_message(scalar($imap->search("ALL")))
&& $imap->close
&& imap->delete($target2) , "delete $target2");
$imap->select("INBOX");
$@ = ""; # clear $@
@hits = $imap->search
(BEFORE => Mail::IMAPClient::Rfc2060_date(time), "UNDELETED");
ok(!$@, 'search undeleted');
#
# Test migrate method
#
my $im2 = Mail::IMAPClient->new
( Server => $parms{server}
, Port => $parms{port}
, User => $parms{user}
, Password=> $parms{passed}
, Authmechanism => $parms{authmechanism}
, Clear => 0,
, Timeout => 30,
, Debug => $debug
, Debug_fh => ($debug ? IO::File->new(">./imap2.debug") : undef)
, Fast_IO => $fast
, Uid => $uidplus
);
ok(defined $im2, 'started second imap client');
my $source = $target;
$imap->select($source)
or die "cannot select source $source: $@";
$imap->append($source, $testmsg) for 1..5;
$imap->close;
$imap->select($source);
my $migtarget = $target. '_mirror';
$im2->create($migtarget)
or die "can't create $migtarget: $@" ;
$im2->select($migtarget)
or die "can't select $migtarget: $@";
$imap->migrate($im2,scalar($imap->search("ALL")),$migtarget)
or die "couldn't migrate: $@";
$im2->close;
$im2->select($migtarget)
or die "can't select $migtarget: $@";
cmp_ok($@, 'eq', '');
#
#
#
my $total_bytes1 = 0;
for ($imap->search("ALL"))
{ my $s = $imap->size($_);
$total_bytes1 += $s;
print "Size of msg $_ is $s\n" if $debug
};
my $total_bytes2 = 0;
for ($im2->search("ALL"))
{ my $s = $im2->size($_);
$total_bytes2 += $s; print "Size of msg $_ is $s\n" if $debug
}
cmp_ok($@, '==', '');
cmp_ok($total_bytes1, '==', $total_bytes2, 'size source==target');
# cleanup
$im2->select($migtarget);
$im2->delete_message(@{$im2->messages})
if $im2->message_count;
$im2->close;
$im2->delete($migtarget);
$im2->logout;
#
# Test IDLE
#
if($imap->has_capability("IDLE") )
{ eval { my $idle = $imap->idle; sleep 1; $imap->done($idle) };
cmp_ok($@, 'eq', '');
}
else
{ ok(1, "idle not supported");
}
$imap->select('inbox');
if( $imap->rename($target,"${target}NEW") )
{ ok(1, 'rename');
$imap->close;
$imap->select("${target}NEW") ;
$imap->delete_message(@{$imap->messages}) if $imap->message_count;
$imap->close;
$imap->delete("${target}NEW") ;
}
else
{ ok(0, 'rename failed');
$imap->delete_message(@{$imap->messages})
if $imap->message_count;
$imap->close;
$imap->delete($target) ;
}

29
Mail-IMAPClient-2.99_02/t/bodystructure.t Executable file
View file

@ -0,0 +1,29 @@
#!/usr/bin/perl
use warnings;
use strict;
use Test::More tests => 8;
use_ok('Mail::IMAPClient::BodyStructure');
my $bs = <<'END_OF_BS';
(BODYSTRUCTURE ("TEXT" "PLAIN" ("CHARSET" "us-ascii") NIL NIL "7BIT" 511 20 NIL NIL NIL))^M
END_OF_BS
my $bsobj = Mail::IMAPClient::BodyStructure->new($bs);
ok(defined $bsobj, 'parsed first');
is($bsobj->bodytype, 'TEXT', 'bodytype');
is($bsobj->bodysubtype, 'PLAIN', 'bodysubtype');
my $bs2 = <<'END_OF_BS2';
(BODYSTRUCTURE (("TEXT" "PLAIN" ("CHARSET" "us-ascii") NIL NIL "7BIT" 2 1 NIL NIL NIL)("MESSAGE" "RFC822" NIL NIL NIL "7BIT" 3930 ("Tue, 16 Jul 2002 15:29:17 -0400" "Re: [Fwd: Here is the the list of uids]" (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("David J Kavid" NIL "david.kavid" "generic.com")) NIL NIL "<72f9a217.a21772f9@generic.com>") (("TEXT" "PLAIN" ("CHARSET" "us-ascii") NIL NIL "7BIT" 369 11 NIL NIL NIL)("MESSAGE" "RFC822" NIL NIL NIL "7BIT" 2599 ("Tue, 9 Jul 2002 13:42:04 -0400" "Here is the the list of uids" (("Nicholas Kringle" NIL "nicholas.kringle" "generic.com")) (("Nicholas Kringle" NIL "nicholas.kringle" "generic.com")) (("Nicholas Kringle" NIL "nicholas.kringle" "generic.com")) (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("Richard W Continued" NIL "richard.continued" "generic.com")) NIL NIL "<015401c2276f$f09b7c10$59cab08c@one.two.generic.com>") ((("TEXT" "PLAIN" ("CHARSET" "iso-8859-1") NIL NIL "QUOTED-PRINTABLE" 256 10 NIL NIL NIL)("TEXT" "HTML" ("CHARSET" "iso-8859-1") NIL NIL "QUOTED-PRINTABLE" 791 22 NIL NIL NIL) "ALTERNATIVE" ("BOUNDARY" "----=_NextPart_001_0151_01C2274E.6969D0F0") NIL NIL) "MIXED" ("BOUNDARY" "----=_NextPart_000_0150_01C2274E.6969D0F0") NIL NIL) 75 NIL NIL NIL) "MIXED" ("BOUNDARY" "--1f34eac2082b02") NIL ("EN")) 118 NIL NIL NIL) "MIXED" ("BOUNDARY" "------------F600BD8FDDD648ABA72A09E0") NIL NIL))
END_OF_BS2
$bsobj = Mail::IMAPClient::BodyStructure->new($bs2) ;
ok(defined $bsobj, 'parsed second');
is($bsobj->bodytype, 'MULTIPART', 'bodytype');
is($bsobj->bodysubtype, 'MIXED', 'bodysubtype');
is(join("#",$bsobj->parts),
"1#2#2.HEAD#2.1#2.2#2.2.HEAD#2.2.1#2.2.1.1#2.2.1.2", 'parts');

32
Mail-IMAPClient-2.99_02/t/messageset.t Executable file
View file

@ -0,0 +1,32 @@
#!/usr/bin/perl
use warnings;
use strict;
use Test::More tests => 7;
use_ok('Mail::IMAPClient::MessageSet');
my $one = q/1:4,3:6,10:15,20:25,2:8/;
my $range = Mail::IMAPClient::MessageSet->new($one);
is($range, "1:8,10:15,20:25", 'range simplify');
is( join(",",$range->unfold)
, "1,2,3,4,5,6,7,8,10,11,12,13,14,15,20,21,22,23,24,25"
, 'range unfold');
$range .= "30,31,32,31:34,40:44";
is($range, "1:8,10:15,20:25,30:34,40:44", 'overload concat');
is( join(",",$range->unfold)
, "1,2,3,4,5,6,7,8,10,11,12,13,14,15,20,21,22,23,24,25,"
. "30,31,32,33,34,40,41,42,43,44"
, 'unfold extended');
$range -= "1:2";
is($range, "3:8,10:15,20:25,30:34,40:44", 'overload subtract');
is( join(",",$range->unfold)
, "3,4,5,6,7,8,10,11,12,13,14,15,20,21,22,23,24,25,"
. "30,31,32,33,34,40,41,42,43,44"
, 'subtract unfold');

9
Mail-IMAPClient-2.99_02/t/pod.t Executable file
View file

@ -0,0 +1,9 @@
#!/usr/bin/perl
use warnings;
use strict;
use Test::More;
eval "use Test::Pod 1.00";
plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
all_pod_files_ok();

31
Mail-IMAPClient-2.99_02/t/thread.t Executable file
View file

@ -0,0 +1,31 @@
#!/usr/bin/perl
use warnings;
use strict;
use Test::More tests => 7;
use_ok('Mail::IMAPClient::Thread');
my $t1 = <<'e1';
* THREAD (166)(167)(168)(169)(172)(170)(171)(173)(174 175 176 178 181 180)(179)(177 183 182 188 184 185 186 187 189)(190)(191)(192)(193)(194 195)(196 197 198)(199)(200 202)(201)(203)(204)(205)(206 207)(208)
e1
my $t2 = <<'e2';
* THREAD (166)(167)(168)(169)(172)((170)(179))(171)(173)((174)(175)(176)(178)(181)(180))((177)(183)(182)(188 (184)(189))(185 186)(187))(190)(191)(192)(193)((194)(195 196))(197 198)(199)(200 202)(201)(203)(204)(205 206 207)(208)
e2
my $parser = Mail::IMAPClient::Thread->new;
ok(defined $parser, 'created parser');
isa_ok($parser, 'Parse::RecDescent'); # !!!
my $thr1 = $parser->start($t1) ;
ok(defined $thr1, 'thread1 start');
cmp_ok(scalar(@$thr1), '==', 25);
my $thr2 = $parser->start($t2);
ok(defined $thr2, 'thread2 start');
cmp_ok(scalar(@$thr2), '==', 23);

5
Mail-IMAPClient-2.99_02/test.txt Normal file
View file

@ -0,0 +1,5 @@
server=localhost
user=tata@est.belle
passed=XXXXXXXXX
port=143
authmechanism=LOGIN

5
Mail-IMAPClient-2.99_02/test_template.txt Executable file
View file

@ -0,0 +1,5 @@
server=imap.server.hostname
user=username
passed=password
port=143
authmechanism=LOGIN

6
Makefile
View file

@ -1,5 +1,5 @@
# $Id: Makefile,v 1.16 2007/06/15 04:08:28 gilles Exp $
# $Id: Makefile,v 1.17 2007/10/30 00:49:43 gilles Exp gilles $
TARGET=imapsync
@ -104,9 +104,9 @@ clean_dist:
lfo: dist niouze_lfo lfo_upload niouze
lfo_upload:
rsync -av --delete . \
rsync -avH --delete . \
/home/gilles/public_html/www.linux-france.org/html/prj/$(TARGET)/
rsync -av --delete ../prepa_dist/imapsync-*tgz \
rsync -avH --delete ../prepa_dist/imapsync-*tgz \
/home/gilles/public_html/www.linux-france.org/ftp/prj/$(TARGET)/
sh ~/memo/lfo-rsync

65
README
View file

@ -1,32 +1,31 @@
NAME
imapsync - IMAP synchronisation, sync, copy or migration tool.
Synchronise mailboxes between two imap servers. Good at IMAP migration.
More than 32 different IMAP server softwares supported with success.
$Revision: 1.223 $
$Revision: 1.233 $
INSTALL
imapsync works fine under any Unix OS with perl.
imapsync works fine under Windows 2000 (at least) and ActiveState's 5.8 Perl
imapsync is already available directly on the following distributions (at least):
FreeBSD, Debian, Gentoo, NetBSD, Darwin, Mandriva.
imapsync is already available directly on the following distributions:
OpenBSD
FreeBSD, Debian, Ubuntu, Gentoo, NetBSD, Darwin, Mandriva.
Get imapsync at
http://www.linux-france.org/prj/imapsync/dist/
You'll find a compressed tarball called imapsync-x.xx.tgz
where x.xx is the version number. Untar the tarball where
you want :
you want (on Unix):
tar xzvf imapsync-x.xx.tgz
Go into the directory imapsync-x.xx and read the INSTALL
file.
The freshmeat record is http://freshmeat.net/projects/imapsync/
Go into the directory imapsync-x.xx and read the INSTALL file.
The INSTALL file is also at
http://www.linux-france.org/prj/imapsync/INSTALL (for windows users)
The freshmeat record is at http://freshmeat.net/projects/imapsync/
SYNOPSIS
imapsync [options]
@ -143,9 +142,10 @@ SECURITY
You may authenticate as one user (typically an admin user), but be
authorized as someone else, which means you don't need to know every
user's personal password. Specify --authuser1 "adminuser" to enable this
on host1. In this case, --authmech1 PLAIN will be used, but otherwise,
--authmech1 CRAM-MD5 is the default. Same behavior with the --authuser2
option.
on host1. In this case, --authmech1 PLAIN will be used by default since
it is the only way to go for now. So don't use --authmech1 SOMETHING
with --authuser1 "adminuser", it will not work. Same behavior with the
--authuser2 option.
EXIT STATUS
imapsync will exit with a 0 status (return code) if everything went
@ -204,17 +204,17 @@ IMAP SERVERS
Failure stories reported with the following 4 imap servers :
- MailEnable 1.54 (Proprietary) http://www.mailenable.com/
- DBMail 2.0.7 (GPL). But DBMail 1.2.1 works.
- DBMail 0.9, 2.0.7 (GPL). But DBMail 1.2.1 works.
Patient and confident testers are welcome.
- dkimap4 2.39
- Imail 7.04 (maybe).
Success stories reported with the following 33 imap servers (softwares
Success stories reported with the following 34 imap servers (softwares
names are in alphabetic order) :
- BincImap 1.2.3 (GPL) (http://www.bincimap.org/)
- CommuniGatePro server (Redhat 8.0)
- Courier IMAP 1.5.1, 2.2.0, 2.1.1, 2.2.1 (GPL)
- Courier IMAP 1.5.1, 2.2.0, 2.1.1, 2.2.1, 3.0.8 (GPL)
(http://www.courier-mta.org/)
- Critical Path (7.0.020)
- Cyrus IMAP 1.5, 1.6, 2.1, 2.1.15, 2.1.16, 2.1.18
@ -222,6 +222,7 @@ IMAP SERVERS
v2.2.3-Invoca-RPM-2.2.3-8,
2.3-alpha (OSI Approved),
v2.2.12-Invoca-RPM-2.2.12-3.RHEL4.1,
2.2.13,
v2.3.1-Invoca-RPM-2.3.1-2.7.fc5,
(http://asg.web.cmu.edu/cyrus/)
- David Tobit V8 (proprietary Message system).
@ -232,6 +233,7 @@ IMAP SERVERS
1.0.0 [dest] (LGPL) (http://www.dovecot.org/)
- Domino (Notes) 6.5, 5.0.6, 5.0.7, 7.0.2, 6.0.2CF1, 7.0.1 [from]
- Eudora WorldMail v2
- GMX IMAP4 StreamProxy.
- Groupwise IMAP (Novell) 6.x and 7.0. Buggy so see the FAQ.
- iPlanet Messaging server 4.15, 5.1, 5.2
- IMail 7.15 (Ipswitch/Win2003), 8.12
@ -304,22 +306,23 @@ Links
Entries for imapsync: http://www.imap.org/products/showall.php
SIMILAR SOFTWARES
imap_tools : http://www.athensfbc.com/imap_tools
offlineimap : http://gopher.quux.org:70/devel/offlineimap/
mailsync : http://mailsync.sourceforge.net/
imapxfer : http://www.washington.edu/imap/
part of the imap-utils from UW.
mailutil : replace imapxfer in
part of the imap-utils from UW.
http://www.gsp.com/cgi-bin/man.cgi?topic=mailutil
imaprepl : http://www.bl0rg.net/software/
http://freshmeat.net/projects/imap-repl/
imap_migrate: http://freshmeat.net/projects/imapmigration/
imapcopy : http://home.arcor.de/armin.diehl/imapcopy/imapcopy.html
migrationtool http://sourceforge.net/projects/migrationtool/
pop2imap : http://www.linux-france.org/prj/pop2imap/
imap_tools : http://www.athensfbc.com/imap_tools
offlineimap : http://software.complete.org/offlineimap
mailsync : http://mailsync.sourceforge.net/
imapxfer : http://www.washington.edu/imap/
part of the imap-utils from UW.
mailutil : replace imapxfer in
part of the imap-utils from UW.
http://www.gsp.com/cgi-bin/man.cgi?topic=mailutil
imaprepl : http://www.bl0rg.net/software/
http://freshmeat.net/projects/imap-repl/
imap_migrate : http://freshmeat.net/projects/imapmigration/
imapcopy : http://home.arcor.de/armin.diehl/imapcopy/imapcopy.html
migrationtool : http://sourceforge.net/projects/migrationtool/
imapmigrate : http://sourceforge.net/projects/cyrus-utils/
pop2imap : http://www.linux-france.org/prj/pop2imap/
Feedback (good or bad) will be always welcome.
$Id: imapsync,v 1.223 2007/06/15 04:08:44 gilles Exp gilles $
$Id: imapsync,v 1.233 2007/10/30 03:20:53 gilles Exp gilles $

16
TODO
View file

@ -1,6 +1,22 @@
TODO file for imapsync
----------------------
Add --justlogin --justlogin1 --justlogin2 options
to check username and passwort.
Change IsUnconnected behavior. If IsUnconnected then print
stats and die. Avoid logout.
Add --subscribeall option.
Is it possible to have a option that subscribes all folders regardless of
subscription on the source server? Perhaps --subscribeall?
Add stdin/stdout filter before transfer:
"Now i asked me, how to modify your perl program to work with
that - in example, to write each mail to stdout, pipe that to the
convertion program, and read the result from stdin - and this all before
the mail will transfer to the target imap-server"
Add a --tmpdir option.
Fix bug with folder names starting with an asterisk: *Archiv

2
VERSION
View file

@ -1 +1 @@
1.223
1.233

20
freshmeat_submition.inp
View file

@ -5,8 +5,8 @@
#RELEASE_FOCUS="Code cleanup"
#RELEASE_FOCUS="Minor feature enhancements"
#RELEASE_FOCUS="Major feature enhancements"
RELEASE_FOCUS="Minor bugfixes"
#RELEASE_FOCUS="Major bugfixes"
#RELEASE_FOCUS="Minor bugfixes"
RELEASE_FOCUS="Major bugfixes"
#RELEASE_FOCUS="Minor security fixes"
#RELEASE_FOCUS="Major security fixes"
@ -14,6 +14,16 @@ RELEASE_FOCUS="Minor bugfixes"
#TEXT_BODY="Updated documentation"
#TEXT_BODY="Bug fix: be case insensitive with header keywords."
#TEXT_BODY="Bug fix: rewrote the way to store messages to avoid freeze problems with some imap servers"
TEXT_BODY="Bug fix: Allow long usernames with md5 authentification."
#TEXT_BODY="Bug fix: Allow long usernames with md5 authentification."
TEXT_BODY="Bug fixes:
- Avoid infinite loop with bad hostname.
- Works without patch on MSWin32 systems.
- Updated help message : avoid --authuser and --authmech1 SOMETHING
- Uppercase --authmech input.
- Date with minus %d-%b-%Y (RFC compliant)
- Added Date::Manip dependency.
- Added Dovecot 1.0.0 [dest] success.
- Added Deerfield VisNetic MailServer 5.8.6 [from] success.
- Turn to --nofastio1 --nofastio2 by default.
- Flags \Recent can be uppercase \RECENT now.
"

183
imapsync
View file

@ -1,6 +1,7 @@
#!/usr/bin/perl -w
=pod
=head1 NAME
imapsync - IMAP synchronisation, sync, copy or migration
@ -8,7 +9,7 @@ tool. Synchronise mailboxes between two imap servers. Good
at IMAP migration. More than 32 different IMAP server softwares
supported with success.
$Revision: 1.223 $
$Revision: 1.233 $
=head1 INSTALL
@ -16,24 +17,22 @@ $Revision: 1.223 $
imapsync works fine under Windows 2000 (at least) and ActiveState's 5.8 Perl
imapsync is already available directly on the following distributions (at least):
FreeBSD, Debian, Gentoo, NetBSD, Darwin, Mandriva.
imapsync is already available directly on the following distributions:
OpenBSD
FreeBSD, Debian, Ubuntu, Gentoo, NetBSD, Darwin, Mandriva.
Get imapsync at
http://www.linux-france.org/prj/imapsync/dist/
You'll find a compressed tarball called imapsync-x.xx.tgz
where x.xx is the version number. Untar the tarball where
you want :
you want (on Unix):
tar xzvf imapsync-x.xx.tgz
Go into the directory imapsync-x.xx and read the INSTALL
file.
The freshmeat record is http://freshmeat.net/projects/imapsync/
Go into the directory imapsync-x.xx and read the INSTALL file.
The INSTALL file is also at
http://www.linux-france.org/prj/imapsync/INSTALL (for windows users)
The freshmeat record is at http://freshmeat.net/projects/imapsync/
=head1 SYNOPSIS
@ -83,6 +82,7 @@ The option list :
=cut
# comment
=pod
=head1 DESCRIPTION
@ -166,9 +166,10 @@ You may authenticate as one user (typically an admin user),
but be authorized as someone else, which means you don't
need to know every user's personal password. Specify
--authuser1 "adminuser" to enable this on host1. In this
case, --authmech1 PLAIN will be used, but otherwise,
--authmech1 CRAM-MD5 is the default. Same behavior with the
--authuser2 option.
case, --authmech1 PLAIN will be used by default since it
is the only way to go for now. So don't use --authmech1 SOMETHING
with --authuser1 "adminuser", it will not work.
Same behavior with the --authuser2 option.
=head1 EXIT STATUS
@ -236,17 +237,17 @@ In your report, please include:
Failure stories reported with the following 4 imap servers :
- MailEnable 1.54 (Proprietary) http://www.mailenable.com/
- DBMail 2.0.7 (GPL). But DBMail 1.2.1 works.
- DBMail 0.9, 2.0.7 (GPL). But DBMail 1.2.1 works.
Patient and confident testers are welcome.
- dkimap4 2.39
- Imail 7.04 (maybe).
Success stories reported with the following 33 imap servers
Success stories reported with the following 34 imap servers
(softwares names are in alphabetic order) :
- BincImap 1.2.3 (GPL) (http://www.bincimap.org/)
- CommuniGatePro server (Redhat 8.0)
- Courier IMAP 1.5.1, 2.2.0, 2.1.1, 2.2.1 (GPL)
- Courier IMAP 1.5.1, 2.2.0, 2.1.1, 2.2.1, 3.0.8 (GPL)
(http://www.courier-mta.org/)
- Critical Path (7.0.020)
- Cyrus IMAP 1.5, 1.6, 2.1, 2.1.15, 2.1.16, 2.1.18
@ -254,6 +255,7 @@ Success stories reported with the following 33 imap servers
v2.2.3-Invoca-RPM-2.2.3-8,
2.3-alpha (OSI Approved),
v2.2.12-Invoca-RPM-2.2.12-3.RHEL4.1,
2.2.13,
v2.3.1-Invoca-RPM-2.3.1-2.7.fc5,
(http://asg.web.cmu.edu/cyrus/)
- David Tobit V8 (proprietary Message system).
@ -264,6 +266,7 @@ Success stories reported with the following 33 imap servers
1.0.0 [dest] (LGPL) (http://www.dovecot.org/)
- Domino (Notes) 6.5, 5.0.6, 5.0.7, 7.0.2, 6.0.2CF1, 7.0.1 [from]
- Eudora WorldMail v2
- GMX IMAP4 StreamProxy.
- Groupwise IMAP (Novell) 6.x and 7.0. Buggy so see the FAQ.
- iPlanet Messaging server 4.15, 5.1, 5.2
- IMail 7.15 (Ipswitch/Win2003), 8.12
@ -356,24 +359,25 @@ Entries for imapsync:
=head1 SIMILAR SOFTWARES
imap_tools : http://www.athensfbc.com/imap_tools
offlineimap : http://gopher.quux.org:70/devel/offlineimap/
mailsync : http://mailsync.sourceforge.net/
imapxfer : http://www.washington.edu/imap/
part of the imap-utils from UW.
mailutil : replace imapxfer in
part of the imap-utils from UW.
http://www.gsp.com/cgi-bin/man.cgi?topic=mailutil
imaprepl : http://www.bl0rg.net/software/
http://freshmeat.net/projects/imap-repl/
imap_migrate: http://freshmeat.net/projects/imapmigration/
imapcopy : http://home.arcor.de/armin.diehl/imapcopy/imapcopy.html
migrationtool http://sourceforge.net/projects/migrationtool/
pop2imap : http://www.linux-france.org/prj/pop2imap/
imap_tools : http://www.athensfbc.com/imap_tools
offlineimap : http://software.complete.org/offlineimap
mailsync : http://mailsync.sourceforge.net/
imapxfer : http://www.washington.edu/imap/
part of the imap-utils from UW.
mailutil : replace imapxfer in
part of the imap-utils from UW.
http://www.gsp.com/cgi-bin/man.cgi?topic=mailutil
imaprepl : http://www.bl0rg.net/software/
http://freshmeat.net/projects/imap-repl/
imap_migrate : http://freshmeat.net/projects/imapmigration/
imapcopy : http://home.arcor.de/armin.diehl/imapcopy/imapcopy.html
migrationtool : http://sourceforge.net/projects/migrationtool/
imapmigrate : http://sourceforge.net/projects/cyrus-utils/
pop2imap : http://www.linux-france.org/prj/pop2imap/
Feedback (good or bad) will be always welcome.
$Id: imapsync,v 1.223 2007/06/15 04:08:44 gilles Exp gilles $
$Id: imapsync,v 1.233 2007/10/30 03:20:53 gilles Exp gilles $
@ -432,14 +436,14 @@ my(
use vars qw ($opt_G); # missing code for this will be option.
$rcs = ' $Id: imapsync,v 1.223 2007/06/15 04:08:44 gilles Exp gilles $ ';
$rcs = ' $Id: imapsync,v 1.233 2007/10/30 03:20:53 gilles Exp gilles $ ';
$rcs =~ m/,v (\d+\.\d+)/;
$VERSION = ($1) ? $1 : "UNKNOWN";
my $VERSION_IMAPClient = $Mail::IMAPClient::VERSION;
check_lib_version() or
die "Upgrade perl lib Mail::IMAPClient to release 2.2.9 at least\n";
#check_lib_version() or
# die "Upgrade perl lib Mail::IMAPClient to release 2.2.9 at least\n";
$mess_size_total_trans = 0;
@ -469,10 +473,10 @@ $error=0;
my $banner = join("",
'$RCSfile: imapsync,v $ ',
'$Revision: 1.223 $ ',
'$Date: 2007/06/15 04:08:44 $ ',
'$Revision: 1.233 $ ',
'$Date: 2007/10/30 03:20:53 $ ',
"\n",localhost_info(),
"Mail::IMAPClient version used here is ",
" and the module Mail::IMAPClient version used here is ",
$VERSION_IMAPClient,"\n",
"Command line used :\n",
"$0 @ARGV\n",
@ -509,17 +513,20 @@ sub connect_imap {
$imap->Server($host);
$imap->Port($port);
$imap->Debug($debugimap);
$imap->connect()
$imap->connect2()
or die "Can not open imap connection on [$host] : $@\n";
}
sub localhost_info {
my($infos) = join("", "Here is a $OSNAME system",
" ", join(" ", uname()),
")\nwith perl ",
sprintf("%vd", $PERL_VERSION), "\n");
my($infos) = join("",
"Here is a [$OSNAME] system (",
join(" ",
uname(),
),
")\n",
"with perl ",
sprintf("%vd", $PERL_VERSION));
return($infos);
}
@ -550,6 +557,9 @@ if(defined($authmd5) and not($authmd5)) {
$authmech2 ||= $authuser2 ? 'PLAIN' : 'CRAM-MD5';
}
$authmech1 = uc($authmech1);
$authmech2 = uc($authmech2);
$authuser1 ||= $user1;
$authuser2 ||= $user2;
@ -647,7 +657,7 @@ sub login_imap {
if ($ssl) {
$imap->State(Mail::IMAPClient::Connected);
} else {
$imap->connect()
$imap->connect2()
or die "Can not open imap connection on [$host] with user [$user] : $@\n";
}
print "Banner : ", server_banner($imap);
@ -1160,7 +1170,7 @@ FOLDER: foreach my $f_fold (@f_folders) {
$debug and print "internal date from 1: [$d]\n";
require Date::Manip;
Date::Manip->import(qw(ParseDate Date_Cmp UnixDate));
$d = UnixDate(ParseDate($d), "%d %b %Y %H:%M:%S %z");
$d = UnixDate(ParseDate($d), "%d-%b-%Y %H:%M:%S %z");
$d = "\"$d\"";
$debug and print "internal date from 1: [$d] (fixed)\n";
}
@ -1174,17 +1184,22 @@ FOLDER: foreach my $f_fold (@f_folders) {
print "flags from : [$flags_f][$d]\n";
last FOLDER if $to->IsUnconnected();
unless ($dry) {
#unless($new_id = $to->append_string($t_fold,$string, $flags_f, $d)){
unless($new_id = $to->append_file2($t_fold, $message_file, "", $flags_f, $d)){
if ($OSNAME eq "MSWin32") {
$new_id = $to->append_string($t_fold,$string, $flags_f, $d);
}
else {
$new_id = $to->append_file2($t_fold, $message_file, "", $flags_f, $d);
}
unless($new_id){
warn "Couldn't append msg #$f_msg (Subject:[".
$from->subject($f_msg)."]) to folder $t_fold: ",
$to->LastError, "\n";
$error++;
$mess_size_total_error += $f_size;
next MESS;
}else{
# good
# good
# $new_id is an id if the IMAP server has the
# UIDPLUS capability else just a ref
print "Copied msg id [$f_msg] to folder $t_fold msg id [$new_id]\n";
@ -1515,6 +1530,7 @@ sub string_to_file {
sub usage {
my $localhost_info = localhost_info();
print <<EOF;
usage: $0 [options]
@ -1524,7 +1540,8 @@ Several options are mandatory.
--host1 <string> : "from" imap server. Mandatory.
--port1 <int> : port to connect on host1. Default is 143.
--user1 <string> : user to login on host1. Mandatory.
--authuser1 <string> : user to auth with on host1 (admin user).
--authuser1 <string> : user to auth with on host1 (admin user).
Avoid using --authmech1 SOMETHING with --authuser1.
--password1 <string> : password for the user1. Dangerous, use --passfile1
--passfile1 <string> : password file for the user1. Contains the password.
--host2 <string> : "destination" imap server. Mandatory.
@ -1535,7 +1552,7 @@ Several options are mandatory.
--passfile2 <string> : password file for the user2. Contains the password.
--noauthmd5 : don't use MD5 authentification.
--authmech1 <string> : auth mechanism to use with host1:
PLAIN, LOGIN, CRAM-MD5 etc.
PLAIN, LOGIN, CRAM-MD5 etc. Use UPPERCASE.
--authmech2 <string> : auth mechanism to use with host2. See --authmech1
--ssl1 : use an SSL connection on host1.
--ssl2 : use an SSL connection on host2.
@ -1642,7 +1659,7 @@ $0 \\
--host1 imap.truc.org --user1 foo --passfile1 /etc/secret1 \\
--host2 imap.trac.org --user2 bar --passfile2 /etc/secret2
$localhost_info
Mail::IMAPClient version is $Mail::IMAPClient::VERSION
$rcs
imapsync copyleft is the GNU General Public License.
@ -2132,3 +2149,65 @@ sub _cram_md5_2 {
$client->Password());
return MIME::Base64::encode($client->User() . " $hmac", "");
}
sub connect2 {
my $self = shift;
$self->Port(143)
if defined ($IO::Socket::INET::VERSION)
and $IO::Socket::INET::VERSION eq '1.25'
and !$self->Port;
%$self = (%$self, @_);
my $sock = ($self->Ssl ? IO::Socket::SSL->new : IO::Socket::INET->new);
my $dp = ($self->Ssl ? 'imaps(993)' : 'imap(143)');
#print "i01\n";
my $ret = $sock->configure({
PeerAddr => $self->Server ,
PeerPort => $self->Port||$dp ,
Proto => 'tcp' ,
Timeout => $self->Timeout||0 ,
Debug => $self->Debug ,
});
#print "i02\n";
unless ( defined($ret) ) {
$self->LastError( "$@\n");
$@ = "$@";
carp "$@"
unless defined wantarray;
return undef;
}
#print "i03\n";
$self->Socket($sock);
$self->State(Connected);
$sock->autoflush(1) ;
my ($code, $output);
$output = "";
until ( $code ) {
$output = $self->_read_line or return undef;
for my $o (@$output) {
$self->_debug("Connect: Received this from readline: " .
join("/",@$o) . "\n");
$self->_record($self->Count,$o); # $o is a ref
next unless $o->[TYPE] eq "OUTPUT";
($code) = $o->[DATA] =~ /^\*\s+(OK|BAD|NO)/i ;
}
}
if ($code =~ /BYE|NO /) {
$self->State(Unconnected);
return undef ;
}
if ($self->User and $self->Password) {
return $self->login ;
} else {
return $self;
}
}

2071
imapsync2
View file

File diff suppressed because it is too large Load diff

2
learn/hugemigr
View file

@ -1,6 +1,6 @@
#!/bin/sh
{while IFS=';' read u1 p1 u2 p2; do
{ while IFS=';' read u1 p1 u2 p2; do
imapsync --user1 "$u1" --password1 "$p1" --user2 "$u2" --password2 "$p2" ...
done ; } < file.csv

39
memo
View file

@ -16,6 +16,8 @@ niouzes_compil() {
cd $DIR_SAVE
}
lfo_announce() {
software_version
NEWS_FILE="/home/gilles/public_html/www.linux-france.org/html/niouzes/niouzes_imapsync.xml"
@ -26,7 +28,7 @@ else
<news date="`date '+%Y%m%d'`">
`LANG=fr date '+%A %d %B %Y'` : Synchronisez ou migrez vos boites
aux lettres avec économie et l'outil <A
aux lettres avec économie et l\'outil <A
HREF="prj/imapsync/">imapsync $VERSION</A> (Gilles LAMIRAL)
</news>
EOF
@ -42,22 +44,20 @@ fm_read_param() {
}
fm_announce() {
fm_init() {
software_version
NEWS_FILE_FM="/home/gilles/public_html/imapsync/freshmeat_submition"
NEWS_FILE_FM_INP=${NEWS_FILE_FM}.inp
NEWS_FILE_FM_OUT=${NEWS_FILE_FM}.out
if ! newer VERSION $NEWS_FILE_FM_OUT; then
echo "$VERSION already submitted on freshmeat"
else
if newer VERSION $NEWS_FILE_FM_INP; then
echo "Update $NEWS_FILE_FM_INP please"
return 1
fi
}
fm_read_param
cat > $NEWS_FILE_FM_OUT << EOF
fm_read_announce() {
fm_init
fm_read_param
cat << EOF
Project: imapsync
Version: $VERSION
Release-Focus: $RELEASE_FOCUS
@ -68,7 +68,22 @@ Gzipped-Tar-URL: http://www.linux-france.org/prj/imapsync/dist/
$TEXT_BODY
EOF
#return
}
fm_announce() {
fm_init
if ! newer VERSION $NEWS_FILE_FM_OUT; then
echo "$VERSION already submitted on freshmeat"
else
if newer VERSION $NEWS_FILE_FM_INP; then
echo "Update $NEWS_FILE_FM_INP please"
return 1
fi
fm_read_param
fm_read_announce > $NEWS_FILE_FM_OUT
freshmeat-submit < $NEWS_FILE_FM_OUT
fi

15
t/01_connect Normal file
View file

@ -0,0 +1,15 @@
#!/usr/bin/perl -w
use Mail::IMAPClient;
$imap = Mail::IMAPClient->new();
$imap->Debug(1);
$imap->Server('Xlouloutte.dyndns.org');
$imap->connect() or die;
$imap->User('MarkOv@est.belle');
$imap->Password('emhj91ly');
$imap->login();
$imap->logout();

36
tests.sh
View file

@ -1,6 +1,6 @@
#!/bin/sh
# $Id: tests.sh,v 1.61 2007/06/15 04:06:58 gilles Exp gilles $
# $Id: tests.sh,v 1.64 2007/10/30 03:20:32 gilles Exp gilles $
#### Shell pragmas
@ -26,9 +26,9 @@ run_test() {
}
run_tests() {
for t in $*; do
for t in "$@"; do
test_count=`expr 1 + $test_count`
run_test $t
run_test "$t"
sleep 1
done
}
@ -71,9 +71,10 @@ no_args() {
# dprof()
sendtestmessage() {
email=${1:-"tata@est.belle"}
rand=`pwgen 16 1`
mess='test:'$rand
cmd="echo $mess""| mail -s ""$mess"" tata@est.belle"
cmd="echo $mess""| mail -s ""$mess"" $email"
echo $cmd
eval "$cmd"
}
@ -445,6 +446,16 @@ ll_bad_host()
}
ll_bad_host_ssl()
{
! ./imapsync \
--host1 badhost --user1 toto@est.belle \
--passfile1 /var/tmp/secret1 \
--host2 badhost --user2 titi@est.belle \
--passfile2 /var/tmp/secret2 \
--ssl1 --ssl2
}
ll_justfoldersizes()
{
@ -843,6 +854,20 @@ ariasolutions() {
}
ariasolutions2() {
./imapsync \
--host1 209.17.174.12 \
--user1 chrisw@basebuilding.net \
--passfile1 /var/tmp/secret.ariasolutions2 \
--host2 209.17.174.20 \
--user2 chrisw@basebuilding.net\
--passfile2 /var/tmp/secret.ariasolutions2 \
--noauthmd5 --syncinternaldates
# --dry --debug --debugimap
}
##########################
##########################
@ -883,6 +908,7 @@ test $# -eq 0 && run_tests \
ll_sep2 \
ll_bad_login \
ll_bad_host \
ll_bad_host_ssl \
ll_justfoldersizes \
ll_useheader \
ll_regexmess \
@ -901,7 +927,7 @@ test $# -eq 0 && run_tests \
# selective tests
test $# -gt 0 && run_tests $*
test $# -gt 0 && run_tests "$@"
# If there, all is good