#!/usr/bin/perl

# structure
# pod documentation
# pragmas
# main program
# global variables initialisation
# get_options(  ) ;
# default values
# folder loop
# subroutines
# IMAPClient 3.xx ads

# pod documentation

=pod

=head1 NAME 

imapsync - IMAP synchronisation, sync, copy or migration tool.
Synchronises mailboxes between two imap servers.
Good at IMAP migration. More than 52 different IMAP server softwares
supported with success, few failures.

$Revision: 1.592 $

=head1 SYNOPSIS

To synchronize imap account "foo" on "imap.truc.org"
           to  imap account "bar" on "imap.trac.org"
           with foo password "secret1"
           and  bar password "secret2":

  imapsync \
   --host1 imap.truc.org --user1 foo --password1 secret1 \
   --host2 imap.trac.org --user2 bar --password2 secret2

=head1 INSTALL

 imapsync works fine under any Unix OS with perl.
 imapsync works fine under Windows (2000, XP, Vista, Seven) 
 with Strawberry Perl (5.10, 5.12 or higher)
 or as a standalone binary software imapsync.exe

imapsync can be available directly on the following distributions:
FreeBSD, Debian, Ubuntu, Gentoo, Fedora,
NetBSD, Darwin, Mandriva and OpenBSD.

 Purchase latest imapsync at
 http://imapsync.lamiral.info/

 You'll receive a link to a compressed tarball called imapsync-x.xx.tgz
 where x.xx is the version number. Untar the tarball where
 you want (on Unix):

 tar xzvf  imapsync-x.xx.tgz

 Go into the directory imapsync-x.xx and read the INSTALL file.
 The INSTALL file is also at 
 http://imapsync.lamiral.info/INSTALL

 The freecode (was freshmeat) record is at 
 http://freecode.com/projects/imapsync

=head1 USAGE

 imapsync [options]

To get a description of each option just run imapsync like this:

  imapsync --help
  imapsync

The option list:

  imapsync [--host1 server1]  [--port1 <num>]
           [--user1 <string>] [--passfile1 <string>]
           [--host2 server2]  [--port2 <num>]
           [--user2 <string>] [--passfile2 <string>]
           [--ssl1] [--ssl2]
	   [--tls1] [--tls2]
           [--authmech1 <string>] [--authmech2 <string>]
           [--proxyauth1] [--proxyauth2]
	   [--domain1] [--domain2] 
           [--authmd51] [--authmd52]
           [--folder <string> --folder <string> ...]
           [--folderrec <string> --folderrec <string> ...]
           [--include <regex>] [--exclude <regex>]
           [--prefix2 <string>] [--prefix1 <string>] 
           [--regextrans2 <regex> --regextrans2 <regex> ...]
           [--sep1 <char>]
           [--sep2 <char>]
           [--justfolders] [--justfoldersizes] [--justconnect] [--justbanner]
           [--syncinternaldates]
           [--idatefromheader]
           [--syncacls]
           [--regexmess <regex>] [--regexmess <regex>]
           [--maxsize <int>]
	   [--minsize <int>]
           [--maxage <int>]
           [--minage <int>]
           [--search <string>]
           [--search1 <string>]
           [--search2 <string>]
           [--skipheader <regex>]
           [--useheader <string>] [--useheader <string>]
	   [--nouid1] [--nouid2] 
	   [--usecache]
           [--skipsize] [--allowsizemismatch]
           [--delete] [--delete2]
           [--expunge] [--expunge1] [--expunge2] [--uidexpunge2]
	   [--delete2folders] [--delete2foldersonly] [--delete2foldersbutnot]
           [--subscribed] [--subscribe] [--subscribe_all] 
           [--nofoldersizes] [--nofoldersizesatend] 
           [--dry]
           [--debug] [--debugimap][--debugimap1][--debugimap2]
           [--timeout <int>] 
           [--split1] [--split2] 
           [--reconnectretry1 <int>] [--reconnectretry2 <int>]
	   [--noreleasecheck]
           [--releasecheck]
	   [--pidfile <filepath>]
	   [--tmpdir  <dirpath>]
           [--version] [--help]
	   [--tests] [--tests_debug]
  
=cut
# comment

=pod

=head1 DESCRIPTION

The command imapsync is a tool allowing incremental and
recursive imap transfer from one mailbox to another. 

By default all folders are transferred, recursively, all 
possible flags (\Seen \Answered \Flagged etc.) are synced too.

We sometimes need to transfer mailboxes from one imap server to
another. This is called migration.

imapsync is a good tool because it reduces the amount
of data transferred by not transferring a given message 
if it is already on both sides. Same headers
and the transfer is done only once. All flags are
preserved, unread will stay unread, read will stay read,
deleted will stay deleted. You can stop the transfer at any
time and restart it later, imapsync works well with bad 
connections.

You can decide to delete the messages from the source mailbox
after a successful transfer, it can be a good feature when migrating
live mailboxes since messages will be only on one side.
In that case, use the --delete option. Option --delete implies 
also option --expunge so all messages marked deleted on host1 
will be really deleted.
(you can use --noexpunge to avoid this but I don't see any
good real world scenario for the combinaison --delete --noexpunge).

You can also just synchronize a mailbox B from another mailbox A
in case you just want to keep a "live" copy of A in B. 
In that case --delete2 can be used, it deletes messages in host2
folder B that are not in host1 folder A.

imapsync is not adequate for maintaining two active imap accounts 
in synchronization where the user plays independently on both sides.
Use offlineimap (written by John Goerzen) or mbsync (written by 
Michael R. Elkins) for 2 ways synchronizations.


=head1 OPTIONS

To get a description of each option just invoke: 

imapsync --help

=head1 HISTORY

I wrote imapsync because an enterprise (basystemes) paid me to install
a new imap server without losing huge old mailboxes located on a far
away remote imap server accessible by a low bandwidth link. The tool
imapcp (written in python) could not help me because I had to verify
every mailbox was well transferred and delete it after a good
transfer. imapsync started life as a copy_folder.pl patch.
The tool copy_folder.pl comes from the Mail-IMAPClient-2.1.3 perl
module tarball source (in the examples/ directory of the tarball).

=head1 EXAMPLE

While working on imapsync parameters please run imapsync in
dry mode (no modification induced) with the --dry
option. Nothing bad can be done this way.

To synchronize the imap account "buddy" (with password "secret1") 
on host "imap.src.fr" to the imap account "max" (with password "secret2") 
on host "imap.dest.fr":

 imapsync --host1 imap.src.fr  --user1 buddy --password1 secret1 \
          --host2 imap.dest.fr --user2 max   --password2 secret2

Then you will have max's mailbox updated from buddy's
mailbox.

=head1 SECURITY

You can use --passfile1  instead of --password1 to give the
password since it is safer. With --password1 option any user 
on your host can see the password by using the 'ps auxwwww'
command. Using a variable (like $PASSWORD1) is also
dangerous because of the 'ps auxwwwwe' command. So, saving
the password in a well protected file (600 or rw-------) is
the best solution.

imasync is not totally protected against sniffers on the
network since passwords may be transferred in plain text
if CRAM-MD5 is not supported by your imap servers.  Use
--ssl1 (or --tls1) and --ssl2 (or --tls2) to enable 
encryption on host1 and host2.

You may authenticate as one user (typically an admin user),
but be authorized as someone else, which means you don't
need to know every user's personal password.  Specify
--authuser1 "adminuser" to enable this on host1.  In this
case, --authmech1 PLAIN will be used 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.
Authenticate with an admin account must be supported by your
imap server to work with imapsync.

When working on Sun/iPlanet/Netscape IMAP servers you must use 
--proxyauth1 to enable administrative user to masquerade as another user. 
Can also be used on destination server with --proxyauth2 

You can authenticate with OAUTH when transfering from Google Apps.
The consumer key will be the domain part of the --user, and the
--password will be used as the consumer secret. It does not work
with Google Apps free edition. 

=head1 EXIT STATUS

imapsync will exit with a 0 status (return code) if everything went good.
Otherwise, it exits with a non-zero status.

So if you have an unreliable internet connection, you can use this loop 
in a Bourne shell:

        while ! imapsync ...; do 
              echo imapsync not complete
        done

=head1 LICENSE

imapsync is free, open, public but not always gratis software 
cover by the NOLIMIT Public License.
See the LICENSE file included in the distribution or just read this
simple sentence as it is the licence text:
No limit to do anything with this work and this license.

=head1 MAILING-LIST

The public mailing-list may be the best way to get free support.

To write on the mailing-list, the address is:
<imapsync@linux-france.org>

To subscribe, send any message (even empty) to:
<imapsync-subscribe@listes.linux-france.org>
then just reply to the confirmation message.

To unsubscribe, send a message to:
<imapsync-unsubscribe@listes.linux-france.org>

To contact the person in charge for the list:
<imapsync-request@listes.linux-france.org>

The list archives are available at:
http://www.linux-france.org/prj/imapsync_list/
So consider that the list is public, anyone
can see your post. Use a pseudonym or do not
post to this list if you want to stay private.

Thank you for your participation.

=head1 AUTHOR

Gilles LAMIRAL <gilles.lamiral@laposte.net>

Feedback good or bad is very often welcome.

Gilles LAMIRAL earns his living by writing, installing,
configuring and teaching free, open and often gratis
softwares. It used to be "always gratis" but now it is
"often" because imapsync is sold by its author, a good
way to stay maintening and supporting free open public 
softwares (see the license) over decades.

=head1 BUG REPORT GUIDELINES

Help me to help you: follow the following guidelines.

Report any bugs or feature requests to the public mailing-list 
or to the author.

Before reporting bugs, read the FAQ, the README and the
TODO files. http://imapsync.lamiral.info/

Upgrade to last imapsync release, maybe the bug
is already fixed.

Upgrade to last Mail-IMAPClient Perl module.
http://search.cpan.org/dist/Mail-IMAPClient/
maybe the bug is already fixed there.

Make a good title with word "imapsync" in it (my spam filter won't filter it), 
Try to write an email title with more words than just "imapsync" or "problem",
a good title is made of keywords summary, but not too long (one visible line).

Help us to help you: in your report, please include:

 - imapsync version.

 - output near the first failures, a few lines before is good to get the context
   of the issue. First failures messages are often more significant than 
   the last ones. 
 
 - if the issue is always related to the same messages, include the output 
   with --debug --debugimap, near the failure point. For example,
   Isolate a buggy message or two in a folder 'BUG' and use 

     imapsync ... --folder 'BUG' --debug --debugimap 

 - imap server softwares on both sides and their version number.

 - imapsync with all the options you use,  the full command line
   you use (except the passwords of course). 

 - IMAPClient.pm version.

 - the run context. Do you run imapsync.exe, a unix binary 
   or the perl script imapsync.

 - operating system running imapsync.

 - virtual software context (vmware, xen etc.)

 - operating systems on both sides and the third side in case
   you run imapsync on a foreign host from the both.

Most of those values can be found as a copy/paste at the begining of the output,
so a carbon copy of the output is a very easy and very good debug report for me.

One time in your life, read the paper 
"How To Ask Questions The Smart Way"
http://www.catb.org/~esr/faqs/smart-questions.html
and then forget it.

=head1 IMAP SERVERS 

Failure stories reported in the past with the following 6 imap servers.
Maybe last imapsync release can run successfully with them.
Don't hesitate to have a try, It's been a long time since last failure occured,
I will help you and make efforts to switch them to the success list, 
that's my job.

 - MailEnable 1.54 (Proprietary) but MailEnable 4.23 is supported. 
 - DBMail 0.9, 2.0.7 (GPL). But DBMail 1.2.1 is supported.
   Patient and confident testers are welcome.
 - Imail 7.04 (maybe).
 - (2011) MDaemon 12.0.3 as host2 but MDaemon is supported as host1.
   MDaemon is simply buggy with the APPEND IMAP command with 
   any IMAP email client.
 - Hotmail since hotmail.com does not provide IMAP access
 - Outlook.com since outlook.com does not provide IMAP access

Success stories reported with the following 62 imap servers 
(software names are in alphabetic order): 

 - 1und1 H mimap1 84498 [host1] H mibap4 95231 [host1]
 - a1.net imap.a1.net IMAP4 Ready [host1]
 - Apple Server 10.6 Snow Leopard [host1]
 - Archiveopteryx 2.03, 2.04, 2.09, 2.10 [host2], 3.0.0 [host2]
   (OSL 3.0) http://www.archiveopteryx.org/
 - Atmail 6.x [host1]
 - Axigen Mail Server Version 8.0.0
 - BincImap 1.2.3 (GPL) (http://www.bincimap.org/)
 - CommuniGatePro server (Redhat 8.0) (Solaris), CommuniGate Pro 5.2.17[host2] (CentOS 5.4)
 - Courier IMAP 1.5.1, 2.2.0, 2.1.1, 2.2.1, 3.0.8, 3.0.3, 4.1.1 (GPL) 
   (http://www.courier-mta.org/)
 - Critical Path (7.0.020)
 - Cyrus IMAP 1.5, 1.6, 
   2.1, 2.1.15, 2.1.16, 2.1.18 
   2.2.1, 2.2.2-BETA, 2.2.3, 2.2.6, 2.2.10, 2.2.12, 2.2.13,
   2.3-alpha (OSI Approved), 2.3.1, 2.3.7, 2.3.16
   (http://asg.web.cmu.edu/cyrus/)
 - David Tobit V8 (proprietary Message system).
 - Deerfield VisNetic MailServer 5.8.6 [host1] (http://www.deerfield.net/products/visnetic-mailserver/) 
 - DBMail 1.2.1, 2.0.4, 2.0.9, 2.2rc1 (GPL) (http://www.dbmail.org/).
   2.0.7 seems buggy.
 - DBOX 2.41 System [host1] (http://www.dbox.handshake.de/).
 - Deerfield VisNetic MailServer 5.8.6 [host1]
 - dkimap4 [host1]
 - Domino (Notes) 4.61 [host1], 6.5 [host1], 5.0.6, 5.0.7, 7.0.2, 6.0.2CF1, 
   7.0.1 [host1], 8.0.1 [host1], 8.5.2 [host2], 8.5.3 [host1]
 - Dovecot 0.99.10.4, 0.99.14, 0.99.14-8.fc4, 1.0-0.beta2.7, 
   1.0.0 [dest/source] (LGPL) (http://www.dovecot.org/)
 - Eudora WorldMail v2
 - FirtClass 9 [host1] Read the FAQ! (http://www.firstclass.com/)
 - FTGate (http://www.ftgate.com/)
 - Fusemail imap.fusemail.net:143 (https://www.fusemail.com/).
 - Gimap (Gmail imap)
 - GMX IMAP4 StreamProxy.
 - Groupwise IMAP (Novell) 6.x and 7.0. Buggy so see the FAQ.
 - hMailServer 5.40-B1950 [host12], 5.3.3 [host2], 4.4.1 [host1] (see FAQ)
 - IceWarp Server 10.4.5 [host1] (http://www.icewarp.com/)
 - iPlanet Messaging server 4.15, 5.1, 5.2
 - IMail 7.15 (Ipswitch/Win2003), 8.12, 11.03 [host1]
 - Kerio 7.2.0 Patch 1 [host12], Kerio 8 [host1]
 - Mail2World IMAP4 Server 2.5 [host1] (http://www.mail2world.com/)
 - MailEnable 4.23 [host1] [host2], 4.26 [host1][host2], 5 [host1]
 - MDaemon 7.0.1, 8.0.2, 8.1, 9.5.4 (Windows server 2003 R2 platform), 
   9.6.5 [host1], 12 [host2], 12.0.3 [host1], 12.5.5 [host1],
 - Mercury 4.1 (Windows server 2000 platform)
 - Microsoft Exchange Server 5.5, 6.0.6249.0[host1], 6.0.6487.0[host1], 
   6.5.7638.1 [host2], 6.5 [host1], Exchange 2007 SP1 (with Update Rollup 2), 
   Exchange2007-EP-SP2,
   Exchange 2010 RTM (Release to Manufacturing) [host2],
   Exchange 2010 SP1 RU2[host2],
 - Mirapoint, 4.1.9-GA [host1]
 - Netscape Mail Server 3.6 (Wintel !)
 - Netscape Messaging Server 4.15 Patch 7
 - Office 365 [host1] [host2]
 - OpenMail IMAP server B.07.00.k0 (Samsung Contact ?)
 - OpenWave
 - Oracle Beehive [host1]
 - Parallels Plesk Panel 9.x [host2] 11.x [host2] (http://www.parallels.com/)
 - Qualcomm Worldmail (NT)
 - QQMail IMAP4Server [host1] [host2] https://en.mail.qq.com/
 - RackSpace hoster secure.emailsrvr.com:993 http://www.rackspace.com/
 - Rockliffe Mailsite 5.3.11, 4.5.6
 - Samsung Contact IMAP server 8.5.0
 - Scalix v10.1, 10.0.1.3, 11.0.0.431, 11.4.6
 - Sendmail Mail Store IMAP4rev1 (5.5.6/mstore-5-5-build-1874 [host1].
 - SmarterMail, Smarter Mail 5.0 Enterprise, Smarter Mail 5.5 [host1], 
   SmarterMail Professional 10.2 [host1], Smarter Mail 11.7 [host1][host2].
 - Softalk Workgroup Mail 7.6.4 [host1].
 - SunONE Messaging server 5.2, 6.0 (SUN JES - Java Enterprise System)
 - Sun Java(tm) System Messaging Server 6.2-2.05,  6.2-7.05, 6.3
 - Surgemail 3.6f5-5, 6.3d-72 [host2]
 - UW-imap servers (imap-2000b) rijkkramer IMAP4rev1 2000.287
   (RedHat uses UW like 2003.338rh), v12.264 Solaris 5.7 (OSI Approved) 
   (http://www.washington.edu/imap/)
 - UW - QMail v2.1
 - VMS, Imap part of TCP/IP suite of VMS 7.3.2
 - Yahoo [host1]
 - Zarafa 6,40,0,20653 [host1] (http://www.zarafa.com/)
 - Zarafa ZCP 7.1.4 IMAP Gateway [host2]
 - Zimbra-IMAP 3.0.1 GA 160, 3.1.0 Build 279, 4.0.5, 4.5.2, 4.5.6, 
   Zimbra 5.0.24_GA_3356.RHEL4 [host1], 5.5, 6.x

Please report to the author any success or bad story with
imapsync and do not forget to mention the IMAP server
software names and version on both sides. This will help
future users. To help the author maintaining this section
report the two lines at the begining of the output if they
are useful to know the softwares. Example:

 Host1 software:* OK louloutte Cyrus IMAP4 v1.5.19 server ready
 Host2 software:* OK Courier-IMAP ready

You can use option --justconnect to get those lines.
Example:

  imapsync --host1 imap.troc.org --host2 imap.trac.org --justconnect


=head1 HUGE MIGRATION

Pay special attention to options 
--subscribed
--subscribe
--delete
--delete2
--delete2folders
--maxage
--minage
--maxsize
--useuid
--usecache

If you have many mailboxes to migrate think about a little
shell program. Write a file called file.txt (for example)
containing users and passwords.
The separator used in this example is ';'

The file.txt file contains:

user001_1;password001_1;user001_2;password001_2
user002_1;password002_1;user002_2;password002_2
user003_1;password003_1;user003_2;password003_2
user004_1;password004_1;user004_2;password004_2
user005_1;password005_1;user005_2;password005_2
...

On Unix the shell program can be:

 { while IFS=';' read  u1 p1 u2 p2; do 
	imapsync --host1 imap.side1.org --user1 "$u1" --password1 "$p1" \
                 --host2 imap.side2.org --user2 "$u2" --password2 "$p2" ...
 done ; } < file.txt

On Windows the batch program can be:

  FOR /F "tokens=1,2,3,4 delims=; eol=#" %%G IN (file.txt) DO imapsync ^
  --host1 imap.side1.org --user1 %%G --password1 %%H ^
  --host2 imap.side2.org --user2 %%I --password2 %%J ...

The ... have to be replaced by nothing or any imapsync option.
Welcome in shell programming !

You will find already written scripts at 
http://imapsync.lamiral.info/examples/



=head1 Hacking

Feel free to hack imapsync as the NOLIMIT license permits it.

=head1 Links

Entries for imapsync:
  http://www.imap.org/products/showall.php


=head1 SIMILAR SOFTWARES

  imap_tools    : http://www.athensfbc.com/imap_tools
  offlineimap   : https://github.com/nicolas33/offlineimap
  mbsync        : http://isync.sourceforge.net/
  mailsync      : http://mailsync.sourceforge.net/
  mailutil      : http://www.washington.edu/imap/
                  part of the UW IMAP tookit.
  imaprepl      : http://www.bl0rg.net/software/
                  http://freecode.com/projects/imap-repl/
  imapcopy      : http://home.arcor.de/armin.diehl/imapcopy/imapcopy.html
  migrationtool : http://sourceforge.net/projects/migrationtool/
  imapmigrate   : http://sourceforge.net/projects/cyrus-utils/
  wonko_imapsync: http://wonko.com/article/554
                  see also file W/tools/wonko_ruby_imapsync
  exchange-away : http://exchange-away.sourceforge.net/
  pop2imap      : http://www.linux-france.org/prj/pop2imap/


Feedback (good or bad) will often be welcome.

$Id: imapsync,v 1.592 2014/05/22 10:03:17 gilles Exp gilles $

=cut


# pragmas

use strict ;
use warnings ;
++$| ;
use Carp ;
use Getopt::Long ;
use Mail::IMAPClient 3.29 ;
use Digest::MD5  qw( md5 md5_hex md5_base64 ) ;
use Digest::HMAC_SHA1 qw( hmac_sha1 ) ;
#use Term::ReadKey ;
#use IO::Socket::SSL ;
use MIME::Base64 ;
use English '-no_match_vars' ;
use File::Basename ;
use POSIX qw(uname SIGALRM) ;
use Fcntl ;
use File::Spec ;
use File::Path qw( mkpath rmtree ) ;
use File::Copy::Recursive ;
use IO::Socket qw(:crlf SOL_SOCKET SO_KEEPALIVE) ;
use Errno qw(EAGAIN EPIPE ECONNRESET) ;
use File::Glob qw( :glob ) ;
use IO::File ;
use Time::Local ;
use Time::HiRes qw( time sleep ) ;
use Test::More 'no_plan' ;
use IPC::Open3 'open3' ;
use IO::Tee ;
#use Unix::Sysexits ;

# global variables

my(
        $rcs, $pidfile, $pidfilelocking, 
	$debug, $debugimap, $debugimap1, $debugimap2, $debugcontent, $debugflags,
	$debugLIST, $debugsleep, $debugdev, $debugmemory, $debugmaxlinelength,
	$nb_errors,
	$host1, $host2, $port1, $port2,
	$user1, $user2, $domain1, $domain2, 
	$password1, $password2, $passfile1, $passfile2,
        @folder, @include, @exclude, @folderrec,
        @folderfirst, @folderlast,
        $prefix1, $prefix2, 
        @regextrans2, @regexmess, @regexflag,
	$flagsCase, $filterflags, $syncflagsaftercopy,
        $sep1, $sep2,
	$syncinternaldates,
        $idatefromheader,
        $syncacls,
        $fastio1, $fastio2, 
	$maxsize, $minsize, $maxage, $minage,
        $exitwhenover,
        $search, $search1, $search2, 
        $skipheader, @useheader,
        $skipsize, $allowsizemismatch, $foldersizes, $foldersizesatend, $buffersize,
	$delete, $delete2, $delete2duplicates,
        $expunge, $expunge1, $expunge2, $uidexpunge2, $dry,
        $justfoldersizes,
        $authmd5, $authmd51, $authmd52, 
        $subscribed, $subscribe, $subscribe_all,
	$version, $help, 
        $justconnect, $justfolders, $justbanner,
        $fast,
        
        $total_bytes_transferred,
        $total_bytes_skipped,
        $total_bytes_error,
        $nb_msg_transferred, 
	$nb_msg_skipped, 
	$nb_msg_skipped_dry_mode,
	$h1_nb_msg_duplicate,
	$h2_nb_msg_duplicate,
	$h1_nb_msg_noheader,
	$h2_nb_msg_noheader,
	$h1_total_bytes_duplicate,
	$h2_total_bytes_duplicate,
	$h1_nb_msg_deleted,
	$h2_nb_msg_deleted,
        
        $h1_bytes_processed, 
        $h1_nb_msg_processed,
        $h1_nb_msg_at_start, $h1_bytes_start,
        $h2_nb_msg_start, $h2_bytes_start, 
        $h1_nb_msg_end, $h1_bytes_end,
        $h2_nb_msg_end, $h2_bytes_end, 
        
        $timeout,
	$timestart, $timestart_int, $timeend,
        $timebefore,
        $ssl1, $ssl2, 
        $ssl1_SSL_version, $ssl2_SSL_version,
	$tls1, $tls2,
	$uid1, $uid2,
        $authuser1, $authuser2,
        $proxyauth1, $proxyauth2,
        $authmech1, $authmech2,
        $split1, $split2,
        $reconnectretry1, $reconnectretry2,
	$relogin1, $relogin2,
	$tests, $test_builder, $tests_debug,
	$allow3xx, $justlogin,
	$tmpdir,
	$releasecheck,
	$max_msg_size_in_bytes,
	$modules_version,
	$delete2folders, $delete2foldersonly, $delete2foldersbutnot,
	$usecache, $debugcache, $cacheaftercopy,
	$wholeheaderifneeded, %h1_msgs_copy_by_uid, $useuid, $h2_uidguess,
        $addheader,
        %h1, %h2,
        $checkselectable, $checkmessageexists,
        $expungeaftereach,
        $abletosearch,
        $showpasswords,
        $fixslash2,
        $messageidnodomain,
        $fixInboxINBOX,
        $maxlinelength,
        $minmaxlinelength,
	$uidnext_default,
        $fixcolonbug,
        $create_folder_old,
        $maxmessagespersecond,
        $maxbytespersecond,
        $skipcrossduplicates, $debugcrossduplicates,
        $log, $logfile,
	$disarmreadreceipts,
);

# main program

# global variables initialisation

$rcs = '$Id: imapsync,v 1.592 2014/05/22 10:03:17 gilles Exp gilles $ ';

$total_bytes_transferred   = 0;
$total_bytes_skipped = 0;
$total_bytes_error   = 0;
$nb_msg_transferred = 0;
$nb_msg_skipped = $nb_msg_skipped_dry_mode = 0;
$h1_nb_msg_deleted = $h2_nb_msg_deleted = 0;
$h1_nb_msg_duplicate = $h2_nb_msg_duplicate = 0;
$h1_nb_msg_noheader = $h2_nb_msg_noheader = 0;
$h1_total_bytes_duplicate = $h2_total_bytes_duplicate = 0;


$h1_nb_msg_at_start     = $h1_bytes_start = 0 ;
$h2_nb_msg_start     = $h2_bytes_start = 0 ;
$h1_nb_msg_processed = $h1_bytes_processed = 0 ;

$h1_nb_msg_end = $h1_bytes_end = 0 ;
$h2_nb_msg_end = $h2_bytes_end = 0 ;

$nb_errors = 0;
$max_msg_size_in_bytes = 0;

my %month_abrev = (
   Jan => 0,
   Feb => 1,
   Mar => 2,
   Apr => 3,
   May => 4,
   Jun => 5,
   Jul => 6,
   Aug => 7,
   Sep => 8,
   Oct => 9,
   Nov => 10,
   Dec => 11,
);

sub EX_USAGE { 
	# 64 on my linux box.
        # See http://search.cpan.org/~jmates/Unix-Sysexits-0.02/lib/Unix/Sysexits.pm
	return( 64 ) ;
}


# @ARGV will be eat by get_options()
my @argv_copy = @ARGV;

get_options(  ) ;

# $SIG{ INT } = \&catch_continue ;
local $SIG{ INT } = local $SIG{ QUIT } = local $SIG{ TERM } = \&catch_exit ;

$timestart = time(  );

$log       = defined($log)     ? $log : 1 ;
$logfile   = defined($logfile) ? $logfile : logfile( $timestart, $user2 ) ;

teelaunch( $logfile ) if ( $log ) ;

$timestart_int = int( $timestart ) ;
$timebefore = $timestart ;

my $timestart_str = localtime( $timestart ) ;
print "Transfer started at $timestart_str\n" ;
print "PID is $PROCESS_ID\n" ;
print "Log file is $logfile\n" if ( $log ) ;
$modules_version = defined( $modules_version ) ? $modules_version : 1 ;

# If you want releasecheck not to be done by default (like the github maintainer),
# then uncomment the first "$releasecheck =" line, the line ending with "0 ;".
# The second line (ending with "1 ;") can stay active or be commented, 
# the result will be the same: no releasecheck by default.

$releasecheck = defined($releasecheck) ? $releasecheck : 0 ;
#$releasecheck = defined($releasecheck) ? $releasecheck : 1 ;

my $warn_release = ($releasecheck) ? check_last_release() : '' ;

# default values

$tmpdir ||= File::Spec->tmpdir();
$pidfile ||= $tmpdir . '/imapsync.pid';

$pidfilelocking = defined( $pidfilelocking ) ? $pidfilelocking : 0 ;

# allow Mail::IMAPClient 3.0.xx by default
$allow3xx = defined($allow3xx) ? $allow3xx : 1;

$wholeheaderifneeded  = defined( $wholeheaderifneeded )  ? $wholeheaderifneeded  : 1;

# turn on RFC standard flags correction like \SEEN -> \Seen
$flagsCase = defined( $flagsCase ) ? $flagsCase : 1 ;

# Use PERMANENTFLAGS if available
$filterflags = defined( $filterflags ) ? $filterflags : 1 ;

# sync flags just after an APPEND, some servers ignore the flags given in the APPEND
# like MailEnable IMAP server.
# Off by default since it takes time.
$syncflagsaftercopy = defined( $syncflagsaftercopy ) ? $syncflagsaftercopy : 0 ;



# turn on relogin 5 by default
$relogin1 = defined( $relogin1 ) ? $relogin1 : 5 ;
$relogin2 = defined( $relogin2 ) ? $relogin2 : 5 ;

if ( $fast ) {
	# $useuid = 1 ;
	# $foldersizes      = 0 ;
	# $foldersizesatend = 0 ;
}

# Activate --usecache if --useuid is set and no --nousecache
$usecache = 1 if ( $useuid and ( ! defined( $usecache ) ) ) ;
$cacheaftercopy = 1 if ( $usecache and ( ! defined( $cacheaftercopy ) ) ) ;

$checkselectable = defined( $checkselectable ) ? $checkselectable : 1 ;
$checkmessageexists = defined( $checkmessageexists ) ? $checkmessageexists : 0 ;
$expungeaftereach = defined( $expungeaftereach ) ? $expungeaftereach : 1 ;
$abletosearch = defined( $abletosearch ) ? $abletosearch : 1 ;
$checkmessageexists = 0 if ( not $abletosearch ) ;
$showpasswords = defined( $showpasswords ) ? $showpasswords : 0 ;
$fixslash2 = defined( $fixslash2 ) ? $fixslash2 : 1 ;
$fixInboxINBOX = defined( $fixInboxINBOX ) ? $fixInboxINBOX : 1 ;
$create_folder_old = defined( $create_folder_old ) ? $create_folder_old : 0 ;

$delete2duplicates = 1 if ( $delete2 and ( ! defined( $delete2duplicates ) ) ) ;

$maxmessagespersecond = defined( $maxmessagespersecond ) ? $maxmessagespersecond : 0 ;
$maxbytespersecond    = defined( $maxbytespersecond )    ? $maxbytespersecond    : 0 ;

print banner_imapsync(@argv_copy);

print "Temp directory is $tmpdir\n";

is_valid_directory( $tmpdir ) || croak "Error creating tmpdir $tmpdir : $!" ;
write_pidfile( $pidfile ) if ( $pidfile ) ;

$fixcolonbug = defined( $fixcolonbug ) ? $fixcolonbug : 1 ;

if ( $usecache and $fixcolonbug ) { tmpdir_fix_colon_bug(  ) } ;

$modules_version and print "Modules version list:\n", modules_VERSION(), "\n";

check_lib_version() or 
  croak "imapsync needs perl lib Mail::IMAPClient release 3.25 or superior \n";

exit_clean( 0 ) if ( $justbanner ) ;

# By default, 100 at a time, not more.
$split1 ||= 100;
$split2 ||= 100;

$host1 || missing_option("--host1") ;
$port1 ||= ( $ssl1 ) ? 993 : 143;

$host2 || missing_option("--host2") ;
$port2 ||= ( $ssl2 ) ? 993 : 143;

$debugimap1 = $debugimap2 = 1 if ( $debugimap ) ;
$debug = 1 if ( $debugimap1 or $debugimap2 ) ;

# By default, don't take size to compare 
$skipsize = (defined $skipsize) ? $skipsize : 1;

$uid1 = defined($uid1) ? $uid1 : 1;
$uid2 = defined($uid2) ? $uid2 : 1;

$subscribe = defined($subscribe) ? $subscribe : 1;

# Allow size mismatch by default
$allowsizemismatch = defined($allowsizemismatch) ? $allowsizemismatch : 1;

$delete2folders = 1 
    if ( defined( $delete2foldersbutnot ) or defined( $delete2foldersonly ) ) ;

if ($justconnect) {
	justconnect();
	exit_clean(0);
}

$user1 || missing_option("--user1");
$user2 || missing_option("--user2");

$syncinternaldates = defined($syncinternaldates) ? $syncinternaldates : 1;

# Turn on expunge if there is not explicit option --noexpunge and option 
# --delete is given.
# Done because --delete --noexpunge is very dangerous on the second run:
# the Deleted flag is then synced to all previously transfered messages.
# So --delete implies --expunge is a better usability default behaviour.
if ($delete) {
	if ( ! defined($expunge)) {
		$expunge = 1;
	}
}

if ( $uidexpunge2 and not Mail::IMAPClient->can( 'uidexpunge' ) ) {
        print "Failure: uidexpunge not supported (IMAPClient release < 3.17), use --expunge2 instead\n" ;
        exit_clean( 3 ) ;
}

if ( ( $delete2 or $delete2duplicates ) and not defined( $uidexpunge2 ) ) {
        if ( Mail::IMAPClient->can( 'uidexpunge' ) ) {
                print "Info: will act as --uidexpunge2\n" ;
		$uidexpunge2 = 1 ;
        }elsif ( not defined( $expunge2 ) ) {
                 print "Info: will act as --expunge2 (no uidexpunge support)\n" ;
                $expunge2 = 1 ;
        }
}

if ( $delete and $delete2 ) {
	print "Warning: using --delete and --delete2 together is almost always a bad idea, exiting imapsync\n" ;
	exit_clean( 4 ) ;
}

if ($idatefromheader) {
	print "Turned ON idatefromheader, ",
	      "will set the internal dates on host2 from the 'Date:' header line.\n";
	$syncinternaldates = 0;
}

if ($syncinternaldates) {
	print "Info: turned ON syncinternaldates, ",
	      "will set the internal dates (arrival dates) on host2 same as host1.\n";
}else{
	print "Info: turned OFF syncinternaldates\n";
}



if (defined($authmd5) and ($authmd5)) {
	$authmd51 = 1 ;
	$authmd52 = 1 ;
}

if (defined($authmd51) and ($authmd51)) {
	$authmech1 ||= 'CRAM-MD5';
}
else{
	$authmech1 ||= $authuser1 ? 'PLAIN' : 'LOGIN';
}

if (defined($authmd52) and ($authmd52)) {
	$authmech2 ||= 'CRAM-MD5';
}
else{
	$authmech2 ||= $authuser2 ? 'PLAIN' : 'LOGIN';
}

$authmech1 = uc($authmech1);
$authmech2 = uc($authmech2);

if (defined $proxyauth1 && !$authuser1) {
        missing_option("With --proxyauth1, --authuser1");
}

if (defined $proxyauth2 && !$authuser2) {
        missing_option("With --proxyauth2, --authuser2");
}

$authuser1 ||= $user1;
$authuser2 ||= $user2;

print "Info: will try to use $authmech1 authentication on host1\n";
print "Info: will try to use $authmech2 authentication on host2\n";

$timeout = defined( $timeout ) ? $timeout : 120 ;
print "Info: imap connexions timeout is $timeout seconds\n";


$syncacls = (defined($syncacls)) ? $syncacls : 0 ;
$foldersizes = (defined($foldersizes)) ? $foldersizes : 1 ;
$foldersizesatend = (defined($foldersizesatend)) ? $foldersizesatend : $foldersizes ;



$fastio1 = (defined($fastio1)) ? $fastio1 : 0;
$fastio2 = (defined($fastio2)) ? $fastio2 : 0;

$reconnectretry1 = (defined($reconnectretry1)) ? $reconnectretry1 : 3;
$reconnectretry2 = (defined($reconnectretry2)) ? $reconnectretry2 : 3;

# Since select_msgs() returns no messages when uidnext does not return something
# then $uidnext_default is never used. So I have to remove it.
$uidnext_default = 999999 ;

@useheader = ( "Message-Id", "Message-ID", "Received" ) unless ( @useheader ) ;

my %useheader ;

# Make a hash %useheader of each --useheader 'key' in uppercase
for ( @useheader ) { $useheader{ uc( $_ ) } = undef } ;

#require Data::Dumper ;
#print Data::Dumper->Dump( [ \%useheader ] ) ;
#exit ;

print "Host1: IMAP server [$host1] port [$port1] user [$user1]\n";
print "Host2: IMAP server [$host2] port [$port2] user [$user2]\n";

$password1 || $passfile1 || 'PREAUTH' eq $authmech1 || 'EXTERNAL' eq $authmech1 || do {
	$password1 = ask_for_password( $authuser1 || $user1, $host1 ) ;
} ;

$password1 = ( defined( $passfile1 ) ) ? firstline ( $passfile1 ) : $password1 ;

$password2 || $passfile2 || 'PREAUTH' eq $authmech2 || 'EXTERNAL' eq $authmech2 || do {
	$password2 = ask_for_password( $authuser2 || $user2, $host2 ) ;
} ;

$password2 = ( defined( $passfile2 ) ) ? firstline ( $passfile2 ) : $password2 ;


my $dry_message = '' ;
$dry_message = "\t(not really since --dry mode)" if $dry ;

$search1 ||= $search if ( $search ) ;
$search2 ||= $search if ( $search ) ;

if ( $disarmreadreceipts ) {
	push( @regexmess, 's{\A(.*?(?! ^$))^Disposition-Notification-To:(.*?)$}{$1X-Disposition-Notification-To:$2}igxms' ) ;
}

if ( @regexmess ) {
	my $string = regexmess( '' ) ;
        # string undef means one of the eval regex was bad.
        if ( not ( defined( $string ) ) ) {
        	die_clean( "Error: one of --regexmess option is bad, check it" ) ;
        }
}

if ( @regexflag and not ( defined( flags_regex( '' ) ) ) ) {
        die_clean( "Error: one of --regexmess option is bad, check it" ) ;
}

my $imap1 = ();
my $imap2 = ();

$debugimap1 and print "Host1 connection\n";
$imap1 = login_imap($host1, $port1, $user1, $domain1, $password1, 
		   $debugimap1, $timeout, $fastio1, $ssl1, $tls1,
		   $authmech1, $authuser1, $reconnectretry1,
		   $proxyauth1, $uid1, $split1, 'Host1', $ssl1_SSL_version );

$debugimap2 and print "Host2 connection\n";
$imap2 = login_imap($host2, $port2, $user2, $domain2, $password2, 
		 $debugimap2, $timeout, $fastio2, $ssl2, $tls2,
		 $authmech2, $authuser2, $reconnectretry2,
		 $proxyauth2, $uid2, $split2, 'Host2', $ssl2_SSL_version );


$debug and print "Host1 Buffer I/O: ", $imap1->Buffer(), "\n";
$debug and print "Host2 Buffer I/O: ", $imap2->Buffer(), "\n";



die_clean( 'Not authenticated on host1' ) unless $imap1->IsAuthenticated( ) ;
print "Host1: state Authenticated\n";
die_clean( 'Not authenticated on host2' ) unless   $imap2->IsAuthenticated( ) ;
print "Host2: state Authenticated\n";

print "Host1 capability: ", join(" ", @{ $imap1->capability_update() || [] }), "\n";
print "Host2 capability: ", join(" ", @{ $imap2->capability_update() || [] }), "\n";


if ( $justlogin ) {
	$imap1->logout(  ) ;
	$imap2->logout(  ) ;
	exit_clean( 0 ) ;
}
# 
# Folder stuff
#

my (
@h1_folders_all , %h1_folders_all , @h1_folders_wanted , %requested_folder , 
%h1_subscribed_folder , %h2_subscribed_folder , 
@h2_folders_all , %h2_folders_all , %h2_folders_all_UPPER , 
@h2_folders_from_1_wanted , %h2_folders_from_1_wanted , 
%h2_folders_from_1_several , 
%h2_folders_from_1_all ,
) ;


# Make a hash of subscribed folders in both servers.

for ( $imap1->subscribed(  ) ) { $h1_subscribed_folder{ $_ } = 1 } ;
for ( $imap2->subscribed(  ) ) { $h2_subscribed_folder{ $_ } = 1 } ;

# All folders on host1 and host2
@h1_folders_all = sort $imap1->folders();
@h2_folders_all = sort $imap2->folders();

for ( @h1_folders_all ) { $h1_folders_all{ $_ } = 1 } ;
for ( @h2_folders_all ) { 
	$h2_folders_all{ $_ } = 1 ;
	$h2_folders_all_UPPER{ uc( $_ ) } = 1 ;
} ;

if ( $fixInboxINBOX and ( my $reg = fix_Inbox_INBOX_mapping( \%h1_folders_all, \%h2_folders_all ) ) ) {
	#print "RRRRRR $reg\n" ;
	push( @regextrans2, $reg ) ;
} 

if (scalar(@folder) or $subscribed or scalar(@folderrec)) {
	# folders given by option --folder
	if (scalar(@folder)) {
		add_to_requested_folders(@folder);
	}
	
	# option --subscribed
	if ( $subscribed ) {
		add_to_requested_folders( keys ( %h1_subscribed_folder ) ) ;
	}
	
	# option --folderrec
	if (scalar(@folderrec)) {
		foreach my $folderrec (@folderrec) {
			add_to_requested_folders($imap1->folders($folderrec));
		}
	}
}
else {
	# no include, no folder/subscribed/folderrec options => all folders
	if (not scalar(@include)) {
		add_to_requested_folders(@h1_folders_all);
	}
}


# consider (optional) includes and excludes
if ( scalar( @include ) ) {
	foreach my $include ( @include ) {
		my @included_folders = grep { /$include/x } @h1_folders_all ;
		add_to_requested_folders( @included_folders ) ;
                my $included_folders = join( " ", map( "[$_]", @included_folders ) ) ;
		print "Including folders matching pattern '$include': " . $included_folders . "\n" ;
	}
}

if ( scalar( @exclude ) ) {
	foreach my $exclude ( @exclude ) {
		my @requested_folder = sort( keys( %requested_folder ) ) ;
		my @excluded_folders = grep { /$exclude/x } @requested_folder ;
		remove_from_requested_folders( @excluded_folders ) ;
                my $excluded_folders = join( " ", map( "[$_]", @excluded_folders ) ) ;
		print "Excluding folders matching pattern '$exclude': " . $excluded_folders . "\n" ;
	}
}

# Remove no selectable folders

$checkselectable and do {
	foreach my $folder (keys(%requested_folder)) {
        	if ( not $imap1->selectable($folder)) {
			print "Warning: ignoring folder $folder because it is not selectable\n";
                	remove_from_requested_folders($folder);
        	}
	}
} ;

@h1_folders_wanted = sort_requested_folders(  ) ;

#my $h1_namespace = $imap1->namespace() ;
#my $h2_namespace = $imap2->namespace() ;
#require Data::Dumper ;
#$debug and print "Host1 namespace:\n", Data::Dumper->Dump([$h1_namespace]) ;
#$debug and print "Host2 namespace:\n", Data::Dumper->Dump([$h2_namespace]) ;

my($h1_sep,$h2_sep); 
# what are the private folders separators for each server ?

$debug and print "Getting separators\n" ;
$h1_sep = get_separator( $imap1, $sep1, "--sep1", "Host1" ) ;
$h2_sep = get_separator( $imap2, $sep2, "--sep2", "Host2" ) ;

my( $h1_prefix, $h2_prefix ) ; 
$h1_prefix = get_prefix( $imap1, $prefix1, "--prefix1", "Host1" ) ;
$h2_prefix = get_prefix( $imap2, $prefix2, "--prefix2", "Host2" ) ;


print "Host1 separator and prefix: [$h1_sep][$h1_prefix]\n" ;
print "Host2 separator and prefix: [$h2_sep][$h2_prefix]\n" ;

#my $h1_xlist_folders = $imap1->xlist_folders(  ) ;
#my $h2_xlist_folders = $imap2->xlist_folders(  ) ;
#require Data::Dumper ;
#print "Host1 xlist:\n", Data::Dumper->Dump([$h1_xlist_folders]) ;
#print "Host2 xlist:\n", Data::Dumper->Dump([$h2_xlist_folders]) ;

#exit ;

foreach my $h1_fold ( @h1_folders_wanted ) {
	my $h2_fold ;
	$h2_fold = imap2_folder_name( $h1_fold ) ;
	$h2_folders_from_1_wanted{ $h2_fold }++ ;
        if ( 1 < $h2_folders_from_1_wanted{ $h2_fold } ) {
        	$h2_folders_from_1_several{ $h2_fold }++ ;
        }
} 
@h2_folders_from_1_wanted = sort keys(%h2_folders_from_1_wanted);

foreach my $h1_fold (@h1_folders_all) {
	my $h2_fold;
	$h2_fold = imap2_folder_name($h1_fold);
	$h2_folders_from_1_all{$h2_fold}++;
}


if ( $foldersizes ) {
	( $h1_nb_msg_at_start, $h1_bytes_start ) = foldersizes( "Host1", $imap1, $search1, @h1_folders_wanted ) ;
	( $h2_nb_msg_start, $h2_bytes_start ) = foldersizes( "Host2", $imap2, $search2, @h2_folders_from_1_wanted ) ;
	$fast or sleep( 2 ) ;
}


exit_clean(0) if ($justfoldersizes);

print 
  "++++ Listing folders\n",
  "Host1 folders list:\n", map( { "[$_]\n" } @h1_folders_all ), "\n",
  "Host2 folders list:\n", map( { "[$_]\n" } @h2_folders_all ), "\n" ;

print 
  "Host1 subscribed folders list: ", 
  map( { "[$_] " } sort keys( %h1_subscribed_folder ) ), "\n" 
  if ( $subscribed ) ;

my @h2_folders_not_in_1;
@h2_folders_not_in_1 = list_folders_in_2_not_in_1();

print "Folders in host2 not in host1:\n", 
  map( { "[$_]\n" } @h2_folders_not_in_1 ), "\n" ;

delete_folders_in_2_not_in_1() if $delete2folders;

# folder loop
print "++++ Looping on each folder\n";

my $begin_transfer_time = time ;


my %uid_candidate_for_deletion ;
my %uid_candidate_no_deletion ;

my %h2_folders_of_md5 = (  ) ;

FOLDER: foreach my $h1_fold ( @h1_folders_wanted ) {

        last FOLDER if $imap1->IsUnconnected();
        last FOLDER if $imap2->IsUnconnected();

	my $h2_fold = imap2_folder_name( $h1_fold ) ;
	#relogin1(  ) if ( $relogin1 ) ;
	printf( "%-35s -> %-35s\n", "[$h1_fold]", "[$h2_fold]" ) ;

	# host1 can not be fetched read only, select is needed because of expunge.
	select_folder( $imap1, $h1_fold, 'Host1' ) or next FOLDER ;
	
	
	if ( ! exists( $h2_folders_all{ $h2_fold } ) ) {
		create_folder( $imap2, $h2_fold, $h1_fold ) or next FOLDER ;
	}
	
	acls_sync( $h1_fold, $h2_fold ) ;
	
        # Sometimes the folder on host2 is listed (it exists) but is
        # not selectable but becomes selectable by a create (Gmail)
	select_folder( $imap2, $h2_fold, 'Host2' ) 
        or ( create_folder( $imap2, $h2_fold, $h1_fold ) 
             and select_folder( $imap2, $h2_fold, 'Host2' ) )
        or next FOLDER ;
	my @select_results = $imap2->Results(  ) ;
	
	#print "%%% @select_results\n" ;
	my $permanentflags2 = permanentflags( @select_results ) ;
	( $debug or $debugflags ) and print "permanentflags: $permanentflags2\n" ;

	if ( $expunge or $expunge1 ){
		print "Expunging host1 $h1_fold $dry_message\n" ;
		unless($dry) { $imap1->expunge() } ;
		#print "Expunging host2 $h2_fold\n" ;
		#unless($dry) { $imap2->expunge() } ;
	}
	
	if ( ( ( $subscribe and exists $h1_subscribed_folder{ $h1_fold } ) or $subscribe_all )
             and not exists( $h2_subscribed_folder{ $h2_fold } ) ) {
		print "Subscribing to folder $h2_fold on destination server\n" ;
		unless( $dry ) { $imap2->subscribe( $h2_fold ) } ;
	}
	
	next FOLDER if ($justfolders);

        last FOLDER if $imap1->IsUnconnected();
        last FOLDER if $imap2->IsUnconnected();

        my $h1_msgs_all_hash_ref = {  } ;
	my @h1_msgs = select_msgs( $imap1, $h1_msgs_all_hash_ref, $search1, $h1_fold );
	last FOLDER if $imap1->IsUnconnected();
        
        my $h1_msgs_nb = scalar( @h1_msgs ) ;
        $h1{ $h1_fold }{ 'messages_nb' } = $h1_msgs_nb ;

	( $debug or $debugLIST ) and print "Host1 LIST: $h1_msgs_nb messages [@h1_msgs]\n" ;
        $debug and print "Host1 selecting messages of folder [$h1_fold] took ", timenext(), " s\n";
        
        my $h2_msgs_all_hash_ref = {  } ;
	my @h2_msgs = select_msgs( $imap2, $h2_msgs_all_hash_ref, $search2, $h2_fold ) ;
	last FOLDER if $imap2->IsUnconnected();
        
        my $h2_msgs_nb = scalar( @h2_msgs ) ;
        $h2{ $h2_fold }{ 'messages_nb' } = $h2_msgs_nb ;

	( $debug or $debugLIST ) and print "Host2 LIST: $h2_msgs_nb messages [@h2_msgs]\n";
        $debug and print "Host2 selecting messages of folder [$h2_fold] took ", timenext(), " s\n";
        
	my $cache_base = "$tmpdir/imapsync_cache/" ;
	my $cache_dir = cache_folder( $cache_base, "$host1/$user1/$host2/$user2", $h1_fold, $h2_fold ) ;
	my ( $cache_1_2_ref, $cache_2_1_ref ) = ( {}, {} ) ;
        
	my $h1_uidvalidity = $imap1->uidvalidity(  ) || '' ;
	my $h2_uidvalidity = $imap2->uidvalidity(  ) || '' ;

        last FOLDER if $imap1->IsUnconnected() ;
        last FOLDER if $imap2->IsUnconnected() ;

	if ( $usecache ) {
		print "cache directory: $cache_dir\n" ;
		mkpath( "$cache_dir" ) ;
		( $cache_1_2_ref, $cache_2_1_ref ) 
                = get_cache( $cache_dir, \@h1_msgs, \@h2_msgs, $h1_msgs_all_hash_ref, $h2_msgs_all_hash_ref ) ;
		print "CACHE h1 h2: ", scalar( keys %$cache_1_2_ref ), " files\n" ; 
		$debug and print '[',
		    map ( { "$_->$cache_1_2_ref->{$_} " } keys %$cache_1_2_ref ), " ]\n";
	}
	
	my %h1_hash = () ;
	my %h2_hash = () ;
	
	my ( %h1_msgs, %h2_msgs ) ;
	@h1_msgs{ @h1_msgs } = ();
	@h2_msgs{ @h2_msgs } = ();
	
	my @h1_msgs_in_cache = sort { $a <=> $b } keys %$cache_1_2_ref ;
	my @h2_msgs_in_cache = keys %$cache_2_1_ref ;
	
	my ( %h1_msgs_not_in_cache, %h2_msgs_not_in_cache ) ;
	%h1_msgs_not_in_cache = %h1_msgs ;
	%h2_msgs_not_in_cache = %h2_msgs ;
	delete @h1_msgs_not_in_cache{ @h1_msgs_in_cache } ;
	delete @h2_msgs_not_in_cache{ @h2_msgs_in_cache } ;
	
	my @h1_msgs_not_in_cache = keys %h1_msgs_not_in_cache ;
	#print "h1_msgs_not_in_cache: [@h1_msgs_not_in_cache]\n" ;
	my @h2_msgs_not_in_cache = keys %h2_msgs_not_in_cache ;
	
	my @h2_msgs_delete2_not_in_cache = () ;
	%h1_msgs_copy_by_uid = (  ) ;
	
	if ( $useuid ) {
		# use uid so we have to avoid getting header
		@h1_msgs_copy_by_uid{ @h1_msgs_not_in_cache } = (  ) ;
		@h2_msgs_delete2_not_in_cache = @h2_msgs_not_in_cache if $usecache ;
		@h1_msgs_not_in_cache = (  ) ;
		@h2_msgs_not_in_cache = (  ) ;
		
		#print "delete2: @h2_msgs_delete2_not_in_cache\n";
	}
	
	$debug and print "Host1 parsing headers of folder [$h1_fold]\n";

	my ($h1_heads_ref, $h1_fir_ref) = ({}, {});
	$h1_heads_ref = $imap1->parse_headers([@h1_msgs_not_in_cache], @useheader) if (@h1_msgs_not_in_cache);
	$debug and print "Host1 parsing headers of folder [$h1_fold] took ", timenext(), " s\n";

	@$h1_fir_ref{@h1_msgs} = (undef);
        
	$debug and print "Host1 getting flags idate and sizes of folder [$h1_fold]\n" ;
        if ( $abletosearch ) {
		$h1_fir_ref = $imap1->fetch_hash( \@h1_msgs, "FLAGS", "INTERNALDATE", "RFC822.SIZE", $h1_fir_ref )
	  	if ( @h1_msgs ) ;
        }else{
		my $uidnext = $imap1->uidnext( $h1_fold ) || $uidnext_default ;
		$h1_fir_ref = $imap1->fetch_hash( "1:$uidnext", "FLAGS", "INTERNALDATE", "RFC822.SIZE", $h1_fir_ref )
		if ( @h1_msgs ) ;
        }
	$debug and print "Host1 getting flags idate and sizes of folder [$h1_fold] took ", timenext(), " s\n";
	unless ($h1_fir_ref) {
		print
		"Host1 folder $h1_fold: Could not fetch_hash ",
		scalar(@h1_msgs), " msgs: ", $imap1->LastError || '', "\n";
		$nb_errors++;
		next FOLDER;
	}

	my @h1_msgs_duplicate;
	foreach my $m (@h1_msgs_not_in_cache) {
		my $rc = parse_header_msg($imap1, $m, $h1_heads_ref, $h1_fir_ref, 'Host1', \%h1_hash);
		if (! defined($rc)) {
			my $h1_size = $h1_fir_ref->{$m}->{"RFC822.SIZE"} || 0;
			print "Host1 $h1_fold/$m size $h1_size ignored (no wanted headers so we ignore this message. To solve this: use --addheader)\n" ;
			$total_bytes_skipped += $h1_size;
			$nb_msg_skipped += 1;
			$h1_nb_msg_noheader +=1;
                        $h1_nb_msg_processed +=1 ;
		} elsif(0 == $rc) {
			# duplicate
			push(@h1_msgs_duplicate, $m);
			# duplicate, same id same size?
			my $h1_size = $h1_fir_ref->{$m}->{"RFC822.SIZE"} || 0;
			$nb_msg_skipped += 1;
			$h1_total_bytes_duplicate += $h1_size;
			$h1_nb_msg_duplicate += 1;
                        $h1_nb_msg_processed +=1 ;
		}
	}
        my $h1_msgs_duplicate_nb = scalar( @h1_msgs_duplicate ) ;
        $h1{ $h1_fold }{ 'duplicates_nb' } = $h1_msgs_duplicate_nb ;
        
        $debug and print "Host1 selected: $h1_msgs_nb  duplicates: $h1_msgs_duplicate_nb\n" ;
	$debug and print "Host1 whole time parsing headers took ", timenext(), " s\n";
        
	$debug and print "Host2 parsing headers of folder [$h2_fold]\n";
        
	my ($h2_heads_ref, $h2_fir_ref) = ( {}, {} );
	$h2_heads_ref =   $imap2->parse_headers([@h2_msgs_not_in_cache], @useheader) if (@h2_msgs_not_in_cache);
	$debug and print "Host2 parsing headers of folder [$h2_fold] took ", timenext(), " s\n" ;

	$debug and print "Host2 getting flags idate and sizes of folder [$h2_fold]\n" ;
	@$h2_fir_ref{@h2_msgs} = (  ); # fetch_hash can select by uid with last arg as ref


        if ( $abletosearch ) {
		$h2_fir_ref = $imap2->fetch_hash( \@h2_msgs, "FLAGS", "INTERNALDATE", "RFC822.SIZE", $h2_fir_ref)
		if (@h2_msgs) ;
        }else{
		my $uidnext = $imap2->uidnext( $h2_fold ) || $uidnext_default ;
		$h2_fir_ref = $imap2->fetch_hash( "1:$uidnext", "FLAGS", "INTERNALDATE", "RFC822.SIZE", $h2_fir_ref )
		if ( @h2_msgs ) ;
        }

	$debug and print "Host2 getting flags idate and sizes of folder [$h2_fold] took ", timenext(), " s\n" ;
	
	my @h2_msgs_duplicate;
	foreach my $m (@h2_msgs_not_in_cache) {
		my $rc = parse_header_msg($imap2, $m, $h2_heads_ref, $h2_fir_ref, 'Host2', \%h2_hash);
		my $h2_size = $h2_fir_ref->{$m}->{"RFC822.SIZE"} || 0;
		if (! defined($rc)) {
                        print "Host2 $h2_fold/$m size $h2_size ignored (no wanted headers so we ignore this message)\n" ;
			$h2_nb_msg_noheader += 1 ;
		} elsif(0 == $rc) {
			# duplicate
			$h2_nb_msg_duplicate += 1;
			$h2_total_bytes_duplicate += $h2_size;
			push(@h2_msgs_duplicate, $m);
		}
	}
        
        # %h2_folders_of_md5
        foreach my $md5 (  keys( %h2_hash ) ) {
        	$h2_folders_of_md5{ $md5 }->{ $h2_fold } ++ ;
        }

        
        my $h2_msgs_duplicate_nb = scalar( @h2_msgs_duplicate ) ;
        $h2{ $h2_fold }{ 'duplicates_nb' } = $h2_msgs_duplicate_nb ;
        
        print "Host2 folder $h2_fold selected: $h2_msgs_nb messages,  duplicates: $h2_msgs_duplicate_nb\n" 
        	if ( $debug or $delete2duplicates or $h2_msgs_duplicate_nb ) ;
	$debug and print "Host2 whole time parsing headers took ", timenext(), " s\n";

	$debug and print "++++ Verifying [$h1_fold] -> [$h2_fold]\n";
	# messages in host1 that are not in host2
	
	my @h1_hash_keys_sorted_by_uid 
	  = sort {$h1_hash{$a}{'m'} <=> $h1_hash{$b}{'m'}} keys(%h1_hash);
	
	#print map { $h1_hash{$_}{'m'} . " "} @h1_hash_keys_sorted_by_uid;
	
	my @h2_hash_keys_sorted_by_uid 
	  = sort {$h2_hash{$a}{'m'} <=> $h2_hash{$b}{'m'}} keys(%h2_hash);

        
	if( $delete2duplicates and not exists( $h2_folders_from_1_several{ $h2_fold } ) ) {
		my @h2_expunge ;

		foreach my $h2_msg ( @h2_msgs_duplicate ) {
			print "msg $h2_fold/$h2_msg marked \\Deleted [duplicate] on host2 $dry_message\n" ;
			push( @h2_expunge, $h2_msg ) if $uidexpunge2 ;
			unless ( $dry ) {
				$imap2->delete_message( $h2_msg ) ;
				$h2_nb_msg_deleted += 1 ;
			}
		}
		my $cnt = scalar @h2_expunge ;
		if( @h2_expunge ) {
			print "uidexpunge $cnt message(s) $dry_message\n" ;
			$imap2->uidexpunge( \@h2_expunge ) if ! $dry ;
		}
        	if ( $expunge2 ){
                	print "Expunging host2 folder $h2_fold $dry_message\n" ;
                	$imap2->expunge(  ) if ! $dry ;
        	}
	}
        
	if( $delete2 and not exists( $h2_folders_from_1_several{ $h2_fold } ) ) {
        	# No host1 folders f1a f1b ... going all to same f2 (via --regextrans2)
		my @h2_expunge;
		foreach my $m_id (@h2_hash_keys_sorted_by_uid) {
			#print "$m_id ";
			unless (exists($h1_hash{$m_id})) {
				my $h2_msg  = $h2_hash{$m_id}{'m'};
				my $h2_flags  = $h2_hash{$m_id}{'F'} || "";
				my $isdel  = $h2_flags =~ /\B\\Deleted\b/x ? 1 : 0;
				print "msg $h2_fold/$h2_msg marked \\Deleted on host2 [$m_id] $dry_message\n"
				  if ! $isdel;
				push(@h2_expunge, $h2_msg) if $uidexpunge2;
				unless ($dry or $isdel) {
					$imap2->delete_message($h2_msg);
					$h2_nb_msg_deleted += 1;
				}
			}
		}
		foreach my $h2_msg ( @h2_msgs_delete2_not_in_cache ) {
			print "msg $h2_fold/$h2_msg marked \\Deleted [not in cache] on host2 $dry_message\n";
                        push(@h2_expunge, $h2_msg) if $uidexpunge2;
			unless ($dry) {
				$imap2->delete_message($h2_msg);
				$h2_nb_msg_deleted += 1;
			}
		}
		my $cnt = scalar @h2_expunge ;
		if( @h2_expunge ) {
			print "uidexpunge $cnt message(s) $dry_message\n" ;
			$imap2->uidexpunge( \@h2_expunge ) if ! $dry ;
		}
        	if ($expunge2){
                	print "Expunging host2 folder $h2_fold $dry_message\n" ;
                	$imap2->expunge(  ) if ! $dry ;
        	}
	}

	if( $delete2 and exists( $h2_folders_from_1_several{ $h2_fold } ) ) {
        	print "Host2 folder $h2_fold $h2_folders_from_1_several{ $h2_fold } folders left to sync there\n" ;
		my @h2_expunge;
		foreach my $m_id ( @h2_hash_keys_sorted_by_uid ) {
                	my $h2_msg  = $h2_hash{ $m_id }{ 'm' } ;
			unless ( exists( $h1_hash{ $m_id } ) ) {
				my $h2_flags  = $h2_hash{ $m_id }{ 'F' } || "" ;
				my $isdel  = $h2_flags =~ /\B\\Deleted\b/x ? 1 : 0 ;
				unless ( $isdel ) {
                                	$debug and print "msg $h2_fold/$h2_msg candidate for deletion on host2 [$m_id]\n" ;
					$uid_candidate_for_deletion{ $h2_fold }{ $h2_msg }++ ;
				}
			}else{
                        	$debug and print "msg $h2_fold/$h2_msg will cancel deletion on host2 [$m_id]\n" ;
                        	$uid_candidate_no_deletion{ $h2_fold }{ $h2_msg }++ ;
                        }
		}
		foreach my $h2_msg ( @h2_msgs_delete2_not_in_cache ) {
			print "msg $h2_fold/$h2_msg candidate for deletion [not in cache] on host2\n";
                        $uid_candidate_for_deletion{ $h2_fold }{ $h2_msg }++ ;
		}
                
		foreach my $h2_msg ( @h2_msgs_in_cache ) {
			print "msg $h2_fold/$h2_msg will cancel deletion [in cache] on host2\n";
                        $uid_candidate_no_deletion{ $h2_fold }{ $h2_msg }++ ;
		}
                
                
                if ( 0 == $h2_folders_from_1_several{ $h2_fold } ) {
                	# last host1 folder going to $h2_fold
                        print "Last host1 folder going to $h2_fold\n" ;
                        foreach my $h2_msg ( keys %{ $uid_candidate_for_deletion{ $h2_fold } } ) {
                        	$debug and print "msg $h2_fold/$h2_msg candidate for deletion on host2\n" ;
                                if ( exists( $uid_candidate_no_deletion{ $h2_fold }{ $h2_msg } ) ) {
                                	$debug and print "msg $h2_fold/$h2_msg canceled deletion on host2\n" ;
                                }else{
                                	print "msg $h2_fold/$h2_msg marked \\Deleted on host2 $dry_message\n";
                                        push( @h2_expunge, $h2_msg ) if $uidexpunge2 ;
                                        unless ( $dry ) {
                                        	$imap2->delete_message( $h2_msg ) ;
                                        	$h2_nb_msg_deleted += 1 ;
                                        }
                                }
                        }
                }
                
		my $cnt = scalar @h2_expunge ;
		if( @h2_expunge ) {
			print "uidexpunge $cnt message(s) $dry_message\n" ;
			$imap2->uidexpunge( \@h2_expunge ) if ! $dry ;
		}
        	if ( $expunge2 ) {
                	print "Expunging host2 folder $h2_fold $dry_message\n" ;
                	$imap2->expunge(  ) if ! $dry ;
        	}

                $h2_folders_from_1_several{ $h2_fold }-- ;                
	}


	my $h2_uidnext = $imap2->uidnext( $h2_fold ) ;
        $debug and print "Host2 uidnext: $h2_uidnext\n" ;
	$h2_uidguess = $h2_uidnext ;
	MESS: foreach my $m_id (@h1_hash_keys_sorted_by_uid) {
        	last FOLDER if $imap1->IsUnconnected() ;
                last FOLDER if $imap2->IsUnconnected() ;

		#print "h1_nb_msg_processed: $h1_nb_msg_processed\n" ;
		my $h1_size  = $h1_hash{$m_id}{'s'};
		my $h1_msg   = $h1_hash{$m_id}{'m'};
		my $h1_idate = $h1_hash{$m_id}{'D'};

		if ( ( not exists( $h2_hash{ $m_id } ) ) 
                	and ( not exists( $h2_folders_of_md5{ $m_id } )
                              or not $skipcrossduplicates ) ) {
			# copy
			my $h2_msg = copy_message( $h1_msg, $h1_fold, $h2_fold, $h1_fir_ref, $permanentflags2, $cache_dir ) ;
                        $h2_folders_of_md5{ $m_id }->{ $h2_fold } ++ ;
                        if( $delete2 and exists( $h2_folders_from_1_several{ $h2_fold } ) and $h2_msg ) {
                        	print "msg $h2_fold/$h2_msg will cancel deletion [fresh copy] on host2\n" ;
	                        $uid_candidate_no_deletion{ $h2_fold }{ $h2_msg }++ ;
                        }
                        last FOLDER if total_bytes_max_reached(  ) ;
			next MESS;
		}
		else{
		        # already on host2
                        if ( exists( $h2_hash{ $m_id } ) ) {
				my $h2_msg   = $h2_hash{$m_id}{'m'} ;
				$debug and print "Host1 found msg $h1_fold/$h1_msg equals Host2 $h2_fold/$h2_msg\n" ;
                                if ( $usecache ) {
                                	$debugcache and print "touch $cache_dir/${h1_msg}_$h2_msg\n" ;
                                	touch( "$cache_dir/${h1_msg}_$h2_msg" ) 
                                        or croak( "Couldn't touch $cache_dir/${h1_msg}_$h2_msg" ) ;
                                }
                        }elsif( exists( $h2_folders_of_md5{ $m_id } ) ) {
                        	my @folders_dup = keys( %{ $h2_folders_of_md5{ $m_id } } ) ;
                        	( $debug or $debugcrossduplicates ) and print "Host1 found msg $h1_fold/$h1_msg is also in Host2 folders @folders_dup\n" ;
                        }
			$total_bytes_skipped += $h1_size ;
			$nb_msg_skipped += 1 ;
                        $h1_nb_msg_processed +=1 ;
                }
		
                if ( exists( $h2_hash{ $m_id } ) ) {
			#$debug and print "MESSAGE $m_id\n";
			my $h2_msg  = $h2_hash{$m_id}{'m'};

                	sync_flags_fir( $h1_fold, $h1_msg, $h2_fold, $h2_msg, $permanentflags2, $h1_fir_ref, $h2_fir_ref ) ;
	    		# Good
			my $h2_size = $h2_hash{$m_id}{'s'};
			$debug and print
			"Host1 size  msg $h1_fold/$h1_msg = $h1_size <> $h2_size = Host2 $h2_fold/$h2_msg\n";
		}
                last FOLDER if $imap2->IsUnconnected() ;
                
		if( $delete ) {
                        my $expunge_message = '' ;
                        $expunge_message = "and expunged" if ( $expungeaftereach and ( $expunge or $expunge1 ) ) ;
			print "Host1 msg $h1_fold/$h1_msg marked deleted $expunge_message $dry_message\n" ;
			unless( $dry ) {
				$imap1->delete_message( $h1_msg ) ;
				$h1_nb_msg_deleted += 1 ;
				$imap1->expunge() if ( $expungeaftereach and ( $expunge or $expunge1 ) ) ;
			}
		}
	}
	# END MESS: loop
        last FOLDER if $imap1->IsUnconnected();
        last FOLDER if $imap2->IsUnconnected();
	MESS_IN_CACHE: foreach my $h1_msg ( @h1_msgs_in_cache ) {
		my $h2_msg = $cache_1_2_ref->{ $h1_msg } ;
		$debugcache and print "cache messages update flags $h1_msg->$h2_msg\n";
		sync_flags_fir( $h1_fold, $h1_msg, $h2_fold, $h2_msg, $permanentflags2, $h1_fir_ref, $h2_fir_ref ) ;
		my $h1_size = $h1_fir_ref->{ $h1_msg }->{ 'RFC822.SIZE' } || 0 ;
		$total_bytes_skipped += $h1_size;
		$nb_msg_skipped += 1;
                $h1_nb_msg_processed +=1 ;
                last FOLDER if $imap2->IsUnconnected();                
	}
	
	#print "Messages by uid: ", map { "$_ " } keys %h1_msgs_copy_by_uid, "\n" ;
	MESS_BY_UID: foreach my $h1_msg ( sort { $a <=> $b } keys %h1_msgs_copy_by_uid ) {
		# 
		$debug and print "Copy by uid $h1_fold/$h1_msg\n" ;
                last FOLDER if $imap1->IsUnconnected();
                last FOLDER if $imap2->IsUnconnected();
		my $h2_msg = copy_message( $h1_msg, $h1_fold, $h2_fold, $h1_fir_ref, $permanentflags2, $cache_dir ) ;
                if( $delete2 and exists( $h2_folders_from_1_several{ $h2_fold } ) and $h2_msg ) {
                	print "msg $h2_fold/$h2_msg will cancel deletion [fresh copy] on host2\n" ;
	                $uid_candidate_no_deletion{ $h2_fold }{ $h2_msg }++ ;
                }
		last FOLDER if total_bytes_max_reached(  ) ;
	}
	
	if ($expunge or $expunge1){
		print "Expunging host1 folder $h1_fold $dry_message\n";
		unless($dry) { $imap1->expunge() };
	}
	if ($expunge2){
		print "Expunging host2 folder $h2_fold $dry_message\n";
		unless($dry) { $imap2->expunge() };
	}

	$debug and print "Time: ", timenext(), " s\n";
}


sub total_bytes_max_reached {

	return( 0 ) if not $exitwhenover ;
	if ( $total_bytes_transferred >= $exitwhenover ) {
        	print "Maximum bytes transfered reached, $total_bytes_transferred >= $exitwhenover, ending sync\n" ;
        	return( 1 ) ;
        }  

}

print "++++ End looping on each folder\n";
$debug and print "Time: ", timenext(), " s\n";

#print memory_consumption();


if ( $foldersizesatend ) {
	timenext() ;
	# Get all folders on host2 again since new were created
	@h2_folders_all = sort $imap2->folders();
	for ( @h2_folders_all ) { $h2_folders_all{ $_ } = 1 } ;
	( $h1_nb_msg_end, $h1_bytes_end ) = foldersizes( "Host1", $imap1, $search1, @h1_folders_wanted ) ;
	( $h2_nb_msg_end, $h2_bytes_end ) = foldersizes( "Host2", $imap2, $search2, @h2_folders_from_1_wanted ) ;
}

$imap1->logout(  ) unless lost_connection($imap1, "for host1 [$host1]");
$imap2->logout(  ) unless lost_connection($imap2, "for host2 [$host2]");


stats(  ) ;
print "Log file is $logfile\n" if ( $log ) ;
exit_clean( 1 ) if ( $nb_errors ) ;
exit_clean( 0 ) ;

# END of main program

# subroutines


sub size_filtered_flag {
	my $h1_size = shift ;
	
	if (defined $maxsize and $h1_size >= $maxsize) {
		return( 1 ) ;
	}
	if (defined $minsize and $h1_size <= $minsize) {
		return( 1 ) ;
	}
	return( 0 ) ;
}

sub sync_flags_fir {
	my ( $h1_fold, $h1_msg, $h2_fold, $h2_msg, $permanentflags2, $h1_fir_ref, $h2_fir_ref ) = @_ ;

	if ( not defined( $h1_msg ) ) { return(  ) } ;
	if ( not defined( $h2_msg ) ) { return(  ) } ;
        
	my $h1_size = $h1_fir_ref->{$h1_msg}->{"RFC822.SIZE"} ;
	return(  ) if size_filtered_flag( $h1_size ) ;

	# used cached flag values for efficiency
	my $h1_flags = $h1_fir_ref->{ $h1_msg }->{ "FLAGS" } || '' ;
	my $h2_flags = $h2_fir_ref->{ $h2_msg }->{ "FLAGS" } || '' ;

	sync_flags( $h1_fold, $h1_msg, $h1_flags, $h2_fold, $h2_msg, $h2_flags, $permanentflags2 ) ;

        return(  ) ;
}

sub sync_flags_after_copy {
	my( $h1_fold, $h1_msg, $h1_flags, $h2_fold, $h2_msg, $permanentflags2 ) = @_ ;
        
        my @h2_flags = $imap2->flags( $h2_msg ) ;
        my $h2_flags = "@h2_flags" ;
        ( $debug or $debugflags ) and print "Host2 flags before resync by STORE on msg $h2_msg: $h2_flags\n" ;
	sync_flags( $h1_fold, $h1_msg, $h1_flags, $h2_fold, $h2_msg, $h2_flags, $permanentflags2 ) ;
        return(  ) ;
}

sub sync_flags {
	my( $h1_fold, $h1_msg, $h1_flags, $h2_fold, $h2_msg, $h2_flags, $permanentflags2 ) = @_ ;

	( $debug or $debugflags ) and 
        print "Host1 flags init msg $h1_fold/$h1_msg flags( $h1_flags ) Host2 $h2_fold/$h2_msg flags( $h2_flags )\n" ;

	$h1_flags = flags_for_host2( $h1_flags, $permanentflags2 ) ;

	$h2_flags = flagsCase( $h2_flags ) ;

	( $debug or $debugflags ) and 
        print "Host1 flags filt msg $h1_fold/$h1_msg flags( $h1_flags ) Host2 $h2_fold/$h2_msg flags( $h2_flags )\n" ;

	
	# compare flags - set flags if there a difference
	my @h1_flags = sort split(' ', $h1_flags );
	my @h2_flags = sort split(' ', $h2_flags );
	my $diff = compare_lists( \@h1_flags, \@h2_flags );

	$diff and ( $debug or $debugflags ) 
		and     print "Host2 flags msg $h2_fold/$h2_msg replacing h2 flags( $h2_flags ) with h1 flags( $h1_flags )\n";
	# This sets flags so flags can be removed with this
	# When you remove a \Seen flag on host1 you want to it
	# to be removed on host2. Just add flags is not what 
	# we need most of the time.
	
	if ( not $dry and $diff and not $imap2->store( $h2_msg, "FLAGS.SILENT (@h1_flags)" ) ) {
		print "Host2 flags msg $h2_fold/$h2_msg could not add flags [@h1_flags]: ",
		  $imap2->LastError || '', "\n" ;
		#$nb_errors++ ;
	}

        return(  ) ;
}



sub _filter {
	my $str = shift or return "";
        my $sz  = 64;
        my $len = length($str);
        if ( not $debug and $len > $sz*2 ) {
                my $beg = substr($str, 0, $sz);
                my $end = substr($str, -$sz, $sz);
                $str = $beg . "..." . $end;
        }
        $str =~ s/\012?\015$//x;
        return "(len=$len) " . $str;
}



sub lost_connection {
	my($imap, $error_message) = @_;
        if ( $imap->IsUnconnected() ) {
                $nb_errors++;
                my $lcomm = $imap->LastIMAPCommand || "";
                my $einfo = $imap->LastError || @{$imap->History}[-1] || "";

                # if string is long try reduce to a more reasonable size
                $lcomm = _filter($lcomm);
                $einfo = _filter($einfo);
                print("Failure: last command: $lcomm\n") if ($debug && $lcomm);
                print("Failure: lost connection $error_message: ", $einfo, "\n");
                return(1);
        }
        else{
        	return(0);
        }
}

sub max {
	my @list = @_ ;
	return( undef ) if ( 0 == scalar( @list ) ) ;
	my @sorted = sort { $a <=> $b } @list ;
	return( pop( @sorted ) ) ;
}

sub tests_max {
	ok( 0 == max(0),   "max 0");
	ok( 1 == max(1),   "max 1");
	ok( -1 == max(-1), "max -1");
	ok( not ( defined( max(  ) ) ), "max no arg" ) ;
	ok( 100 == max( 1, 100 ), "max 1 100" ) ;
	ok( 100 == max( 100, 1 ), "max 100 1") ;
	ok( 100 == max( 100, 42, 1 ), "max 100 42 1") ;
	ok( 100 == max( 100, "42", 1 ), "max 100 42 1") ;
	ok( 100 == max( "100", "42", 1 ), "max 100 42 1") ;
	#ok( 100 == max( 100, "haha", 1 ), "max 100 42 1") ;
        return(  ) ;
}

sub keyval {
        my %hash = @_ ;
        return( join( " ", map( { "$_ => " . $hash{ $_ } } keys %hash ) ) . "\n" ) ;
}
        


sub check_lib_version {
	$debug and print "IMAPClient $Mail::IMAPClient::VERSION\n";
	if ($Mail::IMAPClient::VERSION eq '2.2.9') {
		print "imapsync no longer supports Mail::IMAPClient 2.2.9, upgrade it" ;
		return( 0 ) ;
	}
	else{
		# 3.x.x is no longer buggy with imapsync.
		return( 1 ) ;      
	}
}

sub module_version_str {
	my( $module_name, $module_version ) = @_ ;
	my $str = sprintf( "%-20s %s\n", $module_name, $module_version ) ;
        return( $str ) ;
}

sub modules_VERSION {

	my @list_version;

	my $v ;
	eval { require Mail::IMAPClient; $v = $Mail::IMAPClient::VERSION } or $v = "?" ;
	push ( @list_version, module_version_str( 'Mail::IMAPClient', $v ) ) ;

	eval { require IO::Socket; $v = $IO::Socket::VERSION } or $v = "?" ;
	push ( @list_version, module_version_str( 'IO::Socket', $v ) ) ;

	eval { require IO::Socket::IP; $v = $IO::Socket::IP::VERSION } or $v = "?" ;
	push ( @list_version, module_version_str( 'IO::Socket::IP', $v ) ) ;

	eval { require IO::Socket::INET; $v = $IO::Socket::INET::VERSION } or $v = "?" ;
	push ( @list_version, module_version_str( 'IO::Socket::INET', $v ) ) ;

	eval { require IO::Socket::SSL ; $v = $IO::Socket::SSL::VERSION } or $v = "?" ;
	push ( @list_version, module_version_str( 'IO::Socket::SSL ', $v ) ) ;

	eval { require Net::SSLeay ; $v = $Net::SSLeay::VERSION } or $v = "?" ;
	push ( @list_version, module_version_str( 'Net::SSLeay ', $v ) ) ;

	eval { require Digest::MD5; $v = $Digest::MD5::VERSION } or $v = "?" ;
	push ( @list_version, module_version_str( 'Digest::MD5', $v ) ) ;

	eval { require Digest::HMAC_MD5; $v = $Digest::HMAC_MD5::VERSION } or $v = "?" ;
	push ( @list_version, module_version_str( 'Digest::HMAC_MD5', $v ) ) ;

	eval { require Digest::HMAC_SHA1; $v = $Digest::HMAC_SHA1::VERSION } or $v = "?" ;
	push ( @list_version, module_version_str( 'Digest::HMAC_SHA1', $v ) ) ;

	eval { require Term::ReadKey; $v = $Term::ReadKey::VERSION } or $v = "?" ;
	push ( @list_version, module_version_str( 'Term::ReadKey', $v ) ) ;

	eval { require Authen::NTLM; $v = $Authen::NTLM::VERSION } or $v = "?" ;
	push ( @list_version, module_version_str( 'Authen::NTLM', $v ) ) ;

	eval { require File::Spec; $v = $File::Spec::VERSION } or $v = "?" ;
	push ( @list_version, module_version_str( 'File::Spec', $v ) ) ;

	eval { require Time::HiRes; $v = $Time::HiRes::VERSION } or $v = "?" ;
	push ( @list_version, module_version_str( 'Time::HiRes', $v ) ) ;

	eval { require URI::Escape; $v = $URI::Escape::VERSION } or $v = "?" ;
	push ( @list_version, module_version_str( 'URI::Escape', $v ) ) ;

	eval { require Data::Uniqid; $v = $Data::Uniqid::VERSION } or $v = "?" ;
	push ( @list_version, module_version_str( 'Data::Uniqid', $v ) ) ;

	return( @list_version ) ;
}


# Construct a command line copy with passwords replaced by MASKED.
sub command_line_nopassword {
	my @argv = @_;
	my @argv_nopassword;
        
        return("@argv") if $showpasswords ;
	while (@argv) {
		my $arg = shift(@argv); # option name or value
		if ($arg =~ m/-password[12]/x) {
			shift(@argv); # password value 
			push(@argv_nopassword, $arg, "MASKED"); # option name and fake value
		}else{
			push(@argv_nopassword, $arg); # same option or value
		}
	}
	return("@argv_nopassword");
}

sub tests_command_line_nopassword {

	ok('' eq command_line_nopassword(), 'command_line_nopassword void');
	ok('--blabla' eq command_line_nopassword('--blabla'), 'command_line_nopassword --blabla');
	#print command_line_nopassword((qw{ --password1 secret1 })), "\n";
	ok('--password1 MASKED' eq command_line_nopassword(qw{ --password1 secret1}), 'command_line_nopassword --password1');
	ok('--blabla --password1 MASKED --blibli' 
	eq command_line_nopassword(qw{ --blabla --password1 secret1 --blibli }), 'command_line_nopassword --password1 --blibli');
	$showpasswords = 1 ;
	ok('' eq command_line_nopassword(), 'command_line_nopassword void');
	ok('--blabla' eq command_line_nopassword('--blabla'), 'command_line_nopassword --blabla');
	#print command_line_nopassword((qw{ --password1 secret1 })), "\n";
	ok('--password1 secret1' eq command_line_nopassword(qw{ --password1 secret1}), 'command_line_nopassword --password1');
	ok('--blabla --password1 secret1 --blibli' 
	eq command_line_nopassword(qw{ --blabla --password1 secret1 --blibli }), 'command_line_nopassword --password1 --blibli');
        return(  ) ;
}

sub ask_for_password {
	my ($user, $host) = @_;
	print "What's the password for $user\@$host? ";
	Term::ReadKey::ReadMode(2);
	my $password = <>;
	chomp $password;
	printf "\n";
	Term::ReadKey::ReadMode(0);
	return $password;
}

sub catch_exit {
	my $signame = shift ;
	print "\nGot a SIG$signame!\n" ;
	stats(  ) ;
	exit_clean( 6 ) ;
        return(  ) ; # fake, for perlcritic
}

sub catch_continue {
	my $signame = shift ;
	print "\nGot a SIG$signame!\n" ;
        return(  ) ;
}



sub connect_imap {
	my( $host, $port, $mydebugimap, $ssl, $tls, $SSL_version ) = @_ ;
	my $imap = Mail::IMAPClient->new() ;
	if ( $ssl ) { set_ssl( $imap, $SSL_version ) }
	if ( $tls ) { 
        	$imap->Tls( $tls ) ;
        }
	$imap->Server($host) ;
	$imap->Port($port) ;
	$imap->Debug($mydebugimap) ;
	$imap->connect()
	  or die_clean("Can not open imap connection on [$host]: $@\n") ;

        my $banner = $imap->Results()->[0] ;
        $imap->Banner( $banner ) ;
        
        if ( $imap->Tls(  ) ) {
        	set_tls( $imap ) ;
        	$imap->starttls(  )
                or die_clean("Can not go to tls encryption on [$host]:", $imap->LastError, "\n" ) ;
        }
        return( $imap ) ;
}

sub justconnect {

	$imap1 = connect_imap( $host1, $port1, $debugimap1, $ssl1, $tls1, $ssl1_SSL_version ) ;
	print "Host1 software: ", server_banner( $imap1 ) ;
	print "Host1 capability: ", join(" ", $imap1->capability(  ) ), "\n" ;
	$imap2 = connect_imap( $host2, $port2, $debugimap2, $ssl2, $tls2, $ssl2_SSL_version ) ;
	print "Host2 software: ", server_banner( $imap2 ) ;
	print "Host2 capability: ", join(" ", $imap2->capability(  ) ), "\n" ;
	$imap1->logout() ;
	$imap2->logout() ;
        return(  ) ;
}

sub relogin1 {
	$imap1 = relogin_imap(
		$imap1,
		$host1, $port1, $user1, $domain1, $password1, 
		$debugimap1, $timeout, $fastio1, $ssl1, $tls1,
		$authmech1, $authuser1, $reconnectretry1,
		$proxyauth1, $uid1, $split1) ;
		
	$relogin1-- if ( $relogin1 ) ;
        return(  ) ;
}

sub relogin2 {
	$imap2 = relogin_imap(
		$imap2,
		$host2, $port2, $user2, $domain2, $password2, 
		$debugimap2, $timeout, $fastio2, $ssl2, $tls2,
		$authmech2, $authuser2, $reconnectretry2,
		$proxyauth2, $uid2, $split2) ;
		
	$relogin2-- if ( $relogin2 )  ;
        return(  ) ;
}

sub relogin_imap {
	my($imap,
	   $host, $port, $user, $domain, $password, 
	   $mydebugimap, $mytimeout, $fastio, 
	   $ssl, $tls, $authmech, $authuser, $reconnectretry,
	   $proxyauth, $uid, $split) = @_;

	my $folder_current = $imap->Folder ;
	$imap->logout(  ) ;
	$imap = login_imap(
		$host, $port, $user, $domain, $password, 
		$mydebugimap, $mytimeout, $fastio, 
		$ssl, $tls, $authmech, $authuser, $reconnectretry,
		$proxyauth, $uid, $split
	) ;
	$imap->select( $folder_current ) if defined( $folder_current ) ;
	return( $imap ) ;
}


sub login_imap {

	my @allargs = @_ ;
	my($host, $port, $user, $domain, $password, 
	   $mydebugimap, $mytimeout, $fastio, 
	   $ssl, $tls, $authmech, $authuser, $reconnectretry,
	   $proxyauth, $uid, $split, $Side, $SSL_version ) = @allargs ;

	my $side = lc( $Side ) ;
	my $imap = init_imap( @allargs ) ;

	$imap->connect()
	  or die_clean("Failure: can not open imap connection on $side [$host] with user [$user]: $@\n");
	
        my $banner = $imap->Results()->[0] ;
        $imap->Banner( $banner ) ;
	print "$Side: ", server_banner($imap);

        if ( $authmech eq 'PREAUTH' ) {
        	if ( $imap->IsAuthenticated( ) ) {
        		$imap->Socket ;
			printf("%s: Assuming PREAUTH for %s\n", $Side, $imap->Server ) ;
        	}else{
                	die_clean( "Failure: error login on $side [$host] with user [$user] auth [PREAUTH]" ) ;
                }
        }

        if ( $imap->Tls(  ) ) {
        	set_tls( $imap ) ;
        	$imap->starttls(  )
                or die_clean("Can not go to tls encryption on [$host]:", $imap->LastError, "\n" ) ;
        }
	
        authenticate_imap( $imap, @allargs ) ;
	
	print "$Side: success login on [$host] with user [$user] auth [$authmech]\n" ;
	return( $imap ) ;
}


sub authenticate_imap {

	my($imap,
           $host, $port, $user, $domain, $password, 
	   $mydebugimap, $mytimeout, $fastio, 
	   $ssl, $tls, $authmech, $authuser, $reconnectretry,
	   $proxyauth, $uid, $split, $Side ) = @_ ;

	check_capability( $imap, $authmech, $Side ) ;

        if ( $proxyauth ) {
                $imap->Authmechanism("") ;
                $imap->User($authuser) ;
        } else {
                $imap->Authmechanism( $authmech ) unless ( $authmech eq 'LOGIN'  or $authmech eq 'PREAUTH' ) ;
                $imap->User($user) ;
        }
        
	$imap->Authcallback(\&xoauth) if ( 'XOAUTH' eq $authmech ) ;
	$imap->Authcallback(\&plainauth) if ( ( 'PLAIN' eq $authmech ) or ( 'EXTERNAL' eq $authmech )  ) ;
	
        $imap->Domain($domain) if (defined($domain)) ;
        $imap->Authuser($authuser) ;
        $imap->Password($password) ;
	
	unless ( $authmech eq 'PREAUTH' or $imap->login( ) ) {
		my $info  = "Failure: error login on [$host] with user [$user] auth" ;
		my $einfo = $imap->LastError || @{$imap->History}[-1] ;
		chomp( $einfo ) ;
		my $error = "$info [$authmech]: $einfo\n" ;
                if ( $authmech eq 'LOGIN' or $imap->IsUnconnected( ) or $authuser ) {
                	die_clean( $error ) ;
                }else{
			print $error ;
                }
		print "Info: trying LOGIN Auth mechanism on [$host] with user [$user]\n" ;
		$imap->Authmechanism("") ;
		$imap->login() or
		  die_clean("$info [LOGIN]: ", $imap->LastError, "\n") ;
	}

        if ( $proxyauth ) {
                if ( ! $imap->proxyauth( $user ) ) {
                        my $info  = "Failure: error doing proxyauth as user [$user] on [$host] using proxy-login as [$authuser]" ;
                        my $einfo = $imap->LastError || @{$imap->History}[-1] ;
                        chomp( $einfo ) ;
                        die_clean( "$info: $einfo\n" ) ;
                }
        }

	return(  ) ;
}

sub check_capability {

	my( $imap, $authmech, $Side ) = @_ ;
        
	if ($imap->has_capability("AUTH=$authmech")
	    or $imap->has_capability($authmech)
	   ) {
		printf("%s: %s says it has CAPABILITY for AUTHENTICATE %s\n",
		       $Side, $imap->Server, $authmech);
	} 
	else {
		printf("%s: %s says it has NO CAPABILITY for AUTHENTICATE %s\n",
		       $Side, $imap->Server, $authmech);
		if ($authmech eq 'PLAIN') {
			print "$Side: frequently PLAIN is only supported with SSL, ",
			  "try --ssl or --tls options\n";
		}
	}
	return(  ) ;
}

sub set_ssl {
	my ( $imap, $SSL_version ) = @_ ;
        # SSL_version can be
        #    SSLv3 SSLv2 SSLv23 SSLv23:!SSLv2 (last one is the default in IO-Socket-SSL-1.953)
        #
        $SSL_version = $SSL_version || '' ;
        #print "[$SSL_version]\n" ;

	my $sslargs = [
		SSL_verify_mode => 'SSL_VERIFY_PEER',
        	SSL_verifycn_scheme => 'imap',
                SSL_version => $SSL_version,
        ] ;
        $imap->Ssl( $sslargs ) ;
	return(  ) ;
}

sub set_tls {
	my ( $imap ) = @_ ;
	my $tlsargs = [
		SSL_verify_mode => 'SSL_VERIFY_NONE',
        ] ;
        $imap->Starttls( $tlsargs ) ;
	return(  ) ;
}




sub init_imap {
	my($host, $port, $user, $domain, $password, 
	   $mydebugimap, $mytimeout, $fastio, 
	   $ssl, $tls, $authmech, $authuser, $reconnectretry,
	   $proxyauth, $uid, $split, $Side, $SSL_version ) = @_ ;

	my ( $imap ) ;
	
	$imap = Mail::IMAPClient->new() ;
	
	if ( $ssl ) { set_ssl( $imap, $SSL_version ) }
	if ( $tls ) { 
        	$imap->Tls( $tls ) ;
        }
	$imap->Clear(1);
	$imap->Server($host);
	$imap->Port($port);
	$imap->Fast_io($fastio);
	$imap->Buffer($buffersize || 4096);
	$imap->Uid($uid);
	#$imap->Uid(0);
	$imap->Peek(1);
	$imap->Debug($mydebugimap);
	defined( $mytimeout ) and $imap->Timeout($mytimeout);

	$imap->Reconnectretry($reconnectretry) if ($reconnectretry);
	$imap->Ignoresizeerrors( $allowsizemismatch ) ;
	$split and $imap->Maxcommandlength( 10 * $split ) ;
	

	return( $imap ) ;

}

sub plainauth {
        my $code = shift;
        my $imap = shift;

        my $string = sprintf("%s\x00%s\x00%s", $imap->User,
                            $imap->Authuser, $imap->Password);
        return encode_base64("$string", "");
}

# xoauth() thanks to Eduardo Bortoluzzi Junior
sub xoauth {
               require URI::Escape  ;
               require Data::Uniqid ;

        my $code = shift;
        my $imap = shift;
               
        # The base information needed to construct the OAUTH authentication
        my $method = "GET";
        my $URL = sprintf("https://mail.google.com/mail/b/%s/imap/", $imap->User);
        my $URLparm = sprintf("xoauth_requestor_id=%s", URI::Escape::uri_escape($imap->User));
        
        # For Google Apps, the consumer key is the primary domain
        # TODO: create a command line argument to define the consumer key
        my @user_parts = split(/@/x, $imap->User);
        $debug and print "XOAUTH: consumer key: $user_parts[1]\n";
        
        # All the parameters needed to be signed on the XOAUTH
        my %hash = ();
        $hash { 'xoauth_requestor_id' } = URI::Escape::uri_escape($imap->User);
        $hash { 'oauth_consumer_key' } = $user_parts[1];
        $hash { 'oauth_nonce' } = md5_hex(Data::Uniqid::uniqid(rand(), 1==1));
        $hash { 'oauth_signature_method' } = 'HMAC-SHA1';
        $hash { 'oauth_timestamp' } = time();
        $hash { 'oauth_version' } = '1.0';

        # Base will hold the string to be signed
        my $base = "$method&" . URI::Escape::uri_escape($URL) . "&";
        
        # The parameters must be in dictionary order before signing
        my $baseparms = "";
        foreach my $key (sort keys %hash) {
                if(length($baseparms)>0) {
                        $baseparms .= "&";
                }
                
                $baseparms .= "$key=$hash{$key}";
        }
        
        $base .= URI::Escape::uri_escape($baseparms);
        $debug and print "XOAUTH: base request to sign: $base\n";
        # Sign it with the consumer secret, informed on the command line (password)
        my $digest = hmac_sha1($base, URI::Escape::uri_escape($imap->Password) . "&");
        
        # The parameters signed become a parameter and...
        $hash { 'oauth_signature' } = URI::Escape::uri_escape(substr(encode_base64($digest),0,-1));
        
        # ... we don't need the requestor_id anymore.
        delete $hash{'xoauth_requestor_id'};
        
        # Create the final authentication string
        my $string = $method . " " . $URL . "?" . $URLparm ." ";

        # All the parameters must be sorted
        $baseparms = "";
        foreach my $key (sort keys %hash) {
                if(length($baseparms)>0) {
                        $baseparms .= ",";
                }
                
                $baseparms .= "$key=\"$hash{$key}\"";
        }
        
        $string .= $baseparms;
        
        $debug and print "XOAUTH: authentication string: $string\n";
       
       # It must be base64 encoded     
        return encode_base64("$string", "");
}

sub server_banner {
	my $imap = shift;
	my $banner = $imap->Banner() ||  "No banner\n";
	return $banner;
 }


sub banner_imapsync {

	my @argv = @_ ;
	my $banner_imapsync = join("", 
		  '$RCSfile: imapsync,v $ ',
		  '$Revision: 1.592 $ ',
		  '$Date: 2014/05/22 10:03:17 $ ',
		  "\n",localhost_info(), "\n",
		  "Command line used:\n",
		  "$0 ", command_line_nopassword( @argv ), "\n",
	) ;
        return( $banner_imapsync ) ;
}

sub is_valid_directory {
	my $dir = shift;
	return( 1 ) if (-d $dir and -r _ and -w _) ;
	# Trying to create it
	eval { mkpath( $dir ) } or return( 0 ) ;
}


sub write_pidfile { 
	my $pid_filename = shift ;
	
	print "PID file is $pid_filename\n" ;
	if ( -e $pid_filename and $pidfilelocking ) {
		print "$pid_filename already exists, another imapsync may be curently running. Aborting imapsync.\n" ;
                exit( 8 ) ;
	} 
	if ( -e $pid_filename ) {
		print "$pid_filename already exists, overwriting it\n" ;
	}
        my $FILE_HANDLE ;
	open( $FILE_HANDLE, '>', $pid_filename ) or do {
		print "Could not open $pid_filename for writing" ;
		return ;
	} ;
	
	print $FILE_HANDLE $PROCESS_ID ;
	close $FILE_HANDLE ;
        
	return( $PROCESS_ID ) ;
} 

sub exit_clean {
	my $status = shift ;
	$status = defined( $status ) ? $status : 1 ;
	unlink( $pidfile ) ;
	exit( $status ) ;
}

sub die_clean {
	my @messages = @_ ;
	unlink( $pidfile ) ;
	die( @messages ) ;
} 

sub missing_option {
	my ($option) = @_;
	die_clean("$option option is mandatory, for help run $0 --help\n");
	return(  ) ;
}


sub fix_Inbox_INBOX_mapping {
	my( $h1_all, $h2_all ) = @_ ;

	my $regex = '' ;
	SWITCH: {
		if ( exists( $h1_all->{INBOX} ) and exists( $h2_all->{INBOX} ) ) { $regex = '' ; last SWITCH ; } ;
		if ( exists( $h1_all->{Inbox} ) and exists( $h2_all->{Inbox} ) ) { $regex = '' ; last SWITCH ; } ;
		if ( exists( $h1_all->{INBOX} ) and exists( $h2_all->{Inbox} ) ) { $regex = 's/^INBOX$/Inbox/x' ; last SWITCH ; } ;
		if ( exists( $h1_all->{Inbox} ) and exists( $h2_all->{INBOX} ) ) { $regex = 's/^Inbox$/INBOX/x' ; last SWITCH ; } ;
	} ;
        return( $regex ) ;
}

sub tests_fix_Inbox_INBOX_mapping {

	my( $h1_all, $h2_all ) ;
        
	$h1_all = { 'INBOX' => '' } ;
	$h2_all = { 'INBOX' => '' } ;
	ok( '' eq fix_Inbox_INBOX_mapping( $h1_all, $h2_all ), 'fix_Inbox_INBOX_mapping: INBOX INBOX' ) ;
        
	$h1_all = { 'Inbox' => '' } ;
	$h2_all = { 'Inbox' => '' } ;
	ok( '' eq fix_Inbox_INBOX_mapping( $h1_all, $h2_all ), 'fix_Inbox_INBOX_mapping: Inbox Inbox' ) ;
        
	$h1_all = { 'INBOX' => '' } ;
	$h2_all = { 'Inbox' => '' } ;
	ok( 's/^INBOX$/Inbox/x' eq fix_Inbox_INBOX_mapping( $h1_all, $h2_all ), 'fix_Inbox_INBOX_mapping: INBOX Inbox' ) ;
        
	$h1_all = { 'Inbox' => '' } ;
	$h2_all = { 'INBOX' => '' } ;
	ok( 's/^Inbox$/INBOX/x' eq fix_Inbox_INBOX_mapping( $h1_all, $h2_all ), 'fix_Inbox_INBOX_mapping: Inbox INBOX' ) ;
        
	$h1_all = { 'INBOX' => '' } ;
	$h2_all = { 'rrrrr' => '' } ;
	ok( '' eq fix_Inbox_INBOX_mapping( $h1_all, $h2_all ), 'fix_Inbox_INBOX_mapping: INBOX rrrrrr' ) ;
        
	$h1_all = { 'rrrrr' => '' } ;
	$h2_all = { 'Inbox' => '' } ;
	ok( '' eq fix_Inbox_INBOX_mapping( $h1_all, $h2_all ), 'fix_Inbox_INBOX_mapping: rrrrr Inbox' ) ;

	return(  ) ;
}

sub select_folder {
	my ( $imap, $folder, $hostside ) = @_ ;
	if ( ! $imap->select( $folder ) ) {
		print 
		"$hostside folder $folder: Could not select: ",
		$imap->LastError,  "\n" ;
		$nb_errors++ ;
		return( 0 ) ;
	}else{
		# ok select succeeded
		return( 1 ) ;
	}
}

sub examine_folder {
	my ( $imap, $folder, $hostside ) = @_ ;
	if ( ! $imap->examine( $folder ) ) {
		print 
		"$hostside folder $folder: Could not examine: ",
		$imap->LastError,  "\n" ;
		$nb_errors++ ;
		return( 0 ) ;
	}else{
		# ok examine succeeded
		return( 1 ) ;
	}
}


sub create_folder_old {
	my( $imap, $h2_fold, $h1_fold ) = @_ ;
	
	print "Creating (old way) folder [$h2_fold] on host2\n";
        if ( ( 'INBOX' eq uc( $h2_fold) )
         and ( $imap->exists( $h2_fold ) ) ) {
                print "Folder [$h2_fold] already exists\n" ;
                return( 1 ) ;
        }
	if ( ! $dry ){
		if ( ! $imap->create( $h2_fold ) ) {
			print( "Could not create folder [$h2_fold] from [$h1_fold]: ",
			$imap->LastError(  ), "\n" );
			$nb_errors++;
                        # success if folder exists ("already exists" error)
                        return( 1 ) if $imap->exists( $h2_fold ) ;
                        # failure since create failed
			return( 0 );
		}else{
			#create succeeded
                        print "Created  (old way) folder [$h2_fold] on host2\n";
			return( 1 );
		}
	}else{
		# dry mode, no folder so many imap will fail, assuming failure
                print "Created  (old way) folder [$h2_fold] on host2 $dry_message\n";
		return( 0 );
	}
}


sub create_folder {
        my( $imap2 , $h2_fold , $h1_fold ) = @_ ;
        my( @parts , $parent ) ;

	if ( $create_folder_old ) {
        	return( create_folder_old( $imap2 , $h2_fold , $h1_fold ) ) ;
	}
        print "Creating folder [$h2_fold] on host2\n" ;
        if ( ( 'INBOX' eq uc( $h2_fold ) )
         and ( $imap2->exists( $h2_fold ) ) ) {
                print "Folder [$h2_fold] already exists\n" ;
                return( 1 ) ;
        }

        @parts = split( /\Q$h2_sep\E/ , $h2_fold ) ;
        pop( @parts ) ;
        $parent = join( $h2_sep , @parts ) ;
        $parent =~ s/^\s+|\s+$//g ;
        if ( ($parent ne "") and ! $imap2->exists( $parent ) ) {
                create_folder( $imap2 , $parent , $h1_fold ) ;
        }

        if ( ! $dry ) {
                if ( ! $imap2->create( $h2_fold ) ) {
                        print( "Could not create folder [$h2_fold] from [$h1_fold]: " ,
                        $imap2->LastError(  ), "\n" ) ;
                        $nb_errors++ ;
                        # success if folder exists ("already exists" error)
                        return( 1 ) if $imap2->exists( $h2_fold ) ;
                        # failure since create failed
                        return( 0 ) ;
                }else{
                        #create succeeded
                        print "Created  folder [$h2_fold] on host2\n" ;
                        return( 1 ) ;
                }
        }else{
                # dry mode, no folder so many imap will fail, assuming failure
                print "Created  folder [$h2_fold] on host2 $dry_message\n" ;
                print "Since --dry mode is on and folder [$h2_fold] on host2 does not exist yet, syncing messges will not be simulated.\n"
                . "To simulate message syncing, use --justfolders without --dry to first create the missing folders then rerun the --dry sync.\n" ;
                return( 0 ) ;
        }
}



sub tests_folder_routines {
	ok( !is_requested_folder('folder_foo'), 'is_requested_folder folder_foo 1'               );
	ok(  add_to_requested_folders('folder_foo'), 'add_to_requested_folders folder_foo'       );
	ok(  is_requested_folder('folder_foo'), 'is_requested_folder folder_foo 2'               );
	ok( !is_requested_folder('folder_NO_EXIST'), 'is_requested_folder folder_NO_EXIST'       );
	ok( !remove_from_requested_folders('folder_foo'), 'removed folder_foo'                   );
	ok( !is_requested_folder('folder_foo'), 'is_requested_folder folder_foo 3'               );
	my @f ;
	ok(  @f = add_to_requested_folders('folder_bar', 'folder_toto'), "add result: @f"        );
	ok(  is_requested_folder('folder_bar'), 'is_requested_folder 4'                          );
	ok(  is_requested_folder('folder_toto'), 'is_requested_folder 5'                         );
	ok(  remove_from_requested_folders('folder_toto'), 'remove_from_requested_folders: '       );
	ok( !is_requested_folder('folder_toto'), 'is_requested_folder 6'                         );
	ok( !remove_from_requested_folders('folder_bar'), "remove_from_requested_folders: empty" ) ;

        ok( 0 == compare_lists( [ sort_requested_folders(  ) ], [] ), 'sort_requested_folders: all empty' ) ;
	ok(  add_to_requested_folders('M_55'), 'add_to_requested_folders M_55'       );
        ok( 0 == compare_lists( [ sort_requested_folders(  ) ], [ 'M_55' ] ), 'sort_requested_folders: middle' ) ;
	@folderfirst = ( 'Z_11' ) ;
        ok( 0 == compare_lists( [ sort_requested_folders(  ) ], [ 'Z_11', 'M_55' ] ), 'sort_requested_folders: first+middle' ) ;
	@folderlast = ( 'A_99' ) ;
        ok( 0 == compare_lists( [ sort_requested_folders(  ) ], [ 'Z_11', 'M_55', 'A_99' ] ), 'sort_requested_folders: first+middle+last 1' ) ;

	ok(  add_to_requested_folders('M_55', 'M_44',), 'add_to_requested_folders M_55 M_44'       );
        ok( 0 == compare_lists( [ sort_requested_folders(  ) ], [ 'Z_11', 'M_44', 'M_55', 'A_99' ] ), 'sort_requested_folders: first+middle+last 2' ) ;
	@folderfirst = ( 'Z_22', 'Z_11' ) ;
	@folderlast  = ( 'A_99', 'A_88' ) ;
        ok( 0 == compare_lists( [ sort_requested_folders(  ) ], [  'Z_22', 'Z_11', 'M_44', 'M_55', 'A_99', 'A_88' ] ), 'sort_requested_folders: first+middle+last 3' ) ;
        
	return(  ) ;
}


sub sort_requested_folders {
	my @requested_folders_sorted = () ;

	foreach my $folder ( @folderfirst ) {
        	remove_from_requested_folders( $folder ) ;
        }

	foreach my $folder ( @folderlast ) {
        	remove_from_requested_folders( $folder ) ;
        }

	my @middle = sort( keys( %requested_folder ) ) ;

        @requested_folders_sorted = ( @folderfirst, @middle, @folderlast ) ;

	return( @requested_folders_sorted ) ;
}

sub is_requested_folder {
	my ( $folder ) = @_;
	
	return( defined( $requested_folder{ $folder } ) ) ;
}


sub add_to_requested_folders {
	my @wanted_folders = @_ ;
	
	foreach my $folder ( @wanted_folders ) {
	 	++$requested_folder{ $folder } ;
	}
	return( keys( %requested_folder ) ) ;
}

sub remove_from_requested_folders {
	my @wanted_folders = @_ ;
	
	foreach my $folder ( @wanted_folders ) {
	 	delete $requested_folder{ $folder } ;
	}
	return( keys( %requested_folder ) ) ;
}

sub compare_lists {
	my ($list_1_ref, $list_2_ref) = @_;
	
	return(-1) if ((not defined($list_1_ref)) and defined($list_2_ref));
	return(0)  if ((not defined($list_1_ref)) and not defined($list_2_ref)); # end if no list
	return(1)  if (not defined($list_2_ref)); # end if only one list
	
	if (not ref($list_1_ref)) {$list_1_ref = [$list_1_ref]};
	if (not ref($list_2_ref)) {$list_2_ref = [$list_2_ref]};


	my $last_used_indice = -1;
	#print "\$#$list_1_ref:", $#$list_1_ref, "\n";
	#print "\$#$list_2_ref:", $#$list_2_ref, "\n";
	ELEMENT:
	foreach my $indice ( 0 .. $#$list_1_ref ) {
		$last_used_indice = $indice;
		
		# End of list_2
		return 1 if ($indice > $#$list_2_ref);
		
		my $element_list_1 = $list_1_ref->[$indice];
		my $element_list_2 = $list_2_ref->[$indice];
		my $balance = $element_list_1 cmp $element_list_2 ;
		next ELEMENT if ($balance == 0) ;
		return $balance;
	}
	# each element equal until last indice of list_1
	return -1 if ($last_used_indice < $#$list_2_ref) ;
	
	# same size, each element equal
	return 0 ;
}

sub tests_compare_lists {

	
	my $empty_list_ref = [];
	
	ok( 0 == compare_lists()               , 'compare_lists, no args');
	ok( 0 == compare_lists(undef)          , 'compare_lists, undef = nothing');
	ok( 0 == compare_lists(undef, undef)   , 'compare_lists, undef = undef');
	ok(-1 == compare_lists(undef , [])     , 'compare_lists, undef < []');
	ok(-1 == compare_lists(undef , [1])    , 'compare_lists, undef < [1]');
	ok(-1 == compare_lists(undef , [0])    , 'compare_lists, undef < [0]');
      	ok(+1 == compare_lists([])             , 'compare_lists, [] > nothing');
        ok(+1 == compare_lists([], undef)      , 'compare_lists, [] > undef');
	ok( 0 == compare_lists([] , [])        , 'compare_lists, [] = []');

	ok(-1 == compare_lists([] , [1])        , 'compare_lists, [] < [1]');
	ok(+1 == compare_lists([1] , [])        , 'compare_lists, [1] > []');

	
	ok( 0 == compare_lists([1],  1 )          , "compare_lists, [1] =  1 ") ;
	ok( 0 == compare_lists( 1 , [1])          , "compare_lists,  1  = [1]") ;
	ok( 0 == compare_lists( 1 ,  1 )          , "compare_lists,  1  =  1 ") ;
	ok(-1 == compare_lists( 0 ,  1 )          , "compare_lists,  0  <  1 ") ;
	ok(-1 == compare_lists(-1 ,  0 )          , "compare_lists, -1  <  0 ") ;
	ok(-1 == compare_lists( 1 ,  2 )          , "compare_lists,  1  <  2 ") ;
	ok(+1 == compare_lists( 2 ,  1 )          , "compare_lists,  2  >  1 ") ;


	ok( 0 == compare_lists([1,2], [1,2])   , "compare_lists, [1,2] = [1,2]") ;
	ok(-1 == compare_lists([1], [1,2])     , "compare_lists, [1] < [1,2]") ;
	ok(+1 == compare_lists([2], [1,2])     , "compare_lists, [2] > [1,2]") ;
	ok(-1 == compare_lists([1], [1,1])     , "compare_lists, [1] < [1,1]") ;
	ok(+1 == compare_lists([1, 1], [1])    , "compare_lists, [1, 1] > [1]") ;
	ok( 0 == compare_lists([1 .. 20_000] , [1 .. 20_000])
                                               , "compare_lists, [1..20_000] = [1..20_000]") ;
	ok(-1 == compare_lists([1], [3])       , 'compare_lists, [1] < [3]') ;
	ok( 0 == compare_lists([2], [2])       , 'compare_lists, [0] = [2]') ;
	ok(+1 == compare_lists([3], [1])       , 'compare_lists, [3] > [1]') ;
	
	ok(-1 == compare_lists(["a"], ["b"])   , 'compare_lists, ["a"] < ["b"]') ;
	ok( 0 == compare_lists(["a"], ["a"])   , 'compare_lists, ["a"] = ["a"]') ;
	ok( 0 == compare_lists(["ab"], ["ab"]) , 'compare_lists, ["ab"] = ["ab"]') ;
	ok(+1 == compare_lists(["b"], ["a"])   , 'compare_lists, ["b"] > ["a"]') ;
	ok(-1 == compare_lists(["a"], ["aa"])  , 'compare_lists, ["a"] < ["aa"]') ;
	ok(-1 == compare_lists(["a"], ["a", "a"]), 'compare_lists, ["a"] < ["a", "a"]') ;
	ok( 0 == compare_lists([split(" ", "a b")], ["a", "b"]), 'compare_lists, split') ;
	ok( 0 == compare_lists([sort split(" ", "b a")], ["a", "b"]), 'compare_lists, sort split') ;
        return(  ) ;
}



sub get_prefix { 
	my( $imap, $prefix_in, $prefix_opt, $Side ) = @_ ;
	my( $prefix_out ) ;
	
	$debug and print "$Side: Getting prefix\n" ;

	$debug and print "$Side: Calling namespace capability\n" ;
	if ( $imap->has_capability( "namespace" ) ) {
		my $r_namespace = $imap->namespace(  ) ;
		$prefix_out = $r_namespace->[0][0][0] ;
                print "$Side: prefix given by NAMESPACE: [$prefix_out]\n" ;
		if ( defined( $prefix_in ) ) {
                	print "$Side: but using [$prefix_in] given by $prefix_opt\n" ;
                	$prefix_out = $prefix_in ;
                	return( $prefix_out ) ;
                }else{
                	# all good
	                return( $prefix_out ) ;
                }
	}
	else{
        	if ( defined( $prefix_in ) ) {
                	print "$Side: using [$prefix_in] given by $prefix_opt\n" ;
                	$prefix_out = $prefix_in ;
                	return( $prefix_out ) ;
                }else{
			print 
			  "$Side: No NAMESPACE capability in imap server ", 
			    $imap->Server(  ),"\n",
			      help_to_guess_prefix( $imap, $prefix_opt ) ;
			exit_clean( 1 ) ;
                }
	}
        return(  ) ;
}


sub get_separator { 
	my( $imap, $sep_in, $sep_opt, $Side ) = @_ ;
	my( $sep_out ) ;
	
	
	$debug and print "$Side: calling namespace capability\n" ;
	if ( $imap->has_capability( "namespace" ) ) {
		$sep_out = $imap->separator(  ) ;
		if ( defined( $sep_out ) ) {
                	print "$Side: separator given by NAMESPACE: [$sep_out]\n" ;
                        if ( defined( $sep_in ) ) {
                		print "$Side: but using [$sep_in] given by $sep_opt\n" ;
                        	$sep_out = $sep_in ;
                        	return( $sep_out ) ;
                        }else{
                        	return( $sep_out ) ;
                        }
		}else{
                	if ( defined( $sep_in ) ) {
                        	print "$Side: NAMESPACE request failed but using [$sep_in] given by $sep_opt\n" ;
                        	$sep_out = $sep_in ;
                        	return( $sep_out ) ;
                        }else{
				print 
		  		"$Side: NAMESPACE request failed for ", 
		  		$imap->Server(), ": ", $imap->LastError, "\n",
                  		help_to_guess_sep( $imap, $sep_opt ) ;
				exit_clean( 1 ) ;
                        }
                }
	}
	else{
        	if ( defined( $sep_in ) ) {
                	print "$Side: No NAMESPACE capability but using [$sep_in] given by $sep_opt\n" ;
                	$sep_out = $sep_in ;
                	return( $sep_out ) ;
                }else{
			print
		  	"$Side: No NAMESPACE capability in imap server ", 
		    	$imap->Server(),"\n",
		      	help_to_guess_sep( $imap, $sep_opt ) ;
			exit_clean( 1 ) ;
                }
	}
        return(  ) ;
}

sub help_to_guess_sep {
	my( $imap, $sep_opt ) = @_ ;
	
	my $help_to_guess_sep = "Give the separator character with the $sep_opt option,\n"
	. "the folowing listing of folders may help you to find it:\n"
	. folders_list_to_help($imap)
	. "Most of the time it is character . or /\n"
	. "so try $sep_opt . or $sep_opt /\n" ;
	
	return( $help_to_guess_sep ) ;
}

sub help_to_guess_prefix {
	my( $imap, $prefix_opt ) = @_ ;
		      
	my $help_to_guess_prefix = "Give the prefix namespace with the $prefix_opt option,\n"
	. "the folowing listing of folders may help you to find it:\n"
	. folders_list_to_help( $imap )
	. "Most of the time it is INBOX. or an empty string\n"
	. "so try $prefix_opt INBOX. or $prefix_opt " . '""' . "\n" ;
	
	return( $help_to_guess_prefix ) ;
}


sub folders_list_to_help {
	my($imap) = @_ ;

	my @folders = $imap->folders ;
	my $listing = join('', map { "[$_]\n" } @folders) ;
	return( $listing ) ;
}


sub tests_separator_invert {
	$fixslash2 = 0 ;
	ok( not( defined( separator_invert(  ) ) ), 'separator_invert: no args' ) ;
	ok( not( defined( separator_invert( '' ) ) ), 'separator_invert: not enough args' ) ;
	ok( not( defined( separator_invert( '', '' ) ) ), 'separator_invert: not enough args' ) ;
	
	ok( '' eq separator_invert( '', '', '' ), 'separator_invert: 3 empty strings' ) ;
	ok( 'lalala' eq separator_invert( 'lalala', '', '' ), 'separator_invert: empty separator' ) ;
	ok( 'lalala' eq separator_invert( 'lalala', '/', '/' ), 'separator_invert: same separator /' ) ;
	ok( 'lal/ala' eq separator_invert( 'lal/ala', '/', '/' ), 'separator_invert: same separator / 2' ) ;
	ok( 'lal.ala' eq separator_invert( 'lal/ala', '/', '.' ), 'separator_invert: separators /.' ) ;
	ok( 'lal/ala' eq separator_invert( 'lal.ala', '.', '/' ), 'separator_invert: separators ./' ) ;
	ok( 'la.l/ala' eq separator_invert( 'la/l.ala', '.', '/' ), 'separator_invert: separators ./' ) ;

	ok( 'l/al.ala' eq separator_invert( 'l.al/ala', '/', '.' ), 'separator_invert: separators /.' ) ;
        $fixslash2 = 1 ;
	ok( 'l_al.ala' eq separator_invert( 'l.al/ala', '/', '.' ), 'separator_invert: separators /.' ) ;

	return(  ) ;
}

sub separator_invert {
	my( $h1_fold, $h1_separator, $h2_separator ) = @_ ;

	return( undef ) if ( not defined( $h1_fold ) or not defined( $h1_separator ) or not defined( $h2_separator ) ) ;
	# The separator we hope we'll never encounter: 00000000 == 0x00
	my $o_sep="\000" ;

	my $h2_fold = $h1_fold ;
	$h2_fold =~ s@\Q$h2_separator@$o_sep@xg ;
	$h2_fold =~ s@\Q$h1_separator@$h2_separator@xg ;
	$h2_fold =~ s@\Q$o_sep@$h1_separator@xg ;
        $h2_fold =~ s,/,_,xg if( $fixslash2 and '/' ne $h2_separator and '/' eq $h1_separator ) ;
	return( $h2_fold ) ;
} 


sub tests_imap2_folder_name {

$h1_prefix = $h2_prefix = '';
$h1_sep = '/';
$h2_sep = '.';

$debug and print <<"EOS"
prefix1: [$h1_prefix]
prefix2: [$h2_prefix]
sep1:[$h1_sep]
sep2:[$h2_sep]
EOS
;

$fixslash2 = 0 ;
ok('' eq imap2_folder_name(''), 'imap2_folder_name: empty string');
ok('blabla' eq imap2_folder_name('blabla'), 'imap2_folder_name: blabla');
ok('spam.spam' eq imap2_folder_name('spam/spam'), 'imap2_folder_name: spam/spam');
ok('spam/spam' eq imap2_folder_name('spam.spam'), 'imap2_folder_name: spam.spam');
ok('spam.spam/spam' eq imap2_folder_name('spam/spam.spam'), 'imap2_folder_name: spam/spam.spam');
ok('s pam.spam/sp  am' eq imap2_folder_name('s pam/spam.sp  am'), 'imap2_folder_name: s pam/spam.sp  am');
@regextrans2 = ('s,/,X,g');
ok('' eq imap2_folder_name(''), 'imap2_folder_name: empty string [s,/,X,g]');
ok('blabla' eq imap2_folder_name('blabla'), 'imap2_folder_name: blabla [s,/,X,g]');
ok('spam.spam' eq imap2_folder_name('spam/spam'), 'imap2_folder_name: spam/spam [s,/,X,g]');
ok('spamXspam' eq imap2_folder_name('spam.spam'), 'imap2_folder_name: spam.spam [s,/,X,g]');
ok('spam.spamXspam' eq imap2_folder_name('spam/spam.spam'), 'imap2_folder_name: spam/spam.spam [s,/,X,g]');

@regextrans2 = ('s, ,_,g');
ok('blabla' eq imap2_folder_name('blabla'), 'imap2_folder_name: blabla [s, ,_,g]');
ok('bla_bla' eq imap2_folder_name('bla bla'), 'imap2_folder_name: blabla [s, ,_,g]');

@regextrans2 = ('s,(.*),\U$1,');
ok('BLABLA' eq imap2_folder_name('blabla'), 'imap2_folder_name: blabla [s,\U(.*)\E,$1,]');

$fixslash2 = 1 ;
@regextrans2 = (  ) ;
ok('' eq imap2_folder_name(''), 'imap2_folder_name: empty string');
ok('blabla' eq imap2_folder_name('blabla'), 'imap2_folder_name: blabla');
ok('spam.spam' eq imap2_folder_name('spam/spam'), 'imap2_folder_name: spam/spam -> spam.spam');
ok('spam_spam' eq imap2_folder_name('spam.spam'), 'imap2_folder_name: spam.spam -> spam_spam');
ok('spam.spam_spam' eq imap2_folder_name('spam/spam.spam'), 'imap2_folder_name: spam/spam.spam -> spam.spam_spam');
ok('s pam.spam_spa  m' eq imap2_folder_name('s pam/spam.spa  m'), 'imap2_folder_name: s pam/spam.spa m -> s pam.spam_spa  m');

$h1_sep = '.';
$h2_sep = '/';
ok('' eq imap2_folder_name(''), 'imap2_folder_name: empty string');
ok('blabla' eq imap2_folder_name('blabla'), 'imap2_folder_name: blabla');
ok('spam.spam' eq imap2_folder_name('spam/spam'), 'imap2_folder_name: spam/spam -> spam.spam');
ok('spam/spam' eq imap2_folder_name('spam.spam'), 'imap2_folder_name: spam.spam -> spam/spam');
ok('spam.spam/spam' eq imap2_folder_name('spam/spam.spam'), 'imap2_folder_name: spam/spam.spam -> spam.spam/spam');

$fixslash2 = 0 ;
$h1_prefix = ' ';

ok('spam.spam/spam' eq imap2_folder_name('spam/spam.spam'), 'imap2_folder_name: spam/spam.spam -> spam.spam/spam');
ok('spam.spam/spam' eq imap2_folder_name(' spam/spam.spam'), 'imap2_folder_name:  spam/spam.spam -> spam.spam/spam');


return(  ) ;

}

sub imap2_folder_name {
	my ( $x_fold ) = @_ ;
	my ( $h2_fold ) ;
	# first we remove the prefix
	$x_fold =~ s/^\Q$h1_prefix\E//x ;
	$debug and print "removed host1 prefix: [$x_fold]\n";
	$h2_fold = separator_invert($x_fold,$h1_sep, $h2_sep);
	$debug and print "inverted  separators: [$h2_fold]\n";
	# Adding the prefix supplied by namespace or the --prefix2 option
	$h2_fold = $h2_prefix . $h2_fold 
	  unless(($h2_prefix eq "INBOX" . $h2_sep) and ($h2_fold =~ m/^INBOX$/xi));
	$debug and print "added   host2 prefix: [$h2_fold]\n";

	# Transforming the folder name by the --regextrans2 option(s)
	foreach my $regextrans2 (@regextrans2) {
	        my $h2_fold_before = $h2_fold;
		my $ret = eval( "\$h2_fold =~ $regextrans2 ; 1 ") ;
		$debug and print "[$h2_fold_before] -> [$h2_fold] using re [$regextrans2]\n" ;
                if ( not ( defined( $ret ) ) or $@ ) {
			die_clean("error: eval regextrans2 '$regextrans2': $@\n") ;
                }
	}
	return($h2_fold);
}

sub tests_decompose_regex {
	ok( 1, 'decompose_regex 1' ) ;
	ok( 0 == compare_lists( [ '', '' ], [ decompose_regex( '' ) ] ), 'decompose_regex empty string' ) ;
	ok( 0 == compare_lists( [ '.*', 'lala' ], [ decompose_regex( 's/.*/lala/' ) ] ), 'decompose_regex s/.*/lala/' ) ;
	return(  ) ;
}

sub decompose_regex {
	my $regex = shift ;
	my( $left_part, $right_part ) ;

	( $left_part, $right_part ) = $regex =~ m{^s/((?:[^/]|\\/)+)/((?:[^/]|\\/)+)/}x;
        return( '', '' ) if not $left_part ;
	return( $left_part, $right_part ) ;
}


sub foldersizes {

	my ( $side, $imap, $search_cmd, @folders ) = @_ ;
	my $total_size = 0 ;
	my $total_nb = 0 ;
	my $biggest_in_all = 0 ;
	
	print "++++ Calculating sizes on $side\n" ;
	foreach my $folder ( @folders )     {
		my $stot = 0 ;
		my $nb_msgs = 0 ;
		printf( "$side folder %-35s", "[$folder]" ) ;
                if ( 'Host2' eq $side and not exists( $h2_folders_all_UPPER{ uc( $folder ) } ) ) {
		        print(" does not exist yet\n") ;
			next ;
		}
                if ( 'Host1' eq $side and not exists( $h1_folders_all{ $folder } ) ) {
		        print( " does not exist\n" ) ;
			next ;
		}
                
		# FTGate is RFC buggy with EXAMINE it does not act as SELECT
		#unless ( $imap->examine( $folder ) ) {
		unless ( $imap->select( $folder ) ) {
			print 
			  "$side Folder $folder: Could not examine: ",
			    $imap->LastError,  "\n" ;
			$nb_errors++ ;
			next ;
		}
		last if $imap->IsUnconnected() ;

		my $hash_ref = { } ;
		my @msgs = select_msgs( $imap, undef, $search_cmd, $folder ) ;
		$nb_msgs = scalar( @msgs ) ;
		my $biggest_in_folder = 0 ;
		@$hash_ref{ @msgs } = ( undef ) if @msgs ;
		if ( $nb_msgs > 0 and @msgs ) {
                	if ( $abletosearch ) {
				$imap->fetch_hash( \@msgs, "RFC822.SIZE", $hash_ref) or die_clean("$@" ) ;
                        }else{
				my $uidnext = $imap->uidnext( $folder ) || $uidnext_default ;
                        	$imap->fetch_hash( "1:$uidnext", "RFC822.SIZE", $hash_ref ) or die_clean( "$@" ) ;
                        }
			for ( keys %$hash_ref ) {
                        	my $size =  $hash_ref->{ $_ }->{ "RFC822.SIZE" } ;
                        	$stot    += $size ;
                                $biggest_in_folder =  max( $biggest_in_folder, $size ) ;
                        }
		}
		
		printf( " Size: %9s", $stot ) ;
		printf( " Messages: %5s", $nb_msgs ) ;
		printf( " Biggest: %9s\n", $biggest_in_folder ) ;
		$total_size += $stot ;
		$total_nb += $nb_msgs ;
                $biggest_in_all =  max( $biggest_in_all, $biggest_in_folder ) ;
	}
	printf ( "%s Nb messages:     %11s messages\n", $side, $total_nb ) ;
	printf ( "%s Total size:      %11s bytes (%s)\n", $side, $total_size, bytes_display_string( $total_size ) ) ;
	printf ( "%s Biggest message: %11s bytes (%s)\n", $side, $biggest_in_all, bytes_display_string( $biggest_in_all ) ) ;
	printf ( "%s Time spent:      %11.1f seconds\n", $side, timenext(  ) ) ;
        return( $total_nb, $total_size ) ;
}

sub timenext {
	my ( $timenow, $timediff ) ;
	# $timebefore is global, beurk !
	$timenow    = time ;
	$timediff   = $timenow - $timebefore ;
	$timebefore = $timenow ;
	return( $timediff ) ;
}

sub timesince {
	my $timeinit = shift ;
	my ( $timenow, $timediff ) ;
	$timenow    = time ;
	$timediff   = $timenow - $timeinit ;
	return( $timediff ) ;
}




sub tests_flags_regex {
	
	
	ok('' eq flags_regex(''), "flags_regex, null string ''");
	ok('\Seen NonJunk $Spam' eq flags_regex('\Seen NonJunk $Spam'), 'flags_regex, nothing to do');

	@regexflag = ('I am BAD' ) ;
        ok( not ( defined( flags_regex( '' ) ) ), 'flags_regex, bad regex' ) ;
        
	@regexflag = ('s/NonJunk//g');
	ok('\Seen  $Spam' eq flags_regex('\Seen NonJunk $Spam'), "flags_regex, remove NonJunk: 's/NonJunk//g'");
	@regexflag = ('s/\$Spam//g');
	ok('\Seen NonJunk ' eq flags_regex('\Seen NonJunk $Spam'), 'flags_regex, remove $Spam: '."'s/\$Spam//g'");
	
	@regexflag = ('s/\\\\Seen//g');
	
	ok(' NonJunk $Spam' eq flags_regex('\Seen NonJunk $Spam'), 'flags_regex, remove \Seen: '. "'s/\\\\\\\\Seen//g'");
	
	@regexflag = ('s/(\s|^)[^\\\\]\w+//g');
	ok('\Seen \Middle \End' eq flags_regex('\Seen NonJunk \Middle $Spam \End'), 'flags_regex, only \word [' . flags_regex('\Seen NonJunk \Middle $Spam \End'.']'));
	ok(' \Seen \Middle \End1' eq flags_regex('Begin \Seen NonJunk \Middle $Spam \End1 End'), 'flags_regex, only \word [' . flags_regex('Begin \Seen NonJunk \Middle $Spam \End1 End'.']'));

	@regexflag = ('s/.*?(Keep1|Keep2|Keep3)/$1 /g');
	ok('Keep1 Keep2  ReB' eq flags_regex('ReA Keep1 REM Keep2 ReB'), "Keep only regex");
	#ok('Keep1 Keep2' eq flags_regex('Keep1 Keep2 Remove1'), "Keep only regex");
	ok('Keep1 Keep2 ' eq flags_regex('REM REM Keep1 Keep2'), "Keep only regex");
	ok('Keep1 Keep2 ' eq flags_regex('Keep1 REM REM Keep2'), "Keep only regex");
	ok('Keep1 Keep2 ' eq flags_regex('REM Keep1 REM REM  Keep2'), "Keep only regex");
	ok('Keep1 Keep2 ' eq flags_regex('Keep1 Keep2'), "Keep only regex");
	ok('Keep1 ' eq flags_regex('REM Keep1'), "Keep only regex");

	@regexflag = ('s/(Keep1|Keep2|Keep3) (?!(Keep1|Keep2|Keep3)).*/$1 /g');
	ok('Keep1 Keep2 ' eq flags_regex('Keep1 Keep2 ReB'), "Keep only regex");
	ok('Keep1 Keep2 ' eq flags_regex('Keep1 Keep2 REM REM  REM'), "Keep only regex");
	ok('Keep2 ' eq flags_regex('Keep2 REM REM  REM'), "Keep only regex");
	#ok('' eq flags_regex('REM REM'), "Keep only regex");
	
	@regexflag = ('s/.*?(Keep1|Keep2|Keep3)/$1 /g', 
	's/(Keep1|Keep2|Keep3) (?!(Keep1|Keep2|Keep3)).*/$1 /g');
	ok('Keep1 Keep2 ' eq flags_regex('REM Keep1 REM Keep2 REM'), "Keep only regex");
	ok('Keep1 Keep2 ' eq flags_regex('Keep1 REM Keep2 REM'), "Keep only regex");
	ok('Keep1 Keep2 ' eq flags_regex('REM Keep1 Keep2 REM'), "Keep only regex");
	ok('Keep1 Keep2 ' eq flags_regex('REM Keep1 REM Keep2'), "Keep only regex");
	ok('Keep1 Keep2 Keep3 ' eq flags_regex('REM Keep1 REM Keep2 REM REM Keep3 REM'), "Keep only regex");
	ok('Keep1 ' eq flags_regex('REM  REM Keep1 REM REM REM '), "Keep only regex");
	ok('Keep1 Keep3 ' eq flags_regex('RE1 Keep1 RE2 Keep3 RE3 RE4 RE5 '), "Keep only regex");
	
	@regexflag = ('s/(.*)/$1 jrdH8u/');
	ok('REM  REM  REM REM REM jrdH8u' eq flags_regex('REM  REM  REM REM REM'), "Keep only regex 's/(.*)/\$1 jrdH8u/'") ;
	@regexflag = ('s/jrdH8u *//');
	ok('REM  REM  REM REM REM ' eq flags_regex('REM  REM  REM REM REM jrdH8u'), "Keep only regex s/jrdH8u *//") ;
	
	@regexflag = (
	's/(.*)/$1 jrdH8u/',
	's/.*?(Keep1|Keep2|Keep3|jrdH8u)/$1 /g', 
	's/(Keep1|Keep2|Keep3|jrdH8u) (?!(Keep1|Keep2|Keep3|jrdH8u)).*/$1 /g',
	's/jrdH8u *//'
	);
	
	ok('Keep1 Keep2 ' eq flags_regex('REM Keep1 REM Keep2 REM'), "Keep only regex 'REM Keep1 REM Keep2 REM'");
	ok('Keep1 Keep2 ' eq flags_regex('Keep1 REM Keep2 REM'), "Keep only regex");
	ok('Keep1 Keep2 ' eq flags_regex('REM Keep1 Keep2 REM'), "Keep only regex");
	ok('Keep1 Keep2 ' eq flags_regex('REM Keep1 REM Keep2'), "Keep only regex");
	ok('Keep1 Keep2 Keep3 ' eq flags_regex('REM Keep1 REM Keep2 REM REM Keep3 REM'), "Keep only regex");
	ok('Keep1 ' eq flags_regex('REM  REM Keep1 REM REM REM '), "Keep only regex");
	ok('Keep1 Keep3 ' eq flags_regex('RE1 Keep1 RE2 Keep3 RE3 RE4 RE5 '), "Keep only regex");
	ok('' eq flags_regex('REM  REM REM REM REM'), "Keep only regex");
	
	@regexflag = (
	's/(.*)/$1 jrdH8u/',
	's/.*?(\\\\Seen|\\\\Answered|\\\\Flagged|\\\\Deleted|\\\\Draft|jrdH8u)/$1 /g', 
	's/(\\\\Seen|\\\\Answered|\\\\Flagged|\\\\Deleted|\\\\Draft|jrdH8u) (?!(\\\\Seen|\\\\Answered|\\\\Flagged|\\\\Deleted|\\\\Draft|jrdH8u)).*/$1 /g',
	's/jrdH8u *//'
	);
	
	ok('\\Deleted \\Answered ' 
	eq flags_regex('Blabla $Junk \\Deleted machin \\Answered truc'), "Keep only regex: Exchange case");
	ok('' eq flags_regex(''), "Keep only regex: Exchange case, null string");
	ok('' 
	eq flags_regex('Blabla $Junk  machin  truc'), "Keep only regex: Exchange case, no accepted flags ");
	ok('\\Deleted \\Answered \\Draft \\Flagged ' 
	eq flags_regex('\\Deleted    \\Answered  \\Draft \\Flagged '), "Keep only regex: Exchange case");
	
	
	@regexflag = (
	's/.*?(?:(\\\\(?:Answered|Flagged|Deleted|Seen|Draft)\s?)|$)/defined($1)?$1:q()/eg'
	);
	
	ok('\\Deleted \\Answered ' 
	eq flags_regex('Blabla \$Junk \\Deleted machin \\Answered truc'), 
	"Keep only regex: Exchange case (Phil)");
	
	ok('' eq flags_regex(''), "Keep only regex: Exchange case, null string (Phil)");
	
	ok('' 
	eq flags_regex('Blabla $Junk  machin  truc'), 
	"Keep only regex: Exchange case, no accepted flags (Phil)");
	
	ok('\\Deleted \\Answered \\Draft \\Flagged ' 
	eq flags_regex('\\Deleted    \\Answered  \\Draft \\Flagged '), 
	"Keep only regex: Exchange case (Phil)");
	
	return(  ) ;
}

sub flags_regex {
	my ( $h1_flags ) = @_ ;
	foreach my $regexflag ( @regexflag ) {
		my $h1_flags_orig = $h1_flags ;
		$debugflags and print "eval \$h1_flags =~ $regexflag\n" ;
		my $ret = eval( "\$h1_flags =~ $regexflag ; 1 " ) ;
		$debugflags and print "regexflag $regexflag [$h1_flags_orig] -> [$h1_flags]\n" ;
                if( not ( defined $ret ) or $@ ) {
			print "Error: eval regexflag '$regexflag': $@\n" ;
                        return( undef ) ;
                }
	}
	return( $h1_flags ) ;
}

sub acls_sync {
	my($h1_fold, $h2_fold) = @_ ;
	if ( $syncacls ) {
		my $h1_hash = $imap1->getacl($h1_fold)
		  or print "Could not getacl for $h1_fold: $@\n";
		my $h2_hash = $imap2->getacl($h2_fold)
		  or print "Could not getacl for $h2_fold: $@\n";
		my %users = map({ ($_, 1) } (keys(%$h1_hash), keys(%$h2_hash)));
		foreach my $user (sort(keys(%users))) {
			my $acl = $h1_hash->{$user} || "none";
			print "acl $user: [$acl]\n";
			next if ($h1_hash->{$user} && $h2_hash->{$user} &&
				 $h1_hash->{$user} eq $h2_hash->{$user});
			unless ($dry) {
				print "setting acl $h2_fold $user $acl\n";
				$imap2->setacl($h2_fold, $user, $acl)
				  or print "Could not set acl: $@\n";
			}
		}
	}
        return(  ) ;
}


sub tests_permanentflags {
	
	my $string;
	ok('' eq permanentflags(' * OK [PERMANENTFLAGS (\* \Draft \Answered)] Limited'), 
	   'permanentflags \*');
	ok('\Draft \Answered' eq permanentflags(' * OK [PERMANENTFLAGS (\Draft \Answered)] Limited'), 
	   'permanentflags \Draft \Answered');
	ok('\Draft \Answered' 
	   eq permanentflags('Blabla', 
	                     ' * OK [PERMANENTFLAGS (\Draft \Answered)] Limited',
			     'Blabla'),
	   'permanentflags \Draft \Answered'
	);
	ok('' eq permanentflags('Blabla'), 'permanentflags nothing');
        return(  ) ;
}

sub permanentflags {
	my @lines = @_ ;

	foreach my $line (@lines) {
		if ( $line =~ m{\[PERMANENTFLAGS\s\(([^)]+?)\)\]}x ) {
			( $debugflags or $debug ) and print "permanentflags: $line" ;
			my $permanentflags = $1 ;
			if ( $permanentflags =~ m{\\\*}x ) {
				$permanentflags = '' ;
			}
			return($permanentflags) ;
		} ;
	}
        return( '' ) ;
}

sub tests_flags_filter {

	ok( '\Seen' eq flags_filter('\Seen', '\Draft \Seen \Answered'), 'flags_filter ' );
	ok( '' eq flags_filter('\Seen', '\Draft  \Answered'), 'flags_filter ' );
	ok( '\Seen' eq flags_filter('\Seen', '\Seen'), 'flags_filter ' );
	ok( '\Seen' eq flags_filter('\Seen', ' \Seen '), 'flags_filter ' );
	ok( '\Seen \Draft' 
	   eq flags_filter('\Seen \Draft', '\Draft \Seen \Answered'), 'flags_filter ' );
	ok( '\Seen \Draft' 
	   eq flags_filter('\Seen \Draft', ' \Draft \Seen \Answered '), 'flags_filter ' );
        return(  ) ;
}

sub flags_filter {
	my( $flags, $allowed_flags ) = @_ ;
	
	my @flags = split( /\s+/x, $flags ) ;
	my %allowed_flags = map { $_ => 1 } split(' ', $allowed_flags ) ;
	my @flags_out     = map { exists $allowed_flags{$_} ? $_ : () } @flags ;

	my $flags_out = join( ' ', @flags_out ) ;
	#print "%%%$flags_out%%%\n" ;
	return( $flags_out ) ;
}

sub flagsCase {
	my $flags = shift ;
	
	my @flags = split( /\s+/x, $flags );
	my %rfc_flags = map { $_ => 1 } split(' ', '\Answered \Flagged \Deleted \Seen \Draft' );
	my @flags_out = map { exists $rfc_flags{ ucsecond( lc( $_ ) ) } ? ucsecond( lc( $_ ) ) : $_ } @flags ;

	my $flags_out = join( ' ', @flags_out ) ;
	#print "%%%$flags_out%%%\n" ;
	return( $flags_out ) ;
}

sub tests_flagsCase {
	ok( '\Seen' eq flagsCase( '\Seen' ), 'flagsCase: \Seen -> \Seen' ) ;
	ok( '\Seen' eq flagsCase( '\SEEN' ), 'flagsCase: \SEEN -> \Seen' ) ;

	ok( '\Seen \Draft' eq flagsCase( '\SEEN \DRAFT' ), 'flagsCase: \SEEN \DRAFT -> \Seen \Draft' ) ;
	ok( '\Draft \Seen' eq flagsCase( '\DRAFT \SEEN' ), 'flagsCase: \DRAFT \SEEN -> \Draft \Seen' ) ;
	
	ok( '\Draft LALA \Seen' eq flagsCase( '\DRAFT  LALA \SEEN' ), 'flagsCase: \DRAFT  LALA \SEEN -> \Draft LALA \Seen' ) ;
	ok( '\Draft lala \Seen' eq flagsCase( '\DRAFT  lala \SEEN' ), 'flagsCase: \DRAFT  lala \SEEN -> \Draft lala \Seen' ) ;
        return(  ) ;
}

sub ucsecond {
	my $string = shift ;
	my $output ;
	
	return( $string )  if ( 1 >= length( $string ) ) ;
	$output = substr( $string, 0, 1) . uc( substr( $string, 1, 1 ) ) if ( 2 == length( $string ) ) ;
	$output = substr( $string, 0, 1) . uc( substr( $string, 1, 1 ) ) . substr( $string, 2 );
	#print "UUU $string -> $output\n" ;
	return( $output ) ;
}


sub tests_ucsecond {
	ok( 'aBcde' eq ucsecond( 'abcde' ), 'ucsecond: abcde -> aBcde' ) ;
	ok( 'ABCDE' eq ucsecond( 'ABCDE' ), 'ucsecond: ABCDE -> ABCDE'  ) ;
	ok( 'ABCDE' eq ucsecond( 'AbCDE' ), 'ucsecond: AbCDE -> ABCDE'  ) ;
	ok( 'ABCde' eq ucsecond( 'AbCde' ), 'ucsecond: AbCde -> ABCde'  ) ;
	ok( 'A'     eq ucsecond( 'A' ),     'ucsecond: A  -> A'  ) ;
	ok( 'AB'    eq ucsecond( 'Ab' ),    'ucsecond: Ab -> AB' ) ;
	ok( '\B'    eq ucsecond( '\b' ),    'ucsecond: \b -> \B' ) ;
	ok( '\Bcde' eq ucsecond( '\bcde' ), 'ucsecond: \bcde -> \Bcde' ) ;
        return(  ) ;
}


sub select_msgs {
	my ( $imap, $msgs_all_hash_ref, $search_cmd, $folder ) = @_ ;
	my ( @msgs ) ;

	if ( $abletosearch ) { 
		@msgs = select_msgs_by_search( $imap, $msgs_all_hash_ref, $search_cmd, $folder ) ;
	}else{
		@msgs = select_msgs_by_fetch( $imap, $msgs_all_hash_ref, $search_cmd, $folder ) ;
	}

}

sub select_msgs_by_search {
	my ( $imap, $msgs_all_hash_ref, $search_cmd, $folder ) = @_ ;
	my ( @msgs, @msgs_all ) ;
	
        # Need to have the whole list in msgs_all_hash_ref
        # without calling messages() several times.
        # Need all messages list to avoid deleting useful cache part 
        # in case of --search or --minage or --maxage

	if ( ( defined( $msgs_all_hash_ref ) and $usecache )
        or ( not defined( $maxage ) and not defined( $minage ) and not defined( $search_cmd ) )
        ) {

       		$debugdev and print "Calling messages()\n" ;
		@msgs_all = $imap->messages() ;

                return if ( $#msgs_all == 0 && !defined( $msgs_all[0] ) ) ;
                
                if ( defined( $msgs_all_hash_ref ) ) {
                        @{ $msgs_all_hash_ref }{ @msgs_all } =  () ;
                }
                # return all messages
                if ( not defined( $maxage ) and not defined( $minage ) and not defined( $search_cmd ) ) {
                        return( @msgs_all ) ;
                }
	}
        
        if ( defined( $search_cmd ) ) {
        	@msgs = $imap->search( $search_cmd ) ;
                return( @msgs ) ;
        }

	# we are here only if $maxage or $minage is defined
        @msgs = select_msgs_by_age( $imap ) ;
	return( @msgs );
}


sub select_msgs_by_fetch {
	my ( $imap, $msgs_all_hash_ref, $search_cmd, $folder ) = @_ ;
	my ( @msgs, @msgs_all, %fetch ) ;
	
        # Need to have the whole list in msgs_all_hash_ref
        # without calling messages() several times.
        # Need all messages list to avoid deleting useful cache part 
        # in case of --search or --minage or --maxage


	$debugdev and print "Calling fetch_hash()\n" ;
	my $uidnext = $imap->uidnext( $folder ) || $uidnext_default ;
	%fetch = %{$imap->fetch_hash( "1:$uidnext", "INTERNALDATE") } ;
        @msgs_all = sort { $a <=> $b } keys( %fetch ) ;
        $debugdev and print "Done fetch_hash()\n" ;

        return(  ) if ( $#msgs_all == 0 && !defined( $msgs_all[0] ) ) ;
               
        if ( defined( $msgs_all_hash_ref ) ) {
                 @{ $msgs_all_hash_ref }{ @msgs_all } =  () ;
        }
        # return all messages
        if ( not defined( $maxage ) and not defined( $minage ) and not defined( $search_cmd ) ) {
                return( @msgs_all ) ;
        }
	
        if ( defined( $search_cmd ) ) {
		print "Warning: strange to see --search with --noabletosearch, an error can happen\n" ;
        	@msgs = $imap->search( $search_cmd ) ;
                return( @msgs ) ;
        }

	# we are here only if $maxage or $minage is defined
	my( @max, @min, $maxage_epoch, $minage_epoch ) ;
	if ( defined( $maxage ) ) { $maxage_epoch = $timestart_int - 86400 * $maxage ; }
	if ( defined( $minage ) ) { $minage_epoch = $timestart_int - 86400 * $minage ; }
	foreach my $msg ( @msgs_all ) {
		my $idate = $fetch{ $msg }->{'INTERNALDATE'} ;
		#print "$idate\n" ;
		if ( defined( $maxage ) and ( epoch( $idate ) >= $maxage_epoch ) ) {
			push( @max, $msg ) ;
		}
		if ( defined( $minage ) and ( epoch( $idate ) <= $minage_epoch ) ) {
			push( @min, $msg ) ;
		}
	}
        @msgs = msgs_from_maxmin( \@max, \@min ) ;
	return( @msgs ) ;
}

sub select_msgs_by_age {
	my( $imap ) = @_ ;
        
	my( @max, @min, @msgs, @inter, @union ) ;
        
	if ( defined( $maxage ) ) {
		@max = $imap->sentsince( $timestart_int - 86400 * $maxage ) ;
	}
	if ( defined( $minage ) ) {
		@min = $imap->sentbefore( $timestart_int - 86400 * $minage ) ;
	}

	@msgs = msgs_from_maxmin( \@max, \@min ) ;
	return( @msgs ) ;
}

sub msgs_from_maxmin {
	my( $max_ref, $min_ref ) = @_ ;
	my( @max, @min, @msgs, @inter, @union ) ;

	@max = @$max_ref ;
	@min = @$min_ref ;

	SWITCH: {
		unless( defined( $minage ) ) { @msgs = @max ; last SWITCH } ;
		unless( defined( $maxage ) ) { @msgs = @min ; last SWITCH } ;
		my ( %union, %inter ) ; 
		foreach my $m ( @min, @max ) { $union{ $m }++ && $inter{ $m }++ }
		@inter = sort { $a <=> $b } keys( %inter ) ;
		@union = sort { $a <=> $b } keys( %union ) ;
		# normal case
		if ( $minage <= $maxage )  { @msgs = @inter ; last SWITCH } ;
		# just exclude messages between
		if ( $minage > $maxage )  { @msgs = @union ; last SWITCH } ;
		
	}
	return( @msgs );
}

sub tests_msgs_from_maxmin {
	my @msgs ;
	$maxage = 200 ;
	@msgs = msgs_from_maxmin( [ '1', '2' ], [ '2', '3' ] ) ;
	ok( 0 == compare_lists( [ '1', '2' ], \@msgs ), 'msgs_from_maxmin: maxage++' ) ;
	$minage = 100 ;
	@msgs = msgs_from_maxmin( [ '1', '2' ], [ '2', '3' ] ) ;
	ok( 0 == compare_lists( [ '2' ], \@msgs ), 'msgs_from_maxmin:  -maxage++minage-' ) ;
	$minage = 300 ;
	@msgs = msgs_from_maxmin( [ '1', '2' ], [ '2', '3' ] ) ;
	ok( 0 == compare_lists( [ '1', '2', '3' ], \@msgs ), 'msgs_from_maxmin:  ++maxage-minage++' ) ;
	$maxage = undef ;
	@msgs = msgs_from_maxmin( [ '1', '2' ], [ '2', '3' ] ) ;
	ok( 0 == compare_lists( [ '2', '3' ], \@msgs ), 'msgs_from_maxmin:  ++minage-' ) ;
}


sub lastuid {
	my $imap   = shift ;
	my $folder = shift ;
	my $lastuid_guess  = shift ;
	my $lastuid ;
	
	# rfc3501: The only reliable way to identify recent messages is to
	#          look at message flags to see which have the \Recent flag
	#          set, or to do a SEARCH RECENT.
	# SEARCH RECENT doesn't work this way on courrier.

	my @recent_messages ;
	# SEARCH RECENT for each transfer can be expensive with a big folder
	# Call commented for now
	#@recent_messages = $imap->recent(  ) ;
	#print "Recent: @recent_messages\n";
	
	my $max_recent ;
	$max_recent = max( @recent_messages ) ;
	 
	if ( defined( $max_recent ) and ($lastuid_guess <= $max_recent ) ) {
		$lastuid = $max_recent ;
	}else{
		$lastuid = $lastuid_guess
	}
	return( $lastuid ) ;
}

sub size_filtered {
	my( $h1_size, $h1_msg, $h1_fold, $h2_fold  ) = @_ ;
	
        $h1_size = 0 if ( ! $h1_size ) ; # null if empty or undef
	if (defined $maxsize and $h1_size > $maxsize) {
		print "msg $h1_fold/$h1_msg skipped ($h1_size exceeds maxsize limit $maxsize bytes)\n";
		$total_bytes_skipped += $h1_size;
		$nb_msg_skipped += 1;
		return( 1 ) ;
	}
	if (defined $minsize and $h1_size <= $minsize) {
		print "msg $h1_fold/$h1_msg skipped ($h1_size smaller than minsize $minsize bytes)\n";
		$total_bytes_skipped += $h1_size;
		$nb_msg_skipped += 1;
		return( 1 ) ;
	}
	return( 0 ) ;
}

sub message_exists {

	my( $imap, $msg ) = @_ ;
	return( 1 ) if not $imap->Uid(  ) ;
        
	my $search_uid ;
        ( $search_uid ) = $imap->search( "UID $msg" ) ;
        #print "$search ? $msg\n" ;
        return( 1 ) if ( $search_uid eq $msg ) ;
        return( 0 ) ;

}

sub copy_message {
	# copy
	
	my ( $h1_msg, $h1_fold, $h2_fold, $h1_fir_ref, $permanentflags2, $cache_dir ) = @_ ;
	( $debug or $dry) and print "msg $h1_fold/$h1_msg copying to $h2_fold $dry_message\n";

	my $h1_size  = $h1_fir_ref->{$h1_msg}->{"RFC822.SIZE"} || 0 ;
	my $h1_flags = $h1_fir_ref->{$h1_msg}->{"FLAGS"} || '' ;
	my $h1_idate = $h1_fir_ref->{$h1_msg}->{"INTERNALDATE"} || '' ;
	
	
        if ( size_filtered( $h1_size, $h1_msg, $h1_fold, $h2_fold  ) ) {
		$total_bytes_skipped += $h1_size;
		$nb_msg_skipped += 1;
        	$h1_nb_msg_processed +=1 ;
                return(  ) ;
        }
	
	do { print "SLEEP 5\n" and sleep 5 ; } if ( $debugsleep ) ;
	print "- msg $h1_fold/$h1_msg S[$h1_size] F[$h1_flags] I[$h1_idate] has RFC822.SIZE null!\n" if ( ! $h1_size ) ;

	
        if ( $checkmessageexists and not message_exists( $imap1, $h1_msg ) ) {
		$total_bytes_skipped += $h1_size;
		$nb_msg_skipped += 1;
        	$h1_nb_msg_processed +=1 ;
                return(  ) ;
        }

	my ( $string, $string_len ) ;
        ( $string, $string_len ) = message_for_host2( $h1_msg, $h1_fold, $h1_size, $h1_flags, $h1_idate, $h1_fir_ref ) ;
        
        if ( not defined( $string ) and not defined( $string_len ) ) {
		print "- msg $h1_fold/$h1_msg skipped. Could not be fetched\n" ;
		$total_bytes_skipped += $h1_size;
		$nb_msg_skipped += 1;
                $h1_nb_msg_processed +=1 ;
                return(  ) ;
        }
        
        # Lines two long => do no copy
        if ( defined ( $maxlinelength ) or defined ( $minmaxlinelength ) ) {
		my $maxlinelength_string = max_line_length( $string ) ;
                $debugmaxlinelength and print "msg $h1_fold/$h1_msg maxlinelength: $maxlinelength_string\n" ;
                if ( defined ( $maxlinelength )  and ( $maxlinelength_string > $maxlinelength ) ) {
         		my $subject = subject( $string ) ;
         		print "- msg $h1_fold/$h1_msg skipped S[$h1_size] F[$h1_flags] I[$h1_idate] " 
                      	. "(Subject:[$subject]) (line length exceeds maxlinelength $maxlinelength bytes)\n" ;
                        $h1_nb_msg_processed +=1 ;
			$total_bytes_skipped += $h1_size;
			$nb_msg_skipped += 1;
         		return(  ) ;
                }
                if ( defined ( $minmaxlinelength )  and ( $maxlinelength_string <= $minmaxlinelength ) ) {
         		my $subject = subject( $string ) ;
         		$debugdev and print "- msg $h1_fold/$h1_msg skipped S[$h1_size] F[$h1_flags] I[$h1_idate] " 
                      	. "(Subject:[$subject]) (max line length under minmaxlinelength $minmaxlinelength bytes)\n" ;
                        $h1_nb_msg_processed +=1 ;
			$total_bytes_skipped += $h1_size;
			$nb_msg_skipped += 1;
         		return(  ) ;
                }                
        }

	my $h1_date = date_for_host2( $h1_msg, $h1_idate ) ;

	( $debug or $debugflags ) and 
        print "Host1 flags init msg $h1_fold/$h1_msg date [$h1_date] flags [$h1_flags] size [$h1_size]\n" ;

	$h1_flags = flags_for_host2( $h1_flags, $permanentflags2 ) ;

	( $debug or $debugflags ) and 
        print "Host1 flags filt msg $h1_fold/$h1_msg date [$h1_date] flags [$h1_flags] size [$h1_size]\n" ;

	$h1_date = undef if ($h1_date eq "");
	
	my $new_id = append_message_on_host2( $string, $h1_fold, $h1_msg, $string_len, $h2_fold, $h1_size, $h1_flags, $h1_date, $cache_dir ) ;

	if ( $new_id and $syncflagsaftercopy ) {
        	sync_flags_after_copy( $h1_fold, $h1_msg, $h1_flags, $h2_fold, $new_id, $permanentflags2 ) ;
        }

	if ( $debugmemory ) { 
        	printf ("Memory consumption: %.1f MiB\n", memory_consumption(  ) / 1024 / 1024) ;
        }
        
        return( $new_id ) ;
}



sub message_for_host2 {
	my ( $h1_msg, $h1_fold, $h1_size, $h1_flags, $h1_idate, $h1_fir_ref ) = @_ ;
        
	my $string = $imap1->message_string( $h1_msg ) ;
	
	my $string_len = defined( $string ) ? length( $string ) : '' ; # length or empty string
	#print "- msg $h1_fold/$h1_msg {$string_len}\n" ;
	unless ( defined( $string ) and $string_len ) { # undef or 0 length
		print
		"- msg $h1_fold/$h1_msg {$string_len} S[$h1_size] F[$h1_flags] I[$h1_idate] could not be fetched: ",
		$imap1->LastError || '', "\n" ;
		$nb_errors++ ;
		$total_bytes_error += $h1_size if ( $h1_size ) ;
		#relogin1(  ) if ( $relogin1 ) ;
                $h1_nb_msg_processed +=1 ;
		return(  ) ;
	}
	
	if ( @regexmess ) {
		$string = regexmess( $string ) ;
                # string undef means the eval regex was bad.
                if ( not ( defined( $string ) ) ) {
                	print
			"- msg $h1_fold/$h1_msg {$string_len} S[$h1_size] F[$h1_flags] I[$h1_idate]" 
                        . " could not be transformed by --regexmess option\n" ;
                	return(  ) ;
                }
	}

        if ( $addheader and defined $h1_fir_ref->{$h1_msg}->{"NO_HEADER"} ) {
                my $header = add_header( $h1_msg ) ;
                $debug and print "msg $h1_fold/$h1_msg adding custom header [$header]\n" ;
                $string = $header . "\r\n" . $string ;
        }


	$debugcontent and print 
		"=" x80, "\n", 
		"F message content begin next line\n",
		$string,
		"F message content ended on previous line\n", "=" x 80, "\n";

	return( $string, $string_len ) ;
}

sub date_for_host2 {
	my( $h1_msg, $h1_idate ) = @_ ;

	my $h1_date = "" ;

	if ( $syncinternaldates ) {
		$h1_date = $h1_idate ;
		$debug and print "internal date from host1: [$h1_date]\n" ;
		$h1_date = good_date( $h1_date ) ;
		$debug and print "internal date from host1: [$h1_date] (fixed)\n" ;
	}
	
	if ( $idatefromheader ) {
		$h1_date = $imap1->get_header($h1_msg,"Date") ;
		$debug and print "header date from host1: [$h1_date]\n" ;
		$h1_date = good_date( $h1_date ) ;
		$debug and print "header date from host1: [$h1_date] (fixed)\n" ;
	}

	return( $h1_date ) ;
}

sub flags_for_host2 {
	my( $h1_flags, $permanentflags2 ) = @_ ;
	# RFC 2060: This flag can not be altered by any client
	$h1_flags =~ s@\\Recent\s?@@xgi ;
        my $h1_flags_re ;
        if ( @regexflag and defined( $h1_flags_re = flags_regex( $h1_flags ) ) ) {
                $h1_flags = $h1_flags_re ;
        }
	$h1_flags = flagsCase( $h1_flags ) if $flagsCase ;
        $h1_flags = flags_filter( $h1_flags, $permanentflags2) if ( $permanentflags2 and $filterflags ) ;
	
	return( $h1_flags ) ;
}

sub subject {
	my $string = shift ;
	my $subject = '' ;
        
        my $header = extract_header( $string ) ;

        if( $header =~ m/^Subject:\s*([^\n\r]*)\r?$/msx ) {  
        	#print "MMM[$1]\n" ;
        	$subject = $1 ;
        }
	return( $subject ) ;
}

sub tests_subject {
	ok( '' eq subject( '' ), 'subject: null') ;
	ok( 'toto le hero' eq subject( 'Subject: toto le hero' ), 'subject: toto le hero') ;
	ok( 'toto le hero' eq subject( 'Subject:toto le hero' ), 'subject: toto le hero blank') ;
	ok( 'toto le hero' eq subject( "Subject:toto le hero\r\n" ), 'subject: toto le hero\r\n') ;

        my $MESS ;
	$MESS = <<'EOF';
From: lalala
Subject: toto le hero
Date: zzzzzz

Boogie boogie
EOF
	ok( 'toto le hero' eq subject( $MESS ), 'subject: toto le hero 2') ;

	$MESS = <<'EOF';
Subject: toto le hero
From: lalala
Date: zzzzzz

Boogie boogie
EOF
	ok( 'toto le hero' eq subject( $MESS ), 'subject: toto le hero 3') ;


	$MESS = <<'EOF';
From: lalala
Subject: cuicui
Date: zzzzzz

Subject: toto le hero
EOF
	ok( 'cuicui' eq subject( $MESS ), 'subject: cuicui') ;

	$MESS = <<'EOF';
From: lalala
Date: zzzzzz

Subject: toto le hero
EOF
	ok( '' eq subject( $MESS ), 'subject: null but body could') ;


}


# GlobVar
# $dry
# $max_msg_size_in_bytes
# $imap2
# $imap1
# $nb_errors
# $total_bytes_error
# $h1_nb_msg_processed
# $h2_uidguess
# $total_bytes_transferred
# $nb_msg_transferred
# $begin_transfer_time
# $time_spent
# ...
#
#
sub append_message_on_host2 {
	my( $string, $h1_fold, $h1_msg, $string_len, $h2_fold, $h1_size, $h1_flags, $h1_date, $cache_dir ) = @_ ;
	
	my $new_id ;
	if ( ! $dry ) {
		$max_msg_size_in_bytes = max( $h1_size, $max_msg_size_in_bytes ) ;
		$new_id = $imap2->append_string( $h2_fold, $string, $h1_flags, $h1_date ) ;
		if ( ! $new_id){
                	my $subject = subject( $string ) ;
                        my $error = $imap2->LastError || '' ;
			print "- msg $h1_fold/$h1_msg {$string_len} couldn't append  (Subject:[$subject]) to folder $h2_fold: $error\n" ;
			  
			$nb_errors++;
			$total_bytes_error += $h1_size;
                        $h1_nb_msg_processed +=1 ;
			return(  ) ;
		}
		else{
			# good
			# $new_id is an id if the IMAP server has the 
			# UIDPLUS capability else just a ref
			if ( $new_id !~ m{^\d+$}x ) {
				$new_id = lastuid( $imap2, $h2_fold, $h2_uidguess ) ;
			}
			$h2_uidguess += 1 ;
			$total_bytes_transferred += $h1_size ;
			$nb_msg_transferred += 1 ;
                        $h1_nb_msg_processed +=1 ;

                        my $time_spent = timesince( $begin_transfer_time ) ;
                        my $rate = bytes_display_string( $total_bytes_transferred / $time_spent ) ;
                        my $eta = eta( $time_spent, $h1_nb_msg_processed, $h1_nb_msg_at_start, $nb_msg_transferred ) ;
                        
			printf( "msg %s/%-19s copied to %s/%-10s %.2f msgs/s  %s/s  %s\n", 
                        $h1_fold, "$h1_msg {$string_len}", $h2_fold, $new_id, $nb_msg_transferred/$time_spent, $rate, $eta );
                        sleep_if_needed( $time_spent, $total_bytes_transferred, $nb_msg_transferred ) ;
                        if ( $usecache and $cacheaftercopy and $new_id =~ m{^\d+$}x ) {
				$debugcache and print "touch $cache_dir/${h1_msg}_$new_id\n" ;
				touch( "$cache_dir/${h1_msg}_$new_id" ) 
                        	or croak( "Couldn't touch $cache_dir/${h1_msg}_$new_id" ) ;
                        }
			if ( $delete ) {
				delete_message_on_host1( $h1_msg, $h1_fold ) ;
			}
			#print "PRESS ENTER" and my $a = <> ;
                        return( $new_id ) ;
		}
	}
	else{
		$nb_msg_skipped_dry_mode += 1;
                $h1_nb_msg_processed +=1 ;
	}

	return(  ) ;
}

sub sleep_if_needed {
	my( $time_spent, $total_bytes_transferred, $nb_msg_transferred ) = @_ ;
        my $sleep_max_messages = sleep_max_messages( $nb_msg_transferred, $time_spent, $maxmessagespersecond ) ;
        my $sleep_max_bytes = sleep_max_bytes( $total_bytes_transferred, $time_spent, $maxbytespersecond  ) ;
        my $sleep_max = max( $sleep_max_messages, $sleep_max_bytes ) ;
        if ( $sleep_max > 0 ) {
        	printf( "sleeping %.2f s\n", $sleep_max ) ;
                sleep( $sleep_max ) ;
        }
}

sub sleep_max_messages {
	# how long we have to sleep to go under max_messages_per_second
        my( $nb_msg_transferred, $time_spent, $maxmessagespersecond ) = @_ ;
        if ( ( not defined( $maxmessagespersecond ) ) or $maxmessagespersecond <= 0 ) { return( 0 ) } ;
        my $sleep = ( $nb_msg_transferred / $maxmessagespersecond ) - $time_spent ;
        # the sleep must be positive
        return( max( 0, $sleep ) ) ;
}


sub tests_sleep_max_messages {
	ok( 0 == sleep_max_messages( 4, 2, undef ),  'sleep_max_messages: maxmessagespersecond = undef') ;
	ok( 0 == sleep_max_messages( 4, 2, 0 ),  'sleep_max_messages: maxmessagespersecond = 0') ;
	ok( 0 == sleep_max_messages( 4, 2, -1 ), 'sleep_max_messages: maxmessagespersecond = -1') ;
	ok( 0 == sleep_max_messages( 4, 2, 2 ),  'sleep_max_messages: maxmessagespersecond = 2 max reached') ;
	ok( 2 == sleep_max_messages( 8, 2, 2 ),  'sleep_max_messages: maxmessagespersecond = 2 max over') ;
	ok( 0 == sleep_max_messages( 2, 2, 2 ),  'sleep_max_messages: maxmessagespersecond = 2 max not reached') ;
	return(  ) ;
}


sub sleep_max_bytes {
	# how long we have to sleep to go under max_bytes_per_second
        my( $total_bytes_transferred, $time_spent, $maxbytespersecond ) = @_ ;
        if ( ( not defined( $maxbytespersecond ) ) or $maxbytespersecond <= 0 ) { return( 0 ) } ;
        my $sleep = ( $total_bytes_transferred / $maxbytespersecond ) - $time_spent ;
        # the sleep must be positive
        return( max( 0, $sleep ) ) ;
}


sub tests_sleep_max_bytes {
	ok( 0 == sleep_max_bytes( 4000, 2, undef ),  'sleep_max_bytes: maxbytespersecond = undef') ;
	ok( 0 == sleep_max_bytes( 4000, 2, 0 ),  'sleep_max_bytes: maxbytespersecond = 0') ;
	ok( 0 == sleep_max_bytes( 4000, 2, -1 ), 'sleep_max_bytes: maxbytespersecond = -1') ;
	ok( 0 == sleep_max_bytes( 4000, 2, 2000 ),  'sleep_max_bytes: maxbytespersecond = 2 max reached') ;
	ok( 2 == sleep_max_bytes( 8000, 2, 2000 ),  'sleep_max_bytes: maxbytespersecond = 2 max over') ;
	ok( 0 == sleep_max_bytes( 2000, 2, 2000 ),  'sleep_max_bytes: maxbytespersecond = 2 max not reached') ;
	return(  ) ;
}




# 6 GlobVar: $dry_message $dry $imap1 $h1_nb_msg_deleted $expunge $expunge1 
sub delete_message_on_host1 {
	my( $h1_msg, $h1_fold ) = @_ ;
	print "msg $h1_fold/$h1_msg deleted on host1 $dry_message\n";
        if ( ! $dry ) {
        	$imap1->delete_message( $h1_msg ) ;
        	$h1_nb_msg_deleted += 1 ;
        	$imap1->expunge() if ( $expunge or $expunge1 ) ;
        }
        return(  ) ;
}


sub eta {
	my( $my_time_spent, $h1_nb_processed, $h1_nb_msg_start, $nb_transferred ) = @_ ;
	return( '' ) if not $foldersizes ;
        	
        my $time_remaining = time_remaining( $my_time_spent, $h1_nb_processed, $h1_nb_msg_start, $nb_transferred ) ;
        my $nb_msg_remaining = $h1_nb_msg_start - $h1_nb_processed ;
        my $eta_date = localtime( time + $time_remaining ) ;
        return( sprintf( "ETA: %s  %1.0f s  %s msgs left", $eta_date, $time_remaining, $nb_msg_remaining ) ) ;
}

sub time_remaining {

	my( $my_time_spent, $h1_nb_processed, $h1_nb_msg_start, $nb_transferred ) = @_ ;

	my $time_remaining = ( $my_time_spent / $nb_transferred ) * ( $h1_nb_msg_start - $h1_nb_processed ) ;
	return( $time_remaining ) ;
}


sub tests_time_remaining {

	ok( 1 == time_remaining( 1, 1, 2, 1 ), "time_remaining: 1, 1, 2, 1 -> 1") ;
	ok( 1 == time_remaining( 9, 9, 10, 9 ), "time_remaining: 9, 9, 10, 9 -> 1") ;
	ok( 9 == time_remaining( 1, 1, 10, 1 ), "time_remaining: 1, 1, 10, 1 -> 1") ;
	return(  ) ;
}


sub cache_map {
	my ( $cache_files_ref, $h1_msgs_ref, $h2_msgs_ref ) = @_;
	my ( %map1_2, %map2_1, %done2 ) ;
	
	my $h1_msgs_hash_ref = {  } ;
	my $h2_msgs_hash_ref = {  } ;
	
	@$h1_msgs_hash_ref{ @$h1_msgs_ref } = (  ) ;
	@$h2_msgs_hash_ref{ @$h2_msgs_ref } = (  ) ;
	
	foreach my $file ( sort @$cache_files_ref ) {
		$debugcache and print "C12: $file\n" ;
		( $uid1, $uid2 ) = match_a_cache_file( $file ) ;
		
		if (  exists( $h1_msgs_hash_ref->{ defined( $uid1 ) ? $uid1 : q{} } ) 
		  and exists( $h2_msgs_hash_ref->{ defined( $uid2 ) ? $uid2 : q{} } ) ) {
		  	# keep only the greatest uid2 
			# 130_2301 and
			# 130_231  => keep only 130 -> 2301
			
			# keep only the greatest uid1
			# 1601_260 and
			#  161_260 => keep only 1601 -> 260
		  	my $max_uid2 = max( $uid2, $map1_2{ $uid1 } || -1 ) ;
			if ( exists( $done2{ $max_uid2 } ) ) {
				if ( $done2{ $max_uid2 } < $uid1 )  {
					$map1_2{ $uid1 } = $max_uid2 ;
					delete( $map1_2{ $done2{ $max_uid2 } } ) ;
					$done2{ $max_uid2 } = $uid1 ;
				}
			}else{
				$map1_2{ $uid1 } = $max_uid2 ;
				$done2{ $max_uid2 } = $uid1 ;
			}
		};
		
	}
	%map2_1 = reverse( %map1_2 ) ;
	return( \%map1_2, \%map2_1) ;
}

sub tests_cache_map {
	#$debugcache = 1 ;
	my @cache_files = qw (
	100_200
	101_201
	120_220
	142_242
	143_243
	177_277
	177_278
	177_279
	155_255
	180_280
	181_280
	182_280
	130_231
	130_2301
	161_260
	1601_260
	) ;
	
	my $msgs_1 = [120, 142, 143, 144, 161, 1601,           177,      182, 130 ];
	my $msgs_2 = [     242, 243,       260,      299, 377, 279, 255, 280, 231, 2301 ];
	
	my( $c12, $c21 ) ;
	ok( ( $c12, $c21 ) = cache_map( \@cache_files, $msgs_1, $msgs_2 ), 'cache_map: 02' );
	my $a1 = [ sort { $a <=> $b } keys %$c12 ] ;
	my $a2 = [ sort { $a <=> $b } keys %$c21 ] ;
	ok( 0 == compare_lists( [ 130, 142, 143,      177, 182, 1601      ], $a1 ), 'cache_map: 03' );
	ok( 0 == compare_lists( [      242, 243, 260, 279, 280,      2301 ], $a2 ), 'cache_map: 04' );
	ok( ! $c12->{161},        'cache_map: ! 161 ->  260' );
	ok( 260  == $c12->{1601}, 'cache_map:  1601 ->  260' );
	ok( 2301 == $c12->{130},  'cache_map:   130 -> 2301' );
	#print $c12->{1601}, "\n";
	return(  ) ;

}

sub cache_dir_fix {
	my $cache_dir = shift ;
        $cache_dir =~ s/([;<>\*\|`&\$!#\(\)\[\]\{\}:'"\\])/\\$1/xg ;
        #print "cache_dir_fix: $cache_dir\n" ;
	return( $cache_dir ) ;
}

sub tests_cache_dir_fix {
	ok( 'lalala' eq  cache_dir_fix('lalala'),  'cache_dir_fix: lalala -> lalala' );
	ok( 'ii\\\\ii' eq  cache_dir_fix('ii\ii'), 'cache_dir_fix: ii\ii -> ii\\\\ii' );
	ok( 'ii@ii' eq  cache_dir_fix('ii@ii'),  'cache_dir_fix: ii@ii -> ii@ii' );
	ok( 'ii@ii\\:ii' eq  cache_dir_fix('ii@ii:ii'), 'cache_dir_fix: ii@ii:ii -> ii@ii\\:ii' );
	ok( 'i\\\\i\\\\ii' eq  cache_dir_fix('i\i\ii'), 'cache_dir_fix: i\i\ii -> i\\\\i\\\\ii' );
	ok( 'i\\\\ii' eq  cache_dir_fix('i\\ii'), 'cache_dir_fix: i\\ii -> i\\\\\\\\ii' );
	ok( '\\\\ ' eq  cache_dir_fix('\\ '), 'cache_dir_fix: \\  -> \\\\\ ' );
	ok( '\\\\ ' eq  cache_dir_fix('\ '), 'cache_dir_fix: \  -> \\\\\ ' );
	return(  ) ;

}

sub get_cache { 
	my ( $cache_dir, $h1_msgs_ref, $h2_msgs_ref, $h1_msgs_all_hash_ref, $h2_msgs_all_hash_ref ) = @_;

	$debugcache and print "Entering get_cache\n";

	-d $cache_dir or return( undef ); # exit if cache directory doesn't exist
	$debugcache and print "cache_dir    : $cache_dir\n";
	
	#$cache_dir =~ s{\\}{\\\\}g;
        $cache_dir = cache_dir_fix( $cache_dir ) if ( 'MSWin32' ne $OSNAME ) ;

	$debugcache and print "cache_dir_fix: $cache_dir\n" ;
        
	my @cache_files = bsd_glob( "$cache_dir/*" ) ;
	#$debugcache and print "cache_files: [@cache_files]\n" ;
        
	$debugcache and print( "cache_files: ", scalar( @cache_files ), " files found\n" ) ;
	
	my( $cache_1_2_ref, $cache_2_1_ref ) 
	  = cache_map( \@cache_files, $h1_msgs_ref, $h2_msgs_ref ) ;
	
	clean_cache( \@cache_files, $cache_1_2_ref, $h1_msgs_all_hash_ref, $h2_msgs_all_hash_ref ) ;
	
	#print "\n", map { "c12 $_ -> $cache_1_2_ref->{ $_ }\n" } keys %$cache_1_2_ref ;
	#print "\n", map { "c21 $_ -> $cache_2_1_ref->{ $_ }\n" } keys %$cache_2_1_ref ;

	$debugcache and print "Exiting get_cache\n";
	return ( $cache_1_2_ref, $cache_2_1_ref ) ;
}


sub tests_get_cache {
	
	ok( not( get_cache('/cache_no_exist') ), 'get_cache: /cache_no_exist' );
	ok( ( not -d 'W/tmp/cache/F1/F2' or rmtree( 'W/tmp/cache/F1/F2' )), 'get_cache: rmtree W/tmp/cache/F1/F2' ) ;
	ok( mkpath( 'W/tmp/cache/F1/F2' ), 'get_cache: mkpath W/tmp/cache/F1/F2' ) ;
	
	my @test_files_cache = ( qw( 
	W/tmp/cache/F1/F2/100_200
	W/tmp/cache/F1/F2/101_201
	W/tmp/cache/F1/F2/120_220
	W/tmp/cache/F1/F2/142_242
	W/tmp/cache/F1/F2/143_243
	W/tmp/cache/F1/F2/177_277
	W/tmp/cache/F1/F2/177_377
	W/tmp/cache/F1/F2/177_777
	W/tmp/cache/F1/F2/155_255
	) ) ;
	ok( touch( @test_files_cache ), 'get_cache: touch W/tmp/cache/F1/F2/...' ) ;
	
	
	# on cache: 100_200 101_201 142_242 143_243 177_277 177_377 177_777 155_255
	# on live:
	my $msgs_1 = [120, 142, 143, 144,          177      ];
	my $msgs_2 = [     242, 243,     299, 377, 777, 255 ];
        
        my $msgs_all_1 = { 120 => '', 142 => '', 143 => '', 144 => '', 177 => '' } ;
        my $msgs_all_2 = { 242 => '', 243 => '', 299 => '', 377 => '', 777 => '', 255 => '' } ;
	
	my( $c12, $c21 ) ;
	ok( ( $c12, $c21 ) = get_cache( 'W/tmp/cache/F1/F2', $msgs_1, $msgs_2, $msgs_all_1, $msgs_all_2 ), 'get_cache: 02' );
	my $a1 = [ sort { $a <=> $b } keys %$c12 ] ;
	my $a2 = [ sort { $a <=> $b } keys %$c21 ] ;
	ok( 0 == compare_lists( [ 142, 143, 177 ], $a1 ), 'get_cache: 03' );
	ok( 0 == compare_lists( [ 242, 243, 777 ], $a2 ), 'get_cache: 04' );
	ok( -f 'W/tmp/cache/F1/F2/142_242', 'get_cache: file kept 142_242');
	ok( -f 'W/tmp/cache/F1/F2/142_242', 'get_cache: file kept 143_243');
	ok( ! -f 'W/tmp/cache/F1/F2/100_200', 'get_cache: file removed 100_200');
	ok( ! -f 'W/tmp/cache/F1/F2/101_201', 'get_cache: file removed 101_201');
	
	# test clean_cache executed
	$maxage = 2 ;
	ok( touch(@test_files_cache), 'get_cache: touch W/tmp/cache/F1/F2/...' ) ;
	ok( ( $c12, $c21 ) = get_cache('W/tmp/cache/F1/F2', $msgs_1, $msgs_2, $msgs_all_1, $msgs_all_2 ), 'get_cache: 02' );
	ok( -f 'W/tmp/cache/F1/F2/142_242', 'get_cache: file kept 142_242');
	ok( -f 'W/tmp/cache/F1/F2/142_242', 'get_cache: file kept 143_243');
	ok( ! -f 'W/tmp/cache/F1/F2/100_200', 'get_cache: file NOT removed 100_200');
	ok( ! -f 'W/tmp/cache/F1/F2/101_201', 'get_cache: file NOT removed 101_201');
	
	
	# strange files
	#$debugcache = 1 ;
	$maxage = undef ;
	ok( ( not -d 'W/tmp/cache/rr\uee' or rmtree( 'W/tmp/cache/rr\uee' )), 'get_cache: rmtree W/tmp/cache/rr\uee' ) ;
	ok( mkpath( 'W/tmp/cache/rr\uee' ), 'get_cache: mkpath W/tmp/cache/rr\uee' ) ;
	
	@test_files_cache = ( qw( 
	W/tmp/cache/rr\uee/100_200
	W/tmp/cache/rr\uee/101_201
	W/tmp/cache/rr\uee/120_220
	W/tmp/cache/rr\uee/142_242
	W/tmp/cache/rr\uee/143_243
	W/tmp/cache/rr\uee/177_277
	W/tmp/cache/rr\uee/177_377
	W/tmp/cache/rr\uee/177_777
	W/tmp/cache/rr\uee/155_255
	) ) ;
	ok( touch(@test_files_cache), 'get_cache: touch strange W/tmp/cache/...' ) ;
	
	# on cache: 100_200 101_201 142_242 143_243 177_277 177_377 177_777 155_255
	# on live:
	$msgs_1 = [120, 142, 143, 144,          177      ] ;
	$msgs_2 = [     242, 243,     299, 377, 777, 255 ] ;
	
        $msgs_all_1 = { 120 => '', 142 => '', 143 => '', 144 => '', 177 => '' } ;
        $msgs_all_2 = { 242 => '', 243 => '', 299 => '', 377 => '', 777 => '', 255 => '' } ;
        
	ok( ( $c12, $c21 ) = get_cache('W/tmp/cache/rr\uee', $msgs_1, $msgs_2, $msgs_all_1, $msgs_all_2), 'get_cache: strange path 02' );
	$a1 = [ sort { $a <=> $b } keys %$c12 ] ;
	$a2 = [ sort { $a <=> $b } keys %$c21 ] ;
	ok( 0 == compare_lists( [ 142, 143, 177 ], $a1 ), 'get_cache: strange path 03' );
	ok( 0 == compare_lists( [ 242, 243, 777 ], $a2 ), 'get_cache: strange path 04' );
	ok( -f 'W/tmp/cache/rr\uee/142_242', 'get_cache: strange path file kept 142_242');
	ok( -f 'W/tmp/cache/rr\uee/142_242', 'get_cache: strange path file kept 143_243');
	ok( ! -f 'W/tmp/cache/rr\uee/100_200', 'get_cache: strange path file removed 100_200');
	ok( ! -f 'W/tmp/cache/rr\uee/101_201', 'get_cache: strange path file removed 101_201');
	return(  ) ;
}

sub match_a_cache_file {
	my $file = shift ;
	my ( $cache_uid1, $cache_uid2 ) ;
	
	return( ( undef, undef ) ) if ( ! $file ) ;
	if ( $file =~ m{(?:^|/)(\d+)_(\d+)$}x ) {
		$cache_uid1 = $1 ;
		$cache_uid2 = $2 ;
	}
	return( $cache_uid1, $cache_uid2 ) ;
}

sub tests_match_a_cache_file {
	my ( $tuid1, $tuid2 ) ;
	ok( ( $tuid1, $tuid2 ) = match_a_cache_file(  ), 'match_a_cache_file: no arg' ) ;
	ok( ! defined( $tuid1 ), 'match_a_cache_file: no arg 1' ) ;
	ok( ! defined( $tuid2 ), 'match_a_cache_file: no arg 2' ) ;
	
	ok( ( $tuid1, $tuid2 ) = match_a_cache_file( '' ), 'match_a_cache_file: empty arg' ) ;
	ok( ! defined( $tuid1 ), 'match_a_cache_file: empty arg 1' ) ;
	ok( ! defined( $tuid2 ), 'match_a_cache_file: empty arg 2' ) ;
	
	ok( ( $tuid1, $tuid2 ) = match_a_cache_file( '000_000' ), 'match_a_cache_file: 000_000' ) ;
	ok( '000' eq $tuid1, 'match_a_cache_file: 000_000 1' ) ;
	ok( '000' eq $tuid2, 'match_a_cache_file: 000_000 2' ) ;
	
	ok( ( $tuid1, $tuid2 ) = match_a_cache_file( '123_456' ), 'match_a_cache_file: 123_456' ) ;
	ok( '123' eq $tuid1, 'match_a_cache_file: 123_456 1' ) ;
	ok( '456' eq $tuid2, 'match_a_cache_file: 123_456 2' ) ;

	ok( ( $tuid1, $tuid2 ) = match_a_cache_file( '/tmp/truc/123_456' ), 'match_a_cache_file: /tmp/truc/123_456' ) ;
	ok( '123' eq $tuid1, 'match_a_cache_file: /tmp/truc/123_456 1' ) ;
	ok( '456' eq $tuid2, 'match_a_cache_file: /tmp/truc/123_456 2' ) ;

	ok( ( $tuid1, $tuid2 ) = match_a_cache_file( '/lala123_456' ), 'match_a_cache_file: NO /lala123_456' ) ;
	ok( ! $tuid1, 'match_a_cache_file: /lala123_456 1' ) ;
	ok( ! $tuid2, 'match_a_cache_file: /lala123_456 2' ) ;

	ok( ( $tuid1, $tuid2 ) = match_a_cache_file( 'la123_456' ), 'match_a_cache_file: NO la123_456' ) ;
	ok( ! $tuid1, 'match_a_cache_file: la123_456 1' ) ;
	ok( ! $tuid2, 'match_a_cache_file: la123_456 2' ) ;

	return(  ) ;
}

sub clean_cache {
	my ( $cache_files_ref, $cache_1_2_ref, $h1_msgs_all_hash_ref, $h2_msgs_all_hash_ref )  = @_ ;
	
	$debugcache and print "Entering clean_cache\n";
	
	$debugcache and print map { "$_ -> " . $cache_1_2_ref->{ $_ } . "\n" } keys %$cache_1_2_ref ;
	foreach my $file ( @$cache_files_ref ) {
		$debugcache and print "$file\n" ;
		my ( $cache_uid1, $cache_uid2 ) = match_a_cache_file( $file ) ;
		$debugcache and print( "u1: $cache_uid1 u2: $cache_uid2 c12: ", $cache_1_2_ref->{ $cache_uid1 } || '', "\n") ;
#		  or ( ! exists( $cache_1_2_ref->{ $cache_uid1 } ) )
#		  or ( ! ( $cache_uid2 == $cache_1_2_ref->{ $cache_uid1 } ) )
		if ( ( not defined( $cache_uid1 ) )
		  or ( not defined( $cache_uid2 ) )
                  or ( not exists( $h1_msgs_all_hash_ref->{ $cache_uid1 } ) )
                  or ( not exists( $h2_msgs_all_hash_ref->{ $cache_uid2 } ) )
                ) {
			$debugcache and print "remove $file\n" ;
			unlink( $file ) or print "$!" ;
		}
	}
	
	$debugcache and print "Exiting clean_cache\n";
	return( 1 ) ;
}

sub tests_clean_cache {

	ok( ( not -d  'W/tmp/cache/G1/G2' or rmtree( 'W/tmp/cache/G1/G2' )), 'clean_cache: rmtree W/tmp/cache/G1/G2' ) ;
	ok( mkpath( 'W/tmp/cache/G1/G2' ), 'clean_cache: mkpath W/tmp/cache/G1/G2' ) ;
	
	my @test_files_cache = ( qw( 
	W/tmp/cache/G1/G2/100_200
	W/tmp/cache/G1/G2/101_201
	W/tmp/cache/G1/G2/120_220
	W/tmp/cache/G1/G2/142_242
	W/tmp/cache/G1/G2/143_243
	W/tmp/cache/G1/G2/177_277
	W/tmp/cache/G1/G2/177_377
	W/tmp/cache/G1/G2/177_777
	W/tmp/cache/G1/G2/155_255
	) ) ;
	ok( touch(@test_files_cache), 'clean_cache: touch W/tmp/cache/G1/G2/...' ) ;
	
	ok( -f 'W/tmp/cache/G1/G2/100_200', 'clean_cache: 100_200 before' );
	ok( -f 'W/tmp/cache/G1/G2/142_242', 'clean_cache: 142_242 before' );
	ok( -f 'W/tmp/cache/G1/G2/177_277', 'clean_cache: 177_277 before' );
	ok( -f 'W/tmp/cache/G1/G2/177_377', 'clean_cache: 177_377 before' );
	ok( -f 'W/tmp/cache/G1/G2/177_777', 'clean_cache: 177_777 before' );
	ok( -f 'W/tmp/cache/G1/G2/155_255', 'clean_cache: 155_255 before' );
	
	my $cache = {
		142 => 242,
		177 => 777,
	} ;
        
        my $all_1 = {
                142 => '',
                177 => '',
        } ;
        
        my $all_2 = {
                200 => '',
                242 => '',
                777 => '',
        } ;
	ok( clean_cache( \@test_files_cache, $cache, $all_1, $all_2 ), 'clean_cache: ' ) ;
	
	ok( ! -f 'W/tmp/cache/G1/G2/100_200', 'clean_cache: 100_200 after' );
	ok(   -f 'W/tmp/cache/G1/G2/142_242', 'clean_cache: 142_242 after' );
	ok( ! -f 'W/tmp/cache/G1/G2/177_277', 'clean_cache: 177_277 after' );
	ok( ! -f 'W/tmp/cache/G1/G2/177_377', 'clean_cache: 177_377 after' );
	ok(   -f 'W/tmp/cache/G1/G2/177_777', 'clean_cache: 177_777 after' );
	ok( ! -f 'W/tmp/cache/G1/G2/155_255', 'clean_cache: 155_255 after' );
	return(  ) ;
}

sub tests_clean_cache_2 {

	ok( ( not -d  'W/tmp/cache/G1/G2' or rmtree( 'W/tmp/cache/G1/G2' )), 'clean_cache_2: rmtree W/tmp/cache/G1/G2' ) ;
	ok( mkpath( 'W/tmp/cache/G1/G2' ), 'clean_cache_2: mkpath W/tmp/cache/G1/G2' ) ;
	
	my @test_files_cache = ( qw( 
	W/tmp/cache/G1/G2/100_200
	W/tmp/cache/G1/G2/101_201
	W/tmp/cache/G1/G2/120_220
	W/tmp/cache/G1/G2/142_242
	W/tmp/cache/G1/G2/143_243
	W/tmp/cache/G1/G2/177_277
	W/tmp/cache/G1/G2/177_377
	W/tmp/cache/G1/G2/177_777
	W/tmp/cache/G1/G2/155_255
	) ) ;
	ok( touch(@test_files_cache), 'clean_cache_2: touch W/tmp/cache/G1/G2/...' ) ;
	
	ok( -f 'W/tmp/cache/G1/G2/100_200', 'clean_cache_2: 100_200 before' );
	ok( -f 'W/tmp/cache/G1/G2/142_242', 'clean_cache_2: 142_242 before' );
	ok( -f 'W/tmp/cache/G1/G2/177_277', 'clean_cache_2: 177_277 before' );
	ok( -f 'W/tmp/cache/G1/G2/177_377', 'clean_cache_2: 177_377 before' );
	ok( -f 'W/tmp/cache/G1/G2/177_777', 'clean_cache_2: 177_777 before' );
	ok( -f 'W/tmp/cache/G1/G2/155_255', 'clean_cache_2: 155_255 before' );
	
	my $cache = {
		142 => 242,
		177 => 777,
	} ;
        
        my $all_1 = {
                100 => '',
                142 => '',
                177 => '',
        } ;
        
        my $all_2 = {
                200 => '',
                242 => '',
                777 => '',
        } ;
        
        
        
	ok( clean_cache( \@test_files_cache, $cache, $all_1, $all_2 ), 'clean_cache_2: ' ) ;
	
	ok(   -f 'W/tmp/cache/G1/G2/100_200', 'clean_cache_2: 100_200 after' );
	ok(   -f 'W/tmp/cache/G1/G2/142_242', 'clean_cache_2: 142_242 after' );
	ok( ! -f 'W/tmp/cache/G1/G2/177_277', 'clean_cache_2: 177_277 after' );
	ok( ! -f 'W/tmp/cache/G1/G2/177_377', 'clean_cache_2: 177_377 after' );
	ok(   -f 'W/tmp/cache/G1/G2/177_777', 'clean_cache_2: 177_777 after' );
	ok( ! -f 'W/tmp/cache/G1/G2/155_255', 'clean_cache_2: 155_255 after' );
	return(  ) ;
}



sub tests_mkpath {

        my $long_path_unix = "123456789/" x 30 ;


	# \\?\C:\TEMP
        my $long_path_2_prefix =  $tmpdir || '\\\?\\E:\\TEMP\\'  ; 
	print "long_path_2_prefix: $long_path_2_prefix\n" ;
	
        my $long_path_2 = $long_path_2_prefix . "\\" . "123456789\\" x 30 . 'END'; 

	( 'MSWin32' ne $OSNAME ) and ok( (-d "W/tmp/tests/long/$long_path_unix" or  mkpath( "W/tmp/tests/long/$long_path_unix" )), 'tests_mkpath: mkpath > 300 char' ) ;
	( 'MSWin32' ne $OSNAME ) and ok( (-d "W/tmp/tests/long/$long_path_unix" and rmtree( "W/tmp/tests/long/" )),           'tests_mkpath: rmtree > 300 char' ) ;
        ok( 1 == 1, 'tests_mkpath: 1 == 1' ) ;

        ( 'MSWin32' eq $OSNAME ) and print "$long_path_2\n" ;
	( 'MSWin32' eq $OSNAME ) and ok( ( -d $long_path_2_prefix ), 'tests_mkpath: -d \ small path' ) ;
	( 'MSWin32' eq $OSNAME ) and ok( ( -d $long_path_2_prefix and rmtree( $long_path_2_prefix ) ), 'tests_mkpath: rmtree \ > 300 char' ) ;

	( 'MSWin32' eq $OSNAME ) and ok( ( -d $long_path_2_prefix or mkpath( "\\\\\?\\E:\\\\TEMP" ) ), 'tests_mkpath: -d \ small path 1' ) ;
	( 'MSWin32' eq $OSNAME ) and ok( ( -d $long_path_2 ), 'tests_mkpath: -d \ > 300 char' ) ;
	( 'MSWin32' eq $OSNAME ) and ok( ( -d $long_path_2_prefix or mkpath( $long_path_2_prefix ) ), 'tests_mkpath: -d \ small path' ) ;
	( 'MSWin32' eq $OSNAME ) and ok( ( -d $long_path_2 or  mkpath( $long_path_2 ) ), 'tests_mkpath: mkpath \ > 300 char' ) ;
	( 'MSWin32' eq $OSNAME ) and ok( ( -d $long_path_2_prefix and rmtree( $long_path_2_prefix ) ), 'tests_mkpath: rmtree \ > 300 char' ) ;
	return(  ) ;
}

sub tests_touch {

	ok( (-d 'W/tmp/tests/' or  mkpath( 'W/tmp/tests/' )), 'tests_touch: mkpath W/tmp/tests/' ) ;
	ok( 1 == touch( 'W/tmp/tests/lala'), 'tests_touch: W/tmp/tests/lala') ;
	ok( 1 == touch( 'W/tmp/tests/\y'), 'tests_touch: W/tmp/tests/\y') ;
	ok( 0 == touch( '/aaa'), 'tests_touch: not /aaa') ;
	ok( 1 == touch( 'W/tmp/tests/lili', 'W/tmp/tests/lolo'), 'tests_touch: 2 files') ;
	ok( 0 == touch( 'W/tmp/tests/\y', '/aaa'), 'tests_touch: 2 files, 1 fails' ) ;
	return(  ) ;
}


sub touch {
	my @files = @_ ;
	my $failures = 0 ;
	
	foreach my $file ( @files ) {
		my  $fh = IO::File->new ;
		if ( $fh->open(">> $file" ) ) {
			$fh->close ;
		}else{
                	print "Could not open file $file in write/append mode\n" ;
                	$failures++ ;
                }
	}
	return( ! $failures );
}


sub tests_tmpdir_has_colon_bug {

	ok( 0 == tmpdir_has_colon_bug( '' ),        'tmpdir_has_colon_bug: ' ) ;
	ok( 0 == tmpdir_has_colon_bug( '/tmp' ),    'tmpdir_has_colon_bug: /tmp' ) ;
	ok( 1 == tmpdir_has_colon_bug( 'C:' ),      'tmpdir_has_colon_bug: C:' ) ;
	ok( 1 == tmpdir_has_colon_bug( 'C:\temp' ), 'tmpdir_has_colon_bug: C:\temp' ) ;
        
        return( 0 ) ;
}

sub tmpdir_has_colon_bug {
	my $path = shift ;

	my $path_filtered = filter_forbidden_characters( $path ) ;
	if ( $path_filtered ne $path ) {
        	( -d $path_filtered ) and print "Path $path was previously mistakely changed to $path_filtered\n" ;
        	return( 1 ) ;
        }
        return( 0 ) ;
}

sub tmpdir_fix_colon_bug {

	my $err = 0 ;
	if ( not (-d $tmpdir and -r _ and -w _) ) {
        	print "tmpdir $tmpdir is not valid\n" ;
		return( 0 ) ;
        }
	my $cachedir_new = "$tmpdir/imapsync_cache" ;

	if ( not tmpdir_has_colon_bug( $cachedir_new ) ) { return( 0 ) } ;

	# check if old cache directory already exists
        my $cachedir_old = filter_forbidden_characters( $cachedir_new ) ;
        if ( not ( -d $cachedir_old ) ) {
        	print "Old cache directory $cachedir_new no exists, nothing to do\n" ;
                return( 1 ) ;
        }	
        
        # check if new cache directory already exists
        if ( -d $cachedir_new ) {
        	print "New fixed cache directory $cachedir_new already exists, not moving the old one $cachedir_old. Fix this manually.\n" ;
                return( 0 ) ;
        }else{
        	# move the old one to the new place
        
        	print "Moving $cachedir_old to $cachedir_new Do not interrupt this task.\n" ;
                File::Copy::Recursive::rmove( $cachedir_old, $cachedir_new ) 
                or do { 
                	print "Could not move $cachedir_old to $cachedir_new\n" ;
                        $err++ ;
                } ;
        	# check it succeeded
        	if ( -d $cachedir_new and -r _ and -w _ ) {
        		print "New fixed cache directory $cachedir_new ok\n" ;
		}else{
        		print "New fixed cache directory $cachedir_new does not exist\n" ;
                        $err++ ;
        	}
        	if ( -d $cachedir_old ) {
        		print "Old cache directory $cachedir_old still exists\n" ;
                        $err++ ;
		}else{
        		print "Old cache directory $cachedir_old successfuly moved\n" ;
        	}
        }
        return( not $err ) ;
}


sub tests_cache_folder {

	ok( '/path/fold1/fold2' eq cache_folder( '', '/path', 'fold1', 'fold2'), 'cache_folder: /path, fold1, fold2 -> /path/fold1/fold2' ) ;
	ok( '/pa_th/fold1/fold2' eq cache_folder( '', '/pa*th', 'fold1', 'fold2'), 'cache_folder: /pa*th, fold1, fold2 -> /path/fold1/fold2' ) ;
	ok( '/_p_a__th/fol_d1/fold2' eq cache_folder( '', '/>p<a|*th', 'fol*d1', 'fold2'), 'cache_folder: />p<a|*th, fol*d1, fold2 -> /path/fol_d1/fold2' ) ;

	ok( 'D:/path/fold1/fold2' eq cache_folder( 'D:', '/path', 'fold1', 'fold2'), 'cache_folder: /path, fold1, fold2 -> /path/fold1/fold2' ) ;
	ok( 'D:/pa_th/fold1/fold2' eq cache_folder( 'D:', '/pa*th', 'fold1', 'fold2'), 'cache_folder: /pa*th, fold1, fold2 -> /path/fold1/fold2' ) ;
	ok( 'D:/_p_a__th/fol_d1/fold2' eq cache_folder( 'D:', '/>p<a|*th', 'fol*d1', 'fold2'), 'cache_folder: />p<a|*th, fol*d1, fold2 -> /path/fol_d1/fold2' ) ;
	return(  ) ;
}

sub cache_folder {
	my( $cache_base, $cache_dir, $h1_fold, $h2_fold ) = @_ ;
	
	my $sep_1 = $h1_sep || '/';
	my $sep_2 = $h2_sep || '/';
	
	#print "$cache_dir h1_fold $h1_fold sep1 $sep_1 h2_fold $h2_fold sep2 $sep_2\n";
	$h1_fold = convert_sep_to_slash( $h1_fold, $sep_1 ) ;
	$h2_fold = convert_sep_to_slash( $h2_fold, $sep_2 ) ;
                
        my $cache_folder = "$cache_base" . filter_forbidden_characters( "$cache_dir/$h1_fold/$h2_fold" ) ;
	#print "cache_folder [$cache_folder]\n" ;
        return( $cache_folder ) ;
}

sub filter_forbidden_characters  {
	my $string = shift ;
        
        if ( 'MSWin32' eq $OSNAME ) {
        	# Move trailing whitespace to _ " a b /c d " -> " a b_/c d_"
        	$string =~ s{\ (/|$)}{_$1}xg ;
        }
        $string =~ s{[\Q*|?:"<>\E]}{_}xg ;
        #print "[$string]\n" ;
	return ( $string ) ;
}

sub tests_filter_forbidden_characters  {

	ok( 'a_b' eq filter_forbidden_characters( 'a_b' ), 'filter_forbidden_characters: a_b -> a_b' ) ;
	ok( 'a_b' eq filter_forbidden_characters( 'a*b' ), 'filter_forbidden_characters: a*b -> a_b' ) ;
	ok( 'a_b' eq filter_forbidden_characters( 'a|b' ), 'filter_forbidden_characters: a|b -> a_b' ) ;
	ok( 'a_b' eq filter_forbidden_characters( 'a?b' ), 'filter_forbidden_characters: a?b -> a_b' ) ;
	ok( 'a_______b' eq filter_forbidden_characters( 'a*|?:"<>b' ), 'filter_forbidden_characters: a*|?:"<>b -> a_______b' ) ;

	( 'MSWin32' ne $OSNAME ) and ok( ( 'a b ' eq filter_forbidden_characters( 'a b ' ) ), 'filter_forbidden_characters: "a b " -> "a b "' ) ;

	( 'MSWin32' eq $OSNAME ) and ok( ( ' a b_' eq filter_forbidden_characters( ' a b ' ) ), 'filter_forbidden_characters: "a b " -> "a b_"' ) ;
	( 'MSWin32' eq $OSNAME ) and ok( ( ' a b_/ c d_' eq filter_forbidden_characters( ' a b / c d ' ) ), 'filter_forbidden_characters: " a b / c d " -> "a b_/ c d_"' ) ;
        
	return(  ) ;
}

sub convert_sep_to_slash {
	my ( $folder, $sep ) = @_ ;
	
	$folder =~ s{\Q$sep\E}{/}xg ;
	return( $folder ) ;
}

sub tests_convert_sep_to_slash {

	ok('' eq convert_sep_to_slash('', '/'), 'convert_sep_to_slash: no folder');
	ok('INBOX' eq convert_sep_to_slash('INBOX', '/'), 'convert_sep_to_slash: INBOX');
	ok('INBOX/foo' eq convert_sep_to_slash('INBOX/foo', '/'), 'convert_sep_to_slash: INBOX/foo');
	ok('INBOX/foo' eq convert_sep_to_slash('INBOX_foo', '_'), 'convert_sep_to_slash: INBOX_foo');
	ok('INBOX/foo/zob' eq convert_sep_to_slash('INBOX_foo_zob', '_'), 'convert_sep_to_slash: INBOX_foo_zob');
	ok('INBOX/foo' eq convert_sep_to_slash('INBOX.foo', '.'), 'convert_sep_to_slash: INBOX.foo');
	ok('INBOX/foo/hi' eq convert_sep_to_slash('INBOX.foo.hi', '.'), 'convert_sep_to_slash: INBOX.foo.hi');
	return(  ) ;
}


sub tests_regexmess {
	
	ok("blabla" eq regexmess("blabla"), "regexmess, no regexmess, nothing to do");

	@regexmess = ('lalala') ;
	ok( not( defined( regexmess("popopo") ) ), "regexmess, bad regex lalala") ;
	
	@regexmess = ('s/p/Z/g');
	ok("ZoZoZo" eq regexmess("popopo"), "regexmess, s/p/Z/g");
	
	@regexmess = 's{c}{C}gxms';
	ok("H1: abC\nH2: Cde\n\nBody abC" 
		   eq regexmess("H1: abc\nH2: cde\n\nBody abc"), 
	   "regexmess, c->C");
	   
	@regexmess = 's{\AFrom\ }{From:}gxms';
	ok(          '' 
	eq regexmess(''),
	'From mbox 1 add colon blank');
	
	ok(          'From:<tartanpion@machin.truc>' 
	eq regexmess('From <tartanpion@machin.truc>'),
	'From mbox 2 add colo');
	
	ok(          "\n" . 'From <tartanpion@machin.truc>' 
	eq regexmess("\n" . 'From <tartanpion@machin.truc>'),
	'From mbox 3 add colo');
	
	ok(          "From: zzz\n" . 'From <tartanpion@machin.truc>' 
	eq regexmess("From  zzz\n" . 'From <tartanpion@machin.truc>'),
	'From mbox 4 add colo');
	
	@regexmess = 's{\AFrom\ [^\n]*(\n)?}{}gxms';
	ok(          '' 
	eq regexmess(''),
	'From mbox 1 remove, blank');
	
	ok(          '' 
	eq regexmess('From <tartanpion@machin.truc>'),
	'From mbox 2 remove');
	
	ok(          "\n" . 'From <tartanpion@machin.truc>' 
	eq regexmess("\n" . 'From <tartanpion@machin.truc>'),
	'From mbox 3 remove');
	
	#print "[", regexmess("From  zzz\n" . 'From <tartanpion@machin.truc>'), "]";
	ok(          ""            . 'From <tartanpion@machin.truc>' 
	eq regexmess("From  zzz\n" . 'From <tartanpion@machin.truc>'),
	'From mbox 4 remove');
	

	ok(
<<'EOM'
Date: Sat, 10 Jul 2010 05:34:45 -0700
From:<tartanpion@machin.truc>

Hello,
Bye.
EOM
	eq regexmess(
<<'EOM'
From  zzz
Date: Sat, 10 Jul 2010 05:34:45 -0700
From:<tartanpion@machin.truc>

Hello,
Bye.
EOM
), 'From mbox 5 remove');


@regexmess = 's{\A(.*?(?! ^$))(^Disposition-Notification-To:.*?\n)}{$1}gxms';

	ok(
<<'EOM'
Date: Sat, 10 Jul 2010 05:34:45 -0700
From:<tartanpion@machin.truc>

Hello,
Bye.
EOM
	eq regexmess(
<<'EOM'
Date: Sat, 10 Jul 2010 05:34:45 -0700
Disposition-Notification-To: Gilles LAMIRAL <gilles.lamiral@laposte.net>
From:<tartanpion@machin.truc>

Hello,
Bye.
EOM
	),
	'regexmess: 1 Delete header Disposition-Notification-To:');

	ok(
<<'EOM'
Date: Sat, 10 Jul 2010 05:34:45 -0700
From:<tartanpion@machin.truc>

Hello,
Bye.
EOM
	eq regexmess(
<<'EOM'
Date: Sat, 10 Jul 2010 05:34:45 -0700
From:<tartanpion@machin.truc>
Disposition-Notification-To: Gilles LAMIRAL <gilles.lamiral@laposte.net>

Hello,
Bye.
EOM
),
	'regexmess: 2 Delete header Disposition-Notification-To:');

	ok(
<<'EOM'
Date: Sat, 10 Jul 2010 05:34:45 -0700
From:<tartanpion@machin.truc>

Hello,
Bye.
EOM
	eq regexmess(
<<'EOM'
Disposition-Notification-To: Gilles LAMIRAL <gilles.lamiral@laposte.net>
Date: Sat, 10 Jul 2010 05:34:45 -0700
From:<tartanpion@machin.truc>

Hello,
Bye.
EOM
),
	'regexmess: 3 Delete header Disposition-Notification-To:');

	ok(
<<'EOM'
Date: Sat, 10 Jul 2010 05:34:45 -0700
From:<tartanpion@machin.truc>

Disposition-Notification-To: Gilles LAMIRAL <gilles.lamiral@laposte.net>
Bye.
EOM
	eq regexmess(
<<'EOM'
Disposition-Notification-To: Gilles LAMIRAL <gilles.lamiral@laposte.net>
Date: Sat, 10 Jul 2010 05:34:45 -0700
From:<tartanpion@machin.truc>

Disposition-Notification-To: Gilles LAMIRAL <gilles.lamiral@laposte.net>
Bye.
EOM
),
	'regexmess: 4 Delete header Disposition-Notification-To:');



return(  ) ;

}

sub regexmess {
	my ($string) = @_ ;
	foreach my $regexmess ( @regexmess ) {
		$debug and print "eval \$string =~ $regexmess\n" ;
		my $ret = eval( "\$string =~ $regexmess ; 1" ) ;
                #print "eval [$ret]\n" ;
                if ( ( not $ret ) or $@ ) {
			print "Error: eval regexmess '$regexmess': $@" ;
                        return( undef ) ;
                }
	}
	return( $string ) ;
}


sub tests_bytes_display_string {

	ok(    '0.000 KiB' eq bytes_display_string(       0 ), 'bytes_display_string:       0' ) ;
	ok(    '0.001 KiB' eq bytes_display_string(       1 ), 'bytes_display_string:       1' ) ;
	ok(    '0.010 KiB' eq bytes_display_string(      10 ), 'bytes_display_string:      10' ) ;
	ok(    '1.000 MiB' eq bytes_display_string( 1048575 ), 'bytes_display_string: 1048575' ) ;
	ok(    '1.000 MiB' eq bytes_display_string( 1048576 ), 'bytes_display_string: 1048576' ) ;

	ok(    '1.000 GiB' eq bytes_display_string( 1073741823 ), 'bytes_display_string: 1073741823 ' ) ;
	ok(    '1.000 GiB' eq bytes_display_string( 1073741824 ), 'bytes_display_string: 1073741824 ' ) ;

	ok(    '1.000 TiB' eq bytes_display_string( 1099511627775 ), 'bytes_display_string: 1099511627775' ) ;
	ok(    '1.000 TiB' eq bytes_display_string( 1099511627776 ), 'bytes_display_string: 1099511627776' ) ;

	ok(    '1.000 PiB' eq bytes_display_string( 1125899906842623 ), 'bytes_display_string: 1125899906842623' ) ;
	ok(    '1.000 PiB' eq bytes_display_string( 1125899906842624 ), 'bytes_display_string: 1125899906842624' ) ;

	ok( '1024.000 PiB' eq bytes_display_string( 1152921504606846975 ), 'bytes_display_string: 1152921504606846975' ) ;
	ok( '1024.000 PiB' eq bytes_display_string( 1152921504606846976 ), 'bytes_display_string: 1152921504606846976' ) ;

	ok( '1048576.000 PiB' eq bytes_display_string( 1180591620717411303424 ), 'bytes_display_string: 1180591620717411303424' ) ;
        
        #print  bytes_display_string( 1180591620717411303424 ), "\n" ;
	return(  ) ;
}

sub bytes_display_string { 
	my ( $bytes ) = @_ ;

	my $readable_value = '' ;
       
	SWITCH: {
        	if ( abs( $bytes ) < ( 1000 * 1024 ) ) {
        		$readable_value = sprintf( "%.3f KiB", $bytes / 1024) ; 
                	last SWITCH ;
        	}
        	if ( abs( $bytes ) < ( 1000 * 1024 * 1024 ) ) {
        		$readable_value = sprintf( "%.3f MiB", $bytes / (1024 * 1024) ) ;
        	        last SWITCH ;
        	}
        	if ( abs( $bytes ) < ( 1000 * 1024 * 1024 * 1024) ) {
			$readable_value = sprintf("%.3f GiB", $bytes / (1024 * 1024 * 1024) ) ;
        	        last SWITCH ;
        	}
        	if ( abs( $bytes ) < ( 1000 * 1024 * 1024 * 1024 * 1024) ) {
			$readable_value = sprintf( "%.3f TiB", $bytes / (1024 * 1024 * 1024 * 1024) ) ;
        	        last SWITCH ;
        	} else {
			$readable_value = sprintf( "%.3f PiB", $bytes / (1024 * 1024 * 1024 * 1024 * 1024) ) ;
        	}
		# if you have exabytes (EiB) of email to transfer, you have too much email
	}
        #print "$bytes = $readable_value\n" ;
        return( $readable_value ) ;
}

sub stats {
	$timeend = time(  );
	my $timediff = $timeend - $timestart ;

	my $timeend_str   = localtime( $timeend ) ;
        
	my $memory_consumption = 0 ;
        $memory_consumption = memory_consumption(  ) || 0 ;
	my $memory_ratio = ($max_msg_size_in_bytes) ?  
		sprintf('%.1f', $memory_consumption / $max_msg_size_in_bytes) : "NA" ;

	my $host1_reconnect_count = $imap1->Reconnect_counter() || 0 ;
	my $host2_reconnect_count = $imap2->Reconnect_counter() || 0 ;

	print   "++++ Statistics\n" ;
	print   "Transfer started on               : $timestart_str\n";
	print   "Transfer ended on                 : $timeend_str\n";
	printf( "Transfer time                     : %.1f sec\n", $timediff ) ;
	print   "Messages transferred              : $nb_msg_transferred ";
	print   "(could be $nb_msg_skipped_dry_mode without dry mode)" if ($dry);
	print   "\n";
	print   "Messages skipped                  : $nb_msg_skipped\n";
	print   "Messages found duplicate on host1 : $h1_nb_msg_duplicate\n";
	print   "Messages found duplicate on host2 : $h2_nb_msg_duplicate\n";
	print   "Messages void (noheader) on host1 : $h1_nb_msg_noheader\n";
	print   "Messages void (noheader) on host2 : $h2_nb_msg_noheader\n";
	print   "Messages deleted on host1         : $h1_nb_msg_deleted\n";
	print   "Messages deleted on host2         : $h2_nb_msg_deleted\n";
        printf( "Total bytes transferred           : %d (%s)\n",
                $total_bytes_transferred,
                bytes_display_string($total_bytes_transferred));
        printf( "Total bytes duplicate host1       : %d (%s)\n",
                $h1_total_bytes_duplicate,
                bytes_display_string($h1_total_bytes_duplicate));
        printf( "Total bytes duplicate host2       : %d (%s)\n",
                $h2_total_bytes_duplicate,
                bytes_display_string($h2_total_bytes_duplicate));
        printf( "Total bytes skipped               : %d (%s)\n",
                $total_bytes_skipped,
                bytes_display_string($total_bytes_skipped));
        printf( "Total bytes error                 : %d (%s)\n",
                $total_bytes_error,
                bytes_display_string($total_bytes_error));
	$timediff ||= 1; # No division per 0
	printf ("Message rate                      : %.1f messages/s\n", $nb_msg_transferred / $timediff);
	printf ("Average bandwidth rate            : %.1f KiB/s\n", $total_bytes_transferred / 1024 / $timediff);
	print   "Reconnections to host1            : $host1_reconnect_count\n";
	print   "Reconnections to host2            : $host2_reconnect_count\n";
	printf ("Memory consumption                : %.1f MiB\n", $memory_consumption / 1024 / 1024);
	print   "Biggest message                   : $max_msg_size_in_bytes bytes\n";
#	print   "Memory/biggest message ratio      : $memory_ratio\n";
        if ( $foldersizesatend and $foldersizes ) {
	printf("Initial difference host2 - host1  : %s messages, %s bytes (%s)\n", $h2_nb_msg_start - $h1_nb_msg_at_start,
                                                        $h2_bytes_start  - $h1_bytes_start,
                                                        bytes_display_string( $h2_bytes_start  - $h1_bytes_start ) ) ;
	printf("Final   difference host2 - host1  : %s messages, %s bytes (%s)\n", $h2_nb_msg_end   - $h1_nb_msg_end,
                                                        $h2_bytes_end    - $h1_bytes_end,
                                                        bytes_display_string( $h2_bytes_end    - $h1_bytes_end ) ) ;
        }
	print   "Detected $nb_errors errors\n\n" ;

	print   $warn_release, "\n" ;
	print   thank_author();
	return(  ) ;
}

sub thank_author {
	return("Homepage: http://imapsync.lamiral.info/\n");
}


sub load_modules {

	if ( $ssl1 or $ssl2 or $tls1 or $tls2 ) {
        	require IO::Socket::SSL ;
                #$IO::Socket::SSL::DEBUG = 4 ;
        }

        require Term::ReadKey if (
	       ((not($password1 or $passfile1)) 
	    or (not($password2 or $passfile2)))
	and (not $help));

	#require Data::Dumper if ($debug);
	return(  ) ;
}



sub parse_header_msg {
	my ($imap, $m_uid, $s_heads, $s_fir, $side, $s_hash) = @_;
	
	my $head = $s_heads->{$m_uid};
	my $headnum =  scalar(keys(%$head));
	$debug and print "$side uid $m_uid head nb pass one: ", $headnum, "\n";
	
	if ( ( ! $headnum ) and ( $wholeheaderifneeded ) ){
		print "$side uid $m_uid no header by parse_headers so taking whole header with BODY.PEEK[HEADER]\n" ;
		$imap->fetch($m_uid, "BODY.PEEK[HEADER]");
		my $whole_header = $imap->_transaction_literals;
		
                #print $whole_header;
                $head = decompose_header( $whole_header ) ;
                
                $headnum =  scalar( keys( %$head ) ) ;
	        $debug and print "$side uid $m_uid head nb pass two: ", $headnum, "\n";
	}

        #require Data::Dumper ;
        #print Data::Dumper->Dump( [ $head, \%useheader ] ) ;

	my $headstr ;
        
        $headstr = header_construct( $head, $side, $m_uid ) ;
		
	if ( ( ! $headstr) and ( $addheader ) and ( $side eq "Host1" )){
        	my $header = add_header( $m_uid ) ;
		print "Host1 uid $m_uid no header found so adding our own [$header]\n";
		$headstr .= uc( $header ) ;
		$s_fir->{$m_uid}->{"NO_HEADER"} = 1;
	}

	return(  ) if ( ! $headstr ) ;
	
	my $size  = $s_fir->{$m_uid}->{"RFC822.SIZE"};
	my $flags = $s_fir->{$m_uid}->{"FLAGS"};
	my $idate = $s_fir->{$m_uid}->{"INTERNALDATE"};
	$size = length( $headstr ) unless ( $size ) ;
	my $m_md5 = md5_base64( $headstr ) ;
	$debug and print "$side uid $m_uid sig $m_md5 size $size idate $idate\n";
	my $key;
        if ($skipsize) {
                $key = "$m_md5";
        }
	else {
                $key = "$m_md5:$size";
        }
	# 0 return code is used to identify duplicate message hash
	return 0 if exists $s_hash->{"$key"};
	$s_hash->{"$key"}{'5'} = $m_md5;
	$s_hash->{"$key"}{'s'} = $size;
	$s_hash->{"$key"}{'D'} = $idate;
	$s_hash->{"$key"}{'F'} = $flags;
	$s_hash->{"$key"}{'m'} = $m_uid;

	return( 1 ) ;
}

sub header_construct {

	my( $head, $side, $m_uid ) = @_ ;
        
        my $headstr ;
	foreach my $h ( sort keys( %$head ) ) {
                next if ( not exists( $useheader{ uc( $h ) } )
                      and not exists( $useheader{ 'ALL' } )
                ) ;
		foreach my $val ( sort @{$head->{$h}} ) {
                	
                        my $H = header_line_normalize( $h, $val ) ;
                                                
			# show stuff in debug mode
			$debug and print "$side uid $m_uid header [$H]", "\n" ;
			
			if ($skipheader and $H =~ m/$skipheader/xi) {
				$debug and print "$side uid $m_uid skipping header [$H]\n" ;
				next ;
			}
			$headstr .= "$H" ;
		}
	}
	return( $headstr ) ;
}


sub header_line_normalize {
	my( $header_key,  $header_val ) = @_ ;
	
        # no 8-bit data in headers !
        $header_val =~ s/[\x80-\xff]/X/xog;

        # change tabulations to space (Gmail bug on with "Received:" on multilines)
        $header_val =~ s/\t/\ /xg ;

        # remove the first blanks ( dbmail bug? )
        $header_val =~ s/^\s*//xo;

        # remove successive blanks ( Mailenable does it )
        $header_val =~ s/\s+/ /gxo;

        # remove Message-Id value domain part ( Mailenable changes it )
        if ( ( $messageidnodomain ) and ( 'MESSAGE-ID' eq uc( $header_key ) ) ) { $header_val =~ s/^([^@]+).*$/$1/xo ; }

        # and uppercase header line 
        # (dbmail and dovecot)

        my $header_line = uc("$header_key: $header_val") ;

	return( $header_line ) ;

}

sub tests_header_line_normalize {

	ok( ': ' eq header_line_normalize( '', '' ), 'header_line_normalize: empty args' ) ;
	ok( 'HHH: VVV' eq header_line_normalize( 'hhh', 'vvv' ), 'header_line_normalize: hhh vvv ' ) ;
	ok( 'HHH: VVV' eq header_line_normalize( 'hhh', '  vvv' ), 'header_line_normalize: remove first blancs' ) ;
	ok( 'HHH: AA BB CCC ' eq header_line_normalize( 'hhh', 'aa  bb   ccc  ' ), 'header_line_normalize: remove succesive blancs' ) ;
	ok( 'HHH: VVV XX YY' eq header_line_normalize( 'hhh', "vvv\t\txx\tyy" ), 'header_line_normalize: tabs' ) ;
	ok( 'HHH: XABX' eq header_line_normalize( 'hhh', "\x80AB\xff" ), 'header_line_normalize: 8bit' ) ;

	return(  ) ;
}


sub firstline {
        # extract the first line of a file (without \n)

        my($file) = @_ ;
        my $line  = "" ;
        
        open( my $FILE, '<', $file ) or die_clean( "error [$file]: $! " ) ;
        chomp( $line = <$FILE> ) ;
        close $FILE ;
        $line = ( $line ) ? $line: "error !EMPTY! [$file]" ;
        return $line ;
}


sub file_to_string {
	my( $file ) = @_ ;
	my @string ;
	open( my $FILE, '<', $file )  or die_clean( "error [$file]: $! " ) ;
	@string = <$FILE> ;
	close $FILE ;
	return join('', @string) ;
}


sub string_to_file {
	my($string, $file) = @_;
	sysopen(FILE, $file,O_WRONLY|O_TRUNC|O_CREAT, 0600) or die_clean("$! $file");
	print FILE $string;
	close FILE;
	return(  ) ;
}

sub tests_is_a_release_number {
	ok(is_a_release_number(1.351), 'is_a_release_number 1.351');
	ok(is_a_release_number(42.4242), 'is_a_release_number 42.4242');
	ok(is_a_release_number(imapsync_version()), 'is_a_release_number imapsync_version()');
	ok(! is_a_release_number('blabla' ), '! is_a_release_number blabla');
	return(  ) ;
}

sub is_a_release_number {
	my $number = shift;
	
	return( $number =~ m{\d\.\d+}xo ) ;
}

sub check_last_release {

	my $public_release = not_long_imapsync_version_public(  ) ;
	#print "check_last_release: [$public_release]\n" ;
	return('unknown') if ($public_release eq 'unknown');
	return('timeout') if ($public_release eq 'timeout');
	return('unknown') if (! is_a_release_number($public_release));
	
	my $imapsync_here  = imapsync_version();
	
	if ($public_release > $imapsync_here) {
		return("New imapsync release $public_release available");
	}else{
		return("This current imapsync is up to date");
	}
}

sub imapsync_version  {
	my $rcs_imapsync = '$Id: imapsync,v 1.592 2014/05/22 10:03:17 gilles Exp gilles $ ' ;
        my $imapsync_version ;
        
	if ( $rcs_imapsync =~ m{,v\s+(\d+\.\d+)}xo ) {
		$imapsync_version = $1
        } else {
        	$imapsync_version = "UNKNOWN" ;
        }
	return( $imapsync_version ) ;
}

sub tests_imapsync_basename {

	ok('imapsync' eq imapsync_basename(), 'imapsync_basename: imapsync');
	ok('blabla'   ne imapsync_basename(), '! imapsync_basename: blabla');
	return(  ) ;
}

sub imapsync_basename {

	return basename($0);

}

sub imapsync_version_public {
	
	my $local_version = imapsync_version();
	my $imapsync_basename = imapsync_basename();
	my $agent_info = "$OSNAME system, perl " 
		. sprintf("%vd", $PERL_VERSION) 
		. ", Mail::IMAPClient $Mail::IMAPClient::VERSION"
		. " $imapsync_basename";
	my $sock = IO::Socket::INET->new(
		PeerAddr => 'imapsync.lamiral.info',
		PeerPort => '80',
		Proto => 'tcp' 
                ) ;
	return( 'unknown' ) if not $sock ;
	print $sock
		"GET /prj/imapsync/VERSION HTTP/1.0\n",
		"User-Agent: imapsync/$local_version ($agent_info)\n",
		"Host: ks.lamiral.info\n\n";
	my @line = <$sock>;
	close($sock);
	my $last_release = $line[-1];
	chomp($last_release);
	return($last_release);
}

sub not_long_imapsync_version_public {
	#print "Entering not_long_imapsync_version_public\n";

	my $val;
	
	# Doesn't work with gethostbyname (see perlipc)
	#local $SIG{ALRM} = sub { die "alarm\n" };
	
	if ('MSWin32' eq $OSNAME) {
		local $SIG{ALRM} = sub { die "alarm\n" };
	}else{
	
        	POSIX::sigaction(SIGALRM,
                         POSIX::SigAction->new(sub { croak "alarm" }))
        		or print "Error setting SIGALRM handler: $!\n";
	}
	
	my $ret = eval {
		alarm(3) ;
		{
			$val = imapsync_version_public(  ) ;
                        #sleep 4 ;
			#print "End of imapsync_version_public\n" ;
		}
		alarm(0) ;
                1 ;
	} ;
        #print "eval [$ret]\n" ;
	if ( ( not $ret ) or $@ ) {
		#print "$@";
		if ($@ =~ /alarm/) {
		# timed out
			return('timeout');
		}else{
			alarm(0);
			return('unknown'); # propagate unexpected errors
		}
	}else {
	# Good!
		return($val);
	}
}

sub localhost_info {
	
	my($infos) = join("", 
	    "Here is a [$OSNAME] system (", 
	    join(" ", 
	         uname(),
	         ),
                 ")\n",
	         "With perl ", 
	         sprintf("%vd", $PERL_VERSION),
	         " Mail::IMAPClient  $Mail::IMAPClient::VERSION",
            ) ;
	return($infos);
}

sub memory_consumption {
	# memory consumed by imapsync until now in bytes
	return( ( memory_consumption_of_pids(  ) )[0] );
}

sub memory_consumption_of_pids {

	my @pid = @_;
	@pid = (@pid) ? @pid : ($PROCESS_ID) ;
	
	#print "PIDs: @PID\n";
	my @val;
	if ('MSWin32' eq $OSNAME) {
		@val = memory_consumption_of_pids_win32(@pid);
	}else{
		# Unix
		my @ps = qx{ ps -o vsz -p @pid };
                #my @ps = backtick( "ps -o vsz -p @pid" ) ;
		shift @ps; # First line is column name "VSZ"
		chomp @ps; 
		# convert to 
		@val = map { $_ * 1024 } @ps;
	}
	return( @val ) ;
}

sub memory_consumption_of_pids_win32 {
	# Windows
	my @PID = @_;
	my %PID;
	# hash of pids as key values
	map { $PID{$_}++ } @PID;
	
	# Does not work but should reading the tasklist documentation
	#@ps = qx{ tasklist /FI "PID eq @PID" };
	
	my @ps = qx{ tasklist /NH /FO CSV } ;
        #my @ps = backtick( 'tasklist /NH /FO CSV' ) ;
	#print "-" x 80, "\n", @ps, "-" x 80, "\n";
	my @val;
	foreach my $line (@ps) {
		my($name, $pid, $mem) = (split(',', $line))[0,1,4];
		next if (! $pid);
		#print "[$name][$pid][$mem]";
		if ($PID{remove_qq($pid)}) {
			#print "MATCH !\n";
			chomp($mem);
			$mem = remove_qq($mem);
			$mem = remove_Ko($mem);
			$mem = remove_not_num($mem);
			#print "[$mem]\n";
			push(@val, $mem * 1024);
		}
	}
	return(@val);
}

sub backtick {
	my $command = shift ;
	my ( $writer, $reader, $err ) ;
        my @output ;
        open3( $writer, $reader, $err, $command ) ;
        @output = <$reader>;  #Output here
        #my @errors = <$err>;    #Errors here, instead of the console
        $debugdev and print @output ;
        return( @output ) ;
}

sub tests_backtick {
        
        my @output ;
        @output = backtick( "echo Hello World!" ) ;
        ok( "Hello World!\n" eq $output[0], 'backtick: echo Hello World!' ) ;
        
        @output = backtick( "echo Hello\necho World!" ) ;
        ok( "Hello\n" eq $output[0], 'backtick: echo Hello; echo World!' ) ;
        ok( "World!\n" eq $output[1], 'backtick: echo Hello; echo World!' ) ;
        #print @output ;
        if ('MSWin32' ne $OSNAME) {
        	my @output_1 = backtick( 'ls /' ) ;
                #my @output_2 = `ls /` ;
                #ok( 0 == compare_lists( \@output_1, \@output_2 ), 'backtick: ls /' ) ;
        }
        return(  ) ;
}

sub remove_not_num {
	
	my $string = shift;
	$string =~ tr/0-9//cd;
	#print "tr [$string]\n";
	return($string);
}

sub tests_remove_not_num {

	ok('123' eq remove_not_num(123), 'remove_not_num( 123 )');
	ok('123' eq remove_not_num('123'), "remove_not_num( '123' )");
	ok('123' eq remove_not_num('12 3'), "remove_not_num( '12 3' )");
	ok('123' eq remove_not_num('a 12 3 Ko'), "remove_not_num( 'a 12 3 Ko' )");
	return(  ) ;
}

sub remove_Ko {
	my $string = shift;
	if ($string =~ /^(.*)\sKo$/xo) {
		return($1);
	}else{
		return($string);
	}
}

sub remove_qq {
	my $string = shift;
	if ($string =~ /^"(.*)"$/xo) {
		return($1);
	}else{
		return($string);
	}
}

sub memory_consumption_ratio {

	my ($base) = @_;
	$base ||= 1;
	my $consu = memory_consumption();
	return($consu / $base);
}

sub tests_memory_consumption {

	ok(print join("\n", memory_consumption_of_pids()), " memory_consumption_of_pids\n");
	ok(print join("\n", memory_consumption_of_pids('1')), " memory_consumption_of_pids 1\n");
	ok(print join("\n", memory_consumption_of_pids('1', $PROCESS_ID)), " memory_consumption_of_pids 1 $PROCESS_ID\n");

	ok(print memory_consumption_ratio(), " memory_consumption_ratio \n");
	ok(print memory_consumption_ratio(1), " memory_consumption_ratio 1\n");
	ok(print memory_consumption_ratio(10), " memory_consumption_ratio 10\n");
	
	ok(print memory_consumption(), " memory_consumption\n");
	return(  ) ;
}

sub good_date {
        # two incoming formats:
        # header    Tue, 24 Aug 2010 16:00:00 +0200
	# internal       24-Aug-2010 16:00:00 +0200
	
        # outgoing format: internal date format
        #   24-Aug-2010 16:00:00 +0200
	
    my $d = shift ;
    return ('') if not defined($d);

	SWITCH: {
    	if ( $d =~ m{(\d?)(\d-...-\d{4})(\s\d{2}:\d{2}:\d{2})(\s(?:\+|-)\d{4})?}xo ) {
		#print "internal: [$1][$2][$3][$4]\n" ;
		my ($day_1, $date_rest, $hour, $zone) = ($1,$2,$3,$4) ;
		$day_1 = '0' if ($day_1 eq '') ;
		$zone  = ' +0000'  if not defined($zone) ;
		$d = $day_1 . $date_rest . $hour . $zone ;
                last SWITCH ;
        }
        
	if ($d =~ m{(?:\w{3,},\s)?(\d{1,2}),?\s+(\w{3,})\s+(\d{2,4})\s+(\d{1,2})(?::|\.)(\d{1,2})(?:(?::|\.)(\d{1,2}))?\s*((?:\+|-)\d{4})?}xo ) {
        	# Handles any combination of following formats
                # Tue, 24 Aug 2010 16:00:00 +0200 -- Standard
                # 24 Aug 2010 16:00:00 +0200 -- Missing Day of Week
                # Tue, 24 Aug 97 16:00:00 +0200 -- Two digit year
                # Tue, 24 Aug 1997 16.00.00 +0200 -- Periods instead of colons 
                # Tue, 24 Aug 1997  16:00:00 +0200 -- Extra whitespace between year and hour
                # Tue, 24 Aug 1997 6:5:2 +0200 -- Single digit hour, min, or second
                # Tue, 24, Aug 1997 16:00:00 +0200 -- Extra comma

                #print "header: [$1][$2][$3][$4][$5][$6][$7][$8]\n";
                my ($day, $month, $year, $hour, $min, $sec, $zone) = ($1,$2,$3,$4,$5,$6,$7,$8);
                $year = '19' . $year if length($year) == 2 && $year =~ m/^[789]/xo;
                $year = '20' . $year if length($year) == 2;
                 
                $month = substr $month, 0, 3 if length($month) > 4;
                $day = sprintf("%02d", $day);
                $hour = sprintf("%02d", $hour);
                $min = sprintf("%02d", $min);
                $sec  = '00' if not defined($sec);
                $sec = sprintf("%02d", $sec);
                $zone  = '+0000' if not defined($zone);
                $d = "$day-$month-$year $hour:$min:$sec $zone";
		last SWITCH ;
	}
    
	if ($d =~ m{(?:.{3})\s(...)\s+(\d{1,2})\s(\d{1,2}):(\d{1,2}):(\d{1,2})\s(?:\w{3})?\s?(\d{4})}xo ) {
        	# Handles any combination of following formats
                # Sun Aug 20 11:55:09 2006
                # Wed Jan 24 11:58:38 MST 2007
                # Wed Jan  2 08:40:57 2008

                #print "header: [$1][$2][$3][$4][$5][$6]\n";
                my ($month, $day, $hour, $min, $sec, $year) = ($1,$2,$3,$4,$5,$6);
                $day = sprintf("%02d", $day);
                $hour = sprintf("%02d", $hour);
                $min = sprintf("%02d", $min);
                $sec = sprintf("%02d", $sec);
                $d = "$day-$month-$year $hour:$min:$sec +0000";
		last SWITCH ;
	}

        if ($d =~ m{(\d{2})/(\d{2})/(\d{2})\s(\d{2}):(\d{2}):(\d{2})}xo ) {
                # Handles the following format
                # 02/06/09 22:18:08 -- Generated by AVTECH TemPageR devices

                #print "header: [$1][$2][$3][$4][$5][$6]\n";
                my ($month, $day, $year, $hour, $min, $sec) = ($1,$2,$3,$4,$5,$6);
                $year = '20' . $year;
                my %num2mon = qw(01 Jan 02 Feb 03 Mar 04 Apr 05 May 06 Jun 07 Jul 08 Aug 09 Sep 10 Oct 11 Nov 12 Dec);
                $month = $num2mon{$month};
                $d = "$day-$month-$year $hour:$min:$sec +0000";
		last SWITCH ;
	}
    
	if ($d =~ m{\w{6,},\s(\w{3})\w+\s+(\d{1,2}),\s(\d{4})\s(\d{2}):(\d{2})\s(AM|PM)}xo ) {
        	# Handles the following format
                # Saturday, December 14, 2002 05:00 PM - KBtoys.com order confirmations

                my ($month, $day, $year, $hour, $min, $apm) = ($1,$2,$3,$4,$5,$6);

                $hour += 12 if $apm eq 'PM';
                $day = sprintf("%02d", $day);
                $d = "$day-$month-$year $hour:$min:00 +0000";
                last SWITCH ;
	}
    
	if ($d =~ m{(\w{3})\s(\d{1,2})\s(\d{4})\s(\d{2}):(\d{2}):(\d{2})\s((?:\+|-)\d{4})}xo ) {
        	# Handles the following format
                # Saturday, December 14, 2002 05:00 PM - jr.com order confirmations

                my ($month, $day, $year, $hour, $min, $sec, $zone) = ($1,$2,$3,$4,$5,$6,$7);

                $day = sprintf("%02d", $day);
                $d = "$day-$month-$year $hour:$min:$sec $zone";
                last SWITCH ;
	}
    
	if ($d =~ m{(\d{1,2})-(\w{3})-(\d{4})}xo ) {
        	# Handles the following format
                # 21-Jun-2001 - register.com domain transfer email circa 2001

                my ($day, $month, $year) = ($1,$2,$3);
                $day = sprintf("%02d", $day);
                $d = "$day-$month-$year 11:11:11 +0000";
		last SWITCH ;
	}
        
    	# unknown or unmatch => return same string
    	return($d);
    }
    
    $d = qq("$d") ;
    return( $d ) ;
} 


sub tests_good_date {

	ok('' eq good_date(), 'good_date no arg');
	ok('"24-Aug-2010 16:00:00 +0200"' eq good_date('24-Aug-2010 16:00:00 +0200'), 'good_date internal 2digit zone');
	ok('"24-Aug-2010 16:00:00 +0000"' eq good_date('24-Aug-2010 16:00:00'), 'good_date internal 2digit no zone');
	ok('"01-Sep-2010 16:00:00 +0200"' eq good_date( '1-Sep-2010 16:00:00 +0200'), 'good_date internal SP 1digit');
	ok('"24-Aug-2010 16:00:00 +0200"' eq good_date('Tue, 24 Aug 2010 16:00:00 +0200'), 'good_date header 2digit zone');
	ok('"01-Sep-2010 16:00:00 +0000"' eq good_date('Wed, 1 Sep 2010 16:00:00'), 'good_date header SP 1digit zone');
	ok('"01-Sep-2010 16:00:00 +0200"' eq good_date('Wed, 1 Sep 2010 16:00:00 +0200'), 'good_date header SP 1digit zone');
	ok('"01-Sep-2010 16:00:00 +0200"' eq good_date('Wed, 1 Sep 2010 16:00:00 +0200 (CEST)'), 'good_date header SP 1digit zone');
        ok('"06-Feb-2009 22:18:08 +0000"' eq good_date('02/06/09 22:18:08'), 'good_date header TemPageR');
        ok('"02-Jan-2008 08:40:57 +0000"' eq good_date('Wed Jan  2 08:40:57 2008'), 'good_date header dice.com support 1digit day');
        ok('"20-Aug-2006 11:55:09 +0000"' eq good_date('Sun Aug 20 11:55:09 2006'), 'good_date header dice.com support 2digit day');
        ok('"24-Jan-2007 11:58:38 +0000"' eq good_date('Wed Jan 24 11:58:38 MST 2007'), 'good_date header status-now.com');
        ok('"24-Aug-2010 16:00:00 +0200"' eq good_date('24 Aug 2010 16:00:00 +0200'), 'good_date header missing date of week');
        ok('"24-Aug-2067 16:00:00 +0200"' eq good_date('Tue, 24 Aug 67 16:00:00 +0200'), 'good_date header 2digit year');
        ok('"24-Aug-1977 16:00:00 +0200"' eq good_date('Tue, 24 Aug 77 16:00:00 +0200'), 'good_date header 2digit year');
        ok('"24-Aug-1987 16:00:00 +0200"' eq good_date('Tue, 24 Aug 87 16:00:00 +0200'), 'good_date header 2digit year');
        ok('"24-Aug-1997 16:00:00 +0200"' eq good_date('Tue, 24 Aug 97 16:00:00 +0200'), 'good_date header 2digit year');
        ok('"24-Aug-2004 16:00:00 +0200"' eq good_date('Tue, 24 Aug 04 16:00:00 +0200'), 'good_date header 2digit year');
        ok('"24-Aug-1997 16:00:00 +0200"' eq good_date('Tue, 24 Aug 1997 16.00.00 +0200'), 'good_date header period time sep');
        ok('"24-Aug-1997 16:00:00 +0200"' eq good_date('Tue, 24 Aug 1997  16:00:00 +0200'), 'good_date header extra white space type1');
        ok('"24-Aug-1997 05:06:02 +0200"' eq good_date('Tue, 24 Aug 1997 5:6:2 +0200'), 'good_date header 1digit time vals');
        ok('"24-Aug-1997 05:06:02 +0200"' eq good_date('Tue, 24, Aug 1997 05:06:02 +0200'), 'good_date header extra commas');
        ok('"01-Oct-2003 12:45:24 +0000"' eq good_date('Wednesday, 01 October 2003 12:45:24 CDT'), 'good_date header no abbrev');
        ok('"11-Jan-2005 17:58:27 -0500"' eq good_date('Tue,  11  Jan 2005 17:58:27 -0500'), 'good_date extra white space');
        ok('"18-Dec-2002 15:07:00 +0000"' eq good_date('Wednesday, December 18, 2002 03:07 PM'), 'good_date kbtoys.com orders');
        ok('"16-Dec-2004 02:01:49 -0500"' eq good_date('Dec 16 2004 02:01:49 -0500'), 'good_date jr.com orders');
        ok('"21-Jun-2001 11:11:11 +0000"' eq good_date('21-Jun-2001'), 'good_date register.com domain transfer');
        ok('"18-Nov-2012 18:34:38 +0100"' eq good_date('Sun, 18 Nov 2012 18:34:38 +0100'), 'good_date pop2imap bug (Westeuropäische Normalzeit)');

	return(  ) ;
}


sub tests_list_keys_in_2_not_in_1 {

	my @list;
	ok( ! list_keys_in_2_not_in_1( {}, {}), 'list_keys_in_2_not_in_1: {} {}');
	ok( 0 == compare_lists( [], [ list_keys_in_2_not_in_1( {}, {} ) ] ), 'list_keys_in_2_not_in_1: {} {}');
	ok( 0 == compare_lists( ['a','b'], [ list_keys_in_2_not_in_1( {}, {'a' => 1, 'b' => 1}) ]), 'list_keys_in_2_not_in_1: {} {a, b}');
	ok( 0 == compare_lists( ['b'],     [ list_keys_in_2_not_in_1( {'a' => 1}, {'a' => 1, 'b' => 1}) ]), 'list_keys_in_2_not_in_1: {a} {a, b}');
	ok( 0 == compare_lists( [],        [ list_keys_in_2_not_in_1( {'a' => 1, 'b' => 1}, {'a' => 1, 'b' => 1}) ]), 'list_keys_in_2_not_in_1: {a, b} {a, b}');
	ok( 0 == compare_lists( [],        [ list_keys_in_2_not_in_1( {'a' => 1, 'b' => 1, 'c' => 1}, {'a' => 1, 'b' => 1}) ]), 'list_keys_in_2_not_in_1: {a, b, c} {a, b}');
	ok( 0 == compare_lists( ['b'],     [ list_keys_in_2_not_in_1( {'a' => 1, 'c' => 1}, {'a' => 1, 'b' => 1}) ]), 'list_keys_in_2_not_in_1: {a, b, c} {a, b}');
	
	return(  ) ;
}

sub list_keys_in_2_not_in_1 {

	my $folders1_ref = shift;
	my $folders2_ref = shift;
	my @list;
	
	foreach my $folder ( sort keys %$folders2_ref ) {
		next if exists($folders1_ref->{$folder});
		push(@list, $folder);
	}
	return(@list);
}


sub list_folders_in_2_not_in_1 {

	my (@h2_folders_not_in_h1, %h2_folders_not_in_h1) ;
	@h2_folders_not_in_h1 = list_keys_in_2_not_in_1( \%h1_folders_all, \%h2_folders_all) ;
	map { $h2_folders_not_in_h1{$_} = 1} @h2_folders_not_in_h1 ;
	@h2_folders_not_in_h1 = list_keys_in_2_not_in_1( \%h2_folders_from_1_all, \%h2_folders_not_in_h1) ;
	
	return( reverse @h2_folders_not_in_h1 );
}

sub delete_folders_in_2_not_in_1 { 

	foreach my $folder (@h2_folders_not_in_1) {
		if ( defined( $delete2foldersonly ) and eval( "\$folder !~ $delete2foldersonly" ) ) {
			print "Not deleting $folder because of --delete2foldersonly $delete2foldersonly\n";
			next;
		}
		if ( defined( $delete2foldersbutnot ) and eval( "\$folder =~ $delete2foldersbutnot" ) ) {
			print "Not deleting $folder because of --delete2foldersbutnot $delete2foldersbutnot\n";
			next;
		}
		my $res = $dry ; # always success in dry mode!
		$imap2->unsubscribe( $folder ) if ( ! $dry ) ;
		$res = $imap2->delete( $folder ) if ( ! $dry ) ;
		if ( $res ) {
			print "Delete $folder", "$dry_message", "\n" ;
		}else{
			print "Delete $folder failure", "\n" ;
		}
	}
	return(  ) ;
}


sub extract_header {
        my $string = shift ;
        
        my ( $header ) = split( /\n\n/x, $string ) ;
        if ( ! $header ) { return( '' ) ; }
        #print "[$header]\n" ;
        return( $header ) ;
}

sub tests_extract_header {

        
my $h = <<'EOM';
Message-Id: <20100428101817.A66CB162474E@plume.est.belle>
Date: Wed, 28 Apr 2010 12:18:17 +0200 (CEST)
From: gilles@louloutte.dyndns.org (Gilles LAMIRAL)
EOM
chomp( $h ) ;
ok( $h eq extract_header(
<<'EOM'
Message-Id: <20100428101817.A66CB162474E@plume.est.belle>
Date: Wed, 28 Apr 2010 12:18:17 +0200 (CEST)
From: gilles@louloutte.dyndns.org (Gilles LAMIRAL)

body
lalala
EOM
), 'extract_header: 1') ;


     
	return(  ) ;
}

sub decompose_header{
        my $string = shift ;
        
        # a hash, for a keyword header KEY value are list of strings [VAL1, VAL1_other, etc]
        # Think of multiple "Received:" header lines.
        my $header = {  } ;
        
        my ($key, $val ) ;
        my @line = split( /\n|\r\n/x, $string ) ;
        foreach my $line ( @line ) {
                #print "DDD $line\n" ;
                # End of header
                last if ( $line =~ m{^$}xo ) ;
                # Key: value
                if ( $line =~ m/(^[^:]+):\s(.*)/xo ) {
                        $key = $1 ;
                        $val = $2 ;
                        $debugdev and print "DDD KV [$key] [$val]\n" ;
                        push( @{ $header->{ $key } }, $val ) ;
                # blanc and value => value from previous line continues
                }elsif( $line =~ m/^(\s+)(.*)/xo ) {
                        $val = $2 ;
                        $debugdev and print "DDD  V [$val]\n" ;
                        @{ $header->{ $key } }[ -1 ] .= " $val" if $key ;
                # dirty line?
                }else{
                        next ;
                }
        }
        #require Data::Dumper ;
        #print Data::Dumper->Dump( [ $header ] ) ;

        return( $header ) ;
}


sub tests_decompose_header{

        my $header_dec ;
        
        $header_dec = decompose_header(
<<'EOH'
KEY_1: VAL_1
KEY_2: VAL_2
  VAL_2_+
        VAL_2_++
KEY_3: VAL_3
KEY_1: VAL_1_other
KEY_4: VAL_4
	VAL_4_+
KEY_5 BLANC:  VAL_5

KEY_6_BAD_BODY: VAL_6
EOH
        ) ;
        
        ok( 'VAL_3' 
        eq $header_dec->{ 'KEY_3' }[0], 'decompose_header: VAL_3' ) ;

        ok( 'VAL_1' 
        eq $header_dec->{ 'KEY_1' }[0], 'decompose_header: VAL_1' ) ;

        ok( 'VAL_1_other' 
        eq $header_dec->{ 'KEY_1' }[1], 'decompose_header: VAL_1_other' ) ;

        ok( 'VAL_2 VAL_2_+ VAL_2_++' 
        eq $header_dec->{ 'KEY_2' }[0], 'decompose_header: VAL_2 VAL_2_+ VAL_2_++' ) ;

        ok( 'VAL_4 VAL_4_+' 
        eq $header_dec->{ 'KEY_4' }[0], 'decompose_header: VAL_4 VAL_4_+' ) ;

        ok( ' VAL_5' 
        eq $header_dec->{ 'KEY_5 BLANC' }[0], 'decompose_header: KEY_5 BLANC' ) ;

        ok( not( defined( $header_dec->{ 'KEY_6_BAD_BODY' }[0] ) ), 'decompose_header: KEY_6_BAD_BODY' ) ;

        
        $header_dec = decompose_header(
<<'EOH'
Message-Id: <20100428101817.A66CB162474E@plume.est.belle>
Date: Wed, 28 Apr 2010 12:18:17 +0200 (CEST)
From: gilles@louloutte.dyndns.org (Gilles LAMIRAL)
EOH
        ) ;

        ok( '<20100428101817.A66CB162474E@plume.est.belle>' 
        eq $header_dec->{ 'Message-Id' }[0], 'decompose_header: 1' ) ;

        $header_dec = decompose_header(
<<'EOH'
Return-Path: <gilles@louloutte.dyndns.org>
Received: by plume.est.belle (Postfix, from userid 1000)
        id 120A71624742; Wed, 28 Apr 2010 01:46:40 +0200 (CEST)
Subject: test:eekahceishukohpe
EOH
) ;
        ok( 
'by plume.est.belle (Postfix, from userid 1000) id 120A71624742; Wed, 28 Apr 2010 01:46:40 +0200 (CEST)' 
        eq $header_dec->{ 'Received' }[0], 'decompose_header: 2' ) ;

        $header_dec = decompose_header(
<<'EOH'
Received: from plume (localhost [127.0.0.1])
        by plume.est.belle (Postfix) with ESMTP id C6EB73F6C9
        for <gilles@localhost>; Mon, 26 Nov 2007 10:39:06 +0100 (CET)
Received: from plume [192.168.68.7]
        by plume with POP3 (fetchmail-6.3.6)
        for <gilles@localhost> (single-drop); Mon, 26 Nov 2007 10:39:06 +0100 (CET)
EOH
        ) ;
        ok(
        'from plume (localhost [127.0.0.1]) by plume.est.belle (Postfix) with ESMTP id C6EB73F6C9 for <gilles@localhost>; Mon, 26 Nov 2007 10:39:06 +0100 (CET)'
        eq $header_dec->{ 'Received' }[0], 'decompose_header: 3' ) ;
        ok(
        'from plume [192.168.68.7] by plume with POP3 (fetchmail-6.3.6) for <gilles@localhost> (single-drop); Mon, 26 Nov 2007 10:39:06 +0100 (CET)'
        eq $header_dec->{ 'Received' }[1], 'decompose_header: 3' ) ;

# Bad header beginning with a blank character
        $header_dec = decompose_header(
<<'EOH'
 KEY_1: VAL_1
KEY_2: VAL_2
  VAL_2_+
        VAL_2_++
KEY_3: VAL_3
KEY_1: VAL_1_other
EOH
        ) ;
        
        ok( 'VAL_3' 
        eq $header_dec->{ 'KEY_3' }[0], 'decompose_header: Bad header VAL_3' ) ;

        ok( 'VAL_1_other' 
        eq $header_dec->{ 'KEY_1' }[0], 'decompose_header: Bad header VAL_1_other' ) ;

        ok( 'VAL_2 VAL_2_+ VAL_2_++' 
        eq $header_dec->{ 'KEY_2' }[0], 'decompose_header: Bad header VAL_2 VAL_2_+ VAL_2_++' ) ;

	return(  ) ;
}

sub epoch {
        # incoming format:
	# internal date 24-Aug-2010 16:00:00 +0200
	
        # outgoing format: epoch


        my $d = shift ;
        return ('') if not defined($d);

        my ( $mday, $month, $year, $hour, $min, $sec, $sign, $zone_h, $zone_m ) ;
        my $time ;
        
        if ( $d =~ m{(\d{1,2})-([A-Z][a-z]{2})-(\d{4})\s(\d{2}):(\d{2}):(\d{2})\s((?:\+|-))(\d{2})(\d{2})}xo ) {
                #print "internal: [$1][$2][$3][$4][$5][$6][$7][$8][$9]\n" ;
                ( $mday, $month, $year, $hour, $min, $sec, $sign, $zone_h, $zone_m ) 
                =  ( $1,   $2,     $3,    $4,    $5,  $6,    $7,     $8,     $9 ) ;
                #print "( $mday, $month, $year, $hour, $min, $sec, $sign, $zone_h, $zone_m )\n" ;
                
                $sign = +1 if ( '+' eq $sign ) ;
                $sign = -1 if ( '-' eq $sign ) ;
                
                $time = timegm( $sec, $min, $hour, $mday, $month_abrev{$month}, $year ) 
                        - $sign * ( 3600 * $zone_h + 60 * $zone_m ) ;
                
                #print( "$time ", scalar(localtime($time)), "\n");
        }
        return( $time ) ;
}

sub tests_epoch {
        ok( '1282658400' eq epoch( '24-Aug-2010 16:00:00 +0200' ), 'epoch 24-Aug-2010 16:00:00 +0200 -> 1282658400' ) ;
        ok( '1282658400' eq epoch( '24-Aug-2010 14:00:00 +0000' ), 'epoch 24-Aug-2010 14:00:00 +0000 -> 1282658400' ) ;
        ok( '1282658400' eq epoch( '24-Aug-2010 12:00:00 -0200' ), 'epoch 24-Aug-2010 12:00:00 -0200 -> 1282658400' ) ;
        ok( '1282658400' eq epoch( '24-Aug-2010 16:01:00 +0201' ), 'epoch 24-Aug-2010 16:01:00 +0201 -> 1282658400' ) ;
        ok( '1282658400' eq epoch( '24-Aug-2010 14:01:00 +0001' ), 'epoch 24-Aug-2010 14:01:00 +0001 -> 1282658400' ) ;

        ok( '1280671200' eq epoch( '1-Aug-2010 16:00:00 +0200' ), 'epoch 1-Aug-2010 16:00:00 +0200 -> 1280671200' ) ;
        ok( '1280671200' eq epoch( '1-Aug-2010 14:00:00 +0000' ), 'epoch 1-Aug-2010 14:00:00 +0000 -> 1280671200' ) ;
        ok( '1280671200' eq epoch( '1-Aug-2010 12:00:00 -0200' ), 'epoch 1-Aug-2010 12:00:00 -0200 -> 1280671200' ) ;
        ok( '1280671200' eq epoch( '1-Aug-2010 16:01:00 +0201' ), 'epoch 1-Aug-2010 16:01:00 +0201 -> 1280671200' ) ;
        ok( '1280671200' eq epoch( '1-Aug-2010 14:01:00 +0001' ), 'epoch 1-Aug-2010 14:01:00 +0001 -> 1280671200' ) ;
	return(  ) ;
}

sub add_header {
	my $header_uid = shift || 'mistake' ;
	my $header_Message_Id = 'Message-Id: <' . $header_uid . '@imapsync>' ;
        return( $header_Message_Id ) ;
}

sub tests_add_header {
	ok( 'Message-Id: <mistake@imapsync>' eq add_header(), 'add_header no arg' ) ;
	ok( 'Message-Id: <123456789@imapsync>' eq add_header(123456789), 'add_header 123456789' ) ;

	return(  ) ;
}

sub tests_Banner{

	my $imap = Mail::IMAPClient->new(  ) ;
        ok( 'lalala' eq $imap->Banner('lalala'), "Banner set lalala" ) ;
        ok( 'lalala' eq $imap->Banner(), "Banner get lalala" ) ;
	return(  ) ;
}




sub max_line_length {
	my $string = shift ;
        my $max = 0 ;
        my $i ;
        while ( $string =~ m/([^\n]*\n?)/msxg ) {
        	$max = max( $max, length( $1 ) ) ;
                #++$i ;
        	#print "max $max $i\n" ;
        }
        #print "MAX $max $i\n\n" ;
	return( $max ) ;
}

sub tests_max_line_length {
	ok( 0 == max_line_length( '' ), 'max_line_length: 0 == null string' ) ;
	ok( 1 == max_line_length( "\n" ), 'max_line_length: 1 == \n' ) ;
	ok( 1 == max_line_length( "\n\n" ), 'max_line_length: 1 == \n\n' ) ;
	ok( 1 == max_line_length( "\n" x 500 ), 'max_line_length: 1 == 500 \n' ) ;
	ok( 1 == max_line_length( "a" ), 'max_line_length: 1 == a' ) ;
	ok( 2 == max_line_length( "a\na" ), 'max_line_length: 2 == a\na' ) ;
	ok( 2 == max_line_length( "a\na\n" ), 'max_line_length: 2 == a\na\n' ) ;
	ok( 3 == max_line_length( "a\nab\n" ), 'max_line_length: 3 == a\nab\n' ) ;
	ok( 3 == max_line_length( "a\nab\n" x 10000 ), 'max_line_length: 3 == 10000 a\nab\n' ) ;
	ok( 3 == max_line_length( "a\nab\nabc" ), 'max_line_length: 3 == a\nab\nabc' ) ;

	ok( 4 == max_line_length( "a\nab\nabc\n" ), 'max_line_length: 4 == a\nab\nabc\n' ) ;
	ok( 5 == max_line_length( "a\nabcd\nabc\n" ), 'max_line_length: 5 == a\nabcd\nabc\n' ) ;
	ok( 5 == max_line_length( "a\nabcd\nabc\n\nabcd\nabcd\nabcd\nabcd\nabcd\nabcd\nabcd\nabcd" ), 'max_line_length: 5 == a\nabcd\nabc\n\nabcd\nabcd\nabcd\nabcd\nabcd\nabcd\nabcd\nabcd' ) ;
	return(  ) ;
}

sub logfile {
	my ( $time, $suffix) = @_ ;
	
	$time   ||= 0 ;
	$suffix ||= '' ;
	my $sep = ( $suffix ) ? '_' : '' ;
	
	my $date_str = POSIX::strftime( "%Y_%m_%d_%H_%M_%S", localtime( $time ) ) ;
	#print "date_str: $date_str\n" ;
	return( "LOG_imapsync/${date_str}${sep}${suffix}.txt" ) ;
}

sub tests_logfile {
	ok( 'LOG_imapsync/1970_01_01_01_00_00.txt' eq logfile(  ), 'logfile: no args => LOG_imapsync/1970_01_01_01_00_00.txt' ) ;
	ok( 'LOG_imapsync/1970_01_01_01_00_00.txt' eq logfile( 0 ), 'logfile: 0 => LOG_imapsync/1970_01_01_01_00_00.txt' ) ;
	ok( 'LOG_imapsync/1970_01_01_01_01_01.txt' eq logfile( 61 ), 'logfile: 0 => LOG_imapsync/1970_01_01_01_01_01.txt' ) ;
	ok( 'LOG_imapsync/2010_08_24_16_00_00.txt' eq logfile( 1282658400 ), 'logfile: 1282658400 => LOG_imapsync/2010_08_24_16_00_00.txt' ) ;
	ok( 'LOG_imapsync/2010_08_24_16_01_01.txt' eq logfile( 1282658461 ), 'logfile: 1282658461 => LOG_imapsync/2010_08_24_16_01_01.txt' ) ;
	ok( 'LOG_imapsync/2010_08_24_16_01_01_poupinette.txt' eq logfile( 1282658461, "poupinette" ), 'logfile: 1282658461 poupinette => LOG_imapsync/2010_08_24_16_01_01_poupinette.txt' ) ;
	
	return(  ) ;
}

sub logfileprepa {
	my $logfile = shift ;
	
	my $dirname = dirname( $logfile ) ;
	is_valid_directory( $dirname ) || return( 0 ) ;
	return( 1 ) ;
}

sub teelaunch {
	my $logfile = shift ;
	logfileprepa( $logfile ) || croak "Error creating directory for $logfile : $!" ;
	my $logfile_handle ;
	open( $logfile_handle, '>', $logfile )
	  or die( "Can not open $logfile for write: $!" ) ;
	my $tee = IO::Tee->new( $logfile_handle, \*STDOUT ) ;
	*STDERR = *$tee{IO} ;
	select $tee ;
}

sub usage {
	my $localhost_info = localhost_info();
	my $thank = thank_author();
	my $imapsync_release = '';
	$imapsync_release = check_last_release() if (not defined($releasecheck));
        my $escape_char = ( 'MSWin32' eq $OSNAME ) ? '^' : '\\';
        print <<"EOF";

usage: $0 [options]

Several options are mandatory. 

--dry                  : Makes imapsync doing nothing, just print what would 
                         be done without --dry.

--host1       <string> : Source or "from" imap server. Mandatory.
--port1       <int>    : Port to connect on host1. Default is 143.
--user1       <string> : User to login on host1. Mandatory.
--showpasswords        : Shows passwords on output instead of "MASKED".
                         Useful to restart a complete run by just reading a log.
--password1   <string> : Password for the user1.
--host2       <string> : "destination" imap server. Mandatory.
--port2       <int>    : Port to connect on host2. Default is 143.
--user2       <string> : User to login on host2. Mandatory.
--password2   <string> : Password for the user2.

--passfile1   <string> : Password file for the user1. It must contain the 
                         password on the first line. This option avoids to show 
                         the password on the command line like --password1 does.
--passfile2   <string> : Password file for the user2. Contains the password.
--domain1     <string> : Domain on host1 (NTLM authentication).
--domain2     <string> : Domain on host2 (NTLM authentication).
--authuser1   <string> : User to auth with on host1 (admin user). 
                         Avoid using --authmech1 SOMETHING with --authuser1.
--authuser2   <string> : User to auth with on host2 (admin user).
--proxyauth1           : Use proxyauth on host1. Requires --authuser1.
                         Required by Sun/iPlanet/Netscape IMAP servers to
                         be able to use an administrative user.
--proxyauth2           : Use proxyauth on host2. Requires --authuser2.
                         Required by Sun/iPlanet/Netscape IMAP servers to
                         be able to use an administrative user

--authmd51             : Use MD5 authentification for host1.
--authmd52             : Use MD5 authentification for host2.
--authmech1   <string> : Auth mechanism to use with host1:
                         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.
--tls1                 : Use an TLS connection on host1.
--tls2                 : Use an TLS connection on host2.
--timeout    <int>     : Connections timeout in seconds. Default is 120.
                         0 means no timeout.

--folder      <string> : Sync this folder.
--folder      <string> : and this one, etc.
--folderrec   <string> : Sync this folder recursively.
--folderrec   <string> : and this one, etc.

--folderfirst <string> : Sync this folder first. --folderfirst "Work"
--folderfirst <string> : then this one, etc.
--folderlast  <string> : Sync this folder last. --folderlast "[Gmail]/All Mail"
--folderlast  <string> : then this one, etc.

--include     <regex>  : Sync folders matching this regular expression
                         Blancs like in "foo bar" have to be written "foo\\ bar"
--include     <regex>  : or this one, etc.
                         in case both --include --exclude options are
                         use, include is done before.
--exclude     <regex>  : Skips folders matching this regular expression
                         Several folders to avoid:
			  --exclude 'fold1|fold2|f3' skips fold1, fold2 and f3.
--exclude     <regex>  : or this one, etc.
--regextrans2 <regex>  : Apply the whole regex to each destination folders.
--regextrans2 <regex>  : and this one. etc.
                         When you play with the --regextrans2 option, first
                         add also the safe options --dry --justfolders
                         Then, when happy, remove --dry, remove --justfolders.
                         Have in mind that --regextrans2 is applied after prefix 
                         and separator inversion.

--tmpdir      <string> : Where to store temporary files and subdirectories.
                         Will be created if it doesn't exist.
			 Default is system specific, Unix is /tmp but
                         it's often small and deleted at reboot.
                         --tmpdir /var/tmp should be better.
--pidfile     <string> : The file where imapsync pid is written.
--pidfilelocking       : Abort if pidfile already exists. Usefull to avoid 
                         concurrent transfers on the same mailbox.

--prefix1     <string> : Remove prefix to all destination folders 
                         (usually INBOX. or INBOX/ or an empty string "")
                         you have to use --prefix1 if host1 imap server
                         does not have NAMESPACE capability, all other
                         cases are bad.
--prefix2     <string> : Add prefix to all host2 folders. See --prefix1
--sep1        <string> : Host1 separator in case NAMESPACE is not supported.
--sep2        <string> : Host2 separator in case NAMESPACE is not supported.

--disarmreadreceipts   : Disarms read receipts (host2 Exchange issue)
--regexmess   <regex>  : Apply the whole regex to each message before transfer.
                         Example: 's/\\000/ /g' # to replace null by space.
--regexmess   <regex>  : and this one.
--regexmess   <regex>  : and this one, etc.
--regexflag   <regex>  : Apply the whole regex to each flags list.
                         Example: 's/\"Junk"//g' # to remove "Junk" flag.
--regexflag   <regex>  : and this one, etc.

--delete               : Deletes messages on host1 server after a successful 
                         transfer. Option --delete has the following behavior: 
                         it marks messages as deleted with the IMAP flag 
                         \\Deleted, then messages are really deleted with an 
                         EXPUNGE IMAP command.
--delete2              : Delete messages in host2 that are not in
                         host1 server. Useful for backup or pre-sync.
--delete2duplicates    : Delete messages in host2 that are duplicates.
                         Works only without --useuid since duplicates are 
                         detected with header part of each message.
--delete2folders       : Delete folders in host2 that are not in host1 server. 
                         For safety, first try it like this (it is safe):
			 --delete2folders --dry --justfolders --nofoldersizes
--delete2foldersonly   <regex>: Deleted only folders matching regex.
                         Example: --delete2foldersonly "/^Junk\$|^INBOX.Junk\$/"
--delete2foldersbutnot <regex>: Do not delete folders matching regex.
                         Example: --delete2foldersbutnot "/Tasks\$|Contacts\$|Foo\$/"
--noexpunge            : Do not expunge messages on host1.
                         Expunge really deletes messages marked deleted.
                         Expunge is made at the beginning, on host1 only. 
                         Newly transferred messages are also expunged if 
			 option --delete is given.
                         No expunge is done on host2 account (unless --expunge2)
--expunge1             : Expunge messages on host1 after messages transfer.
--expunge2             : Expunge messages on host2 after messages transfer.
--uidexpunge2          : uidexpunge messages on the host2 account
                         that are not on the host1 account, requires --delete2

--syncinternaldates    : Sets the internal dates on host2 same as host1.
                         Turned on by default. Internal date is the date
			 a message arrived on a host (mtime).
--idatefromheader      : Sets the internal dates on host2 same as the 
                         "Date:" headers.

--maxsize     <int>    : Skip messages larger  (or equal) than <int> bytes
--minsize     <int>    : Skip messages smaller (or equal) than <int> bytes
--maxage      <int>    : Skip messages older than <int> days.
                         final stats (skipped) don't count older messages
			 see also --minage
--minage      <int>    : Skip messages newer than <int> days.
                         final stats (skipped) don't count newer messages
                         You can do (+ are the messages selected):
                         past|----maxage+++++++++++++++>now
                         past|+++++++++++++++minage---->now
                         past|----maxage+++++minage---->now (intersection)
                         past|++++minage-----maxage++++>now (union)

--search      <string> : Selects only messages returned by this IMAP SEARCH 
                         command. Applied on both sides.
--search1     <string> : Same as --search for selecting host1 messages only.
--search2     <string> : Same as --search for selecting host2 messages only.
                         --search CRIT equals --search1 CRIT --search2 CRIT

--exitwhenover   <int> : Stop syncing when total bytes transferred reached.
                         Gmail per day allows 2500000000 down 500000000 upload.

--maxlinelength <int>  : skip messages with a line length longer than <int> bytes.
                         RFC 2822 says it must be no more than 1000 bytes.

--useheader   <string> : Use this header to compare messages on both sides.
                         Ex: Message-ID or Subject or Date.
--useheader   <string>   and this one, etc.

--subscribed           : Transfers subscribed folders.
--subscribe            : Subscribe to the folders transferred on the 
                         host2 that are subscribed on host1. On by default.
--subscribe_all        : Subscribe to the folders transferred on the 
                         host2 even if they are not subscribed on host1.

--nofoldersizes        : Do not calculate the size of each folder in bytes
                         and message counts. Default is to calculate them.
--nofoldersizesatend   : Do not calculate the size of each folder in bytes
                         and message counts at the end. Default is on.
--justfoldersizes      : Exit after having printed the folder sizes.

--syncacls             : Synchronises acls (Access Control Lists).
--nosyncacls           : Does not synchronize acls. This is the default.
                         Acls in IMAP are not standardized, be careful.

--usecache             : Use cache to speedup.
--nousecache           : Do not use cache. Caveat: --useuid --nousecache creates
                         duplicates on multiple runs.
--useuid               : Use uid instead of header as a criterium to recognize 
                         messages. Option --usecache is then implied unless 
                         --nousecache is used.  

--debug                : Debug mode.
--debugcontent         : Debug content of the messages transfered.
--debugflags           : Debug flags.
--debugimap1           : IMAP debug mode for host1. imap debug is very verbose.
--debugimap2           : IMAP debug mode for host2.
--debugimap            : IMAP debug mode for host1 and host2.

--version              : Print software version.
--noreleasecheck       : Do not check for new imapsync release (a http request).
--releasecheck         : Check for new imapsync release (a http request).
--justconnect          : Just connect to both servers and print useful
                         information. Need only --host1 and --host2 options.
--justlogin            : Just login to both host1 and host2 with users 
                         credentials, then exit.
--justfolders          : Do only things about folders (ignore messages).

--help                 : print this help.

Example: to synchronize imap account "foo" on "imap.truc.org"
                    to  imap account "bar" on "imap.trac.org"
                    with foo password "secret1"
                    and  bar password "secret2"

$0 $escape_char
   --host1 imap.truc.org --user1 foo --password1 secret1 $escape_char
   --host2 imap.trac.org --user2 bar --password2 secret2

$localhost_info
$rcs
$imapsync_release

$thank
EOF
	return( 1 ) ;
}

sub usage_complete {
	print <<'EOF' ;
--skipheader  <regex>  : Don't take into account header keyword 
                         matching <string> ex: --skipheader 'X.*'
        
--skipsize             : Don't take message size into account to compare 
                         messages on both sides. On by default.
			 Use --no-skipsize for using size comparaison.
--allowsizemismatch    : allow RFC822.SIZE != fetched msg size
                         consider also --skipsize to avoid duplicate messages
                         when running syncs more than one time per mailbox

--reconnectretry1 <int>: reconnect to host1 if connection is lost up to 
                         <int> times per imap command (default is 3)
--reconnectretry2 <int>: same as --reconnectretry1 but for host2
--split1     <int>     : split the requests in several parts on host1.
                         <int> is the number of messages handled per request.
                         default is like --split1 500.
--split2     <int>     : same thing on host2.
EOF
	return(  ) ;
}



sub get_options {
	my $numopt = scalar(@ARGV);
	my $argv   = join("¤", @ARGV);
	
	$test_builder = Test::More->builder;
	$test_builder->no_ending(1);

	if($argv =~ m/-delete¤2/x) {
		print "May be you mean --delete2 instead of --delete 2\n";
		exit 1;
	}
        my $opt_ret = GetOptions(
                                   "debug!"        => \$debug,
                                   "debugLIST!"    => \$debugLIST,
                                   "debugcontent!" => \$debugcontent,
				   "debugsleep!"   => \$debugsleep,
                                   "debugflags!"   => \$debugflags,
                                   "debugimap!"    => \$debugimap,
                                   "debugimap1!"   => \$debugimap1,
                                   "debugimap2!"   => \$debugimap2,
                                   "debugdev!"     => \$debugdev,
                                   "debugmemory!" => \$debugmemory,
                                   "debugmaxlinelength!" => \$debugmaxlinelength,
                                   "host1=s"     => \$host1,
                                   "host2=s"     => \$host2,
                                   "port1=i"     => \$port1,
                                   "port2=i"     => \$port2,
                                   "user1=s"     => \$user1,
                                   "user2=s"     => \$user2,
                                   "domain1=s"   => \$domain1,
                                   "domain2=s"   => \$domain2,
                                   "password1=s" => \$password1,
                                   "password2=s" => \$password2,
                                   "passfile1=s" => \$passfile1,
                                   "passfile2=s" => \$passfile2,
				   "authmd5!"    => \$authmd5,
				   "authmd51!"   => \$authmd51,
				   "authmd52!"   => \$authmd52,
                                   "sep1=s"      => \$sep1,
                                   "sep2=s"      => \$sep2,
				   "folder=s"    => \@folder,
				   "folderrec=s" => \@folderrec,
				   "include=s"   => \@include,
				   "exclude=s"   => \@exclude,
                                   "folderfirst=s" => \@folderfirst,
                                   "folderlast=s" => \@folderlast,
				   "prefix1=s"   => \$prefix1,
				   "prefix2=s"   => \$prefix2,
				   "fixslash2!"  => \$fixslash2,
                                   "fixInboxINBOX!" => \$fixInboxINBOX,
				   "regextrans2=s" => \@regextrans2,
				   "regexmess=s" => \@regexmess,
                                   "disarmreadreceipts!" => \$disarmreadreceipts,
				   "regexflag=s" => \@regexflag,
				   "filterflags!" => \$filterflags,
				   "flagsCase!"  => \$flagsCase,
                                   "syncflagsaftercopy!" => \$syncflagsaftercopy,
                                   "delete|delete1!" => \$delete,
                                   "delete2!"    => \$delete2,
                                   "delete2duplicates!" => \$delete2duplicates,
				   "delete2folders!"    => \$delete2folders,
				   "delete2foldersonly=s" => \$delete2foldersonly,
				   "delete2foldersbutnot=s" => \$delete2foldersbutnot,
                                   "syncinternaldates!" => \$syncinternaldates,
                                   "idatefromheader!"   => \$idatefromheader,
                                   "syncacls!"   => \$syncacls,
				   "maxsize=i"   => \$maxsize,
				   "minsize=i"   => \$minsize,
				   "maxage=i"    => \$maxage,
				   "minage=i"    => \$minage,
                                   "search=s"    => \$search,
                                   "search1=s"   => \$search1,
                                   "search2=s"   => \$search2,
				   "foldersizes!" => \$foldersizes,
				   "foldersizesatend!" => \$foldersizesatend,
                                   "dry!"        => \$dry,
                                   "expunge!"    => \$expunge,
                                   "expunge1!"    => \$expunge1,
                                   "expunge2!"    => \$expunge2,
                                   "uidexpunge2!" => \$uidexpunge2,
                                   "subscribed!" => \$subscribed,
                                   "subscribe!"  => \$subscribe,
                                   "subscribe_all!"  => \$subscribe_all,
				   "justbanner!" => \$justbanner,
                                   "justconnect!"=> \$justconnect,
                                   "justfolders!"=> \$justfolders,
				   "justfoldersizes!" => \$justfoldersizes,
				   "fast!"       => \$fast,
                                   "version"     => \$version,
                                   "help"        => \$help,
                                   "timeout=i"   => \$timeout,
				   "skipheader=s" => \$skipheader,
				   "useheader=s" => \@useheader,
				   "wholeheaderifneeded!"   => \$wholeheaderifneeded,
                                   "messageidnodomain!" => \$messageidnodomain,
				   "skipsize!"   => \$skipsize,
				   "allowsizemismatch!" => \$allowsizemismatch,
				   "fastio1!"     => \$fastio1,
				   "fastio2!"     => \$fastio2,
				   "ssl1!"        => \$ssl1,
				   "ssl2!"        => \$ssl2,
				   "ssl1_SSL_version=s" => \$ssl1_SSL_version,
				   "ssl2_SSL_version=s" => \$ssl2_SSL_version,
				   "tls1!"        => \$tls1,
				   "tls2!"        => \$tls2,
				   "uid1!"        => \$uid1,
				   "uid2!"        => \$uid2,
				   "authmech1=s" => \$authmech1,
				   "authmech2=s" => \$authmech2,
				   "authuser1=s" => \$authuser1,
				   "authuser2=s" => \$authuser2,
				   "proxyauth1"        => \$proxyauth1,
				   "proxyauth2"        => \$proxyauth2,
				   "split1=i"    => \$split1,
				   "split2=i"    => \$split2,
				   "buffersize=i" => \$buffersize,
				   "reconnectretry1=i" => \$reconnectretry1,
				   "reconnectretry2=i" => \$reconnectretry2,
				   "relogin1=i"  => \$relogin1,
				   "relogin2=i"  => \$relogin2,
                                   "tests"       => \$tests,
                                   "tests_debug" => \$tests_debug,
                                   "allow3xx!"   => \$allow3xx,
                                   "justlogin!"  => \$justlogin,
				   "tmpdir=s"    => \$tmpdir,
				   "pidfile=s"    => \$pidfile,
				   "pidfilelocking!"    => \$pidfilelocking,                                 
				   "releasecheck!" => \$releasecheck,
				   "modules_version!" => \$modules_version,
				   "usecache!"    => \$usecache,
                                   "cacheaftercopy!" => \$cacheaftercopy,
				   "debugcache!" => \$debugcache,
				   "useuid!"      => \$useuid,
                                   "addheader!"   => \$addheader,
                                   "exitwhenover=i" => \$exitwhenover,
                                   "checkselectable!" => \$checkselectable,
                                   "checkmessageexists!" => \$checkmessageexists,
                                   "expungeaftereach!" => \$expungeaftereach,
                                   "abletosearch!" => \$abletosearch,
                                   "showpasswords!" => \$showpasswords,
                                   "maxlinelength=i" => \$maxlinelength, 
                                   "minmaxlinelength=i" => \$minmaxlinelength, 
                                   "fixcolonbug!" => \$fixcolonbug,
                                   "create_folder_old!" => \$create_folder_old,
                                   "maxmessagespersecond=f" => \$maxmessagespersecond,
                                   "maxbytespersecond=i" => \$maxbytespersecond,
                                   "skipcrossduplicates!" => \$skipcrossduplicates,
                                   "debugcrossduplicates!" => \$debugcrossduplicates,
                                   "log!" => \$log,
                                   "logfile=s" => \$logfile,
                                  );
	
        $debug and print "get options: [$opt_ret]\n";

	# just the version
        print imapsync_version(), "\n" and exit if ($version) ;
	
	if ($tests) {
		$test_builder->no_ending(0);
		tests();
		exit;
	}
	if ($tests_debug) {
		$test_builder->no_ending(0);
		tests_debug();
		exit;
	}
	
	$help = 1 if ! $numopt;
	load_modules();

	# exit with --help option or no option at all
        usage(  ) and exit(  ) if ( $help or not $numopt ) ;

	# don't go on if options are not all known.
        exit( EX_USAGE(  ) ) unless ( $opt_ret ) ;
	return(  ) ;
}


sub tests_debug {
	
      SKIP: {
		skip "No test in normal run" if ( not $tests_debug );
                #tests_mkpath(  ) ;
		tests_logfile(  ) ;
	}
        return(  ) ;
}

sub tests {
	
      SKIP: {
		skip "No test in normal run" if (not $tests);
		tests_folder_routines(  ) ;
		tests_compare_lists();
		tests_regexmess();
		tests_flags_regex();
		tests_permanentflags();
		tests_flags_filter(  ) ;
                tests_separator_invert(  ) ;
		tests_imap2_folder_name();
		tests_command_line_nopassword();
		tests_good_date(  ) ;
		tests_max();
		tests_remove_not_num();
		tests_memory_consumption();
		tests_is_a_release_number();
		tests_imapsync_basename();
		tests_list_keys_in_2_not_in_1();
		tests_convert_sep_to_slash(  ) ;
		tests_match_a_cache_file(  ) ;
		tests_cache_map(  ) ;
		tests_get_cache(  ) ;
		tests_clean_cache(  ) ;
		tests_clean_cache_2(  ) ;
		tests_touch(  ) ;
		tests_ucsecond(  ) ;
		tests_flagsCase(  ) ;
                tests_mkpath(  ) ;
                tests_extract_header(  ) ;
                tests_decompose_header(  ) ;
                tests_epoch(  ) ;
                tests_add_header(  ) ;
                tests_cache_dir_fix(  ) ;
                tests_filter_forbidden_characters(  ) ;
                tests_cache_folder(  ) ;
                tests_time_remaining(  ) ;
                tests_decompose_regex(  ) ;
                tests_Banner(  ) ;
                tests_backtick(  ) ;
                tests_bytes_display_string(  ) ;
                tests_header_line_normalize(  ) ;
                tests_fix_Inbox_INBOX_mapping(  ) ;
                tests_max_line_length(  ) ;
                tests_subject(  ) ;
		tests_msgs_from_maxmin(  ) ;
                tests_tmpdir_has_colon_bug(  ) ;
                tests_sleep_max_messages(  ) ;
                tests_sleep_max_bytes(  ) ;
		tests_logfile(  ) ;
	}
        return(  ) ;
}



# IMAPClient 3.xx ads

package Mail::IMAPClient;

sub Tls {
	my $self  = shift ;
	my $value = shift ;
	if ( defined( $value ) ) { $self->{TLS} = $value }
	return $self->{TLS};
}

sub Reconnect_counter {
	my $self  = shift ;
        my $value = shift ;
	$self->{Reconnect_counter} = 0 if ( not defined( $self->{Reconnect_counter} ) ) ;
	if ( defined( $value ) ) { $self->{Reconnect_counter} = $value }
	return( $self->{Reconnect_counter} ) ;
}


sub Banner {
	my $self  = shift ;
	my $value = shift ;
	if ( defined( $value ) ) { $self->{ BANNER } = $value }
	return $self->{ BANNER };
}

sub capability_update {
	my $self = shift ;
	
	delete $self->{CAPABILITY} ;
	return( $self->capability ) ;
}

