imapsync-1.945

#!/usr/bin/env perl

# $Id: imapsync,v 1.945 2019/06/26 19:30:56 gilles Exp gilles $
# structure
# pod documentation
# use pragmas
# main program
# global variables initialization
# get_options(  ) ;
# default values
# folder loop
# subroutines
# sub usage


# pod documentation

=pod

=head1 NAME

imapsync - Email IMAP tool for syncing, copying and migrating
email mailboxes between two imap servers, one way,
and without duplicates.

=head1 VERSION

This documentation refers to Imapsync $Revision: 1.945 $

=head1 USAGE

 To synchronize the source imap account
   "test1" on server "test1.lamiral.info" with password "secret1"
 to the destination imap account
   "test2" on server "test2.lamiral.info" with password "secret2"
 do:

  imapsync \
   --host1 test1.lamiral.info --user1 test1 --password1 secret1 \
   --host2 test2.lamiral.info --user2 test2 --password2 secret2

=head1 DESCRIPTION

We sometimes need to transfer mailboxes from one imap server to
one another.

Imapsync command is a tool allowing incremental and
recursive imap transfers from one mailbox to another.
If you don't understand the previous sentence, it's normal,
it's pedantic computer oriented jargon.

All folders are transferred, recursively, meaning
the whole folder hierarchy is taken, all messages in them,
and all messages flags (\Seen \Answered \Flagged etc.)
are synced too.

Imapsync reduces the amount of data transferred by not transferring
a given message if it already resides on the destination side.
Messages that are on the destination side but not on the 
source side stay as they are (see the --delete2 
option to have a strict sync).

How imapsync knows a message is already on both sides?
Same specific headers and the transfer is done only once.
By default, the identification headers are
"Message-Id:" and "Received:" lines
but this choice can be changed with the --useheader option.

All flags are preserved, unread messages will stay unread,
read ones will stay read, deleted will stay deleted.

You can abort the transfer at any time and restart it later,
imapsync works well with bad connections and interruptions,
by design. On a terminal hit Ctr-c twice within two seconds
in order to abort the program. Hit Ctr-c just once makes 
imapsync reconnect to both imap servers.

A classical scenario is synchronizing a mailbox B from another mailbox A
in case you just want to keep a strict copy of A in B. Strict meaning
all messages in A will be in B but no more.

For this, option --delete2 has to be used, it deletes messages in host2
folder B that are not in host1 folder A. If you also need to destroy
host2 folders that are not in host1 then use --delete2folders. See also
--delete2foldersonly and --delete2foldersbutnot to set up exceptions
on folders to destroy (INBOX will never be destroy, it's a mandatory
folder in IMAP).

A different scenario is to delete the messages from the source mailbox
after a successful transfer, it can be a good feature when migrating
mailboxes since messages will be only on one side. The source account
will only have messages that are not on the destination yet, ie,
messages that arrived after a sync or that failed to be copied.

In that case, use the --delete1 option. Option --delete1 implies also
option --expunge1 so all messages marked deleted on host1 will be really
deleted. In IMAP protocol deleting a message does not really delete it,
it marks it with the flag \Deleted, allowing an undelete. Expunging
a folder removes, definitively, all the messages marked as \Deleted
in this folder.

You can also decide to remove empty folders once all of their messages
have been transferred. Add --delete1emptyfolders to obtain this
behavior.


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


=head1 OPTIONS

 usage: imapsync [options]

Standard options are the six values forming the credentials, 
three on each sides, needed to log in into the IMAP servers, ie,
a host, a username, and a password, two times.

Conventions used:

 str means string
 int means integer
 reg means regular expression
 cmd means command

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

=head2 OPTIONS/credentials


 --host1        str  : Source or "from" imap server.
 --port1        int  : Port to connect on host1.
                       Optional since default ports are the 
                       well known ports 143 or 993.
 --user1        str  : User to login on host1.
 --password1    str  : Password for the user1.

 --host2        str  : "destination" imap server.
 --port2        int  : Port to connect on host2. Optional
 --user2        str  : User to login on host2.
 --password2    str  : Password for the user2.

 --showpasswords     : Shows passwords on output instead of "MASKED".
                       Useful to restart a complete run by just reading 
                       the command line used in the log,
                       or to debug passwords.
                       It's not a secure practice.

 --passfile1    str  : Password file for the user1. It must contain the
                       password on the first line. This option avoids showing
                       the password on the command line like --password1 does.
 --passfile2    str  : Password file for the user2.

You can also pass the passwords in the environment variables
IMAPSYNC_PASSWORD1 and IMAPSYNC_PASSWORD2

=head2 OPTIONS/encryption

 --nossl1            : Do not use a SSL connection on host1.
 --ssl1              : Use a SSL connection on host1. On by default if possible.

 --nossl2            : Do not use a SSL connection on host2.
 --ssl2              : Use a SSL connection on host2. On by default if possible.

 --notls1            : Do not use a TLS connection on host1.
 --tls1              : Use a TLS connection on host1. On by default if possible.

 --notls2            : Do not use a TLS connection on host2.
 --tls2              : Use a TLS connection on host2. On by default if possible.

 --debugssl     int  : SSL debug mode from 0 to 4.

 --sslargs1     str  : Pass any ssl parameter for host1 ssl or tls connection. Example:
                       --sslargs1 SSL_verify_mode=1 --sslargs1 SSL_version=SSLv3
                       See all possibilities in the new() method of IO::Socket::SSL
                       http://search.cpan.org/perldoc?IO::Socket::SSL#Description_Of_Methods
 --sslargs2     str  : Pass any ssl parameter for host2 ssl or tls connection.
                       See --sslargs1

 --timeout1     int  : Connection timeout in seconds for host1.
                       Default is 120 and 0 means no timeout at all.
 --timeout2     int  : Connection timeout in seconds for host2.
                       Default is 120 and 0 means no timeout at all.


=head2 OPTIONS/authentication

 --authmech1    str  : Auth mechanism to use with host1:
                       PLAIN, LOGIN, CRAM-MD5 etc. Use UPPERCASE.
 --authmech2    str  : Auth mechanism to use with host2. See --authmech1

 --authuser1    str  : User to auth with on host1 (admin user).
                       Avoid using --authmech1 SOMETHING with --authuser1.
 --authuser2    str  : 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.

 --authmd51          : Use MD5 authentication for host1.
 --authmd52          : Use MD5 authentication for host2.
 --domain1      str  : Domain on host1 (NTLM authentication).
 --domain2      str  : Domain on host2 (NTLM authentication).


=head2 OPTIONS/folders


 --folder       str  : Sync this folder.
 --folder       str  : and this one, etc.
 --folderrec    str  : Sync this folder recursively.
 --folderrec    str  : and this one, etc.

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

 --nomixfolders      : Do not merge folders when host1 is case-sensitive
                       while host2 is not (like Exchange). Only the first
                       similar folder is synced (example: with folders 
                       "Sent", "SENT" and "sent"
                       on host1 only "Sent" will be synced to host2).

 --skipemptyfolders  : Empty host1 folders are not created on host2.

 --include      reg  : Sync folders matching this regular expression
 --include      reg  : or this one, etc.
                       If both --include --exclude options are used, then
                       include is done before.
 --exclude      reg  : Skips folders matching this regular expression
                       Several folders to avoid:
                        --exclude 'fold1|fold2|f3' skips fold1, fold2 and f3.
 --exclude      reg  : or this one, etc.

 --automap           : guesses folders mapping, for folders well known as
                       "Sent", "Junk", "Drafts", "All", "Archive", "Flagged".

 --f1f2    str1=str2 : Force folder str1 to be synced to str2,
                       --f1f2 overrides --automap and --regextrans2.

 --subfolder2   str  : Syncs the whole host1 folders hierarchy under the
                       host2 folder named str.
                       It does it internally by adding three
                       --regextrans2 options before all others.
                       Add --debug to see what's really going on.

 --subfolder1   str  : Syncs the host1 folders hierarchy under str
                       to the root hierarchy of host2.
                       It's the couterpart of a sync done by --subfolder2
                       when doing it in the reverse order. 
                       Backup/Restore scenario:
                       Use --subfolder2 str for a backup to the folder str
                       on host2. Then use --subfolder1 str for restoring 
                       from the folder str, after inverting 
                       host1/host2 user1/user2 values.


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

 --prefix1      str  : Remove prefix str to all destination folders,
                       usually "INBOX." or "INBOX/" or an empty string "".
                       imapsync guesses the prefix if host1 imap server
                       does not have NAMESPACE capability. So this option
                       should not be used, most of the time.
 --prefix2      str  : Add prefix to all host2 folders. See --prefix1

 --sep1         str  : Host1 separator. This option should not be used, 
                       most of the time.
                       Imapsync gets the separator from the server itself,
                       by using NAMESPACE, or it tries to guess it
                       from the folders listing (it counts
                       characters / . \\ \ in folder names and choose the
                       more frequent, or finally / if nothing is found.
 --sep2         str  : Host2 separator.

 --regextrans2  reg  : Apply the whole regex to each destination folders.
 --regextrans2  reg  : 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 
                       the automatic prefix and separator inversion. 
                       For examples see:
                       https://imapsync.lamiral.info/FAQ.d/FAQ.Folders_Mapping.txt

=head2 OPTIONS/folders sizes

 --nofoldersizes     : Do not calculate the size of each folder at the
                       beginning of the sync. Default is to calculate them.
 --nofoldersizesatend: Do not calculate the size of each folder at the
                       end of the sync. Default is to calculate them.
 --justfoldersizes   : Exit after having printed the initial folder sizes.


=head2 OPTIONS/tmp


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


=head2 OPTIONS/log

 --nolog             : Turn off logging on file
 --logfile      str  : Change the default log filename (can be dirname/filename).
 --logdir       str  : Change the default log directory. Default is LOG_imapsync/


=head2 OPTIONS/messages

 --skipmess     reg  : Skips messages matching the regex.
                       Example: 'm/[\x80-ff]/' # to avoid 8bits messages.
                       --skipmess is applied before --regexmess
 --skipmess     reg  : or this one, etc.

 --pipemess     cmd  : Apply this cmd command to each message content
                       before the copy.
 --pipemess     cmd  : and this one, etc. 
                       With several --pipemess, the output of each cmd
                       command (STDOUT) is given to the input (STDIN) 
                       of the next command.
                       For example, 
                       --pipemess cmd1 --pipemess cmd2 --pipemess cmd3
                       is like a Unix pipe:
                       "cat message | cmd1 | cmd2 | cmd3"

 --disarmreadreceipts : Disarms read receipts (host2 Exchange issue)

 --regexmess    reg  : Apply the whole regex to each message before transfer.
                       Example: 's/\000/ /g' # to replace null by space.
 --regexmess    reg  : and this one, etc.


=head2 OPTIONS/flags

 If you encounter flag problems see also:
 https://imapsync.lamiral.info/FAQ.d/FAQ.Flags.txt

 --regexflag    reg  : Apply the whole regex to each flags list.
                       Example: 's/"Junk"//g' # to remove "Junk" flag.
 --regexflag    reg  : then this one, etc.

 --resyncflags       : Resync flags for already transferred messages.
                       On by default.
 --noresyncflags     : Do not resync flags for already transferred messages.
                       May be useful when a user has already started to play
                       with its host2 account.

=head2 OPTIONS/deletions

 --delete1           : Deletes messages on host1 server after a successful
                       transfer. Option --delete1 has the following behavior:
                       it marks messages as deleted with the IMAP flag
                       \Deleted, then messages are really deleted with an
                       EXPUNGE IMAP command. If expunging after each message
                       slows down too much the sync then use
                       --noexpungeaftereach to speed up, expunging will then be
                       done only twice per folder, one at the beginning and 
                       one at the end of a folder sync.

 --expunge1          : Expunge messages on host1 just before syncing a folder.
                       Expunge is done per folder.
                       Expunge aims is to really delete messages marked deleted.
                       An expunge is also done after each message copied
                       if option --delete1 is set (unless --noexpungeaftereach).

 --noexpunge1        : Do not expunge messages on host1.

 --delete1emptyfolders : Deletes empty folders on host1, INBOX excepted.
                         Useful with --delete1 since what remains on host1
                         is only what failed to be synced.

 --delete2           : Delete messages in host2 that are not in
                       host1 server. Useful for backup or pre-sync.
                       --delete2 implies --uidexpunge2

 --delete2duplicates : Delete messages in host2 that are duplicates.
                       Works only without --useuid since duplicates are
                       detected with an 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   reg : Deleted only folders matching regex.
                              Example: --delete2foldersonly "/^Junk$|^INBOX.Junk$/"

 --delete2foldersbutnot reg : Do not delete folders matching regex.
                              Example: --delete2foldersbutnot "/Tasks$|Contacts$|Foo$/"

 --noexpunge2        : Do not expunge messages on host2.
 --nouidexpunge2     : Do not uidexpunge messages on the host2 account
                       that are not on the host1 account.


=head2 OPTIONS/dates

 If you encounter problems with dates, see also:
 https://imapsync.lamiral.info/FAQ.d/FAQ.Dates.txt

 --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 (Unix mtime).
 --idatefromheader   : Sets the internal dates on host2 same as the
                       ones in "Date:" headers.
                       


=head2 OPTIONS/message selection

 --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       str  : Selects only messages returned by this IMAP SEARCH
                       command. Applied on both sides.
                       For a complete of what can be search see
                       https://imapsync.lamiral.info/FAQ.d/FAQ.Messages_Selection.txt

 --search1      str  : Same as --search but for selecting host1 messages only.
 --search2      str  : Same as --search but for selecting host2 messages only.
                       --search CRIT equals --search1 CRIT --search2 CRIT

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


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

 --usecache          : Use cache to speed up the sync.
 --nousecache        : Do not use cache. Caveat: --useuid --nousecache creates
                       duplicates on multiple runs.
 --useuid            : Use UIDs instead of headers as a criterion to recognize
                       messages. Option --usecache is then implied unless
                       --nousecache is used.


=head2 OPTIONS/miscellaneous

 --syncacls          : Synchronizes acls (Access Control Lists).
 --nosyncacls        : Does not synchronize acls. This is the default.
                       Acls in IMAP are not standardized, be careful
                       since one acl code on one side may signify something
                       else on the other one.

 --addheader         : When a message has no headers to be identified,
                       --addheader adds a "Message-Id" header,
                       like "Message-Id: 12345@imapsync", where 12345
                       is the imap UID of the message on the host1 folder.


=head2 OPTIONS/debugging

 --debug             : Debug mode.
 --debugfolders      : Debug mode for the folders part only.
 --debugcontent      : Debug content of the messages transferred. Huge output.
 --debugflags        : Debug mode for flags.
 --debugimap1        : IMAP debug mode for host1. Very verbose.
 --debugimap2        : IMAP debug mode for host2. Very verbose.
 --debugimap         : IMAP debug mode for host1 and host2. Twice very verbose.
 --debugmemory       : Debug mode showing memory consumption after each copy.

 --errorsmax     int : Exit when int number of errors is reached. Default is 50.

 --tests             : Run local non-regression tests. Exit code 0 means all ok.
 --testslive         : Run a live test with test1.lamiral.info imap server.
                       Useful to check the basics. Needs internet connection.
 --testslive6        : Run a live test with ks2ipv6.lamiral.info imap server.
                       Useful to check the ipv6 connectivity. Needs internet.


=head2 OPTIONS/specific

  --gmail1           : sets --host1 to Gmail and options from FAQ.Gmail.txt
  --gmail2           : sets --host2 to Gmail and options from FAQ.Gmail.txt

  --office1          : sets --host1 to Office365 options from FAQ.Exchange.txt
  --office2          : sets --host2 to Office365 options from FAQ.Exchange.txt

  --exchange1        : sets options from FAQ.Exchange.txt, account1 part
  --exchange2        : sets options from FAQ.Exchange.txt, account2 part

  --domino1          : sets options from FAQ.Domino.txt, account1 part
  --domino2          : sets options from FAQ.Domino.txt, account2 part


=head2 OPTIONS/behavior

 --maxmessagespersecond int : limits the number of messages transferred per second.

 --maxbytespersecond int : limits the average transfer rate per second.
 --maxbytesafter     int : starts --maxbytespersecond limitation only after
                           --maxbytesafter amount of data transferred.

 --maxsleep      int : do not sleep more than int seconds.
                       On by default, 2 seconds max, like --maxsleep 2

 --abort             : terminates a previous call still running.
                       It uses the pidfile to know what process to abort.

 --exitwhenover int  : Stop syncing and exits when int total bytes 
                       transferred is reached.

 --version           : Print only software version.
 --noreleasecheck    : Do not check for new imapsync release 
 --releasecheck      : Check for new imapsync release.
                       it's an http request to
                       http://imapsync.lamiral.info/prj/imapsync/VERSION

 --noid              : Do not send/receive ID command to imap servers.

 --justconnect       : Just connect to both servers and print useful
                       information. Need only --host1 and --host2 options.
                       Obsolete since "imapsync --host1 imaphost" alone
                       implies --justconnect
                       
 --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 "test1" on "test1.lamiral.info"
                     to  imap account "test2" on "test2.lamiral.info"
                     with test1 password "secret1"
                     and  test2 password "secret2"

 imapsync \
    --host1 test1.lamiral.info --user1 test1 --password1 secret1 \
    --host2 test2.lamiral.info --user2 test2 --password2 secret2


=cut
# comment

=pod



=head1 SECURITY

You can use --passfile1  instead of --password1 to give the
password since it is safer. With --password1 option, on Linux,
any user on your host can see the password by using the 'ps auxwwww'
command. Using a variable (like IMAPSYNC_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.

Imapsync activates ssl or tls encryption by default, if possible.

What detailed behavior is under this "if possible"?

Imapsync activates ssl if the well known port imaps port (993) is open
on the imap servers. If the imaps port is closed then it open a
normal (clear) connection on port 143 but it looks for TLS support
in the CAPABILITY list of the servers. If TLS is supported
then imapsync goes to encryption.

If the automatic ssl/tls detection fails then imapsync will
not protect against sniffing activities on the
network, especially for passwords.

If you want to force ssl or tls just use --ssl1 --ssl2 or --tls1 --tls2

See also the document FAQ.Security.txt in the FAQ.d/ directory
or at https://imapsync.lamiral.info/FAQ.d/FAQ.Security.txt

=head1 EXIT STATUS

Imapsync will exit with a 0 status (return code) if everything went good.
Otherwise, it exits with a non-zero status.
Here is the list of the exit code values (an integer between 0 and 255),
the names reflects their meaning:

=for comment
egrep '^Readonly my.*\$EX' imapsync | egrep -o 'EX.*' | sed 's_^_     _'


     EX_OK          => 0  ; #/* successful termination */
     EX_USAGE       => 64 ; #/* command line usage error */
     EX_NOINPUT     => 66 ; #/* cannot open input */
     EX_UNAVAILABLE => 69 ; #/* service unavailable */
     EX_SOFTWARE    => 70 ; #/* internal software error */
     EXIT_CATCH_ALL              =>   1 ; # Any other error
     EXIT_BY_SIGNAL              =>   6 ; # Should be 128+n where n is the sig_num
     EXIT_PID_FILE_ERROR         =>   8 ;
     EXIT_CONNECTION_FAILURE     =>  10 ;
     EXIT_TLS_FAILURE            =>  12 ;
     EXIT_AUTHENTICATION_FAILURE =>  16 ;
     EXIT_SUBFOLDER1_NO_EXISTS   =>  21 ;
     EXIT_WITH_ERRORS            => 111 ;
     EXIT_WITH_ERRORS_MAX        => 112 ;
     EXIT_TESTS_FAILED           => 254 ; # Like Test::More API


=head1 LICENSE AND COPYRIGHT

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 limits to do anything with this work and this license."

In case it is not long enough, I repeat:

 "No limits to do anything with this work and this license."

Look at https://imapsync.lamiral.info/LICENSE

=head1 AUTHOR

Gilles LAMIRAL <gilles@lamiral.info>

Good feedback good is always welcome.
Bad feedback is very often welcome.

Gilles LAMIRAL earns his living by writing, installing,
configuring and teaching free, open and often gratis
software. Imapsync used to be "always gratis" but now it is
only "often gratis" because imapsync is sold by its author,
a good way to maintain and support free open public
software over decades.

=head1 BUGS AND LIMITATIONS

See https://imapsync.lamiral.info/FAQ.d/FAQ.Reporting_Bugs.txt

=head1 IMAP SERVERS supported

See https://imapsync.lamiral.info/S/imapservers.shtml

=head1 HUGE MIGRATION

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 or batch programming !

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

=head1 INSTALL

 Imapsync works under any Unix with Perl.

 Imapsync works under most Windows (2000, XP, Vista, Seven, Eight, Ten
 and all Server releases 2000, 2003, 2008 and R2, 2012 and R2, 2016)
 as a standalone binary software called imapsync.exe,
 usually launched from a batch file in order to avoid always typing
 the options.

 Imapsync works under OS X as a standalone binary
 software called imapsync_bin_Darwin

 Purchase latest imapsync at
 https://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.
 As mentioned at https://imapsync.lamiral.info/#install
 the INSTALL file can also be found at
 https://imapsync.lamiral.info/INSTALL.d/INSTALL.ANY.txt
 It is now split in several files for each system
 https://imapsync.lamiral.info/INSTALL.d/

=head1 CONFIGURATION

There is no specific configuration file for imapsync,
everything is specified by the command line parameters
and the default behavior.


=head1 HACKING

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


=head1 SIMILAR SOFTWARE

  See also https://imapsync.lamiral.info/S/external.shtml
  for a better up to date list.

Last updated and verified on Thu Apr 11, 2019.

  imapsync         : https://github.com/imapsync/imapsync
                     (this is an imapsync copy, sometimes delayed,
                     with --noreleasecheck by default since release 1.592, 2014/05/22)
  imap_tools       : https://web.archive.org/web/20161228145952/http://www.athensfbc.com/imap_tools/
                     The imap_tools code is now at
                     https://github.com/andrewnimmo/rick-sanders-imap-tools
  imaputils        : https://github.com/mtsatsenko/imaputils (very old imap_tools fork)
  Doveadm-Sync     : https://wiki2.dovecot.org/Tools/Doveadm/Sync ( Dovecot sync tool )
  davmail          : http://davmail.sourceforge.net/
  offlineimap      : http://offlineimap.org/
  mbsync           : http://isync.sourceforge.net/
  mailsync         : http://mailsync.sourceforge.net/
  mailutil         : http://www.washington.edu/imap/ part of the UW IMAP tookit.
  imaprepl         : https://bl0rg.net/software/ http://freecode.com/projects/imap-repl/
  imapcopy (Pascal): http://www.ardiehl.de/imapcopy/
  imapcopy (Java)  : https://code.google.com/archive/p/imapcopy/
  imapsize         : http://www.broobles.com/imapsize/
  migrationtool    : http://sourceforge.net/projects/migrationtool/
  imapmigrate      : http://sourceforge.net/projects/cyrus-utils/
  larch            : https://github.com/rgrove/larch (derived from wonko_imapsync, good at Gmail)
  wonko_imapsync   : http://wonko.com/article/554 (superseded by larch)
  pop2imap         : http://www.linux-france.org/prj/pop2imap/ (I wrote that too)
  exchange-away    : http://exchange-away.sourceforge.net/
  SyncBackPro      : http://www.2brightsparks.com/syncback/sbpro.html
  ImapSyncClient   : https://github.com/ridaamirini/ImapSyncClient
  MailStore        : https://www.mailstore.com/en/products/mailstore-home/
  mnIMAPSync       : https://github.com/manusa/mnIMAPSync
  imap-upload      : http://imap-upload.sourceforge.net/
                     (a tool for uploading a local mbox file to IMAP4 server)

=head1 HISTORY

I initially wrote imapsync in July 2001 because an enterprise, 
basystemes, paid me to install a new imap server 
without losing huge old mailboxes located in a far
away remote imap server, accessible by an 
often broken low-bandwidth ISDN link.

I had to verify every mailbox was well transferred, all folders, all messages,
without wasting bandwidth or creating duplicates upon resyncs. The design was
made with the beautiful rsync command in mind.

Imapsync started its life as a patch of the copy_folder.pl
script. The script copy_folder.pl comes from the Mail-IMAPClient-2.1.3 perl
module tarball source (more precisely in the examples/ directory of the
Mail-IMAPClient tarball).

So many happened since then that I wonder
if it remains any lines of the original 
copy_folder.pl in imapsync source code.


=cut


# use pragmas
# 

use strict ;
use warnings ;
use Carp ;
use Data::Dumper ;
use Digest::HMAC_SHA1 qw( hmac_sha1 hmac_sha1_hex ) ;
use Digest::MD5  qw( md5 md5_hex md5_base64 ) ;
use English qw( -no_match_vars ) ;
use Errno qw(EAGAIN EPIPE ECONNRESET) ;
use Fcntl ;
use File::Basename ;
use File::Copy::Recursive ;
use File::Glob qw( :glob ) ;
use File::Path qw( mkpath rmtree ) ;
use File::Spec ;
use File::stat ;
use Getopt::Long (  ) ;
use IO::File ;
use IO::Socket qw( :crlf SOL_SOCKET SO_KEEPALIVE ) ;
use IO::Socket::INET6 ;
use IO::Socket::SSL ;
use IO::Tee ;
use IPC::Open3 'open3' ;
use Mail::IMAPClient 3.30 ;
use MIME::Base64 ;
use Pod::Usage qw(pod2usage) ;
use POSIX qw(uname SIGALRM) ;
use Sys::Hostname ;
use Term::ReadKey ;
use Test::More ;
use Time::HiRes qw( time sleep ) ;
use Time::Local ;
use Unicode::String ;
use Cwd ;
use Readonly ;
use Sys::MemInfo ;
use Regexp::Common ;
use Text::ParseWords;
use File::Tail ;

local $OUTPUT_AUTOFLUSH = 1 ;

# constants

# Let us do like sysexits.h
# /usr/include/sysexits.h
# and https://www.tldp.org/LDP/abs/html/exitcodes.html

# Should avoid 2 126 127 128..128+64=192 255
# Should use   0 1 3..125 193..254

Readonly my $EX_OK          => 0  ; #/* successful termination */
Readonly my $EX_USAGE       => 64 ; #/* command line usage error */
#Readonly my $EX_DATAERR     => 65 ; #/* data format error */
Readonly my $EX_NOINPUT     => 66 ; #/* cannot open input */
#Readonly my $EX_NOUSER      => 67 ; #/* addressee unknown */
#Readonly my $EX_NOHOST      => 68 ; #/* host name unknown */
Readonly my $EX_UNAVAILABLE => 69 ; #/* service unavailable */
Readonly my $EX_SOFTWARE    => 70 ; #/* internal software error */
#Readonly my $EX_OSERR       => 71 ; #/* system error (e.g., can't fork) */
#Readonly my $EX_OSFILE      => 72 ; #/* critical OS file missing */
#Readonly my $EX_CANTCREAT   => 73 ; #/* can't create (user) output file */
#Readonly my $EX_IOERR       => 74 ; #/* input/output error */
#Readonly my $EX_TEMPFAIL    => 75 ; #/* temp failure; user is invited to retry */
#Readonly my $EX_PROTOCOL    => 76 ; #/* remote error in protocol */
#Readonly my $EX_NOPERM      => 77 ; #/* permission denied */
#Readonly my $EX_CONFIG      => 78 ; #/* configuration error */

# Mine
Readonly my $EXIT_CATCH_ALL              =>   1 ; # Any other error
Readonly my $EXIT_BY_SIGNAL              =>   6 ; # Should be 128+n where n is the sig_num
Readonly my $EXIT_PID_FILE_ERROR         =>   8 ;
Readonly my $EXIT_CONNECTION_FAILURE     =>  10 ;
Readonly my $EXIT_TLS_FAILURE            =>  12 ;
Readonly my $EXIT_AUTHENTICATION_FAILURE =>  16 ;
Readonly my $EXIT_SUBFOLDER1_NO_EXISTS   =>  21 ;
Readonly my $EXIT_WITH_ERRORS            => 111 ;
Readonly my $EXIT_WITH_ERRORS_MAX        => 112 ;


Readonly my $EXIT_TESTS_FAILED           => 254 ; # Like Test::More API


Readonly my %EXIT_TXT => (
        $EX_OK                       => 'EX_OK: successful termination',
        $EX_USAGE                    => 'EX_USAGE: command line usage error',
        $EX_NOINPUT                  => 'EX_NOINPUT: cannot open input',
        $EX_UNAVAILABLE              => 'EX_UNAVAILABLE: service unavailable',
        $EX_SOFTWARE                 => 'EX_SOFTWARE: internal software error',
        
        $EXIT_CATCH_ALL              => 'EXIT_CATCH_ALL',
        $EXIT_BY_SIGNAL              => 'EXIT_BY_SIGNAL',
        $EXIT_PID_FILE_ERROR         => 'EXIT_PID_FILE_ERROR' ,
        $EXIT_CONNECTION_FAILURE     => 'EXIT_CONNECTION_FAILURE',
        $EXIT_TLS_FAILURE            => 'EXIT_TLS_FAILURE',
        $EXIT_AUTHENTICATION_FAILURE => 'EXIT_AUTHENTICATION_FAILURE',
        $EXIT_SUBFOLDER1_NO_EXISTS   => 'EXIT_SUBFOLDER1_NO_EXISTS',
        $EXIT_WITH_ERRORS            => 'EXIT_WITH_ERRORS',
        $EXIT_WITH_ERRORS_MAX        => 'EXIT_WITH_ERRORS_MAX',
        $EXIT_TESTS_FAILED           => 'EXIT_TESTS_FAILED',
) ;




Readonly my $DEFAULT_LOGDIR => 'LOG_imapsync' ;

Readonly my $ERRORS_MAX     =>  50 ; # exit after 50 errors.
Readonly my $ERRORS_MAX_CGI =>  20 ; # exit after 20 errors in CGI context.



Readonly my $INTERVAL_TO_EXIT => 2 ; # interval max to exit instead of reconnect

Readonly my $SPLIT        => 100 ; # By default, 100 at a time, not more.
Readonly my $SPLIT_FACTOR =>  10 ; # init_imap() calls Maxcommandlength( $SPLIT_FACTOR * $split )
                                   # which means default Maxcommandlength is 10*100 = 1000 characters ;

Readonly my $IMAP_PORT     => 143 ; # Well know port for IMAP
Readonly my $IMAP_SSL_PORT => 993 ; # Well know port for IMAP over SSL

Readonly my $LAST => -1 ;
Readonly my $MINUS_ONE => -1 ;
Readonly my $MINUS_TWO => -2 ;

Readonly my $RELEASE_NUMBER_EXAMPLE_1 => '1.351' ;
Readonly my $RELEASE_NUMBER_EXAMPLE_2 => 42.4242 ;

Readonly my $TCP_PING_TIMEOUT => 5 ;
Readonly my $DEFAULT_TIMEOUT => 120 ;
Readonly my $DEFAULT_NB_RECONNECT_PER_IMAP_COMMAND => 3 ;
Readonly my $DEFAULT_UIDNEXT => 999_999 ;
Readonly my $DEFAULT_BUFFER_SIZE => 4096 ;

Readonly my $MAX_SLEEP => 2 ; # 2 seconds max for limiting too long sleeps from --maxbytespersecond and --maxmessagespersecond

Readonly my $DEFAULT_EXPIRATION_TIME_OAUTH2_PK12 => 3600 ;

Readonly my $PERMISSION_FILTER => 7777 ;

Readonly my $KIBI => 1024 ;

Readonly my $NUMBER_10 => 10 ;
Readonly my $NUMBER_42 => 42 ;
Readonly my $NUMBER_100 => 100 ;
Readonly my $NUMBER_200 => 200 ;
Readonly my $NUMBER_300 => 300 ;
Readonly my $NUMBER_123456 => 123456 ;
Readonly my $NUMBER_654321 => 654321 ;

Readonly my $NUMBER_20_000 => 20_000 ;

Readonly my $QUOTA_PERCENT_LIMIT => 90 ;

Readonly my $NUMBER_104_857_600 => 104_857_600 ;

Readonly my $SIZE_MAX_STR => 64 ;

Readonly my $NB_SECONDS_IN_A_DAY => 86_400 ;

Readonly my $STD_CHAR_PER_LINE => 80 ;

Readonly my $TRUE  => 1 ;
Readonly my $FALSE => 0 ;

Readonly my $LAST_RESSORT_SEPARATOR => q{/} ;

Readonly my $CGI_TMPDIR_TOP => '/var/tmp/imapsync_cgi' ;
Readonly my $CGI_HASHFILE   => '/var/tmp/imapsync_hash' ;
Readonly my $UMASK_PARANO   => '0077' ;

Readonly my $STR_use_releasecheck => q{Check if a new imapsync release is available by adding --releasecheck} ;

Readonly my $GMAIL_MAXSIZE => 35_651_584 ;


# if ( 'MSWin32' eq $OSNAME )
# if ( 'darwin' eq $OSNAME )
# if ( 'linux' eq $OSNAME )



# global variables
# Currently working to finish with only $sync
# Not finished yet...

my(
        $sync,
        $debugimap, $debugimap1, $debugimap2, $debugcontent, $debugflags,
        $debuglist, $debugdev, $debugmaxlinelength, $debugcgi,
        $domain1, $domain2,
        @include, @exclude, @folderrec,
        @folderfirst, @folderlast,
        $prefix1, $prefix2,
        @regexmess, @regexflag, @skipmess, @pipemess, $pipemesscheck,
        $flagscase, $filterflags, $syncflagsaftercopy,
        $syncinternaldates,
        $idatefromheader,
        $syncacls,
        $fastio1, $fastio2,
        $minsize, $maxage, $minage,
        $search, $search1, $search2,
        $skipheader, @useheader,
        $skipsize, $allowsizemismatch, $foldersizes, $foldersizesatend, $buffersize,


        $authmd5, $authmd51, $authmd52,
        $subscribed, $subscribe, $subscribeall,
        $help,
        $justbanner,
        $fast,

        $nb_msg_skipped_dry_mode,
        $h1_nb_msg_duplicate,
        $h2_nb_msg_duplicate,
        $h2_nb_msg_noheader,

        $h2_nb_msg_deleted,

        $h1_bytes_processed,

        $h1_nb_msg_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_int,
        $timebefore,
        $uid1, $uid2,
        $authuser1, $authuser2,
        $proxyauth1, $proxyauth2,
        $authmech1, $authmech2,
        $split1, $split2,
        $reconnectretry1, $reconnectretry2,
        $max_msg_size_in_bytes,
        $modulesversion,
        $delete2folders, $delete2foldersonly, $delete2foldersbutnot,
        $usecache, $debugcache, $cacheaftercopy,
        $wholeheaderifneeded, %h1_msgs_copy_by_uid, $useuid, $h2_uidguess,
        $checkmessageexists,
        $messageidnodomain,
        $fixInboxINBOX,
        $maxlinelength, $maxlinelengthcmd,
        $minmaxlinelength,
        $uidnext_default,
        $fixcolonbug,
        $create_folder_old,
        $skipcrossduplicates, $debugcrossduplicates,
        $disarmreadreceipts,
        $mixfolders, $skipemptyfolders,
        $fetch_hash_set,
) ;


# main program
# global variables initialization

# I'm currently removing all global variables except $sync
# passing each of them under $sync->{variable_name}

$sync->{timestart} = time ; # Is a float because of use Time::HiRres

$sync->{rcs} = q{$Id: imapsync,v 1.945 2019/06/26 19:30:56 gilles Exp gilles $} ;

$sync->{ memory_consumption_at_start } = memory_consumption(  ) || 0 ;


my @loadavg = loadavg(  ) ;

$sync->{cpu_number} = cpu_number(  ) ;
$sync->{loaddelay} = load_and_delay( $sync->{cpu_number}, @loadavg ) ;
$sync->{loadavg} = join( q{ }, $loadavg[ 0 ] )
                   . " on $sync->{cpu_number} cores and "
                   . ram_memory_info(  ) ;



$sync->{ total_bytes_transferred } = 0 ;
$sync->{ total_bytes_skipped } = 0 ;
$sync->{ nb_msg_transferred } = 0 ;
$sync->{ nb_msg_skipped } = $nb_msg_skipped_dry_mode = 0 ;
$sync->{ h1_nb_msg_deleted } = 0 ;
$h2_nb_msg_deleted  = 0 ;
$h1_nb_msg_duplicate = 0 ;
$h2_nb_msg_duplicate = 0 ;
$sync->{ h1_nb_msg_noheader } = 0 ;
$h2_nb_msg_noheader = 0 ;


$h1_nb_msg_start  = $h1_bytes_start = 0 ;
$h2_nb_msg_start     = $h2_bytes_start = 0 ;
$sync->{ h1_nb_msg_processed } = $h1_bytes_processed = 0 ;

$sync->{ h2_nb_msg_crossdup } = 0 ;

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

$sync->{nb_errors} = 0;
$max_msg_size_in_bytes = 0;

my %month_abrev = (
   Jan => '00',
   Feb => '01',
   Mar => '02',
   Apr => '03',
   May => '04',
   Jun => '05',
   Jul => '06',
   Aug => '07',
   Sep => '08',
   Oct => '09',
   Nov => '10',
   Dec => '11',
);


my $cgidir ;

# Just create a CGI object if under cgi context only.
# Needed for the get_options() call
cgibegin( $sync ) ;

# In cgi context, printing must start by the header so we delay other prints by using output() storage
my $options_good = get_options( $sync, @ARGV ) ;
# Is it the first myprint?
docker_context( $sync ) ;
cgibuildheader( $sync ) ;

myprint( output( $sync ) ) ;
output_reset_with( $sync ) ;

# Old place for cgiload( $sync ) ;

# don't go on if options are not all known.
if ( ! defined $options_good ) { exit $EX_USAGE ; }

# If you want releasecheck not to be done by default (like the github maintainer),
# then just uncomment the first "$sync->{releasecheck} =" line, the line ending with "0 ;",
# the second line (ending with "1 ;") can then stay active or be commented,
# the result will be the same: no releasecheck by default (because 0 is then the defined value).

#$sync->{releasecheck} = defined  $sync->{releasecheck}  ? $sync->{releasecheck} : 0 ;
$sync->{releasecheck} = defined  $sync->{releasecheck}  ? $sync->{releasecheck} : 1 ;

# just the version
if ( $sync->{ version } ) {
        myprint( imapsync_version( $sync ), "\n" ) ;
        exit 0 ;
}

$sync->{debugenv} and printenv( $sync ) ; # if option --debugenv
load_modules(  ) ;

# after_get_options call usage and exit if --help or options were not well got
after_get_options( $sync, $options_good ) ;


# Under CGI environment, fix caveat emptor potential issues
cgisetcontext( $sync ) ;

# --gmail --gmail --exchange --office etc.
easyany( $sync ) ;

$sync->{ sanitize } = defined $sync->{ sanitize } ? $sync->{ sanitize } : 1 ;
sanitize( $sync ) ;

$sync->{ tmpdir } ||= File::Spec->tmpdir(  ) ;

# Unit tests
testsexit( $sync ) ;

# init live varaiables
testslive( $sync ) if ( $sync->{testslive} ) ;
testslive6( $sync ) if ( $sync->{testslive6} )  ;

#

$sync->{pidfile} =  defined  $sync->{pidfile}  ? $sync->{pidfile} : $sync->{ tmpdir } . '/imapsync.pid' ;
$sync->{pidfilelocking} = defined  $sync->{pidfilelocking}  ? $sync->{pidfilelocking} : 0 ;

# old abort place

# Unix signals
@{ $sync->{ sigexit } }      = ( defined( $sync->{ sigexit } ) )      ? @{ $sync->{ sigexit } }      : ( 'QUIT', 'TERM' ) ;
@{ $sync->{ sigreconnect } } = ( defined( $sync->{ sigreconnect } ) ) ? @{ $sync->{ sigreconnect } } : ( 'INT' ) ;
@{ $sync->{ sigprint } }     = ( defined( $sync->{ sigprint } ) )     ? @{ $sync->{ sigprint } }     : ( 'HUP' ) ;
@{ $sync->{ sigignore } }    = ( defined( $sync->{ sigignore } ) )    ? @{ $sync->{ sigignore } }    : ( ) ;

local %SIG = %SIG ;
sig_install( $sync, 'catch_exit',      @{ $sync->{ sigexit      } } ) ;
sig_install( $sync, 'catch_reconnect', @{ $sync->{ sigreconnect } } ) ;
sig_install( $sync, 'catch_print',     @{ $sync->{ sigprint     } } ) ;
# --sigignore can override sigexit, sigreconnect and sigprint (for the same signals only)
sig_install( $sync, 'catch_ignore',    @{ $sync->{ sigignore }  } ) ;

sig_install_toggle_sleep( $sync ) ;


$sync->{log}        = defined $sync->{log}        ? $sync->{log}        :  1 ;
$sync->{errorsdump} = defined $sync->{errorsdump} ? $sync->{errorsdump} :  1 ;
$sync->{errorsmax}  = defined $sync->{errorsmax}  ? $sync->{errorsmax}  : $ERRORS_MAX ;

# log and output
if ( $sync->{log} ) {
        setlogfile( $sync ) ;
        teelaunch( $sync ) ;
        # now $sync->{tee} is a filehandle to STDOUT and the logfile
}
# STDERR goes to the same place: LOG and STDOUT (if logging is on)
$sync->{tee} and local *STDERR = *${$sync->{tee}}{IO} ;



$timestart_int = int( $sync->{timestart} ) ;
$timebefore =    $sync->{timestart} ;


my $timestart_str = localtime( $sync->{timestart} ) ;

# The prints in the log starts here

myprint( localhost_info( $sync ), "\n" ) ;
myprint( "Transfer started at $timestart_str\n" ) ;
myprint( "PID is $PROCESS_ID my PPID is ", mygetppid(  ), "\n" ) ;
myprint( "Log file is $sync->{logfile} ( to change it, use --logfile path ; or use --nolog to turn off logging )\n" ) if ( $sync->{log} ) ;
myprint( "Load is " . ( join( q{ }, loadavg(  ) ) || 'unknown' ), " on $sync->{cpu_number} cores\n" ) ;
#myprintf( "Memory consumption so far: %.1f MiB\n", memory_consumption(  ) / $KIBI / $KIBI ) ;
myprint( 'Current directory is ' . getcwd(  ) . "\n" ) ;
myprint( 'Real user id is ' . getpwuid_any_os( $REAL_USER_ID ) . " (uid $REAL_USER_ID)\n" ) ;
myprint( 'Effective user id is ' . getpwuid_any_os( $EFFECTIVE_USER_ID ). " (euid $EFFECTIVE_USER_ID)\n" ) ;

$modulesversion = defined  $modulesversion  ? $modulesversion : 1 ;

my $warn_release = ( $sync->{releasecheck} ) ? check_last_release(  ) : $STR_use_releasecheck ;


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

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

$sync->{ checkselectable } = defined $sync->{ checkselectable } ? $sync->{ checkselectable } : 1 ;
$sync->{ checkfoldersexist } = defined $sync->{ checkfoldersexist } ? $sync->{ checkfoldersexist } : 1 ;
$checkmessageexists = defined  $checkmessageexists  ? $checkmessageexists : 0 ;
$sync->{ expungeaftereach }   = defined  $sync->{ expungeaftereach }  ? $sync->{ expungeaftereach } : 1 ;

# abletosearch is on by default
$sync->{abletosearch}    = defined  $sync->{abletosearch}   ? $sync->{abletosearch} : 1 ;
$sync->{abletosearch1}   = defined  $sync->{abletosearch1}  ? $sync->{abletosearch1} : $sync->{abletosearch} ;
$sync->{abletosearch2}   = defined  $sync->{abletosearch2}  ? $sync->{abletosearch2} : $sync->{abletosearch} ;
$checkmessageexists      = 0 if ( not $sync->{abletosearch1} ) ;


$sync->{showpasswords}   = defined  $sync->{showpasswords}  ? $sync->{showpasswords} : 0 ;
$sync->{ fixslash2 }     = defined  $sync->{ fixslash2 }  ? $sync->{ fixslash2 } : 1 ;
$fixInboxINBOX      = defined  $fixInboxINBOX  ? $fixInboxINBOX : 1 ;
$create_folder_old  = defined  $create_folder_old  ? $create_folder_old : 0 ;
$mixfolders         = defined  $mixfolders  ? $mixfolders : 1 ;
$sync->{automap}    = defined  $sync->{automap}  ? $sync->{automap} : 0 ;

$sync->{ delete2duplicates } = 1 if ( $sync->{ delete2 } and ( ! defined  $sync->{ delete2duplicates }  ) ) ;

$sync->{maxmessagespersecond} = defined  $sync->{maxmessagespersecond}  ? $sync->{maxmessagespersecond} : 0 ;
$sync->{maxbytespersecond}    = defined  $sync->{maxbytespersecond}     ? $sync->{maxbytespersecond}    : 0 ;

$sync->{sslcheck} = defined $sync->{sslcheck} ? $sync->{sslcheck} : 1 ;

myprint( banner_imapsync( $sync, @ARGV ) ) ;

myprint( "Temp directory is $sync->{ tmpdir } ( to change it use --tmpdir dirpath )\n" ) ;

myprint( output( $sync ) ) ;
output_reset_with( $sync ) ;

do_valid_directory( $sync->{ tmpdir } ) || croak "Error creating tmpdir $sync->{ tmpdir } : $OS_ERROR" ;

remove_pidfile_not_running( $sync->{pidfile} ) ;

# if another imapsync is running then tail -f its logfile and exit
# useful in cgi context
if ( $sync->{tail} and tail( $sync ) )
{
        myprint( "Tail -f finished. Now finishing myself processus $PROCESS_ID\n" ) ;
        exit_clean( $sync, $EX_OK ) ;
        exit $EX_OK ;
}

if ( ! write_pidfile( $sync ) ) {
        myprint( "Exiting with return value $EXIT_PID_FILE_ERROR ($EXIT_TXT{$EXIT_PID_FILE_ERROR})\n" ) ;
        exit $EXIT_PID_FILE_ERROR ;
}


# New place for abort
# abort before simulong in order to be able to abort a simulong sync
if ( $sync->{ abort } )
{
        abort( $sync ) ;
}

# simulong is just a loop printing some lines for xx seconds with option "--simulong xx".
if ( $sync->{ simulong } )
{
        simulong( $sync->{ simulong } ) ;
}


# New place for cgiload 2019_03_03
# because I want to log it
# Can break here if load is too heavy
cgiload( $sync ) ;


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

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

$modulesversion and myprint( "Modules version list:\n", modulesversion(), "( use --no-modulesversion to turn off printing this Perl modules list )\n" ) ;


check_lib_version( $sync ) or
  croak "imapsync needs perl lib Mail::IMAPClient release 3.30 or superior.\n";


exit_clean( $sync, $EX_OK ) if ( $justbanner ) ;

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

# update flags on host2 for already transferred messages
$sync->{resyncflags} = defined  $sync->{resyncflags} ? $sync->{resyncflags} : 1 ;
if ( $sync->{resyncflags} ) {
        myprint( "Info: will resync flags for already transferred messages. Use --noresyncflags to not resync flags.\n" ) ;
}else{
        myprint( "Info: will not resync flags for already transferred messages. Use --resyncflags to resync flags.\n" ) ;
}


sslcheck( $sync ) ;
#print Data::Dumper->Dump( [ \$sync ] ) ;

$split1 ||= $SPLIT ;
$split2 ||= $SPLIT ;

#$sync->{host1} || missing_option( $sync, '--host1' ) ;
$sync->{port1} ||= ( $sync->{ssl1} ) ? $IMAP_SSL_PORT : $IMAP_PORT ;

#$sync->{host2} || missing_option( $sync, '--host2' ) ;
$sync->{port2} ||= ( $sync->{ssl2} ) ? $IMAP_SSL_PORT : $IMAP_PORT ;

$debugimap1 = $debugimap2 = 1 if ( $debugimap ) ;
$sync->{ 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;


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


my $SSL_VERIFY_POLICY ;
my %SSL_VERIFY_STR ;

Readonly $SSL_VERIFY_POLICY => IO::Socket::SSL::SSL_VERIFY_NONE(  ) ;
Readonly %SSL_VERIFY_STR => (
	IO::Socket::SSL::SSL_VERIFY_NONE(  ) => 'SSL_VERIFY_NONE, ie, do not check the certificate server.' ,
	IO::Socket::SSL::SSL_VERIFY_PEER(  ) => 'SSL_VERIFY_PEER, ie, check the certificate server' ,
) ;

$IO::Socket::SSL::DEBUG = defined( $sync->{debugssl} ) ? $sync->{debugssl} : 1 ;


if ( $sync->{ssl1} or $sync->{ssl2} or $sync->{tls1} or $sync->{tls2}) {
        myprint( "SSL debug mode level is --debugssl $IO::Socket::SSL::DEBUG (can be set from 0 meaning no debug to 4 meaning max debug)\n" ) ;
}

if ( $sync->{ssl1} ) {
        myprint( qq{Host1: SSL default mode is like --sslargs1 "SSL_verify_mode=$SSL_VERIFY_POLICY", meaning for host1 $SSL_VERIFY_STR{$SSL_VERIFY_POLICY}\n} ) ;
        myprint( 'Host1: Use --sslargs1 SSL_verify_mode=' . IO::Socket::SSL::SSL_VERIFY_PEER(  ) . " to have $SSL_VERIFY_STR{IO::Socket::SSL::SSL_VERIFY_PEER(  )} of host1\n" ) ;
}

if ( $sync->{ssl2} ) {
        myprint( qq{Host2: SSL default mode is like --sslargs2 "SSL_verify_mode=$SSL_VERIFY_POLICY", meaning for host2 $SSL_VERIFY_STR{$SSL_VERIFY_POLICY}\n} ) ;
        myprint( 'Host2: Use --sslargs2 SSL_verify_mode=' . IO::Socket::SSL::SSL_VERIFY_PEER(  ) . " to have $SSL_VERIFY_STR{IO::Socket::SSL::SSL_VERIFY_PEER(  )} of host2\n" ) ;
}


if ( $sync->{justconnect} 
        or not $sync->{user1} 
        or not $sync->{user2}
        or not $sync->{host1}
        or not $sync->{host2}
        )
{
        my $justconnect = justconnect( $sync ) ;
        myprint( debugmemory( $sync, " after justconnect() call" ) ) ;
        exit_clean( $sync, $EX_OK, "Exiting after a justconnect on host(s): $justconnect\n" ) ;
}


#$sync->{user1} || missing_option( $sync, '--user1' ) ;
#$sync->{user2} || missing_option( $sync, '--user2' ) ;

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

# Turn on expunge if there is not explicit option --noexpunge1 and option
# --delete1 is given.
# Done because --delete1 --noexpunge1 is very dangerous on the second run:
# the Deleted flag is then synced to all previously transferred messages.
# So --delete1 implies --expunge1 is a better usability default behavior.
if ( $sync->{ delete1 } ) {
        if ( ! defined  $sync->{ expunge1 }  ) {
                myprint( "Info: turning on --expunge1 because --delete1 --noexpunge1 is very dangerous on the second run.\n" ) ;
                $sync->{ expunge1 } = 1 ;
        }
                myprint( "Info: if expunging after each message slows down too much the sync then use --noexpungeaftereach to speed up\n" ) ;
}

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

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

if ( $sync->{ delete1 } and $sync->{ delete2 } ) {
        myprint( "Warning: using --delete1 and --delete2 together is almost always a bad idea, exiting imapsync\n" ) ;
        exit_clean( $sync, $EX_USAGE ) ;
}

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

if ( $syncinternaldates ) {
        myprint( 'Info: turned ON syncinternaldates, ',
              "will set the internal dates (arrival dates) on host2 same as host1.\n" ) ;
}else{
        myprint( "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( $sync, 'With --proxyauth1, --authuser1' ) ;
}

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

$authuser1 ||= $sync->{user1};
$authuser2 ||= $sync->{user2};

myprint( "Host1: will try to use $authmech1 authentication on host1\n") ;
myprint( "Host2: will try to use $authmech2 authentication on host2\n") ;

$timeout = defined  $timeout  ? $timeout : $DEFAULT_TIMEOUT ;

$sync->{h1}->{timeout} = defined  $sync->{h1}->{timeout}  ? $sync->{h1}->{timeout} : $timeout ;
myprint( "Host1: imap connection timeout is $sync->{h1}->{timeout} seconds\n") ;
$sync->{h2}->{timeout} = defined  $sync->{h2}->{timeout}  ? $sync->{h2}->{timeout} : $timeout ;
myprint( "Host2: imap connection timeout is $sync->{h2}->{timeout} seconds\n" ) ;

$syncacls = defined  $syncacls  ? $syncacls : 0 ;

# No folders sizes if --justfolders, unless really wanted.
if ( $sync->{ justfolders } and not defined  $foldersizes and not $sync->{ justfoldersizes } ) { $foldersizes = 0 ; $foldersizesatend = 1 ; }

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

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

$reconnectretry1 = defined  $reconnectretry1  ? $reconnectretry1 : $DEFAULT_NB_RECONNECT_PER_IMAP_COMMAND ;
$reconnectretry2 = defined  $reconnectretry2  ? $reconnectretry2 : $DEFAULT_NB_RECONNECT_PER_IMAP_COMMAND ;

# 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 = $DEFAULT_UIDNEXT ;

if ( ! @useheader ) { @useheader = qw( Message-Id Received )  ; }

my %useheader ;

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

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

myprint( "Host1: IMAP server [$sync->{host1}] port [$sync->{port1}] user [$sync->{user1}]\n" ) ;
myprint( "Host2: IMAP server [$sync->{host2}] port [$sync->{port2}] user [$sync->{user2}]\n" ) ;

get_password1( $sync ) ;
get_password2( $sync ) ;


$sync->{dry_message} = q{} ;
if( $sync->{dry} ) {
        $sync->{dry_message} = "\t(not really since --dry mode)" ;
}

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

if ( $disarmreadreceipts ) {
        push @regexmess, q{s{\A((?:[^\n]+\r\n)+|)(^Disposition-Notification-To:[^\n]*\n)(\r?\n|.*\n\r?\n)}{$1X-$2$3}ims} ;
}

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

if ( @pipemess and $pipemesscheck ) {
        myprint( 'Checking each --pipemess command, '
                . join( q{, }, @pipemess )
                . ", with an space string. ( Can avoid this check with --nopipemesscheck )\n" ) ;
        my $string = pipemess( q{ }, @pipemess ) ;
        # string undef means something was bad.
        if ( not ( defined  $string  ) ) {
                exit_clean( $sync, $EX_USAGE, "Error: one of --pipemess command is bad, check it\n" ) ;
        }
        myprint( "Ok with each --pipemess @pipemess\n"  ) ;
}

if ( $maxlinelengthcmd ) {
        myprint( "Checking --maxlinelengthcmd command,  $maxlinelengthcmd, with an space string.\n"  ) ;
        my $string = pipemess( q{ }, $maxlinelengthcmd ) ;
        # string undef means something was bad.
        if ( not ( defined  $string  ) ) {
                exit_clean( $sync, $EX_USAGE, "Error: --maxlinelengthcmd command is bad, check it\n" ) ;
        }
        myprint( "Ok with --maxlinelengthcmd $maxlinelengthcmd\n"  ) ;
}

if ( @regexmess ) {
        my $string = regexmess( q{ } ) ;
        myprint( "Checking each --regexmess command with an space string.\n"  ) ;
        # string undef means one of the eval regex was bad.
        if ( not ( defined  $string  ) ) {
                exit_clean( $sync, $EX_USAGE, 'Error: one of --regexmess option is bad, check it' ) ;
        }
        myprint( "Ok with each --regexmess\n"  ) ;
}

if ( @skipmess ) {
        myprint( "Checking each --skipmess command with an space string.\n"  ) ;
        my $match = skipmess( q{ } ) ;
        # match undef means one of the eval regex was bad.
        if ( not ( defined  $match  ) ) {
                exit_clean( $sync, $EX_USAGE, 'Error: one of --skipmess option is bad, check it' ) ;
        }
        myprint( "Ok with each --skipmess\n"  ) ;
}

if ( @regexflag ) {
        myprint( "Checking each --regexflag command with an space string.\n"  ) ;
        my $string = flags_regex( q{ } ) ;
        # string undef means one of the eval regex was bad.
        if ( not ( defined  $string  ) ) {
                exit_clean( $sync, $EX_USAGE, 'Error: one of --regexflag option is bad, check it' ) ;
        }
        myprint( "Ok with each --regexflag\n"  ) ;
}

$sync->{imap1} = login_imap( $sync->{host1}, $sync->{port1}, $sync->{user1}, $domain1, $sync->{password1},
                   $debugimap1, $sync->{h1}->{timeout}, $fastio1, $sync->{ssl1}, $sync->{tls1},
                   $authmech1, $authuser1, $reconnectretry1,
                   $proxyauth1, $uid1, $split1, 'Host1', $sync->{h1}, $sync ) ;

$sync->{imap2} = login_imap( $sync->{host2}, $sync->{port2}, $sync->{user2}, $domain2, $sync->{password2},
                 $debugimap2, $sync->{h2}->{timeout}, $fastio2, $sync->{ssl2}, $sync->{tls2},
                 $authmech2, $authuser2, $reconnectretry2,
                 $proxyauth2, $uid2, $split2, 'Host2', $sync->{h2}, $sync ) ;


$sync->{ debug } and myprint( 'Host1 Buffer I/O: ', $sync->{imap1}->Buffer(), "\n" ) ;
$sync->{ debug } and myprint( 'Host2 Buffer I/O: ', $sync->{imap2}->Buffer(), "\n" ) ;


if ( ! $sync->{imap1}->IsAuthenticated( ) ) { exit_clean( $sync, $EXIT_AUTHENTICATION_FAILURE, 'Not authenticated on host1' )  ; }
myprint( "Host1: state Authenticated\n" ) ;
if ( ! $sync->{imap2}->IsAuthenticated( ) ) { exit_clean( $sync, $EXIT_AUTHENTICATION_FAILURE, 'Not authenticated on host2' )  ; }
myprint( "Host2: state Authenticated\n" ) ;

myprint( 'Host1 capability once authenticated: ', join(q{ }, @{ $sync->{imap1}->capability() || [] }), "\n" ) ;

#myprint( Data::Dumper->Dump( [ $sync->{imap1} ] )  ) ;
#myprint( "imap4rev1: " . $sync->{imap1}->imap4rev1() . "\n" ) ;

myprint( 'Host2 capability once authenticated: ', join(q{ }, @{ $sync->{imap2}->capability() || [] }), "\n" ) ;


# ID on by default since 1.832
$sync->{id} = defined  $sync->{id}  ? $sync->{id} : 1 ;
imap_id_stuff( $sync ) ;

#quota( $sync, $sync->{imap1}, 'h1' ) ; # quota on host1 is useless and pollute host2 output.
quota( $sync, $sync->{imap2}, 'h2' )  ;

maxsize_setting( $sync ) ;

if ( $sync->{ justlogin } ) {
        $sync->{imap1}->logout(  ) ;
        $sync->{imap2}->logout(  ) ;
        myprint( "Exiting because of --justlogin\n" ) ;
        exit_clean( $sync, $EX_OK ) ;
}


#
# 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 ,
) ;

my $h1_folders_wanted_nb = 0 ;
my $h1_folders_wanted_ct = 0 ; # counter of folders done.

# All folders on host1 and host2

@h1_folders_all = sort $sync->{imap1}->folders(  ) ;
@h2_folders_all = sort $sync->{imap2}->folders(  ) ;

myprint( 'Host1: found ', scalar  @h1_folders_all , " folders.\n"  ) ;
myprint( 'Host2: found ', scalar  @h2_folders_all , " folders.\n"  ) ;

foreach my $f ( @h1_folders_all ) {
	$h1_folders_all{ $f } = 1
}
foreach my $f ( @h2_folders_all ) {
        $h2_folders_all{ $f } = 1 ;
        $h2_folders_all_UPPER{ uc  $f  } = 1 ;
}

$sync->{h1_folders_all} = \%h1_folders_all ;
$sync->{h2_folders_all} = \%h2_folders_all ;
$sync->{h2_folders_all_UPPER} = \%h2_folders_all_UPPER ;

private_folders_separators_and_prefixes(  ) ;


# Make a hash of subscribed folders in both servers.

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


if ( defined $sync->{ subfolder1 } ) {
        subfolder1( $sync ) ;
}




if ( defined  $sync->{ subfolder2 } ) {
        subfolder2(  $sync ) ;
}

if ( $fixInboxINBOX and ( my $reg = fix_Inbox_INBOX_mapping( \%h1_folders_all, \%h2_folders_all ) ) ) {
        push @{ $sync->{ regextrans2 } }, $reg ;
}



if ( ( $sync->{ folder } and scalar @{ $sync->{ folder } } )
     or $subscribed
     or scalar @folderrec )
{
        # folders given by option --folder
        if ( $sync->{ folder } and scalar @{ $sync->{ folder } } ) {
                add_to_requested_folders( @{ $sync->{ 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( $sync->{imap1}->folders( $folderrec ) ) ;
                }
        }
}
else
{
        # no include, no folder/subscribed/folderrec options => all folders
        if ( not scalar @include ) {
                myprint( "Including all folders found by default. Use --subscribed or --folder or --folderrec or --include to select specific folders. Use --exclude to unselect specific folders.\n"  ) ;
                add_to_requested_folders( @h1_folders_all ) ;
        }
}


# consider (optional) includes and excludes
if ( scalar  @include  ) {
        foreach my $include ( @include ) {
                my @included_folders = grep { /$include/ } @h1_folders_all ;
                add_to_requested_folders( @included_folders ) ;
                myprint( "Including folders matching pattern $include\n" . jux_utf8_list( @included_folders )  . "\n"  ) ;
        }
}

if ( scalar  @exclude  ) {
        foreach my $exclude ( @exclude ) {
                my @requested_folder = sort keys %requested_folder ;
                my @excluded_folders = grep { /$exclude/ } @requested_folder ;
                remove_from_requested_folders( @excluded_folders ) ;
                myprint( "Excluding folders matching pattern $exclude\n" . jux_utf8_list( @excluded_folders ) . "\n"  ) ;
        }
}


# sort before is not very powerful
# it adds --folderfirst and --folderlast even if they don't exist on host1
@h1_folders_wanted = sort_requested_folders(  ) ;

# Remove no selectable folders


if ( $sync->{ checkfoldersexist } ) {
        my @h1_folders_wanted_exist ;
        myprint( "Host1: Checking wanted folders exist. Use --nocheckfoldersexist to avoid this check (shared of public namespace targeted).\n"  ) ;
        foreach my $folder ( @h1_folders_wanted ) {
                ( $sync->{ debug } or $sync->{debugfolders} ) and myprint( "Checking $folder exists on host1\n"  ) ;
                if ( ! exists  $h1_folders_all{ $folder }  ) {
                        myprint( "Host1: warning! ignoring folder $folder because it is not in host1 whole folders list.\n" ) ;
                        next ;
                }else{
                        push  @h1_folders_wanted_exist, $folder  ;
                }
        }
        @h1_folders_wanted = @h1_folders_wanted_exist ;
}else{
        myprint( "Host1: Not checking that wanted folders exist. Remove --nocheckfoldersexist to get this check.\n"  ) ;
}


if ( $sync->{ checkselectable } ) {
        my @h1_folders_wanted_selectable ;
        myprint( "Host1: Checking wanted folders are selectable. Use --nocheckselectable to avoid this check.\n"  ) ;
        foreach my $folder ( @h1_folders_wanted ) {
                ( $sync->{ debug } or $sync->{debugfolders} ) and myprint( "Checking $folder is selectable on host1\n"  ) ;
                # It does an imap command  LIST "" $folder and then search for no \Noselect
                if ( ! $sync->{imap1}->selectable( $folder ) ) {
                                myprint( "Host1: warning! ignoring folder $folder because it is not selectable\n" ) ;
                }else{
                        push  @h1_folders_wanted_selectable, $folder  ;
                }
        }
        @h1_folders_wanted = @h1_folders_wanted_selectable ;
        ( $sync->{ debug } or $sync->{debugfolders} ) and myprint( 'Host1: checking folders took ', timenext(  ), " s\n"  ) ;
}else{
        myprint( "Host1: Not checking that wanted folders are selectable. Remove --nocheckselectable to get this check.\n"  ) ;
}

$sync->{h1_folders_wanted} = \@h1_folders_wanted ;


# Old place of private_folders_separators_and_prefixes(  ) call.
#private_folders_separators_and_prefixes(  ) ;


# this hack is because LWP post does not pass well a hash in the $form parameter
# but it does pass well an array
%{ $sync->{f1f2h} } = split_around_equal( @{ $sync->{f1f2} } ) ;

automap( $sync ) ;


foreach my $h1_fold ( @h1_folders_wanted ) {
        my $h2_fold ;
        $h2_fold = imap2_folder_name( $sync, $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( $sync, $h1_fold ) ;
        $h2_folders_from_1_all{ $h2_fold }++ ;
}



myprint( << 'END_LISTING'  ) ;

++++ Listing folders
All foldernames are presented between brackets like [X] where X is the foldername.
When a foldername contains non-ASCII characters it is presented in the form
[X] = [Y] where
X is the imap foldername you have to use in command line options and
Y is the utf8 output just printed for convenience, to recognize it.

END_LISTING

myprint(
  "Host1: folders list (first the raw imap format then the [X] = [Y]):\n",
  $sync->{imap1}->list(  ),
  "\n",
  jux_utf8_list( @h1_folders_all ),
  "\n",
  "Host2: folders list (first the raw imap format then the [X] = [Y]):\n",
  $sync->{imap2}->list(  ),
  "\n",
  jux_utf8_list( @h2_folders_all ),
  "\n",
  q{}
) ;

if ( $subscribed ) {
        myprint(
                'Host1 subscribed folders list: ',
                jux_utf8_list( sort keys  %h1_subscribed_folder  ), "\n",
        ) ;
}


my @h2_folders_not_in_1;
@h2_folders_not_in_1 = list_folders_in_2_not_in_1(  ) ;

if ( @h2_folders_not_in_1 ) {
        myprint( "Folders in host2 not in host1:\n",
        jux_utf8_list( @h2_folders_not_in_1 ), "\n" ) ;
}


if ( keys %{ $sync->{f1f2auto} } ) {
        myprint( "Folders mapping from --automap feature (use --f1f2 to override any mapping):\n"  ) ;
        foreach my $h1_fold ( keys %{ $sync->{f1f2auto} } ) {
                my $h2_fold = $sync->{f1f2auto}{$h1_fold} ;
                myprintf( "%-40s -> %-40s\n",
                       jux_utf8( $h1_fold ), jux_utf8( $h2_fold ) ) ;
        }
        myprint( "\n"  ) ;
}

if ( keys %{ $sync->{f1f2h} } ) {
        myprint( "Folders mapping from --f1f2 options, it overrides --automap:\n"  ) ;
        foreach my $h1_fold ( keys %{ $sync->{f1f2h} } ) {
                my $h2_fold = $sync->{f1f2h}{$h1_fold} ;
                my $warn = q{} ;
                if ( not exists  $h1_folders_all{ $h1_fold }  ) {
                        $warn = "BUT $h1_fold does NOT exist on host1!" ;
                }
                myprintf( "%-40s -> %-40s %s\n",
                       jux_utf8( $h1_fold ), jux_utf8( $h2_fold ), $warn ) ;
        }
        myprint( "\n"  ) ;
}

exit_clean( $sync, $EX_OK ) if ( $sync->{justfolderlists} ) ;
exit_clean( $sync, $EX_OK ) if ( $sync->{justautomap} ) ;

debugsleep( $sync ) ;

if ( $foldersizes ) {
        foldersizes_on_h1h2( $sync ) ;
}



if ( $sync->{ justfoldersizes } )
{
        myprint( "Exiting because of --justfoldersizes\n" ) ;
        exit_clean( $sync, $EX_OK ) ;
}

$sync->{stats} = 1 ;

if ( $sync->{ delete1emptyfolders } ) {
        delete1emptyfolders( $sync ) ;
}

delete_folders_in_2_not_in_1(  ) if $delete2folders ;

# folder loop
$h1_folders_wanted_nb = scalar  @h1_folders_wanted  ;

myprint( "++++ Looping on each one of $h1_folders_wanted_nb folders to sync\n" ) ;

$sync->{begin_transfer_time} = time ;

my %uid_candidate_for_deletion ;
my %uid_candidate_no_deletion ;

$sync->{ h2_folders_of_md5 } = {  } ;

FOLDER: foreach my $h1_fold ( @h1_folders_wanted ) {

        if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }

        my $h2_fold = imap2_folder_name( $sync, $h1_fold ) ;

        $h1_folders_wanted_ct++ ;
        myprintf( "Folder %7s %-35s -> %-35s\n", "$h1_folders_wanted_ct/$h1_folders_wanted_nb",
                jux_utf8( $h1_fold ), jux_utf8( $h2_fold ) ) ;
        myprint( debugmemory( $sync, " at folder loop" ) ) ;

        # host1 can not be fetched read only, select is needed because of expunge.
        select_folder( $sync, $sync->{imap1}, $h1_fold, 'Host1' ) or next FOLDER ;

        debugsleep( $sync ) ;

        my $h1_fold_nb_messages = count_from_select( $sync->{imap1}->History ) ;
        myprint( "Host1: folder [$h1_fold] has $h1_fold_nb_messages messages in total (mentioned by SELECT)\n" ) ;

        if ( $skipemptyfolders and 0 == $h1_fold_nb_messages ) {
                myprint( "Host1: skipping empty host1 folder [$h1_fold]\n"  ) ;
                next FOLDER ;
        }

        # Code added from https://github.com/imapsync/imapsync/issues/95
        # Thanks jh1995
        if ( $skipemptyfolders ) {
                my $h1_msgs_all_hash_ref_tmp = {  } ;
                my @h1_msgs_tmp = select_msgs( $sync->{imap1}, $h1_msgs_all_hash_ref_tmp, $search1, $h1_fold ) ;
                my $h1_fold_nb_messages_tmp = scalar( @h1_msgs_tmp ) ;
                if ( 0 == $h1_fold_nb_messages_tmp ) {
                        myprint( "Host1: skipping empty host1 folder [$h1_fold] (0 message found by SEARCH)\n"  ) ;
                        next FOLDER ;
                }
        }

        if ( ! exists  $h2_folders_all{ $h2_fold }  ) {
                create_folder( $sync, $sync->{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( $sync, $sync->{imap2}, $h2_fold, 'Host2' )
        or ( create_folder( $sync, $sync->{imap2}, $h2_fold, $h1_fold )
             and select_folder( $sync, $sync->{imap2}, $h2_fold, 'Host2' ) )
        or next FOLDER ;
        my @select_results = $sync->{imap2}->Results(  ) ;

        my $h2_fold_nb_messages = count_from_select( @select_results ) ;
        myprint( "Host2: folder [$h2_fold] has $h2_fold_nb_messages messages in total (mentioned by SELECT)\n" ) ;

        my $permanentflags2 = permanentflags( @select_results ) ;
        myprint( "Host2: folder [$h2_fold] permanentflags: $permanentflags2\n"  ) ;

        if ( $sync->{ expunge1 } )
        {
                myprint( "Host1: Expunging $h1_fold $sync->{dry_message}\n"  ) ;
                if ( ! $sync->{dry} ) { $sync->{imap1}->expunge(  ) } ;
        }

        if ( ( ( $subscribe and exists $h1_subscribed_folder{ $h1_fold } ) or $subscribeall )
             and not exists  $h2_subscribed_folder{ $h2_fold }  )
        {
                myprint( "Host2: Subscribing to folder $h2_fold\n"  ) ;
                if ( ! $sync->{dry} ) { $sync->{imap2}->subscribe( $h2_fold ) } ;
        }

        next FOLDER if ( $sync->{ justfolders } ) ;

        if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }

        my $h1_msgs_all_hash_ref = {  } ;
        my @h1_msgs = select_msgs( $sync->{imap1}, $h1_msgs_all_hash_ref, $search1, $sync->{abletosearch1}, $h1_fold );

        if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }

        my $h1_msgs_nb = scalar  @h1_msgs  ;

        myprint( "Host1: folder [$h1_fold] considering $h1_msgs_nb messages\n"  ) ;
        ( $sync->{ debug } or $debuglist ) and myprint( "Host1: folder [$h1_fold] considering $h1_msgs_nb messages, LIST gives: @h1_msgs\n" ) ;
        $sync->{ debug } and myprint( "Host1: selecting messages of folder [$h1_fold] took ", timenext(), " s\n" ) ;

        my $h2_msgs_all_hash_ref = {  } ;
        my @h2_msgs = select_msgs( $sync->{imap2}, $h2_msgs_all_hash_ref, $search2, $sync->{abletosearch2}, $h2_fold ) ;

        if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }

        my $h2_msgs_nb = scalar  @h2_msgs  ;

        myprint( "Host2: folder [$h2_fold] considering $h2_msgs_nb messages\n" ) ;
        ( $sync->{ debug } or $debuglist ) and myprint( "Host2: folder [$h2_fold] considering $h2_msgs_nb messages, LIST gives: @h2_msgs\n" ) ;
        $sync->{ debug } and myprint( "Host2: selecting messages of folder [$h2_fold] took ", timenext(), " s\n" ) ;

        my $cache_base = "$sync->{ tmpdir }/imapsync_cache/" ;
        my $cache_dir = cache_folder( $cache_base, "$sync->{host1}/$sync->{user1}/$sync->{host2}/$sync->{user2}", $h1_fold, $h2_fold ) ;
        my ( $cache_1_2_ref, $cache_2_1_ref ) = ( {}, {} ) ;

        my $h1_uidvalidity = $sync->{imap1}->uidvalidity(  ) || q{} ;
        my $h2_uidvalidity = $sync->{imap2}->uidvalidity(  ) || q{} ;

        if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }

        if ( $usecache ) {
                myprint( "Local cache directory: $cache_dir ( " . length( $cache_dir  )  . " characters long )\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 ) ;
                myprint( 'CACHE h1 h2: ', scalar  keys %{ $cache_1_2_ref } , " files\n"  ) ;
                $sync->{ debug } and myprint( '[',
                    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 ;
        #myprint( "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 = (  ) ;

                #myprint( "delete2: @h2_msgs_delete2_not_in_cache\n" ) ;
        }

        $sync->{ debug } and myprint( "Host1: parsing headers of folder [$h1_fold]\n" ) ;

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

        @{ $h1_fir_ref }{@h1_msgs} = ( undef ) ;

        $sync->{ debug } and myprint( "Host1: getting flags idate and sizes of folder [$h1_fold]\n"  ) ;

        my @h1_common_fetch_param = ( 'FLAGS', 'INTERNALDATE', 'RFC822.SIZE' ) ;
        if ( $sync->{ synclabels } or $sync->{ resynclabels } ) { push @h1_common_fetch_param, 'X-GM-LABELS' ; }

        if ( $sync->{abletosearch1} )
        {
                $h1_fir_ref = $sync->{imap1}->fetch_hash( \@h1_msgs, @h1_common_fetch_param, $h1_fir_ref )
                if ( @h1_msgs ) ;
        }
        else
        {
                my $uidnext = $sync->{imap1}->uidnext( $h1_fold ) || $uidnext_default ;
                my $fetch_hash_uids = $fetch_hash_set || "1:$uidnext" ;
                $h1_fir_ref = $sync->{imap1}->fetch_hash( $fetch_hash_uids, @h1_common_fetch_param, $h1_fir_ref )
                if ( @h1_msgs ) ;
        }

        $sync->{ debug } and myprint( "Host1: getting flags idate and sizes of folder [$h1_fold] took ", timenext(), " s\n"  ) ;
        if ( ! $h1_fir_ref )
        {
                my $error = join( q{}, "Host1: folder $h1_fold : Could not fetch_hash ",
                        scalar @h1_msgs, ' msgs: ', $sync->{imap1}->LastError || q{}, "\n" ) ;
                errors_incr( $sync, $error ) ;
                next FOLDER ;
        }

        my @h1_msgs_duplicate;
        foreach my $m ( @h1_msgs_not_in_cache )
        {
                my $rc = parse_header_msg( $sync, $sync->{imap1}, $m, $h1_heads_ref, $h1_fir_ref, 'Host1', \%h1_hash ) ;
                if ( ! defined $rc )
                {
                        my $h1_size = $h1_fir_ref->{$m}->{'RFC822.SIZE'} || 0;
                        myprint( "Host1: $h1_fold/$m size $h1_size ignored (no wanted headers so we ignore this message. To solve this: use --addheader)\n"  ) ;
                        $sync->{ total_bytes_skipped } += $h1_size ;
                        $sync->{ nb_msg_skipped } += 1 ;
                        $sync->{ h1_nb_msg_noheader }  +=1 ;
                        $sync->{ 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;
                        $sync->{ nb_msg_skipped } += 1;
                        $h1_nb_msg_duplicate += 1;
                        $sync->{ h1_nb_msg_processed } +=1 ;
                }
        }
        my $h1_msgs_duplicate_nb = scalar  @h1_msgs_duplicate  ;

        myprint( "Host1: folder [$h1_fold] selected $h1_msgs_nb messages, duplicates $h1_msgs_duplicate_nb\n" ) ;

        $sync->{ debug } and myprint( 'Host1: whole time parsing headers took ', timenext(), " s\n"  ) ;
        # Getting headers and metada can be so long that host2 might be disconnected here
        if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }


        $sync->{ debug } and myprint( "Host2: parsing headers of folder [$h2_fold]\n" ) ;

        my ($h2_heads_ref, $h2_fir_ref) = ( {}, {} );
        $h2_heads_ref =   $sync->{imap2}->parse_headers([@h2_msgs_not_in_cache], @useheader) if (@h2_msgs_not_in_cache);
        $sync->{ debug } and myprint( "Host2: parsing headers of folder [$h2_fold] took ", timenext(), " s\n"  ) ;

        $sync->{ debug } and myprint( "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


        my @h2_common_fetch_param = ( 'FLAGS', 'INTERNALDATE', 'RFC822.SIZE' ) ;
        if ( $sync->{ synclabels } or $sync->{ resynclabels } ) { push @h2_common_fetch_param, 'X-GM-LABELS' ; }

        if ( $sync->{abletosearch2} and scalar( @h2_msgs ) ) {
                $h2_fir_ref = $sync->{imap2}->fetch_hash( \@h2_msgs, @h2_common_fetch_param, $h2_fir_ref) ;
        }else{
                my $uidnext = $sync->{imap2}->uidnext( $h2_fold ) || $uidnext_default ;
                my $fetch_hash_uids = $fetch_hash_set || "1:$uidnext" ;
                $h2_fir_ref = $sync->{imap2}->fetch_hash( $fetch_hash_uids, @h2_common_fetch_param, $h2_fir_ref )
                if ( @h2_msgs ) ;
        }

        $sync->{ debug } and myprint( "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( $sync, $sync->{imap2}, $m, $h2_heads_ref, $h2_fir_ref, 'Host2', \%h2_hash ) ;
                my $h2_size = $h2_fir_ref->{$m}->{'RFC822.SIZE'} || 0 ;
                if (! defined  $rc  ) {
                        myprint( "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 ;
                        push  @h2_msgs_duplicate, $m  ;
                }
        }

        # %h2_folders_of_md5
        foreach my $md5 (  keys  %h2_hash  ) {
                $sync->{ h2_folders_of_md5 }->{ $md5 }->{ $h2_fold } ++ ;
        }
        # %h1_folders_of_md5
        foreach my $md5 (  keys  %h1_hash  ) {
                $sync->{ h1_folders_of_md5 }->{ $md5 }->{ $h2_fold } ++ ;
        }


        my $h2_msgs_duplicate_nb = scalar  @h2_msgs_duplicate  ;

        myprint( "Host2: folder [$h2_fold] selected $h2_msgs_nb messages, duplicates $h2_msgs_duplicate_nb\n" ) ;

        $sync->{ debug } and myprint( 'Host2 whole time parsing headers took ', timenext(  ), " s\n"  ) ;

        $sync->{ debug } and myprint( "++++ 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;

        #myprint( map { $h1_hash{$_}{'m'} . q{ }} @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;

        # Deletions on account2.

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

                foreach my $h2_msg ( @h2_msgs_duplicate ) {
                        myprint( "Host2: msg $h2_fold/$h2_msg marked \\Deleted [duplicate] on host2 $sync->{dry_message}\n"  ) ;
                        push  @h2_expunge, $h2_msg  if $sync->{ uidexpunge2 } ;
                        if ( ! $sync->{dry} ) {
                                $sync->{imap2}->delete_message( $h2_msg ) ;
                                $h2_nb_msg_deleted += 1 ;
                        }
                }
                my $cnt = scalar @h2_expunge ;
                if( @h2_expunge and not $sync->{ expunge2 } ) {
                        myprint( "Host2: UidExpunging $cnt message(s) in folder $h2_fold $sync->{dry_message}\n"  ) ;
                        $sync->{imap2}->uidexpunge( \@h2_expunge ) if ! $sync->{dry} ;
                }
                if ( $sync->{ expunge2 } ){
                        myprint( "Host2: Expunging folder $h2_fold $sync->{dry_message}\n"  ) ;
                        $sync->{imap2}->expunge(  ) if ! $sync->{dry} ;
                }
        }

        if( $sync->{ 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) {
                        #myprint( "$m_id " ) ;
                        if ( ! exists $h1_hash{$m_id} ) {
                                my $h2_msg  = $h2_hash{$m_id}{'m'};
                                my $h2_flags  = $h2_hash{$m_id}{'F'} || q{};
                                my $isdel  = $h2_flags =~ /\B\\Deleted\b/x ? 1 : 0;
                                myprint( "Host2: msg $h2_fold/$h2_msg marked \\Deleted on host2 [$m_id] $sync->{dry_message}\n" )
                                  if ! $isdel;
                                push @h2_expunge, $h2_msg if $sync->{ uidexpunge2 };
                                if ( ! ( $sync->{dry} or $isdel ) ) {
                                        $sync->{imap2}->delete_message($h2_msg);
                                        $h2_nb_msg_deleted += 1;
                                }
                        }
                }
                foreach my $h2_msg ( @h2_msgs_delete2_not_in_cache ) {
                        myprint( "Host2: msg $h2_fold/$h2_msg marked \\Deleted [not in cache] on host2 $sync->{dry_message}\n" ) ;
                        push @h2_expunge, $h2_msg if $sync->{ uidexpunge2 };
                        if ( ! $sync->{dry} ) {
                                $sync->{imap2}->delete_message($h2_msg);
                                $h2_nb_msg_deleted += 1;
                        }
                }
                my $cnt = scalar @h2_expunge ;

                if( @h2_expunge and not $sync->{ expunge2 } ) {
                        myprint( "Host2: UidExpunging $cnt message(s) in folder $h2_fold $sync->{dry_message}\n"  ) ;
                        $sync->{imap2}->uidexpunge( \@h2_expunge ) if ! $sync->{dry} ;
                }
                if ( $sync->{ expunge2 } ) {
                        myprint( "Host2: Expunging folder $h2_fold $sync->{dry_message}\n"  ) ;
                        $sync->{imap2}->expunge(  ) if ! $sync->{dry} ;
                }
        }

        if( $sync->{ delete2 } and exists  $h2_folders_from_1_several{ $h2_fold }  ) {
                myprint( "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' } ;
                        if ( ! exists  $h1_hash{ $m_id }  ) {
                                my $h2_flags  = $h2_hash{ $m_id }{ 'F' } || q{} ;
                                my $isdel  = $h2_flags =~ /\B\\Deleted\b/x ? 1 : 0 ;
                                if ( ! $isdel ) {
                                        $sync->{ debug } and myprint( "Host2: msg $h2_fold/$h2_msg candidate for deletion [$m_id]\n"  ) ;
                                        $uid_candidate_for_deletion{ $h2_fold }{ $h2_msg }++ ;
                                }
                        }else{
                                $sync->{ debug } and myprint( "Host2: msg $h2_fold/$h2_msg will cancel deletion [$m_id]\n"  ) ;
                                $uid_candidate_no_deletion{ $h2_fold }{ $h2_msg }++ ;
                        }
                }
                foreach my $h2_msg ( @h2_msgs_delete2_not_in_cache ) {
                        myprint( "Host2: msg $h2_fold/$h2_msg candidate for deletion [not in cache]\n" ) ;
                        $uid_candidate_for_deletion{ $h2_fold }{ $h2_msg }++ ;
                }

                foreach my $h2_msg ( @h2_msgs_in_cache ) {
                        myprint( "Host2: msg $h2_fold/$h2_msg will cancel deletion [in cache]\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
                        myprint( "Last host1 folder going to $h2_fold\n"  ) ;
                        foreach my $h2_msg ( keys %{ $uid_candidate_for_deletion{ $h2_fold } } ) {
                                $sync->{ debug } and myprint( "Host2: msg $h2_fold/$h2_msg candidate for deletion\n"  ) ;
                                if ( exists  $uid_candidate_no_deletion{ $h2_fold }{ $h2_msg }  ) {
                                        $sync->{ debug } and myprint( "Host2: msg $h2_fold/$h2_msg canceled deletion\n"  ) ;
                                }else{
                                        myprint( "Host2: msg $h2_fold/$h2_msg marked \\Deleted $sync->{dry_message}\n" ) ;
                                        push  @h2_expunge, $h2_msg  if $sync->{ uidexpunge2 } ;
                                        if ( ! $sync->{dry} ) {
                                                $sync->{imap2}->delete_message( $h2_msg ) ;
                                                $h2_nb_msg_deleted += 1 ;
                                        }
                                }
                        }
                }

                my $cnt = scalar @h2_expunge ;
                if( @h2_expunge and not $sync->{ expunge2 } ) {
                        myprint( "Host2: UidExpunging $cnt message(s) in folder $h2_fold $sync->{dry_message}\n"  ) ;
                        $sync->{imap2}->uidexpunge( \@h2_expunge ) if ! $sync->{dry} ;
                }
                if ( $sync->{ expunge2 } ) {
                        myprint( "Host2: Expunging host2 folder $h2_fold $sync->{dry_message}\n"  ) ;
                        $sync->{imap2}->expunge(  ) if ! $sync->{dry} ;
                }

                $h2_folders_from_1_several{ $h2_fold }-- ;
        }

        my $h2_uidnext = $sync->{imap2}->uidnext( $h2_fold ) ;
        $sync->{ debug } and myprint( "Host2: uidnext is $h2_uidnext\n"  ) ;
        $h2_uidguess = $h2_uidnext ;

	# Getting host2 headers, metada and delete2 stuff can be so long that host1 might be disconnected here
        if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }

        my @h1_msgs_to_delete ;
        MESS: foreach my $m_id (@h1_hash_keys_sorted_by_uid) {
		if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }

                #myprint( "h1_nb_msg_processed: $sync->{ 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'};

                #my $labels = labels( $sync->{imap1}, $h1_msg ) ;
                #print "LABELS: $labels\n" ;

                if ( ( not exists  $h2_hash{ $m_id }  )
                        and ( not ( exists $sync->{ h2_folders_of_md5 }->{ $m_id } )
                              or not $skipcrossduplicates ) )
                {
                        # copy
                        my $h2_msg = copy_message( $sync, $h1_msg, $h1_fold, $h2_fold, $h1_fir_ref, $permanentflags2, $cache_dir ) ;
                        if ( $h2_msg and $sync->{ delete1 } and not $sync->{ expungeaftereach } ) {
                                # not  expunged
                                push @h1_msgs_to_delete, $h1_msg ;
                        }

                        # A bug here with imapsync 1.920, fixed in 1.921
                        # Added $h2_msg in the condition. Errors of APPEND were not counted as missing messages on host2!
                        if ( $h2_msg and not $sync->{ dry } )
                        {
                                $sync->{ h2_folders_of_md5 }->{ $m_id }->{ $h2_fold } ++ ;
                        }

                        #
                        if( $sync->{ delete2 } and ( exists $h2_folders_from_1_several{ $h2_fold } ) and $h2_msg ) {
                                myprint( "Host2: msg $h2_fold/$h2_msg will cancel deletion [fresh copy] on host2\n"  ) ;
                                $uid_candidate_no_deletion{ $h2_fold }{ $h2_msg }++ ;
                        }

                        if ( total_bytes_max_reached( $sync ) ) {
                                # a bug when using --delete1 --noexpungeaftereach
                                # same thing below on all total_bytes_max_reached!
                                last FOLDER ;
                        }
                        next MESS;
                }
                else
                {
                        # already on host2
                        if ( exists  $h2_hash{ $m_id }  )
                        {
                                my $h2_msg   = $h2_hash{$m_id}{'m'} ;
                                $sync->{ debug } and myprint( "Host1: found that msg $h1_fold/$h1_msg equals Host2 $h2_fold/$h2_msg\n"  ) ;
                                if ( $usecache )
                                {
                                        $debugcache and myprint( "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  $sync->{ h2_folders_of_md5 }->{ $m_id }  )
                        {
                                my @folders_dup = keys  %{ $sync->{ h2_folders_of_md5 }->{ $m_id } }  ;
                                ( $sync->{ debug } or $debugcrossduplicates ) and myprint( "Host1: found that msg $h1_fold/$h1_msg is also in Host2 folders @folders_dup\n"  ) ;
                                $sync->{ h2_nb_msg_crossdup } +=1 ;
                        }
                        $sync->{ total_bytes_skipped } += $h1_size ;
                        $sync->{ nb_msg_skipped } += 1 ;
                        $sync->{ h1_nb_msg_processed } +=1 ;
                }

                if ( exists  $h2_hash{ $m_id }  ) {
                        #$debug and myprint( "MESSAGE $m_id\n" ) ;
                        my $h2_msg  = $h2_hash{$m_id}{'m'};
                        if ( $sync->{resyncflags} ) {
                                sync_flags_fir( $sync, $h1_fold, $h1_msg, $h2_fold, $h2_msg, $permanentflags2, $h1_fir_ref, $h2_fir_ref ) ;
                        }
                        # Good
                        my $h2_size = $h2_hash{$m_id}{'s'};
                        $sync->{ debug } and myprint(
                        "Host1: size msg $h1_fold/$h1_msg = $h1_size <> $h2_size = Host2 $h2_fold/$h2_msg\n" ) ;

                        if ( $sync->{ resynclabels } )
                        {
                                resynclabels( $sync, $h1_msg, $h2_msg, $h1_fir_ref, $h2_fir_ref, $h1_fold )
                        }
                }

		if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }

                if ( $sync->{ delete1 } ) {
                        push @h1_msgs_to_delete, $h1_msg ;
                }
        }
        # END MESS: loop

        delete_message_on_host1( $sync, $h1_fold, $sync->{ expunge1 }, @h1_msgs_to_delete, @h1_msgs_in_cache ) ;

	if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }

        # MESS_IN_CACHE:
        if ( ! $sync->{ delete1 } )
        {
                foreach my $h1_msg ( @h1_msgs_in_cache )
                {
                        my $h2_msg = $cache_1_2_ref->{ $h1_msg } ;
                        $debugcache and myprint( "cache messages update flags $h1_msg->$h2_msg\n" ) ;
                        if ( $sync->{resyncflags} )
                        {
                                sync_flags_fir( $sync, $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 ;
                        $sync->{ total_bytes_skipped } += $h1_size;
                        $sync->{ nb_msg_skipped } += 1;
                        $sync->{ h1_nb_msg_processed } +=1 ;
                }
        }

        if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }

        @h1_msgs_to_delete = (  ) ;
        #myprint( "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 )
        {
                $sync->{ debug } and myprint( "Copy by uid $h1_fold/$h1_msg\n"  ) ;
                if ( ! reconnect_12_if_needed( $sync ) ) { last FOLDER ; }

                my $h2_msg = copy_message( $sync, $h1_msg, $h1_fold, $h2_fold, $h1_fir_ref, $permanentflags2, $cache_dir ) ;
                if( $sync->{ delete2 } and exists  $h2_folders_from_1_several{ $h2_fold }  and $h2_msg ) {
                        myprint( "Host2: 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( $sync ) ;
        }

        if ( $sync->{ expunge1 } ){
                myprint( "Host1: Expunging folder $h1_fold $sync->{dry_message}\n"  ) ;
                if ( ! $sync->{dry} ) { $sync->{imap1}->expunge(  ) } ;
        }
        if ( $sync->{ expunge2 } ){
                myprint( "Host2: Expunging folder $h2_fold $sync->{dry_message}\n"  ) ;
                if ( ! $sync->{dry} ) { $sync->{imap2}->expunge(  ) } ;
        }
        $sync->{ debug } and myprint( 'Time: ', timenext(  ), " s\n"  ) ;
}


myprint( "++++ End looping on each folder\n"  ) ;

if ( $sync->{ delete1 } and $sync->{ delete1emptyfolders } ) {
	delete1emptyfolders( $sync ) ;
}

( $sync->{ debug } or $sync->{debugfolders} ) and myprint( 'Time: ', timenext(  ), " s\n"  ) ;


if ( $foldersizesatend ) {
        myprint( << 'END_SIZE'  ) ;

Folders sizes after the synchronization.
You can remove this foldersizes listing by using  "--nofoldersizesatend"
END_SIZE

        foldersizesatend( $sync ) ;
}

if ( ! lost_connection( $sync, $sync->{imap1}, "for host1 [$sync->{host1}]" ) ) { $sync->{imap1}->logout(  )  ; }
if ( ! lost_connection( $sync, $sync->{imap2}, "for host2 [$sync->{host2}]" ) ) { $sync->{imap2}->logout(  )  ; }

stats( $sync ) ;
myprint( errorsdump( $sync->{nb_errors}, errors_log( $sync ) ) ) if ( $sync->{errorsdump} ) ;
tests_live_result( $sync->{nb_errors} ) if ( $sync->{testslive} or $sync->{testslive6} ) ;


exit_clean( $sync, $EXIT_WITH_ERRORS ) if ( $sync->{nb_errors} ) ;
exit_clean( $sync, $EX_OK ) ;

# END of main program


# subroutines
sub myprint
{
        #print @ARG ;
        print { $sync->{ tee } || \*STDOUT } @ARG ;
        return ;
}

sub myprintf
{
        printf { $sync->{ tee } || \*STDOUT } @ARG ;
        return ;
}

sub mysprintf
{
        my( $format, @list ) = @ARG ;
        return sprintf $format, @list ;
}

sub output_start
{
	my $mysync = shift @ARG ;

	if ( not $mysync ) { return ; }

	my @output = @ARG ;
	$mysync->{ output } = join( q{}, @output ) . ( $mysync->{ output } || q{} ) ;
	return $mysync->{ output } ;
}


sub tests_output_start
{
	note( 'Entering tests_output_start()' ) ;

	my $mysync = { } ;

	is( undef, output_start(  ), 'output_start: no args => undef' ) ;
	is( q{}, output_start( $mysync ), 'output_start: one arg => ""' ) ;
	is( 'rrrr', output_start( $mysync, 'rrrr' ), 'output_start: rrrr => rrrr' ) ;
	is( 'aaaarrrr', output_start( $mysync, 'aaaa' ), 'output_start: aaaa => aaaarrrr' ) ;
	is( "\naaaarrrr", output_start( $mysync, "\n" ), 'output_start: \n => \naaaarrrr' ) ;
	is( "ABC\naaaarrrr", output_start( $mysync, 'A', 'B', 'C' ), 'output_start: A B C => ABC\naaaarrrr' ) ;

	note( 'Leaving  tests_output_start()' ) ;
	return ;
}

sub tests_output
{
	note( 'Entering tests_output()' ) ;

	my $mysync = { } ;

	is( undef, output(  ), 'output: no args => undef' ) ;
	is( q{}, output( $mysync ), 'output: one arg => ""' ) ;
	is( 'rrrr', output( $mysync, 'rrrr' ), 'output: rrrr => rrrr' ) ;
	is( 'rrrraaaa', output( $mysync, 'aaaa' ), 'output: aaaa => rrrraaaa' ) ;
	is( "rrrraaaa\n", output( $mysync, "\n" ), 'output: \n => rrrraaaa\n' ) ;
	is( "rrrraaaa\nABC", output( $mysync, 'A', 'B', 'C' ), 'output: A B C => rrrraaaaABC\n' ) ;

	note( 'Leaving  tests_output()' ) ;
	return ;
}

sub output
{
	my $mysync = shift @ARG ;

	if ( not $mysync ) { return ; }

	my @output = @ARG ;
	$mysync->{ output } .= join( q{}, @output ) ;
	return $mysync->{ output } ;
}



sub tests_output_reset_with
{
	note( 'Entering tests_output_reset_with()' ) ;

	my $mysync = { } ;

	is( undef,  output_reset_with(  ), 'output_reset_with: no args => undef' ) ;
	is( q{},    output_reset_with( $mysync ), 'output_reset_with: one arg => ""' ) ;
	is( 'rrrr', output_reset_with( $mysync, 'rrrr' ), 'output_reset_with: rrrr => rrrr' ) ;
	is( 'aaaa', output_reset_with( $mysync, 'aaaa' ), 'output_reset_with: aaaa => aaaa' ) ;
	is( "\n",   output_reset_with( $mysync, "\n" ), 'output_reset_with: \n => \n' ) ;

	note( 'Leaving  tests_output_reset_with()' ) ;
	return ;
}

sub output_reset_with
{
	my $mysync = shift @ARG ;

	if ( not $mysync ) { return ; }

	my @output = @ARG ;
	$mysync->{ output } = join( q{}, @output ) ;
	return $mysync->{ output } ;
}



sub abort
{
	my $mysync = shift @ARG ;
	if ( ! -r $mysync->{pidfile} ) {
		myprint( "Can not read pidfile $mysync->{pidfile}. Exiting.\n" ) ;
		exit $EX_OK ;
	}
	my $pidtokill = firstline( $mysync->{pidfile} ) ;
	if ( ! $pidtokill ) {
		myprint( "No process to abort. Exiting.\n" ) ;
		exit $EX_OK ;
	}
	# First ask for suicide
	if ( kill 'ZERO', $pidtokill ) {
		myprint( "Sending signal QUIT to PID $pidtokill \n" ) ;
		kill 'QUIT', $pidtokill ;
		sleep 1 ;
	}else{
		myprint( "Can not send signal to PID $pidtokill. Exiting.\n" ) ;
		exit $EX_OK ;
	}
	# Then murder
	if ( kill 'ZERO', $pidtokill ) {
		myprint( "Sending signal KILL to PID $pidtokill \n" ) ;
		kill 'KILL', $pidtokill ;
		sleep 1 ;
	}else{
		myprint( "Process PID $pidtokill ended. Exiting.\n" ) ;
		exit $EX_OK ;
	}
	# Well ...
	if ( kill 'ZERO', $pidtokill ) {
		myprint( "Process PID $pidtokill still there. Can not do much. Exiting.\n" ) ;
		exit $EX_OK ;
	}else{
		myprint( "Process PID $pidtokill ended. Exiting.\n" ) ;
		exit $EX_OK ;
	}
        # well abort job done anyway

        exit $EX_OK ;
}



sub docker_context
{
	my $mysync = shift ;
	-e '/.dockerenv'  || return ;
	myprint( "Docker context detected with /.dockerenv\n" ) ;
	# No pidfile
	$mysync->{pidfile} = q{} ;
	# No log
	$mysync->{log} = 0 ;
	# In case
	myprint( "Changing current directory to /var/tmp/\n" ) ;
	chdir '/var/tmp/' ;

	return ;
}

sub cgibegin
{
	my $mysync = shift ;
	if ( ! under_cgi_context( $mysync ) ) { return ; }
	require CGI ;
	CGI->import( qw( -no_debug ) ) ;
	require CGI::Carp ;
	CGI::Carp->import( qw( fatalsToBrowser ) ) ;
	$mysync->{cgi} = CGI->new( ) ;
	return ;
}

sub tests_under_cgi_context
{
	note( 'Entering tests_under_cgi_context()' ) ;

	# $ENV{SERVER_SOFTWARE} = 'under imapsync' ;
	do {
		# Not in cgi context
		delete local $ENV{SERVER_SOFTWARE} ;
		is( undef, under_cgi_context(  ), 'under_cgi_context: SERVER_SOFTWARE unset => not in cgi context' ) ;
	} ;
	do {
		# In cgi context
		local $ENV{SERVER_SOFTWARE} = 'under imapsync' ;
		is( 1, under_cgi_context(  ), 'under_cgi_context: SERVER_SOFTWARE set => in cgi context' ) ;
	} ;
	do {
		# Not in cgi context
		delete local $ENV{SERVER_SOFTWARE} ;
		is( undef, under_cgi_context(  ), 'under_cgi_context: SERVER_SOFTWARE unset => not in cgi context' ) ;
	} ;
	do {
		# In cgi context
		local $ENV{SERVER_SOFTWARE} = 'under imapsync' ;
		is( 1, under_cgi_context(  ), 'under_cgi_context: SERVER_SOFTWARE set => in cgi context' ) ;
	} ;
	note( 'Leaving  tests_under_cgi_context()' ) ;
	return ;
}


sub under_cgi_context
{
        my $mysync = shift ;
	# Under cgi context
	if ( $ENV{SERVER_SOFTWARE} ) {
		return 1 ;
	}
	# Not in cgi context
	return ;
}

sub cgibuildheader
{
	my $mysync = shift ;
	if ( ! under_cgi_context( $mysync ) ) { return ; }

	my $imapsync_runs = $mysync->{cgi}->cookie( 'imapsync_runs' ) || 0 ;
	my $cookie = $mysync->{cgi}->cookie(
			-name => 'imapsync_runs',
			-value => 1 + $imapsync_runs,
			-expires => '+20y',
			-path    => '/cgi-bin/imapsync',
		) ;
	my $httpheader ;
	if ( $mysync->{ abort } ) {
		$httpheader = $mysync->{cgi}->header(
			-type   => 'text/plain',
			-status => '200 OK to abort syncing IMAP boxes' . ". Here is " . hostname(),
		) ;
	}elsif( $mysync->{ loaddelay } ) {
# https://tools.ietf.org/html/rfc2616#section-10.5.4
# 503 Service Unavailable
# The server is currently unable to handle the request due to a temporary overloading or maintenance of the server.
		$httpheader = $mysync->{cgi}->header(
			-type   => 'text/plain',
			-status => '503 Service Unavailable' . ". Be back in $mysync->{ loaddelay } min. Load on " . hostname() . " is $mysync->{ loadavg }",
		) ;
	}else{
		$httpheader = $mysync->{cgi}->header(
		-type   => 'text/plain',
		-status => '200 OK to sync IMAP boxes' . ". Load on " . hostname() . " is $mysync->{ loadavg }",
		-cookie => $cookie,
		) ;
	}
	output_start( $mysync, $httpheader ) ;

	return ;
}

sub cgiload
{
        # Exit on heavy load in CGI context
        my $mysync = shift ;
        if ( ! under_cgi_context( $mysync ) ) { return ; }
        if ( $mysync->{ abort } ) { return ; } # keep going to abort since some ressources will be free soon
        if ( $mysync->{ loaddelay } )
        {
                myprint( "Server is on heavy load. Be back in $mysync->{ loaddelay } min. Load is $mysync->{ loadavg }\n") ;
                exit_clean( $mysync, $EX_UNAVAILABLE ) ;
        }
        return ;
}

sub tests_set_umask
{
	note( 'Entering tests_set_umask()' ) ;

	my $save_umask = umask ;

	my $mysync = {} ;
	if ( 'MSWin32' eq $OSNAME ) {
		is( undef, set_umask( $mysync ), "set_umask: set failure to $UMASK_PARANO on MSWin32" ) ;
	}else{
		is( 1, set_umask( $mysync ), "set_umask: set to $UMASK_PARANO" ) ;
	}

	umask $save_umask ;
	note( 'Leaving  tests_set_umask()' ) ;
	return ;
}

sub set_umask
{
	my $mysync = shift ;
	my $previous_umask = umask_str(  ) ;
	my $new_umask = umask_str( $UMASK_PARANO ) ;
	output( $mysync, "Umask set with $new_umask (was $previous_umask)\n" ) ;
	if ( $new_umask eq $UMASK_PARANO ) {
		return 1 ;
	}
	return ;
}

sub tests_umask_str
{
	note( 'Entering tests_umask_str()' ) ;

	my $save_umask = umask ;

	is( umask_str(  ), umask_str(  ),  'umask_str: no parameters => idopotent' ) ;
	is( my $save_umask_str = umask_str(  ), umask_str(  ),  'umask_str: no parameters => idopotent + save' ) ;
	is( '0000', umask_str(    q{ } ),  'umask_str:  q{ } => 0000' ) ;
	is( '0000', umask_str(     q{} ),  'umask_str:   q{} => 0000' ) ;
	is( '0000', umask_str(  '0000' ),  'umask_str:  0000 => 0000' ) ;
	is( '0000', umask_str(     '0' ),  'umask_str:     0 => 0000' ) ;
	is( '0200', umask_str(  '0200' ),  'umask_str:  0200 => 0200' ) ;
	is( '0400', umask_str(  '0400' ),  'umask_str:  0400 => 0400' ) ;
	is( '0600', umask_str(  '0600' ),  'umask_str:  0600 => 0600' ) ;

	SKIP: {
	if ( 'MSWin32' eq $OSNAME ) { skip( 'Tests success only for Unix', 6 ) ; }
	is( '0100', umask_str(  '0100' ),  'umask_str:  0100 => 0100' ) ;
	is( '0001', umask_str(  '0001' ),  'umask_str:  0001 => 0001' ) ;
	is( '0777', umask_str(  '0777' ),  'umask_str:  0777 => 0777' ) ;
	is( '0777', umask_str( '00777' ),  'umask_str: 00777 => 0777' ) ;
	is( '0777', umask_str( ' 777 ' ),  'umask_str:  777  => 0777' ) ;
	is( "$UMASK_PARANO", umask_str( $UMASK_PARANO ),   "umask_str: UMASK_PARANO $UMASK_PARANO => $UMASK_PARANO" ) ;
	}

	is( $save_umask_str, umask_str( $save_umask_str ),  'umask_str: restore with str' ) ;
	is( $save_umask, umask, 'umask_str: umask is restored, controlled by direct umask' ) ;
	is( $save_umask, umask $save_umask, 'umask_str: umask is restored by direct umask' ) ;
	is( $save_umask, umask, 'umask_str: umask initial controlled by direct umask' ) ;

	note( 'Leaving  tests_umask_str()' ) ;
	return ;
}

sub umask_str
{
	my $value = shift ;

	if ( defined $value ) {
		umask oct( $value ) ;
	}
	my $current = umask ;

	return( sprintf( '%#04o', $current ) ) ;
}

sub tests_umask
{
	note( 'Entering tests_umask()' ) ;

	my $save_umask ;
	is( umask, umask, 'umask: umask is umask' ) ;
	is( $save_umask = umask, umask, "umask: umask is umask again + save it: $save_umask" ) ;
	is( $save_umask, umask oct(0000), 'umask: umask 0000' ) ;
	is( oct(0000), umask, 'umask: umask is now 0000' ) ;
	is( oct(0000), umask oct(777), 'umask: umask 0777 call, previous 0000' ) ;

	SKIP: {
	if ( 'MSWin32' eq $OSNAME ) { skip( 'Tests success only for Unix', 2 ) ; }
	is( oct(777), umask, 'umask: umask is now  0777' ) ;
	is( oct(777), umask $save_umask, "umask: umask $save_umask restore inital value, previous 0777" ) ;
	}

	ok( defined umask $save_umask, "umask: umask $save_umask restore inital value, previous defined" ) ;
	is( $save_umask, umask, 'umask: umask is umask restored' ) ;
	note( 'Leaving  tests_umask()' ) ;

	return ;
}

sub  cgisetcontext
{
	my $mysync = shift ;
	if ( ! under_cgi_context( $mysync ) ) { return ; }

	output( $mysync, "Under cgi context\n" ) ;
	set_umask( $mysync ) ;

        # Remove all content in unsafe evaled options
        @{ $mysync->{ regextrans2 } } = (  ) ;
        @regexflag   = (  ) ;
        @regexmess   = (  ) ;
        @skipmess    = (  ) ;
        @pipemess    = (  ) ;
        $delete2foldersonly   = undef ;
        $delete2foldersbutnot = undef ;
	$maxlinelengthcmd     = undef ;

	# Set safe default values (I hope...)

	$mysync->{pidfile} =  'imapsync.pid' ;
	$mysync->{pidfilelocking} = 1 ;
	$mysync->{errorsmax} = $ERRORS_MAX_CGI ;
	$modulesversion = 0 ;
	$mysync->{releasecheck} = defined  $mysync->{releasecheck}  ? $mysync->{releasecheck} : 1 ;
	$usecache = 0 ;
	$mysync->{showpasswords} = 0 ;
	$debugimap1 = $debugimap2 = $debugimap = 0 ;
	$reconnectretry1 = $reconnectretry2 = $DEFAULT_NB_RECONNECT_PER_IMAP_COMMAND ;
	$pipemesscheck = 0 ;

	$mysync->{hashfile} = $CGI_HASHFILE ;
	my $hashsynclocal = hashsynclocal( $mysync ) || die "Can not get hashsynclocal. Exiting\n" ;
	$cgidir = $CGI_TMPDIR_TOP . '/' . $hashsynclocal ;

        -d $cgidir or mkpath $cgidir or die "Can not create $cgidir: $OS_ERROR\n" ;
        chdir  $cgidir or die "Can not cd to $cgidir: $OS_ERROR\n" ;
	$mysync->{ tmpdir } = $cgidir ;
	cgioutputenvcontext( $mysync ) ;
        $mysync->{ debug } and output( $mysync, 'Current directory is ' . getcwd(  ) . "\n" ) ;
        $mysync->{ debug } and output( $mysync, 'Real user id is ' . getpwuid_any_os( $REAL_USER_ID ) . " (uid $REAL_USER_ID)\n" ) ;
        $mysync->{ debug } and output( $mysync, 'Effective user id is ' . getpwuid_any_os( $EFFECTIVE_USER_ID ). " (euid $EFFECTIVE_USER_ID)\n" ) ;

        $skipemptyfolders = defined  $skipemptyfolders  ? $skipemptyfolders : 1 ;

        # Out of memory with messages over 1 GB ?
        $mysync->{ maxsize } = defined  $mysync->{ maxsize }  ? $mysync->{ maxsize } : 1_000_000_000 ;

        # tail -f behaviour on by default
        $mysync->{ tail } = defined  $mysync->{ tail }  ? $mysync->{ tail } : 1 ;
        
        # not sure it's for good
        @useheader = qw( Message-Id ) ;

        # addheader on by default
        $mysync->{ addheader } = defined  $mysync->{ addheader }  ? $mysync->{ addheader } : 1 ;
        
        return ;
}

sub cgioutputenvcontext
{
	my $mysync = shift @ARG ;

	for my $envvar ( qw( REMOTE_ADDR REMOTE_HOST HTTP_REFERER HTTP_USER_AGENT SERVER_SOFTWARE SERVER_PORT HTTP_COOKIE ) ) {

		my $envval = $ENV{ $envvar } || q{} ;
		if ( $envval ) { output( $mysync, "$envvar is $envval\n" ) } ;
	}

	return ;
}





sub debugsleep
{
        my $mysync = shift @ARG ;
        if ( defined $mysync->{debugsleep} ) {
                myprint( "Info: sleeping $mysync->{debugsleep}s\n" ) ;
                sleep $mysync->{debugsleep} ;
        }
        return ;
}

sub foldersizes_on_h1h2
{
        my $mysync = shift ;

        myprint( << 'END_SIZE'  ) ;

Folders sizes before the synchronization.
You can remove foldersizes listings by using "--nofoldersizes" and "--nofoldersizesatend"
but then you will also lose the ETA (Estimation Time of Arrival) given after each message copy.
END_SIZE

        ( $h1_nb_msg_start, $h1_bytes_start ) = foldersizes( 'Host1', $mysync->{imap1}, $search1, $mysync->{abletosearch1}, @h1_folders_wanted        ) ;
        ( $h2_nb_msg_start, $h2_bytes_start ) = foldersizes( 'Host2', $mysync->{imap2}, $search2, $mysync->{abletosearch2}, @h2_folders_from_1_wanted ) ;

        if ( not all_defined( $h1_nb_msg_start, $h1_bytes_start, $h2_nb_msg_start, $h2_bytes_start ) ) {
                my $error = "Failure getting foldersizes, ETA and final diff will not be displayed\n" ;
                errors_incr( $mysync, $error ) ;
                $foldersizes = 0 ;
                $foldersizesatend = 0 ;
                return ;
        }

        my $h2_bytes_limit = $mysync->{h2}->{quota_limit_bytes} || 0 ;
        if ( $h2_bytes_limit and ( $h2_bytes_limit < $h1_bytes_start ) ) {
                my $quota_percent = mysprintf( '%.0f', $NUMBER_100 * $h1_bytes_start / $h2_bytes_limit ) ;
                my $error = "Host2: Quota limit will be exceeded! Over $quota_percent % ( $h1_bytes_start bytes / $h2_bytes_limit bytes )\n" ;
                errors_incr( $mysync, $error ) ;
        }
        return ;
}


sub total_bytes_max_reached
{
        my $mysync = shift ;

        if ( ! $mysync->{ exitwhenover } ) {
                return( 0 ) ;
        }
        if ( $mysync->{ total_bytes_transferred } >= $mysync->{ exitwhenover } ) {
                myprint( "Maximum bytes transferred reached, $mysync->{total_bytes_transferred} >= $mysync->{ exitwhenover }, ending sync\n"  ) ;
                return( 1 ) ;
        }
        return ;
}


sub tests_mock_capability
{
        note( 'Entering tests_mock_capability()' ) ;

        my $myimap ;
        ok( $myimap = mock_capability(  ),
            'mock_capability: (1) no args => a Test::MockObject'
        ) ;
        ok( $myimap->isa( 'Test::MockObject' ),
            'mock_capability: (2) no args => a Test::MockObject'
        ) ;

        is( undef, $myimap->capability(  ),
            'mock_capability: (3) no args => capability undef'
        ) ;

        ok( mock_capability( $myimap ),
            'mock_capability: (1) one arg  => MockObject'
        ) ;

        is( undef, $myimap->capability(  ),
            'mock_capability: (2) one arg OO style => capability undef'
        ) ;

        ok( mock_capability( $myimap, $NUMBER_123456 ),
            'mock_capability: (1) two args 123456 => capability 123456'
        ) ;

        is( $NUMBER_123456, $myimap->capability(  ),
            'mock_capability: (2) two args 123456 => capability 123456'
        ) ;

        ok( mock_capability( $myimap, 'ABCD' ),
            'mock_capability: (1) two args ABCD => capability ABCD'
        ) ;
        is( 'ABCD', $myimap->capability(  ),
            'mock_capability: (2) two args ABCD => capability ABCD'
        ) ;

        ok( mock_capability( $myimap, [ 'ABCD' ] ),
            'mock_capability: (1) two args [ ABCD ] => capability [ ABCD ]'
        ) ;
        is_deeply( [ 'ABCD' ], $myimap->capability(  ),
            'mock_capability: (2) two args [ ABCD ] => capability [ ABCD ]'
        ) ;

        ok( mock_capability( $myimap, [ 'ABC', 'DEF' ] ),
            'mock_capability: (1) two args [ ABC, DEF ] => capability [ ABC, DEF ]'
        ) ;
        is_deeply( [ 'ABC', 'DEF' ], $myimap->capability(  ),
            'mock_capability: (2) two args [ ABC, DEF ] => capability capability [ ABC, DEF ]'
        ) ;

        ok( mock_capability( $myimap, 'ABC', 'DEF' ),
            'mock_capability: (1) two args ABC, DEF => capability [ ABC, DEF ]'
        ) ;
        is_deeply( [ 'ABC', 'DEF' ], [ $myimap->capability(  ) ],
            'mock_capability: (2) two args ABC, DEF => capability capability [ ABC, DEF ]'
        ) ;

        ok( mock_capability( $myimap, 'IMAP4rev1', 'APPENDLIMIT=123456' ),
            'mock_capability: (1) two args IMAP4rev1, APPENDLIMIT=123456 => capability [ IMAP4rev1, APPENDLIMIT=123456 ]'
        ) ;
        is_deeply( [ 'IMAP4rev1', 'APPENDLIMIT=123456' ], [ $myimap->capability(  ) ],
            'mock_capability: (2) two args IMAP4rev1, APPENDLIMIT=123456 => capability capability [ IMAP4rev1, APPENDLIMIT=123456 ]'
        ) ;

        note( 'Leaving  tests_mock_capability()' ) ;
        return ;
}

sub sig_install_toggle_sleep
{
        my $mysync = shift ;
        if ( 'MSWin32' ne $OSNAME ) {
                #myprint( "sig_install( $mysync, \&toggle_sleep, 'USR1' )\n" ) ;
                sig_install( $mysync, 'toggle_sleep', 'USR1' ) ;
        }
        #myprint( "Leaving sig_install_toggle_sleep\n" ) ;
        return ;
}


sub mock_capability
{
        my $myimap = shift ;
        my @has_capability_value = @ARG ;
        my ( $has_capability_value ) = @has_capability_value ;

        if ( ! $myimap )
        {
                require_ok( "Test::MockObject" ) ;
                $myimap = Test::MockObject->new(  ) ;
        }

        $myimap->mock(
                'capability',
                sub { return  wantarray ?
                                @has_capability_value
                                : $has_capability_value ;
                }
        ) ;

        return $myimap ;
}


sub tests_capability_of
{
        note( 'Entering tests_capability_of()' ) ;

        is( undef, capability_of(  ),
            'capability_of: no args => undef' ) ;

        my $myimap ;
        is( undef, capability_of( $myimap ),
            'capability_of: undef => undef' ) ;


        $myimap = mock_capability( $myimap, 'IMAP4rev1', 'APPENDLIMIT=123456' ) ;

        is( undef, capability_of( $myimap, 'CACA' ),
            'capability_of: two args unknown capability => undef' ) ;


        is( $NUMBER_123456, capability_of( $myimap, 'APPENDLIMIT' ),
            'capability_of: two args APPENDLIMIT 123456 => 123456 yeah!' ) ;

        note( 'Leaving  tests_capability_of()' ) ;
        return ;
}


sub capability_of
{
        my $imap = shift || return ;
        my $capability_keyword = shift || return ;

        my @capability = $imap->capability ;

        if ( ! @capability ) { return ; }
        my $capability_value = search_in_array( $capability_keyword, @capability ) ;

        return $capability_value ;
}


sub tests_search_in_array
{
        note( 'Entering tests_search_in_array()' ) ;

        is( undef, search_in_array( 'KA' ),
                'search_in_array: no array => undef ' ) ;

        is( 'VA', search_in_array( 'KA', ( 'KA=VA' ) ),
                'search_in_array: KA KA=VA => VA ' ) ;

        is( 'VA', search_in_array( 'KA', ( 'KA=VA', 'KB=VB' ) ),
                'search_in_array: KA KA=VA KB=VB => VA ' ) ;

        is( 'VB', search_in_array( 'KB', ( 'KA=VA', 'KB=VB' ) ),
                'search_in_array: KA=VA KB=VB => VB ' ) ;

        note( 'Leaving  tests_search_in_array()' ) ;
        return ;
}

sub search_in_array
{
        my ( $key, @array ) = @ARG ;

        foreach my $item ( @array )
        {

        if ( $item =~ /([^=]+)=(.*)/ )
                {
                        if ( $1 eq $key )
                        {
                                return $2 ;
                        }
                }
        }

        return ;
}




sub tests_appendlimit_from_capability
{
        note( 'Entering tests_appendlimit_from_capability()' ) ;

        is( undef, appendlimit_from_capability(  ),
            'appendlimit_from_capability: no args => undef'
        ) ;

        my $myimap ;
        is( undef, appendlimit_from_capability( $myimap ),
            'appendlimit_from_capability: undef arg => undef'
        ) ;


        $myimap = mock_capability( $myimap, 'IMAP4rev1', 'APPENDLIMIT=123456' ) ;

        # Normal behavior
        is( $NUMBER_123456, appendlimit_from_capability( $myimap ),
            'appendlimit_from_capability: APPENDLIMIT=123456 => 123456'
        ) ;

        # Not a number
        $myimap = mock_capability( $myimap, 'IMAP4rev1', 'APPENDLIMIT=ABC' ) ;

        is( undef, appendlimit_from_capability( $myimap ),
            'appendlimit_from_capability: not a number => undef'
        ) ;

        note( 'Leaving  tests_appendlimit_from_capability()' ) ;
        return ;
}


sub appendlimit_from_capability
{
        my $myimap = shift ;
        if ( ! $myimap )
        {
                myprint( "Warn: no imap with call to appendlimit_from_capability\n" ) ;
                return ;
        }

        #myprint( Data::Dumper->Dump( [ \$myimap ] )  ) ;
        my $appendlimit = capability_of( $myimap, 'APPENDLIMIT' ) ;
        #myprint( "has_capability APPENDLIMIT $appendlimit\n" ) ;
        if ( is_an_integer( $appendlimit ) )
        {
                return $appendlimit ;
        }
        return ;
}


sub tests_appendlimit
{
        note( 'Entering tests_appendlimit()' ) ;

        is( undef, appendlimit(  ),
            'appendlimit: no args => undef'
        ) ;

        my $mysync = {  } ;

        is( undef, appendlimit( $mysync ),
            'appendlimit: no imap2 => undef'
        ) ;

        my $myimap ;
        $myimap = mock_capability( $myimap, 'IMAP4rev1', 'APPENDLIMIT=123456' ) ;

        $mysync->{ imap2 } = $myimap ;

        is( 123456, appendlimit( $mysync ),
            'appendlimit: imap2 with APPENDLIMIT=123456 => 123456'
        ) ;

        note( 'Leaving  tests_appendlimit()' ) ;
        return ;
}

sub appendlimit
{
        my $mysync = shift || return ;
        my $myimap = $mysync->{ imap2 } ;

        my $appendlimit = appendlimit_from_capability( $myimap ) ;
        if ( defined $appendlimit )
        {
                myprint( "Host2: found APPENDLIMIT=$appendlimit in CAPABILITY (use --appendlimit xxxx to override this automatic setting)\n" ) ;
                return $appendlimit ;
        }
        return ;

}


sub  tests_maxsize_setting
{
        note( 'Entering tests_maxsize_setting()' ) ;

        is( undef, maxsize_setting(  ),
           'maxsize_setting: no args => undef'
        ) ;

        my $mysync ;

        is( undef, maxsize_setting( $mysync  ),
           'maxsize_setting: undef arg => undef'
        ) ;

        $mysync = {  } ;
        $mysync->{ maxsize } = $NUMBER_123456 ;

        #  --maxsize alone
        is( $NUMBER_123456, maxsize_setting( $mysync ),
                'maxsize_setting: --maxsize 123456 alone => 123456'
        ) ;


        $mysync = {  } ;
        my $myimap ;

        $myimap = mock_capability( $myimap, 'IMAP4rev1', 'APPENDLIMIT=654321' ) ;
        $mysync->{ imap2 } = $myimap ;

        # APPENDLIMIT alone
        is( $NUMBER_654321, maxsize_setting( $mysync ),
                'maxsize_setting: APPENDLIMIT 654321 alone => 654321'
        ) ;

        is( $NUMBER_654321, $mysync->{ maxsize },
                'maxsize_setting: APPENDLIMIT 654321 alone => maxsize 654321'
        ) ;

        # APPENDLIMIT with --appendlimit => --appendlimit wins
        $mysync->{ appendlimit } = $NUMBER_123456 ;
        
        is( $NUMBER_123456, maxsize_setting( $mysync ),
                'maxsize_setting: APPENDLIMIT 654321 + --appendlimit 123456 => 123456'
        ) ;

        is( $NUMBER_123456, $mysync->{ maxsize },
                'maxsize_setting: APPENDLIMIT 654321 + --appendlimit 123456 => maxsize 123456'
        ) ;

        # Fresh
        $mysync = {  } ;
        $mysync->{ imap2 } = $myimap = mock_capability( $myimap, 'IMAP4rev1', 'APPENDLIMIT=654321' ) ;
        
        # Case: "APPENDLIMIT >= --maxsize" => maxsize.
        $mysync->{ maxsize } = $NUMBER_123456 ;

        is( $NUMBER_123456, maxsize_setting( $mysync ),
                'maxsize_setting: APPENDLIMIT 654321 --maxsize 123456 => 123456'
        ) ;

        # Case: "APPENDLIMIT < --maxsize" => APPENDLIMIT.
        
        
        # Fresh
        $mysync = {  } ;
        $mysync->{ imap2 } = $myimap = mock_capability( $myimap, 'IMAP4rev1', 'APPENDLIMIT=123456' ) ;
        $mysync->{ maxsize } = $NUMBER_654321 ;

        is( $NUMBER_123456, maxsize_setting( $mysync ),
                'maxsize_setting: APPENDLIMIT 123456 --maxsize 654321  => 123456 '
        ) ;

        # Now --truncmess stuff
        
        
        
        note( 'Leaving  tests_maxsize_setting()' ) ;

        return ;
}

# Three variables to take account of
# appendlimit (given by --appendlimit or CAPABILITY...)
# maxsize
# truncmess

sub maxsize_setting
{
        my $mysync = shift || return ;

        if ( defined $mysync->{ appendlimit } )
        {
                myprint( "Host2: Getting appendlimit from --appendlimit $mysync->{ appendlimit }\n" ) ;
        }
        else
        {
                $mysync->{ appendlimit } = appendlimit( $mysync ) ;
        }


        if ( all_defined( $mysync->{ appendlimit },  $mysync->{ maxsize } ) )
        {
                my $min_maxsize_appendlimit = min( $mysync->{ maxsize }, $mysync->{ appendlimit } ) ;
                myprint( "Host2: Setting maxsize to $min_maxsize_appendlimit (min of --maxsize $mysync->{ maxsize } and appendlimit $mysync->{ appendlimit }\n" ) ;
                $mysync->{ maxsize } = $min_maxsize_appendlimit ;
                return $mysync->{ maxsize } ;
        }
        elsif ( defined $mysync->{ appendlimit } )
        {
                myprint( "Host2: Setting maxsize to appendlimit $mysync->{ appendlimit }\n" ) ;
                $mysync->{ maxsize } = $mysync->{ appendlimit } ;
                return $mysync->{ maxsize } ;
        }elsif ( defined $mysync->{ maxsize } )
        {
                return $mysync->{ maxsize } ;
        }else
        {
                return ;
        }
}




sub all_defined
{
        if ( not @ARG ) {
                return 0 ;
        }
        foreach my $elem ( @ARG ) {
                if ( not defined $elem ) {
                        return 0 ;
                }
        }
        return 1 ;
}

sub tests_all_defined
{
	note( 'Entering tests_all_defined()' ) ;

        is( 0, all_defined(  ),             'all_defined: no param  => 0' ) ;
        is( 0, all_defined( () ),           'all_defined: void list => 0' ) ;
        is( 0, all_defined( undef ),        'all_defined: undef     => 0' ) ;
        is( 0, all_defined( undef, undef ), 'all_defined: undef     => 0' ) ;
        is( 0, all_defined( 1, undef ),     'all_defined: 1 undef   => 0' ) ;
        is( 0, all_defined( undef, 1 ),     'all_defined: undef 1   => 0' ) ;
        is( 1, all_defined( 1, 1 ),         'all_defined: 1 1   => 1' ) ;
        is( 1, all_defined( (1, 1) ),       'all_defined: (1 1) => 1' ) ;

	note( 'Leaving  tests_all_defined()' ) ;
        return ;
}


sub tests_hashsynclocal
{
	note( 'Entering tests_hashsynclocal()' ) ;

	my $mysync = {
		host1 => '',
		user1 => '',
		password1 => '',
		host2 => '',
		user2 => '',
		password2 => '',
	} ;

	is( undef, hashsynclocal( $mysync ), 'hashsynclocal: no hashfile name' ) ;

	$mysync->{ hashfile } = '' ;
	is( undef, hashsynclocal( $mysync ), 'hashsynclocal: empty hashfile name' ) ;

	$mysync->{ hashfile } = './noexist/rrr' ;
	is( undef, hashsynclocal( $mysync ), 'hashsynclocal: no exists hashfile dir' ) ;

	SKIP: {
		if ( 'MSWin32' eq $OSNAME or '0' eq $EFFECTIVE_USER_ID ) { skip( 'Tests only for non-root Unix', 1 ) ; }
		$mysync->{ hashfile } = '/rrr' ;
		is( undef, hashsynclocal( $mysync ), 'hashsynclocal: permission denied' ) ;
	}
	ok( (-d 'W/tmp/tests/' or  mkpath( 'W/tmp/tests/' ) ), 'hashsynclocal: mkpath W/tmp/tests/' ) ;
	$mysync->{ hashfile } = 'W/tmp/tests/imapsync_hash' ;

	ok( ! -e 'W/tmp/tests/imapsync_hash' || unlink 'W/tmp/tests/imapsync_hash', 'hashsynclocal: unlink W/tmp/tests/imapsync_hash' ) ;
	ok( ! -e 'W/tmp/tests/imapsync_hash', 'hashsynclocal: verify there is no W/tmp/tests/imapsync_hash' ) ;
	is( 'ecdeb4ede672794d173da4e08c52b8ee19b7d252', hashsynclocal( $mysync, 'mukksyhpmbixkxkpjlqivmlqsulpictj' ), 'hashsynclocal: creating/reading W/tmp/tests/imapsync_hash' ) ;
	# A second time now
	is( 'ecdeb4ede672794d173da4e08c52b8ee19b7d252', hashsynclocal( $mysync ), 'hashsynclocal: reading W/tmp/tests/imapsync_hash second time => same' ) ;

	note( 'Leaving  tests_hashsynclocal()' ) ;
	return ;
}

sub hashsynclocal
{
	my $mysync = shift ;
	my $hashkey = shift ; # Optional, only there for tests
	my $hashfile = $mysync->{ hashfile } ;
	$hashfile = createhashfileifneeded( $hashfile, $hashkey ) ;
	if ( ! $hashfile ) {
		return ;
	}
	$hashkey = firstline( $hashfile ) ;
	if ( ! $hashkey ) {
		myprint( "No hashkey!\n" ) ;
		return ;
	}
	my $hashsynclocal = hashsync( $mysync, $hashkey ) ;
	return( $hashsynclocal ) ;

}

sub tests_hashsync
{
	note( 'Entering tests_hashsync()' ) ;


	is( 'fbdb1d1b18aa6c08324b7d64b71fb76370690e1d', hashsync( {}, q{} ), 'hashsync: empty args' ) ;
	my $mysync ;
	$mysync->{ host1 } = 'zzz' ;
	is( 'e86a28a3611c1e7bbaf8057cd00ae122781a11fe', hashsync( $mysync, q{} ), 'hashsync: host1 zzz => ' ) ;
	is( 'e86a28a3611c1e7bbaf8057cd00ae122781a11fe', hashsync( $mysync, q{} ), 'hashsync: host1 zzz => ' ) ;
	$mysync->{ host2 } = 'zzz' ;
	is( '15959573e4a86763253a7aedb1a2b0c60d133dc2', hashsync( $mysync, q{} ), 'hashsync: + host2 zzz => ' ) ;
	is( 'b8d4ab541b209c75928528020ca28ee43488bd8f', hashsync( $mysync, 'A' ), 'hashsync: + hashkey A => ' ) ;

	note( 'Leaving  tests_hashsync()' ) ;
	return ;
}

sub hashsync
{
	my $mysync  = shift ;
	my $hashkey = shift ;

	my $mystring = join( q{},
		$mysync->{ host1 }     || q{},
		$mysync->{ user1 }     || q{},
		$mysync->{ password1 } || q{},
		$mysync->{ host2 }     || q{},
		$mysync->{ user2 }     || q{},
		$mysync->{ password2 } || q{},
	) ;
	my $hashsync = hmac_sha1_hex( $mystring, $hashkey ) ;
	#myprint( "$hashsync\n" ) ;
	return( $hashsync ) ;
}


sub tests_createhashfileifneeded
{
	note( 'Entering tests_createhashfileifneeded()' ) ;

	is( undef, createhashfileifneeded(  ), 'createhashfileifneeded: no parameters => undef' ) ;

	note( 'Leaving  tests_createhashfileifneeded()' ) ;
	return ;
}

sub createhashfileifneeded
{
	my $hashfile = shift ;
	my $hashkey  = shift || rand32(  ) ;

	# no name
	if ( ! $hashfile ) {
		return ;
	}
	# already there
	if ( -e -r $hashfile ) {
		return $hashfile ;
	}
	# not creatable
	if ( ! -w dirname( $hashfile ) ) {
		return ;
	}
	# creatable
	open my $FILE_HANDLE, '>', $hashfile
                or do {
                        myprint( "Could not open $hashfile for writing. Check permissions or disk space."  ) ;
                return ;
        } ;
        myprint( "Writing random hashkey in $hashfile, once for all times\n"  ) ;
        print $FILE_HANDLE $hashkey ;
        close $FILE_HANDLE ;
	# Should be there now
	if ( -e -r $hashfile ) {
		return $hashfile ;
	}
	# unknown failure
	return ;
}

sub tests_rand32
{
	note( 'Entering tests_rand32()' ) ;

	my $string = rand32(  ) ;
	myprint( "$string\n" ) ;
	is( 32, length( $string ),    'rand32: 32 characters long' ) ;
	is( 32, length( rand32(  ) ), 'rand32: 32 characters long, another one' ) ;

	note( 'Leaving  tests_rand32()' ) ;
	return ;
}

sub rand32
{
	my @chars = ( "a".."z" ) ;
	my $string;
	$string .= $chars[rand @chars] for 1..32 ;
	return $string ;
}

sub imap_id_stuff
{
        my $mysync = shift ;

        if ( not $mysync->{id} ) { return ; } ;

        $mysync->{h1_imap_id} = imap_id( $mysync, $mysync->{imap1}, 'Host1' ) ;
        #myprint( 'Host1: ' . $mysync->{h1_imap_id}  ) ;
        $mysync->{h2_imap_id} = imap_id( $mysync, $mysync->{imap2}, 'Host2' ) ;
        #myprint( 'Host2: ' . $mysync->{h2_imap_id}  ) ;

        return ;
}

sub imap_id
{
        my ( $mysync, $imap, $Side ) = @_ ;

        $Side ||= q{} ;
        my $imap_id_response = q{} ;

        if ( not $imap->has_capability( 'ID' ) ) {
                 $imap_id_response = 'No ID capability' ;
                 myprint( "$Side: No ID capability\n"  ) ;
        }else{
                my $id_inp = imapsync_id( $mysync, { side => lc $Side } ) ;
                myprint( "\n$Side: found ID capability. Sending/receiving ID, presented in raw IMAP for now.\n"
                . "In order to avoid sending/receiving ID, use option --noid\n" ) ;
                my $debug_before = $imap->Debug(  ) ;
                $imap->Debug( 1 ) ;
                my $id_out = $imap->tag_and_run( 'ID ' . $id_inp ) ;
                #my $id_out = $imap->tag_and_run( 'ID NIL' ) ;
                myprint( "\n"  ) ;
                $imap->Debug( $debug_before ) ;
                #$imap_id_response = Data::Dumper->Dump( [ $id_out ], [ 'IMAP_ID' ] ) ;
        }
        return( $imap_id_response ) ;
}

sub imapsync_id
{
        my $mysync = shift ;
        my $overhashref = shift ;
        # See http://tools.ietf.org/html/rfc2971.html

        my $imapsync_id = { } ;

        my $imapsync_id_lamiral = {
                name          => 'imapsync',
                version       => imapsync_version( $mysync ),
                os            => $OSNAME,
                vendor        => 'Gilles LAMIRAL',
                'support-url' => 'https://imapsync.lamiral.info/',
                # Example of date-time:  19-Sep-2015 08:56:07
                date          => date_from_rcs( q{$Date: 2019/06/26 19:30:56 $ } ),
        } ;

        my $imapsync_id_github  = {
                name          => 'imapsync',
                version       => imapsync_version( $mysync ),
                os            => $OSNAME,
                vendor        => 'github',
                'support-url' => 'https://github.com/imapsync/imapsync',
                date          => date_from_rcs( q{$Date: 2019/06/26 19:30:56 $ } ),
        } ;

        $imapsync_id = $imapsync_id_lamiral ;
        #$imapsync_id = $imapsync_id_github ;
        my %mix = ( %{ $imapsync_id }, %{ $overhashref } ) ;
        my $imapsync_id_str = format_for_imap_arg( \%mix ) ;
        #myprint( "$imapsync_id_str\n"  ) ;
        return( $imapsync_id_str ) ;
}

sub tests_imapsync_id
{
	note( 'Entering tests_imapsync_id()' ) ;

        my $mysync ;
        ok( '("name" "imapsync" "version" "111" "os" "beurk" "vendor" "Gilles LAMIRAL" "support-url" "https://imapsync.lamiral.info/" "date" "22-12-1968" "side" "host1")'
                eq imapsync_id( $mysync,
                        {
                        version => 111,
                        os => 'beurk',
                        date => '22-12-1968',
                        side => 'host1'
                        }
                ),
                'tests_imapsync_id override'
        ) ;

	note( 'Leaving  tests_imapsync_id()' ) ;
        return ;
}

sub format_for_imap_arg
{
        my $ref = shift ;

        my $string = q{} ;
        my %terms = %{ $ref } ;
        my @terms = (  ) ;
        if ( not ( %terms ) ) { return( 'NIL' ) } ;
        # sort like in RFC then add extra key/values
        foreach my $key ( qw( name version os os-version vendor support-url address date command arguments environment) ) {
                if ( $terms{ $key } ) {
                        push  @terms, $key, $terms{ $key }  ;
                        delete $terms{ $key } ;
                }
        }
        push  @terms, %terms  ;
        $string = '(' . ( join q{ }, map { '"' . $_ . '"' } @terms )  . ')' ;
        return( $string ) ;
}



sub tests_format_for_imap_arg
{
	note( 'Entering tests_format_for_imap_arg()' ) ;

        ok( 'NIL' eq format_for_imap_arg( { } ), 'format_for_imap_arg empty hash ref' ) ;
        ok( '("name" "toto")' eq format_for_imap_arg( { name => 'toto' } ), 'format_for_imap_arg { name => toto }' ) ;
        ok( '("name" "toto" "key" "val")' eq format_for_imap_arg( { name => 'toto', key => 'val' } ), 'format_for_imap_arg 2 x key val' ) ;

	note( 'Leaving  tests_format_for_imap_arg()' ) ;
        return ;
}

sub quota
{
        my ( $mysync, $imap, $side ) = @_ ;

	my %side = (
		h1 => 'Host1',
		h2 => 'Host2',
	) ;
        my $Side = $side{ $side } ;
        my $debug_before = $imap->Debug(  ) ;
        $imap->Debug( 1 ) ;
        if ( not $imap->has_capability( 'QUOTA' ) ) {
                $imap->Debug( $debug_before ) ;
                return ;
        } ;
        myprint( "\n$Side: found quota, presented in raw IMAP\n"  ) ;
        my $getquotaroot = $imap->getquotaroot( 'INBOX' ) ;
        # Gmail INBOX quotaroot is "" but with it Mail::IMAPClient does a literal GETQUOTA {2} \n ""
        #$imap->quota( 'ROOT' ) ;
        #$imap->quota( '""' ) ;
        myprint( "\n"  ) ;
        $imap->Debug( $debug_before ) ;
        my $quota_limit_bytes   = quota_extract_storage_limit_in_bytes( $mysync, $getquotaroot ) ;
        my $quota_current_bytes = quota_extract_storage_current_in_bytes( $mysync, $getquotaroot ) ;
        $mysync->{$side}->{quota_limit_bytes}   = $quota_limit_bytes ;
        $mysync->{$side}->{quota_current_bytes} = $quota_current_bytes ;
        my $quota_percent ;
        if ( $quota_limit_bytes > 0 ) {
                $quota_percent = mysprintf( '%.2f', $NUMBER_100 * $quota_current_bytes / $quota_limit_bytes ) ;
        }else{
                $quota_percent = 0 ;
        }
        myprint( "$Side: Quota current storage is $quota_current_bytes bytes. Limit is $quota_limit_bytes bytes. So $quota_percent % full\n"  ) ;
        if ( $QUOTA_PERCENT_LIMIT < $quota_percent ) {
                my $error = "$Side: $quota_percent % full: it is time to find a bigger place! ( $quota_current_bytes bytes / $quota_limit_bytes bytes )\n" ;
                errors_incr( $mysync, $error ) ;
        }
        return ;
}

sub tests_quota_extract_storage_limit_in_bytes
{
        note( 'Entering tests_quota_extract_storage_limit_in_bytes()' ) ;

        my $mysync = {} ;
        my $imap_output = [
        '* QUOTAROOT "INBOX" "Storage quota" "Messages quota"',
        '* QUOTA "Storage quota" (STORAGE 1 104857600)',
        '* QUOTA "Messages quota" (MESSAGE 2 100000)',
        '5 OK Getquotaroot completed.'
        ] ;
        ok( $NUMBER_104_857_600 * $KIBI == quota_extract_storage_limit_in_bytes( $mysync, $imap_output ), 'quota_extract_storage_limit_in_bytes ') ;

        note( 'Leaving  tests_quota_extract_storage_limit_in_bytes()' ) ;
        return ;
}

sub quota_extract_storage_limit_in_bytes
{
        my $mysync = shift ;
        my $imap_output = shift ;

        my $limit_kb ;
        $limit_kb = ( map { /.*\(\s*STORAGE\s+\d+\s+(\d+)\s*\)/x ? $1 : () } @{ $imap_output } )[0] ;
        $limit_kb ||= 0 ;
        $mysync->{ debug } and myprint( "storage_limit_kb = $limit_kb\n"  ) ;
        return( $KIBI * $limit_kb ) ;
}


sub tests_quota_extract_storage_current_in_bytes
{
	note( 'Entering tests_quota_extract_storage_current_in_bytes()' ) ;

        my $mysync = {} ;
        my $imap_output = [
        '* QUOTAROOT "INBOX" "Storage quota" "Messages quota"',
        '* QUOTA "Storage quota" (STORAGE 1 104857600)',
        '* QUOTA "Messages quota" (MESSAGE 2 100000)',
        '5 OK Getquotaroot completed.'
        ] ;
        ok( 1*$KIBI == quota_extract_storage_current_in_bytes( $mysync, $imap_output ), 'quota_extract_storage_current_in_bytes: 1 => 1024 ') ;

	note( 'Leaving  tests_quota_extract_storage_current_in_bytes()' ) ;
        return ;
}

sub quota_extract_storage_current_in_bytes
{
        my $mysync = shift ;
        my $imap_output = shift ;

        my $current_kb ;
        $current_kb = ( map { /.*\(\s*STORAGE\s+(\d+)\s+\d+\s*\)/x ? $1 : () } @{ $imap_output } )[0] ;
        $current_kb ||= 0 ;
        $mysync->{ debug } and myprint( "storage_current_kb = $current_kb\n"  ) ;
        return( $KIBI * $current_kb ) ;

}


sub automap
{
        my ( $mysync ) = @_ ;

        if ( $mysync->{automap} ) {
                myprint( "Turned on automapping folders ( use --noautomap to turn off automapping )\n"  ) ;
        }else{
                myprint( "Turned off automapping folders ( use --automap to turn on automapping )\n"  ) ;
                return ;
        }

        $mysync->{h1_special} = special_from_folders_hash( $mysync, $mysync->{imap1}, 'Host1' ) ;
        $mysync->{h2_special} = special_from_folders_hash( $mysync, $mysync->{imap2}, 'Host2' ) ;

        build_possible_special( $mysync ) ;
        build_guess_special(  $mysync ) ;
        build_automap( $mysync ) ;

        return ;
}




sub build_guess_special
{
        my ( $mysync ) = shift ;

        foreach my $h1_fold ( sort keys  %{ $mysync->{h1_folders_all} }  ) {
                my $special = guess_special( $h1_fold, $mysync->{possible_special}, $mysync->{h1_prefix} ) ;
                if ( $special ) {
                        $mysync->{h1_special_guessed}{$h1_fold} = $special ;
                        my $already_guessed = $mysync->{h1_special_guessed}{$special} ;
                        if ( $already_guessed ) {
                                myprint( "Host1: $h1_fold not $special because set to $already_guessed\n"  ) ;
                        }else{
                                $mysync->{h1_special_guessed}{$special} = $h1_fold ;
                        }
                }
        }
        foreach my $h2_fold ( sort keys  %{ $mysync->{h2_folders_all} }  ) {
                my $special = guess_special( $h2_fold, $mysync->{possible_special}, $mysync->{h2_prefix} ) ;
                if ( $special ) {
                        $mysync->{h2_special_guessed}{$h2_fold} = $special ;
                        my $already_guessed = $mysync->{h2_special_guessed}{$special} ;
                        if ( $already_guessed ) {
                                myprint( "Host2: $h2_fold not $special because set to $already_guessed\n"  ) ;
                        }else{
                                $mysync->{h2_special_guessed}{$special} = $h2_fold ;
                        }
                }
        }
        return ;
}

sub guess_special
{
        my( $folder, $possible_special_ref, $prefix ) = @_ ;

        my $folder_no_prefix = $folder ;
        $folder_no_prefix =~ s/\Q${prefix}\E//xms ;
        #$debug and myprint( "folder_no_prefix: $folder_no_prefix\n"  ) ;

        my $guess_special = $possible_special_ref->{ $folder }
                || $possible_special_ref->{ $folder_no_prefix }
                || q{} ;

        return( $guess_special ) ;
}

sub tests_guess_special
{
	note( 'Entering tests_guess_special()' ) ;

        my $possible_special_ref = build_possible_special( my $mysync ) ;
        ok( '\Sent' eq guess_special( 'Sent', $possible_special_ref, q{} ) ,'guess_special: Sent => \Sent' ) ;
        ok( q{} eq guess_special( 'Blabla', $possible_special_ref, q{} ) ,'guess_special: Blabla => q{}' ) ;
        ok( '\Sent' eq guess_special( 'INBOX.Sent', $possible_special_ref, 'INBOX.' ) ,'guess_special: INBOX.Sent => \Sent' ) ;
        ok( '\Sent' eq guess_special( 'IN BOX.Sent', $possible_special_ref, 'IN BOX.' ) ,'guess_special: IN BOX.Sent => \Sent' ) ;

	note( 'Leaving  tests_guess_special()' ) ;
        return ;
}

sub build_automap
{
        my $mysync = shift ;
	$mysync->{ debug } and myprint( "Entering build_automap\n" ) ;
        foreach my $h1_fold ( @{ $mysync->{h1_folders_wanted} } ) {
                my $h2_fold ;
                my $h1_special = $mysync->{h1_special}{$h1_fold} ;
                my $h1_special_guessed = $mysync->{h1_special_guessed}{$h1_fold} ;

                # Case 1: special on both sides.
                if ( $h1_special
                     and exists  $mysync->{h2_special}{$h1_special}  ) {
                        $h2_fold = $mysync->{h2_special}{$h1_special} ;
                        $mysync->{f1f2auto}{ $h1_fold } = $h2_fold ;
                        next ;
                }
                # Case 2: special on host1, not on host2
                if ( $h1_special
                     and ( not exists  $mysync->{h2_special}{$h1_special}  )
                     and ( exists  $mysync->{h2_special_guessed}{$h1_special}  )
                   ) {
                        # special_guessed on host2
                        $h2_fold = $mysync->{h2_special_guessed}{$h1_special} ;
                        $mysync->{f1f2auto}{ $h1_fold } = $h2_fold ;
                        next ;
                }
                # Case 3: no special on host1, special on host2
                if ( ( not $h1_special )
                     and ( $h1_special_guessed )
                     and ( exists  $mysync->{h2_special}{$h1_special_guessed}  )
                ) {
                        $h2_fold = $mysync->{h2_special}{$h1_special_guessed} ;
                        $mysync->{f1f2auto}{ $h1_fold } = $h2_fold ;
                        next ;
                }
                # Case 4: no special on both sides.
                if ( ( not $h1_special )
                     and ( $h1_special_guessed )
                     and ( not exists  $mysync->{h2_special}{$h1_special_guessed}  )
                     and ( exists  $mysync->{h2_special_guessed}{$h1_special_guessed}  )
                ) {
                        $h2_fold = $mysync->{h2_special_guessed}{$h1_special_guessed} ;
                        $mysync->{f1f2auto}{ $h1_fold } = $h2_fold ;
                        next ;
                }
        }
        return( $mysync->{f1f2auto} ) ;
}

# I will not add what there is at:
# http://stackoverflow.com/questions/2185391/localized-gmail-imap-folders/2185548#2185548
# because it works well without
sub build_possible_special
{
        my $mysync = shift ;
        my $possible_special = { } ;
        # All|Archive|Drafts|Flagged|Junk|Sent|Trash

        $possible_special->{'\All'}     = [ 'All', 'All Messages', '&BBIEQQQ1-' ] ;
        $possible_special->{'\Archive'} = [ 'Archive', 'Archives', '&BBAEQARFBDgEMg-' ] ;
        $possible_special->{'\Drafts'}  = [ 'Drafts', 'DRAFTS', '&BCcENQRABD0EPgQyBDgEOgQ4-', 'Szkice', 'Wersje robocze' ] ;
        $possible_special->{'\Flagged'} = [ 'Flagged', 'Starred', '&BB8EPgQ8BDUERwQ1BD0EPQRLBDU-' ] ;
        $possible_special->{'\Junk'}    = [ 'Junk', 'junk', 'Spam', 'SPAM', '&BCEEPwQwBDw-', 
                                            'Potwierdzony spam', 'Wiadomo&AVs-ci-&AVs-mieci',
                                            'Junk E-Mail', 'Junk Email'] ;
        $possible_special->{'\Sent'}    = [ 'Sent', 'Sent Messages', 'Sent Items',
                                            'Gesendete Elemente', 'Gesendete Objekte',
                                            '&AMk-l&AOk-ments envoy&AOk-s', 'Envoy&AOk-', 'Objets envoy&AOk-s',
                                            'Elementos enviados',
                                            '&kAFP4W4IMH8wojCkMMYw4A-',
                                            '&BB4EQgQ,BEAEMAQyBDsENQQ9BD0ESwQ1-',
                                            'Elementy wys&AUI-ane'] ;
        $possible_special->{'\Trash'}   = [ 'Trash', 'TRASH',
                                            '&BCMENAQwBDsENQQ9BD0ESwQ1-', '&BBoEPgRABDcEOAQ9BDA-', 
                                            'Kosz',
                                            'Deleted Items', 'Deleted Messages' ] ;


        foreach my $special ( qw( \All \Archive \Drafts \Flagged \Junk \Sent \Trash ) ){
                foreach my $possible_folder ( @{ $possible_special->{$special} } ) {
                        $possible_special->{ $possible_folder } = $special ;
                } ;
        }
        $mysync->{possible_special} = $possible_special ;
        $mysync->{ debug } and myprint( Data::Dumper->Dump( [ $possible_special ], [ 'possible_special' ] )  ) ;
        return( $possible_special ) ;
}

sub tests_special_from_folders_hash
{
	note( 'Entering tests_special_from_folders_hash()' ) ;

        my $mysync = {} ;
        require_ok( "Test::MockObject" ) ;
        my $imapT = Test::MockObject->new(  ) ;

        is( undef, special_from_folders_hash(  ), 'special_from_folders_hash: no args' ) ;
        is( undef, special_from_folders_hash( $mysync ), 'special_from_folders_hash: undef args' ) ;
        is_deeply( {}, special_from_folders_hash( $mysync, $imapT ), 'special_from_folders_hash: $imap void' ) ;

        $imapT->mock( 'folders_hash', sub { return( [ { name => 'Sent', attrs => [ '\Sent' ] } ] ) } ) ;

        is_deeply( { Sent => '\Sent', '\Sent' => 'Sent' },
                special_from_folders_hash( $mysync, $imapT ), 'special_from_folders_hash: $imap \Sent' ) ;

	note( 'Leaving  tests_special_from_folders_hash()' ) ;
        return(  ) ;
}

sub special_from_folders_hash
{
        my ( $mysync, $imap, $side ) = @_ ;
        my %special = (  ) ;

        if ( ! defined $imap  ) { return ; }
        $side = defined $side ? $side : 'Host?' ;

        if ( ! $imap->can( 'folders_hash' ) ) {
                my $error =  "$side: To have automagic rfc6154 folder mapping, upgrade Mail::IMAPClient >= 3.34\n" ;
                errors_incr( $mysync, $error ) ;
                return( \%special ) ; # empty hash ref
        }
        my $folders_hash = $imap->folders_hash(  ) ;
        foreach my $fhash (@{ $folders_hash } ) {
                        my @special =  grep { /\\(?:All|Archive|Drafts|Flagged|Junk|Sent|Trash)/x } @{ $fhash->{attrs} }  ;
                        if ( @special ) {
                                my $special = $special[0] ; # keep first one. Could be not very good.
                                if ( exists  $special{ $special }  ) {
                                        myprintf( "%s: special %-20s = %s already assigned to %s\n",
                                                $side, $fhash->{name}, join( q{ }, @special ), $special{ $special } ) ;
                                }else{
                                        myprintf( "%s: special %-20s = %s\n",
                                                $side, $fhash->{name}, join( q{ }, @special ) ) ;
                                        $special{ $special } = $fhash->{name} ;
                                        $special{ $fhash->{name} } = $special ; # double entry value => key
                                }
                        }
                }
        myprint( "\n" ) if ( %special ) ;
        return( \%special ) ;
}

sub errors_incr
{
        my ( $mysync, @error ) = @ARG ;
        $mysync->{nb_errors}++ ;

        if ( @error ) {
                errors_log( $mysync, @error ) ;
                myprint( @error ) ;
        }

        $mysync->{errorsmax} ||= $ERRORS_MAX ;
        if ( $mysync->{nb_errors} >= $mysync->{errorsmax} ) {
                myprint( "Maximum number of errors $mysync->{errorsmax} reached ( you can change $mysync->{errorsmax} to any value, for example 100 with --errorsmax 100 ). Exiting.\n"  ) ;
                if ( $mysync->{errorsdump} ) {
                        myprint( errorsdump( $mysync->{nb_errors}, errors_log( $mysync ) ) ) ;
                        # again since errorsdump(  ) can be very verbose and masquerade previous warning
                        myprint( "Maximum number of errors $mysync->{errorsmax} reached ( you can change $mysync->{errorsmax} to any value, for example 100 with --errorsmax 100 ). Exiting.\n"  ) ;
                }
                exit_clean( $mysync, $EXIT_WITH_ERRORS_MAX ) ;
        }
        return ;
}

sub tests_errors_log
{
        note( 'Entering tests_errors_log()' ) ;
        is( undef, errors_log(  ), 'errors_log: no args => undef' ) ;
        my $mysync = {} ;
        is( undef, errors_log( $mysync ), 'errors_log: empty => undef' ) ;
        is_deeply( [ 'aieaie' ], [ errors_log( $mysync, 'aieaie' ) ], 'errors_log: aieaie => aieaie' ) ;
        # cumulative
        is_deeply( [ 'aieaie' ], [ errors_log( $mysync ) ], 'errors_log: nothing more => aieaie' ) ;
        is_deeply( [ 'aieaie', 'ouille' ], [ errors_log( $mysync, 'ouille' ) ], 'errors_log: ouille => aieaie ouille' ) ;
        is_deeply( [ 'aieaie', 'ouille' ], [ errors_log( $mysync ) ], 'errors_log: nothing more => aieaie ouille' ) ;
        note( 'Leaving  tests_errors_log()' ) ;
        return ;
}

sub errors_log
{
        my ( $mysync, @error ) = @ARG ;

        if ( ! $mysync->{errors_log} ) {
                $mysync->{errors_log} = [] ;
        }

        if ( @error ) {
                push  @{ $mysync->{errors_log} }, join( q{}, @error  ) ;
        }
        if ( @{ $mysync->{errors_log} } ) {
                return @{ $mysync->{errors_log} } ;
        }
        else {
                return ;
        }
}


sub errorsdump
{
        my( $nb_errors, @errors_log ) = @ARG ;
        my $error_num = 0 ;
        my $errors_list = q{} ;
        if ( @errors_log ) {
                $errors_list = "++++ Listing $nb_errors errors encountered during the sync ( avoid this listing with --noerrorsdump ).\n" ;
                foreach my $error ( @errors_log ) {
                        $error_num++ ;
                        $errors_list .= "Err $error_num/$nb_errors: $error" ;
                }
        }
        return( $errors_list ) ;
}


sub tests_live_result
{
	note( 'Entering tests_live_result()' ) ;

        my $nb_errors = shift ;
        if ( $nb_errors  ) {
                myprint( "Live tests failed with $nb_errors errors\n"  ) ;
        } else {
                myprint( "Live tests ended successfully\n"  ) ;
        }
	note( 'Leaving  tests_live_result()' ) ;
        return ;
}

sub foldersizesatend
{
        my $mysync = shift ;
        timenext(  ) ;
        return if ( $mysync->{imap1}->IsUnconnected(  ) ) ;
        return if ( $mysync->{imap2}->IsUnconnected(  ) ) ;
        # Get all folders on host2 again since new were created
        @h2_folders_all = sort $mysync->{imap2}->folders();
        for ( @h2_folders_all ) {
                $h2_folders_all{ $_ } = 1 ;
                $h2_folders_all_UPPER{ uc  $_  } = 1 ;
        } ;
        ( $h1_nb_msg_end, $h1_bytes_end ) = foldersizes( 'Host1', $mysync->{imap1}, $search1, $mysync->{abletosearch1}, @h1_folders_wanted ) ;
        ( $h2_nb_msg_end, $h2_bytes_end ) = foldersizes( 'Host2', $mysync->{imap2}, $search2, $mysync->{abletosearch2}, @h2_folders_from_1_wanted ) ;
        if ( not all_defined( $h1_nb_msg_end, $h1_bytes_end, $h2_nb_msg_end, $h2_bytes_end ) ) {
                my $error = "Failure getting foldersizes, final differences will not be calculated\n" ;
                errors_incr( $mysync, $error ) ;
        }
        return ;
}

sub size_filtered_flag
{
        my $mysync = shift ;
        my $h1_size = shift ;

        if ( defined $mysync->{ maxsize } and $h1_size >= $mysync->{ maxsize } ) {
                return( 1 ) ;
        }
        if ( defined $minsize and $h1_size <= $minsize ) {
                return( 1 ) ;
        }
        return( 0 ) ;
}

sub sync_flags_fir
{
        my ( $mysync, $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( $mysync, $h1_size ) ;

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

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

        return ;
}

sub sync_flags_after_copy
{
        # Activated with option --syncflagsaftercopy
        my( $mysync, $h1_fold, $h1_msg, $h1_flags, $h2_fold, $h2_msg, $permanentflags2 ) = @_ ;

        if ( my @h2_flags = $mysync->{imap2}->flags( $h2_msg ) ) {
                my $h2_flags = "@h2_flags" ;
                ( $mysync->{ debug } or $debugflags ) and myprint( "Host2: msg $h2_fold/$h2_msg flags before sync flags after copy ( $h2_flags )\n"  ) ;
                sync_flags( $mysync, $h1_fold, $h1_msg, $h1_flags, $h2_fold, $h2_msg, $h2_flags, $permanentflags2 ) ;
        }else{
                myprint( "Host2: msg $h2_fold/$h2_msg could not get its flags for sync flags after copy\n"  ) ;
        }
        return ;
}

# Globals
# $debug
# $debugflags
# $permanentflags2


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

        ( $mysync->{ debug } or $debugflags ) and
        myprint( "Host1: flags init msg $h1_fold/$h1_msg flags( $h1_flags ) Host2 msg $h2_fold/$h2_msg flags( $h2_flags )\n"  ) ;

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

        $h2_flags = flagscase( $h2_flags ) ;

        ( $mysync->{ debug } or $debugflags ) and
        myprint( "Host1: flags filt msg $h1_fold/$h1_msg flags( $h1_flags ) Host2 msg $h2_fold/$h2_msg flags( $h2_flags )\n"  ) ;


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

        $diff and ( $mysync->{ debug } or $debugflags )
              and myprint( "Host2: flags msg $h2_fold/$h2_msg replacing h2 flags( $h2_flags ) with h1 flags( $h1_flags )\n" ) ;

        # This sets flags exactly. So flags can be removed with this.
        # When you remove a \Seen flag on host1 you want it
        # to be removed on host2. Just add flags is not what
        # we need most of the time, so no + like in "+FLAGS.SILENT".

        if ( not $mysync->{dry} and $diff and not $mysync->{imap2}->store( $h2_msg, "FLAGS.SILENT (@h1_flags)" ) ) {
                my $error_msg = join q{}, "Host2: flags msg $h2_fold/$h2_msg could not add flags [@h1_flags]: ",
                  $mysync->{imap2}->LastError || q{}, "\n" ;
                errors_incr( $mysync, $error_msg ) ;
        }

        return ;
}



sub _filter
{
        my $mysync = shift ;
        my $str = shift or return q{} ;
        my $sz  = $SIZE_MAX_STR ;
        my $len = length $str ;
        if ( not $mysync->{ 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( $mysync, $imap, $error_message ) = @_;
        if ( $imap->IsUnconnected(  ) ) {
                $mysync->{nb_errors}++ ;
                my $lcomm = $imap->LastIMAPCommand || q{} ;
                my $einfo = $imap->LastError || @{$imap->History}[$LAST] || q{} ;

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

sub tests_max
{
	note( 'Entering tests_max()' ) ;

        is( 0, max( 0 ),  'max 0 => 0' ) ;
        is( 1, max( 1 ),  'max 1 => 1' ) ;
        is( $MINUS_ONE, max( $MINUS_ONE ), 'max -1 => -1') ;
        is( undef, max(  ), 'max no arg => undef' ) ;
        is( $NUMBER_100, max( 1, $NUMBER_100 ), 'max 1 100 => 100' ) ;
        is( $NUMBER_100, max( $NUMBER_100, 1 ), 'max 100 1 => 100' ) ;
        is( $NUMBER_100, max( $NUMBER_100, $NUMBER_42, 1 ), 'max 100 42 1 => 100' ) ;
        is( $NUMBER_100, max( $NUMBER_100, '42', 1 ), 'max 100 42 1 => 100' ) ;
        is( $NUMBER_100, max( '100', '42', 1 ), 'max 100 42 1 => 100' ) ;
        is( $NUMBER_100, max( $NUMBER_100, 'haha', 1 ), 'max 100 haha 1 => 100') ;
        is( $NUMBER_100, max( 'bb', $NUMBER_100, 'haha' ), 'max bb 100 haha => 100') ;
        is( $MINUS_ONE, max( q{}, $MINUS_ONE, 'haha' ), 'max "" -1 haha => -1') ;
        is( $MINUS_ONE, max( q{}, $MINUS_ONE, $MINUS_TWO ), 'max "" -1 -2 => -1') ;
        is( $MINUS_ONE, max( 'haha', $MINUS_ONE, $MINUS_TWO ), 'max haha -1 -2 => -1') ;
	is( 1, max( $MINUS_ONE, 1 ), 'max -1 1 => 1') ;
	is( 1, max( undef, 1 ), 'max undef 1 => 1' ) ;
	is( 0, max( undef, 0 ), 'max undef 0 => 0' ) ;
        is( 'haha', max( 'haha' ), 'max haha => haha') ;
        is( 'bb', max( 'aa', 'bb' ), 'max aa bb => bb') ;
        is( 'bb', max( 'bb', 'aa' ), 'max bb aa => bb') ;
        is( 'bb', max( 'bb', 'aa', 'bb' ), 'max bb aa bb => bb') ;
	note( 'Leaving  tests_max()' ) ;
        return ;
}

sub max
{
        my @list = @_ ;
        return( undef ) if ( 0 == scalar  @list  ) ;

        my( @numbers, @notnumbers ) ;
        foreach my $item ( @list ) {
                if ( is_number( $item ) ) {
                        push @numbers, $item ;
                }else{
                        push @notnumbers, $item ;
                }
        }

        my @sorted ;
        if ( @numbers ) {
                @sorted = sort { $a <=> $b } @numbers ;
        }elsif( @notnumbers ) {
                @sorted = sort { $a cmp $b } @notnumbers ;
        }else{
                return ;
        }

        return( pop @sorted ) ;
}

sub tests_is_number
{
        note( 'Entering tests_is_number()' ) ;

        ok( ! is_number( ),    'is_number: no args => undef ' ) ;
        ok( is_number( 1 ),    'is_number:  1 => 1' ) ;
        ok( is_number( 1.1 ),  'is_number:  1.1 => 1' ) ;
        ok( is_number( 0 ),    'is_number:  0 => 1' ) ;
        ok( is_number( -1 ),   'is_number: -1 => 1' ) ;
        ok( ! is_number( 1.1.1 ),   'is_number: 1.1.1 => no' ) ;
        ok( ! is_number( q{} ),     'is_number:   q{} => no' ) ;
        ok( ! is_number( 'haha' ),  'is_number:  haha => no' ) ;
        ok( ! is_number( '0haha' ), 'is_number: 0haha => no' ) ;
        ok( ! is_number( '2haha' ), 'is_number: 2haha => no' ) ;
        ok( ! is_number( 'haha2' ), 'is_number: haha2 => no' ) ;

        note( 'Leaving  tests_is_number()' ) ;
        return ;
}



sub is_number
{
        my $item = shift ;

        if ( ! defined $item ) { return ; }

        if ( $item =~ /\A$RE{num}{real}\Z/ ) {
                return 1 ;
        }
        return ;
}

sub tests_min
{
	note( 'Entering tests_min()' ) ;

        is( 0, min( 0 ),  'min 0 => 0' ) ;
        is( 1, min( 1 ),  'min 1 => 1' ) ;
        is( $MINUS_ONE, min( $MINUS_ONE ), 'min -1 => -1' ) ;
        is( undef, min(  ), 'min no arg => undef' ) ;
        is( 1, min( 1, $NUMBER_100 ), 'min 1 100 => 1' ) ;
        is( 1, min( $NUMBER_100, 1 ), 'min 100 1 => 1' ) ;
        is( 1, min( $NUMBER_100, $NUMBER_42, 1 ), 'min 100 42 1 => 1' ) ;
        is( 1, min( $NUMBER_100, '42', 1 ), 'min 100 42 1 => 1' ) ;
        is( 1, min( '100', '42', 1 ), 'min 100 42 1 => 1' ) ;
        is( 1, min( $NUMBER_100, 'haha', 1 ), 'min 100 haha 1 => 1') ;
	is( $MINUS_ONE, min( $MINUS_ONE, 1 ), 'min -1 1 => -1') ;

	is( 1, min( undef, 1 ), 'min undef 1 => 1' ) ;
	is( 0, min( undef, 0 ), 'min undef 0 => 0' ) ;
	is( 1, min( undef, 1 ), 'min undef 1 => 1' ) ;
	is( 0, min( undef, 2, 0, 1 ), 'min undef, 2, 0, 1 => 0' ) ;

        is( 'haha', min( 'haha' ), 'min haha => haha') ;
        is( 'aa', min( 'aa', 'bb' ), 'min aa bb => aa') ;
        is( 'aa', min( 'bb', 'aa' ), 'min bb aa bb => aa') ;
        is( 'aa', min( 'bb', 'aa', 'bb' ), 'min bb aa bb => aa') ;

	note( 'Leaving  tests_min()' ) ;
        return ;
}


sub min
{
        my @list = @_ ;
        return( undef ) if ( 0 == scalar  @list  ) ;

        my( @numbers, @notnumbers ) ;
        foreach my $item ( @list ) {
                if ( is_number( $item ) ) {
                        push @numbers, $item ;
                }else{
                        push @notnumbers, $item ;
                }
        }

        my @sorted ;
        if ( @numbers ) {
                @sorted = sort { $a <=> $b } @numbers ;
        }elsif( @notnumbers ) {
                @sorted = sort { $a cmp $b } @notnumbers ;
        }else{
                return ;
        }

        return( shift @sorted ) ;
}


sub check_lib_version
{
        my $mysync = shift ;
        $mysync->{ debug } and myprint( "IMAPClient $Mail::IMAPClient::VERSION\n"  ) ;
        if ( '2.2.9' eq $Mail::IMAPClient::VERSION ) {
                myprint( "imapsync no longer supports Mail::IMAPClient 2.2.9, upgrade it\n"  ) ;
                return 0 ;
        }
        else{
                # 3.x.x is no longer buggy with imapsync.
                # 3.30 or currently superior is imposed in the Perl "use Mail::IMAPClient line".
                return 1 ;
        }
        return ;
}

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

sub modulesversion
{

        my @list_version;

        my %modulesversion = (
                'Authen::NTLM'          => sub { $Authen::NTLM::VERSION },
                'CGI'                   => sub { $CGI::VERSION },
                'Compress::Zlib'        => sub { $Compress::Zlib::VERSION },
                'Crypt::OpenSSL::RSA'   => sub { $Crypt::OpenSSL::RSA::VERSION },
                'Data::Uniqid'          => sub { $Data::Uniqid::VERSION },
                'Digest::HMAC_MD5'      => sub { $Digest::HMAC_MD5::VERSION },
                'Digest::HMAC_SHA1'     => sub { $Digest::HMAC_SHA1::VERSION },
                'Digest::MD5'           => sub { $Digest::MD5::VERSION },
                'File::Copy::Recursive' => sub { $File::Copy::Recursive::VERSION },
                'File::Spec'            => sub { $File::Spec::VERSION },
                'Getopt::Long'          => sub { $Getopt::Long::VERSION },
                'HTML::Entities'        => sub { $HTML::Entities::VERSION },
                'IO::Socket'            => sub { $IO::Socket::VERSION },
                'IO::Socket::INET'      => sub { $IO::Socket::INET::VERSION },
                'IO::Socket::INET6'     => sub { $IO::Socket::INET6::VERSION },
                'IO::Socket::IP'        => sub { $IO::Socket::IP::VERSION },
                'IO::Socket::SSL'       => sub { $IO::Socket::SSL::VERSION },
                'IO::Tee'               => sub { $IO::Tee::VERSION },
                'JSON'                  => sub { $JSON::VERSION },
                'JSON::WebToken'        => sub { $JSON::WebToken::VERSION },
                'LWP'                   => sub { $LWP::VERSION },
                'Mail::IMAPClient'      => sub { $Mail::IMAPClient::VERSION },
                'Net::Ping'             => sub { $Net::Ping::VERSION },
                'Net::SSLeay'           => sub { $Net::SSLeay::VERSION },
                'Term::ReadKey'         => sub { $Term::ReadKey::VERSION },
                'Test::MockObject'      => sub { $Test::MockObject::VERSION },
                'Time::HiRes'           => sub { $Time::HiRes::VERSION },
                'Unicode::String'       => sub { $Unicode::String::VERSION },
                'URI::Escape'           => sub { $URI::Escape::VERSION },
                #'Lalala'                => sub { $Lalala::VERSION },
        ) ;

        foreach my $module_name ( sort keys %modulesversion ) {
                # trick from http://www.perlmonks.org/?node_id=152122
                my $file_name = $module_name . '.pm' ;
                $file_name =~s,::,/,xmgs; # Foo::Bar::Baz => Foo/Bar/Baz.pm
                my $v ;
                eval {
                        require $file_name ;
                        $v = defined $modulesversion{ $module_name } ? $modulesversion{ $module_name }->() : q{?} ;
                } or $v = q{Not installed} ;

                push  @list_version, module_version_str( $module_name, $v )  ;
        }
        return( @list_version ) ;
}


sub tests_command_line_nopassword
{
        note( 'Entering tests_command_line_nopassword()' ) ;

        ok( q{} eq command_line_nopassword(), 'command_line_nopassword void' );
        my $mysync = {} ;
        ok( '--blabla' eq command_line_nopassword( $mysync, '--blabla' ), 'command_line_nopassword --blabla' );
        #myprint( command_line_nopassword((qw{ --password1 secret1 })), "\n" ) ;
        ok( '--password1 MASKED' eq command_line_nopassword( $mysync, qw{ --password1 secret1}), 'command_line_nopassword --password1' );
        ok( '--blabla --password1 MASKED --blibli'
        eq command_line_nopassword( $mysync, qw{ --blabla --password1 secret1 --blibli } ), 'command_line_nopassword --password1 --blibli' );
        $mysync->{showpasswords} = 1 ;
        ok( q{} eq command_line_nopassword(), 'command_line_nopassword void' );
        ok( '--blabla' eq command_line_nopassword( $mysync, '--blabla'), 'command_line_nopassword --blabla' );
        #myprint( command_line_nopassword((qw{ --password1 secret1 })), "\n" ) ;
        ok( '--password1 secret1' eq command_line_nopassword( $mysync, qw{ --password1 secret1} ), 'command_line_nopassword --password1' );
        ok( '--blabla --password1 secret1 --blibli'
        eq command_line_nopassword( $mysync, qw{ --blabla --password1 secret1 --blibli } ), 'command_line_nopassword --password1 --blibli' );

	note( 'Leaving  tests_command_line_nopassword()' ) ;
        return ;
}

# Construct a command line copy with passwords replaced by MASKED.
sub command_line_nopassword
{
        my $mysync = shift @ARG ;
        my @argv = @ARG ;
        my @argv_nopassword ;

        if ( $mysync->{ cmdcgi } ) {
                @argv_nopassword = mask_password_value( @{ $mysync->{ cmdcgi } } ) ;
                return( "@argv_nopassword" ) ;
        }

        if ( $mysync->{showpasswords} )
        {
                return( "@argv" ) ;
        }

        @argv_nopassword = mask_password_value( @argv ) ;
        return("@argv_nopassword") ;
}

sub mask_password_value
{
        my @argv = @ARG ;
        my @argv_nopassword ;
        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_get_stdin_masked
{
        note( 'Entering tests_get_stdin_masked()' ) ;

        is( q{}, get_stdin_masked(  ), 'get_stdin_masked: no args' ) ;
        is( q{}, get_stdin_masked( 'Please ENTER: ' ), 'get_stdin_masked: ENTER' ) ;

        note( 'Leaving  tests_get_stdin_masked()' ) ;
        return ;
}

#######################################################
# The issue is that prompt() does not prompt the prompt
# when the program is used like
# { sleep 2 ; echo blablabla ; } | ./imapsync ...--host1 lo --user1 tata --host2 lo --user2 titi

# use IO::Prompter ;
sub get_stdin_masked
{
        my $prompt = shift || 'Say something: ' ;
        local @ARGV = () ;
        my $input = prompt(
                -prompt => $prompt,
                -echo => '*',
        ) ;
        #myprint( "You said: $input\n" ) ;
        return $input ;
}

sub ask_for_password_new
{
        my $prompt = shift ;
        my $password = get_stdin_masked( $prompt ) ;
        return $password ;
}
#########################################################


sub ask_for_password
{
        my $prompt = shift ;
        myprint( $prompt  ) ;
        Term::ReadKey::ReadMode( 2 ) ;
        ## no critic (InputOutput::ProhibitExplicitStdin)
        my $password = <STDIN> ;
        chomp $password ;
        myprint( "\nGot it\n" ) ;
        Term::ReadKey::ReadMode( 0 ) ;
        return $password ;
}

# Have to refactor get_password1() get_password2()
# to have only get_password() and two calls
sub get_password1
{

	my $mysync = shift ;

	$mysync->{password1}
	|| $mysync->{ passfile1 }
	|| 'PREAUTH' eq $authmech1
	|| 'EXTERNAL' eq $authmech1
	|| $ENV{IMAPSYNC_PASSWORD1}
	|| do
        {
                myprint( << 'FIN_PASSFILE'  ) ;

If you are afraid of giving password on the command line arguments, you can put the
password of user1 in a file named file1 and use "--passfile1 file1" instead of typing it.
Then give this file restrictive permissions with the command "chmod 600 file1".
An other solution is to set the environment variable IMAPSYNC_PASSWORD1
FIN_PASSFILE
                my $user = $authuser1 || $mysync->{user1} ;
                my $host =  $mysync->{host1} ;
                my $prompt = "What's the password for $user" . ' at ' . "$host? (not visible while you type, then enter RETURN) " ;
                $mysync->{password1} = ask_for_password( $prompt ) ;
        } ;

	if ( defined  $mysync->{ passfile1 }  ) {
		if ( ! -e -r $mysync->{ passfile1 } ) {
			myprint( "Failure: file from parameter --passfile1 $mysync->{ passfile1 } does not exist or is not readable\n" ) ;
			exit_clean( $mysync, $EX_NOINPUT ) ;
		}
		# passfile1 readable
		$mysync->{password1} = firstline ( $mysync->{ passfile1 } ) ;
		return ;
	}
	if ( $ENV{IMAPSYNC_PASSWORD1} ) {
		$mysync->{password1} = $ENV{IMAPSYNC_PASSWORD1} ;
		return ;
	}
	return ;
}

sub get_password2
{

	my $mysync = shift ;

	$mysync->{password2}
	|| $mysync->{ passfile2 }
	|| 'PREAUTH' eq $authmech2
	|| 'EXTERNAL' eq $authmech2
	|| $ENV{IMAPSYNC_PASSWORD2}
	|| do
        {
                myprint( << 'FIN_PASSFILE'  ) ;

If you are afraid of giving password on the command line arguments, you can put the
password of user2 in a file named file2 and use "--passfile2 file2" instead of typing it.
Then give this file restrictive permissions with the command "chmod 600 file2".
An other solution is to set the environment variable IMAPSYNC_PASSWORD2
FIN_PASSFILE
                my $user = $authuser2 || $mysync->{user2} ;
                my $host =  $mysync->{host2} ;
                my $prompt = "What's the password for $user" . ' at ' . "$host? (not visible while you type, then enter RETURN) " ;
                $mysync->{password2} = ask_for_password( $prompt ) ;
        } ;


	if ( defined  $mysync->{ passfile2 }  ) {
		if ( ! -e -r $mysync->{ passfile2 } ) {
			myprint( "Failure: file from parameter --passfile2 $mysync->{ passfile2 } does not exist or is not readable\n" ) ;
			exit_clean( $mysync, $EX_NOINPUT ) ;
		}
		# passfile2 readable
		$mysync->{password2} = firstline ( $mysync->{ passfile2 } ) ;
		return ;
	}
	if ( $ENV{IMAPSYNC_PASSWORD2} ) {
		$mysync->{password2} = $ENV{IMAPSYNC_PASSWORD2} ;
		return ;
	}
	return ;
}




sub remove_tmp_files
{
        my $mysync = shift or return ;
        $mysync->{pidfile} or return ;
        if ( -e $mysync->{pidfile} ) {
                unlink $mysync->{pidfile} ;
        }
        return ;
}

sub cleanup_before_exit
{
        my $mysync = shift ;
        remove_tmp_files( $mysync ) ;
        if ( $mysync->{imap1} and $mysync->{imap1}->IsConnected() )
        {
                myprint( "Disconnecting from host1 $mysync->{ host1 } user1 $mysync->{ user1 }\n" ) ;
                $mysync->{imap1}->logout(  ) ;
        }
        if ( $mysync->{imap2} and $mysync->{imap2}->IsConnected() )
        {
                myprint( "Disconnecting from host2 $mysync->{ host2 } user2 $mysync->{ user2 }\n" ) ;
                $mysync->{imap2}->logout(  ) ;
        }
        if ( $mysync->{log} ) {
                myprint( "Log file is $mysync->{logfile} ( to change it, use --logfile filepath ; or use --nolog to turn off logging )\n" ) ;
        }
        if ( $mysync->{log} and $mysync->{logfile_handle} ) {
                #myprint( "Closing $mysync->{ logfile }\n" ) ;
                close $mysync->{logfile_handle} ;
        }
        return ;
}



sub exit_clean
{
        my $mysync = shift @ARG ;
        my $status = shift @ARG ;
        my @messages = @ARG ;
        if ( @messages )
        {
                myprint( @messages ) ;
        }
        myprint( "Exiting with return value $status ($EXIT_TXT{$status})\n" ) ;
        cleanup_before_exit( $mysync ) ;

        exit $status ;
}

sub missing_option
{
        my $mysync = shift ;
        my $option  = shift ;
        exit_clean( $mysync, $EX_USAGE, "$option option is mandatory, for help run $PROGRAM_NAME --help\n" ) ;
        return ;
}


sub catch_ignore
{
        my $mysync = shift ;
        my $signame = shift ;

        my $sigcounter = ++$mysync->{ sigcounter }{ $signame } ;
        myprint( "\nGot a signal $signame (my PID is $PROCESS_ID my PPID is ", getppid(  ),
                 "). Received $sigcounter $signame signals so far. Thanks!\n" ) ;
        stats( $mysync ) ;
        return ;
}


sub catch_exit
{
        my $mysync = shift ;
        my $signame = shift || q{} ;
        if ( $signame ) {
                myprint( "\nGot a signal $signame (my PID is $PROCESS_ID my PPID is ", getppid(  ),
                         "). Asked to terminate\n" ) ;
                if ( $mysync->{stats} ) {
                        myprint( "Here are the final stats of this sync not completely finished so far\n" ) ;
                        stats( $mysync ) ;
                        myprint( "Ended by a signal $signame (my PID is $PROCESS_ID my PPID is ",
                        getppid(  ), "). I am asked to terminate immediately.\n" ) ;
                        myprint( "You should resynchronize those accounts by running a sync again,\n",
                        "since some messages and entire folders might still be missing on host2.\n" ) ;
                }
                ## no critic (RequireLocalizedPunctuationVars)
                $SIG{ $signame }  = 'DEFAULT'; # restore default action
                # kill myself with $signame
                # https://www.cons.org/cracauer/sigint.html
                myprint( "Killing myself with signal $signame\n" ) ;
                cleanup_before_exit( $mysync ) ;
                kill( $signame, $PROCESS_ID ) ;
        }
        else
        {
                exit_clean( $mysync, $EXIT_BY_SIGNAL ) ;
        }
        return ;
}


sub catch_print
{
        my $mysync = shift ;
        my $signame = shift ;

        my $sigcounter = ++$mysync->{ sigcounter }{ $signame } ;
        myprint( "\nGot a signal $signame (my PID is $PROCESS_ID my PPID is ", getppid(  ),
                 "). Received $sigcounter $signame signals so far. Thanks!\n" ) ;
        return ;
}


sub catch_reconnect
{
        my $mysync = shift ;
        my $signame = shift ;
        if ( here_twice( $mysync ) ) {
                myprint( "Got two signals $signame within $INTERVAL_TO_EXIT seconds. Exiting...\n" ) ;
                catch_exit( $mysync, $signame ) ;
        }else{
                myprint( "\nGot a signal $signame (my PID is $PROCESS_ID my PPID is ", getppid(  ), ")\n",
                        "Hit 2 ctr-c within 2 seconds to exit the program\n",
                        "Hit only 1 ctr-c to reconnect to both imap servers\n",
                ) ;
                myprint( "For now only one signal $signame within $INTERVAL_TO_EXIT seconds.\n" ) ;

                if ( ! defined $mysync->{imap1} ) { return ; }
                if ( ! defined $mysync->{imap2} ) { return ; }

                myprint( "Info: reconnecting to host1 imap server $mysync->{host1}\n" ) ;
                $mysync->{imap1}->State( Mail::IMAPClient::Unconnected ) ;
                $mysync->{imap1}->{IMAPSYNC_RECONNECT_COUNT} += 1 ;
                if ( $mysync->{imap1}->reconnect(  ) )
                {
                        myprint( "Info: reconnected to host1 imap server $mysync->{host1}\n" ) ;
                }
                else
                {
                        exit_clean( $mysync, $EXIT_CONNECTION_FAILURE ) ;
                }
                myprint( "Info: reconnecting to host2 imap server\n" ) ;
                $mysync->{imap2}->State( Mail::IMAPClient::Unconnected ) ;
                $mysync->{imap2}->{IMAPSYNC_RECONNECT_COUNT} += 1 ;
                if ( $mysync->{imap2}->reconnect(  ) )
                {
                        myprint( "Info: reconnected to host2 imap server $mysync->{host2}\n" ) ;
                }
                else
                {
                        exit_clean( $mysync, $EXIT_CONNECTION_FAILURE ) ;
                }
                myprint( "Info: reconnected to both imap servers\n" ) ;
        }
        return ;
}

sub tests_reconnect_12_if_needed
{
	note( 'Entering tests_reconnect_12_if_needed()' ) ;

	my $mysync ;

	$mysync->{imap1} = Mail::IMAPClient->new(  ) ;
	$mysync->{imap2} = Mail::IMAPClient->new(  ) ;
	$mysync->{imap1}->Server( 'test1.lamiral.info' ) ;
	$mysync->{imap2}->Server( 'test2.lamiral.info' ) ;
	is( 2, reconnect_12_if_needed( $mysync ), 'reconnect_12_if_needed: test1&test2 .lamiral.info => 1' ) ;
	is( 1, $mysync->{imap1}->{IMAPSYNC_RECONNECT_COUNT}, 'reconnect_12_if_needed: test1.lamiral.info IMAPSYNC_RECONNECT_COUNT => 1' ) ;
	is( 1, $mysync->{imap2}->{IMAPSYNC_RECONNECT_COUNT}, 'reconnect_12_if_needed: test2.lamiral.info IMAPSYNC_RECONNECT_COUNT => 1' ) ;

	note( 'Leaving  tests_reconnect_12_if_needed()' ) ;
	return ;
}

sub reconnect_12_if_needed
{
        my $mysync = shift ;
	#return 2 ;
	if ( ! reconnect_if_needed( $mysync->{imap1} ) ) {
		return ;
	}
	if ( ! reconnect_if_needed( $mysync->{imap2} ) ) {
		return ;
	}
	# both were good
	return 2 ;
}


sub tests_reconnect_if_needed
{
	note( 'Entering tests_reconnect_if_needed()' ) ;


	my $myimap ;

	is( undef, reconnect_if_needed( ), 'reconnect_if_needed: no args => undef' ) ;
	is( undef, reconnect_if_needed( $myimap ), 'reconnect_if_needed: undef arg => undef' ) ;

	$myimap = Mail::IMAPClient->new(  ) ;
        $myimap->Debug( 1 ) ;
	is( undef, reconnect_if_needed( $myimap ), 'reconnect_if_needed: empty new Mail::IMAPClient => undef' ) ;
	$myimap->Server( 'test.lamiral.info' ) ;
	is( 1, reconnect_if_needed( $myimap ), 'reconnect_if_needed: test.lamiral.info => 1' ) ;
	is( 1, $myimap->{IMAPSYNC_RECONNECT_COUNT}, 'reconnect_if_needed: test.lamiral.info IMAPSYNC_RECONNECT_COUNT => 1' ) ;

	note( 'Leaving  tests_reconnect_if_needed()' ) ;
	return ;
}

sub reconnect_if_needed
{
	# return undef upon failure.
	# return 1 upon connection success, with or without reconnection.

        my $imap = shift ;

	if ( ! defined $imap ) { return ; }
	if ( ! $imap->Server(  ) ) { return ; }

	if ( $imap->IsUnconnected(  ) ) {
		$imap->{IMAPSYNC_RECONNECT_COUNT} += 1 ;
		if ( $imap->reconnect( ) )  {
			return 1 ;
		}
	}else{
		return 1 ;
	}

	# A last forced one
	$imap->State( Mail::IMAPClient::Unconnected ) ;
	$imap->reconnect(  ) ;
	$imap->{IMAPSYNC_RECONNECT_COUNT} += 1 ;
	if ( $imap->noop ) {
		# NOOP is ok
		return 1 ;
	}

	return ;
}



sub here_twice
{
        my $mysync = shift ;
        my $now = time ;
        my $previous = $mysync->{lastcatch} || 0 ;
        $mysync->{lastcatch} = $now ;

        if ( $INTERVAL_TO_EXIT >= $now - $previous ) {
                return $TRUE ;
        }else{
                return $FALSE ;
        }
}


sub justconnect 
{
        my $mysync = shift ;
        my $justconnect1 = justconnect1( $sync ) ;
        my $justconnect2 = justconnect2( $sync ) ;
        return "$justconnect1 $justconnect2";
}

sub justconnect1
{
        my $mysync = shift ;
        if ( $mysync->{host1} ) 
        {
                myprint( "Host1: Will just connect to $mysync->{host1} without login\n" ) ;
                $mysync->{imap1} = connect_imap(
                        $mysync->{host1}, $mysync->{port1}, $debugimap1,
                        $mysync->{ssl1}, $mysync->{tls1}, 'Host1', 
                        $mysync->{h1}->{timeout}, $mysync->{h1} ) ;

                $mysync->{imap1}->logout(  ) ;
                return $mysync->{host1} ;
        }
        
        return '' ;
}

sub justconnect2
{
        my $mysync = shift ;
        if ( $mysync->{host2} )
        {
                myprint( "Host2: Will just connect to $mysync->{host2} without login\n" ) ;
                $mysync->{imap2} = connect_imap( 
                        $mysync->{host2}, $mysync->{port2}, $debugimap2,
                        $mysync->{ssl2}, $mysync->{tls2}, 'Host2',
                        $mysync->{h2}->{timeout}, $mysync->{h2} ) ;

                $mysync->{imap2}->logout(  ) ;
                return $mysync->{host2} ;
        }
        
        return '' ;
}

sub skip_macosx
{
        return ;
        # return( 'macosx.polarhome.com' eq hostname() ) ;
}

sub tests_mailimapclient_connect
{
        note( 'Entering tests_mailimapclient_connect()' ) ;

        my $imap ;
        # ipv4
        ok( $imap = Mail::IMAPClient->new(  ), 'mailimapclient_connect ipv4: new' ) ;
        is( 'Mail::IMAPClient', ref( $imap ), 'mailimapclient_connect ipv4: ref is Mail::IMAPClient' ) ;

        # Mail::IMAPClient 3.40 die on this... So we skip it, thanks to "mature" IO::Socket::IP
        # Mail::IMAPClient 3.42 is ok so this test is back.
        is( undef, $imap->connect(  ), 'mailimapclient_connect ipv4: connect with no server => failure' ) ;


        is( 'test.lamiral.info', $imap->Server( 'test.lamiral.info' ), 'mailimapclient_connect ipv4: setting Server(test.lamiral.info)' ) ;
        is( 1, $imap->Debug( 1 ), 'mailimapclient_connect ipv4: setting Debug( 1 )' ) ;
        is( 143, $imap->Port( 143 ), 'mailimapclient_connect ipv4: setting Port( 143 )' ) ;
        is( 3, $imap->Timeout( 3 ), 'mailimapclient_connect ipv4: setting Timout( 30 )' ) ;
        like( ref( $imap->connect(  ) ), qr/IO::Socket::INET|IO::Socket::IP/, 'mailimapclient_connect ipv4: connect to test.lamiral.info' ) ;
        like( $imap->logout( ), qr/Mail::IMAPClient/, 'mailimapclient_connect ipv4: logout' ) ;
        is( undef, undef $imap, 'mailimapclient_connect ipv4: free variable' ) ;

        # ipv4 + ssl
        ok( $imap = Mail::IMAPClient->new(  ), 'mailimapclient_connect ipv4 + ssl: new' ) ;
        is( 'test.lamiral.info', $imap->Server( 'test.lamiral.info' ), 'mailimapclient_connect ipv4 + ssl: setting Server(test.lamiral.info)' ) ;
        is( 1, $imap->Debug( 1 ), 'mailimapclient_connect ipv4 + ssl: setting Debug( 1 )' ) ;
        ok( $imap->Ssl( [ SSL_verify_mode => SSL_VERIFY_NONE ] ), 'mailimapclient_connect ipv4 + ssl: setting Ssl( SSL_VERIFY_NONE )' ) ;
        is( 993, $imap->Port( 993 ), 'mailimapclient_connect ipv4 + ssl: setting Port( 993 )' ) ;
        like( ref( $imap->connect(  ) ), qr/IO::Socket::SSL/, 'mailimapclient_connect ipv4 + ssl: connect to test.lamiral.info' ) ;
        is( $imap->logout( ), undef, 'mailimapclient_connect ipv4 + ssl: logout in ssl causes failure' ) ;
        is( undef, undef $imap, 'mailimapclient_connect ipv4 + ssl: free variable' ) ;

        # ipv6 + ssl
        ok( $imap = Mail::IMAPClient->new(  ), 'mailimapclient_connect ipv6 + ssl: new' ) ;
        is( 'ks2ipv6.lamiral.info', $imap->Server( 'ks2ipv6.lamiral.info' ), 'mailimapclient_connect ipv6 + ssl: setting Server(ks2ipv6.lamiral.info)' ) ;
        ok( $imap->Ssl( [ SSL_verify_mode => SSL_VERIFY_NONE ] ), 'mailimapclient_connect ipv6 + ssl: setting Ssl( SSL_VERIFY_NONE )' ) ;
        is( 993, $imap->Port( 993 ), 'mailimapclient_connect ipv6 + ssl: setting Port( 993 )' ) ;
        SKIP: {
        if (
                'CUILLERE' eq hostname()
                or
                skip_macosx()
                or
                -e '/.dockerenv'
                )
        {
                skip( 'Tests avoided on CUILLERE can not do ipv6', 2 ) ;
        }
        like( ref( $imap->connect(  ) ), qr/IO::Socket::SSL/, 'mailimapclient_connect ipv6 + ssl: connect to ks2ipv6.lamiral.info' ) ;
        is( $imap->logout( ), undef, 'mailimapclient_connect ipv6 + ssl: logout in ssl causes failure' ) ;
        }
        is( undef, undef $imap, 'mailimapclient_connect ipv6 + ssl: free variable' ) ;


        note( 'Leaving  tests_mailimapclient_connect()' ) ;
        return ;
}


sub tests_mailimapclient_connect_bug
{
        note( 'Entering tests_mailimapclient_connect_bug()' ) ;

        my $imap ;

        # ipv6
        ok( $imap = Mail::IMAPClient->new(  ), 'mailimapclient_connect_bug ipv6: new' ) ;
        is( 'ks2ipv6.lamiral.info', $imap->Server( 'ks2ipv6.lamiral.info' ), 'mailimapclient_connect_bug ipv6: setting Server(ks2ipv6.lamiral.info)' ) ;
        is( 143, $imap->Port( 143 ), 'mailimapclient_connect_bug ipv6: setting Port( 993 )' ) ;

        SKIP: {
                if (
                        'CUILLERE' eq hostname()
                or
                        skip_macosx()
                or
                        -e '/.dockerenv'
                )
                {
                        skip( 'Tests avoided on CUILLERE can not do ipv6', 1 ) ;
                }
                like( ref( $imap->connect(  ) ), qr/IO::Socket::INET/, 'mailimapclient_connect_bug ipv6: connect to ks2ipv6.lamiral.info' )
                or diag( 'mailimapclient_connect_bug ipv6: ', $imap->LastError(  ), $!,  ) ;
        }
        #is( $imap->logout( ), undef, 'mailimapclient_connect_bug ipv6: logout in ssl causes failure' ) ;
        is( undef, undef $imap, 'mailimapclient_connect_bug ipv6: free variable' ) ;

        note( 'Leaving  tests_mailimapclient_connect_bug()' ) ;
        return ;
}



sub tests_connect_socket
{
        note( 'Entering tests_connect_socket()' ) ;

	is( undef, connect_socket(  ), 'connect_socket: no args' ) ;

        my $socket ;
        my $imap ;
        SKIP: {
                if (
                        'CUILLERE' eq hostname()
                or
                        skip_macosx()
                or
                        -e '/.dockerenv'
                )
                {
                        skip( 'Tests avoided on CUILLERE/macosx.polarhome.com/docker cannot do ipv6', 2 ) ;
                }

                $socket = IO::Socket::INET6->new(
                        PeerAddr => 'ks2ipv6.lamiral.info',
                        PeerPort => 143,
                ) ;


                ok( $imap = connect_socket( $socket ), 'connect_socket: ks2ipv6.lamiral.info port 143 IO::Socket::INET6' ) ;
                #$imap->Debug( 1 ) ;
                # myprint( $imap->capability(  ) ) ;
                if ( $imap ) {
                        $imap->logout(  ) ;
                }

                #$IO::Socket::SSL::DEBUG = 4 ;
                $socket = IO::Socket::SSL->new(
                        PeerHost => 'ks2ipv6.lamiral.info',
                        PeerPort => 993,
                        SSL_verify_mode => SSL_VERIFY_NONE,
                ) ;
                # myprint( $socket ) ;
                ok( $imap = connect_socket( $socket ), 'connect_socket: ks2ipv6.lamiral.info port 993 IO::Socket::SSL' ) ;
                #$imap->Debug( 1 ) ;
                # myprint( $imap->capability(  ) ) ;
                # $socket->close(  ) ;
                if ( $imap ) {
                        $socket->close(  ) ;
                }
                #$socket->close(SSL_no_shutdown => 1) ;
                #$imap->logout(  ) ;
                #myprint( "\n" ) ;
                #$imap->logout(  ) ;
        }
        note( 'Leaving  tests_connect_socket()' ) ;
        return ;
}

sub connect_socket
{
	my( $socket ) = @ARG ;

	if ( ! defined $socket ) { return ; }

	my $host = $socket->peerhost(  ) ;
	my $port = $socket->peerport(  ) ;
	#print "socket->peerhost: ", $socket->peerhost(  ), "\n" ;
	#print "socket->peerport: ", $socket->peerport(  ), "\n" ;
	my $imap = Mail::IMAPClient->new(  ) ;
	$imap->Socket( $socket ) ;
	my $banner = $imap->Results()->[0] ;
	#myprint( "banner: $banner"  ) ;
	return $imap ;
}


sub tests_probe_imapssl
{
        note( 'Entering tests_probe_imapssl()' ) ;

        is( undef, probe_imapssl(  ),          'probe_imapssl: no args => undef' ) ;
        is( undef, probe_imapssl( 'unknown' ), 'probe_imapssl: unknown => undef' ) ;

	SKIP: {
                if (
                        'CUILLERE' eq hostname()
                or
                        skip_macosx()
                or
                        -e '/.dockerenv'
                )
                {
                        skip( 'Tests avoided on CUILLERE/macosx.polarhome.com/docker cannot do ipv6', 2 ) ;
                }
                like( probe_imapssl( 'ks2ipv6.lamiral.info' ), qr/^\* OK/, 'probe_imapssl: ks2ipv6.lamiral.info matches "* OK"' ) ;
                like( probe_imapssl( 'imap.gmail.com' ),       qr/^\* OK/, 'probe_imapssl: imap.gmail.com matches "* OK"' ) ;
        } ;

        like( probe_imapssl( 'test1.lamiral.info' ),   qr/^\* OK/, 'probe_imapssl: test1.lamiral.info matches "* OK"' ) ;

        note( 'Leaving  tests_probe_imapssl()' ) ;
        return ;
}

sub probe_imapssl
{
        my $host = shift ;

        if ( ! $host ) { return ; }

  	my $socket = IO::Socket::SSL->new(
		PeerHost => $host,
		PeerPort => $IMAP_SSL_PORT,
                SSL_verify_mode => SSL_VERIFY_NONE,
	) ;
        #print "$socket\n" ;
        if ( ! $socket ) { return ; }

        my $banner ;
        $socket->sysread( $banner, 65_536 ) ;
        #print "$banner" ;
        $socket->close(  ) ;
        return $banner ;

}

sub connect_imap
{
        my( $host, $port, $mydebugimap, $ssl, $tls, $Side, $mytimeout, $h ) = @_ ;
        my $imap = Mail::IMAPClient->new(  ) ;
        if ( $ssl ) { set_ssl( $imap, $h ) }
        $imap->Server( $host ) ;
        $imap->Port( $port ) ;
        $imap->Debug( $mydebugimap ) ;
        $imap->Timeout( $mytimeout ) ;

        my $side = lc $Side ;
        myprint( "$Side: connecting on $side [$host] port [$port]\n"  ) ;

        $imap->connect(  )
          or exit_clean( $sync, $EXIT_CONNECTION_FAILURE, "$Side: Can not open imap connection on [$host]: " . $imap->LastError . " $OS_ERROR\n" ) ;
		myprint( "$Side IP address: ", $imap->Socket->peerhost(), "\n"  ) ;
        my $banner = $imap->Results()->[0] ;

        myprint( "$Side banner: $banner"  ) ;
        myprint( "$Side capability: ", join(q{ }, @{ $imap->capability() || [] }), "\n" ) ;

        if ( $tls ) {
                set_tls( $imap, $h ) ;
                $imap->starttls(  )
                or exit_clean( $sync, $EXIT_TLS_FAILURE, "$Side: Can not go to tls encryption on $side [$host]:", $imap->LastError, "\n" ) ;
                myprint( "$Side: Socket successfuly converted to SSL\n"  ) ;
        }
        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, $h, $mysync ) = @allargs ;

        my $side = lc $Side ;
        myprint( "$Side: connecting and login on $side [$host] port [$port] with user [$user]\n"  ) ;

        my $imap = init_imap( @allargs ) ;

        $imap->connect()
          or exit_clean( $mysync, $EXIT_CONNECTION_FAILURE, "$Side failure: can not open imap connection on $side [$host] with user [$user]: " . $imap->LastError . " $OS_ERROR\n" ) ;
		myprint( "$Side IP address: ", $imap->Socket->peerhost(), "\n"  ) ;
        my $banner = $imap->Results()->[0] ;

        myprint( "$Side banner: $banner"  ) ;
	myprint( "$Side capability before authentication: ", join(q{ }, @{ $imap->capability() || [] }), "\n" ) ;

	if ( (! $ssl) and (! defined $tls ) and $imap->has_capability( 'STARTTLS' ) ) {
		myprint( "$Side: going to ssl because STARTTLS is in CAPABILITY. Use --notls1 or --notls2 to avoid that behavior\n" ) ;
		$tls = 1 ;
	}

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

        if ( $tls ) {
                set_tls( $imap, $h ) ;
                $imap->starttls(  )
                or exit_clean( $mysync, $EXIT_TLS_FAILURE, "$Side failure: Can not go to tls encryption on $side [$host]:", $imap->LastError, "\n" ) ;
                myprint( "$Side: Socket successfuly converted to SSL\n"  ) ;
        }

        authenticate_imap( $imap, @allargs ) ;

        myprint( "$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, $h, $mysync ) = @_ ;

        check_capability( $imap, $authmech, $Side ) ;
        $imap->User( $user ) ;
        $imap->Domain( $domain ) if ( defined $domain ) ;
        $imap->Authuser( $authuser ) ;
        $imap->Password( $password ) ;

        if ( 'X-MASTERAUTH' eq $authmech )
        {
                xmasterauth( $imap ) ;
                return ;
        }

        if ( $proxyauth ) {
                $imap->Authmechanism(q{}) ;
                $imap->User( $authuser ) ;
        } else {
                $imap->Authmechanism( $authmech ) unless ( $authmech eq 'LOGIN'  or $authmech eq 'PREAUTH' ) ;
        }

        $imap->Authcallback(\&xoauth)  if ( 'XOAUTH'  eq $authmech ) ;
        $imap->Authcallback(\&xoauth2) if ( 'XOAUTH2' eq $authmech ) ;
        $imap->Authcallback(\&plainauth) if ( ( 'PLAIN' eq $authmech ) or ( 'EXTERNAL' eq $authmech )  ) ;


        unless ( $authmech eq 'PREAUTH' or $authmech eq 'X-MASTERAUTH' or $imap->login( ) ) {
                my $info  = "$Side failure: Error login on [$host] with user [$user] auth" ;
                my $einfo = $imap->LastError || @{$imap->History}[$LAST] ;
                chomp $einfo ;
                my $error = "$info [$authmech]: $einfo\n" ;
                if ( $authmech eq 'LOGIN' or $imap->IsUnconnected(  ) or $authuser ) {
                        exit_clean( $mysync, $EXIT_AUTHENTICATION_FAILURE, $error ) ;
                }else{
                        myprint( $error ) ;
                }
                myprint( "$Side info: trying LOGIN Auth mechanism on [$host] with user [$user]\n"  ) ;
                $imap->Authmechanism(q{}) ;
                $imap->login() or
                  exit_clean( $mysync, $EXIT_AUTHENTICATION_FAILURE, "$info [LOGIN]: ", $imap->LastError, "\n") ;
        }

        if ( $proxyauth ) {
                if ( ! $imap->proxyauth( $user ) ) {
                        my $info  = "$Side failure: Error doing proxyauth as user [$user] on [$host] using proxy-login as [$authuser]" ;
                        my $einfo = $imap->LastError || @{$imap->History}[$LAST] ;
                        chomp $einfo ;
                        exit_clean( $mysync, $EXIT_AUTHENTICATION_FAILURE, "$info: $einfo\n" ) ;
                }
        }

        return ;
}

sub check_capability
{

        my( $imap, $authmech, $Side ) = @_ ;


        if ( $imap->has_capability( "AUTH=$authmech" )
                or $imap->has_capability( $authmech ) )
        {
                myprintf("%s: %s says it has CAPABILITY for AUTHENTICATE %s\n",
                        $Side, $imap->Server, $authmech) ;
                return ;
        }

        if ( $authmech eq 'LOGIN' )
        {
                # Well, the warning is so common and useless that I prefer to remove it
                # No more "... says it has NO CAPABILITY for AUTHENTICATE LOGIN"
                return ;
        }


        myprintf( "%s: %s says it has NO CAPABILITY for AUTHENTICATE %s\n",
                $Side, $imap->Server, $authmech ) ;

        if ( $authmech eq 'PLAIN' )
        {
                myprint( "$Side: frequently PLAIN is only supported with SSL, try --ssl or --tls options\n" ) ;
        }

        return ;
}

sub set_ssl
{
        my ( $imap, $h ) = @_ ;
        # SSL_version can be
        #    SSLv3 SSLv2 SSLv23 SSLv23:!SSLv2 (last one is the default in IO-Socket-SSL-1.953)
        #

        my $sslargs_hash = $h->{sslargs} ;

        my $sslargs_default = {
                SSL_verify_mode => $SSL_VERIFY_POLICY,
                SSL_verifycn_scheme => 'imap',
		SSL_cipher_list => 'DEFAULT:!DH',
        } ;

        # initiate with default values
        my %sslargs_mix = %{ $sslargs_default } ;
        # now override with passed values
        @sslargs_mix{ keys %{ $sslargs_hash } } = values %{ $sslargs_hash } ;
        # remove keys with undef values
        foreach my $key ( keys %sslargs_mix ) {
                delete $sslargs_mix{ $key } if ( not defined  $sslargs_mix{ $key }  ) ;
        }
        # back to an ARRAY
        my @sslargs_mix = %sslargs_mix ;
        #myprint( Data::Dumper->Dump( [ $sslargs_hash, $sslargs_default, \%sslargs_mix, \@sslargs_mix ] )  ) ;
        $imap->Ssl( \@sslargs_mix ) ;
        return ;
}

sub set_tls
{
        my ( $imap, $h ) = @_ ;

        my $sslargs_hash = $h->{sslargs} ;

        my $sslargs_default = {
                SSL_verify_mode => $SSL_VERIFY_POLICY,
		SSL_cipher_list => 'DEFAULT:!DH',
        } ;

        # initiate with default values
        my %sslargs_mix = %{ $sslargs_default } ;
        # now override with passed values
        @sslargs_mix{ keys %{ $sslargs_hash } } = values %{ $sslargs_hash } ;
        # remove keys with undef values
        foreach my $key ( keys %sslargs_mix ) {
                delete $sslargs_mix{ $key } if ( not defined  $sslargs_mix{ $key } ) ;
        }
        # back to an ARRAY
        my @sslargs_mix = %sslargs_mix ;

        $imap->Starttls( \@sslargs_mix ) ;
        return ;
}




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

        my ( $imap ) ;

        $imap = Mail::IMAPClient->new() ;

        if ( $ssl ) { set_ssl( $imap, $h ) }
        if ( $tls ) {  } # can not do set_tls() here because connect() will directly do a STARTTLS
        $imap->Clear(1);
        $imap->Server($host);
        $imap->Port($port);
        $imap->Fast_io($fastio);
        $imap->Buffer($buffersize || $DEFAULT_BUFFER_SIZE);
        $imap->Uid($uid);


        $imap->Peek(1);
        $imap->Debug($mydebugimap);
	if ( $mysync->{ showpasswords } ) {
		$imap->Showcredentials( 1 ) ;
	}
        defined  $mytimeout  and $imap->Timeout( $mytimeout ) ;

        $imap->Reconnectretry( $reconnectretry ) if ( $reconnectretry ) ;
	$imap->{IMAPSYNC_RECONNECT_COUNT} = 0 ;
        $imap->Ignoresizeerrors( $allowsizemismatch ) ;
        $split and $imap->Maxcommandlength( $SPLIT_FACTOR * $split ) ;


        return( $imap ) ;

}

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

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

# Copy from https://github.com/imapsync/imapsync/pull/25/files
# Changes "use" pragmas to "require".
# The openssl system call shall be replaced by pure Perl and
# https://metacpan.org/pod/Crypt::OpenSSL::PKCS12

# Now the Joaquin Lopez code:
#
# Used this as an example: https://gist.github.com/gsainio/6322375
#
# And this as a reference: https://developers.google.com/accounts/docs/OAuth2ServiceAccount
# (note there is an http/rest tab, where the real info is hidden away... went on a witch hunt
# until I noticed that...)
#
# This is targeted at gmail to maintain compatibility after google's oauth1 service is deactivated
# on May 5th, 2015: https://developers.google.com/gmail/oauth_protocol
# If there are other oauth2 implementations out there, this would need to be modified to be
# compatible
#
# This is a good guide on setting up the google api/apps side of the equation:
# http://www.limilabs.com/blog/oauth2-gmail-imap-service-account
#
# 2016/05/27: Updated to support oauth/key data in the .json files Google now defaults to
# when creating gmail service accounts. They're easier to work with since they neither
# requiring decrypting nor specifying the oauth2 client id separately.
#
# If the password arg ends in .json, it will assume this new json method, otherwise it
# will fallback to the "oauth client id;.p12" format it was previously using.
sub xoauth2
{
        require JSON::WebToken ;
        require LWP::UserAgent ;
        require HTML::Entities ;
        require JSON ;
        require JSON::WebToken::Crypt::RSA ;
        require Crypt::OpenSSL::RSA ;
        require Encode::Byte ;
        require IO::Socket::SSL ;

        my $code = shift;
        my $imap = shift;

        my ($iss,$key);

        if( $imap->Password =~ /^(.*\.json)$/x ) {
            my $json = JSON->new( ) ;
            my $filename = $1;
            $sync->{ debug } and myprint( "XOAUTH2 json file: $filename\n" ) ;
            open( my $FILE, '<', $filename ) or exit_clean( $sync, $EXIT_AUTHENTICATION_FAILURE, "error [$filename]: $OS_ERROR " ) ;
            my $jsonfile = $json->decode( join q{}, <$FILE> ) ;
            close $FILE ;

            $iss = $jsonfile->{client_id};
            $key = $jsonfile->{private_key};
            $sync->{ debug } and myprint( "Service account: $iss\n");
            $sync->{ debug } and myprint( "Private key:\n$key\n");
        }
        else {
            # Get iss (service account address), keyfile name, and keypassword if necessary
            ( $iss, my $keyfile, my $keypass ) = $imap->Password =~ /([\-\d\w\@\.]+);([a-zA-Z0-9 \_\-\.\/]+);?(.*)?/x ;

            # Assume key password is google default if not provided
            $keypass = 'notasecret' if not $keypass;

            $sync->{ debug } and myprint( "Service account: $iss\nKey file: $keyfile\nKey password: $keypass\n");

            # Get private key from p12 file (would be better in perl...)
            $key = `openssl pkcs12 -in "$keyfile" -nodes -nocerts -passin pass:$keypass -nomacver`;

            $sync->{ debug } and myprint( "Private key:\n$key\n");
        }

        # Create jwt of oauth2 request
        my $time = time ;
        my $jwt = JSON::WebToken->encode( {
        'iss' => $iss, # service account
        'scope' => 'https://mail.google.com/',
        'aud' => 'https://www.googleapis.com/oauth2/v3/token',
        'exp' => $time + $DEFAULT_EXPIRATION_TIME_OAUTH2_PK12,
        'iat' => $time,
        'prn' => $imap->User # user to auth as
        },
        $key, 'RS256', {'typ' => 'JWT'} ); # Crypt::OpenSSL::RSA needed here.

        # Post oauth2 request
        my $ua = LWP::UserAgent->new(  ) ;
        $ua->env_proxy(  ) ;

        my $response = $ua->post('https://www.googleapis.com/oauth2/v3/token',
        { grant_type => HTML::Entities::encode_entities('urn:ietf:params:oauth:grant-type:jwt-bearer'),
        assertion => $jwt } ) ;

        unless( $response->is_success(  ) ) {
                exit_clean( $sync, $EXIT_AUTHENTICATION_FAILURE, $response->code, "\n", $response->content, "\n" ) ;
        }else{
                $sync->{ debug } and myprint( $response->content  ) ;
        }

        # access_token in response is what we need
        my $data = JSON::decode_json( $response->content ) ;

        # format as oauth2 auth data
        my $xoauth2_string = encode_base64( 'user=' . $imap->User . "\1auth=Bearer " . $data->{access_token} . "\1\1", q{} ) ;

        $sync->{ debug } and myprint( "XOAUTH2 String: $xoauth2_string\n");
        return($xoauth2_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 = mysprintf( 'https://mail.google.com/mail/b/%s/imap/', $imap->User ) ;
        my $urlparm = mysprintf( '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 ;
        $sync->{ debug } and myprint( "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 ) . q{&} ;

        # The parameters must be in dictionary order before signing
        my $baseparms = q{} ;
        foreach my $key ( sort keys %hash ) {
                if ( length( $baseparms ) > 0 ) {
                        $baseparms .= q{&} ;
                }

                $baseparms .= "$key=$hash{$key}" ;
        }

        $base .= URI::Escape::uri_escape($baseparms);
        $sync->{ debug } and myprint( "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 ) . q{&} ) ;

        # The parameters signed become a parameter and...
        $hash { 'oauth_signature' } = URI::Escape::uri_escape( substr encode_base64( $digest ), 0, $MINUS_ONE ) ;

        # ... we don't need the requestor_id anymore.
        delete $hash{'xoauth_requestor_id'} ;

        # Create the final authentication string
        my $string = $method . q{ } . $url . q{?} . $urlparm .q{ } ;

        # All the parameters must be sorted
        $baseparms = q{};
        foreach my $key (sort keys %hash) {
                if(length($baseparms)>0) {
                        $baseparms .= q{,} ;
                }

                $baseparms .= "$key=\"$hash{$key}\"";
        }

        $string .= $baseparms;

        $sync->{ debug } and myprint( "XOAUTH: authentication string: $string\n" ) ;

       # It must be base64 encoded
        return encode_base64("$string", q{});
}


sub xmasterauth
{
        # This is Kerio auth admin
        # This code comes from
        # https://github.com/imapsync/imapsync/pull/53/files

        my $imap = shift ;

        my $user     = $imap->User(  ) ;
        my $password = $imap->Password(  ) ;
        my $authmech = 'X-MASTERAUTH' ;

        my @challenge = $imap->tag_and_run( $authmech, "+" ) ;
        if ( not defined $challenge[0] )
        {
                exit_clean( $sync, $EXIT_AUTHENTICATION_FAILURE, "Failure authenticate with $authmech: ", $imap->LastError, "\n") ;
                return ; # hahaha!
        }
        $sync->{ debug } and myprint( "X-MASTERAUTH challenge: [@challenge]\n" ) ;

        $challenge[1] =~ s/^\+ |^\s+|\s+$//g ;
        $imap->_imap_command( { addcrlf => 1, addtag => 0, tag => $imap->Count }, md5_hex( $challenge[1] . $password ) )
                or exit_clean( $sync, $EXIT_AUTHENTICATION_FAILURE, "Failure authenticate with $authmech: ", $imap->LastError, "\n") ;

        $imap->tag_and_run( 'X-SETUSER ' . $user )
                or exit_clean( $sync, $EXIT_AUTHENTICATION_FAILURE, "Failure authenticate with $authmech: ", "X-SETUSER ", $imap->LastError, "\n") ;

                $imap->State( Mail::IMAPClient::Authenticated ) ;
        # I comment this state because "Selected" state is usually done by SELECT or EXAMINE imap commands
        # $imap->State( Mail::IMAPClient::Selected ) ;

        return ;
}


sub tests_do_valid_directory
{
	note( 'Entering tests_do_valid_directory()' ) ;

        Readonly my $NB_UNIX_tests_do_valid_directory => 2 ;
        SKIP: {
                skip( 'Tests only for Unix', $NB_UNIX_tests_do_valid_directory ) if ( 'MSWin32' eq $OSNAME ) ;
                ok( 1 == do_valid_directory( '.'), 'do_valid_directory: . good' ) ;
                ok( 1 == do_valid_directory( './W/tmp/tests/valid/sub'), 'do_valid_directory: ./W/tmp/tests/valid/sub good' ) ;
        }
        Readonly my $NB_UNIX_tests_do_valid_directory_non_root => 2 ;
        SKIP: {
                skip( 'Tests only for Unix', $NB_UNIX_tests_do_valid_directory_non_root ) if ( 'MSWin32' eq $OSNAME or '0' eq $EFFECTIVE_USER_ID ) ;
                diag( 'Error / not writable is on purpose' ) ;
                ok( 0 == do_valid_directory( '/'), 'do_valid_directory: / bad' ) ;
                diag( 'Error permission denied on /noway is on purpose' ) ;
                ok( 0 == do_valid_directory( '/noway'), 'do_valid_directory: /noway bad' ) ;
        }


	note( 'Leaving  tests_do_valid_directory()' ) ;
        return ;
}

sub banner_imapsync
{
        my $mysync = shift @ARG ;
        my @argv = @ARG ;

        my $banner_imapsync = join q{},
                q{$RCSfile: imapsync,v $ },
                q{$Revision: 1.945 $ },
                q{$Date: 2019/06/26 19:30:56 $ },
                "\n",
                "Command line used, run by $EXECUTABLE_NAME:\n",
                "$PROGRAM_NAME ", command_line_nopassword( $mysync, @argv ), "\n" ;

        return( $banner_imapsync ) ;
}

sub do_valid_directory
{
        my $dir = shift @ARG ;

        # all good => return ok.
        return( 1 ) if ( -d $dir and -r _ and -w _ ) ;

        # exist but bad
        if ( -e $dir and not -d _ ) {
                myprint( "Error: $dir exists but is not a directory\n"  ) ;
                return( 0 ) ;
        }
        if ( -e $dir and not -w _ ) {
                my $sb = stat $dir ;
                myprintf( "Error: directory %s is not writable for user %s, permissions are %04o and owner is %s ( uid %s )\n",
                         $dir, getpwuid_any_os( $EFFECTIVE_USER_ID ), ($sb->mode & oct($PERMISSION_FILTER) ), getpwuid_any_os( $sb->uid ), $sb->uid(  ) ) ;
                return( 0 ) ;
        }
        # Trying to create it
        myprint( "Creating directory $dir\n"  ) ;
        if ( ! eval { mkpath( $dir ) } ) {
                myprint( "$EVAL_ERROR" ) if ( $EVAL_ERROR )  ;
        }
        return( 1 ) if ( -d $dir and -r _ and -w _ ) ;
        return( 0 ) ;
}


sub tests_match_a_pid_number
{
        note( 'Entering tests_match_a_pid_number()' ) ;

        is( undef, match_a_pid_number(  ), 'match_a_pid_number: no args => undef' ) ;
        is( undef, match_a_pid_number( '' ), 'match_a_pid_number: "" => undef' ) ;
        is( undef, match_a_pid_number( 'lalala' ), 'match_a_pid_number: lalala => undef' ) ;
        is( 1, match_a_pid_number( 1 ), 'match_a_pid_number: 1 => 1' ) ;
        is( 1, match_a_pid_number( 123 ), 'match_a_pid_number: 123 => 1' ) ;
        is( 1, match_a_pid_number( '123' ), 'match_a_pid_number: "123" => 1' ) ;
        is( undef, match_a_pid_number( 'a123' ), 'match_a_pid_number: a123 => undef' ) ;
        is( 1, match_a_pid_number( 99999 ), 'match_a_pid_number: 99999 => 1' ) ;
        is( undef, match_a_pid_number( 0 ), 'match_a_pid_number: 0 => undef' ) ;
        is( undef, match_a_pid_number( 100000 ), 'match_a_pid_number: 100000 => undef' ) ;
        is( undef, match_a_pid_number( 123456 ), 'match_a_pid_number: 123456 => undef' ) ;

        note( 'Leaving  tests_match_a_pid_number()' ) ;
        return ;
}

sub match_a_pid_number
{
        my $pid = shift @ARG ;
        if ( ! $pid ) { return ; }
        if ( ! match( $pid, '^\d+$' ) ) { return ; }
        if ( 0 > $pid ) { return ; }
        #if ( 65535 < $pid ) { return ; }
        if ( 99999 < $pid ) { return ; }
        return 1 ;
}

sub tests_remove_pidfile_not_running
{
        note( 'Entering tests_remove_pidfile_not_running()' ) ;

        ok( (-d 'W/tmp/tests/' or  mkpath( 'W/tmp/tests/' ) ), 'remove_pidfile_not_running: mkpath W/tmp/tests/' ) ;
        is( undef, remove_pidfile_not_running(  ), 'remove_pidfile_not_running: no args => undef' ) ;
        is( undef, remove_pidfile_not_running( './W' ), 'remove_pidfile_not_running: a dir => undef' ) ;
        is( undef, remove_pidfile_not_running( 'noexists' ), 'remove_pidfile_not_running: noexists => undef' ) ;
        is( 1, touch( 'W/tmp/tests/empty.pid' ), 'remove_pidfile_not_running: prepa empty W/tmp/tests/empty.pid' ) ;
        is( undef, remove_pidfile_not_running( 'W/tmp/tests/empty.pid' ), 'remove_pidfile_not_running: W/tmp/tests/empty.pid => undef' ) ;
        is( 'lalala', string_to_file( 'lalala', 'W/tmp/tests/lalala.pid' ), 'remove_pidfile_not_running: prepa W/tmp/tests/lalala.pid' ) ;
        is( undef, remove_pidfile_not_running( 'W/tmp/tests/lalala.pid' ), 'remove_pidfile_not_running: W/tmp/tests/lalala.pid => undef' ) ;
        is( '55555', string_to_file( '55555', 'W/tmp/tests/notrunning.pid' ), 'remove_pidfile_not_running: prepa W/tmp/tests/notrunning.pid' ) ;
        is( 1, remove_pidfile_not_running( 'W/tmp/tests/notrunning.pid' ), 'remove_pidfile_not_running: W/tmp/tests/notrunning.pid => 1' ) ;
        is( $PROCESS_ID, string_to_file( $PROCESS_ID, 'W/tmp/tests/running.pid' ), 'remove_pidfile_not_running: prepa W/tmp/tests/running.pid' ) ;
        is( undef, remove_pidfile_not_running( 'W/tmp/tests/running.pid' ), 'remove_pidfile_not_running: W/tmp/tests/running.pid => undef' ) ;

        note( 'Leaving  tests_remove_pidfile_not_running()' ) ;
        return ;
}

sub remove_pidfile_not_running
{
        #
        my $pid_filename = shift @ARG ;

        if ( ! $pid_filename )    { myprint( "No variable pid_filename\n" ) ; return } ;
        if ( ! -e $pid_filename ) { myprint( "File $pid_filename does not exist\n" ) ; return } ;
        if ( ! -f $pid_filename ) { myprint( "File $pid_filename is not a file\n" ) ; return } ;

        my $pid = firstline( $pid_filename ) ;
        if ( ! match_a_pid_number( $pid ) ) { myprint( "pid $pid in $pid_filename is not a number\n" ) ; return } ;
        # can't kill myself => do nothing
        if ( ! kill 'ZERO', $PROCESS_ID  ) { myprint( "Can not kill ZERO myself $PROCESS_ID\n" ) ; return } ;

        # can't kill ZERO the pid => it is gone or own by another user => remove pidfile
        if ( ! kill 'ZERO', $pid ) {
                myprint( "Removing old $pid_filename since its PID $pid is not running anymore (oo-killed?)\n" ) ;
                if ( unlink $pid_filename ) {
                        myprint( "Removed old $pid_filename\n" ) ;
                        return 1 ;
                }else{
                        myprint( "Could not remove old $pid_filename because $!\n" ) ;
                        return ;
                }
        }
        myprint( "Another imapsync process $pid is running as says pidfile $pid_filename\n" ) ;
        return ;
}


sub tests_tail
{
        note( 'Entering tests_tail()' ) ;

        ok( (-d 'W/tmp/tests/' or  mkpath( 'W/tmp/tests/' ) ), 'tail: mkpath W/tmp/tests/' ) ;
        ok( ( ! -e 'W/tmp/tests/tail.pid' || unlink 'W/tmp/tests/tail.pid' ), 'tail: unlink W/tmp/tests/tail.pid' ) ;
        ok( ( ! -e 'W/tmp/tests/tail.txt' || unlink 'W/tmp/tests/tail.txt' ), 'tail: unlink W/tmp/tests/tail.txt' ) ;

        is( undef, tail(  ),  'tail: no args => undef' ) ;
        my $mysync ;
        is( undef, tail( $mysync ),  'tail: no pidfile => undef' ) ;

        $mysync->{pidfile} = 'W/tmp/tests/tail.pid' ;
        is( undef, tail( $mysync ),  'tail: no pidfilelocking => undef' ) ;

        $mysync->{pidfilelocking} = 1 ;
        is( undef, tail( $mysync ),  'tail: pidfile no exists => undef' ) ;


        my $pidandlog = "33333\nW/tmp/tests/tail.txt\n" ;
        is( $pidandlog, string_to_file( $pidandlog, $mysync->{pidfile} ), 'tail: put pid 33333 and tail.txt in pidfile' ) ;
        is( undef, tail( $mysync ), 'tail: logfile to tail no exists => undef' ) ;

        my $tailcontent = "L1\nL2\nL3\nL4\nL5\n" ;
        is( $tailcontent, string_to_file( $tailcontent, 'W/tmp/tests/tail.txt' ),
            'tail: put L1\nL2\nL3\nL4\nL5\n in W/tmp/tests/tail.txt' ) ;

        is( undef, tail( $mysync ),  'tail: fake pid in pidfile + tail off => 1' ) ;

        $mysync->{ tail } = 1 ;
        is( 1, tail( $mysync ),  'tail: fake pid in pidfile + tail on=> 1' ) ;

        # put my own pid, won't do tail
        $pidandlog = "$PROCESS_ID\nW/tmp/tests/tail.txt\n" ;
        is( $pidandlog, string_to_file( $pidandlog, $mysync->{pidfile} ),  'tail: put my own PID in pidfile' ) ;
        is( undef, tail( $mysync ),  'tail: my own pid in pidfile => undef' ) ;

        note( 'Leaving  tests_tail()' ) ;
        return ;
}



sub tail
{
        # return undef on failures
        # return 1 on success

        my $mysync = shift ;

        # no tail when aborting!
        if ( $mysync->{ abort } ) { return ; }

        my $pidfile = $mysync->{pidfile} ;
        my $lock    = $mysync->{pidfilelocking} ;
        my $tail    = $mysync->{tail} ;

        if ( ! $pidfile ) { return ; }
        if ( ! $lock )    { return ; }
        if ( ! $tail )    { return ; }

        my $pidtotail = firstline( $pidfile ) ;
        if ( ! $pidtotail ) { return ; }



        # It should not happen but who knows...
        if ( $pidtotail eq $PROCESS_ID ) { return ; }


        my $filetotail = secondline( $pidfile ) ;
        if ( ! $filetotail ) { return ; }

        if ( ! -r $filetotail )
        {
                #myprint( "Error: can not read $filetotail\n" ) ;
                return ;
        }

        myprint( "Doing a tail -f on $filetotail for processus pid $pidtotail until it is finished.\n" ) ;
        my $file = File::Tail->new(
                name        => $filetotail,
                nowait      => 1,
                interval    => 1,
                tail        => 1,
                adjustafter => 2
        );

        my $moretimes = 200 ;
        # print one line at least
        my $line = $file->read ;
        myprint( $line ) ;
        while ( isrunning( $pidtotail, \$moretimes )  and defined( $line = $file->read ) )
        {
                myprint( $line );
                sleep( 0.02 ) ;
        }

        return 1 ;
}

sub isrunning
{
        my $pidtocheck    = shift ;
        my $moretimes_ref = shift ;

        if ( kill 'ZERO', $pidtocheck )
        {
                #myprint( "$pidtocheck running\n" ) ;
                return 1 ;
        }
        elsif ( $$moretimes_ref >= 0 )
        {
                # continue to consider it running
                $$moretimes_ref-- ;
                return 1 ;
        }
        else
        {
                myprint( "Tailed processus $pidtocheck ended\n" ) ;
                return ;
        }
}

sub tests_write_pidfile
{
        note( 'Entering tests_write_pidfile()' ) ;

        my $mysync ;

        is( 1, write_pidfile(  ), 'write_pidfile: no args => 1' ) ;

        # no pidfile => ok
        $mysync->{pidfile} = q{} ;
        is( 1, write_pidfile( $mysync ), 'write_pidfile: no pidfile => undef' ) ;

        # The pidfile path is bad => failure
        $mysync->{pidfile} = '/no/no/no.pid' ;
        is( undef, write_pidfile( $mysync ), 'write_pidfile: no permission for /no/no/no.pid, no lock => undef' ) ;

        $mysync->{pidfilelocking} = 1 ;
        is( undef, write_pidfile( $mysync ), 'write_pidfile: no permission for /no/no/no.pid + lock => undef' ) ;

        $mysync->{pidfile} = 'W/tmp/tests/test.pid' ;
        ok( (-d 'W/tmp/tests/' or  mkpath( 'W/tmp/tests/' ) ), 'write_pidfile: mkpath W/tmp/tests/' ) ;
        is( 1, touch( $mysync->{pidfile} ), 'write_pidfile: lock prepa' ) ;

        $mysync->{pidfilelocking} = 0 ;
        is( 1, write_pidfile( $mysync ), 'write_pidfile: W/tmp/tests/test.pid + no lock => 1' ) ;
        is( $PROCESS_ID, firstline( 'W/tmp/tests/test.pid' ), "write_pidfile: W/tmp/tests/test.pid contains $PROCESS_ID" ) ;
        is( q{}, secondline( 'W/tmp/tests/test.pid' ), "write_pidfile: W/tmp/tests/test.pid contains no second line" ) ;

        $mysync->{pidfilelocking} = 1 ;
        is( undef, write_pidfile( $mysync ), 'write_pidfile: W/tmp/tests/test.pid + lock => undef' ) ;


        $mysync->{pidfilelocking} = 0 ;
        $mysync->{ logfile } = 'rrrr.txt' ;
        is( 1, write_pidfile( $mysync ), 'write_pidfile: W/tmp/tests/test.pid + no lock + logfile => 1' ) ;
        is( $PROCESS_ID, firstline( 'W/tmp/tests/test.pid' ),  "write_pidfile: + no lock + logfile W/tmp/tests/test.pid contains $PROCESS_ID" ) ;
        is( q{rrrr.txt}, secondline( 'W/tmp/tests/test.pid' ), "write_pidfile: + no lock + logfile W/tmp/tests/test.pid contains rrrr.txt" ) ;


        note( 'Leaving  tests_write_pidfile()' ) ;
        return ;
}



sub write_pidfile
{
        # returns undef if something is considered fatal
        # returns 1 otherwise

        if ( ! @ARG ) { return 1 ; }

        my $mysync = shift @ARG ;

        # Do not write the pid file if this process goal is to abort the process designed by the pid file
        if ( $mysync->{abort} ) { return 1 ; }

        #
        my $pid_filename = $mysync->{ pidfile } ;
        my $lock         = $mysync->{ pidfilelocking } ;

        if ( ! $pid_filename )
        {
                myprint( "PID file is unset ( to set it, use --pidfile filepath ; to avoid it use --pidfile \"\" )\n" ) ;
                return( 1 ) ;
        }

        myprint( "PID file is $pid_filename ( to change it, use --pidfile filepath ; to avoid it use --pidfile \"\" )\n" ) ;
        if ( -e $pid_filename and $lock ) {
                myprint( "$pid_filename already exists, another imapsync may be curently running. Aborting imapsync.\n"  ) ;
                return ;

        }

        if ( -e $pid_filename ) {
                myprint( "$pid_filename already exists, overwriting it ( use --pidfilelocking to avoid concurrent runs )\n"  ) ;
        }

        my $pid_string = "$PROCESS_ID\n" ;
        my $pid_message = "Writing my PID $PROCESS_ID in $pid_filename\n" ;

        if ( $mysync->{ logfile } )
        {
                $pid_string  .= "$mysync->{ logfile }\n" ;
                $pid_message .= "Writing also my logfile name in $pid_filename : $mysync->{ logfile }\n" ;
        }

        if ( open my $FILE_HANDLE, '>', $pid_filename ) {
                myprint( $pid_message ) ;
                print $FILE_HANDLE $pid_string ;
                close $FILE_HANDLE ;
                return( 1 ) ;
        }
        else
        {
                myprint( "Could not open $pid_filename for writing. Check permissions or disk space: $OS_ERROR\n"  ) ;
                return ;
        }
}


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

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

sub tests_fix_Inbox_INBOX_mapping
{
	note( 'Entering tests_fix_Inbox_INBOX_mapping()' ) ;


        my( $h1_all, $h2_all ) ;

        $h1_all = { 'INBOX' => q{} } ;
        $h2_all = { 'INBOX' => q{} } ;
        ok( q{} eq fix_Inbox_INBOX_mapping( $h1_all, $h2_all ), 'fix_Inbox_INBOX_mapping: INBOX INBOX' ) ;

        $h1_all = { 'Inbox' => q{} } ;
        $h2_all = { 'Inbox' => q{} } ;
        ok( q{} eq fix_Inbox_INBOX_mapping( $h1_all, $h2_all ), 'fix_Inbox_INBOX_mapping: Inbox Inbox' ) ;

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

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

        $h1_all = { 'INBOX' => q{} } ;
        $h2_all = { 'rrrrr' => q{} } ;
        ok( q{} eq fix_Inbox_INBOX_mapping( $h1_all, $h2_all ), 'fix_Inbox_INBOX_mapping: INBOX rrrrrr' ) ;

        $h1_all = { 'rrrrr' => q{} } ;
        $h2_all = { 'Inbox' => q{} } ;
        ok( q{} eq fix_Inbox_INBOX_mapping( $h1_all, $h2_all ), 'fix_Inbox_INBOX_mapping: rrrrr Inbox' ) ;

	note( 'Leaving  tests_fix_Inbox_INBOX_mapping()' ) ;
        return ;
}


sub jux_utf8_list
{
        my @s_inp = @_ ;
        my $s_out = q{} ;
        foreach my $s ( @s_inp ) {
                $s_out .= jux_utf8( $s ) . "\n" ;
        }
        return( $s_out ) ;
}

sub tests_jux_utf8_list
{
	note( 'Entering tests_jux_utf8_list()' ) ;

        ok( q{} eq jux_utf8_list(  ), 'jux_utf8_list: void' ) ;
        ok( "[]\n" eq jux_utf8_list( q{} ), 'jux_utf8_list: empty string' ) ;
        ok( "[INBOX]\n" eq jux_utf8_list( 'INBOX' ), 'jux_utf8_list: INBOX' ) ;
        ok( "[&ANY-] = [Ö]\n" eq jux_utf8_list( '&ANY-' ), 'jux_utf8_list: &ANY-' ) ;

	note( 'Leaving  tests_jux_utf8_list()' ) ;
        return( 0 ) ;
}

sub jux_utf8
{
        # juxtapose utf8 at the right if different
        my ( $s_utf7 ) =  shift ;
        my ( $s_utf8 ) =  imap_utf7_decode( $s_utf7 ) ;

        if ( $s_utf7 eq $s_utf8 ) {
                #myprint( "[$s_utf7]\n"  ) ;
                return( "[$s_utf7]" ) ;
        }else{
                #myprint( "[$s_utf7] = [$s_utf8]\n"  ) ;
                return( "[$s_utf7] = [$s_utf8]" ) ;
        }
}

# editing utf8 can be tricky without an utf8 editor
sub tests_jux_utf8
{
	note( 'Entering tests_jux_utf8()' ) ;

        ok( '[INBOX]' eq jux_utf8( 'INBOX'), 'jux_utf8: INBOX => [INBOX]' ) ;
        ok( '[&ZTZO9nux-] = [收件箱]' eq jux_utf8( '&ZTZO9nux-'), 'jux_utf8: => [&ZTZO9nux-] = [收件箱]' ) ;
        ok( '[&ANY-] = [Ö]' eq jux_utf8( '&ANY-'), 'jux_utf8: &ANY- => [&ANY-] = [Ö]' ) ;
        ok( '[]' eq jux_utf8( q{} ), 'jux_utf8: void => []' ) ;
        ok( '[+BD8EQAQ1BDQEOwQ+BDM-] = [предлог]' eq jux_utf8( '+BD8EQAQ1BDQEOwQ+BDM-' ), 'jux_utf8: => [+BD8EQAQ1BDQEOwQ+BDM-] = [предлог]' ) ;
        ok( '[&BB8EQAQ+BDUEOgRC-] = [Проект]'      eq jux_utf8( '&BB8EQAQ+BDUEOgRC-' ),    'jux_utf8: => [&BB8EQAQ+BDUEOgRC-] = [Проект]' ) ;

	note( 'Leaving  tests_jux_utf8()' ) ;
        return ;
}

# Copied from http://cpansearch.perl.org/src/FABPOT/Unicode-IMAPUtf7-2.01/lib/Unicode/IMAPUtf7.pm
# and then fixed with
# https://rt.cpan.org/Public/Bug/Display.html?id=11172
sub imap_utf7_decode
{
        my ( $s ) = shift ;

        # Algorithm
        # On remplace , par / dans les BASE 64 (, entre & et -)
        # On remplace les &, non suivi d'un - par +
        # On remplace les &- par &
        $s =~ s/&([^,&\-]*),([^,\-&]*)\-/&$1\/$2\-/xg ;
        $s =~ s/&(?!\-)/\+/xg ;
        $s =~ s/&\-/&/xg ;
        return( Unicode::String::utf7( $s )->utf8 ) ;
}

sub imap_utf7_encode
{
        my ( $s ) = @_ ;

        $s = Unicode::String::utf8( $s )->utf7 ;

        $s =~ s/\+([^\/&\-]*)\/([^\/\-&]*)\-/\+$1,$2\-/xg ;
        $s =~ s/&/&\-/xg ;
        $s =~ s/\+([^+\-]+)?\-/&$1\-/xg ;
        return( $s ) ;
}




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

sub examine_folder
{
        my ( $mysync, $imap, $folder, $hostside ) = @_ ;
        if ( ! $imap->examine( $folder ) ) {
                my $error = join q{},
                        "$hostside folder $folder: Could not examine: ",
                        $imap->LastError,  "\n" ;
                errors_incr( $mysync, $error ) ;
                return( 0 ) ;
        }else{
                # ok select succeeded
                return( 1 ) ;
        }
}


sub count_from_select
{
        my @lines = @ARG ;
        my $count ;
        foreach my $line ( @lines ) {
                #myprint( "line = [$line]\n"  ) ;
                if ( $line =~ m/^\*\s+(\d+)\s+EXISTS/x ) {
                        $count = $1 ;
                        return( $count ) ;
                }
        }
        return( undef ) ;
}



sub create_folder_old
{
        my $mysync = shift @ARG ;
        my( $imap, $h2_fold, $h1_fold ) = @ARG ;

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


sub create_folder
{
        my $mysync = shift @ARG ;
        my( $myimap2 , $h2_fold , $h1_fold ) = @ARG ;
        my( @parts , $parent ) ;

        if ( $myimap2->IsUnconnected(  ) ) {
                myprint( "Host2: Unconnected state\n"  ) ;
                return( 0 ) ;
        }

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

        if ( $mixfolders and $myimap2->exists( $h2_fold ) ) {
                myprint( "Folder [$h2_fold] already exists (--nomixfolders is not set)\n"  ) ;
                return( 1 ) ;
        }


        if ( ( not $mixfolders ) and ( $myimap2->exists( $h2_fold ) ) ) {
                myprint( "Folder [$h2_fold] already exists and --nomixfolders is set\n"  ) ;
                return( 0 ) ;
        }

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

        if ( ! $mysync->{dry} ) {
                if ( ! $myimap2->create( $h2_fold ) ) {
                        my $error = join q{},
                                "Could not create folder [$h2_fold] from [$h1_fold]: " ,
                                $myimap2->LastError(  ), "\n" ;
                        errors_incr( $mysync, $error ) ;
                        # success if folder exists ("already exists" error)
                        return( 1 ) if $myimap2->exists( $h2_fold ) ;
                        # failure since create failed
                        return( 0 ) ;
                }else{
                        #create succeeded
                        myprint( "Created folder [$h2_fold] on host2\n"  ) ;
                        return( 1 ) ;
                }
        }else{
                # dry mode, no folder so many imap will fail, assuming failure
                myprint( "Created folder [$h2_fold] on host2 $mysync->{dry_message}\n"  ) ;
                if ( ! $mysync->{ justfolders } ) {
                        myprint( "Since --dry mode is on and folder [$h2_fold] on host2 does not exist yet, syncing messages 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
{
	note( 'Entering 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'       );

        is_deeply( [ 'folder_foo' ], [ remove_from_requested_folders( 'folder_foo' ) ], 'removed folder_foo => 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'                         );

        is_deeply( [ 'folder_bar' ], [ 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( 'A_99', 'M_55', 'Z_11' ), 'add_to_requested_folders M_55 Z_11'       );
        ok( 0 == compare_lists( [ sort_requested_folders(  ) ], [ 'A_99', 'M_55', 'Z_11' ] ), 'sort_requested_folders: middle' ) ;


        @folderfirst = ( 'Z_11' ) ;

        ok( 0 == compare_lists( [ sort_requested_folders(  ) ], [ 'Z_11', 'A_99', 'M_55' ] ), 'sort_requested_folders: first+middle' ) ;

        is_deeply( [ 'Z_11', 'A_99', 'M_55' ], [ sort_requested_folders(  ) ], 'sort_requested_folders: first+middle is_deeply' ) ;

        @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' ) ;


        ok(  add_to_requested_folders('A_88', 'Z_22',), 'add_to_requested_folders A_88 Z_22'       ) ;
        @folderfirst = qw( Z_22  Z_11 ) ;
        @folderlast  = qw( 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' ) ;
        undef @folderfirst ;
        undef @folderlast ;

	note( 'Leaving  tests_folder_routines()' ) ;
        return ;
}


sub sort_requested_folders
{
        my @requested_folders_sorted = () ;

        #myprint "folderfirst: @folderfirst\n" ;
        my @folderfirst_requested = remove_from_requested_folders( @folderfirst ) ;
        #myprint "folderfirst_requested: @folderfirst_requested\n" ;

        my @folderlast_requested  = remove_from_requested_folders( @folderlast ) ;

        my @middle = sort keys %requested_folder ;

        @requested_folders_sorted = ( @folderfirst_requested, @middle, @folderlast_requested ) ;
        #myprint "requested_folders_sorted: @requested_folders_sorted\n" ;
        add_to_requested_folders( @requested_folders_sorted ) ;

        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 tests_remove_from_requested_folders
{
        note( 'Entering tests_remove_from_requested_folders()' ) ;

        is( undef, undef,  'remove_from_requested_folders: undef is undef' ) ;
        is_deeply( [], [ remove_from_requested_folders(  ) ], 'remove_from_requested_folders: no args' ) ;
        %requested_folder = (
                'F1' => 1,
        ) ;
        is_deeply( [], [ remove_from_requested_folders(  ) ], 'remove_from_requested_folders: remove nothing among F1 => nothing' ) ;
        is_deeply( [], [ remove_from_requested_folders( 'Fno' ) ], 'remove_from_requested_folders: remove Fno among F1 => nothing' ) ;
        is_deeply( [ 'F1' ], [ remove_from_requested_folders( 'F1' ) ], 'remove_from_requested_folders: remove F1 among F1 => F1' ) ;
        is_deeply( { }, { %requested_folder }, 'remove_from_requested_folders: remove F1 among F1 => %requested_folder emptied' ) ;

        %requested_folder = (
                'F1' => 1,
                'F2' => 1,
        ) ;
        is_deeply( [], [ remove_from_requested_folders(  ) ], 'remove_from_requested_folders: remove nothing among F1 F2 => nothing' ) ;
        is_deeply( [], [ remove_from_requested_folders( 'Fno' ) ], 'remove_from_requested_folders: remove Fno among F1 F2 => nothing' ) ;
        is_deeply( [ 'F1' ], [ remove_from_requested_folders( 'F1' ) ], 'remove_from_requested_folders: remove F1 among F1 F2 => F1' ) ;
        is_deeply( { 'F2' => 1 }, { %requested_folder }, 'remove_from_requested_folders: remove F1 among F1 F2 => %requested_folder F2' ) ;

        is_deeply( [], [ remove_from_requested_folders( 'F1' ) ], 'remove_from_requested_folders: remove F1 among F2 => nothing' ) ;
        is_deeply( [ 'F2' ], [ remove_from_requested_folders( 'F1', 'F2' ) ], 'remove_from_requested_folders: remove F1 F2 among F2 => F2' ) ;
        is_deeply( {}, { %requested_folder }, 'remove_from_requested_folders: remove F1 among F1 F2 => %requested_folder F2' ) ;

        %requested_folder = (
                'F1' => 1,
                'F2' => 1,
                'F3' => 1,
        ) ;
        is_deeply( [ 'F1', 'F2' ], [ remove_from_requested_folders( 'F1', 'F2' ) ], 'remove_from_requested_folders: remove F1 F2 among F1 F2 F3 => F1 F2' ) ;
        is_deeply( { 'F3' => 1 }, { %requested_folder }, 'remove_from_requested_folders: remove F1 F2 among F1 F2 F3 => %requested_folder F3' ) ;



        note( 'Leaving  tests_remove_from_requested_folders()' ) ;
        return ;
}


sub remove_from_requested_folders
{
        my @unwanted_folders = @_ ;

        my @removed_folders = () ;
        foreach my $folder ( @unwanted_folders ) {
                if ( exists $requested_folder{ $folder } )
                {
                        delete $requested_folder{ $folder } ;
                        push @removed_folders, $folder ;
                }
        }
        return( @removed_folders ) ;
}

sub compare_lists
{
        my ($list_1_ref, $list_2_ref) = @_;

        return($MINUS_ONE) 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 = $MINUS_ONE;


        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 $MINUS_ONE if ($last_used_indice < $#{ $list_2_ref } ) ;

        # same size, each element equal
        return 0 ;
}

sub tests_compare_lists
{
	note( 'Entering 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($MINUS_ONE == compare_lists(undef , [])     , 'compare_lists, undef < []');
        ok($MINUS_ONE == compare_lists(undef , [1])    , 'compare_lists, undef < [1]');
        ok($MINUS_ONE == 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($MINUS_ONE == 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($MINUS_ONE == compare_lists( 0 ,  1 )          , 'compare_lists,  0  <  1 ') ;
        ok($MINUS_ONE == compare_lists($MINUS_ONE ,  0 )          , 'compare_lists, -1  <  0 ') ;
        ok($MINUS_ONE == 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($MINUS_ONE == compare_lists([1], [1,2])     , 'compare_lists,    [1] < [1,2]' ) ;
        ok(+1 == compare_lists([2], [1,2])     , 'compare_lists,    [2] > [1,2]' ) ;
        ok($MINUS_ONE == 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 .. $NUMBER_20_000] , [1 .. $NUMBER_20_000])
                                               , 'compare_lists, [1..20_000] = [1..20_000]' ) ;
        ok($MINUS_ONE == compare_lists([1], [2])       , 'compare_lists, [1] < [2]') ;
        ok( 0 == compare_lists([2], [2])       , 'compare_lists, [0] = [2]') ;
        ok(+1 == compare_lists([2], [1])       , 'compare_lists, [2] > [1]') ;

        ok($MINUS_ONE == 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($MINUS_ONE == compare_lists(['a'],  ['aa'])  , 'compare_lists, ["a"] < ["aa"]') ;
        ok($MINUS_ONE == compare_lists(['a'],  ['a', 'a']), 'compare_lists, ["a"] < ["a", "a"]') ;
        ok( 0 == compare_lists([split q{ }, 'a b' ], ['a', 'b']), 'compare_lists, split') ;
        ok( 0 == compare_lists([sort split q{ }, 'b a' ], ['a', 'b']), 'compare_lists, sort split') ;

	note( 'Leaving  tests_compare_lists()' ) ;
        return ;
}


sub guess_prefix
{
        my @foldernames = @_ ;

        my $prefix_guessed = q{} ;
        foreach my $folder ( @foldernames ) {
                next if ( $folder =~ m{^INBOX$}xi ) ; # no guessing from INBOX
                if ( $folder !~ m{^INBOX}xi ) {
                        $prefix_guessed = q{} ; # prefix empty guessed
                        last ;
                }
                if ( $folder =~ m{^(INBOX(?:\.|\/))}xi ) {
                        $prefix_guessed = $1 ;  # prefix Inbox/ or INBOX. guessed
                }
        }
        return( $prefix_guessed ) ;
}

sub tests_guess_prefix
{
	note( 'Entering tests_guess_prefix()' ) ;

        is( guess_prefix(  ), q{}, 'guess_prefix: no args => empty string' ) ;
        is( q{} , guess_prefix( 'INBOX' ), 'guess_prefix: INBOX alone' ) ;
        is( q{} , guess_prefix( 'Inbox' ), 'guess_prefix: Inbox alone' ) ;
        is( q{} , guess_prefix( 'INBOX' ), 'guess_prefix: INBOX alone' ) ;
        is( 'INBOX/' , guess_prefix( 'INBOX', 'INBOX/Junk' ), 'guess_prefix: INBOX INBOX/Junk' ) ;
        is( 'INBOX.' , guess_prefix( 'INBOX', 'INBOX.Junk' ), 'guess_prefix: INBOX INBOX.Junk' ) ;
        is( 'Inbox/' , guess_prefix( 'Inbox', 'Inbox/Junk' ), 'guess_prefix: Inbox Inbox/Junk' ) ;
        is( 'Inbox.' , guess_prefix( 'Inbox', 'Inbox.Junk' ), 'guess_prefix: Inbox Inbox.Junk' ) ;
        is( 'INBOX/' , guess_prefix( 'INBOX', 'INBOX/Junk', 'INBOX/rrr' ), 'guess_prefix: INBOX INBOX/Junk INBOX/rrr' ) ;
        is( q{} , guess_prefix( 'INBOX', 'INBOX/Junk', 'INBOX/rrr', 'zzz' ), 'guess_prefix: INBOX INBOX/Junk INBOX/rrr zzz' ) ;
        is( q{} , guess_prefix( 'INBOX', 'Junk' ), 'guess_prefix: INBOX Junk' ) ;
        is( q{} , guess_prefix( 'INBOX', 'Junk' ), 'guess_prefix: INBOX Junk' ) ;

	note( 'Leaving  tests_guess_prefix()' ) ;
        return ;
}

sub get_prefix
{
        my( $imap, $prefix_in, $prefix_opt, $Side, $folders_ref ) = @_ ;
        my( $prefix_out, $prefix_guessed ) ;

        ( $sync->{ debug } or $sync->{debugfolders} ) and myprint( "$Side: Getting prefix\n"  ) ;
        $prefix_guessed = guess_prefix( @{ $folders_ref } ) ;
        myprint( "$Side: guessing prefix from folder listing: [$prefix_guessed]\n"  ) ;
        ( $sync->{ debug } or $sync->{debugfolders} ) and myprint( "$Side: Calling namespace capability\n"  ) ;
        if ( $imap->has_capability( 'namespace' ) ) {
                my $r_namespace = $imap->namespace(  ) ;
                $prefix_out = $r_namespace->[0][0][0] ;
                myprint( "$Side: prefix given by NAMESPACE: [$prefix_out]\n"  ) ;
                if ( defined  $prefix_in  ) {
                        myprint( "$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  ) {
                        myprint( "$Side: using [$prefix_in] given by $prefix_opt\n"  ) ;
                        $prefix_out = $prefix_in ;
                        return( $prefix_out ) ;
                }else{
                        myprint(
                          "$Side: No NAMESPACE capability so using guessed prefix [$prefix_guessed]\n",
                          help_to_guess_prefix( $imap, $prefix_opt ) ) ;
                        return( $prefix_guessed ) ;
                }
        }
        return ;
}


sub guess_separator
{
        my @foldernames = @_ ;

        #return( undef ) unless ( @foldernames ) ;

        my $sep_guessed ;
        my %counter ;
        foreach my $folder ( @foldernames ) {
                $counter{'/'}++  while ( $folder =~ m{/}xg ) ;  # count /
                $counter{'.'}++  while ( $folder =~ m{\.}xg ) ; # count .
                $counter{'\\\\'}++ while ( $folder =~ m{(\\){2}}xg ) ; # count \\
                $counter{'\\'}++ while ( $folder =~ m{[^\\](\\){1}(?=[^\\])}xg ) ; # count \
        }
        my @race_sorted = sort { $counter{ $b } <=> $counter{ $a } } keys  %counter  ;
        $sync->{ debug } and myprint( "@foldernames\n@race_sorted\n", %counter, "\n"  ) ;
        $sep_guessed = shift @race_sorted || $LAST_RESSORT_SEPARATOR ; # / when nothing found.
        return( $sep_guessed ) ;
}

sub tests_guess_separator
{
	note( 'Entering tests_guess_separator()' ) ;

        ok( '/' eq  guess_separator(  ), 'guess_separator: no args' ) ;
        ok( '/' eq guess_separator( 'abcd' ), 'guess_separator: abcd' ) ;
        ok( '/' eq guess_separator( 'a/b/c.d' ), 'guess_separator: a/b/c.d' ) ;
        ok( '.' eq guess_separator( 'a.b/c.d' ), 'guess_separator: a.b/c.d' ) ;
        ok( '\\\\' eq guess_separator( 'a\\\\b\\\\c.c\\\\d/e/f' ), 'guess_separator: a\\\\b\\\\c.c\\\\d/e/f' ) ;
        ok( '\\' eq guess_separator( 'a\\b\\c.c\\d/e/f' ), 'guess_separator: a\\b\\c.c\\d/e/f' ) ;
        ok( '\\' eq guess_separator( 'a\\b' ), 'guess_separator: a\\b' ) ;
        ok( '\\' eq guess_separator( 'a\\b\\c' ), 'guess_separator: a\\b\\c' ) ;

	note( 'Leaving  tests_guess_separator()' ) ;
        return ;
}

sub get_separator
{
        my( $imap, $sep_in, $sep_opt, $Side, $folders_ref ) = @_ ;
        my( $sep_out, $sep_guessed ) ;

        ( $sync->{ debug } or $sync->{debugfolders} ) and myprint( "$Side: Getting separator\n"  ) ;
        $sep_guessed = guess_separator( @{ $folders_ref } ) ;
        myprint( "$Side: guessing separator from folder listing: [$sep_guessed]\n"  ) ;

        ( $sync->{ debug } or $sync->{debugfolders} ) and myprint( "$Side: calling namespace capability\n"  ) ;
        if ( $imap->has_capability( 'namespace' ) )
        {
                $sep_out = $imap->separator(  ) ;
                if ( defined  $sep_out  ) {
                        myprint( "$Side: separator given by NAMESPACE: [$sep_out]\n"  ) ;
                        if ( defined  $sep_in  ) {
                                myprint( "$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  ) {
                                myprint( "$Side: NAMESPACE request failed but using [$sep_in] given by $sep_opt\n"  ) ;
                                $sep_out = $sep_in ;
                                return( $sep_out ) ;
                        }else{
                                myprint(
                                "$Side: NAMESPACE request failed so using guessed separator [$sep_guessed]\n",
                                help_to_guess_sep( $imap, $sep_opt ) ) ;
                                return( $sep_guessed ) ;
                        }
                }
        }
        else
        {
                if ( defined  $sep_in  ) {
                        myprint( "$Side: No NAMESPACE capability but using [$sep_in] given by $sep_opt\n"  ) ;
                        $sep_out = $sep_in ;
                        return( $sep_out ) ;
                }else{
                        myprint(
                        "$Side: No NAMESPACE capability, so using guessed separator [$sep_guessed]\n",
                        help_to_guess_sep( $imap, $sep_opt ) ) ;
                        return( $sep_guessed ) ;
                }
        }
        return ;
}

sub help_to_guess_sep
{
        my( $imap, $sep_opt ) = @_ ;

        my $help_to_guess_sep = "You can set the separator character with the $sep_opt option,\n"
        . "the complete listing of folders may help you to find it\n"
        . folders_list_to_help( $imap ) ;

        return( $help_to_guess_sep ) ;
}

sub help_to_guess_prefix
{
        my( $imap, $prefix_opt ) = @_ ;

        my $help_to_guess_prefix = "You can set 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 ) ;

        return( $help_to_guess_prefix ) ;
}


sub folders_list_to_help
{
        my( $imap ) = shift ;

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

sub private_folders_separators_and_prefixes
{
# what are the private folders separators and prefixes for each server ?

        ( $sync->{ debug } or $sync->{debugfolders} ) and myprint( "Getting separators\n"  ) ;
        $sync->{ h1_sep } = get_separator( $sync->{imap1}, $sync->{ sep1 }, '--sep1', 'Host1', \@h1_folders_all ) ;
        $sync->{ h2_sep } = get_separator( $sync->{imap2}, $sync->{ sep2 }, '--sep2', 'Host2', \@h2_folders_all ) ;


        $sync->{ h1_prefix } = get_prefix( $sync->{imap1}, $prefix1, '--prefix1', 'Host1', \@h1_folders_all ) ;
        $sync->{ h2_prefix } = get_prefix( $sync->{imap2}, $prefix2, '--prefix2', 'Host2', \@h2_folders_all ) ;

        myprint( "Host1: separator and prefix: [$sync->{ h1_sep }][$sync->{ h1_prefix }]\n"  ) ;
        myprint( "Host2: separator and prefix: [$sync->{ h2_sep }][$sync->{ h2_prefix }]\n"  ) ;
        return ;
}


sub subfolder1
{
        my $mysync = shift ;
        my $subfolder1 = sanitize_subfolder( $mysync->{ subfolder1 } ) ;

        if ( $subfolder1 )
        {
                # turns off automap
                myprint( "Turning off automapping folders because of --subfolder1\n"  ) ;
                $mysync->{ automap } = undef ;
                myprint( "Sanitizing subfolder1: [$mysync->{ subfolder1 }] => [$subfolder1]\n" ) ;
                $mysync->{ subfolder1 } = $subfolder1 ;
                add_subfolder1_to_folderrec( $mysync ) || exit_clean( $mysync, $EXIT_SUBFOLDER1_NO_EXISTS ) ;
        }
        else
        {
                $mysync->{ subfolder1 } = undef ;
        }

        return ;
}

sub subfolder2
{
        my $mysync = shift ;
        my $subfolder2 = sanitize_subfolder( $mysync->{ subfolder2 } ) ;
        if ( $subfolder2 )
        {
                # turns off automap
                myprint( "Turning off automapping folders because of --subfolder2\n"  ) ;
                $mysync->{ automap } = undef ;
                myprint( "Sanitizing subfolder2: [$mysync->{ subfolder2 }] => [$subfolder2]\n" ) ;
                $mysync->{ subfolder2 } = $subfolder2 ;
                set_regextrans2_for_subfolder2( $mysync ) ;
        }
        else
        {
                $mysync->{ subfolder2 } = undef ;
        }

        return ;
}

sub tests_sanitize_subfolder
{
        note( 'Entering tests_sanitize_subfolder()' ) ;

        is( undef, sanitize_subfolder(  ),  'sanitize_subfolder: no args => undef' ) ;
        is( undef, sanitize_subfolder( '' ),  'sanitize_subfolder: empty => undef' ) ;
        is( undef, sanitize_subfolder( ' ' ),  'sanitize_subfolder: blank => undef' ) ;
        is( undef, sanitize_subfolder( '  ' ),  'sanitize_subfolder: blanks => undef' ) ;
        is( 'abcd', sanitize_subfolder( 'abcd' ),  'sanitize_subfolder: abcd => abcd' ) ;
        is( 'ab cd', sanitize_subfolder( ' ab cd ' ),  'sanitize_subfolder: " ab cd " => "ab cd"' ) ;
        is( 'abcd', sanitize_subfolder( q{a&~b#\\c[]=d;} ),  'sanitize_subfolder: "a&~b#\\c[]=d;" => "abcd"' ) ;
        is( 'aA.b-_ 8c/dD', sanitize_subfolder( 'aA.b-_ 8c/dD' ),  'sanitize_subfolder: aA.b-_ 8c/dD => aA.b-_ 8c/dD' ) ;
        note( 'Leaving  tests_sanitize_subfolder()' ) ;
        return ;
}


sub sanitize_subfolder
{
        my $subfolder = shift ;

        if ( ! $subfolder )
        {
                return ;
        }
        # Remove edging blanks
        $subfolder =~ s,^ +| +$,,g ;
        # Keep only abcd...ABCD...0123... and -_./
        $subfolder =~ tr,-_a-zA-Z0-9./ ,,cd ;

        # A blank subfolder is not a subfolder
        if ( ! $subfolder )
        {
                return ;
        }
        else
        {
                return $subfolder ;
        }
}





sub tests_add_subfolder1_to_folderrec
{
        note( 'Entering tests_add_subfolder1_to_folderrec()' ) ;

        is( undef, add_subfolder1_to_folderrec(  ),  'add_subfolder1_to_folderrec: undef => undef' ) ;
        is_deeply( [], [ add_subfolder1_to_folderrec(  ) ], 'add_subfolder1_to_folderrec: no args => empty array' ) ;
        @folderrec = () ;
        my $mysync = {} ;
        is_deeply( [  ], [ add_subfolder1_to_folderrec( $mysync ) ], 'add_subfolder1_to_folderrec: empty => empty array' ) ;
        is_deeply( [  ], [ @folderrec ], 'add_subfolder1_to_folderrec: empty => empty folderrec' ) ;
        $mysync->{ subfolder1 } = 'SUBI' ;
        $h1_folders_all{ 'SUBI' } = 1 ;
        $mysync->{ h1_prefix } = 'INBOX/' ;
        is_deeply( [ 'SUBI' ], [ add_subfolder1_to_folderrec( $mysync ) ], 'add_subfolder1_to_folderrec: SUBI => SUBI' ) ;
        is_deeply( [ 'SUBI' ], [ @folderrec ], 'add_subfolder1_to_folderrec: SUBI => folderrec SUBI ' ) ;

        @folderrec = () ;
        $mysync->{ subfolder1 } = 'SUBO' ;
        is_deeply( [  ], [ add_subfolder1_to_folderrec( $mysync ) ], 'add_subfolder1_to_folderrec: SUBO no exists => empty array' ) ;
        is_deeply( [  ], [ @folderrec ], 'add_subfolder1_to_folderrec: SUBO no exists => empty folderrec' ) ;
        $h1_folders_all{ 'INBOX/SUBO' } = 1 ;
        is_deeply( [ 'INBOX/SUBO' ], [ add_subfolder1_to_folderrec( $mysync ) ], 'add_subfolder1_to_folderrec: SUBO + INBOX/SUBO exists => INBOX/SUBO' ) ;
        is_deeply( [ 'INBOX/SUBO' ], [ @folderrec ], 'add_subfolder1_to_folderrec: SUBO + INBOX/SUBO exists => INBOX/SUBO folderrec' ) ;

        note( 'Leaving  tests_add_subfolder1_to_folderrec()' ) ;
        return ;
}


sub add_subfolder1_to_folderrec
{
        my $mysync = shift ;
        if ( ! $mysync || ! $mysync->{ subfolder1 } )
        {
                return ;
        }

        my $subfolder1 = $mysync->{ subfolder1 } ;
        my $subfolder1_extended = $mysync->{ h1_prefix } . $subfolder1 ;

        if ( exists  $h1_folders_all{ $subfolder1 }  )
        {
                myprint( qq{Acting like --folderrec "$subfolder1"\n} ) ;
                push @folderrec, $subfolder1 ;
        }
        elsif ( exists  $h1_folders_all{ $subfolder1_extended } )
        {
                myprint( qq{Acting like --folderrec "$subfolder1_extended"\n} ) ;
                push @folderrec, $subfolder1_extended ;
        }
        else
        {
                myprint( qq{Nor folder "$subfolder1" nor "$subfolder1_extended" exists on host1\n} ) ;
        }
        return @folderrec ;
}

sub set_regextrans2_for_subfolder2
{
        my $mysync = shift ;


        unshift @{ $mysync->{ regextrans2 } },
                q(s,^$mysync->{ h2_prefix }(.*),$mysync->{ h2_prefix }$mysync->{ subfolder2 }$mysync->{ h2_sep }$1,),
                q(s,^INBOX$,$mysync->{ h2_prefix }$mysync->{ subfolder2 }$mysync->{ h2_sep }INBOX,),
                q(s,^($mysync->{ h2_prefix }){2},$mysync->{ h2_prefix },);

        #myprint( "@{ $mysync->{ regextrans2 } }\n" ) ;
        return ;
}



# Looks like no globals here

sub tests_imap2_folder_name
{
        note( 'Entering tests_imap2_folder_name()' ) ;

        my $mysync = {} ;
        $mysync->{ h1_prefix } = q{} ;
        $mysync->{ h2_prefix } = q{} ;
        $mysync->{ h1_sep } = '/';
        $mysync->{ h2_sep } = '.';

        $mysync->{ debug } and myprint( <<"EOS"
prefix1: [$mysync->{ h1_prefix }]
prefix2: [$mysync->{ h2_prefix }]
sep1:    [$sync->{ h1_sep }]
sep2:    [$sync->{ h2_sep }]
EOS
) ;

        $mysync->{ fixslash2 } = 0 ;
        is( q{INBOX}, imap2_folder_name( $mysync, q{} ), 'imap2_folder_name: empty string' ) ;
        is( 'blabla', imap2_folder_name( $mysync, 'blabla' ), 'imap2_folder_name: blabla' ) ;
        is('spam.spam', imap2_folder_name( $mysync, 'spam/spam' ), 'imap2_folder_name: spam/spam' ) ;

        is( 'spam/spam', imap2_folder_name( $mysync, 'spam.spam' ), 'imap2_folder_name: spam.spam') ;
        is( 'spam.spam/spam', imap2_folder_name( $mysync, 'spam/spam.spam' ), 'imap2_folder_name: spam/spam.spam' ) ;
        is( 's pam.spam/sp  am', imap2_folder_name( $mysync, 's pam/spam.sp  am' ), 'imap2_folder_name: s pam/spam.sp  am' ) ;

        $mysync->{f1f2h}{ 'auto' } = 'moto' ;
        is( 'moto', imap2_folder_name( $mysync, 'auto' ), 'imap2_folder_name: auto' ) ;
        $mysync->{f1f2h}{ 'auto/auto' } = 'moto x 2' ;
        is( 'moto x 2', imap2_folder_name( $mysync, 'auto/auto' ), 'imap2_folder_name: auto/auto' ) ;

        @{ $mysync->{ regextrans2 } } = ( 's,/,X,g' ) ;
        is( q{INBOX}, imap2_folder_name( $mysync, q{} ), 'imap2_folder_name: empty string [s,/,X,g]' ) ;
        is( 'blabla', imap2_folder_name( $mysync, 'blabla' ), 'imap2_folder_name: blabla [s,/,X,g]' ) ;
        is('spam.spam', imap2_folder_name( $mysync, 'spam/spam'), 'imap2_folder_name: spam/spam [s,/,X,g]');
        is('spamXspam', imap2_folder_name( $mysync, 'spam.spam'), 'imap2_folder_name: spam.spam [s,/,X,g]');
        is('spam.spamXspam', imap2_folder_name( $mysync, 'spam/spam.spam'), 'imap2_folder_name: spam/spam.spam [s,/,X,g]');

        @{ $mysync->{ regextrans2 } } = ( 's, ,_,g' ) ;
        is('blabla', imap2_folder_name( $mysync, 'blabla'), 'imap2_folder_name: blabla [s, ,_,g]');
        is('bla_bla', imap2_folder_name( $mysync, 'bla bla'), 'imap2_folder_name: blabla [s, ,_,g]');

        @{ $mysync->{ regextrans2 } } = ( q{s,(.*),\U$1,} ) ;
        is( 'BLABLA', imap2_folder_name( $mysync, 'blabla' ), q{imap2_folder_name: blabla [s,\U(.*)\E,$1,]} ) ;

        $mysync->{ fixslash2 } = 1 ;
        @{ $mysync->{ regextrans2 } } = (  ) ;
        is(q{INBOX}, imap2_folder_name( $mysync, q{}), 'imap2_folder_name: empty string');
        is('blabla', imap2_folder_name( $mysync, 'blabla'), 'imap2_folder_name: blabla');
        is('spam.spam', imap2_folder_name( $mysync, 'spam/spam'), 'imap2_folder_name: spam/spam -> spam.spam');
        is('spam_spam', imap2_folder_name( $mysync, 'spam.spam'), 'imap2_folder_name: spam.spam -> spam_spam');
        is('spam.spam_spam', imap2_folder_name( $mysync, 'spam/spam.spam'), 'imap2_folder_name: spam/spam.spam -> spam.spam_spam');
        is('s pam.spam_spa  m', imap2_folder_name( $mysync, 's pam/spam.spa  m'), 'imap2_folder_name: s pam/spam.spa m -> s pam.spam_spa  m');

        $mysync->{ h1_sep } = '.';
        $mysync->{ h2_sep } = '/';
        is( q{INBOX}, imap2_folder_name( $mysync, q{}), 'imap2_folder_name: empty string');
        is('blabla', imap2_folder_name( $mysync, 'blabla'), 'imap2_folder_name: blabla');
        is('spam.spam', imap2_folder_name( $mysync, 'spam/spam'), 'imap2_folder_name: spam/spam -> spam.spam');
        is('spam/spam', imap2_folder_name( $mysync, 'spam.spam'), 'imap2_folder_name: spam.spam -> spam/spam');
        is('spam.spam/spam', imap2_folder_name( $mysync, 'spam/spam.spam'), 'imap2_folder_name: spam/spam.spam -> spam.spam/spam');



        $mysync->{ fixslash2 } = 0 ;
        $mysync->{ h1_prefix } = q{ };

        is( 'spam.spam/spam', imap2_folder_name( $mysync, 'spam/spam.spam' ), 'imap2_folder_name: spam/spam.spam -> spam.spam/spam' ) ;
        is( 'spam.spam/spam', imap2_folder_name( $mysync, ' spam/spam.spam' ), 'imap2_folder_name:  spam/spam.spam -> spam.spam/spam' ) ;

        $mysync->{ h1_sep } = '.' ;
        $mysync->{ h2_sep } = '/' ;
        $mysync->{ h1_prefix } = 'INBOX.' ;
        $mysync->{ h2_prefix } = q{} ;
        @{ $mysync->{ regextrans2 } } = ( q{s,(.*),\U$1,} ) ;
        is( 'BLABLA', imap2_folder_name( $mysync, 'blabla' ), 'imap2_folder_name: blabla' ) ;
        is( 'TEST/TEST/TEST/TEST', imap2_folder_name( $mysync, 'INBOX.TEST.test.Test.tesT' ), 'imap2_folder_name: INBOX.TEST.test.Test.tesT' ) ;
        @{ $mysync->{ regextrans2 } } = ( q{s,(.*),\L$1,} ) ;
        is( 'test/test/test/test', imap2_folder_name( $mysync, 'INBOX.TEST.test.Test.tesT' ), 'imap2_folder_name: INBOX.TEST.test.Test.tesT' ) ;

        # INBOX
        $mysync = {} ;
        $mysync->{ h1_prefix } = q{Pf1.} ;
        $mysync->{ h2_prefix } = q{Pf2/} ;
        $mysync->{ h1_sep } = '.';
        $mysync->{ h2_sep } = '/';

        #
        #$mysync->{ debug } = 1 ;
        is( 'Pf2/F1/F2/F3', imap2_folder_name( $mysync, 'F1.F2.F3' ), 'imap2_folder_name: F1.F2.F3 -> Pf2/F1/F2/F3' ) ;
        is( 'Pf2/F1/INBOX', imap2_folder_name( $mysync, 'F1.INBOX' ), 'imap2_folder_name: F1.INBOX -> Pf2/F1/INBOX' ) ;
        is( 'INBOX', imap2_folder_name( $mysync, 'INBOX' ), 'imap2_folder_name: INBOX -> INBOX' ) ;

        is( 'Pf2/F1/F2/F3', imap2_folder_name( $mysync, 'Pf1.F1.F2.F3' ), 'imap2_folder_name: Pf1.F1.F2.F3 -> Pf2/F1/F2/F3' ) ;
        is( 'Pf2/F1/INBOX', imap2_folder_name( $mysync, 'Pf1.F1.INBOX' ), 'imap2_folder_name: Pf1.F1.INBOX -> Pf2/F1/INBOX' ) ;
        is( 'INBOX', imap2_folder_name( $mysync, 'Pf1.INBOX' ), 'imap2_folder_name: Pf1.INBOX -> INBOX' ) ; # not Pf2/INBOX: Yes I can!



        # subfolder2
        $mysync = {} ;
        $mysync->{ h1_prefix } = q{} ;
        $mysync->{ h2_prefix } = q{} ;
        $mysync->{ h1_sep } = '/';
        $mysync->{ h2_sep } = '.';


        set_regextrans2_for_subfolder2( $mysync ) ;
        $mysync->{ subfolder2 } = 'S1.S2' ;
        is( 'S1.S2.F1.F2.F3', imap2_folder_name( $mysync, 'F1/F2/F3' ), 'imap2_folder_name: F1/F2/F3 -> S1.S2.F1.F2.F3' ) ;
        is( 'S1.S2.INBOX', imap2_folder_name( $mysync, 'INBOX' ), 'imap2_folder_name: F1/F2/F3 -> S1.S2.INBOX' ) ;

        $mysync = {} ;
        $mysync->{ h1_prefix } = q{Pf1/} ;
        $mysync->{ h2_prefix } = q{Pf2.} ;
        $mysync->{ h1_sep } = '/';
        $mysync->{ h2_sep } = '.';
        #$mysync->{ debug } = 1 ;

        set_regextrans2_for_subfolder2( $mysync ) ;
        $mysync->{ subfolder2 } = 'Pf2.S1.S2' ;
        is( 'Pf2.S1.S2.F1.F2.F3', imap2_folder_name( $mysync, 'F1/F2/F3' ),     'imap2_folder_name: F1/F2/F3 -> Pf2.S1.S2.F1.F2.F3' ) ;
        is( 'Pf2.S1.S2.INBOX',    imap2_folder_name( $mysync, 'INBOX' ),        'imap2_folder_name: INBOX -> Pf2.S1.S2.INBOX' ) ;
        is( 'Pf2.S1.S2.F1.F2.F3', imap2_folder_name( $mysync, 'Pf1/F1/F2/F3' ), 'imap2_folder_name: F1/F2/F3 -> Pf2.S1.S2.F1.F2.F3' ) ;
        is( 'Pf2.S1.S2.INBOX',    imap2_folder_name( $mysync, 'Pf1/INBOX' ),    'imap2_folder_name: INBOX -> Pf2.S1.S2.INBOX' ) ;

        # subfolder1
        # scenario as the reverse of the previous tests, separators point of vue
        $mysync = {} ;
        $mysync->{ h1_prefix } = q{Pf1.} ;
        $mysync->{ h2_prefix } = q{Pf2/} ;
        $mysync->{ h1_sep } = '.';
        $mysync->{ h2_sep } = '/';
        #$mysync->{ debug } = 1 ;

        $mysync->{ subfolder1 } = 'S1.S2' ;
        is( 'Pf2/F1/F2/F3', imap2_folder_name( $mysync, 'S1.S2.F1.F2.F3' ), 'imap2_folder_name: S1.S2.F1.F2.F3 -> Pf2/F1/F2/F3' ) ;
        is( 'Pf2/F1/F2/F3', imap2_folder_name( $mysync, 'Pf1.S1.S2.F1.F2.F3' ), 'imap2_folder_name: Pf1.S1.S2.F1.F2.F3 -> Pf2/F1/F2/F3' ) ;

        is( 'INBOX', imap2_folder_name( $mysync, 'S1.S2.INBOX' ), 'imap2_folder_name: S1.S2.INBOX -> INBOX' ) ;
        is( 'INBOX', imap2_folder_name( $mysync, 'S1.S2' ),  'imap2_folder_name: S1.S2 -> INBOX' ) ;
        is( 'INBOX', imap2_folder_name( $mysync, 'S1.S2.' ), 'imap2_folder_name: S1.S2. -> INBOX' ) ;

        is( 'INBOX', imap2_folder_name( $mysync, 'Pf1.S1.S2.INBOX' ), 'imap2_folder_name: Pf1.S1.S2.INBOX -> INBOX' ) ;
        is( 'INBOX', imap2_folder_name( $mysync, 'Pf1.S1.S2' ),  'imap2_folder_name: Pf1.S1.S2 -> INBOX' ) ;
        is( 'INBOX', imap2_folder_name( $mysync, 'Pf1.S1.S2.' ), 'imap2_folder_name: Pf1.S1.S2. -> INBOX' ) ;


        $mysync->{ subfolder1 } = 'S1.S2.' ;
        is( 'Pf2/F1/F2/F3', imap2_folder_name( $mysync, 'S1.S2.F1.F2.F3' ), 'imap2_folder_name: S1.S2.F1.F2.F3 -> Pf2/F1/F2/F3' ) ;
        is( 'Pf2/F1/F2/F3', imap2_folder_name( $mysync, 'Pf1.S1.S2.F1.F2.F3' ), 'imap2_folder_name: Pf1.S1.S2.F1.F2.F3 -> Pf2/F1/F2/F3' ) ;

        is( 'INBOX', imap2_folder_name( $mysync, 'S1.S2.INBOX' ), 'imap2_folder_name: S1.S2.INBOX -> INBOX' ) ;
        is( 'INBOX', imap2_folder_name( $mysync, 'S1.S2' ),  'imap2_folder_name: S1.S2 -> INBOX' ) ;
        is( 'INBOX', imap2_folder_name( $mysync, 'S1.S2.' ), 'imap2_folder_name: S1.S2. -> INBOX' ) ;

        is( 'INBOX', imap2_folder_name( $mysync, 'Pf1.S1.S2.INBOX' ), 'imap2_folder_name: Pf1.S1.S2.INBOX -> INBOX' ) ;
        is( 'INBOX', imap2_folder_name( $mysync, 'Pf1.S1.S2' ),  'imap2_folder_name: Pf1.S1.S2 -> INBOX' ) ;
        is( 'INBOX', imap2_folder_name( $mysync, 'Pf1.S1.S2.' ), 'imap2_folder_name: Pf1.S1.S2. -> INBOX' ) ;


        # subfolder1
        # scenario as Gmail
        $mysync = {} ;
        $mysync->{ h1_prefix } = q{} ;
        $mysync->{ h2_prefix } = q{} ;
        $mysync->{ h1_sep } = '/';
        $mysync->{ h2_sep } = '/';
        #$mysync->{ debug } = 1 ;

        $mysync->{ subfolder1 } = 'S1/S2' ;
        is( 'F1/F2/F3', imap2_folder_name( $mysync, 'S1/S2/F1/F2/F3' ), 'imap2_folder_name: S1/S2/F1/F2/F3 -> F1/F2/F3' ) ;
        is( 'INBOX', imap2_folder_name( $mysync, 'S1/S2/INBOX' ), 'imap2_folder_name: S1/S2/INBOX -> INBOX' ) ;
        is( 'INBOX', imap2_folder_name( $mysync, 'S1/S2' ),  'imap2_folder_name: S1/S2 -> INBOX' ) ;
        is( 'INBOX', imap2_folder_name( $mysync, 'S1/S2/' ), 'imap2_folder_name: S1/S2/ -> INBOX' ) ;

        $mysync->{ subfolder1 } = 'S1/S2/' ;
        is( 'F1/F2/F3', imap2_folder_name( $mysync, 'S1/S2/F1/F2/F3' ), 'imap2_folder_name: S1/S2/F1/F2/F3 -> F1/F2/F3' ) ;
        is( 'INBOX', imap2_folder_name( $mysync, 'S1/S2/INBOX' ), 'imap2_folder_name: S1/S2/INBOX -> INBOX' ) ;
        is( 'INBOX', imap2_folder_name( $mysync, 'S1/S2' ),  'imap2_folder_name: S1/S2 -> INBOX' ) ;
        is( 'INBOX', imap2_folder_name( $mysync, 'S1/S2/' ), 'imap2_folder_name: S1/S2/ -> INBOX' ) ;


        note( 'Leaving  tests_imap2_folder_name()' ) ;
        return ;
}


# Global variables to remove:
#


sub imap2_folder_name
{
        my $mysync = shift ;
        my ( $h1_fold ) = shift ;
        my ( $h2_fold ) ;
        if ( $mysync->{f1f2h}{ $h1_fold } ) {
                $h2_fold = $mysync->{f1f2h}{ $h1_fold } ;
                ( $mysync->{ debug } or $mysync->{debugfolders} ) and myprint( "f1f2 [$h1_fold] -> [$h2_fold]\n"  ) ;
                return( $h2_fold ) ;
        }
        if ( $mysync->{f1f2auto}{ $h1_fold } ) {
                $h2_fold = $mysync->{f1f2auto}{ $h1_fold } ;
                ( $mysync->{ debug } or $mysync->{debugfolders} ) and myprint( "automap [$h1_fold] -> [$h2_fold]\n"  ) ;
                return( $h2_fold ) ;
        }

        if ( $mysync->{ subfolder1 } )
        {
                my $esc_h1_sep = "\\" . $mysync->{ h1_sep } ;
                # case where subfolder1 has the sep1 at the end, then remove it
                my $part_to_removed = remove_last_char_if_is( $mysync->{ subfolder1 }, $mysync->{ h1_sep } ) ;
                # remove the subfolder1 part and the sep1 if present after
                $h1_fold =~ s{$part_to_removed($esc_h1_sep)?}{} ;
                #myprint( "h1_fold=$h1_fold\n" ) ;
        }

        if ( ( '' eq $h1_fold ) or ( $mysync->{ h1_prefix } eq $h1_fold ) )
        {
                $h1_fold = 'INBOX' ;
        }

        $h2_fold = prefix_seperator_invertion( $mysync, $h1_fold ) ;
        $h2_fold = regextrans2( $mysync, $h2_fold ) ;
        return( $h2_fold ) ;
}


sub tests_remove_last_char_if_is
{
        note( 'Entering tests_remove_last_char_if_is()' ) ;

        is( undef, remove_last_char_if_is(  ),  'remove_last_char_if_is: no args => undef' ) ;
        is( '', remove_last_char_if_is( '' ),  'remove_last_char_if_is: empty => empty' ) ;
        is( '', remove_last_char_if_is( '', 'Z' ),  'remove_last_char_if_is: empty Z => empty' ) ;
        is( '', remove_last_char_if_is( 'Z', 'Z' ),  'remove_last_char_if_is: Z Z => empty' ) ;
        is( 'abc', remove_last_char_if_is( 'abcZ', 'Z' ),  'remove_last_char_if_is: abcZ Z => abc' ) ;
        is( 'abcY', remove_last_char_if_is( 'abcY', 'Z' ),  'remove_last_char_if_is: abcY Z => abcY' ) ;
        note( 'Leaving  tests_remove_last_char_if_is()' ) ;
        return ;
}




sub remove_last_char_if_is
{
        my $string = shift ;
        my $char   = shift ;

        if ( ! defined $string )
        {
                return ;
        }

        if ( ! defined $char )
        {
                return $string ;
        }

        my $last_char = substr $string, -1 ;
        if ( $char eq $last_char )
        {
                chop $string ;
                return $string ;
        }
        else
        {
                return $string ;
        }
}

sub tests_prefix_seperator_invertion
{
        note( 'Entering tests_prefix_seperator_invertion()' ) ;

        is( undef, prefix_seperator_invertion(  ),                     'prefix_seperator_invertion: no args => undef' ) ;
        is( q{}, prefix_seperator_invertion( undef, q{} ),             'prefix_seperator_invertion: empty string => empty string' ) ;
        is( 'lalala', prefix_seperator_invertion( undef, 'lalala' ),   'prefix_seperator_invertion: lalala => lalala' ) ;
        is( 'lal/ala', prefix_seperator_invertion( undef, 'lal/ala' ), 'prefix_seperator_invertion: lal/ala => lal/ala' ) ;
        is( 'lal.ala', prefix_seperator_invertion( undef, 'lal.ala' ), 'prefix_seperator_invertion: lal.ala => lal.ala' ) ;
        is( '////', prefix_seperator_invertion( undef, '////' ),       'prefix_seperator_invertion: //// => ////' ) ;
        is( '.....', prefix_seperator_invertion( undef, '.....' ),     'prefix_seperator_invertion: ..... => .....' ) ;

        my $mysync  = {
                h1_prefix => '',
                h2_prefix => '',
                h1_sep    => '/',
                h2_sep    => '/',
        } ;

        is( q{}, prefix_seperator_invertion( $mysync, q{} ),             'prefix_seperator_invertion: $mysync empty string => empty string' ) ;
        is( 'lalala', prefix_seperator_invertion( $mysync, 'lalala' ),   'prefix_seperator_invertion: $mysync lalala => lalala' ) ;
        is( 'lal/ala', prefix_seperator_invertion( $mysync, 'lal/ala' ), 'prefix_seperator_invertion: $mysync lal/ala => lal/ala' ) ;
        is( 'lal.ala', prefix_seperator_invertion( $mysync, 'lal.ala' ), 'prefix_seperator_invertion: $mysync lal.ala => lal.ala' ) ;
        is( '////', prefix_seperator_invertion( $mysync, '////' ),       'prefix_seperator_invertion: $mysync //// => ////' ) ;
        is( '.....', prefix_seperator_invertion( $mysync, '.....' ),     'prefix_seperator_invertion: $mysync ..... => .....' ) ;

        $mysync  = {
                h1_prefix => 'PPP',
                h2_prefix => 'QQQ',
                h1_sep    => 's',
                h2_sep    => 't',
        } ;

        is( q{QQQ}, prefix_seperator_invertion( $mysync, q{} ),           'prefix_seperator_invertion: PPPQQQst empty string => QQQ' ) ;
        is( 'QQQlalala', prefix_seperator_invertion( $mysync, 'lalala' ), 'prefix_seperator_invertion: PPPQQQst lalala => QQQlalala' ) ;
        is( 'QQQlal/ala', prefix_seperator_invertion( $mysync, 'lal/ala' ),  'prefix_seperator_invertion: PPPQQQst lal/ala => QQQlal/ala' ) ;
        is( 'QQQlal.ala', prefix_seperator_invertion( $mysync, 'lal.ala' ),  'prefix_seperator_invertion: PPPQQQst lal.ala => QQQlal.ala' ) ;
        is( 'QQQ////', prefix_seperator_invertion( $mysync, '////' ),        'prefix_seperator_invertion: PPPQQQst //// => QQQ////' ) ;
        is( 'QQQ.....', prefix_seperator_invertion( $mysync, '.....' ),      'prefix_seperator_invertion: PPPQQQst ..... => QQQ.....' ) ;

        is( 'QQQPlalala', prefix_seperator_invertion( $mysync, 'PPPPlalala' ),   'prefix_seperator_invertion: PPPQQQst PPPPlalala => QQQPlalala' ) ;
        is( 'QQQ', prefix_seperator_invertion( $mysync, 'PPP' ),                 'prefix_seperator_invertion: PPPQQQst PPP => QQQ' ) ;
        is( 'QQQttt', prefix_seperator_invertion( $mysync, 'sss' ),              'prefix_seperator_invertion: PPPQQQst sss => QQQttt' ) ;
        is( 'QQQt', prefix_seperator_invertion( $mysync, 's' ),                  'prefix_seperator_invertion: PPPQQQst s => QQQt' ) ;
        is( 'QQQtAAAtBBB', prefix_seperator_invertion( $mysync, 'PPPsAAAsBBB' ), 'prefix_seperator_invertion: PPPQQQst PPPsAAAsBBB => QQQtAAAtBBB' ) ;

        note( 'Leaving  tests_prefix_seperator_invertion()' ) ;
        return ;
}

# Global variables to remove:


sub prefix_seperator_invertion
{
        my $mysync  = shift ;
        my $h1_fold = shift ;
        my $h2_fold ;

        if ( not defined $h1_fold ) { return ; }

        my $my_h1_prefix =  $mysync->{ h1_prefix } || q{} ;
        my $my_h2_prefix =  $mysync->{ h2_prefix } || q{} ;
        my $my_h1_sep    = $mysync->{ h1_sep } || '/' ;
        my $my_h2_sep    = $mysync->{ h2_sep } || '/' ;

        # first we remove the prefix
        $h1_fold =~ s/^\Q$my_h1_prefix\E//x ;
        ( $mysync->{ debug } or $mysync->{debugfolders} ) and myprint( "removed host1 prefix: [$h1_fold]\n"  ) ;
        $h2_fold = separator_invert( $mysync, $h1_fold, $my_h1_sep, $my_h2_sep ) ;
        ( $mysync->{ debug } or $mysync->{debugfolders} ) and myprint( "inverted separators: [$h2_fold]\n"  ) ;

        # Adding the prefix supplied by namespace or the --prefix2 option
        # except for INBOX or Inbox
        if ( $h2_fold !~ m/^INBOX$/xi )
        {
                $h2_fold = $my_h2_prefix . $h2_fold ;
        }

        ( $mysync->{ debug } or $mysync->{debugfolders} ) and myprint( "added host2 prefix: [$h2_fold]\n"  ) ;
        return( $h2_fold ) ;
}

sub tests_separator_invert
{
	note( 'Entering tests_separator_invert()' ) ;

        my $mysync = {} ;
        $mysync->{ fixslash2 } = 0 ;
        ok( not( defined separator_invert(  )  ), 'separator_invert: no args' ) ;
        ok( not( defined separator_invert( q{} ) ), 'separator_invert: not enough args' ) ;
        ok( not( defined separator_invert( q{}, q{} ) ), 'separator_invert: not enough args' ) ;

        ok( q{} eq separator_invert( $mysync, q{}, q{}, q{} ), 'separator_invert: 3 empty strings' ) ;
        ok( 'lalala' eq separator_invert( $mysync, 'lalala', q{}, q{} ), 'separator_invert: empty separator' ) ;
        ok( 'lalala' eq separator_invert( $mysync, 'lalala', '/', '/' ), 'separator_invert: same separator /' ) ;
        ok( 'lal/ala' eq separator_invert( $mysync, 'lal/ala', '/', '/' ), 'separator_invert: same separator / 2' ) ;
        ok( 'lal.ala' eq separator_invert( $mysync, 'lal/ala', '/', '.' ), 'separator_invert: separators /.' ) ;
        ok( 'lal/ala' eq separator_invert( $mysync, 'lal.ala', '.', '/' ), 'separator_invert: separators ./' ) ;
        ok( 'la.l/ala' eq separator_invert( $mysync, 'la/l.ala', '.', '/' ), 'separator_invert: separators ./' ) ;

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

	note( 'Leaving  tests_separator_invert()' ) ;
        return ;
}

# Global variables to remove:
#
sub separator_invert
{
        my( $mysync, $h1_fold, $h1_separator, $h2_separator ) = @_ ;

        return( undef ) if ( not all_defined( $mysync, $h1_fold, $h1_separator, $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( $mysync->{ fixslash2 } and '/' ne $h2_separator and '/' eq $h1_separator ) ;
        return( $h2_fold ) ;
}


sub regextrans2
{
        my( $mysync, $h2_fold ) = @_ ;
        # Transforming the folder name by the --regextrans2 option(s)
        foreach my $regextrans2 ( @{ $mysync->{ regextrans2 } } ) {
                my $h2_fold_before = $h2_fold ;
                my $ret = eval "\$h2_fold =~ $regextrans2 ; 1 " ;
                ( $mysync->{ debug } or $mysync->{debugfolders} ) and myprint( "[$h2_fold_before] -> [$h2_fold] using regextrans2 [$regextrans2]\n"  ) ;
                if ( not ( defined  $ret  ) or $EVAL_ERROR ) {
                        exit_clean( $mysync, $EX_USAGE, "error: eval regextrans2 '$regextrans2': $EVAL_ERROR\n" ) ;
                }
        }
        return( $h2_fold ) ;
}


sub tests_decompose_regex
{
	note( 'Entering tests_decompose_regex()' ) ;

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

	note( 'Leaving  tests_decompose_regex()' ) ;
        return ;
}

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

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


sub foldersizes
{

        my ( $side, $imap, $search_cmd, $abletosearch, @folders ) = @_ ;
        my $total_size = 0 ;
        my $total_nb = 0 ;
        my $biggest_in_all = 0 ;

        my $nb_folders = scalar  @folders  ;
        my $ct_folders = 0 ; # folder counter.
        myprint( "++++ Calculating sizes of $nb_folders folders on $side\n"  ) ;
        foreach my $folder ( @folders )     {
                my $stot = 0 ;
                my $nb_msgs = 0 ;
                $ct_folders++ ;
                myprintf( "$side folder %7s %-35s", "$ct_folders/$nb_folders", jux_utf8( $folder ) ) ;
                if ( 'Host2' eq $side and not exists  $h2_folders_all_UPPER{ uc  $folder  }  ) {
                        myprint( " does not exist yet\n") ;
                        next ;
                }
                if ( 'Host1' eq $side and not exists  $h1_folders_all{ $folder }  ) {
                        myprint( " does not exist\n" ) ;
                        next ;
                }

                last if $imap->IsUnconnected(  ) ;
                # FTGate is RFC buggy with EXAMINE it does not act as SELECT
                #unless ( $imap->examine( $folder ) ) {
                unless ( $imap->select( $folder ) ) {
                        my $error = join q{},
                                "$side Folder $folder: Could not select: ",
                                $imap->LastError,  "\n"  ;
                        errors_incr( $sync, $error ) ;
                        next ;
                }
                last if $imap->IsUnconnected(  ) ;

                my $hash_ref = { } ;
                my @msgs = select_msgs( $imap, undef, $search_cmd, $abletosearch, $folder ) ;
                $nb_msgs = scalar  @msgs  ;
                my $biggest_in_folder = 0 ;
                @{ $hash_ref }{ @msgs } = ( undef ) if @msgs ;

                last if $imap->IsUnconnected(  ) ;
                if ( $nb_msgs > 0 and @msgs ) {
                        if ( $abletosearch ) {
                                if ( ! $imap->fetch_hash( \@msgs, 'RFC822.SIZE', $hash_ref) ) {
                                        my $error = "$side failure with fetch_hash: $EVAL_ERROR\n" ;
                                        errors_incr( $sync, $error ) ;
                                        return ;
                                }
                        }else{
                                my $uidnext = $imap->uidnext( $folder ) || $uidnext_default ;
                                my $fetch_hash_uids = $fetch_hash_set || "1:$uidnext" ;
                                if ( ! $imap->fetch_hash( $fetch_hash_uids, 'RFC822.SIZE', $hash_ref ) ) {
                                        my $error = "$side failure with fetch_hash: $EVAL_ERROR\n" ;
                                        errors_incr( $sync, $error ) ;
                                        return ;
                                }
                        }
                        for ( keys %{ $hash_ref } ) {
                                my $size =  $hash_ref->{ $_ }->{ 'RFC822.SIZE' } ;
                                $stot    += $size ;
                                $biggest_in_folder =  max( $biggest_in_folder, $size ) ;
                        }
                }

                myprintf( ' Size: %9s', $stot ) ;
                myprintf( ' Messages: %5s', $nb_msgs ) ;
                myprintf( " Biggest: %9s\n", $biggest_in_folder ) ;
                $total_size += $stot ;
                $total_nb += $nb_msgs ;
                $biggest_in_all =  max( $biggest_in_all, $biggest_in_folder ) ;
        }
        myprintf( "%s Nb folders:      %11s folders\n",    $side, $nb_folders ) ;
        myprintf( "%s Nb messages:     %11s messages\n",   $side, $total_nb ) ;
        myprintf( "%s Total size:      %11s bytes (%s)\n", $side, $total_size, bytes_display_string( $total_size ) ) ;
        myprintf( "%s Biggest message: %11s bytes (%s)\n", $side, $biggest_in_all, bytes_display_string( $biggest_in_all ) ) ;
        myprintf( "%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 || 0 ;
        my ( $timenow, $timediff ) ;
        $timenow    = time ;
        $timediff   = $timenow - $timeinit ;
	# Often used in a division so no 0
        return( max( 1, $timediff) ) ;
}




sub tests_flags_regex
{
	note( 'Entering tests_flags_regex()' ) ;

        ok( q{} eq flags_regex(q{} ), 'flags_regex, null string q{}' ) ;
        ok( q{\Seen NonJunk $Spam} eq flags_regex( q{\Seen NonJunk $Spam} ), q{flags_regex, nothing to do} ) ;

        @regexflag = ('I am BAD' ) ;
        ok( not ( defined flags_regex( q{} ) ), 'flags_regex, bad regex' ) ;

        @regexflag = ( 's/NonJunk//g' ) ;
        ok( q{\Seen  $Spam} eq flags_regex( q{\Seen NonJunk $Spam} ), q{flags_regex, remove NonJunk: 's/NonJunk//g'} ) ;
        @regexflag = ( q{s/\$Spam//g} ) ;
        ok( q{\Seen NonJunk } eq flags_regex( q{\Seen NonJunk $Spam} ), q{flags_regex, remove $Spam: 's/\$Spam//g'} ) ;

        @regexflag = ( 's/\\\\Seen//g' ) ;

        ok( q{ NonJunk $Spam} eq flags_regex( q{\Seen NonJunk $Spam} ), q{flags_regex, remove \Seen: 's/\\\\\\\\Seen//g'} ) ;

        @regexflag = ( 's/(\s|^)[^\\\\]\w+//g' ) ;
        ok( q{\Seen \Middle \End}   eq flags_regex( q{\Seen NonJunk \Middle $Spam \End} ), q{flags_regex: only \word among \Seen NonJunk \Middle $Spam \End} ) ;
        ok( q{ \Seen \Middle \End1} eq flags_regex( q{Begin \Seen NonJunk \Middle $Spam \End1 End} ),
                     q{flags_regex: only \word among Begin \Seen NonJunk \Middle $Spam \End1 End} ) ;

        @regexflag = ( q{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( '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 = ( q{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' ) ;


        @regexflag = ( q{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'), q{Add jrdH8u 's/(.*)/\$1 jrdH8u/'} ) ;
        @regexflag = ('s/jrdH8u *//');
        ok('REM  REM  REM REM REM ' eq flags_regex('REM  REM  REM REM REM jrdH8u'), q{Remove jrdH8u s/jrdH8u *//} ) ;

        @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( q{} eq flags_regex( q{} ), 'Keep only regex: Exchange case, null string (Phil)' ) ;

        ok( q{}
        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)' ) ;

        @regexflag = ( 's/\\\\Flagged//g' ) ;

        is('\Deleted \Answered \Draft  ',
        flags_regex('\\Deleted \\Answered \\Draft \\Flagged '),
        'flags_regex: remove \Flagged 1' ) ;
        is('\\Deleted  \\Answered \\Draft',
        flags_regex('\\Deleted \\Flagged \\Answered \\Draft'),
        'flags_regex: remove \Flagged 2' ) ;

        # I didn't understand why it gives \F
        # https://perldoc.perl.org/perlrebackslash.html
        # \F                Foldcase till \E.  Not in [].
        # https://perldoc.perl.org/functions/fc.html

        # \F Not available in old Perl so I comment the test

        # @regexflag = ( 's/\\Flagged/X/g' ) ;
        #is('\Deleted FX \Answered \FX \Draft \FX',
        #flags_regex( '\Deleted Flagged \Answered \Flagged \Draft \Flagged' ),
        # 'flags_regex: remove \Flagged 3 mistery...' ) ;

	note( 'Leaving  tests_flags_regex()' ) ;
        return ;
}

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

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


sub tests_permanentflags
{
	note( 'Entering tests_permanentflags()' ) ;

        my $string;
        ok(q{} 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(q{} eq permanentflags('Blabla'), 'permanentflags nothing');

	note( 'Leaving  tests_permanentflags()' ) ;
        return ;
}

sub permanentflags
{
        my @lines = @_ ;

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

sub tests_flags_filter
{
	note( 'Entering tests_flags_filter()' ) ;

        ok( '\Seen' eq flags_filter('\Seen', '\Draft \Seen \Answered'), 'flags_filter ' );
        ok( q{} 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 ' );

	note( 'Leaving  tests_flags_filter()' ) ;
	return ;
}

sub flags_filter
{
        my( $flags, $allowed_flags ) = @_ ;

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

        my $flags_out = join q{ }, @flags_out ;

        return( $flags_out ) ;
}

sub flagscase
{
        my $flags = shift ;

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

        my $flags_out = join q{ }, @flags_out ;

        return( $flags_out ) ;
}

sub tests_flagscase
{
	note( 'Entering 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' ) ;

	note( 'Leaving  tests_flagscase()' ) ;
        return ;
}



sub ucsecond
{
        my $string = shift ;
        my $output ;

        return( $string )  if ( 1 >= length $string ) ;

        $output = ( substr( $string, 0, 1) ) . ( uc substr $string, 1, 1 ) . ( substr $string, 2 ) ;
        #myprint( "UUU $string -> $output\n"  ) ;
        return( $output ) ;
}


sub tests_ucsecond
{
	note( 'Entering 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' ) ;

	note( 'Leaving  tests_ucsecond()' ) ;
        return ;
}


sub select_msgs
{
        my ( $imap, $msgs_all_hash_ref, $search_cmd, $abletosearch, $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 ) ;
        }
        return(  @msgs ) ;

}

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 myprint( "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 myprint( "Calling fetch_hash()\n"  ) ;
        my $uidnext = $imap->uidnext( $folder ) || $uidnext_default ;
        my $fetch_hash_uids = $fetch_hash_set || "1:$uidnext" ;
        %fetch = %{$imap->fetch_hash( $fetch_hash_uids, 'INTERNALDATE' ) } ;

        @msgs_all = sort { $a <=> $b } keys  %fetch  ;
        $debugdev and myprint( "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  ) {
                myprint( "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 - $NB_SECONDS_IN_A_DAY * $maxage ; }
        if ( defined  $minage  ) { $minage_epoch = $timestart_int - $NB_SECONDS_IN_A_DAY * $minage ; }
        foreach my $msg ( @msgs_all ) {
                my $idate = $fetch{ $msg }->{'INTERNALDATE'} ;
                #myprint( "$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 - $NB_SECONDS_IN_A_DAY * $maxage ) ;
        }
        if ( defined  $minage  ) {
                @min = $imap->sentbefore( $timestart_int - $NB_SECONDS_IN_A_DAY * $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
{
	note( 'Entering tests_msgs_from_maxmin()' ) ;

        my @msgs ;
        $maxage = $NUMBER_200 ;
        @msgs = msgs_from_maxmin( [ '1', '2' ], [ '2', '3' ] ) ;
        ok( 0 == compare_lists( [ '1', '2' ], \@msgs ), 'msgs_from_maxmin: maxage++' ) ;
        $minage = $NUMBER_100 ;
        @msgs = msgs_from_maxmin( [ '1', '2' ], [ '2', '3' ] ) ;
        ok( 0 == compare_lists( [ '2' ], \@msgs ), 'msgs_from_maxmin:  -maxage++minage-' ) ;
        $minage = $NUMBER_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-' ) ;

	note( 'Leaving  tests_msgs_from_maxmin()' ) ;
        return ;
}

sub tests_info_date_from_uid
{
        note( 'Entering tests_info_date_from_uid()' ) ;
        note( 'Leaving  tests_info_date_from_uid()' ) ;

        return ;
}

sub info_date_from_uid
{

        #my $first_uid   = $msgs_all[ 0 ] ;
        #my $first_idate = $fetch{ $first_uid }->{'INTERNALDATE'} ;
        #my $first_epoch = epoch( $first_idate ) ;
        #my $first_days  = ( $timestart_int - $first_epoch ) / $NB_SECONDS_IN_A_DAY ;
        #myprint( "\nOldest msg has UID $first_uid INTERNALDATE $first_idate EPOCH $first_epoch DAYS AGO $first_days\n" ) ;
}


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(  ) ;
        #myprint( "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 $sync->{ maxsize } and $h1_size > $sync->{ maxsize } ) {
                myprint( "msg $h1_fold/$h1_msg skipped ($h1_size exceeds maxsize limit $sync->{ maxsize } bytes)\n" ) ;
                $sync->{ total_bytes_skipped } += $h1_size;
                $sync->{ nb_msg_skipped } += 1;
                return( 1 ) ;
        }
        if ( defined $minsize and $h1_size <= $minsize ) {
                myprint( "msg $h1_fold/$h1_msg skipped ($h1_size smaller than minsize $minsize bytes)\n" ) ;
                $sync->{ total_bytes_skipped } += $h1_size;
                $sync->{ 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" ) ;
        #myprint( "$search ? $msg\n"  ) ;
        return( 1 ) if ( $search_uid eq $msg ) ;
        return( 0 ) ;
}


# Globals
# $sync->{ total_bytes_skipped }
# $sync->{ nb_msg_skipped }
# $mysync->{ h1_nb_msg_processed }
sub stats_update_skip_message
{
        my $mysync  = shift ; # to be used
        my $h1_size = shift ;

        $mysync->{ total_bytes_skipped } += $h1_size ;
        $mysync->{ nb_msg_skipped } += 1 ;
        $mysync->{ h1_nb_msg_processed } +=1 ;
        return ;
}

sub copy_message
{
        # copy

        my ( $mysync, $h1_msg, $h1_fold, $h2_fold, $h1_fir_ref, $permanentflags2, $cache_dir ) = @_ ;
        ( $mysync->{ debug } or $mysync->{dry}) and myprint( "msg $h1_fold/$h1_msg copying to $h2_fold $mysync->{dry_message}\n" ) ;

        my $h1_size  = $h1_fir_ref->{$h1_msg}->{'RFC822.SIZE'}  || 0 ;
        my $h1_flags = $h1_fir_ref->{$h1_msg}->{'FLAGS'}        || q{} ;
        my $h1_idate = $h1_fir_ref->{$h1_msg}->{'INTERNALDATE'} || q{} ;


        if ( size_filtered( $h1_size, $h1_msg, $h1_fold, $h2_fold  ) ) {
                $mysync->{ h1_nb_msg_processed } +=1 ;
                return ;
        }

        debugsleep( $mysync ) ;
        myprint( "- 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( $mysync->{imap1}, $h1_msg ) ) {
                stats_update_skip_message( $mysync, $h1_size ) ;
                return ;
        }
        myprint( debugmemory( $mysync, " at C1" ) ) ;

        my ( $string, $string_len ) ;
        ( $string_len ) = message_for_host2( $mysync, $h1_msg, $h1_fold, $h1_size, $h1_flags, $h1_idate, $h1_fir_ref, \$string ) ;

        myprint( debugmemory( $mysync, " at C2" ) ) ;

        # not defined or empty $string
        if ( ( not $string ) or ( not $string_len ) ) {
                myprint( "- msg $h1_fold/$h1_msg skipped.\n"  ) ;
                stats_update_skip_message( $mysync, $h1_size ) ;
                return ;
        }

        # Lines too long (or not enough) => do no copy or fix
        if ( ( defined $maxlinelength ) or ( defined $minmaxlinelength ) ) {
                $string = linelengthstuff( $string, $h1_fold, $h1_msg, $string_len, $h1_size, $h1_flags, $h1_idate ) ;
                if ( not defined  $string  ) {
                        stats_update_skip_message( $mysync, $h1_size ) ;
                        return ;
                }
        }

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

        ( $mysync->{ debug } or $debugflags ) and
        myprint( "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 ) ;

        ( $mysync->{ debug } or $debugflags ) and
        myprint( "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 q{} ) ;

        my $new_id = append_message_on_host2( $mysync, \$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( $mysync, $h1_fold, $h1_msg, $h1_flags, $h2_fold, $new_id, $permanentflags2 ) ;
        }

        myprint( debugmemory( $mysync, " at C3" ) ) ;

        return $new_id ;
}



sub linelengthstuff
{
        my( $string, $h1_fold, $h1_msg, $string_len, $h1_size, $h1_flags, $h1_idate  ) = @_ ;
        my $maxlinelength_string = max_line_length( $string ) ;
        $debugmaxlinelength and myprint( "msg $h1_fold/$h1_msg maxlinelength: $maxlinelength_string\n"  ) ;

        if ( ( defined $minmaxlinelength )  and ( $maxlinelength_string <= $minmaxlinelength ) ) {
                my $subject = subject( $string ) ;
                $debugdev and myprint( "- 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" ) ;
                return ;
        }

        if ( ( defined $maxlinelength )  and ( $maxlinelength_string > $maxlinelength ) ) {
                my $subject = subject( $string ) ;
                if ( $maxlinelengthcmd ) {
                        $string = pipemess( $string, $maxlinelengthcmd ) ;
                        # string undef means something was bad.
                        if ( not ( defined  $string  ) ) {
                                myprint( "- msg $h1_fold/$h1_msg {$string_len} S[$h1_size] F[$h1_flags] I[$h1_idate] "
                                      . "(Subject:[$subject]) could not be successfully transformed by --maxlinelengthcmd option\n" ) ;
                                return ;
                        }else{
                                return $string ;
                        }
                }
                myprint( "- msg $h1_fold/$h1_msg skipped S[$h1_size] F[$h1_flags] I[$h1_idate] "
                      . "(Subject:[$subject]) (line length exceeds maxlinelength $maxlinelength bytes)\n" ) ;
                return ;
        }
        return $string ;
}


sub message_for_host2
{

# global variable list:
# @skipmess
# @regexmess
# @pipemess
# $debugcontent
# $debug
#
# API current
#
# at failure:
#   * return nothing ( will then be undef or () )
#   * $string_ref content is undef or empty
# at success:
#   * return string length ($string_ref content length)
#   * $string_ref content filled with message

# API future
#
#
        my ( $mysync, $h1_msg, $h1_fold, $h1_size, $h1_flags, $h1_idate, $h1_fir_ref, $string_ref ) = @_ ;

        # abort when missing a parameter
        if ( ( ! $mysync ) or  ( ! $h1_msg ) or ( ! $h1_fold ) or ( ! defined $h1_size )
             or ( ! defined $h1_flags) or ( ! defined $h1_idate )
             or ( ! $h1_fir_ref) or ( ! $string_ref ) )
        {
                return ;
        }

        myprint( debugmemory( $mysync, " at M1" ) ) ;


        my $string_ok = $mysync->{imap1}->message_to_file( $string_ref, $h1_msg ) ;

        myprint( debugmemory( $mysync, " at M2" ) ) ;

        my $string_len = length_ref( $string_ref  ) ;


        unless ( defined  $string_ok  and $string_len ) {
                # undef or 0 length
                my $error = join q{},
                        "- msg $h1_fold/$h1_msg {$string_len} S[$h1_size] F[$h1_flags] I[$h1_idate] could not be fetched: ",
                        $mysync->{imap1}->LastError || q{}, "\n"  ;
                errors_incr( $mysync, $error ) ;
                $mysync->{ h1_nb_msg_processed } +=1 ;
                return ;
        }

        if ( @skipmess ) {
                my $match = skipmess( ${ $string_ref } ) ;
                # string undef means the eval regex was bad.
                if ( not ( defined  $match  ) ) {
                        myprint(
                        "- msg $h1_fold/$h1_msg {$string_len} S[$h1_size] F[$h1_flags] I[$h1_idate]"
                        . " could not be skipped by --skipmess option, bad regex\n" ) ;
                        return ;
                }
                if ( $match ) {
                        my $subject = subject( ${ $string_ref } ) ;
                        myprint( "- msg $h1_fold/$h1_msg {$string_len} S[$h1_size] F[$h1_flags] I[$h1_idate]"
                            . " (Subject:[$subject]) skipped by --skipmess\n" ) ;
                        return ;
                }
        }

        if ( @regexmess ) {
                ${ $string_ref } = regexmess( ${ $string_ref } ) ;
                # string undef means the eval regex was bad.
                if ( not ( defined  ${ $string_ref }  ) ) {
                        myprint(
                        "- msg $h1_fold/$h1_msg {$string_len} S[$h1_size] F[$h1_flags] I[$h1_idate]"
                        . " could not be transformed by --regexmess\n" ) ;
                        return ;
                }
        }

        if ( @pipemess ) {
                ${ $string_ref } = pipemess( ${ $string_ref }, @pipemess ) ;
                # string undef means something was bad.
                if ( not ( defined  ${ $string_ref }  ) ) {
                        myprint(
                        "- msg $h1_fold/$h1_msg {$string_len} S[$h1_size] F[$h1_flags] I[$h1_idate]"
                        . " could not be successfully transformed by --pipemess option\n" ) ;
                        return ;
                }
        }

        if ( $mysync->{addheader} and defined $h1_fir_ref->{$h1_msg}->{'NO_HEADER'} ) {
                my $header = add_header( $h1_msg ) ;
                $mysync->{ debug } and myprint( "msg $h1_fold/$h1_msg adding custom header [$header]\n"  ) ;
                ${ $string_ref } = $header . "\r\n" . ${ $string_ref } ;
        }
        
        if ( ( defined $mysync->{ truncmess } ) and is_an_integer( $mysync->{ truncmess } ) )
        {
                ${ $string_ref } = truncmess( ${ $string_ref }, $mysync->{ truncmess } ) ;
        }

        $string_len = length_ref( $string_ref  ) ;

        $debugcontent and myprint(
                q{=} x $STD_CHAR_PER_LINE, "\n",
                "F message content begin next line ($string_len characters long)\n",
                ${ $string_ref },
                "\nF message content ended on previous line\n", q{=} x $STD_CHAR_PER_LINE, "\n" ) ;

        myprint( debugmemory( $mysync, " at M3" ) ) ;

        return $string_len ;
}

sub tests_truncmess
{
        note( 'Entering tests_truncmess()' ) ;

        is( undef, truncmess(  ),  'truncmess: no args => undef' ) ;
        is( 'abc', truncmess( 'abc' ),  'truncmess: abc => abc' ) ;
        is( 'ab', truncmess( 'abc', 2 ),  'truncmess: abc 2 => ab' ) ;
        is( 'abc', truncmess( 'abc', 3 ),  'truncmess: abc 3 => abc' ) ;
        is( 'abc', truncmess( 'abc', 4 ),  'truncmess: abc 4 => abc' ) ;
        is( '12345', truncmess( "123456789\n", 5 ),  'truncmess: "123456789\n", 5 => 12345' ) ;
        is( "123456789\n" x 5000, truncmess( "123456789\n" x 100000, 50000 ),  'truncmess: "123456789\n" x 100000, 50000 => "123456789\n" x 5000' ) ;
        note( 'Leaving  tests_truncmess()' ) ;
        return ;
}

sub truncmess
{
        my $string = shift ;
        my $length = shift ;
        
        if ( not defined $string ) { return ; }
        if ( not defined $length ) { return $string ; }
        
        $string = substr $string, 0,  $length ;
        return $string ;
}

sub tests_message_for_host2
{
	note( 'Entering tests_message_for_host2()' ) ;


        my ( $mysync, $h1_msg, $h1_fold, $h1_size, $h1_flags, $h1_idate, $h1_fir_ref, $string_ref ) ;

        is( undef, message_for_host2(  ), q{message_for_host2: no args} ) ;
        is( undef, message_for_host2( $mysync, $h1_msg, $h1_fold, $h1_size, $h1_flags, $h1_idate, $h1_fir_ref, $string_ref ), q{message_for_host2: undef args} ) ;

        require_ok( "Test::MockObject" ) ;
        my $imapT = Test::MockObject->new(  ) ;
        $mysync->{imap1} = $imapT ;
        my $string ;

        $h1_msg = 1 ;
        $h1_fold = 'FoldFoo';
        $h1_size =  9 ;
        $h1_flags = '' ;
        $h1_idate = '10-Jul-2015 09:00:00 +0200' ;
        $h1_fir_ref = {} ;
        $string_ref = \$string ;
        $imapT->mock( 'message_to_file',
                sub {
                        my ( $imap, $mystring_ref, $msg ) = @_ ;
                        ${$mystring_ref} = 'blablabla' ;
                        return length ${$mystring_ref} ;
                }
        ) ;
        is( 9, message_for_host2( $mysync, $h1_msg, $h1_fold, $h1_size, $h1_flags, $h1_idate, $h1_fir_ref, $string_ref ),
        q{message_for_host2: msg 1 == "blablabla", length} ) ;
        is( 'blablabla', $string, q{message_for_host2: msg 1 == "blablabla", value} ) ;

        # so far so good
        # now the --pipemess stuff

        SKIP: {
                Readonly my $NB_WIN_tests_message_for_host2 => 0 ;
                skip( 'Not on MSWin32', $NB_WIN_tests_message_for_host2 ) if ('MSWin32' ne $OSNAME) ;
                # Windows
                # "type" command does not accept redirection of STDIN with <
                # "sort" does

        } ;

        SKIP: {
                Readonly my $NB_UNX_tests_message_for_host2 => 6 ;
                skip( 'Not on Unix', $NB_UNX_tests_message_for_host2 ) if ('MSWin32' eq $OSNAME) ;
                # Unix

                # no change by cat
                @pipemess = ( 'cat' ) ;
                is( 9, message_for_host2( $mysync, $h1_msg, $h1_fold, $h1_size, $h1_flags, $h1_idate, $h1_fir_ref, $string_ref ),
                q{message_for_host2: --pipemess 'cat', length} ) ;
                is( 'blablabla', $string, q{message_for_host2: --pipemess 'cat', value} ) ;


                # failure by false
                @pipemess = ( 'false' ) ;
                is( undef, message_for_host2( $mysync, $h1_msg, $h1_fold, $h1_size, $h1_flags, $h1_idate, $h1_fir_ref, $string_ref ),
                q{message_for_host2: --pipemess 'false', length} ) ;
                is( undef, $string, q{message_for_host2: --pipemess 'false', value} ) ;

                # failure by true since no output
                @pipemess = ( 'true' ) ;
                is( undef, message_for_host2( $mysync, $h1_msg, $h1_fold, $h1_size, $h1_flags, $h1_idate, $h1_fir_ref, $string_ref ),
                q{message_for_host2: --pipemess 'true', length} ) ;
                is( undef, $string, q{message_for_host2: --pipemess 'true', value} ) ;
        }

	note( 'Leaving  tests_message_for_host2()' ) ;
        return ;
}

sub tests_labels_remove_subfolder1
{
        note( 'Entering tests_labels_remove_subfolder1()' ) ;
        is( undef, labels_remove_subfolder1(  ), 'labels_remove_subfolder1: no parameters => undef' ) ;
        is( 'Blabla', labels_remove_subfolder1( 'Blabla' ), 'labels_remove_subfolder1: one parameter Blabla => Blabla' ) ;
        is( 'Blan blue', labels_remove_subfolder1( 'Blan blue' ), 'labels_remove_subfolder1: one parameter Blan blue => Blan blue' ) ;
        is( '\Bla "Blan blan" Blabla', labels_remove_subfolder1( '\Bla "Blan blan" Blabla' ),
                'labels_remove_subfolder1: one parameter \Bla "Blan blan" Blabla => \Bla "Blan blan" Blabla' ) ;

        is( 'Bla', labels_remove_subfolder1( 'Subf/Bla', 'Subf' ), 'labels_remove_subfolder1: Subf/Bla Subf => "Bla"' ) ;


        is( '"\\\\Bla"', labels_remove_subfolder1( '"\\\\Bla"', 'Subf' ), 'labels_remove_subfolder1: "\\\\Bla" Subf => "\\\\Bla"' ) ;

        is( 'Bla Kii', labels_remove_subfolder1( 'Subf/Bla Subf/Kii', 'Subf' ),
                'labels_remove_subfolder1: Subf/Bla Subf/Kii, Subf => "Bla" "Kii"' ) ;

        is( '"\\\\Bla" Kii', labels_remove_subfolder1( '"\\\\Bla" Subf/Kii', 'Subf' ),
                'labels_remove_subfolder1: "\\\\Bla" Subf/Kii Subf => "\\\\Bla" Kii' ) ;

        is( '"Blan blan"', labels_remove_subfolder1( '"Subf/Blan blan"', 'Subf' ),
                'labels_remove_subfolder1: "Subf/Blan blan" Subf => "Blan blan"' ) ;

        is( '"\\\\Loo" "Blan blan" Kii', labels_remove_subfolder1( '"\\\\Loo" "Subf/Blan blan" Subf/Kii', 'Subf' ),
                'labels_remove_subfolder1: "\\\\Loo" "Subf/Blan blan" Subf/Kii + Subf => "\\\\Loo" "Blan blan" Kii' ) ;

        is( '"\\\\Inbox"', labels_remove_subfolder1( 'Subf/INBOX', 'Subf' ),
                'labels_remove_subfolder1: Subf/INBOX + Subf => "\\\\Inbox"' ) ;

        is( '"\\\\Loo" "Blan blan" Kii "\\\\Inbox"', labels_remove_subfolder1( '"\\\\Loo" "Subf/Blan blan" Subf/Kii Subf/INBOX', 'Subf' ),
                'labels_remove_subfolder1: "\\\\Loo" "Subf/Blan blan" Subf/Kii Subf/INBOX + Subf => "\\\\Loo" "Blan blan" Kii "\\\\Inbox"' ) ;


        note( 'Leaving  tests_labels_remove_subfolder1()' ) ;
        return ;
}



sub labels_remove_subfolder1
{
        my $labels = shift ;
        my $subfolder1 = shift ;

        if ( not defined $labels ) { return ; }
        if ( not defined $subfolder1  ) { return $labels ; }

        my @labels = quotewords('\s+', 1, $labels ) ;
        #myprint( "@labels\n" ) ;
        my @labels_subfolder2 ;

        foreach my $label ( @labels )
        {
                if ( $label =~ m{zzzzzzzzzz} )
                {
                        # \Seen \Deleted ... stay the same
                        push @labels_subfolder2, $label ;
                }
                else
                {
                        # Remove surrounding quotes if any, to add them again in case of space
                        $label = join( '', quotewords('\s+', 0, $label ) ) ;
                        $label =~ s{$subfolder1/?}{} ;
                        if ( 'INBOX' eq $label )
                        {
                                push @labels_subfolder2, q{"\\\\Inbox"} ;
                        }
                        elsif ( $label =~ m{\\} )
                        {
                                push @labels_subfolder2, qq{"\\$label"} ;
                        }
                        elsif ( $label =~ m{ } )
                        {
                                push @labels_subfolder2, qq{"$label"} ;
                        }
                        else
                        {
                                push @labels_subfolder2, $label ;
                        }
                }
        }

        my $labels_subfolder2 = join( ' ', sort uniq( @labels_subfolder2 ) ) ;

        return $labels_subfolder2 ;
}

sub tests_labels_remove_special
{
        note( 'Entering tests_labels_remove_special()' ) ;

        is( undef, labels_remove_special(  ), 'labels_remove_special: no parameters => undef' ) ;
        is( '', labels_remove_special( '' ), 'labels_remove_special: empty string => empty string' ) ;
        is( '', labels_remove_special( '"\\\\Inbox"' ), 'labels_remove_special:"\\\\Inbox" => empty string' ) ;
        is( '', labels_remove_special( '"\\\\Inbox" "\\\\Starred"' ), 'labels_remove_special:"\\\\Inbox" "\\\\Starred" => empty string' ) ;
        is( 'Bar Foo', labels_remove_special( 'Foo Bar' ), 'labels_remove_special:Foo Bar => Bar Foo' ) ;
        is( 'Bar Foo', labels_remove_special( 'Foo Bar "\\\\Inbox"' ), 'labels_remove_special:Foo Bar "\\\\Inbox" => Bar Foo' ) ;
        note( 'Leaving  tests_labels_remove_special()' ) ;
        return ;
}




sub labels_remove_special
{
        my $labels = shift ;

        if ( not defined $labels ) { return ; }

        my @labels = quotewords('\s+', 1, $labels ) ;
        myprint( "labels before remove_non_folded: @labels\n" ) ;
        my @labels_remove_special ;

        foreach my $label ( @labels )
        {
                if ( $label =~ m{^\"\\\\} )
                {
                        # not kept
                }
                else
                {
                        push @labels_remove_special, $label ;
                }
        }

        my $labels_remove_special = join( ' ', sort @labels_remove_special ) ;

        return $labels_remove_special ;
}


sub tests_labels_add_subfolder2
{
        note( 'Entering tests_labels_add_subfolder2()' ) ;
        is( undef, labels_add_subfolder2(  ), 'labels_add_subfolder2: no parameters => undef' ) ;
        is( 'Blabla', labels_add_subfolder2( 'Blabla' ), 'labels_add_subfolder2: one parameter Blabla => Blabla' ) ;
        is( 'Blan blue', labels_add_subfolder2( 'Blan blue' ), 'labels_add_subfolder2: one parameter Blan blue => Blan blue' ) ;
        is( '\Bla "Blan blan" Blabla', labels_add_subfolder2( '\Bla "Blan blan" Blabla' ),
                'labels_add_subfolder2: one parameter \Bla "Blan blan" Blabla => \Bla "Blan blan" Blabla' ) ;

        is( 'Subf/Bla', labels_add_subfolder2( 'Bla', 'Subf' ), 'labels_add_subfolder2: Bla Subf => "Subf/Bla"' ) ;


        is( 'Subf/\Bla', labels_add_subfolder2( '\\\\Bla', 'Subf' ), 'labels_add_subfolder2: \Bla Subf => \Bla' ) ;

        is( 'Subf/Bla Subf/Kii', labels_add_subfolder2( 'Bla Kii', 'Subf' ),
                'labels_add_subfolder2: Bla Kii Subf => "Subf/Bla" "Subf/Kii"' ) ;

        is( 'Subf/Kii Subf/\Bla', labels_add_subfolder2( '\\\\Bla Kii', 'Subf' ),
                'labels_add_subfolder2: \Bla Kii Subf => \Bla Subf/Kii' ) ;

        is( '"Subf/Blan blan"', labels_add_subfolder2( '"Blan blan"', 'Subf' ),
                'labels_add_subfolder2: "Blan blan" Subf => "Subf/Blan blan"' ) ;

        is( '"Subf/Blan blan" Subf/Kii Subf/\Loo', labels_add_subfolder2( '\\\\Loo "Blan blan" Kii', 'Subf' ),
                'labels_add_subfolder2: \Loo "Blan blan" Kii + Subf => "Subf/Blan blan" Subf/Kii Subf/\Loo' ) ;

        # "\\Inbox" is special, add to subfolder INBOX also because Gmail will but ...
        is( '"Subf/\\\\Inbox" Subf/INBOX', labels_add_subfolder2( '"\\\\Inbox"', 'Subf' ),
                'labels_add_subfolder2: "\\\\Inbox" Subf => "Subf/\\\\Inbox" Subf/INBOX' ) ;

        # but not with INBOX folder
        is( '"Subf/\\\\Inbox"', labels_add_subfolder2( '"\\\\Inbox"', 'Subf', 'INBOX' ),
                'labels_add_subfolder2: "\\\\Inbox" Subf INBOX => "Subf/\\\\Inbox"' ) ;

        # two times => one time
        is( '"Subf/\\\\Inbox" Subf/INBOX', labels_add_subfolder2( '"\\\\Inbox" "\\\\Inbox"', 'Subf' ),
                'labels_add_subfolder2: "\\\\Inbox" "\\\\Inbox" Subf => "Subf/\\\\Inbox"' ) ;

        is( '"Subf/\\\\Starred"', labels_add_subfolder2( '"\\\\Starred"', 'Subf' ),
                'labels_add_subfolder2: "\\\\Starred" Subf => "Subf/\\\\Starred"' ) ;

        note( 'Leaving  tests_labels_add_subfolder2()' ) ;
        return ;
}

sub labels_add_subfolder2
{
        my $labels = shift ;
        my $subfolder2 = shift ;
        my $h1_folder = shift || q{} ;

        if ( not defined $labels ) { return ; }
        if ( not defined $subfolder2  ) { return $labels ; }

        # Isn't it messy?
        if ( 'INBOX' eq $h1_folder )
        {
                $labels .= ' "\\\\Inbox"' ;
        }

        my @labels = uniq( quotewords('\s+', 1, $labels ) ) ;
        myprint( "labels before subfolder2: @labels\n" ) ;
        my @labels_subfolder2 ;


        foreach my $label ( @labels )
        {
                # Isn't it more messy?
                if ( ( q{"\\\\Inbox"} eq $label ) and ( 'INBOX' ne $h1_folder ) )
                {
                        if ( $subfolder2 =~ m{ } )
                        {
                                push @labels_subfolder2, qq{"$subfolder2/INBOX"} ;
                        }
                        else
                        {
                                push @labels_subfolder2, "$subfolder2/INBOX" ;
                        }
                }
                if ( $label =~ m{^\"\\\\} )
                {
                        # \Seen \Deleted ... stay the same
                        #push @labels_subfolder2, $label ;
                        # Remove surrounding quotes if any, to add them again
                        $label = join( '', quotewords('\s+', 0, $label ) ) ;
                        push @labels_subfolder2, qq{"$subfolder2/\\$label"} ;

                }
                else
                {
                        # Remove surrounding quotes if any, to add them again in case of space
                        $label = join( '', quotewords('\s+', 0, $label ) ) ;
                        if ( $label =~ m{ } )
                        {
                                push @labels_subfolder2, qq{"$subfolder2/$label"} ;
                        }
                        else
                        {
                                push @labels_subfolder2, "$subfolder2/$label" ;
                        }
                }
        }

        my $labels_subfolder2 = join( ' ', sort @labels_subfolder2 ) ;

        return $labels_subfolder2 ;
}

sub tests_labels
{
        note( 'Entering tests_labels()' ) ;

        is( undef, labels(  ),      'labels: no parameters => undef' ) ;
        is( undef, labels( undef ), 'labels: undef => undef' ) ;
        require_ok( "Test::MockObject" ) ;
        my $myimap = Test::MockObject->new(  ) ;

        $myimap->mock( 'fetch_hash',
                sub {
                        return(
                                { '1' => {
                                        'X-GM-LABELS' => '\Seen Blabla'
                                        }
                                }
                        ) ;
                }
        ) ;
        $myimap->mock( 'Debug'   , sub { } ) ;
        $myimap->mock( 'Unescape', sub { return Mail::IMAPClient::Unescape( @_ ) } ) ; # real one

        is( undef, labels( $myimap ), 'labels: one parameter => undef' ) ;
        is( '\Seen Blabla', labels( $myimap, '1' ), 'labels: $mysync UID_1 => \Seen Blabla' ) ;

        note( 'Leaving  tests_labels()' ) ;
        return ;
}

sub labels
{
        my ( $myimap, $uid ) = @ARG ;

        if ( not all_defined( $myimap, $uid ) ) {
                return ;
        }

        my $hash = $myimap->fetch_hash( [ $uid ], 'X-GM-LABELS' ) ;

        my $labels = $hash->{ $uid }->{ 'X-GM-LABELS' } ;
        #$labels = $myimap->Unescape( $labels ) ;
        return $labels ;
}

sub tests_synclabels
{
        note( 'Entering tests_synclabels()' ) ;

        is( undef, synclabels(  ), 'synclabels: no parameters => undef' ) ;
        is( undef, synclabels( undef ), 'synclabels: undef => undef' ) ;
        my $mysync ;
        is( undef, synclabels( $mysync ), 'synclabels: var undef => undef' ) ;

        require_ok( "Test::MockObject" ) ;
        $mysync = {} ;

        my $myimap1 = Test::MockObject->new(  ) ;
        $myimap1->mock( 'fetch_hash',
                sub {
                        return(
                                { '1' => {
                                        'X-GM-LABELS' => '\Seen Blabla'
                                        }
                                }
                        ) ;
                }
        ) ;
        $myimap1->mock( 'Debug',    sub { } ) ;
        $myimap1->mock( 'Unescape', sub { return Mail::IMAPClient::Unescape( @_ ) } ) ; # real one

        my $myimap2 = Test::MockObject->new(  ) ;

        $myimap2->mock( 'store',
                sub {
                        return 1 ;
                }
        ) ;


        $mysync->{imap1} = $myimap1 ;
        $mysync->{imap2} = $myimap2 ;

        is( undef, synclabels( $mysync ), 'synclabels: fresh $mysync => undef' ) ;

        is( undef, synclabels( $mysync, '1' ),  'synclabels: $mysync UID_1 alone => undef' )  ;
        is( 1,     synclabels( $mysync, '1', '2' ), 'synclabels: $mysync UID_1 UID_2 => 1' ) ;

        note( 'Leaving  tests_synclabels()' ) ;
        return ;
}


sub synclabels
{
        my( $mysync, $uid1, $uid2 ) = @ARG ;

        if ( not all_defined( $mysync, $uid1, $uid2 ) ) {
                return ;
        }
        my $myimap1 = $mysync->{ 'imap1' } || return ;
        my $myimap2 = $mysync->{ 'imap2' } || return ;

        $mysync->{debuglabels} and $myimap1->Debug( 1 ) ;
        my $labels1 = labels( $myimap1, $uid1 ) ;
        $mysync->{debuglabels} and $myimap1->Debug( 0 ) ;
        $mysync->{debuglabels} and myprint( "Host1 labels: $labels1\n" ) ;



        if ( $mysync->{ subfolder1 } and $labels1 )
        {
                $labels1 = labels_remove_subfolder1( $labels1, $mysync->{ subfolder1 } ) ;
                $mysync->{debuglabels} and myprint( "Host1 labels with subfolder1: $labels1\n" ) ;
        }

        if ( $mysync->{ subfolder2 } and $labels1 )
        {
                $labels1 = labels_add_subfolder2( $labels1, $mysync->{ subfolder2 } ) ;
                $mysync->{debuglabels} and myprint( "Host1 labels with subfolder2: $labels1\n" ) ;
        }

        my $store ;
        if ( $labels1 and not $mysync->{ dry } )
        {
                $mysync->{ debuglabels } and $myimap2->Debug( 1 ) ;
                $store = $myimap2->store( $uid2, "X-GM-LABELS ($labels1)" ) ;
                $mysync->{ debuglabels } and $myimap2->Debug( 0 ) ;
        }
        return $store ;
}


sub tests_resynclabels
{
        note( 'Entering tests_resynclabels()' ) ;

        is( undef, resynclabels(  ), 'resynclabels: no parameters => undef' ) ;
        is( undef, resynclabels( undef ), 'resynclabels: undef => undef' ) ;
        my $mysync ;
        is( undef, resynclabels( $mysync ), 'resynclabels: var undef => undef' ) ;

        my ( $h1_fir_ref, $h2_fir_ref ) ;

        $mysync->{ debuglabels } = 1 ;
        $h1_fir_ref->{ 11 }->{ 'X-GM-LABELS' } = '\Seen Baa Kii' ;
        $h2_fir_ref->{ 22 }->{ 'X-GM-LABELS' } = '\Seen Baa Kii' ;

        # labels are equal
        is( 1,     resynclabels( $mysync, 11, 22, $h1_fir_ref, $h2_fir_ref ),
                'resynclabels: $mysync UID_1 UID_2 labels are equal => 1' ) ;

        # labels are different
        $h2_fir_ref->{ 22 }->{ 'X-GM-LABELS' } = '\Seen Zuu' ;
        require_ok( "Test::MockObject" ) ;
        my $myimap2 = Test::MockObject->new(  ) ;
        $myimap2->mock( 'store',
                sub {
                        return 1 ;
                }
        ) ;
        $myimap2->mock( 'Debug',    sub { } ) ;
        $mysync->{imap2} = $myimap2 ;

        is( 1,     resynclabels( $mysync, 11, 22, $h1_fir_ref, $h2_fir_ref ),
                'resynclabels: $mysync UID_1 UID_2 labels are not equal => store => 1' ) ;

        note( 'Leaving  tests_resynclabels()' ) ;
        return ;
}



sub resynclabels
{
        my( $mysync, $uid1, $uid2, $h1_fir_ref, $h2_fir_ref, $h1_folder ) = @ARG ;

        if ( not all_defined( $mysync, $uid1, $uid2, $h1_fir_ref, $h2_fir_ref ) ) {
                return ;
        }

        my $labels1 = $h1_fir_ref->{ $uid1 }->{ 'X-GM-LABELS' } || q{} ;
        my $labels2 = $h2_fir_ref->{ $uid2 }->{ 'X-GM-LABELS' } || q{} ;

        if ( $mysync->{ subfolder1 } and $labels1 )
        {
                $labels1 = labels_remove_subfolder1( $labels1, $mysync->{ subfolder1 } ) ;
        }

        if ( $mysync->{ subfolder2 } and $labels1 )
        {
                $labels1 = labels_add_subfolder2( $labels1, $mysync->{ subfolder2 }, $h1_folder ) ;
                $labels2 = labels_remove_special( $labels2 ) ;
        }
        $mysync->{ debuglabels } and myprint( "Host1 labels fixed: $labels1\n" ) ;
        $mysync->{ debuglabels } and myprint( "Host2 labels      : $labels2\n" ) ;

        my $store ;
        if ( $labels1 eq $labels2 )
        {
                # no sync needed
                $mysync->{ debuglabels } and myprint( "Labels are already equal\n" ) ;
                return 1 ;
        }
        elsif ( not $mysync->{ dry } )
        {
                # sync needed
                $mysync->{debuglabels} and $mysync->{imap2}->Debug( 1 ) ;
                $store = $mysync->{imap2}->store( $uid2, "X-GM-LABELS ($labels1)" ) ;
                $mysync->{debuglabels} and $mysync->{imap2}->Debug( 0 ) ;
        }

        return $store ;
}

sub tests_uniq
{
        note( 'Entering tests_uniq()' ) ;

        is( 0, uniq(  ),  'uniq: undef => 0' ) ;
        is_deeply( [ 'one' ], [ uniq( 'one' ) ],  'uniq: one => one' ) ;
        is_deeply( [ 'one' ], [ uniq( 'one', 'one' ) ],  'uniq: one one => one' ) ;
        is_deeply( [ 'one', 'two' ], [ uniq( 'one', 'one', 'two', 'one', 'two' ) ],  'uniq: one one two one two => one two' ) ;
        note( 'Leaving  tests_uniq()' ) ;
        return ;
}

sub uniq
{
        my @list = @ARG ;
        my %seen = (  ) ;
        my @uniq = (  ) ;
        foreach my $item ( @list ) {
        if ( ! $seen{ $item } ) {
                $seen{ $item } = 1 ;
        push( @uniq, $item ) ;
                }
        }
        return @uniq ;
}


sub length_ref
{
        my $string_ref = shift ;
        my $string_len = defined  ${ $string_ref }  ? length( ${ $string_ref } ) : q{} ; # length or empty string
        return $string_len ;
}

sub tests_length_ref
{
	note( 'Entering tests_length_ref()' ) ;

        my $notdefined ;
        is( q{}, length_ref( \$notdefined ), q{length_ref: value not defined} ) ;
        my $notref ;
        is( q{}, length_ref( $notref ), q{length_ref: param not a ref} ) ;

        my $lala = 'lala' ;
        is( 4, length_ref( \$lala ), q{length_ref: lala length == 4} ) ;
        is( 4, length_ref( \'lili' ), q{length_ref: lili length == 4} ) ;

	note( 'Leaving  tests_length_ref()' ) ;
        return ;
}

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

        my $h1_date = q{} ;

        if ( $syncinternaldates ) {
                $h1_date = $h1_idate ;
                $sync->{ debug } and myprint( "internal date from host1: [$h1_date]\n"  ) ;
                $h1_date = good_date( $h1_date ) ;
                $sync->{ debug } and myprint( "internal date from host1: [$h1_date] (fixed)\n"  ) ;
        }

        if ( $idatefromheader ) {
                $h1_date = $sync->{imap1}->get_header( $h1_msg, 'Date' ) ;
                $sync->{ debug } and myprint( "header date from host1: [$h1_date]\n"  ) ;
                $h1_date = good_date( $h1_date ) ;
                $sync->{ debug } and myprint( "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 = q{} ;

        my $header = extract_header( $string ) ;

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

sub tests_subject
{
	note( 'Entering tests_subject()' ) ;

        ok( q{} eq subject( q{} ), '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( q{} eq subject( $MESS ), 'subject: null but body could') ;

	note( 'Leaving  tests_subject()' ) ;
        return ;
}


# GlobVar
# $max_msg_size_in_bytes
# $h2_uidguess
# ...
#
#
sub append_message_on_host2
{
        my( $mysync, $string_ref, $h1_fold, $h1_msg, $string_len, $h2_fold, $h1_size, $h1_flags, $h1_date, $cache_dir ) = @_ ;
        myprint( debugmemory( $mysync, " at A1" ) ) ;

        my $new_id ;
        if ( ! $mysync->{dry} ) {
                $max_msg_size_in_bytes = max( $string_len, $max_msg_size_in_bytes ) ;
                $new_id = $mysync->{imap2}->append_string( $h2_fold, ${ $string_ref }, $h1_flags, $h1_date ) ;
                myprint( debugmemory( $mysync, " at A2" ) ) ;
                if ( ! $new_id){
                        my $subject = subject( ${ $string_ref } ) ;
                        my $error_imap = $mysync->{imap2}->LastError || q{} ;
                        my $error = "- msg $h1_fold/$h1_msg {$string_len} could not append ( Subject:[$subject], Date:[$h1_date], Size:[$h1_size], Flags:[$h1_flags] ) to folder $h2_fold: $error_imap\n" ;
                        errors_incr( $mysync, $error ) ;
                        $mysync->{ 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( $mysync->{imap2}, $h2_fold, $h2_uidguess ) ;
                        }
                        if ( $mysync->{ synclabels } ) { synclabels( $mysync, $h1_msg, $new_id ) }
                        $h2_uidguess += 1 ;
                        $mysync->{total_bytes_transferred} += $string_len ;
                        $mysync->{nb_msg_transferred} += 1 ;
                        $mysync->{ h1_nb_msg_processed } +=1 ;

                        my $time_spent = timesince( $mysync->{begin_transfer_time} ) ;
                        my $rate = bytes_display_string( $mysync->{total_bytes_transferred} / $time_spent ) ;
                        my $eta = eta( $time_spent,
                                       $mysync->{ h1_nb_msg_processed }, $h1_nb_msg_start, $mysync->{nb_msg_transferred} ) ;
                        my $amount_transferred = bytes_display_string( $mysync->{total_bytes_transferred} ) ;
                        myprintf( "msg %s/%-19s copied to %s/%-10s %.2f msgs/s  %s/s %s copied %s\n",
                        $h1_fold, "$h1_msg {$string_len}", $h2_fold, $new_id, $mysync->{nb_msg_transferred}/$time_spent, $rate,
                        $amount_transferred,
                        $eta );
                        sleep_if_needed( $mysync ) ;
                        if ( $usecache and $cacheaftercopy and $new_id =~ m{^\d+$}x ) {
                                $debugcache and myprint( "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 ( $mysync->{ delete1 } ) {
                                delete_message_on_host1( $mysync, $h1_fold, $mysync->{ expungeaftereach }, $h1_msg ) ;
                        }
                        #myprint( "PRESS ENTER" ) and my $a = <> ;

                        return( $new_id ) ;
                }
        }
        else{
                $nb_msg_skipped_dry_mode += 1 ;
                $mysync->{ h1_nb_msg_processed } +=1 ;
        }

        return ;
}

sub tests_sleep_if_needed
{
	note( 'Entering tests_sleep_if_needed()' ) ;

	is( undef, sleep_if_needed(  ), 'sleep_if_needed: no args => undef' ) ;
	my $mysync ;
	is( undef, sleep_if_needed( $mysync ), 'sleep_if_needed: arg undef => undef' ) ;

	$mysync->{maxbytespersecond} = 1000 ;
	is( 0, sleep_if_needed( $mysync ), 'sleep_if_needed: maxbytespersecond only => no sleep => 0' ) ;
	$mysync->{begin_transfer_time} = time ; # now
	is( 0, sleep_if_needed( $mysync ), 'sleep_if_needed: begin_transfer_time now => no sleep => 0' ) ;
	$mysync->{begin_transfer_time} = time - 2 ; # 2 s before
	is( 0, sleep_if_needed( $mysync ), 'sleep_if_needed: total_bytes_transferred == 0 => no sleep => 0' ) ;

	$mysync->{total_bytes_transferred} = 2200 ;
	$mysync->{begin_transfer_time} = time - 2 ; # 2 s before
	is( '0.20', sleep_if_needed( $mysync ), 'sleep_if_needed: total_bytes_transferred == 2200 since 2s => sleep 0.2s' ) ;
	is( '0',  sleep_if_needed( $mysync ),   'sleep_if_needed: total_bytes_transferred == 2200 since 2+2 == 4s => no sleep' ) ;

	$mysync->{maxsleep} = 0.1 ;
	$mysync->{begin_transfer_time} = time - 2 ; # 2 s before again
	is( '0.10', sleep_if_needed( $mysync ), 'sleep_if_needed: total_bytes_transferred == 4000 since 2s but maxsleep 0.1s => sleep 0.1s' ) ;

	$mysync->{maxbytesafter} = 4000 ;
	$mysync->{begin_transfer_time} = time - 2 ; # 2 s before again
	is( 0, sleep_if_needed( $mysync ), 'sleep_if_needed: maxbytesafter == total_bytes_transferred => no sleep => 0' ) ;

	note( 'Leaving  tests_sleep_if_needed()' ) ;
	return ;
}


sub sleep_if_needed
{
        my( $mysync ) = shift ;

	if ( ! $mysync ) {
		return ;
	}
	# No need to go further if there is no limit set
	if (  not ( $mysync->{maxmessagespersecond}
		or $mysync->{maxbytespersecond} )
	) {
		return ;
	}

	$mysync->{maxsleep} = defined $mysync->{maxsleep} ? $mysync->{maxsleep} : $MAX_SLEEP ;
        # Must be positive
        $mysync->{maxsleep} = max( 0, $mysync->{maxsleep} ) ;

	my $time_spent = timesince( $mysync->{begin_transfer_time} ) ;
        my $sleep_max_messages = sleep_max_messages( $mysync->{nb_msg_transferred}, $time_spent, $mysync->{maxmessagespersecond} ) ;

	my $maxbytesafter = $mysync->{maxbytesafter} || 0 ;
	my $total_bytes_transferred = $mysync->{total_bytes_transferred} || 0 ;
	my $total_bytes_to_consider = $total_bytes_transferred - $maxbytesafter ;

	#myprint( "maxbytesafter:$maxbytesafter\n" ) ;
	#myprint( "total_bytes_to_consider:$total_bytes_to_consider\n" ) ;

        my $sleep_max_bytes = sleep_max_bytes( $total_bytes_to_consider, $time_spent, $mysync->{maxbytespersecond}  ) ;
        my $sleep_max = min( $mysync->{maxsleep}, max( $sleep_max_messages, $sleep_max_bytes ) ) ;
	$sleep_max = mysprintf( "%.2f", $sleep_max ) ; # round with 2 decimals.
        if ( $sleep_max > 0 ) {
                myprint( "sleeping $sleep_max s\n" ) ;
                sleep $sleep_max ;
		# Slept
		return $sleep_max ;
        }
	# No sleep
        return 0 ;
}

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
{
	note( 'Entering 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, $MINUS_ONE ), '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') ;

	note( 'Leaving  tests_sleep_max_messages()' ) ;
        return ;
}


sub sleep_max_bytes
{
        # how long we have to sleep to go under max_bytes_per_second
        my( $total_bytes_to_consider, $time_spent, $maxbytespersecond ) = @_ ;
	$total_bytes_to_consider ||= 0 ;
	$time_spent ||= 0 ;

        if ( ( not defined  $maxbytespersecond  ) or $maxbytespersecond <= 0 ) { return( 0 ) } ;
	#myprint( "total_bytes_to_consider:$total_bytes_to_consider\n" ) ;
        my $sleep = ( $total_bytes_to_consider / $maxbytespersecond ) - $time_spent ;
        # the sleep must be positive
        return( max( 0, $sleep ) ) ;
}


sub tests_sleep_max_bytes
{
	note( 'Entering tests_sleep_max_bytes()' ) ;

        ok( 0 == sleep_max_bytes( 4000, 2, undef ),  'sleep_max_bytes: maxbytespersecond == undef => sleep 0' ) ;
        ok( 0 == sleep_max_bytes( 4000, 2, 0 ),  'sleep_max_bytes: maxbytespersecond = 0 => sleep 0') ;
        ok( 0 == sleep_max_bytes( 4000, 2, $MINUS_ONE ), 'sleep_max_bytes: maxbytespersecond = -1 => sleep 0') ;
        ok( 0 == sleep_max_bytes( 4000, 2, 2000 ),  'sleep_max_bytes: maxbytespersecond = 2k max reached sharp => sleep 0') ;
        ok( 2 == sleep_max_bytes( 8000, 2, 2000 ),  'sleep_max_bytes: maxbytespersecond = 2k max over => sleep a little') ;
        ok( 0 == sleep_max_bytes( -8000, 2, 2000 ), 'sleep_max_bytes: maxbytespersecond = 2k max not reached => sleep 0') ;
        ok( 0 == sleep_max_bytes( 2000, 2, 2000 ),  'sleep_max_bytes: maxbytespersecond = 2k max not reached => sleep 0') ;
        ok( 0 == sleep_max_bytes( -2000, 2, 1000 ), 'sleep_max_bytes: maxbytespersecond = 1k max not reached => sleep 0') ;

	note( 'Leaving  tests_sleep_max_bytes()' ) ;
        return ;
}


sub delete_message_on_host1
{
        my( $mysync, $h1_fold, $expunge, @h1_msg ) = @_ ;
        if ( ! $mysync->{ delete1 } ) { return ; }
        if ( ! @h1_msg ) { return ; }
        delete_messages_on_any(
                $mysync,
                $mysync->{imap1},
                "Host1: $h1_fold",
                $expunge,
                $split1,
                @h1_msg ) ;
        return ;
}

sub tests_operators_and_exclam_precedence
{
        note( 'Entering tests_operators_and_exclam_precedence()' ) ;

        is(  1, ! 0, 'tests_operators_and_exclam_precedence: ! 0 => 1' ) ;
        is( "", ! 1, 'tests_operators_and_exclam_precedence: ! 1 => ""' ) ;
        is(  1, not( 0 ), 'tests_operators_and_exclam_precedence: not( 0 ) => 1' ) ;
        is( "", not( 1 ), 'tests_operators_and_exclam_precedence: not( 1 ) => ""' ) ;

        # I wrote those tests to avoid perlcrit "Mixed high and low-precedence booleans"
        # and change sub delete_messages_on_any() but got 4 more warnings... So now commented.

        #is(  0, ( ! 0 and 0 ), 'tests_operators_and_exclam_precedence: ! 0 and 0 ) =>  0' ) ;
        #is(  1, ( ! 0 and 1 ), 'tests_operators_and_exclam_precedence: ! 0 and 1 ) =>  1' ) ;
        #is( "", ( ! 1 and 0 ), 'tests_operators_and_exclam_precedence: ! 1 and 0 ) => ""' ) ;
        #is( "", ( ! 1 and 1 ), 'tests_operators_and_exclam_precedence: ! 1 and 1 ) => ""' ) ;

        is(  0, ( ! 0 && 0 ), 'tests_operators_and_exclam_precedence: ! 0 && 0 ) =>  0' ) ;
        is(  1, ( ! 0 && 1 ), 'tests_operators_and_exclam_precedence: ! 0 && 1 ) =>  1' ) ;
        is( "", ( ! 1 && 0 ), 'tests_operators_and_exclam_precedence: ! 1 && 0 ) => ""' ) ;
        is( "", ( ! 1 && 1 ), 'tests_operators_and_exclam_precedence: ! 1 && 1 ) => ""' ) ;

        is(  2, ( ! 0 && 2 ), 'tests_operators_and_exclam_precedence: ! 0 && 2 ) =>  1' ) ;

        note( 'Leaving  tests_operators_and_exclam_precedence()' ) ;
        return ;
}

sub delete_messages_on_any
{
        my( $mysync, $imap, $hostX_folder, $expunge, $split, @messages  ) = @_ ;
        my $expunge_message = q{} ;

        my $dry_message = $mysync->{ dry_message } ;
        $expunge_message = 'and expunged' if ( $expunge ) ;
        # "Host1: msg "

        $imap->Debug( 1 ) ;

        while ( my @messages_part = splice @messages, 0, $split )
        {
                foreach my $message ( @messages_part )
                {
                        myprint( "$hostX_folder/$message marking deleted $expunge_message $dry_message\n"  ) ;
                }
                if ( ! $mysync->{dry} && @messages_part )
                {
                        my $nb_deleted = $imap->delete_message( $imap->Range( @messages_part ) ) ;
                        if ( defined $nb_deleted )
                        {
                                # $nb_deleted is not accurate
                                $mysync->{ h1_nb_msg_deleted } += scalar @messages_part ;
                        }
                        else
                        {
                                my $error_imap = $imap->LastError || q{} ;
                                my $error = join( q{}, "$hostX_folder folder, could not delete ",
                                        scalar @messages_part, ' messages: ', $error_imap, "\n" ) ;
                                errors_incr( $mysync, $error ) ;
                        }
                }
        }

        if ( $expunge ) {
                uidexpunge_or_expunge( $mysync, $imap, @messages ) ;
        }

        $imap->Debug( 0 ) ;

        return ;
}


sub tests_uidexpunge_or_expunge
{
        note( 'Entering tests_uidexpunge_or_expunge()' ) ;


        is( undef, uidexpunge_or_expunge(  ), 'uidexpunge_or_expunge: no args => undef' ) ;
        my $mysync ;
        is( undef, uidexpunge_or_expunge( $mysync ), 'uidexpunge_or_expunge: undef args => undef' ) ;
        $mysync = {} ;
        is( undef, uidexpunge_or_expunge( $mysync ), 'uidexpunge_or_expunge: arg empty => undef' ) ;
        my $imap ;
        is( undef, uidexpunge_or_expunge( $mysync, $imap ), 'uidexpunge_or_expunge: undef Mail-IMAPClient instance => undef' ) ;

        require_ok( "Test::MockObject" ) ;
        $imap = Test::MockObject->new(  ) ;
        is( undef, uidexpunge_or_expunge( $mysync, $imap ), 'uidexpunge_or_expunge: no message (1) to uidexpunge => undef' ) ;

        my @messages = (  ) ;
        is( undef, uidexpunge_or_expunge( $mysync, $imap, @messages ), 'uidexpunge_or_expunge: no message (2) to uidexpunge => undef' ) ;

        @messages = ( '2', '1' ) ;
        $imap->mock( 'uidexpunge', sub { return ; } ) ;
        $imap->mock( 'expunge',    sub { return ; } ) ;
        is( undef, uidexpunge_or_expunge( $mysync, $imap, @messages ), 'uidexpunge_or_expunge: uidexpunge failure => expunge failure => undef' ) ;

        $imap->mock( 'expunge',    sub { return 1 ; } ) ;
        is( 1, uidexpunge_or_expunge( $mysync, $imap, @messages ), 'uidexpunge_or_expunge: uidexpunge failure => expunge ok => 1' ) ;

        $imap->mock( 'uidexpunge',    sub { return 1 ; } ) ;
        is( 1, uidexpunge_or_expunge( $mysync, $imap, @messages ), 'uidexpunge_or_expunge: messages to uidexpunge ok => 1' ) ;

        note( 'Leaving  tests_uidexpunge_or_expunge()' ) ;
        return ;
}

sub uidexpunge_or_expunge
{
        my $mysync = shift ;
        my $imap = shift ;
        my @messages = @ARG ;

        if ( ! $imap ) { return ; } ;
        if ( ! @messages ) { return ; } ;

        # Doing uidexpunge
        my @uidexpunge_result = $imap->uidexpunge( @messages ) ;
        if ( @uidexpunge_result ) {
                return 1 ;
        }
        # Failure so doing expunge
        my $expunge_result = $imap->expunge(  ) ;
        if ( $expunge_result ) {
                return 1 ;
        }
        # bad trip
        return ;
}


sub eta
{
        my( $my_time_spent, $h1_nb_processed, $my_h1_nb_msg_start, $nb_transferred ) = @_ ;
        return( q{} ) if not $foldersizes ;

        my $time_remaining = time_remaining( $my_time_spent, $h1_nb_processed, $my_h1_nb_msg_start, $nb_transferred ) ;
        my $nb_msg_remaining = $my_h1_nb_msg_start - $h1_nb_processed ;
        my $eta_date = localtime( time + $time_remaining ) ;
        return( mysprintf( 'ETA: %s  %1.0f s  %s/%s msgs left', $eta_date, $time_remaining, $nb_msg_remaining, $my_h1_nb_msg_start ) ) ;
}

sub time_remaining
{

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

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


sub tests_time_remaining
{
	note( 'Entering 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' ) ;

	note( 'Leaving  tests_time_remaining()' ) ;
        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 myprint( "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 } || $MINUS_ONE ) ;
                        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
{
	note( 'Entering 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' );
        #myprint( $c12->{1601}, "\n" ) ;

	note( 'Leaving  tests_cache_map()' ) ;
        return ;

}

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

sub tests_cache_dir_fix
{
	note( 'Entering 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: \  -> \\\\\ ' );
        ok( '\[bracket\]' eq  cache_dir_fix('[bracket]'), 'cache_dir_fix: [bracket] -> \[bracket\]' );

	note( 'Leaving  tests_cache_dir_fix()' ) ;
        return ;
}

sub cache_dir_fix_win
{
        my $cache_dir = shift ;
        $cache_dir =~ s/(\[|\])/[$1]/xg ;
        #myprint( "cache_dir_fix_win: $cache_dir\n"  ) ;
        return( $cache_dir ) ;
}

sub tests_cache_dir_fix_win
{
	note( 'Entering tests_cache_dir_fix_win()' ) ;

        ok( 'lalala' eq  cache_dir_fix_win('lalala'),  'cache_dir_fix_win: lalala -> lalala' );
        ok( '[[]bracket[]]' eq  cache_dir_fix_win('[bracket]'), 'cache_dir_fix_win: [bracket] -> [[]bracket[]]' );

	note( 'Leaving  tests_cache_dir_fix_win()' ) ;
        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 myprint( "Entering get_cache\n" ) ;

        -d $cache_dir or return( undef ); # exit if cache directory doesn't exist
        $debugcache and myprint( "cache_dir : $cache_dir\n" ) ;


        if ( 'MSWin32' ne $OSNAME ) {
                $cache_dir = cache_dir_fix( $cache_dir ) ;
        }else{
                $cache_dir = cache_dir_fix_win( $cache_dir ) ;
        }

        $debugcache and myprint( "cache_dir_fix: $cache_dir\n"  ) ;

        my @cache_files = bsd_glob( "$cache_dir/*" ) ;
        #$debugcache and myprint( "cache_files: [@cache_files]\n"  ) ;

        $debugcache and myprint( '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 ) ;

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


sub tests_get_cache
{
	note( 'Entering 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 => 0, 142 => 0, 143 => 0, 144 => 0, 177 => 0 } ;
        my $msgs_all_2 = { 242 => 0, 243 => 0, 299 => 0, 377 => 0, 777 => 0, 255 => 0 } ;

        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 => q{}, 142 => q{}, 143 => q{}, 144 => q{}, 177 => q{} } ;
        $msgs_all_2 = { 242 => q{}, 243 => q{}, 299 => q{}, 377 => q{}, 777 => q{}, 255 => q{} } ;

        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');

	note( 'Leaving  tests_get_cache()' ) ;
        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
{
	note( 'Entering 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( q{} ), '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' ) ;

	note( 'Leaving  tests_match_a_cache_file()' ) ;
        return ;
}

sub clean_cache
{
        my ( $cache_files_ref, $cache_1_2_ref, $h1_msgs_all_hash_ref, $h2_msgs_all_hash_ref )  = @_ ;

        $debugcache and myprint( "Entering clean_cache\n" ) ;

        $debugcache and myprint( map { "$_ -> " . $cache_1_2_ref->{ $_ } . "\n" } keys %{ $cache_1_2_ref }  ) ;
        foreach my $file ( @{ $cache_files_ref } ) {
                $debugcache and myprint( "$file\n"  ) ;
                my ( $cache_uid1, $cache_uid2 ) = match_a_cache_file( $file ) ;
                $debugcache and myprint( "u1: $cache_uid1 u2: $cache_uid2 c12: ", $cache_1_2_ref->{ $cache_uid1 } || q{}, "\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 myprint( "remove $file\n"  ) ;
                        unlink $file or myprint( "$OS_ERROR"  ) ;
                }
        }

        $debugcache and myprint( "Exiting clean_cache\n" ) ;
        return( 1 ) ;
}

sub tests_clean_cache
{
	note( 'Entering 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 => q{},
                177 => q{},
        } ;

        my $all_2 = {
                200 => q{},
                242 => q{},
                777 => q{},
        } ;
        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' );

	note( 'Leaving  tests_clean_cache()' ) ;
        return ;
}

sub tests_clean_cache_2
{
	note( 'Entering 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 = {
                $NUMBER_100 => q{},
                142 => q{},
                177 => q{},
        } ;

        my $all_2 = {
                200 => q{},
                242 => q{},
                777 => q{},
        } ;



        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' );

	note( 'Leaving  tests_clean_cache_2()' ) ;
        return ;
}



sub tests_mkpath
{
	note( 'Entering tests_mkpath()' ) ;

	ok( (-d 'W/tmp/tests/' or  mkpath( 'W/tmp/tests/' )), 'mkpath: mkpath W/tmp/tests/' ) ;

        SKIP: {
                skip( 'Tests only for Unix', 10   ) if ( 'MSWin32' eq $OSNAME ) ;
                my $long_path_unix = '123456789/' x 30 ;
                ok( ( -d "W/tmp/tests/long/$long_path_unix" or mkpath( "W/tmp/tests/long/$long_path_unix" ) ), 'mkpath: mkpath 300 char' ) ;
		ok( -d "W/tmp/tests/long/$long_path_unix", 'mkpath: mkpath > 300 char verified' ) ;
                ok( ( -d "W/tmp/tests/long/$long_path_unix" and rmtree( 'W/tmp/tests/long/' ) ), 'mkpath: rmtree 300 char' ) ;
		ok( ! -d "W/tmp/tests/long/$long_path_unix", 'mkpath: rmtree 300 char verified' ) ;

		ok( ( -d 'W/tmp/tests/trailing_dots...' or  mkpath( 'W/tmp/tests/trailing_dots...' ) ), 'mkpath: mkpath trailing_dots...' ) ;
		ok( -d 'W/tmp/tests/trailing_dots...', 'mkpath: mkpath trailing_dots... verified' ) ;
		ok( ( -d 'W/tmp/tests/trailing_dots...' and rmtree( 'W/tmp/tests/trailing_dots...' ) ), 'mkpath: rmtree trailing_dots...' ) ;
		ok( ! -d 'W/tmp/tests/trailing_dots...', 'mkpath: rmtree trailing_dots... verified' ) ;

		eval { ok( 1 / 0, 'mkpath: divide by 0' ) ; } or ok( 1, 'mkpath: can not divide by 0' ) ;
		ok( 1, 'mkpath: still alive' ) ;
        } ;

        SKIP: {
                skip( 'Tests only for MSWin32', 13  ) if ( 'MSWin32' ne $OSNAME ) ;
                my $long_path_2_prefix =  ".\\imapsync_tests" || '\\\?\\E:\\TEMP\\imapsync_tests'  ;
                myprint( "long_path_2_prefix: $long_path_2_prefix\n"  ) ;

                my $long_path_100   = $long_path_2_prefix . '\\' . '123456789\\' x 10 . 'END' ;
                my $long_path_300 = $long_path_2_prefix . '\\' . '123456789\\' x 30 . 'END' ;

                #myprint( "$long_path_100\n"  ) ;

                ok( ( -d $long_path_2_prefix or mkpath( $long_path_2_prefix ) ), 'mkpath: -d mkpath small path' ) ;
                ok( ( -d $long_path_2_prefix ), 'mkpath: -d mkpath small path done' ) ;
                ok( ( -d $long_path_100        or mkpath( $long_path_100 ) ),        'mkpath: mkpath > 100 char' ) ;
                ok( ( -d $long_path_100 ), 'mkpath: -d mkpath > 200 char done' ) ;
                ok( ( -d $long_path_2_prefix and rmtree( $long_path_2_prefix ) ), 'mkpath: rmtree > 100 char' ) ;
                ok( (! -d $long_path_2_prefix ), 'mkpath: ! -d rmtree done' ) ;

                # Without the eval the following mkpath 300 just kill the whole process without a whisper
                #myprint( "$long_path_300\n"  ) ;
                eval { ok( ( -d $long_path_300 or mkpath( $long_path_300 ) ),  'mkpath: create a path with 300 characters' ) ; }
			or ok( 1, 'mkpath: can not create a path with 300 characters' ) ;
                ok( ( ( ! -d $long_path_300 ) or -d $long_path_300 and rmtree( $long_path_300 ) ), 'mkpath: rmtree the 300 character path' ) ;
		ok( 1, 'mkpath: still alive' ) ;

		ok( ( -d 'W/tmp/tests/trailing_dots...' or  mkpath( 'W/tmp/tests/trailing_dots...' ) ), 'mkpath: mkpath trailing_dots...' ) ;
		ok( -d 'W/tmp/tests/trailing_dots...', 'mkpath: mkpath trailing_dots... verified' ) ;
		ok( ( -d 'W/tmp/tests/trailing_dots...' and rmtree( 'W/tmp/tests/trailing_dots...' ) ), 'mkpath: rmtree trailing_dots...' ) ;
		ok( ! -d 'W/tmp/tests/trailing_dots...', 'mkpath: rmtree trailing_dots... verified' ) ;


        } ;

	note( 'Leaving  tests_mkpath()' ) ;
	# Keep this because of the eval used by the caller (failed badly?)
        return 1 ;
}

sub tests_touch
{
	note( 'Entering tests_touch()' ) ;

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

	note( 'Leaving  tests_touch()' ) ;
        return ;
}


sub touch
{
        my @files = @_ ;
        my $failures = 0 ;

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


sub tests_tmpdir_has_colon_bug
{
	note( 'Entering tests_tmpdir_has_colon_bug()' ) ;

        ok( 0 == tmpdir_has_colon_bug( q{} ),        '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' ) ;

	note( 'Leaving  tests_tmpdir_has_colon_bug()' ) ;
        return ;
}

sub tmpdir_has_colon_bug
{
        my $path = shift ;

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

sub tmpdir_fix_colon_bug
{
        my $mysync = shift ;
        my $err = 0 ;
        if ( not (-d $mysync->{ tmpdir } and -r _ and -w _) ) {
                myprint( "tmpdir $mysync->{ tmpdir } is not valid\n"  ) ;
                return( 0 ) ;
        }
        my $cachedir_new = "$mysync->{ 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 ) ) {
                myprint( "Old cache directory $cachedir_new no exists, nothing to do\n"  ) ;
                return( 1 ) ;
        }
        # check if new cache directory already exists
        if ( -d $cachedir_new ) {
                myprint( "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
                myprint( "Moving $cachedir_old to $cachedir_new Do not interrupt this task.\n"  ) ;
                File::Copy::Recursive::rmove( $cachedir_old, $cachedir_new )
                or do {
                        myprint( "Could not move $cachedir_old to $cachedir_new\n"  ) ;
                        $err++ ;
                } ;
                # check it succeeded
                if ( -d $cachedir_new and -r _ and -w _ ) {
                        myprint( "New fixed cache directory $cachedir_new ok\n"  ) ;
                }else{
                        myprint( "New fixed cache directory $cachedir_new does not exist\n"  ) ;
                        $err++ ;
                }
                if ( -d $cachedir_old ) {
                        myprint( "Old cache directory $cachedir_old still exists\n"  ) ;
                        $err++ ;
                }else{
                        myprint( "Old cache directory $cachedir_old successfuly moved\n"  ) ;
                }
        }
        return( not $err ) ;
}


sub tests_cache_folder
{
	note( 'Entering tests_cache_folder()' ) ;

        ok( '/path/fold1/fold2' eq cache_folder( q{}, '/path', 'fold1', 'fold2'), 'cache_folder: /path, fold1, fold2 -> /path/fold1/fold2' ) ;
        ok( '/pa_th/fold1/fold2' eq cache_folder( q{}, '/pa*th', 'fold1', 'fold2'), 'cache_folder: /pa*th, fold1, fold2 -> /path/fold1/fold2' ) ;
        ok( '/_p_a__th/fol_d1/fold2' eq cache_folder( q{}, '/>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' ) ;
        ok( '//' eq cache_folder( q{}, q{}, q{}, q{}), 'cache_folder:  -> //' ) ;
        ok( '//_______' eq cache_folder( q{}, q{}, q{}, '*|?:"<>'), 'cache_folder: *|?:"<> -> //_______' ) ;

	note( 'Leaving  tests_cache_folder()' ) ;
        return ;
}

sub cache_folder
{
        my( $cache_base, $cache_dir, $h1_fold, $h2_fold ) = @_ ;

        my $sep_1 = $sync->{ h1_sep } || '/';
        my $sep_2 = $sync->{ h2_sep } || '/';

        #myprint( "$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" ) ;
        #myprint( "cache_folder [$cache_folder]\n"  ) ;
        return( $cache_folder ) ;
}

sub tests_filter_forbidden_characters
{
	note( 'Entering 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' ) ;

        SKIP: {
                skip( 'Not on MSWin32', 1 ) if ( 'MSWin32' eq $OSNAME ) ;
                ok( ( 'a b ' eq filter_forbidden_characters( 'a b ' ) ), 'filter_forbidden_characters: "a b " -> "a b "' ) ;
        } ;

        SKIP: {
                skip( 'Only on MSWin32', 2 ) if ( 'MSWin32' ne $OSNAME ) ;
                ok( ( ' a b_' eq filter_forbidden_characters( ' a b ' ) ), 'filter_forbidden_characters: "a b " -> "a b_"' ) ;
                ok( ( ' a b_/ c d_' eq filter_forbidden_characters( ' a b / c d ' ) ), 'filter_forbidden_characters: " a b / c d " -> "a b_/ c d_"' ) ;
        } ;

        ok( 'a_b' eq filter_forbidden_characters( "a\tb" ), 'filter_forbidden_characters: a\tb -> a_b' ) ;
        ok( "a_b" eq filter_forbidden_characters( "a\rb" ), 'filter_forbidden_characters: a\rb -> a_b' ) ;
        ok( "a_b" eq filter_forbidden_characters( "a\nb" ), 'filter_forbidden_characters: a\nb -> a_b' ) ;
        ok( "a_b" eq filter_forbidden_characters( "a\\b" ), 'filter_forbidden_characters: a\b -> a_b' ) ;

	note( 'Leaving  tests_filter_forbidden_characters()' ) ;
        return ;
}

sub filter_forbidden_characters
{
        my $string = shift ;

	if ( ! defined $string ) { return ; }

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

sub tests_convert_sep_to_slash
{
	note( 'Entering tests_convert_sep_to_slash()' ) ;


        ok(q{} eq convert_sep_to_slash(q{}, '/'), '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');

	note( 'Leaving  tests_convert_sep_to_slash()' ) ;
        return ;
}

sub convert_sep_to_slash
{
        my ( $folder, $sep ) = @_ ;

        $folder =~ s{\Q$sep\E}{/}xg ;
        return( $folder ) ;
}


sub tests_regexmess
{
	note( 'Entering 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(          q{}
        eq regexmess(q{}),
        '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(          q{}
        eq regexmess(q{}),
        'From mbox 1 remove, blank');

        ok(          q{}
        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');

        #myprint( "[", regexmess("From zzz\n" . 'From <tartanpion@machin.truc>'), "]" ) ;
        ok(          q{}            . '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((?:[^\n]+\n)+|)^Disposition-Notification-To:[^\n]*\n(\r?\n|.*\n\r?\n)}{$1$2}xms' ) ; # SUPER SUPER BEST!
        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.info>
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.info>

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

Disposition-Notification-To: Gilles LAMIRAL <gilles@lamiral.info>
Bye.
EOM
),
        'regexmess: 4 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.info>
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.info>
Bye.
EOM
),
        'regexmess: 5 Delete header Disposition-Notification-To:');


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

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

Hello,
Disposition-Notification-To: Gilles LAMIRAL <gilles@lamiral.info>
Bye.
EOM
),
        'regexmess: 6 Delete header Disposition-Notification-To:');

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

Hello,
Disposition-Notification-To: Gilles LAMIRAL <gilles@lamiral.info>

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

Hello,
Disposition-Notification-To: Gilles LAMIRAL <gilles@lamiral.info>

Bye.
EOM
),
        'regexmess: 7 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>

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


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

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

Hello,
Disposition-Notification-To: Gilles LAMIRAL <gilles@lamiral.info>
Bye.
EOM
),
        'regexmess: 9 Delete header Disposition-Notification-To:');



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

Hello,
Disposition-Notification-To: Gilles LAMIRAL <gilles@lamiral.info>


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

Hello,
Disposition-Notification-To: Gilles LAMIRAL <gilles@lamiral.info>


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

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

Hello,

Disposition-Notification-To: Gilles LAMIRAL <gilles@lamiral.info>

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

Hello,

Disposition-Notification-To: Gilles LAMIRAL <gilles@lamiral.info>

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

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

Hello,

Disposition-Notification-To: Gilles LAMIRAL <gilles@lamiral.info>

Disposition-Notification-To: Gilles LAMIRAL <gilles@lamiral.info>

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

Hello,

Disposition-Notification-To: Gilles LAMIRAL <gilles@lamiral.info>

Disposition-Notification-To: Gilles LAMIRAL <gilles@lamiral.info>

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


@regexmess = ( 's{\A(.*?(?! ^$))^Disposition-Notification-To:(.*?)$}{$1X-Disposition-Notification-To:$2}igxms' ) ; # BAD!
@regexmess = ( 's{\A((?:[^\n]+\n)+|)(^Disposition-Notification-To:[^\n]*\n)(\r?\n|.*\n\r?\n)}{$1X-$2$3}ims' ) ;


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

Hello,

Disposition-Notification-To: Gilles LAMIRAL <gilles@lamiral.info>

Disposition-Notification-To: Gilles LAMIRAL <gilles@lamiral.info>

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

Hello,

Disposition-Notification-To: Gilles LAMIRAL <gilles@lamiral.info>

Disposition-Notification-To: Gilles LAMIRAL <gilles@lamiral.info>

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

ok(
<<'EOM'
Date: Sat, 10 Jul 2010 05:34:45 -0700
X-Disposition-Notification-To: Gilles LAMIRAL <gilles@lamiral.info>
From:<tartanpion@machin.truc>

Hello,

Disposition-Notification-To: Gilles LAMIRAL <gilles@lamiral.info>

Disposition-Notification-To: Gilles LAMIRAL <gilles@lamiral.info>

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

Hello,

Disposition-Notification-To: Gilles LAMIRAL <gilles@lamiral.info>

Disposition-Notification-To: Gilles LAMIRAL <gilles@lamiral.info>

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

ok(
<<'EOM'
Date: Sat, 10 Jul 2010 05:34:45 -0700
X-Disposition-Notification-To: Gilles LAMIRAL <gilles@lamiral.info>
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.info>
From:<tartanpion@machin.truc>

Hello,

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


ok(
<<'EOM'
Date: Sat, 10 Jul 2010 05:34:45 -0700
From:<tartanpion@machin.truc>
X-Disposition-Notification-To: Gilles LAMIRAL <gilles@lamiral.info>

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.info>

Hello,

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

ok(
<<'EOM'
X-Disposition-Notification-To: Gilles LAMIRAL <gilles@lamiral.info>
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.info>
Date: Sat, 10 Jul 2010 05:34:45 -0700
From:<tartanpion@machin.truc>

Hello,

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

        @regexmess = ( 's/.{11}\K.*//gs' ) ;
        is( "0123456789\n", regexmess( "0123456789\n" x 100 ), 'regexmess, truncate whole message after 11 characters' ) ;
        is( "0123456789\n", regexmess( "0123456789\n" x 100_000 ), 'regexmess, truncate whole message after 11 characters ~ 1MB' ) ;

        @regexmess = ( 's/.{10000}\K.*//gs' ) ;
        is( "123456789\n" x 1000, regexmess( "123456789\n" x 100_000 ), 'regexmess, truncate whole message after 10000 characters ~ 1MB' ) ;



# regex to play with Date: from the FAQ
#@regexmess = 's{\A(.*?(?! ^$))^Date:(.*?)$}{$1Date:$2\nX-Date:$2}gxms'

	note( 'Leaving  tests_regexmess()' ) ;
	return ;

}

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


sub tests_skipmess
{
	note( 'Entering tests_skipmess()' ) ;

        ok( not( defined skipmess( 'blabla' ) ), 'skipmess, no skipmess, no skip' ) ;

        @skipmess = ('[') ;
        ok( not( defined skipmess( 'popopo' ) ), 'skipmess, bad regex [' ) ;

        @skipmess = ('lalala') ;
        ok( not( defined skipmess( 'popopo' ) ), 'skipmess, bad regex lalala' ) ;

        @skipmess = ('/popopo/') ;
        ok( 1 == skipmess( 'popopo' ), 'skipmess, popopo match regex /popopo/' ) ;

        @skipmess = ('/popopo/') ;
        ok( 0 == skipmess( 'rrrrrr' ), 'skipmess, rrrrrr does not match regex /popopo/' ) ;

        @skipmess = ('m{^$}') ;
        ok( 1 == skipmess( q{} ),    'skipmess: empty string yes' ) ;
        ok( 0 == skipmess( 'Hi!' ), 'skipmess: empty string no' ) ;

        @skipmess = ('m{i}') ;
        ok( 1 == skipmess( 'Hi!' ),  'skipmess: i string yes' ) ;
        ok( 0 == skipmess( 'Bye!' ), 'skipmess: i string no' ) ;

        @skipmess = ('m{[\x80-\xff]}') ;
        ok( 0 == skipmess( 'Hi!' ),  'skipmess: i 8bit no' ) ;
        ok( 1 == skipmess( "\xff" ), 'skipmess: \xff 8bit yes' ) ;

        @skipmess = ('m{A}', 'm{B}') ;
        ok( 0 == skipmess( 'Hi!' ),  'skipmess: A or B no' ) ;
        ok( 0 == skipmess( 'lala' ), 'skipmess: A or B no' ) ;
        ok( 0 == skipmess( "\xff" ), 'skipmess: A or B no' ) ;
        ok( 1 == skipmess( 'AB' ),   'skipmess: A or B yes' ) ;
        ok( 1 == skipmess( 'BA' ),   'skipmess: A or B yes' ) ;
        ok( 1 == skipmess( 'AA' ),   'skipmess: A or B yes' ) ;
        ok( 1 == skipmess( 'Ok Bye' ), 'skipmess: A or B yes' ) ;


        @skipmess = ( 'm#\A((?:[^\n]+\n)+|)^Content-Type: Message/Partial;[^\n]*\n(?:\n|.*\n\n)#ism' ) ; # SUPER BEST!



        ok( 1 == skipmess(
<<'EOM'
Date: Sat, 10 Jul 2010 05:34:45 -0700
Content-Type: Message/Partial; blabla
From:<tartanpion@machin.truc>

Hello!
Bye.
EOM
),
    'skipmess: 1 match Content-Type: Message/Partial' ) ;

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

Hello!
Bye.
EOM
),
    'skipmess: 2 not match Content-Type: Message/Partial' ) ;


        ok( 1 == skipmess(
<<'EOM'
Date: Sat, 10 Jul 2010 05:34:45 -0700
From:<tartanpion@machin.truc>
Content-Type: Message/Partial; blabla

Hello!
Bye.
EOM
),
    'skipmess: 3 match Content-Type: Message/Partial' ) ;

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

Hello!
Content-Type: Message/Partial; blabla
Bye.
EOM
),
    'skipmess: 4 not match Content-Type: Message/Partial' ) ;


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

Hello!
Content-Type: Message/Partial; blabla

Bye.
EOM
),
    'skipmess: 5 not match Content-Type: Message/Partial' ) ;


        ok( 1 == skipmess(
<<'EOM'
Date: Sat, 10 Jul 2010 05:34:45 -0700
Content-Type: Message/Partial; blabla
From:<tartanpion@machin.truc>

Hello!

Content-Type: Message/Partial; blabla

Bye.
EOM
),
    'skipmess: 6 match Content-Type: Message/Partial' ) ;

        ok( 1 == skipmess(
<<'EOM'
Date: Sat, 10 Jul 2010 05:34:45 -0700
Content-Type: Message/Partial;
From:<tartanpion@machin.truc>

Hello!
Bye.
EOM
),
    'skipmess: 7 match Content-Type: Message/Partial' ) ;

        ok( 1 == skipmess(
<<'EOM'
Date: Wed, 2 Jul 2014 02:26:40 +0000
MIME-Version: 1.0
Content-Type: message/partial;
        id="TAN_U_P<1404267997.00007489ed17>";
        number=3;
        total=3

6HQ6Hh3CdXj77qEGixerQ6zHx0OnQ/Cf5On4W0Y6vtU2crABZQtD46Hx1EOh8dDz4+OnTr1G


Hello!
Bye.
EOM
),
    'skipmess: 8 match Content-Type: Message/Partial' ) ;


ok( 1 == skipmess(
<<'EOM'
Return-Path: <gilles@lamiral.info>
Received: by lamiral.info (Postfix, from userid 1000)
        id 21EB12443BF; Mon,  2 Mar 2015 15:38:35 +0100 (CET)
Subject: test: aethaecohngiexao
To: <tata@petite.lamiral.info>
X-Mailer: mail (GNU Mailutils 2.2)
Message-Id: <20150302143835.21EB12443BF@lamiral.info>
Content-Type: message/partial;
        id="TAN_U_P<1404267997.00007489ed17>";
        number=3;
        total=3
Date: Mon,  2 Mar 2015 15:38:34 +0100 (CET)
From: gilles@lamiral.info (Gilles LAMIRAL)

test: aethaecohngiexao
EOM
),
    'skipmess: 9 match Content-Type: Message/Partial' ) ;

ok( 1 == skipmess(
<<'EOM'
Date: Mon,  2 Mar 2015 15:38:34 +0100 (CET)
From: gilles@lamiral.info (Gilles LAMIRAL)
Content-Type: message/partial;
        id="TAN_U_P<1404267997.00007489ed17>";
        number=3;
        total=3

test: aethaecohngiexao
EOM
. "lalala\n" x 3_000_000
),
    'skipmess: 10 match Content-Type: Message/Partial' ) ;

ok( 0 == skipmess(
<<'EOM'
Date: Mon,  2 Mar 2015 15:38:34 +0100 (CET)
From: gilles@lamiral.info (Gilles LAMIRAL)

test: aethaecohngiexao
EOM
. "lalala\n" x 3_000_000
),
    'skipmess: 11 match Content-Type: Message/Partial' ) ;


ok( 0 == skipmess(
<<"EOM"
From: fff\r
To: fff\r
Subject: Testing imapsync --skipmess\r
Date: Mon, 22 Aug 2011 08:40:20 +0800\r
Mime-Version: 1.0\r
Content-Type: text/plain; charset=iso-8859-1\r
Content-Transfer-Encoding: 7bit\r
\r
EOM
. qq{!#"d%&'()*+,-./0123456789:;<=>?\@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefg\r\n } x 32_730
),
    'skipmess: 12 not match Content-Type: Message/Partial' ) ;
        # Complex regular subexpression recursion limit (32766) exceeded with more lines
        # exit;

	note( 'Leaving  tests_skipmess()' ) ;
        return ;
}

sub skipmess
{
        my ( $string ) = @_ ;
        my $match ;
        #myprint( "$string\n" ) ;
        foreach my $skipmess ( @skipmess ) {
                $sync->{ debug } and myprint( "eval \$match = \$string =~ $skipmess\n" ) ;
                my $ret = eval "\$match = \$string =~ $skipmess ; 1" ;
                #myprint( "eval [$ret]\n" ) ;
                $sync->{ debug } and myprint( "match [$match]\n" ) ;
                if ( ( not $ret ) or $EVAL_ERROR ) {
                        myprint( "Error: eval skipmess '$skipmess': $EVAL_ERROR" ) ;
                        return( undef ) ;
                }
                return( $match ) if ( $match ) ;
        }
        return( $match ) ;
}




sub tests_bytes_display_string
{
	note( 'Entering tests_bytes_display_string()' ) ;


        is(    'NA', bytes_display_string(       ), 'bytes_display_string: no args => NA' ) ;
        is(    'NA', bytes_display_string( undef ), 'bytes_display_string: undef   => NA' ) ;
        is(    'NA', bytes_display_string( 'blabla' ), 'bytes_display_string: blabla   => NA' ) ;

        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( 1_048_575 ), 'bytes_display_string: 1_048_575' ) ;
        ok(    '1.000 MiB' eq bytes_display_string( 1_048_576 ), 'bytes_display_string: 1_048_576' ) ;

        ok(    '1.000 GiB' eq bytes_display_string( 1_073_741_823 ), 'bytes_display_string: 1_073_741_823 ' ) ;
        ok(    '1.000 GiB' eq bytes_display_string( 1_073_741_824 ), 'bytes_display_string: 1_073_741_824 ' ) ;

        ok(    '1.000 TiB' eq bytes_display_string( 1_099_511_627_775 ), 'bytes_display_string: 1_099_511_627_775' ) ;
        ok(    '1.000 TiB' eq bytes_display_string( 1_099_511_627_776 ), 'bytes_display_string: 1_099_511_627_776' ) ;

        ok(    '1.000 PiB' eq bytes_display_string( 1_125_899_906_842_623 ), 'bytes_display_string: 1_125_899_906_842_623' ) ;
        ok(    '1.000 PiB' eq bytes_display_string( 1_125_899_906_842_624 ), 'bytes_display_string: 1_125_899_906_842_624' ) ;

        ok( '1024.000 PiB' eq bytes_display_string( 1_152_921_504_606_846_975 ), 'bytes_display_string: 1_152_921_504_606_846_975' ) ;
        ok( '1024.000 PiB' eq bytes_display_string( 1_152_921_504_606_846_976 ), 'bytes_display_string: 1_152_921_504_606_846_976' ) ;

        ok( '1048576.000 PiB' eq bytes_display_string( 1_180_591_620_717_411_303_424 ), 'bytes_display_string: 1_180_591_620_717_411_303_424' ) ;

        #myprint(  bytes_display_string( 1_180_591_620_717_411_303_424 ), "\n" ) ;
	note( 'Leaving  tests_bytes_display_string()' ) ;

        return ;
}

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

        my $readable_value = q{} ;

        if ( ! defined( $bytes ) ) {
                return( 'NA' ) ;
        }

        if ( not match_number( $bytes ) ) {
                return( 'NA' ) ;
        }



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


sub tests_useheader_suggestion
{
        note( 'Entering tests_useheader_suggestion()' ) ;

        is( undef, useheader_suggestion(  ), 'useheader_suggestion: no args => undef' ) ;
        my $mysync = {} ;

        $mysync->{ h1_nb_msg_noheader } = 0 ;
        is( q{}, useheader_suggestion( $mysync ), 'useheader_suggestion: h1_nb_msg_noheader count null => no suggestion' ) ;
        $mysync->{ h1_nb_msg_noheader } = 2 ;
        is( q{in order to sync those 2 unidentified messages, add option --addheader}, useheader_suggestion( $mysync ),
        'useheader_suggestion: h1_nb_msg_noheader count 2 => suggestion of --addheader' ) ;

        note( 'Leaving  tests_useheader_suggestion()' ) ;
        return ;
}

sub useheader_suggestion
{
        my $mysync = shift ;
        if ( ! defined $mysync->{ h1_nb_msg_noheader } )
        {
                return ;
        }
        elsif ( 1 <= $mysync->{ h1_nb_msg_noheader } )
        {
                return qq{in order to sync those $mysync->{ h1_nb_msg_noheader } unidentified messages, add option --addheader} ;
        }
        else
        {
                return q{} ;
        }
        return ;
}

sub stats
{
        my $mysync = shift ;

        if ( ! $mysync->{stats} ) {
                return ;
        }

        my $timeend = time ;
        my $timediff = $timeend - $mysync->{timestart} ;

        my $timeend_str   = localtime $timeend ;

        my $memory_consumption_at_end = memory_consumption(  ) || 0 ;
        my $memory_consumption_at_start = $mysync->{ memory_consumption_at_start } || 0 ;
        my $memory_ratio = ($max_msg_size_in_bytes) ?
                mysprintf('%.1f', $memory_consumption_at_end / $max_msg_size_in_bytes) : 'NA' ;

        # my $useheader_suggestion = useheader_suggestion( $mysync ) ;
        myprint(  "++++ Statistics\n" ) ;
        myprint(  "Transfer started on                     : $timestart_str\n" ) ;
        myprint(  "Transfer ended on                       : $timeend_str\n" ) ;
        myprintf( "Transfer time                           : %.1f sec\n", $timediff ) ;
        myprint(  "Folders synced                          : $h1_folders_wanted_ct/$h1_folders_wanted_nb synced\n" ) ;
        myprint(  "Messages transferred                    : $mysync->{nb_msg_transferred} " ) ;
        myprint(  "(could be $nb_msg_skipped_dry_mode without dry mode)" ) if ( $mysync->{dry} ) ;
        myprint(  "\n" ) ;
        myprint(  "Messages skipped                        : $mysync->{ nb_msg_skipped }\n" ) ;
        myprint(  "Messages found duplicate on host1       : $h1_nb_msg_duplicate\n" ) ;
        myprint(  "Messages found duplicate on host2       : $h2_nb_msg_duplicate\n" ) ;
        myprint(  "Messages found crossduplicate on host2  : $mysync->{ h2_nb_msg_crossdup }\n" ) ;
        myprint(  "Messages void (noheader) on host1       : $mysync->{ h1_nb_msg_noheader }  ", useheader_suggestion( $mysync ), "\n" ) ;
        myprint(  "Messages void (noheader) on host2       : $h2_nb_msg_noheader\n" ) ;
        nb_messages_in_1_not_in_2( $mysync ) ;
        nb_messages_in_2_not_in_1( $mysync ) ;
        myprintf( "Messages found in host1 not in host2    : %s messages\n", $mysync->{ nb_messages_in_1_not_in_2 } ) ;
        myprintf( "Messages found in host2 not in host1    : %s messages\n", $mysync->{ nb_messages_in_2_not_in_1 } ) ;
        myprint(  "Messages deleted on host1               : $mysync->{ h1_nb_msg_deleted }\n" ) ;
        myprint(  "Messages deleted on host2               : $h2_nb_msg_deleted\n" ) ;
        myprintf( "Total bytes transferred                 : %s (%s)\n",
                $mysync->{total_bytes_transferred},
                bytes_display_string( $mysync->{total_bytes_transferred} ) ) ;
        myprintf( "Total bytes skipped                     : %s (%s)\n",
                $mysync->{ total_bytes_skipped },
                bytes_display_string( $mysync->{ total_bytes_skipped } ) ) ;
        $timediff ||= 1 ; # No division per 0
        myprintf("Message rate                            : %.1f messages/s\n", $mysync->{nb_msg_transferred} / $timediff ) ;
        myprintf("Average bandwidth rate                  : %.1f KiB/s\n", $mysync->{total_bytes_transferred} / $KIBI / $timediff ) ;
        myprint( "Reconnections to host1                  : $mysync->{imap1}->{IMAPSYNC_RECONNECT_COUNT}\n" ) ;
        myprint( "Reconnections to host2                  : $mysync->{imap2}->{IMAPSYNC_RECONNECT_COUNT}\n" ) ;
        myprintf("Memory consumption at the end           : %.1f MiB (started with %.1f MiB)\n",
                 $memory_consumption_at_end / $KIBI / $KIBI,
                 $memory_consumption_at_start / $KIBI / $KIBI ) ;
        myprint( "Load end is                             : " . ( join( q{ }, loadavg(  ) ) || 'unknown' ), " on $mysync->{cpu_number} cores\n" ) ;

        myprintf("Biggest message                         : %s bytes (%s)\n",
                $max_msg_size_in_bytes,
                bytes_display_string( $max_msg_size_in_bytes) ) ;
        myprint(  "Memory/biggest message ratio            : $memory_ratio\n" ) ;
        if ( $foldersizesatend and $foldersizes ) {


        my $nb_msg_start_diff = diff_or_NA( $h2_nb_msg_start, $h1_nb_msg_start ) ;
        my $bytes_start_diff  = diff_or_NA( $h2_bytes_start,  $h1_bytes_start  ) ;

        myprintf("Start difference host2 - host1          : %s messages, %s bytes (%s)\n", $nb_msg_start_diff,
                                                        $bytes_start_diff,
                                                        bytes_display_string( $bytes_start_diff ) ) ;

        my $nb_msg_end_diff = diff_or_NA( $h2_nb_msg_end, $h1_nb_msg_end ) ;
        my $bytes_end_diff  = diff_or_NA( $h2_bytes_end,  $h1_bytes_end  ) ;

        myprintf("Final difference host2 - host1          : %s messages, %s bytes (%s)\n", $nb_msg_end_diff,
                                                        $bytes_end_diff,
                                                        bytes_display_string( $bytes_end_diff ) ) ;
        }

        comment_on_final_diff_in_1_not_in_2( $mysync ) ;
        comment_on_final_diff_in_2_not_in_1( $mysync ) ;
        myprint( "Detected $mysync->{nb_errors} errors\n\n" ) ;

        myprint(  $warn_release, "\n" ) ;
        myprint(  homepage(  ), "\n" ) ;
        return ;
}

sub diff_or_NA
{
        my( $n1, $n2 ) = @ARG ;

        if ( not defined $n1 or not defined $n2 ) {
                return 'NA' ;
        }

        if ( not match_number( $n1 )
          or not match_number( $n2 ) ) {
                 return 'NA' ;
        }

        return( $n1 - $n2 ) ;
}

sub match_number
{
        my $n = shift @ARG ;

        if ( not defined $n ) {
                return 0 ;
        }
        if ( $n =~  /[0-9]+\.?[0-9]?/x ) {
                return 1 ;
        }
        else {
                return 0 ;
        }
}


sub tests_match_number
{
	note( 'Entering tests_match_number()' ) ;


        is( 0, match_number(   ),        'match_number: no parameters => 0' ) ;
        is( 0, match_number( undef ),    'match_number:         undef => 0' ) ;
        is( 0, match_number( 'blabla' ), 'match_number:        blabla => 0' ) ;
        is( 1, match_number( 0 ),        'match_number:             0 => 1' ) ;
        is( 1, match_number( 1 ),        'match_number:             1 => 1' ) ;
        is( 1, match_number( 1.0 ),      'match_number:           1.0 => 1' ) ;
        is( 1, match_number( 0.0 ),      'match_number:           0.0 => 1' ) ;

	note( 'Leaving  tests_match_number()' ) ;
        return ;
}



sub tests_diff_or_NA
{
	note( 'Entering tests_diff_or_NA()' ) ;


        is( 'NA', diff_or_NA(  ),             'diff_or_NA: no parameters => NA' ) ;
        is( 'NA', diff_or_NA( undef ),        'diff_or_NA: undef         => NA' ) ;
        is( 'NA', diff_or_NA( undef, undef ), 'diff_or_NA: undef  undef  => NA' ) ;
        is( 'NA', diff_or_NA( undef, 1 ),     'diff_or_NA: undef  1      => NA' ) ;
        is( 'NA', diff_or_NA( 1, undef ),     'diff_or_NA: 1      undef  => NA' ) ;
        is( 'NA', diff_or_NA( 'blabla', 1 ),  'diff_or_NA: blabla 1      => NA' ) ;
        is( 'NA', diff_or_NA( 1, 'blabla' ),  'diff_or_NA: 1      blabla => NA' ) ;
        is( 0, diff_or_NA( 1, 1 ),            'diff_or_NA: 1      1      =>  0' ) ;
        is( 1, diff_or_NA( 1, 0 ),            'diff_or_NA: 1      0      =>  1' ) ;
        is( -1, diff_or_NA( 0, 1 ),           'diff_or_NA: 0      1      => -1' ) ;
        is( 0, diff_or_NA( 1.0, 1 ),          'diff_or_NA: 1.0    1      =>  0' ) ;
        is( 1, diff_or_NA( 1.0, 0 ),          'diff_or_NA: 1.0    0      =>  1' ) ;
        is( -1, diff_or_NA( 0, 1.0 ),         'diff_or_NA: 0      1.0    => -1' ) ;

	note( 'Leaving  tests_diff_or_NA()' ) ;
        return ;
}

sub homepage
{
        return( 'Homepage: https://imapsync.lamiral.info/' ) ;
}


sub load_modules
{
        if ( $sync->{ssl1}
	  or $sync->{ssl2}
	  or $sync->{tls1}
	  or $sync->{tls2}) {
                if ( $sync->{inet4} ) {
                        IO::Socket::SSL->import( 'inet4' ) ;
                }
                if ( $sync->{inet6} ) {
                        IO::Socket::SSL->import( 'inet6' ) ;
                }
        }
        return ;
}



sub parse_header_msg
{
        my ( $mysync, $imap, $m_uid, $s_heads, $s_fir, $side, $s_hash ) = @_ ;

        my $head = $s_heads->{$m_uid} ;
        my $headnum =  scalar keys  %{ $head }   ;
        $mysync->{ debug } and myprint( "$side: uid $m_uid number of headers, pass one: ", $headnum, "\n" ) ;

        if ( ( ! $headnum ) and ( $wholeheaderifneeded ) ){
                $mysync->{ debug } and myprint( "$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 ;

                #myprint( $whole_header ) ;
                $head = decompose_header( $whole_header ) ;

                $headnum =  scalar  keys  %{ $head }   ;
                $mysync->{ debug } and myprint( "$side: uid $m_uid number of headers, pass two: ", $headnum, "\n" ) ;
        }

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

        my $headstr ;

        $headstr = header_construct( $head, $side, $m_uid ) ;

        if ( ( ! $headstr ) and ( $mysync->{addheader} ) and ( $side eq 'Host1' ) ) {
                my $header = add_header( $m_uid ) ;
                $mysync->{ debug } and myprint( "$side: 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 ) ;
        $mysync->{ debug } and myprint( "$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
                        $sync->{ debug } and myprint( "$side uid $m_uid header [$H]", "\n" ) ;

                        if ($skipheader and $H =~ m/$skipheader/xi) {
                                $sync->{ debug } and myprint( "$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/\ /xgo ;

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

        # remove the last blanks ( Gmail bug )
        $header_val =~ s/\s*$//xo;

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

        # 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
{
	note( 'Entering tests_header_line_normalize()' ) ;


        ok( ': ' eq header_line_normalize( q{}, q{} ), '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 D' eq header_line_normalize( 'hhh', 'aa  bb   ccc d' ), 'header_line_normalize: remove succesive blanks' ) ;
        ok( 'HHH: AA BB CCC' eq header_line_normalize( 'hhh', 'aa  bb   ccc   ' ), 'header_line_normalize: remove last blanks' ) ;
        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' ) ;

	note( 'Leaving  tests_header_line_normalize()' ) ;
        return ;
}


sub tests_firstline
{
        note( 'Entering tests_firstline()' ) ;

        is( q{}, firstline( 'W/tmp/tests/noexist.txt' ), 'firstline: getting empty string from inexisting W/tmp/tests/noexist.txt' ) ;

        ok( (-d 'W/tmp/tests/' or  mkpath( 'W/tmp/tests/' ) ), 'firstline: mkpath W/tmp/tests/' ) ;

        is( "blabla\n" , string_to_file( "blabla\n", 'W/tmp/tests/firstline.txt' ), 'firstline: put blabla in W/tmp/tests/firstline.txt' ) ;
        is( 'blabla' , firstline( 'W/tmp/tests/firstline.txt' ), 'firstline: get blabla from W/tmp/tests/firstline.txt' ) ;

        is( q{} , string_to_file( q{}, 'W/tmp/tests/firstline2.txt' ), 'firstline: put empty string in W/tmp/tests/firstline2.txt' ) ;
        is( q{} , firstline( 'W/tmp/tests/firstline2.txt' ), 'firstline: get empty string from W/tmp/tests/firstline2.txt' ) ;

        is( "\n" , string_to_file( "\n", 'W/tmp/tests/firstline3.txt' ), 'firstline: put CR in W/tmp/tests/firstline3.txt' ) ;
        is( q{} , firstline( 'W/tmp/tests/firstline3.txt' ), 'firstline: get empty string from W/tmp/tests/firstline3.txt' ) ;

        is( "blabla\nTiti\n" , string_to_file( "blabla\nTiti\n", 'W/tmp/tests/firstline4.txt' ), 'firstline: put blabla\nTiti\n in W/tmp/tests/firstline4.txt' ) ;
        is( 'blabla' , firstline( 'W/tmp/tests/firstline4.txt' ), 'firstline: get blabla from W/tmp/tests/firstline4.txt' ) ;

        note( 'Leaving  tests_firstline()' ) ;
        return ;
}

sub firstline
{
        # extract the first line of a file (without \n)
        # return empty string if error or empty string

        my $file = shift ;
        my $line ;

        $line = nthline( $file, 1 ) ;
        return $line ;
}



sub tests_secondline
{
        note( 'Entering tests_secondline()' ) ;

        is( q{}, secondline( 'W/tmp/tests/noexist.txt' ), 'secondline: getting empty string from inexisting W/tmp/tests/noexist.txt' ) ;
        is( q{}, secondline( 'W/tmp/tests/noexist.txt', 2 ), 'secondline: 2nd getting empty string from inexisting W/tmp/tests/noexist.txt' ) ;

        ok( (-d 'W/tmp/tests/' or  mkpath( 'W/tmp/tests/' ) ), 'secondline: mkpath W/tmp/tests/' ) ;

        is( "L1\nL2\nL3\nL4\n" , string_to_file( "L1\nL2\nL3\nL4\n", 'W/tmp/tests/secondline.txt' ), 'secondline: put L1\nL2\nL3\nL4\n in W/tmp/tests/secondline.txt' ) ;
        is( 'L2' , secondline( 'W/tmp/tests/secondline.txt' ), 'secondline: get L2 from W/tmp/tests/secondline.txt' ) ;


        note( 'Leaving  tests_secondline()' ) ;
        return ;
}


sub secondline
{
        # extract the second line of a file (without \n)
        # return empty string if error or empty string

        my $file = shift ;
        my $line ;

        $line = nthline( $file, 2 ) ;
        return $line ;
}




sub tests_nthline
{
        note( 'Entering tests_nthline()' ) ;

        is( q{}, nthline( 'W/tmp/tests/noexist.txt' ), 'nthline: getting empty string from inexisting W/tmp/tests/noexist.txt' ) ;
        is( q{}, nthline( 'W/tmp/tests/noexist.txt', 2 ), 'nthline: 2nd getting empty string from inexisting W/tmp/tests/noexist.txt' ) ;

        ok( (-d 'W/tmp/tests/' or  mkpath( 'W/tmp/tests/' ) ), 'nthline: mkpath W/tmp/tests/' ) ;

        is( "L1\nL2\nL3\nL4\n" , string_to_file( "L1\nL2\nL3\nL4\n", 'W/tmp/tests/nthline.txt' ), 'nthline: put L1\nL2\nL3\nL4\n in W/tmp/tests/nthline.txt' ) ;
        is( 'L3' , nthline( 'W/tmp/tests/nthline.txt', 3 ), 'nthline: get L3 from W/tmp/tests/nthline.txt' ) ;


        note( 'Leaving  tests_nthline()' ) ;
        return ;
}


sub nthline
{
        # extract the nth line of a file (without \n)
        # return empty string if error or empty string

        my $file = shift ;
        my $num  = shift ;

        if ( ! all_defined( $file, $num ) ) { return q{} ; }

        my $line ;

        $line = ( file_to_array( $file ) )[$num - 1] ;
        if ( ! defined $line )
        {
                return q{} ;
        }
        else
        {
                chomp $line ;
                return $line ;
        }
}


# Should be unit tested and then be used by file_to_string, refactoring file_to_string
sub file_to_array
{

        my( $file ) = shift ;
        my @string ;

        open my $FILE, '<', $file or do {
		myprint( "Error reading file $file : $OS_ERROR\n" ) ;
		return ;
	} ;
        @string = <$FILE> ;
        close $FILE ;
        return( @string ) ;
}


sub tests_file_to_string
{
	note( 'Entering tests_file_to_string()' ) ;

	is( undef, file_to_string(  ), 'file_to_string: no args => undef' ) ;
	is( undef, file_to_string( '/noexist' ), 'file_to_string: /noexist => undef' ) ;
	is( undef, file_to_string( '/' ), 'file_to_string: reading a directory => undef' ) ;
	ok( file_to_string( $PROGRAM_NAME ), 'file_to_string: reading myself' ) ;

        ok( (-d 'W/tmp/tests/' or  mkpath( 'W/tmp/tests/' ) ), 'file_to_string: mkpath W/tmp/tests/' ) ;

	is( 'lilili', string_to_file( 'lilili', 'W/tmp/tests/canbewritten' ), 'file_to_string: string_to_file filling W/tmp/tests/canbewritten with lilili' ) ;
	is( 'lilili', file_to_string( 'W/tmp/tests/canbewritten' ), 'file_to_string: reading W/tmp/tests/canbewritten is lilili' ) ;

	is( q{}, string_to_file( q{}, 'W/tmp/tests/empty' ), 'file_to_string: string_to_file filling W/tmp/tests/empty with empty string' ) ;
	is( q{}, file_to_string( 'W/tmp/tests/empty' ), 'file_to_string: reading W/tmp/tests/empty is empty' ) ;

	note( 'Leaving  tests_file_to_string()' ) ;
	return ;
}

sub file_to_string
{
        my  $file  = shift ;
	if ( ! $file ) { return ; }
	if ( ! -e $file ) { return ; }
	if ( ! -f $file ) { return ; }
	if ( ! -r $file ) { return ; }
        my @string ;
        if ( open my $FILE, '<', $file ) {
		@string = <$FILE> ;
		close $FILE ;
		return( join q{}, @string ) ;
	}else{
		myprint( "Error reading file $file : $OS_ERROR\n" ) ;
		return ;
	}
}


sub tests_string_to_file
{
	note( 'Entering tests_string_to_file()' ) ;

	is( undef, string_to_file(  ),         'string_to_file: no args => undef' ) ;
	is( undef, string_to_file( 'lalala' ), 'string_to_file: one arg => undef' ) ;
	is( undef, string_to_file( 'lalala', '.' ), 'string_to_file: writing a directory => undef' ) ;
	ok( (-d 'W/tmp/tests/' or  mkpath( 'W/tmp/tests/' ) ), 'string_to_file: mkpath W/tmp/tests/' ) ;
	is( 'lalala', string_to_file( 'lalala', 'W/tmp/tests/canbewritten' ), 'string_to_file: W/tmp/tests/canbewritten with lalala' ) ;
	is( q{}, string_to_file( q{}, 'W/tmp/tests/empty' ), 'string_to_file: W/tmp/tests/empty with empty string' ) ;

	SKIP: {
                Readonly my $NB_UNX_tests_string_to_file => 1 ;
                skip( 'Not on Unix non-root', $NB_UNX_tests_string_to_file ) if ('MSWin32' eq $OSNAME or '0' eq $EFFECTIVE_USER_ID ) ;
		is( undef, string_to_file( 'lalala', '/cantouch' ), 'string_to_file: /cantouch denied => undef' ) ;
	}

	note( 'Leaving  tests_string_to_file()' ) ;
	return ;
}

sub string_to_file
{
        my( $string, $file ) = @_ ;
	if( ! defined $string ) { return ; }
	if( ! defined $file )   { return ; }

	if ( ! -e $file && ! -w dirname( $file ) ) {
		myprint( "string_to_file: directory of $file is not writable\n" ) ;
		return ;
	}

        if ( ! sysopen( FILE, $file, O_WRONLY|O_TRUNC|O_CREAT, 0600) ) {
		myprint( "string_to_file: failure writing to $file with error: $OS_ERROR\n" ) ;
		return ;
	}
        print FILE $string ;
        close FILE ;
        return $string ;
}

0 and <<'MULTILINE_COMMENT' ;
This is a multiline comment.
Based on David Carter discussion, to do:
* Call parameters stay the same.
* Now always "return( $string, $error )". Descriptions below.
OK * Still    capture STDOUT via "1> $output_tmpfile" to finish in $string and "return( $string, $error )"
OK * Now also capture STDERR via "2> $error_tmpfile"  to finish in $error  and "return( $string, $error )"
OK * in case of CHILD_ERROR, return( undef, $error )
  and print $error, with folder/UID/maybeSubject context,
  on console and at the end with the final error listing. Count this as a sync error.
* in case of good command, take final $string as is, unless void. In case $error with value then print it.
* in case of good command and final $string empty, consider it like CHILD_ERROR =>
  return( undef, $error ) and print $error, with folder/UID/maybeSubject context,
  on console and at the end with the final error listing. Count this as a sync error.
MULTILINE_COMMENT
# End of multiline comment.

sub pipemess
{
        my ( $string, @commands ) = @_ ;
        my $error = q{} ;
        foreach my $command ( @commands ) {
                my $input_tmpfile  = "$sync->{ tmpdir }/imapsync_tmp_file.$PROCESS_ID.inp.txt" ;
                my $output_tmpfile = "$sync->{ tmpdir }/imapsync_tmp_file.$PROCESS_ID.out.txt" ;
                my $error_tmpfile  = "$sync->{ tmpdir }/imapsync_tmp_file.$PROCESS_ID.err.txt" ;
                string_to_file( $string, $input_tmpfile  ) ;
                ` $command < $input_tmpfile 1> $output_tmpfile 2> $error_tmpfile ` ;
                my $is_command_ko = $CHILD_ERROR ;
                my $error_cmd = file_to_string( $error_tmpfile ) ;
                chomp( $error_cmd ) ;
                $string = file_to_string( $output_tmpfile ) ;
                my $string_len = length( $string ) ;
                unlink $input_tmpfile, $output_tmpfile, $error_tmpfile ;

                if ( $is_command_ko or ( ! $string_len ) ) {
                        my $cmd_exit_value = $CHILD_ERROR >> 8 ;
                        my $cmd_end_signal = $CHILD_ERROR & 127 ;
                        my $signal_log = ( $cmd_end_signal ) ? " signal $cmd_end_signal and" : q{} ;
                        my $error_log = qq{Failure: --pipemess command "$command" ended with$signal_log "$string_len" characters exit value "$cmd_exit_value" and STDERR "$error_cmd"\n} ;
                        myprint( $error_log ) ;
                        if ( wantarray ) {
                                return @{ [ undef, $error_log ] }
                        }else{
                                return ;
                        }
                }
                if ( $error_cmd ) {
                        $error .= qq{STDERR of --pipemess "$command": $error_cmd\n} ;
                        myprint(  qq{STDERR of --pipemess "$command": $error_cmd\n} ) ;
                }
        }
        #myprint( "[$string]\n" ) ;
        if ( wantarray ) {
                return ( $string, $error ) ;
        }else{
                return $string ;
        }
}



sub tests_pipemess
{
	note( 'Entering tests_pipemess()' ) ;


        SKIP: {
                Readonly my $NB_WIN_tests_pipemess => 3 ;
                skip( 'Not on MSWin32', $NB_WIN_tests_pipemess ) if ('MSWin32' ne $OSNAME) ;
                # Windows
                # "type" command does not accept redirection of STDIN with <
                # "sort" does
                ok( "nochange\n" eq pipemess( 'nochange', 'sort' ), 'pipemess: nearly no change by sort' ) ;
                ok( "nochange2\n" eq pipemess( 'nochange2', qw( sort sort ) ), 'pipemess: nearly no change by sort,sort' ) ;
                # command not found
                #diag( 'Warning and failure about cacaprout are on purpose' ) ;
                ok( ! defined( pipemess( q{}, 'cacaprout' ) ), 'pipemess: command not found' ) ;

        } ;

        my ( $stringT, $errorT ) ;

        SKIP: {
                Readonly my $NB_UNX_tests_pipemess => 25 ;
                skip( 'Not on Unix', $NB_UNX_tests_pipemess ) if ('MSWin32' eq $OSNAME) ;
                # Unix
                ok( 'nochange' eq pipemess( 'nochange', 'cat' ), 'pipemess: no change by cat' ) ;

                ok( 'nochange2' eq pipemess( 'nochange2', 'cat', 'cat' ), 'pipemess: no change by cat,cat' ) ;

                ok( "     1\tnumberize\n" eq pipemess( "numberize\n", 'cat -n' ), 'pipemess: numberize by cat -n' ) ;
                ok( "     1\tnumberize\n     2\tnumberize\n" eq pipemess( "numberize\nnumberize\n", 'cat -n' ), 'pipemess: numberize by cat -n' ) ;

                ok( "A\nB\nC\n" eq pipemess( "A\nC\nB\n", 'sort' ), 'pipemess: sort' ) ;

                # command not found
                #diag( 'Warning and failure about cacaprout are on purpose' ) ;
                is( undef, pipemess( q{}, 'cacaprout' ), 'pipemess: command not found' ) ;

                # success with true but no output at all
                is( undef, pipemess( q{blabla}, 'true' ), 'pipemess: true but no output' ) ;

                # failure with false and no output at all
                is( undef, pipemess( q{blabla}, 'false' ), 'pipemess: false and no output' ) ;

                # Failure since pipemess is not a real pipe, so first cat wait for standard input
                is( q{blabla}, pipemess( q{blabla}, '( cat|cat ) ' ), 'pipemess: ok by ( cat|cat )' ) ;


                ( $stringT, $errorT ) = pipemess( 'nochange', 'cat' ) ;
                is( $stringT, 'nochange', 'pipemess: list context, no change by cat, string' ) ;
                is( $errorT, q{}, 'pipemess: list context, no change by cat, no error' ) ;

                ( $stringT, $errorT ) = pipemess( 'dontcare', 'true' ) ;
                is( $stringT, undef, 'pipemess: list context, true but no output, string' ) ;
                like( $errorT, qr{\QFailure: --pipemess command "true" ended with "0" characters exit value "0" and STDERR ""\E}xm, 'pipemess: list context, true but no output, error' ) ;

                ( $stringT, $errorT ) = pipemess( 'dontcare', 'false' ) ;
                is( $stringT, undef, 'pipemess: list context, false and no output, string' ) ;
                like( $errorT, qr{\QFailure: --pipemess command "false" ended with "0" characters exit value "1" and STDERR ""\E}xm,
		'pipemess: list context, false and no output, error' ) ;

                ( $stringT, $errorT ) = pipemess( 'dontcare', '/bin/echo -n blablabla' ) ;
                is( $stringT, q{blablabla}, 'pipemess: list context, "echo -n blablabla", string' ) ;
                is( $errorT, q{},  'pipemess: list context, "echo blablabla", error' ) ;


                ( $stringT, $errorT ) = pipemess( 'dontcare', '( echo -n blablabla 3>&1 1>&2 2>&3 )' ) ;
                is( $stringT, undef, 'pipemess: list context, "no output STDERR blablabla", string' ) ;
                like( $errorT,  qr{blablabla"}xm, 'pipemess: list context, "no output STDERR blablabla", error' ) ;


                ( $stringT, $errorT ) = pipemess( 'dontcare', '( echo -n blablabla 3>&1 1>&2 2>&3 )', 'false' ) ;
                is( $stringT, undef, 'pipemess: list context, "no output STDERR blablabla then false", string' ) ;
                like( $errorT,  qr{blablabla"}xm, 'pipemess: list context, "no output STDERR blablabla then false", error' ) ;

                ( $stringT, $errorT ) = pipemess( 'dontcare', 'false', '( echo -n blablabla 3>&1 1>&2 2>&3 )' ) ;
                is( $stringT, undef, 'pipemess: list context, "false then STDERR blablabla", string' ) ;
                like( $errorT,  qr{\QFailure: --pipemess command "false" ended with "0" characters exit value "1" and STDERR ""\E}xm,
		'pipemess: list context, "false then STDERR blablabla", error' ) ;

                ( $stringT, $errorT ) = pipemess( 'dontcare', '( echo rrrrr ; echo -n error_blablabla 3>&1 1>&2 2>&3 )' ) ;
                like( $stringT, qr{rrrrr}xm, 'pipemess: list context, "STDOUT rrrrr STDERR error_blablabla", string' ) ;
                like( $errorT,  qr{STDERR.*error_blablabla}xm,  'pipemess: list context, "STDOUT rrrrr STDERR error_blablabla", error' ) ;

        }

        ( $stringT, $errorT ) = pipemess( 'dontcare', 'cacaprout' ) ;
        is( $stringT, undef, 'pipemess: list context, cacaprout not found, string' ) ;
        like( $errorT, qr{\QFailure: --pipemess command "cacaprout" ended with "0" characters exit value\E}xm,
	'pipemess: list context, cacaprout not found, error' ) ;

	note( 'Leaving  tests_pipemess()' ) ;
        return ;
}



sub tests_is_a_release_number
{
	note( 'Entering tests_is_a_release_number()' ) ;

        is( undef, is_a_release_number(  ), 'is_a_release_number: no args => undef' ) ;
        ok( is_a_release_number( $RELEASE_NUMBER_EXAMPLE_1 ), 'is_a_release_number 1.351' ) ;
        ok( is_a_release_number( $RELEASE_NUMBER_EXAMPLE_2 ), 'is_a_release_number 42.4242' ) ;
        ok( is_a_release_number( imapsync_version( $sync ) ), 'is_a_release_number imapsync_version(  )' ) ;
        ok( ! is_a_release_number( 'blabla' ), '! is_a_release_number blabla' ) ;

	note( 'Leaving  tests_is_a_release_number()' ) ;
        return ;
}

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



sub imapsync_version_public
{

        my $local_version = imapsync_version( $sync ) ;
        my $imapsync_basename = imapsync_basename(  ) ;
        my $agent_info = "$OSNAME system, perl "
                . mysprintf( '%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\r\n",
                "User-Agent: imapsync/$local_version ($agent_info)\r\n",
                "Host: ks.lamiral.info\r\n\r\n" ;
        my @line = <$sock> ;
        close $sock ;
        my $last_release = $line[$LAST] ;
        chomp $last_release ;
        return( $last_release ) ;
}

sub not_long_imapsync_version_public
{
        #myprint( "Entering not_long_imapsync_version_public\n" ) ;

	my $fake = shift ;
	if ( $fake ) { return $fake }

        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 myprint( "Error setting SIGALRM handler: $OS_ERROR\n" ) ;
        }

        my $ret = eval {
                alarm 3 ;
                {
                        $val = imapsync_version_public(  ) ;
                        #sleep 4 ;
                        #myprint( "End of imapsync_version_public\n" ) ;
                }
                alarm 0 ;
                1 ;
        } ;
        #myprint( "eval [$ret]\n" ) ;
        if ( ( not $ret ) or $EVAL_ERROR ) {
                #myprint( "$EVAL_ERROR" ) ;
                if ($EVAL_ERROR =~ /alarm/) {
                # timed out
                        return('timeout') ;
                }else{
                        alarm 0 ;
                        return( 'unknown' ) ; # propagate unexpected errors
                }
        }else {
        # Good!
                return( $val ) ;
        }
}

sub tests_not_long_imapsync_version_public
{
	note( 'Entering tests_not_long_imapsync_version_public()' ) ;


	is( 1, is_a_release_number( not_long_imapsync_version_public(  ) ),
		'not_long_imapsync_version_public: public release is a number' ) ;

	note( 'Leaving  tests_not_long_imapsync_version_public()' ) ;
	return ;
}

sub check_last_release
{
	my $fake = shift ;
        my $public_release = not_long_imapsync_version_public( $fake ) ;
        $sync->{ debug } and myprint( "check_last_release: [$public_release]\n" ) ;
        my $inline_help_when_on = '( Use --noreleasecheck to avoid this release check. )' ;

        if ( $public_release eq 'unknown' ) {
                return( 'Imapsync public release is unknown.' . $inline_help_when_on ) ;
        }

        if ( $public_release eq 'timeout' ) {
                return( 'Imapsync public release is unknown (timeout).' . $inline_help_when_on )  ;
        }

        if ( ! is_a_release_number( $public_release ) ) {
                return( "Imapsync public release is unknown ($public_release)." . $inline_help_when_on ) ;
        }

        my $imapsync_here  = imapsync_version( $sync ) ;

        if ( $public_release > $imapsync_here ) {
                return( 'This imapsync is not up to date. ' . "( local $imapsync_here < official $public_release )" . $inline_help_when_on ) ;
        }else{
                return( 'This imapsync is up to date. ' . "( local $imapsync_here >= official $public_release )" . $inline_help_when_on ) ;
        }

	return( 'really unknown' ) ; # Should never arrive here
}

sub tests_check_last_release
{
	note( 'Entering tests_check_last_release()' ) ;

	diag( check_last_release( 1.1 ) ) ;
        # \Q \E here to avoid putting \ before each space
	like( check_last_release( 1.1 ), qr/\Qis up to date\E/mxs, 'check_last_release: up to date' ) ;
	like( check_last_release( 1.1 ), qr/1\.1/mxs, 'check_last_release: up to date, include number' ) ;
	diag( check_last_release( 999.999 ) ) ;
	like( check_last_release( 999.999 ), qr/\Qnot up to date\E/mxs, 'check_last_release: not up to date' ) ;
	like( check_last_release( 999.999 ), qr/999\.999/mxs, 'check_last_release: not up to date, include number' ) ;
	like( check_last_release( 'unknown' ), qr/\QImapsync public release is unknown\E/mxs,           'check_last_release: unknown' ) ;
	like( check_last_release( 'timeout' ), qr/\QImapsync public release is unknown (timeout)\E/mxs, 'check_last_release: timeout' ) ;
	like( check_last_release( 'lalala' ),  qr/\QImapsync public release is unknown (lalala)\E/mxs,  'check_last_release: lalala' ) ;
	diag( check_last_release(  ) ) ;

	note( 'Leaving  tests_check_last_release()' ) ;
	return ;
}

sub imapsync_version
{
        my $mysync = shift ;
        my $rcs = $mysync->{rcs} ;
        my $version ;

        $version = version_from_rcs( $rcs ) ;
        return( $version ) ;
}


sub tests_version_from_rcs
{
	note( 'Entering tests_version_from_rcs()' ) ;

	is( undef, version_from_rcs(  ), 'version_from_rcs: no args => UNKNOWN' ) ;
	is( 1.831, version_from_rcs( q{imapsync,v 1.831 2017/08/27} ), 'version_from_rcs: imapsync,v 1.831 2017/08/27 => 1.831' ) ;
	is( 'UNKNOWN', version_from_rcs( 1.831 ), 'version_from_rcs:  1.831  => UNKNOWN' ) ;

	note( 'Leaving  tests_version_from_rcs()' ) ;
	return ;
}


sub version_from_rcs
{

        my $rcs = shift ;
        if ( ! $rcs ) { return ; }

        my $version = 'UNKNOWN' ;

        if ( $rcs =~ m{,v\s+(\d+\.\d+)}mxso ) {
                $version = $1
        }

        return( $version ) ;
}


sub tests_imapsync_basename
{
	note( 'Entering tests_imapsync_basename()' ) ;

        ok( imapsync_basename() =~ m/imapsync/, 'imapsync_basename: match imapsync');
        ok( 'blabla'   ne imapsync_basename(), 'imapsync_basename: do not equal blabla');

	note( 'Leaving  tests_imapsync_basename()' ) ;
        return ;
}

sub imapsync_basename
{

        return basename( $PROGRAM_NAME ) ;

}


sub localhost_info
{
        my $mysync = shift ;
        my( $infos ) = join( q{},
                "Here is imapsync ", imapsync_version( $mysync ),
                " on host " . hostname(),
                ", a $OSNAME system with ",
                ram_memory_info(  ),
                "\n",
                'with Perl ',
                mysprintf( '%vd ', $PERL_VERSION),
                "and Mail::IMAPClient $Mail::IMAPClient::VERSION",
             ) ;
        return( $infos ) ;
}

sub tests_cpu_number
{
	note( 'Entering tests_cpu_number()' ) ;

        is( 1, is_an_integer( cpu_number(  ) ), "cpu_number: is_an_integer" ) ;
	ok( 1 <= cpu_number(  ), "cpu_number: 1 or more" ) ;
        is( 1, cpu_number( 1 ), "cpu_number: 1 => 1" ) ;
        is( 1, cpu_number( $MINUS_ONE ), "cpu_number: -1 => 1" ) ;
        is( 1, cpu_number( 'lalala' ), "cpu_number: lalala => 1" ) ;
        is( $NUMBER_42, cpu_number( $NUMBER_42 ), "cpu_number: $NUMBER_42 => $NUMBER_42" ) ;
        note( 'Leaving  tests_cpu_number()' ) ;
	return ;
}

sub cpu_number
{

        my $cpu_number_forced = shift ;
	# Well, here 1 is better than 0 or undef
	my $cpu_number = 1 ; # Default value, erased if better found

        my @cpuinfo ;
	if ( $ENV{"NUMBER_OF_PROCESSORS"} ) {
		# might be under a Windows system
		$cpu_number = $ENV{"NUMBER_OF_PROCESSORS"} ;
		$sync->{ debug } and myprint( "Number of processors found by env var NUMBER_OF_PROCESSORS: $cpu_number\n" ) ;
	}elsif ( 'darwin' eq $OSNAME or 'freebsd' eq $OSNAME ) {
		$cpu_number = backtick( "sysctl -n hw.ncpu" ) ;
		chomp( $cpu_number ) ;
                $sync->{ debug } and myprint( "Number of processors found by cmd 'sysctl -n hw.ncpu': $cpu_number\n" ) ;
	}elsif ( ! -e '/proc/cpuinfo' ) {
		$sync->{ debug } and myprint( "Number of processors not found so I might assume there is only 1\n" ) ;
		$cpu_number = 1 ;
	}elsif( @cpuinfo = file_to_array( '/proc/cpuinfo' ) ) {
                $cpu_number = grep { /^processor/mxs } @cpuinfo ;
                $sync->{ debug } and myprint( "Number of processors found via /proc/cpuinfo: $cpu_number\n" ) ;
	}

        if ( defined $cpu_number_forced ) {
                $cpu_number = $cpu_number_forced ;
        }
	return( integer_or_1( $cpu_number ) ) ;
}


sub tests_integer_or_1
{
        note( 'Entering tests_integer_or_1()' ) ;

        is( 1, integer_or_1(  ), 'integer_or_1: no args => 1' ) ;
        is( 1, integer_or_1( undef ), 'integer_or_1: undef => 1' ) ;
        is( $NUMBER_10, integer_or_1( $NUMBER_10 ), 'integer_or_1: 10 => 10' ) ;
        is( 1, integer_or_1( q{} ), 'integer_or_1: empty string => 1' ) ;
        is( 1, integer_or_1( 'lalala' ), 'integer_or_1: lalala => 1' ) ;

        note( 'Leaving  tests_integer_or_1()' ) ;
        return ;
}

sub integer_or_1
{
        my $number = shift ;
        if ( is_an_integer( $number  ) ) {
                return $number ;
        }
        # else
        return 1 ;
}

sub tests_is_an_integer
{
	note( 'Entering tests_is_an_integer()' ) ;

        is( undef, is_an_integer(  ), 'is_an_integer: no args => undef ' ) ;
        ok( is_an_integer( 1 ), 'is_an_integer: 1 => yes ') ;
        ok( is_an_integer( $NUMBER_42 ), 'is_an_integer: 42 => yes ') ;
        ok( is_an_integer( "$NUMBER_42" ), 'is_an_integer: "$NUMBER_42" => yes ') ;
        ok( is_an_integer( '42' ), 'is_an_integer: "42" => yes ') ;
        ok( is_an_integer( $NUMBER_104_857_600 ), 'is_an_integer: 104_857_600 => yes') ;
        ok( is_an_integer( "$NUMBER_104_857_600" ), 'is_an_integer: "$NUMBER_104_857_600" => yes') ;
        ok( is_an_integer( '104857600' ), 'is_an_integer: 104857600 => yes') ;
        ok( ! is_an_integer( 'blabla' ), 'is_an_integer: blabla => no' ) ;
        ok( ! is_an_integer( q{} ), 'is_an_integer: empty string => no' ) ;

	note( 'Leaving  tests_is_an_integer()' ) ;
        return ;
}

sub is_an_integer
{
        my $number = shift ;
        if ( ! defined $number ) { return ; }
        return( $number =~ m{^\d+$}xo ) ;
}




sub tests_loadavg
{
	note( 'Entering tests_loadavg()' ) ;


	SKIP: {
		skip( 'Tests for darwin', 2 ) if ('darwin' ne $OSNAME) ;
		is( undef, loadavg( '/noexist' ), 'loadavg: /noexist => undef' ) ;
		is_deeply( [ '0.11', '0.22', '0.33' ],
		[ loadavg( 'W/t/loadavg.out' ) ],
		'loadavg W/t/loadavg.out => 0.11 0.22 0.33' ) ;
	} ;

	SKIP: {
		skip( 'Tests for linux', 3 ) if ('linux' ne $OSNAME) ;
		is( undef, loadavg( '/noexist' ), 'loadavg: /noexist => undef' ) ;
		ok( loadavg( ), 'loadavg: no args' ) ;

		is_deeply( [ '0.39', '0.30', '0.37', '1/602' ],
		[ loadavg( '0.39 0.30 0.37 1/602 6073' ) ],
		'loadavg 0.39 0.30 0.37 1/602 6073 => [0.39, 0.30, 0.37, 1/602]' ) ;
	} ;

	SKIP: {
		skip( 'Tests for Windows', 1 ) if ('MSWin32' ne $OSNAME) ;
		is_deeply( [ 0 ],
		[ loadavg( ) ],
		'loadavg on MSWin32 => 0' ) ;

	} ;

	note( 'Leaving  tests_loadavg()' ) ;
	return ;
}


sub loadavg
{
	if ( 'linux' eq $OSNAME ) {
		return ( loadavg_linux( @ARG ) ) ;
	}
	if ( 'freebsd' eq $OSNAME ) {
		return ( loadavg_freebsd( @ARG ) ) ;
	}
	if ( 'darwin' eq $OSNAME ) {
		return ( loadavg_darwin( @ARG ) ) ;
	}
	if ( 'MSWin32' eq $OSNAME ) {
		return ( loadavg_windows( @ARG ) ) ;
	}
	return( 'unknown' ) ;

}

sub loadavg_linux
{
	my $line = shift ;

	if ( ! $line ) {
                $line = firstline( '/proc/loadavg'  ) or return ;
	}

	my ( $avg_1_min, $avg_5_min, $avg_15_min, $current_runs ) = split /\s/mxs, $line ;
	if ( all_defined( $avg_1_min, $avg_5_min, $avg_15_min ) ) {
		$sync->{ debug } and myprint( "System load: $avg_1_min $avg_5_min $avg_15_min $current_runs\n" ) ;
		return ( $avg_1_min, $avg_5_min, $avg_15_min, $current_runs ) ;
	}
	return ;
}

sub loadavg_freebsd
{
	my $file = shift ;
	# Example of output of command "sysctl vm.loadavg":
	# vm.loadavg: { 0.15 0.08 0.08 }
	my $loadavg ;

	if ( ! defined $file ) {
		eval {
			$loadavg = `/sbin/sysctl vm.loadavg` ;
			#myprint( "LOADAVG FREEBSD: $loadavg\n" ) ;
		} ;
		if ( $EVAL_ERROR ) { myprint( "[$EVAL_ERROR]\n" ) ; return ; }
	}else{
		$loadavg = firstline( $file ) or return ;
	}

	my ( $avg_1_min, $avg_5_min, $avg_15_min )
	= $loadavg =~ /vm\.loadavg\s*[:=]\s*\{?\s*(\d+\.?\d*)\s+(\d+\.?\d*)\s+(\d+\.?\d*)/mxs ;
	$sync->{ debug } and myprint( "System load: $avg_1_min $avg_5_min $avg_15_min\n" ) ;
	return ( $avg_1_min, $avg_5_min, $avg_15_min ) ;
}

sub loadavg_darwin
{
	my $file = shift ;
	# Example of output of command "sysctl vm.loadavg":
	# vm.loadavg: { 0.15 0.08 0.08 }
	my $loadavg ;

	if ( ! defined $file ) {
		eval {
			$loadavg = `/usr/sbin/sysctl vm.loadavg` ;
			#myprint( "LOADAVG DARWIN: $loadavg\n" ) ;
		} ;
		if ( $EVAL_ERROR ) { myprint( "[$EVAL_ERROR]\n" ) ; return ; }
	}else{
		$loadavg = firstline( $file ) or return ;
	}

	my ( $avg_1_min, $avg_5_min, $avg_15_min )
	= $loadavg =~ /vm\.loadavg\s*[:=]\s*\{?\s*(\d+\.?\d*)\s+(\d+\.?\d*)\s+(\d+\.?\d*)/mxs ;
	$sync->{ debug } and myprint( "System load: $avg_1_min $avg_5_min $avg_15_min\n" ) ;
	return ( $avg_1_min, $avg_5_min, $avg_15_min ) ;
}

sub loadavg_windows
{
	my $file = shift ;
	# Example of output of command "wmic cpu get loadpercentage":
	# LoadPercentage
        # 12
	my $loadavg ;

	if ( ! defined $file ) {
		eval {
			#$loadavg = `CMD wmic cpu get loadpercentage` ;
			$loadavg = "LoadPercentage\n0\n" ;
			#myprint( "LOADAVG WIN: $loadavg\n" ) ;
		} ;
		if ( $EVAL_ERROR ) { myprint( "[$EVAL_ERROR]\n" ) ; return ; }
	}else{
		$loadavg = file_to_string( $file ) or return ;
		#myprint( "$loadavg" ) ;
	}
	$loadavg =~ /LoadPercentage\n(\d+)/xms ;
	my $num = $1 ;
	$num /= 100 ;

	$sync->{ debug } and myprint( "System load: $num\n" ) ;
	return ( $num ) ;
}






sub tests_load_and_delay
{
	note( 'Entering tests_load_and_delay()' ) ;

	is( undef, load_and_delay(  ), 'load_and_delay: no args => undef ' ) ;
	is( undef, load_and_delay( 1 ), 'load_and_delay: not 4 args => undef ' ) ;
	is( undef, load_and_delay( 0, 1, 1, 1 ), 'load_and_delay: division per 0 => undef ' ) ;
	is(  0, load_and_delay( 1, 1, 1, 1 ), 'load_and_delay: one core, loads are all 1 => ok ' ) ;
	is(  0, load_and_delay( 1, 1, 1, 1, 'lalala' ), 'load_and_delay: five arguments is ok' ) ;
	is(  0, load_and_delay( 2, 2, 2, 2 ), 'load_and_delay: two core, loads are all 2 => ok ' ) ;
	is(  0, load_and_delay( 2, 2, 4, 5 ), 'load_and_delay: two core, load1m     is 2 => ok ' ) ;

# Old behavior, rather strict
        # is(  0, load_and_delay( 1, 0, 0, 0 ), 'load_and_delay: one core, load1m=0 load5m=0 load15m=0 => 0 ' ) ;
	# is(  0, load_and_delay( 1, 0, 0, 2 ), 'load_and_delay: one core, load1m=0 load5m=0 load15m=2 => 0 ' ) ;
	# is(  0, load_and_delay( 1, 0, 2, 0 ), 'load_and_delay: one core, load1m=0 load5m=2 load15m=0 => 0 ' ) ;
	# is(  0, load_and_delay( 1, 0, 2, 2 ), 'load_and_delay: one core, load1m=0 load5m=2 load15m=2 => 0 ' ) ;
	# is(  1, load_and_delay( 1, 2, 0, 0 ), 'load_and_delay: one core, load1m=2 load5m=0 load15m=0 => 1 ' ) ;
	# is(  1, load_and_delay( 1, 2, 0, 2 ), 'load_and_delay: one core, load1m=2 load5m=0 load15m=2 => 1 ' ) ;
	# is(  5, load_and_delay( 1, 2, 2, 0 ), 'load_and_delay: one core, load1m=2 load5m=2 load15m=0 => 5 ' ) ;
	# is( 15, load_and_delay( 1, 2, 2, 2 ), 'load_and_delay: one core, load1m=2 load5m=2 load15m=2 => 15 ' ) ;

	# is(  0, load_and_delay( 4, 0, 2, 2 ), 'load_and_delay: four core, load1m=0 load5m=2 load15m=2 => 0 ' ) ;
	# is(  1, load_and_delay( 4, 8, 0, 0 ), 'load_and_delay: four core, load1m=2 load5m=0 load15m=0 => 1 ' ) ;
	# is(  1, load_and_delay( 4, 8, 0, 2 ), 'load_and_delay: four core, load1m=2 load5m=0 load15m=2 => 1 ' ) ;
	# is(  5, load_and_delay( 4, 8, 8, 0 ), 'load_and_delay: four core, load1m=2 load5m=2 load15m=0 => 5 ' ) ;
	# is( 15, load_and_delay( 4, 8, 8, 8 ), 'load_and_delay: four core, load1m=2 load5m=2 load15m=2 => 15 ' ) ;

# New behavior, tolerate more load

        is(  0, load_and_delay( 1, 0, 0, 0 ), 'load_and_delay: one core, load1m=0 load5m=0 load15m=0 => 0 ' ) ;
        is(  0, load_and_delay( 1, 0, 0, 2 ), 'load_and_delay: one core, load1m=0 load5m=0 load15m=2 => 0 ' ) ;
        is(  0, load_and_delay( 1, 0, 2, 0 ), 'load_and_delay: one core, load1m=0 load5m=2 load15m=0 => 0 ' ) ;
        is(  0, load_and_delay( 1, 0, 2, 2 ), 'load_and_delay: one core, load1m=0 load5m=2 load15m=2 => 0 ' ) ;
        is(  0, load_and_delay( 1, 2, 0, 0 ), 'load_and_delay: one core, load1m=2 load5m=0 load15m=0 => 1 ' ) ;
        is(  0, load_and_delay( 1, 2, 0, 2 ), 'load_and_delay: one core, load1m=2 load5m=0 load15m=2 => 1 ' ) ;
        is(  0, load_and_delay( 1, 2, 2, 0 ), 'load_and_delay: one core, load1m=2 load5m=2 load15m=0 => 5 ' ) ;
        is(  0, load_and_delay( 1, 2, 2, 2 ), 'load_and_delay: one core, load1m=2 load5m=2 load15m=2 => 15 ' ) ;

        is(  1, load_and_delay( 1, 4, 0, 0 ), 'load_and_delay: one core, load1m=4 load5m=0 load15m=0 => 1 ' ) ;
        is(  1, load_and_delay( 1, 4, 0, 4 ), 'load_and_delay: one core, load1m=4 load5m=0 load15m=4 => 1 ' ) ;
        is(  5, load_and_delay( 1, 4, 4, 0 ), 'load_and_delay: one core, load1m=4 load5m=4 load15m=0 => 5 ' ) ;
        is( 15, load_and_delay( 1, 4, 4, 4 ), 'load_and_delay: one core, load1m=4 load5m=4 load15m=4 => 15 ' ) ;

        is(  0, load_and_delay( 4, 0, 9, 9 ), 'load_and_delay: four core, load1m=0 load5m=9 load15m=9 => 0 ' ) ;
        is(  1, load_and_delay( 4, 9, 0, 0 ), 'load_and_delay: four core, load1m=9 load5m=0 load15m=0 => 1 ' ) ;
        is(  1, load_and_delay( 4, 9, 0, 9 ), 'load_and_delay: four core, load1m=9 load5m=0 load15m=9 => 1 ' ) ;
        is(  5, load_and_delay( 4, 9, 9, 0 ), 'load_and_delay: four core, load1m=9 load5m=9 load15m=0 => 5 ' ) ;
        is( 15, load_and_delay( 4, 9, 9, 9 ), 'load_and_delay: four core, load1m=9 load5m=9 load15m=9 => 15 ' ) ;

        note( 'Leaving  tests_load_and_delay()' ) ;
        return ;
}

sub load_and_delay
{
	# Basically return 0 if load is not heavy, ie <= 1 per processor

        # Not enough arguments
	if ( 4 > scalar @ARG ) { return ; }

	my ( $cpu_num, $avg_1_min, $avg_5_min, $avg_15_min ) = @ARG ;

	if ( 0 == $cpu_num ) { return ; }

	# Let divide by number of cores
	( $avg_1_min, $avg_5_min, $avg_15_min ) = map { $_ / $cpu_num } ( $avg_1_min, $avg_5_min, $avg_15_min ) ;
	# One of avg ok => ok, for now it is a OR
	if ( $avg_1_min <= 2 ) { return 0 ; }
	if ( $avg_5_min <= 2 ) { return 1 ; } # Retry in 1 minute
	if ( $avg_15_min <= 2 ) { return 5 ; } # Retry in 5 minutes
	return 15 ; # Retry in 15 minutes
}

sub ram_memory_info
{
        # In GigaBytes so division by 1024 * 1024 * 1024
	#
	return(
		sprintf( "%.1f/%.1f free GiB of RAM",
                Sys::MemInfo::get("freemem") / ( $KIBI ** 3 ),
                Sys::MemInfo::get("totalmem") / ( $KIBI ** 3 ),
                )
	) ;
}



sub tests_memory_stress
{
        note( 'Entering tests_memory_stress()' ) ;

        is( undef, memory_stress(  ), 'memory_stress: => undef' ) ;

        note( 'Leaving  tests_memory_stress()' ) ;
        return ;
}

sub memory_stress
{

        my $total_ram_in_MB = Sys::MemInfo::get("totalmem") / ( $KIBI * $KIBI ) ;
        my $i = 1 ;

        myprintf("Stress memory consumption before: %.1f MiB\n", memory_consumption(  ) / $KIBI / $KIBI ) ;
        while ( $i < $total_ram_in_MB / 1.7 ) { $a .= "A" x 1000_000; $i++ } ;
        myprintf("Stress memory consumption after: %.1f MiB\n", memory_consumption(  ) / $KIBI / $KIBI ) ;
        return ;

}

sub tests_memory_consumption
{
	note( 'Entering tests_memory_consumption()' ) ;

        like( memory_consumption(  ),  qr{\d+}xms,'memory_consumption no args') ;
        like( memory_consumption( 1 ), qr{\d+}xms,'memory_consumption 1') ;
        like( memory_consumption( $PROCESS_ID ), qr{\d+}xms,"memory_consumption_of_pids $PROCESS_ID") ;

        like( memory_consumption_ratio(), qr{\d+}xms,   'memory_consumption_ratio' ) ;
        like( memory_consumption_ratio(1), qr{\d+}xms,  'memory_consumption_ratio 1' ) ;
        like( memory_consumption_ratio(10), qr{\d+}xms, 'memory_consumption_ratio 10' ) ;

        like( memory_consumption(), qr{\d+}xms, "memory_consumption\n" ) ;

	note( 'Leaving  tests_memory_consumption()' ) ;
        return ;
}

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

sub debugmemory
{
        my $mysync = shift ;
        if ( ! $mysync->{debugmemory} ) { return q{} ; }

        my $precision = shift ;
        return( mysprintf( "Memory consumption$precision: %.1f MiB\n", memory_consumption(  ) / $KIBI / $KIBI ) ) ;
}

sub memory_consumption_of_pids
{

        my @pid = @_;
        @pid = ( @pid ) ? @pid : ( $PROCESS_ID ) ;

        $sync->{ debug } and myprint( "memory_consumption_of_pids PIDs: @pid\n" ) ;
        my @val ;
        if ( ( 'MSWin32' eq $OSNAME ) or ( 'cygwin' eq $OSNAME ) ) {
                @val = memory_consumption_of_pids_win32( @pid ) ;
        }else{
                # Unix
                my @ps = qx{ ps -o vsz -p @pid } ;
                #myprint( "ps: @ps" ) ;

                # Use IPC::Open3 from perlcrit -3
                # It stalls on Darwin, don't understand why!
                #my @ps = backtick( "ps -o vsz -p @pid" ) ;
                #myprint( "ps: @ps" ) ;

                shift @ps; # First line is column name "VSZ"
                chomp @ps;
                # convert to octets

                @val = map { $_ * $KIBI } @ps ;
        }
        $sync->{ debug } and myprint( "@val\n" ) ;
        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 work 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' ) ;
        #myprint( "-" x $STD_CHAR_PER_LINE, "\n", @ps, "-" x $STD_CHAR_PER_LINE, "\n" ) ;
        my @val;
        foreach my $line (@ps) {
                my($name, $pid, $mem) = (split ',', $line )[0,1,4];
                next if (! $pid);
                #myprint( "[$name][$pid][$mem]" ) ;
                if ($PID{remove_qq($pid)}) {
                        #myprint( "MATCH !\n" ) ;
                        chomp $mem ;
                        $mem = remove_qq($mem);
                        $mem = remove_Ko($mem);
                        $mem = remove_not_num($mem);
                        #myprint( "[$mem]\n" ) ;
                        push @val, $mem * $KIBI;
                }
        }
        return(@val);
}


sub tests_backtick
{
	note( 'Entering tests_backtick()' ) ;

	is( undef, backtick( ), 'backtick: no args' ) ;
	is( undef, backtick( q{} ), 'backtick: empty command' ) ;

        SKIP: {
                skip( 'test for MSWin32', 5 ) if ('MSWin32' ne $OSNAME) ;
                my @output ;
                @output = backtick( 'echo Hello World!' ) ;
                # Add \r on Windows.
                ok( "Hello World!\r\n" eq $output[0], 'backtick: echo Hello World!' ) ;
                $sync->{ debug } and myprint( "[@output]" ) ;
                @output = backtick( 'echo Hello & echo World!' ) ;
                ok( "Hello \r\n" eq $output[0], 'backtick: echo Hello & echo World! line 1' ) ;
                ok( "World!\r\n" eq $output[1], 'backtick: echo Hello & echo World! line 2' ) ;
                $sync->{ debug } and myprint( "[@output][$output[0]][$output[1]]" ) ;
		# Scalar context
		ok( "Hello World!\r\n" eq backtick( 'echo Hello World!' ),
		'backtick: echo Hello World! scalar' ) ;
		ok( "Hello \r\nWorld!\r\n" eq backtick( 'echo Hello & echo World!' ),
		'backtick: echo Hello & echo World! scalar 2 lines' ) ;
        } ;
        SKIP: {
                skip( 'test for Unix', 7 ) if ('MSWin32' eq $OSNAME) ;
		is( undef, backtick( 'aaaarrrg' ), 'backtick: aaaarrrg command not found' ) ;
		# Array context
                my @output ;
                @output = backtick( 'echo Hello World!' ) ;
                ok( "Hello World!\n" eq $output[0], 'backtick: echo Hello World!' ) ;
                $sync->{ debug } and myprint( "[@output]" ) ;
                @output = backtick( "echo Hello\necho World!" ) ;
                ok( "Hello\n" eq $output[0], 'backtick: echo Hello; echo World! line 1' ) ;
                ok( "World!\n" eq $output[1], 'backtick: echo Hello; echo World! line 2' ) ;
                $sync->{ debug } and myprint( "[@output]" ) ;
		# Scalar context
		ok( "Hello World!\n" eq backtick( 'echo Hello World!' ),
		'backtick: echo Hello World! scalar' ) ;
		ok( "Hello\nWorld!\n" eq backtick( "echo Hello\necho World!" ),
		'backtick: echo Hello; echo World! scalar 2 lines' ) ;
		# Return error positive value, that's ok
		is( undef, backtick( 'false' ), 'backtick: false returns no output' ) ;
                my $mem = backtick( "ps -o vsz -p $PROCESS_ID" ) ;
                $sync->{ debug } and myprint( "MEM=$mem\n" ) ;

        }

	note( 'Leaving  tests_backtick()' ) ;
        return ;
}


sub backtick
{
        my $command = shift ;

	if ( ! $command ) { return ; }

        my ( $writer, $reader, $err ) ;
        my @output ;
        my $pid ;
	my $eval = eval {
		$pid = IPC::Open3::open3( $writer, $reader, $err, $command ) ;
	} ;
        if ( $EVAL_ERROR  ) {
                myprint( $EVAL_ERROR ) ;
                return ;
        }
        if ( ! $eval  ) { return ; }
	if ( ! $pid  )  { return ; }
	waitpid( $pid, 0 ) ;
        @output = <$reader>;  # Output here
	#
        #my @errors = <$err>;    #Errors here, instead of the console
	if ( not @output ) { return ; }
        #myprint( @output  ) ;

	if ( $output[0] =~ /\Qopen3: exec of $command failed\E/mxs ) { return ; }
	if ( wantarray ) {
		return( @output ) ;
	} else {
		return( join( q{}, @output) ) ;
	}
}



sub tests_check_binary_embed_all_dyn_libs
{
        note( 'Entering tests_check_binary_embed_all_dyn_libs()' ) ;

        is( 1, check_binary_embed_all_dyn_libs(  ),  'check_binary_embed_all_dyn_libs: no args => 1' ) ;

        note( 'Leaving  tests_check_binary_embed_all_dyn_libs()' ) ;

        return ;
}


sub check_binary_embed_all_dyn_libs
{
        my @search_dyn_lib_locale = search_dyn_lib_locale(  ) ;

        if ( @search_dyn_lib_locale )
        {
                myprint( "Found myself $PROGRAM_NAME pid $PROCESS_ID using locale dynamic libraries that seems out of myself:\n" ) ;
                myprint( @search_dyn_lib_locale ) ;
                if ( $PROGRAM_NAME =~ m{imapsync_bin_Darwin} )
                {
                        return 0 ;
                }
                elsif ( $PROGRAM_NAME =~ m{imapsync.*\.exe} )
                {
                        return 0 ;
                }
                else
                {
                        # is always ok for non binary
                        return 1 ;
                }
        }
        else
        {
                # Found only embedded dynamic lib
                myprint( "Found nothing\n" ) ;
                return 1 ;
        }
}

sub search_dyn_lib_locale
{
        if ( 'darwin' eq $OSNAME )
        {
                return search_dyn_lib_locale_darwin(  ) ;
        }
        if ( 'linux' eq $OSNAME )
        {
                return search_dyn_lib_locale_linux(  ) ;
        }
        if ( 'MSWin32' eq $OSNAME )
        {
                return search_dyn_lib_locale_MSWin32(  ) ;
        }
}

sub search_dyn_lib_locale_darwin
{
        my $command = qq{ lsof -p $PID | grep ' REG ' | grep .dylib | grep -v '/par-' } ;
        myprint( "Search non embeded dynamic libs with the command: $command\n" ) ;
        return backtick( $command ) ;
}

sub search_dyn_lib_locale_linux
{
        my $command = qq{ lsof -p $PID | grep ' REG ' | grep -v '/tmp/par-' | grep '\.so' } ;
        myprint( "Search non embeded dynamic libs with the command: $command\n" ) ;
        return backtick( $command ) ;
}

sub search_dyn_lib_locale_MSWin32
{
        my $command = qq{ Listdlls.exe $PID|findstr Strawberry } ;
        # $command = qq{ Listdlls.exe $PID|findstr Strawberry } ;
        myprint( "Search non embeded dynamic libs with the command: $command\n" ) ;
        return qx( $command ) ;
}



sub remove_not_num
{

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

sub tests_remove_not_num
{
	note( 'Entering tests_remove_not_num()' ) ;

        ok( '123' eq remove_not_num( 123 ), 'remove_not_num( 123 )' ) ;
        ok( '123' eq remove_not_num( '123' ), q{remove_not_num( '123' )} ) ;
        ok( '123' eq remove_not_num( '12 3' ), q{remove_not_num( '12 3' )} ) ;
        ok( '123' eq remove_not_num( 'a 12 3 Ko' ), q{remove_not_num( 'a 12 3 Ko' )} ) ;

	note( 'Leaving  tests_remove_not_num()' ) ;
        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 date_from_rcs
{
        my $d = shift ;

        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 ) ;
        if ($d =~ m{(\d{4})/(\d{2})/(\d{2})\s(\d{2}):(\d{2}):(\d{2})}xo ) {
                # Handles the following format
                # 2015/07/10 11:05:59 -- Generated by RCS Date tag.
                #myprint( "$d\n" ) ;
                #myprint( "header: [$1][$2][$3][$4][$5][$6]\n" ) ;
                my ($year, $month, $day, $hour, $min, $sec) = ($1,$2,$3,$4,$5,$6) ;
                $month = $num2mon{$month} ;
                $d = "$day-$month-$year $hour:$min:$sec +0000" ;
                #myprint( "$d\n" ) ;
        }
        return( $d ) ;
}

sub tests_date_from_rcs
{
	note( 'Entering tests_date_from_rcs()' ) ;

        ok('19-Sep-2015 16:11:07 +0000'
        eq date_from_rcs('Date: 2015/09/19 16:11:07 '), 'date_from_rcs from RCS date' ) ;

	note( 'Leaving  tests_date_from_rcs()' ) ;
        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(q{}) if not defined $d;

        SWITCH: {
        if ( $d =~ m{(\d?)(\d-...-\d{4})(\s\d{2}:\d{2}:\d{2})(\s(?:\+|-)\d{4})?}xo ) {
                #myprint( "internal: [$1][$2][$3][$4]\n" ) ;
                my ($day_1, $date_rest, $hour, $zone) = ($1,$2,$3,$4) ;
                $day_1 = '0' if ($day_1 eq q{}) ;
                $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

                #myprint( "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  = mysprintf( '%02d', $day);
                $hour = mysprintf( '%02d', $hour);
                $min  = mysprintf( '%02d', $min);
                $sec  = '00' if not defined  $sec  ;
                $sec  = mysprintf( '%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

                #myprint( "header: [$1][$2][$3][$4][$5][$6]\n" ) ;
                my ($month, $day, $hour, $min, $sec, $year) = ($1,$2,$3,$4,$5,$6);
                $day  = mysprintf( '%02d', $day  ) ;
                $hour = mysprintf( '%02d', $hour ) ;
                $min  = mysprintf( '%02d', $min  ) ;
                $sec  = mysprintf( '%02d', $sec  ) ;
                $d    = "$day-$month-$year $hour:$min:$sec +0000" ;
                last SWITCH ;
        }
        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 ) ;

        if ($d =~ m{(\d{4})/(\d{2})/(\d{2})\s(\d{2}):(\d{2}):(\d{2})}xo ) {
                # Handles the following format
                # 2015/07/10 11:05:59 -- Generated by RCS Date tag.
                #myprint( "$d\n" ) ;
                #myprint( "header: [$1][$2][$3][$4][$5][$6]\n" ) ;
                my ($year, $month, $day, $hour, $min, $sec) = ($1,$2,$3,$4,$5,$6) ;
                $month = $num2mon{$month} ;
                $d = "$day-$month-$year $hour:$min:$sec +0000" ;
                #myprint( "$d\n" ) ;
                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

                #myprint( "header: [$1][$2][$3][$4][$5][$6]\n" ) ;
                my ($month, $day, $year, $hour, $min, $sec) = ($1,$2,$3,$4,$5,$6);
                $year = '20' . $year;
                $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 = mysprintf( '%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 = mysprintf( '%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 = mysprintf( '%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
{
	note( 'Entering tests_good_date()' ) ;

        ok(q{} 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)');
        ok('"19-Sep-2015 16:11:07 +0000"' eq good_date('Date: 2015/09/19 16:11:07 '), 'good_date from RCS date' ) ;

	note( 'Leaving  tests_good_date()' ) ;
        return ;
}


sub tests_list_keys_in_2_not_in_1
{
	note( 'Entering 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}');

	note( 'Leaving  tests_list_keys_in_2_not_in_1()' ) ;
        return ;
}

sub list_keys_in_2_not_in_1
{
        my $hash_1_ref = shift;
        my $hash_2_ref = shift;
        my @list;

        foreach my $key ( sort keys %{ $hash_2_ref } ) {
                #$debug and print "$folder\n" ;
                next if exists $hash_1_ref->{$key} ;
                push @list, $key ;
        }
        #$debug and print "@list\n" ;
        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 tests_nb_messages_in_2_not_in_1
{
        note( 'Entering tests_stats_across_folders()' ) ;
        is( undef, nb_messages_in_2_not_in_1(  ), 'nb_messages_in_2_not_in_1: no args => undef' ) ;

        my $mysync->{ h1_folders_of_md5 }->{ 'some_id_01' }->{ 'some_folder_01' } = 1 ;
        is( 0, nb_messages_in_2_not_in_1( $mysync ), 'nb_messages_in_2_not_in_1: no messages in 2 => 0' ) ;

        $mysync->{ h1_folders_of_md5 }->{ 'some_id_in_1_and_2' }->{ 'some_folder_01' } = 2 ;
        $mysync->{ h2_folders_of_md5 }->{ 'some_id_in_1_and_2' }->{ 'some_folder_02' } = 4 ;

        is( 0, nb_messages_in_2_not_in_1( $mysync ), 'nb_messages_in_2_not_in_1: a common message => 0' ) ;

        $mysync->{ h2_folders_of_md5 }->{ 'some_id_in_2_not_in_1' }->{ 'some_folder_02' } = 1 ;
        is( 1, nb_messages_in_2_not_in_1( $mysync ), 'nb_messages_in_2_not_in_1: one message in_2_not_in_1 => 1' ) ;

        $mysync->{ h2_folders_of_md5 }->{ 'some_other_id_in_2_not_in_1' }->{ 'some_folder_02' } = 3 ;
        is( 2, nb_messages_in_2_not_in_1( $mysync ), 'nb_messages_in_2_not_in_1: two messages in_2_not_in_1 => 2' ) ;

        note( 'Leaving  tests_stats_across_folders()' ) ;
        return ;
}

sub nb_messages_in_2_not_in_1
{
        my $mysync = shift ;
        if ( not defined $mysync ) { return ; }

        $mysync->{ nb_messages_in_2_not_in_1 } = scalar(
                list_keys_in_2_not_in_1(
                        $mysync->{ h1_folders_of_md5 },
                        $mysync->{ h2_folders_of_md5 } ) ) ;

        return $mysync->{ nb_messages_in_2_not_in_1 } ;
}


sub nb_messages_in_1_not_in_2
{
        my $mysync = shift ;
        if ( not defined $mysync ) { return ; }

        $mysync->{ nb_messages_in_1_not_in_2 }  = scalar(
                list_keys_in_2_not_in_1(
                        $mysync->{ h2_folders_of_md5 },
                        $mysync->{ h1_folders_of_md5 } ) ) ;

        return $mysync->{ nb_messages_in_1_not_in_2 }  ;
}



sub comment_on_final_diff_in_1_not_in_2
{
        my $mysync = shift ;

        if ( not defined $mysync
             or $mysync->{ justfolders }
             or $mysync->{ useuid }
        )
        {
                return ;
        }

        my $nb_identified_h1_messages = scalar( keys %{ $mysync->{ h1_folders_of_md5 } } ) ;
        my $nb_identified_h2_messages = scalar( keys %{ $mysync->{ h2_folders_of_md5 } } ) ;
        $mysync->{ debug } and myprint( "nb_keys h1_folders_of_md5 $nb_identified_h1_messages\n" ) ;
        $mysync->{ debug } and myprint( "nb_keys h2_folders_of_md5 $nb_identified_h2_messages\n" ) ;

        if ( 0 == $nb_identified_h1_messages ) { return ; }

        # Calculate if not yet done
        if ( not defined $mysync->{ nb_messages_in_1_not_in_2 } )
        {
                nb_messages_in_1_not_in_2( $mysync ) ;
        }


        if ( 0 == $mysync->{ nb_messages_in_1_not_in_2 } )
        {
                myprint( "The sync looks good, all $nb_identified_h1_messages identified messages in host1 are on host2.\n" ) ;
        }
        else
        {
                myprint( "The sync is not finished, there are $mysync->{ nb_messages_in_1_not_in_2 } identified messages in host1 that are not on host2.\n" ) ;
        }

        if ( 1 <= $mysync->{ h1_nb_msg_noheader } )
        {
                myprint( "There are $mysync->{ h1_nb_msg_noheader } unidentified messages (usually Sent or Draft messages). To sync them add option --addheader\n" ) ;
        }

        return ;
}

sub comment_on_final_diff_in_2_not_in_1
{
        my $mysync = shift ;

        if ( not defined $mysync
             or $mysync->{ justfolders }
             or $mysync->{ useuid }
        )
        {
                return ;
        }

        my $nb_identified_h2_messages = scalar( keys %{ $mysync->{ h2_folders_of_md5 } } ) ;
        # Calculate if not yet done
        if ( not defined $mysync->{ nb_messages_in_2_not_in_1 } )
        {
                nb_messages_in_2_not_in_1( $mysync ) ;
        }

        if ( 0 == $mysync->{ nb_messages_in_2_not_in_1 } )
        {
                myprint( "The sync is strict,  all $nb_identified_h2_messages identified messages in host2 are on host1.\n" ) ;
        }
        else
        {
                myprint( "The sync is not strict, there are ",
                        $mysync->{ nb_messages_in_2_not_in_1 },
                        " messages in host2 that are not on host1.",
                        " Use --delete2 to delete them and have a strict sync.\n" ) ;
        }
        return ;
}


sub tests_match
{
        note( 'Entering tests_match()' ) ;

        # undef serie
        is( undef, match(  ), 'match: no args => undef' ) ;
        is( undef, match( 'lalala' ), 'match: one args => undef' ) ;

        # This one gives 0 under a binary made by pp
        # but 1 under "normal" Perl interpreter. So a PAR bug?
        #is( 1, match( q{}, q{} ),                'match: q{}      =~ q{}      => 1' ) ;

        is( 'lalala', match( 'lalala', 'lalala' ),      'match: lalala   =~ lalala => lalala' ) ;
        is( 'lalala', match( 'lalala', '^lalala' ),     'match: lalala   =~ ^lalala  => lalala' ) ;
        is( 'lalala', match( 'lalala',  'lalala$' ),    'match: lalala   =~ lalala$  => lalala' ) ;
        is( 'lalala', match( 'lalala', '^lalala$' ),    'match: lalala   =~ ^lalala$ => lalala' ) ;
        is( '_lalala_', match( '_lalala_', 'lalala' ),    'match: _lalala_ =~ lalala   => _lalala_' ) ;
        is( 'lalala', match( 'lalala', '.*' ),          'match: lalala   =~ .*       => lalala' ) ;
        is( 'lalala', match( 'lalala', '.' ),           'match: lalala   =~ .        => lalala' ) ;
        is( '/lalala/', match( '/lalala/', '/lalala/' ),  'match: /lalala/ =~ /lalala/ => /lalala/' ) ;

        is( 0, match( 'foo', 's/foo/bar/g' ),  'match: foo =~ s/foo/bar/g => 0' ) ;
        is( 's/foo/bar/g', match( 's/foo/bar/g', 's/foo/bar/g' ),  'match: s/foo/bar/g =~ s/foo/bar/g => s/foo/bar/g' ) ;


        is( 0, match( 'lalala', 'ooo' ),         'match: lalala   =~ ooo      => 0' ) ;
        is( 0, match( 'lalala', 'lal_ala' ),     'match: lalala   =~ lal_ala  => 0' ) ;
        is( 0, match( 'lalala', '\.' ),          'match: lalala   =~ \.       => 0' ) ;
        is( 0, match( 'lalalaX', '^lalala$' ),   'match: lalalaX  =~ ^lalala$ => 0' ) ;
        is( 0, match( 'lalala', '/lalala/' ),    'match: lalala   =~ /lalala/ => 0' ) ;

	is( 'LALALA', match( 'LALALA', '(?i:lalala)' ),           'match: LALALA   =~ (?i:lalala) => 1' ) ;

	is( undef, match( 'LALALA', '(?{`ls /`})' ),       'match: LALALA   =~ (?{`ls /`})       => undef' ) ;
	is( undef, match( 'LALALA', '(?{print "CACA"})' ), 'match: LALALA   =~ (?{print "CACA"}) => undef' ) ;
	is( undef, match( 'CACA', '(??{print "CACA"})' ),  'match: CACA     =~ (??{print "CACA"}) => undef' ) ;

	note( 'Leaving  tests_match()' ) ;

	return ;
}

sub match
{
	my( $var, $regex ) = @ARG ;

	# undef cases
	if ( ( ! defined $var ) or ( ! defined $regex ) ) { return ; }

	# normal cases
	if ( eval { $var =~ qr{$regex} } ) {
		return $var ;
	}elsif ( $EVAL_ERROR ) {
		myprint( "Fatal regex $regex\n" ) ;
		return ;
	} else {
		return 0 ;
	}
	return ;
}


sub tests_notmatch
{
	note( 'Entering tests_notmatch()' ) ;

	# undef serie
	is( undef, notmatch(  ), 'notmatch: no args => undef' ) ;
	is( undef, notmatch( 'lalala' ), 'notmatch: one args => undef' ) ;

	is( 1, notmatch( 'lalala', '/lalala/' ),   'notmatch: lalala   !~ /lalala/ => 1' ) ;
	is( 0, notmatch( '/lalala/', '/lalala/' ), 'notmatch: /lalala/ !~ /lalala/ => 0' ) ;
	is( 1, notmatch( 'lalala', '/ooo/' ),      'notmatch: lalala   !~ /ooo/    => 1' ) ;

	# This one gives 1 under a binary made by pp
	# but 0 under "normal" Perl interpreter. So a PAR bug, same in tests_match .
	#is( 0, notmatch( q{}, q{} ),             'notmatch: q{}      !~ q{}      => 0' ) ;

	is( 0, notmatch( 'lalala', 'lalala' ),   'notmatch: lalala   !~ lalala   => 0' ) ;
	is( 0, notmatch( 'lalala', '^lalala' ),  'notmatch: lalala   !~ ^lalala  => 0' ) ;
	is( 0, notmatch( 'lalala',  'lalala$' ), 'notmatch: lalala   !~ lalala$  => 0' ) ;
	is( 0, notmatch( 'lalala', '^lalala$' ), 'notmatch: lalala   !~ ^lalala$ => 0' ) ;
	is( 0, notmatch( '_lalala_', 'lalala' ), 'notmatch: _lalala_ !~ lalala   => 0' ) ;
	is( 0, notmatch( 'lalala', '.*' ),       'notmatch: lalala   !~ .*       => 0' ) ;
	is( 0, notmatch( 'lalala', '.' ),        'notmatch: lalala   !~ .        => 0' ) ;


	is( 1, notmatch( 'lalala', 'ooo' ), 'notmatch: does not match regex => 1' ) ;
	is( 1, notmatch( 'lalala', 'lal_ala' ), 'notmatch: does not match regex => 1' ) ;
	is( 1, notmatch( 'lalala', '\.' ), 'notmatch: matches regex => 0' ) ;
	is( 1, notmatch( 'lalalaX', '^lalala$' ), 'notmatch: does not match regex => 1' ) ;

	note( 'Leaving  tests_notmatch()' ) ;

	return ;
}

sub notmatch
{
	my( $var, $regex ) = @ARG ;

	# undef cases
	if ( ( ! defined $var ) or ( ! defined $regex ) ) { return ; }

	# normal cases
	if ( eval { $var !~ $regex } ) {
		return 1 ;
	}elsif ( $EVAL_ERROR ) {
		myprint( "Fatal regex $regex\n" ) ;
		return ;
	}else{
		return 0 ;
	}
	return ;
}


sub delete_folders_in_2_not_in_1
{

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

sub delete_folder
{
        my ( $mysync, $imap, $folder, $Side ) = @_ ;
        if ( ! $mysync )   { return ; }
        if ( ! $imap )   { return ; }
        if ( ! $folder ) { return ; }
        $Side ||= 'HostX' ;

        my $res = $mysync->{dry} ; # always success in dry mode!
        if ( ! $mysync->{dry} ) {
                $imap->unsubscribe( $folder ) ;
                $res = $imap->delete( $folder ) ;
        }
        if ( $res ) {
                myprint( "$Side deleted $folder", $mysync->{dry_message}, "\n" ) ;
                return 1 ;
        }else{
                myprint( "$Side deleting $folder failed", "\n" ) ;
                return ;
        }
}

sub delete1emptyfolders
{
        my $mysync = shift ;
        if ( ! $mysync ) { return ; } # abort if no parameter
        if ( ! $mysync->{delete1emptyfolders} ) { return ; } # abort if --delete1emptyfolders off
        my $imap = $mysync->{imap1} ;
        if ( ! $imap ) { return ; } # abort if no imap
        if ( $imap->IsUnconnected(  ) ) { return ; } # abort if disconnected

        my %folders_kept ;
        myprint( qq{Host1 deleting empty folders\n} ) ;
        foreach my $folder ( reverse sort @{ $mysync->{h1_folders_wanted} } ) {
                my $parenthood = $imap->is_parent( $folder ) ;
                if ( defined $parenthood and $parenthood ) {
                        myprint( "Host1: folder $folder has subfolders\n" ) ;
                        $folders_kept{ $folder }++ ;
                        next ;
                }
                my $nb_messages_select = examine_folder_and_count( $mysync, $imap, $folder, 'Host1' ) ;
                if ( ! defined $nb_messages_select ) { next ; } # Select failed => Neither continue nor keep this folder }
                my $nb_messages_search = scalar( @{ $imap->messages(  ) } ) ;
                if ( 0 != $nb_messages_select and 0 != $nb_messages_search ) {
                        myprint( "Host1: folder $folder has messages: $nb_messages_search (search) $nb_messages_select (select)\n" ) ;
                        $folders_kept{ $folder }++ ;
                        next ;
                }
                if ( 0 != $nb_messages_select + $nb_messages_search ) {
                        myprint( "Host1: folder $folder odd messages count: $nb_messages_search (search) $nb_messages_select (select)\n" ) ;
                        $folders_kept{ $folder }++ ;
                        next ;
                }
                # Here we must have 0 messages by messages() aka "SEARCH ALL" and also "EXAMINE"
                if ( uc $folder eq 'INBOX' ) {
                        myprint( "Host1: Not deleting $folder\n" ) ;
                        $folders_kept{ $folder }++ ;
                        next ;
                }
                myprint( "Host1: deleting empty folder $folder\n" ) ;
                # can not delete a SELECTed or EXAMINEd folder so closing it
                # could changed be SELECT INBOX
                $imap->close(  ) ; # close after examine does not expunge; anyway expunging an empty folder...
                if ( delete_folder( $mysync, $imap, $folder, 'Host1' ) ) {
                        next ; # Deleted, good!
                }else{
                        $folders_kept{ $folder }++ ;
                        next ; # Not deleted, bad!
                }
        }
        remove_deleted_folders_from_wanted_list( $mysync, %folders_kept ) ;
        myprint( qq{Host1 ended deleting empty folders\n} ) ;
        return ;
}

sub remove_deleted_folders_from_wanted_list
{
        my ( $mysync, %folders_kept ) = @ARG ;

        my @h1_folders_wanted_init = @{ $mysync->{h1_folders_wanted} } ;
        my @h1_folders_wanted_last ;
        foreach my $folder ( @h1_folders_wanted_init ) {
                if ( $folders_kept{ $folder } ) {
                        push @h1_folders_wanted_last, $folder ;
                }
        }
        @{ $mysync->{h1_folders_wanted} } = @h1_folders_wanted_last ;
        return ;
}


sub examine_folder_and_count
{
        my ( $mysync, $imap, $folder, $Side ) = @_ ;
        $Side ||= 'HostX' ;

        if ( ! examine_folder( $mysync, $imap, $folder, $Side ) ) {
                return ;
        }
        my $nb_messages_select = count_from_select( $imap->History ) ;
        return $nb_messages_select ;
}


sub tests_delete1emptyfolders
{
	note( 'Entering tests_delete1emptyfolders()' ) ;


        is( undef, delete1emptyfolders(  ), q{delete1emptyfolders: undef} ) ;
        my $syncT ;
        is( undef, delete1emptyfolders( $syncT ), q{delete1emptyfolders: undef 2} ) ;
        my $imapT ;
        $syncT->{imap1} = $imapT ;
        is( undef, delete1emptyfolders( $syncT ), q{delete1emptyfolders: undef imap} ) ;

        require_ok( "Test::MockObject" ) ;
        $imapT = Test::MockObject->new(  ) ;
        $syncT->{imap1} = $imapT ;

        $imapT->set_true( 'IsUnconnected' ) ;
        is( undef, delete1emptyfolders( $syncT ), q{delete1emptyfolders: Unconnected imap} ) ;

        # Now connected tests
        $imapT->set_false( 'IsUnconnected' ) ;
        $imapT->mock( 'LastError', sub { q{LastError mocked} } ) ;

        $syncT->{delete1emptyfolders} = 0 ;
        tests_delete1emptyfolders_unit(
                $syncT,
                [ qw{ INBOX DELME1 DELME2 } ],
                [ qw{ INBOX DELME1 DELME2 } ],
                q{tests_delete1emptyfolders: --delete1emptyfolders OFF}
        ) ;

        # All are parents => no deletion at all
        $imapT->set_true( 'is_parent' ) ;
        $syncT->{delete1emptyfolders} = 1 ;
        tests_delete1emptyfolders_unit(
                $syncT,
                [ qw{ INBOX DELME1 DELME2 } ],
                [ qw{ INBOX DELME1 DELME2 } ],
                q{tests_delete1emptyfolders: --delete1emptyfolders ON}
        ) ;

        # No parents but examine false for all => skip all
        $imapT->set_false( 'is_parent', 'examine' ) ;

        tests_delete1emptyfolders_unit(
                $syncT,
                [ qw{ INBOX DELME1 DELME2 } ],
                [  ],
                q{tests_delete1emptyfolders: EXAMINE fails}
        ) ;

        # examine ok for all but History bad => skip all
        $imapT->set_true( 'examine' ) ;
        $imapT->mock( 'History', sub { ( q{History badly mocked} ) } ) ;
        tests_delete1emptyfolders_unit(
                $syncT,
                [ qw{ INBOX DELME1 DELME2 } ],
                [  ],
                q{tests_delete1emptyfolders: examine ok but History badly mocked so count messages fails}
        ) ;

        # History good but some messages EXISTS == messages() => no deletion
        $imapT->mock( 'History', sub { ( q{* 2 EXISTS} ) } ) ;
        $imapT->mock( 'messages', sub { [ qw{ UID_1 UID_2 } ] } ) ;
        tests_delete1emptyfolders_unit(
                $syncT,
                [ qw{ INBOX DELME1 DELME2 } ],
                [ qw{ INBOX DELME1 DELME2 } ],
                q{tests_delete1emptyfolders: History EXAMINE ok, several messages}
        ) ;

        # 0 EXISTS but != messages() => no deletion
        $imapT->mock( 'History', sub { ( q{* 0 EXISTS} ) } ) ;
        $imapT->mock( 'messages', sub { [ qw{ UID_1 UID_2 } ] } ) ;
        tests_delete1emptyfolders_unit(
                $syncT,
                [ qw{ INBOX DELME1 DELME2 } ],
                [ qw{ INBOX DELME1 DELME2 } ],
                q{tests_delete1emptyfolders: 0 EXISTS but 2 by messages()}
        ) ;

        # 1 EXISTS but != 0 == messages() => no deletion
        $imapT->mock( 'History', sub { ( q{* 1 EXISTS} ) } ) ;
        $imapT->mock( 'messages', sub { [ ] } ) ;
        tests_delete1emptyfolders_unit(
                $syncT,
                [ qw{ INBOX DELME1 DELME2 } ],
                [ qw{ INBOX DELME1 DELME2 } ],
                q{tests_delete1emptyfolders: 1 EXISTS but 0 by messages()}
        ) ;

        # 0 EXISTS and 0 == messages() => deletion except INBOX
        $imapT->mock( 'History', sub { ( q{* 0 EXISTS} ) } ) ;
        $imapT->mock( 'messages', sub { [ ] } ) ;
        $imapT->set_true( qw{ delete close unsubscribe } ) ;
        $syncT->{dry_message} = q{ (not really since in a mocked test)} ;
        tests_delete1emptyfolders_unit(
                $syncT,
                [ qw{ INBOX DELME1 DELME2 } ],
                [ qw{ INBOX } ],
                q{tests_delete1emptyfolders: 0 EXISTS 0 by messages() delete folders, keep INBOX}
        ) ;

	note( 'Leaving  tests_delete1emptyfolders()' ) ;
        return ;
}

sub tests_delete1emptyfolders_unit
{
	note( 'Entering tests_delete1emptyfolders_unit()' ) ;

        my $syncT  = shift ;
        my $folders1wanted_init_ref = shift ;
        my $folders1wanted_after_ref = shift ;
        my $comment = shift || q{delete1emptyfolders:} ;

        my @folders1wanted_init  = @{ $folders1wanted_init_ref } ;
        my @folders1wanted_after = @{ $folders1wanted_after_ref } ;

        @{ $syncT->{h1_folders_wanted} } = @folders1wanted_init ;

        is_deeply( $syncT->{h1_folders_wanted}, \@folders1wanted_init, qq{$comment, init check} ) ;
        delete1emptyfolders( $syncT ) ;
        is_deeply( $syncT->{h1_folders_wanted}, \@folders1wanted_after, qq{$comment, after check} ) ;

	note( 'Leaving  tests_delete1emptyfolders_unit()' ) ;
        return ;
}

sub extract_header
{
        my $string = shift ;

        my ( $header ) = split  /\n\n/x, $string ;
        if ( ! $header ) { return( q{} ) ; }
        #myprint( "[$header]\n" ) ;
        return( $header ) ;
}

sub tests_extract_header
{
	note( 'Entering 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') ;



	note( 'Leaving  tests_extract_header()' ) ;
        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 ) {
                #myprint( "DDD $line\n" ) ;
                # End of header
                last if ( $line =~ m{^$}xo ) ;
                # Key: value
                if ( $line =~ m/(^[^:]+):\s(.*)/xo ) {
                        $key = $1 ;
                        $val = $2 ;
                        $debugdev and myprint( "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 myprint( "DDD V [$val]\n" ) ;
                        @{ $header->{ $key } }[ $LAST ] .= " $val" if $key ;
                # dirty line?
                }else{
                        next ;
                }
        }

        #myprint( Data::Dumper->Dump( [ $header ] )  ) ;

        return( $header ) ;
}


sub tests_decompose_header{
	note( 'Entering 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_++' ) ;

	note( 'Leaving  tests_decompose_header()' ) ;
        return ;
}

sub tests_epoch
{
	note( 'Entering 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' ) ;

        is( '1280671200', epoch( '1-Aug-2010 14:01:00 +0001' ), 'epoch 1-Aug-2010 14:01:00 +0001 -> 1280671200' ) ;
        is( '946684800', epoch( '00-Jan-0000 00:00:00 +0000' ), 'epoch 1-Aug-2010 14:01:00 +0001 -> 1280671200' ) ;

	note( 'Leaving  tests_epoch()' ) ;
        return ;
}

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

        # outgoing format: epoch


        my $d = shift ;
        return(q{}) 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 ) {
                #myprint( "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 ) ;
                #myprint( "( $mday, $month, $year, $hour, $min, $sec, $sign, $zone_h, $zone_m )\n" ) ;

                $sign = +1 if ( '+' eq $sign ) ;
                $sign = $MINUS_ONE if ( '-' eq $sign ) ;

                if ( 0 == $mday ) {
                        myprint( "buggy day in $d. Fixed to 01\n" ) ;
                        $mday = '01' ;
                }
                $time = timegm( $sec, $min, $hour, $mday, $month_abrev{$month}, $year )
                        - $sign * ( 3600 * $zone_h + 60 * $zone_m ) ;

                #myprint( "$time ", scalar localtime($time), "\n");
        }
        return( $time ) ;
}

sub tests_add_header
{
	note( 'Entering 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' ) ;

	note( 'Leaving  tests_add_header()' ) ;
        return ;
}

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




sub tests_max_line_length
{
	note( 'Entering tests_max_line_length()' ) ;

        ok( 0 == max_line_length( q{} ), '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 1_000 ), 'max_line_length: 3 == 1_000 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' ) ;

	note( 'Leaving  tests_max_line_length()' ) ;
        return ;
}

sub max_line_length
{
        my $string = shift ;
        my $max = 0 ;

        while ( $string =~ m/([^\n]*\n?)/msxg ) {
                $max = max( $max, length $1 ) ;
        }
        return( $max ) ;
}


sub tests_setlogfile
{
	note( 'Entering tests_setlogfile()' ) ;

	my $mysync = {} ;
        $mysync->{logdir}  = 'vallogdir' ;
        $mysync->{logfile} = 'vallogfile.txt' ;
        is( 'vallogdir/vallogfile.txt', setlogfile( $mysync ),
                'setlogfile: logdir vallogdir, logfile vallogfile.txt, vallogdir/vallogfile.txt' ) ;

	SKIP: {
	skip( 'Too hard to have a well known timezone on Windows', 9 ) if ( 'MSWin32' eq $OSNAME ) ;

        local $ENV{TZ} = 'GMT' ;

	$mysync = {
                timestart => 2,
	} ;

        is( "$DEFAULT_LOGDIR/1970_01_01_00_00_02_000__.txt", setlogfile( $mysync ),
                "setlogfile: default is like $DEFAULT_LOGDIR/1970_01_01_00_00_02_000__.txt" ) ;

        $mysync = {
                timestart => 2,
                user1     => 'user1',
                user2     => 'user2',
                abort     => 1,
        } ;

        is( "$DEFAULT_LOGDIR/1970_01_01_00_00_02_000_user1_user2_abort.txt", setlogfile( $mysync ),
                "setlogfile: default is like $DEFAULT_LOGDIR/1970_01_01_00_00_02_000_user1_user2_abort.txt" ) ;

        $mysync = {
                timestart => 2,
                user1     => 'user1',
                user2     => 'user2',
                remote    => 'zzz',
        } ;

        is( "$DEFAULT_LOGDIR/1970_01_01_00_00_02_000_user1_user2_remote.txt", setlogfile( $mysync ),
                "setlogfile: default is like $DEFAULT_LOGDIR/1970_01_01_00_00_02_000_user1_user2_remote.txt" ) ;

        $mysync = {
                timestart => 2,
                user1     => 'user1',
                user2     => 'user2',
                remote    => 'zzz',
                abort     => 1,
        } ;

        is( "$DEFAULT_LOGDIR/1970_01_01_00_00_02_000_user1_user2_remote_abort.txt", setlogfile( $mysync ),
                "setlogfile: default is like $DEFAULT_LOGDIR/1970_01_01_00_00_02_000_user1_user2_remote_abort.txt" ) ;


        $mysync = {
                timestart => 2,
                user1     => 'user1',
                user2     => 'user2',
        } ;

        is( "$DEFAULT_LOGDIR/1970_01_01_00_00_02_000_user1_user2.txt", setlogfile( $mysync ),
                "setlogfile: default is like $DEFAULT_LOGDIR/1970_01_01_00_00_02_000_user1_user2.txt" ) ;

        $mysync->{logdir}  = undef ;
        $mysync->{logfile} = undef ;
        is( "$DEFAULT_LOGDIR/1970_01_01_00_00_02_000_user1_user2.txt", setlogfile( $mysync ),
                "setlogfile: logdir undef, $DEFAULT_LOGDIR/1970_01_01_00_00_02_000_user1_user2.txt" ) ;

        $mysync->{logdir} = q{} ;
        $mysync->{logfile} = undef ;
        is( '1970_01_01_00_00_02_000_user1_user2.txt', setlogfile( $mysync ),
                'setlogfile: logdir empty, 1970_01_01_00_00_02_000_user1_user2.txt' ) ;

        $mysync->{logdir} = 'vallogdir' ;
        $mysync->{logfile} = undef ;
        is( 'vallogdir/1970_01_01_00_00_02_000_user1_user2.txt', setlogfile( $mysync ),
                'setlogfile: logdir vallogdir, vallogdir/1970_01_01_00_00_02_000_user1_user2.txt' ) ;

        $mysync = {
                user1     => 'us/er1a*|?:"<>b',
                user2     => 'u/ser2a*|?:"<>b',
        } ;

        is( "$DEFAULT_LOGDIR/1970_01_01_00_00_00_000_us_er1a_______b_u_ser2a_______b.txt", setlogfile( $mysync ),
                "setlogfile: logdir undef, $DEFAULT_LOGDIR/1970_01_01_00_00_00_000_us_er1a_______b_u_ser2a_______b.txt" ) ;



	} ;

	note( 'Leaving  tests_setlogfile()' ) ;
        return ;
}

sub setlogfile
{
        my( $mysync ) = shift ;

        # When aborting another process the log file name finishes with "_abort.txt"
        my $abort_suffix = ( $mysync->{abort} ) ? '_abort' : q{} ;
        # When acting as a proxy the log file name finishes with "_remote.txt"
        # proxy mode is not done yet
        my $remote_suffix = ( $mysync->{remote} ) ? '_remote' : q{} ;

	my $suffix = ( filter_forbidden_characters( move_slash( $mysync->{user1} ) ) || q{} )
			. '_'
                        . ( filter_forbidden_characters( move_slash( $mysync->{user2} ) ) || q{} )
                        . $remote_suffix . $abort_suffix ;

        $mysync->{logdir}  = defined $mysync->{logdir}  ? $mysync->{logdir}  : $DEFAULT_LOGDIR ;

        $mysync->{logfile} = defined $mysync->{logfile}
                ? "$mysync->{logdir}/$mysync->{logfile}"
                : logfile( $mysync->{timestart}, $suffix, $mysync->{logdir} ) ;

        return( $mysync->{logfile} ) ;
}

sub tests_logfile
{
	note( 'Entering tests_logfile()' ) ;

        SKIP: {
                # Too hard to have a well known timezone on Windows
                skip( 'Too hard to have a well known timezone on Windows', 10 ) if ( 'MSWin32' eq $OSNAME ) ;

                local $ENV{TZ} = 'GMT' ;
                { POSIX::tzset unless ('MSWin32' eq $OSNAME) ;
                        is( '1970_01_01_00_00_00_000.txt', logfile(  ),           'logfile: no args    => 1970_01_01_00_00_00.txt' ) ;
                        is( '1970_01_01_00_00_00_000.txt', logfile( 0 ),          'logfile: 0          => 1970_01_01_00_00_00.txt' ) ;
                        is( '1970_01_01_00_01_01_000.txt', logfile( 61 ),         'logfile: 0          => 1970_01_01_00_01_01.txt' ) ;
                        is( '1970_01_01_00_01_01_234.txt', logfile( 61.234 ),     'logfile: 0          => 1970_01_01_00_01_01.txt' ) ;
                        is( '2010_08_24_14_00_00_000.txt', logfile( 1_282_658_400 ), 'logfile: 1_282_658_400 => 2010_08_24_14_00_00.txt' ) ;
                        is( '2010_08_24_14_01_01_000.txt', logfile( 1_282_658_461 ), 'logfile: 1_282_658_461 => 2010_08_24_14_01_01.txt' ) ;
                        is( '2010_08_24_14_01_01_000_poupinette.txt', logfile( 1_282_658_461, 'poupinette' ), 'logfile: 1_282_658_461 poupinette => 2010_08_24_14_01_01_poupinette.txt' ) ;
                        is( '2010_08_24_14_01_01_000_removeblanks.txt', logfile( 1_282_658_461, '   remove blanks  ' ), 'logfile: 1_282_658_461   remove blanks   => 2010_08_24_14_01_01_000_removeblanks' ) ;

                        is( '2010_08_24_14_01_01_234_poup.txt', logfile( 1_282_658_461.2347, 'poup' ),
                            'logfile: 1_282_658_461.2347 poup => 2010_08_24_14_01_01_234_poup.txt' ) ;

                        is( 'dirdir/2010_08_24_14_01_01_234_poup.txt', logfile( 1_282_658_461.2347, 'poup', 'dirdir' ),
                            'logfile: 1_282_658_461.2347 poup dirdir => dirdir/2010_08_24_14_01_01_234_poup.txt' ) ;



                }
                POSIX::tzset unless ('MSWin32' eq $OSNAME) ;
        } ;

	note( 'Leaving  tests_logfile()' ) ;
        return ;
}


sub logfile
{
        my ( $time, $suffix, $dir ) = @_ ;

        $time   ||= 0 ;
        $suffix ||= q{} ;
	$suffix =~ tr/ //ds ;
        my $sep_suffix = ( $suffix ) ? '_' : q{} ;
        $dir    ||= q{} ;
        my $sep_dir = ( $dir ) ? '/' : q{} ;

        my $date_str = POSIX::strftime( '%Y_%m_%d_%H_%M_%S', localtime $time ) ;
	# Because of ab tests or web access, more than one sync withing one second is possible
	# so we add also milliseconds
	$date_str .= sprintf "_%03d", ($time - int( $time ) ) * 1000 ; # without rounding
        my $logfile = "${dir}${sep_dir}${date_str}${sep_suffix}${suffix}.txt" ;
        return( $logfile ) ;
}



sub tests_move_slash
{
	note( 'Entering tests_move_slash()' ) ;

	is( undef, move_slash(  ), 'move_slash: no parameters => undef' ) ;
	is( '_', move_slash( '/' ), 'move_slash: / => _' ) ;
	is( '_abc_def_', move_slash( '/abc/def/' ), 'move_slash: /abc/def/ => _abc_def_' ) ;
	note( 'Leaving  tests_move_slash()' ) ;
	return ;
}

sub move_slash
{
	my $string = shift ;

	if ( ! defined $string ) { return ; }

	$string =~ tr{/}{_} ;

	return(  $string ) ;
}




sub tests_million_folders_baby_2
{
	note( 'Entering tests_million_folders_baby_2()' ) ;

        my %long ;
        @long{ 1 .. 900_000 } = (1) x 900_000 ;
        #myprint( %long, "\n" ) ;
        my $pasglop = 0 ;
        foreach my $elem (  1 .. 900_000 ) {
                #$debug and myprint( "$elem " ) ;
                if ( not exists  $long{ $elem }  ) {
                        $pasglop++ ;
                }
        }
        ok( 0 == $pasglop, 'tests_million_folders_baby_2: search among 900_000' ) ;
        # myprint( "$pasglop\n" ) ;

	note( 'Leaving  tests_million_folders_baby_2()' ) ;
        return ;
}



sub tests_always_fail
{
	note( 'Entering tests_always_fail()' ) ;

        is( 0, 1, 'always_fail: 0 is 1' ) ;

	note( 'Leaving  tests_always_fail()' ) ;
        return ;
}


sub tests_logfileprepa
{
        note( 'Entering tests_logfileprepa()' ) ;

        is( undef, logfileprepa(  ), 'logfileprepa: no args => undef' ) ;
        my $logfile = 'W/tmp/tests/tests_logfileprepa.txt' ;
        is( 1, logfileprepa( $logfile ), 'logfileprepa: W/tmp/tests/tests_logfileprepa.txt => 1' ) ;

        note( 'Leaving  tests_logfileprepa()' ) ;
        return ;
}

sub logfileprepa
{
        my $logfile = shift ;

        if ( ! defined( $logfile ) )
        {
                return ;
        }else
        {
                #myprint( "[$logfile]\n" ) ;
                my $dirname = dirname( $logfile ) ;
                do_valid_directory( $dirname ) || return( 0 ) ;
                return( 1 ) ;
        }
}


sub tests_teelaunch
{
        note( 'Entering tests_teelaunch()' ) ;

        is( undef, teelaunch(  ), 'teelaunch: no args => undef' ) ;
        my $mysync = {} ;
        is( undef, teelaunch( $mysync ), 'teelaunch: arg empty {} => undef' ) ;
        $mysync->{logfile} = '' ;
        is( undef, teelaunch( $mysync ), 'teelaunch: logfile empty string => undef' ) ;
        $mysync->{logfile} = 'W/tmp/tests/tests_teelaunch.txt' ;
        isa_ok( my $tee = teelaunch( $mysync ), 'IO::Tee' , 'teelaunch: logfile W/tmp/tests/tests_teelaunch.txt' ) ;
        is( 1, print( $tee "Hi!\n" ), 'teelaunch: write Hi!') ;
        is( "Hi!\n", file_to_string( 'W/tmp/tests/tests_teelaunch.txt' ), 'teelaunch: reading W/tmp/tests/tests_teelaunch.txt is Hi!\n' ) ;
        is( 1, print( $tee "Hoo\n" ), 'teelaunch: write Hoo') ;
        is( "Hi!\nHoo\n", file_to_string( 'W/tmp/tests/tests_teelaunch.txt' ), 'teelaunch: reading W/tmp/tests/tests_teelaunch.txt is Hi!\nHoo\n' ) ;

        note( 'Leaving  tests_teelaunch()' ) ;
        return ;
}

sub teelaunch
{
        my $mysync = shift ;

        if ( ! defined( $mysync ) )
        {
                return ;
        }

        my $logfile = $mysync->{logfile} ;

        if ( ! $logfile )
        {
                return ;
        }

        logfileprepa( $logfile ) || croak "Error no valid directory to write log file $logfile : $OS_ERROR" ;

        # This is a log file opened during the whole sync
        ## no critic (InputOutput::RequireBriefOpen)
        open my $logfile_handle, '>', $logfile
          or croak( "Can not open $logfile for write: $OS_ERROR" ) ;
        my $tee = IO::Tee->new( $logfile_handle, \*STDOUT ) ;
        $tee->autoflush( 1 ) ;
        $mysync->{logfile_handle} = $logfile_handle ;
        $mysync->{tee} = $tee ;
        return $tee ;
}

sub getpwuid_any_os
{
        my $uid = shift ;

        return( scalar  getlogin ) if ( 'MSWin32' eq $OSNAME ) ; # Windows system
        return( scalar  getpwuid $uid ) ; # Unix system


}

sub simulong
{
	my $max_seconds = shift ;
	my $division = 5 ;
	my $last_count = $division * $max_seconds ;
	foreach my $i ( 1 .. ( $last_count ) ) {
		 myprint( "Are you still here ETA: " . ($last_count - $i) . "/$last_count msgs left\n" ) ;
		#myprint( "Are you still here ETA: " . ($last_count - $i) . "/$last_count  msgs left\n" . ( "Ah" x 40 . "\n") x 4000 ) ;
		sleep( 1 / $division ) ;
	}

	return ;
}



sub printenv
{
        myprint( "Environment variables listing:\n",
		( map { "$_ => $ENV{$_}\n" } sort keys %ENV),
		"Environment variables listing end\n"  ) ;
	return ;
}

sub testsexit
{
	my $mysync = shift ;
        if ( ! ( $mysync->{ tests }  or $mysync->{ testsdebug } or $mysync->{ testsunit } ) ) {
		return ;
	}
        my $test_builder = Test::More->builder ;
        tests( $mysync ) ;
        testsdebug( $mysync ) ;
	testunitsession( $mysync ) ;

	my @summary = $test_builder->summary() ;
	my @details = $test_builder->details() ;
	my $nb_tests_run = scalar( @summary ) ;
	my $nb_tests_expected = $test_builder->expected_tests() ;
	my $nb_tests_failed = count_0s( @summary ) ;
	my $tests_failed = report_failures( @details ) ;
	if ( $nb_tests_failed or ( $nb_tests_run != $nb_tests_expected ) ) {
		#$test_builder->reset(  ) ;
		myprint( "Summary of tests: failed $nb_tests_failed tests, run $nb_tests_run tests, expected to run $nb_tests_expected tests.\n",
                "List of failed tests:\n", $tests_failed ) ;
		exit $EXIT_TESTS_FAILED ;
	}

        cleanup_mess_from_tests(  ) ;
        # Cover is larger with --tests --testslive
        if ( ! $mysync->{ testslive } )
        {
                exit ;
        }
        # $eeee ;
	return ;
}

sub cleanup_mess_from_tests
{
        undef @pipemess ;
        return ;
}

sub after_get_options
{
        my $mysync = shift ;
	my $numopt = shift ;


        # exit with --help option or no option at all
        $mysync->{ debug } and myprint( "numopt:$numopt\n" ) ;

        if ( $help or not $numopt ) {
                myprint( usage( $mysync ) ) ;
                exit ;
        }

        return ;
}

sub tests_remove_edging_blanks
{
        note( 'Entering tests_remove_edging_blanks()' ) ;

        is( undef, remove_edging_blanks(  ),  'remove_edging_blanks: no args => undef' ) ;
        is( 'abcd', remove_edging_blanks( 'abcd' ),  'remove_edging_blanks: abcd => abcd' ) ;
        is( 'ab cd', remove_edging_blanks( ' ab cd ' ),  'remove_edging_blanks: " ab cd " => "ab cd"' ) ;

        note( 'Leaving  tests_remove_edging_blanks()' ) ;
        return ;
}



sub remove_edging_blanks
{
        my $string = shift ;
        if ( ! defined $string )
        {
                return ;
        }
        $string =~ s,^ +| +$,,g ;
        return $string ;
}


sub tests_sanitize
{
        note( 'Entering tests_remove_edging_blanks()' ) ;

        is( undef, sanitize(  ),  'sanitize: no args => undef' ) ;
        my $mysync = {} ;

        $mysync->{ host1 } = ' example.com ' ;
        $mysync->{ user1 } = ' to to ' ;
        $mysync->{ password1 } = ' sex is good! ' ;
        is( undef, sanitize( $mysync ),  'sanitize: => undef' ) ;
        is( 'example.com', $mysync->{ host1 },        'sanitize: host1     " example.com "  => "example.com"' ) ;
        is( 'to to', $mysync->{ user1 },             'sanitize: user1     "  to to  "      => "to to"' ) ;
        is( 'sex is good!', $mysync->{ password1 },  'sanitize: password1 " sex is good! " => "sex is good!"' ) ;
        note( 'Leaving  tests_remove_edging_blanks()' ) ;
        return ;
}


sub sanitize
{
        my $mysync = shift ;
        if ( ! defined $mysync )
        {
                return ;
        }

        foreach my $parameter ( qw( host1 host2 user1 user2 password1 password2 ) )
        {
                $mysync->{ $parameter } = remove_edging_blanks( $mysync->{ $parameter } ) ;
        }
        return ;
}

sub easyany
{
	my $mysync = shift ;

	# Gmail
	if ( $mysync->{gmail1} and $mysync->{gmail2} ) {
		$mysync->{ debug } and myprint( "gmail1 gmail2\n") ;
		gmail12( $mysync ) ;
		return ;
	}
	if ( $mysync->{gmail1}  ) {
		$mysync->{ debug } and myprint( "gmail1\n" ) ;
		gmail1( $mysync ) ;
	}
	if ( $mysync->{gmail2} ) {
		$mysync->{ debug } and myprint( "gmail2\n" ) ;
		gmail2( $mysync ) ;
	}
	# Office 365
	if ( $mysync->{office1} ) {
		office1( $mysync ) ;
	}

	if ( $mysync->{office2} ) {
		office2( $mysync ) ;
	}

	# Exchange
	if ( $mysync->{exchange1} ) {
		exchange1( $mysync ) ;
	}

	if ( $mysync->{exchange2} ) {
		exchange2( $mysync ) ;
	}


	# Domino
	if ( $mysync->{domino1} ) {
		domino1( $mysync ) ;
	}

	if ( $mysync->{domino2} ) {
		domino2( $mysync ) ;
	}

	return ;
}

# From https://imapsync.lamiral.info/FAQ.d/FAQ.Gmail.txt
sub gmail12
{
	my $mysync = shift ;
	# Gmail at host1 and host2
	$mysync->{host1} ||= 'imap.gmail.com' ;
	$mysync->{ssl1} = ( defined $mysync->{ssl1} ) ? $mysync->{ssl1} : 1 ;
	$mysync->{host2} ||= 'imap.gmail.com' ;
	$mysync->{ssl2} = ( defined $mysync->{ssl2} ) ? $mysync->{ssl2} : 1 ;
	$mysync->{maxbytespersecond} ||= 20_000 ; # should be 10_000 when computed from Gmail documentation
	$mysync->{maxbytesafter} ||= 1_000_000_000 ;
	$mysync->{automap}   = ( defined $mysync->{automap} )  ? $mysync->{automap} : 1 ;
	$mysync->{maxsleep}  = ( defined $mysync->{maxsleep} ) ? $mysync->{maxsleep} : $MAX_SLEEP ; ;
	$skipcrossduplicates = ( defined $skipcrossduplicates ) ? $skipcrossduplicates : 0 ;
        $mysync->{ synclabels  }   = ( defined $mysync->{ synclabels } )  ? $mysync->{ synclabels } : 1 ;
        $mysync->{ reynclabels }   = ( defined $mysync->{ reynclabels } )  ? $mysync->{ reynclabels } : 1 ;
	push @exclude, '\[Gmail\]$' ;
        push @folderlast, '[Gmail]/All Mail' ;
	return ;
}


sub gmail1
{
	my $mysync = shift ;
	# Gmail at host2
	$mysync->{host1} ||= 'imap.gmail.com' ;
	$mysync->{ssl1} = ( defined $mysync->{ssl1} ) ? $mysync->{ssl1} : 1 ;
	$mysync->{maxbytespersecond} ||= 40_000 ; # should be 20_000 computed from by Gmail documentation
	$mysync->{maxbytesafter} ||= 2_500_000_000 ;
	$mysync->{automap}   = ( defined $mysync->{automap} ) ? $mysync->{automap} : 1 ;
	$mysync->{maxsleep}  = ( defined $mysync->{maxsleep} ) ? $mysync->{maxsleep} : $MAX_SLEEP ; ;
	$skipcrossduplicates = ( defined $skipcrossduplicates ) ? $skipcrossduplicates : 1 ;

	push @useheader, 'X-Gmail-Received', 'Message-Id' ;
	push @{ $mysync->{ regextrans2 } }, 's,\[Gmail\].,,' ;
        push @folderlast, '[Gmail]/All Mail' ;
	return ;
}

sub gmail2
{
	my $mysync = shift ;
	# Gmail at host2
	$mysync->{host2} ||= 'imap.gmail.com' ;
	$mysync->{ssl2} = ( defined $mysync->{ssl2} ) ? $mysync->{ssl2} : 1 ;
	$mysync->{maxbytespersecond} ||= 20_000 ; # should be 10_000 computed from by Gmail documentation
	$mysync->{maxbytesafter} ||= 1_000_000_000 ; # In fact it is documented as half: 500_000_000
	#$mysync->{ maxsize } ||= 25_000_000 ;
	$mysync->{automap} = ( defined $mysync->{automap} ) ? $mysync->{automap} : 1 ;
	#$skipcrossduplicates = ( defined $skipcrossduplicates ) ? $skipcrossduplicates : 1 ;
	$mysync->{ expunge1 }            = ( defined $mysync->{ expunge1 } )  ? $mysync->{ expunge1 }  : 1 ;
	$mysync->{addheader} = ( defined $mysync->{addheader} ) ? $mysync->{addheader} : 1 ;
	$mysync->{maxsleep}  = ( defined $mysync->{maxsleep} )  ? $mysync->{maxsleep} : $MAX_SLEEP ; ;

        $mysync->{maxsize}  = ( defined $mysync->{maxsize} )  ? $mysync->{maxsize} : $GMAIL_MAXSIZE ;

        if ( ! $mysync->{noexclude} ) {
                push @exclude, '\[Gmail\]$' ;
        }
        push @useheader, 'Message-Id' ;
        push @{ $mysync->{ regextrans2 } }, 's,\[Gmail\].,,' ;

        # push @{ $mysync->{ regextrans2 } }, 's/[ ]+/_/g' ; # is now replaced
        # by the two more specific following regexes,
        # they remove just the beginning and trailing blanks, not all.
        push @{ $mysync->{ regextrans2 } }, 's,^ +| +$,,g' ;
        push @{ $mysync->{ regextrans2 } }, 's,/ +| +/,/,g' ;
        #
	push @{ $mysync->{ regextrans2 } }, q{s/['\\^"]/_/g} ; # Verified this
        push @folderlast, '[Gmail]/All Mail' ;
	return ;
}


# From https://imapsync.lamiral.info/FAQ.d/FAQ.Exchange.txt
sub office1
{
	# Office 365 at host1
	my $mysync = shift ;

	output( $mysync, q{Option --office1 is like: --host1 outlook.office365.com --ssl1 --exclude "^Files$"} . "\n" ) ;
        output( $mysync, "Option --office1 (cont) : unless overrided with --host1 otherhost --nossl1 --noexclude\n" ) ;
	$mysync->{host1} ||= 'outlook.office365.com' ;
	$mysync->{ssl1} = ( defined $mysync->{ssl1} ) ? $mysync->{ssl1} : 1 ;
        if ( ! $mysync->{noexclude} ) {
                push @exclude, '^Files$' ;
        }
	return ;
}


sub office2
{
        # Office 365 at host2
        my $mysync = shift ;
        output( $mysync, qq{Option --office2 is like: --host2 outlook.office365.com --ssl2 --maxsize 45_000_000 --maxmessagespersecond 4\n} ) ;
        output( $mysync, qq{Option --office2 (cont) : --disarmreadreceipts --regexmess "wrap 10500" --f1f2 "Files=Files_renamed_by_imapsync"\n} ) ;
        output( $mysync, qq{Option --office2 (cont) : unless overrided with --host2 otherhost --nossl2 ... --nodisarmreadreceipts --noregexmess\n} ) ;
        output( $mysync, qq{Option --office2 (cont) : and --nof1f2 to avoid Files folder renamed to Files_renamed_by_imapsync\n} ) ;
        $mysync->{host2} ||= 'outlook.office365.com' ;
        $mysync->{ssl2} = ( defined $mysync->{ssl2} ) ? $mysync->{ssl2} : 1 ;
        $mysync->{ maxsize } ||= 45_000_000 ;
        $mysync->{maxmessagespersecond} ||= 4 ;
        #push @regexflag, 's/\\\\Flagged//g' ; # No problem without! tested 2018_09_10
        $disarmreadreceipts = ( defined $disarmreadreceipts ) ? $disarmreadreceipts : 1 ;
        # I dislike double negation but here is one
        if ( ! $mysync->{noregexmess} )
        {
                push @regexmess, 's,(.{10239}),$1\r\n,g' ;
        }
        # and another...
        if ( ! $mysync->{nof1f2} )
        {
                push @{ $mysync->{f1f2} }, 'Files=Files_renamed_by_imapsync' ;
        }
        return ;
}

sub exchange1
{
        # Exchange 2010/2013 at host1
        my $mysync = shift ;
        output( $mysync, "Option --exchange1 does nothing (except printing this line...)\n" ) ;
        # Well nothing to do so far
        return ;
}

sub exchange2
{
        # Exchange 2010/2013 at host2
        my $mysync = shift ;
        output( $mysync, "Option --exchange2 is like: --maxsize 10_000_000 --maxmessagespersecond 4 --disarmreadreceipts\n" ) ;
        output( $mysync, "Option --exchange2 (cont) : --regexflag del Flagged --regexmess wrap 10500\n" ) ;
        output( $mysync, "Option --exchange2 (cont) : unless overrided with --maxsize xxx --nodisarmreadreceipts --noregexflag --noregexmess\n" ) ;
        $mysync->{ maxsize } ||= 10_000_000 ;
        $mysync->{maxmessagespersecond} ||= 4 ;
        $disarmreadreceipts = ( defined $disarmreadreceipts ) ? $disarmreadreceipts : 1 ;
        # I dislike double negation but here are two
        if ( ! $mysync->{noregexflag} ) {
                push @regexflag, 's/\\\\Flagged//g' ;
        }
        if ( ! $mysync->{noregexmess} ) {
                push @regexmess, 's,(.{10239}),$1\r\n,g' ;
        }
        return ;
}

sub domino1
{
	# Domino at host1
	my $mysync = shift ;

	$mysync->{ sep1 }    = q{\\} ;
	$prefix1 = q{} ;
	$messageidnodomain = ( defined $messageidnodomain ) ? $messageidnodomain : 1 ;
	return ;
}

sub domino2
{
	# Domino at host1
	my $mysync = shift ;

	$mysync->{ sep2 }    = q{\\} ;
	$prefix2 = q{} ;
	$messageidnodomain = ( defined $messageidnodomain ) ? $messageidnodomain : 1 ;
	push @{ $mysync->{ regextrans2 } }, 's,^Inbox\\\\(.*),$1,i' ;
	return ;
}


sub tests_resolv
{
	note( 'Entering tests_resolv()' ) ;

	# is( , resolv(  ), 'resolv:  => ' ) ;
	is( undef, resolv(  ), 'resolv: no args => undef' ) ;
	is( undef, resolv( '' ), 'resolv: empty string => undef' ) ;
	is( undef, resolv( 'hostnotexist' ), 'resolv: hostnotexist => undef' ) ;
	is( '127.0.0.1', resolv( '127.0.0.1' ), 'resolv: 127.0.0.1 => 127.0.0.1' ) ;
	is( '127.0.0.1', resolv( 'localhost' ), 'resolv: localhost => 127.0.0.1' ) ;
	is( '5.135.158.182', resolv( 'imapsync.lamiral.info' ), 'resolv: imapsync.lamiral.info => 5.135.158.182' ) ;

	# ip6-localhost ( in /etc/hosts )
	is( '::1', resolv( 'ip6-localhost' ), 'resolv: ip6-localhost => ::1' ) ;
	is( '::1', resolv( '::1' ), 'resolv: ::1 => ::1' ) ;
	# ks2
	is( '2001:41d0:8:d8b6::1', resolv( '2001:41d0:8:d8b6::1' ),  'resolv:  2001:41d0:8:d8b6::1 => 2001:41d0:8:d8b6::1' ) ;
	is( '2001:41d0:8:d8b6::1', resolv( 'ks2ipv6.lamiral.info' ), 'resolv: ks2ipv6.lamiral.info => 2001:41d0:8:d8b6::1' ) ;
	# ks3
	is( '2001:41d0:8:bebd::1', resolv( '2001:41d0:8:bebd::1' ),  'resolv:  2001:41d0:8:bebd::1 => 2001:41d0:8:bebd::1' ) ;
	is( '2001:41d0:8:bebd::1', resolv( 'ks3ipv6.lamiral.info' ), 'resolv: ks3ipv6.lamiral.info => 2001:41d0:8:bebd::1' ) ;


	note( 'Leaving  tests_resolv()' ) ;
        return ;
}



sub resolv
{
	my $host = shift @ARG ;

	if ( ! $host ) { return ; }
        my $addr ;
	if ( defined &Socket::getaddrinfo ) {
		$addr = resolv_with_getaddrinfo( $host ) ;
		return( $addr ) ;
	}



        my $iaddr = inet_aton( $host ) ;
        if ( ! $iaddr ) { return ; }
        $addr = inet_ntoa( $iaddr ) ;

	return $addr ;
}

sub resolv_with_getaddrinfo
{
	my $host = shift @ARG ;

	if ( ! $host ) { return ; }

	my ( $err_getaddrinfo, @res ) = Socket::getaddrinfo( $host, "", { socktype => Socket::SOCK_RAW } ) ;
	if (  $err_getaddrinfo ) {
		myprint( "Cannot getaddrinfo of $host: $err_getaddrinfo\n" ) ;
		return ;
	}

	my @addr ;
	while( my $ai = shift @res ) {
		my ( $err_getnameinfo, $ipaddr ) = Socket::getnameinfo( $ai->{addr}, Socket::NI_NUMERICHOST(), Socket::NIx_NOSERV() ) ;
		if ( $err_getnameinfo ) {
			myprint( "Cannot getnameinfo of $host: $err_getnameinfo\n" ) ;
			return ;
		}
		$sync->{ debug } and myprint( "$host => $ipaddr\n" ) ;
		push @addr, $ipaddr ;
                my $reverse ;
		( $err_getnameinfo, $reverse ) = Socket::getnameinfo( $ai->{addr}, 0, Socket::NIx_NOSERV() ) ;
		$sync->{ debug } and myprint( "$host => $ipaddr => $reverse\n" ) ;
	}

        return $addr[0] ;
}

sub tests_resolvrev
{
	note( 'Entering tests_resolvrev()' ) ;

	# is( , resolvrev(  ), 'resolvrev:  => ' ) ;
	is( undef, resolvrev(  ), 'resolvrev: no args => undef' ) ;
	is( undef, resolvrev( '' ), 'resolvrev: empty string => undef' ) ;
	is( undef, resolvrev( 'hostnotexist' ), 'resolvrev: hostnotexist => undef' ) ;
	is( 'localhost', resolvrev( '127.0.0.1' ), 'resolvrev: 127.0.0.1 => localhost' ) ;
	is( 'localhost', resolvrev( 'localhost' ), 'resolvrev: localhost => localhost' ) ;
	is( 'ks.lamiral.info', resolvrev( 'imapsync.lamiral.info' ), 'resolvrev: imapsync.lamiral.info => ks.lamiral.info' ) ;

	# ip6-localhost ( in /etc/hosts )
	is( 'ip6-localhost', resolvrev( 'ip6-localhost' ), 'resolvrev: ip6-localhost => ip6-localhost' ) ;
	is( 'ip6-localhost', resolvrev( '::1' ), 'resolvrev: ::1 => ip6-localhost' ) ;
	# ks2
	is( 'ks2ipv6.lamiral.info', resolvrev( '2001:41d0:8:d8b6::1' ),  'resolvrev:  2001:41d0:8:d8b6::1 => ks2ipv6.lamiral.info' ) ;
	is( 'ks2ipv6.lamiral.info', resolvrev( 'ks2ipv6.lamiral.info' ), 'resolvrev: ks2ipv6.lamiral.info => ks2ipv6.lamiral.info' ) ;
	# ks3
	is( 'ks3ipv6.lamiral.info', resolvrev( '2001:41d0:8:bebd::1' ),  'resolvrev:  2001:41d0:8:bebd::1 => ks3ipv6.lamiral.info' ) ;
	is( 'ks3ipv6.lamiral.info', resolvrev( 'ks3ipv6.lamiral.info' ), 'resolvrev: ks3ipv6.lamiral.info => ks3ipv6.lamiral.info' ) ;


	note( 'Leaving  tests_resolvrev()' ) ;
        return ;
}

sub resolvrev
{
	my $host = shift @ARG ;

	if ( ! $host ) { return ; }

	if ( defined &Socket::getaddrinfo ) {
		my $name = resolvrev_with_getaddrinfo( $host ) ;
		return( $name ) ;
	}

	return ;
}

sub resolvrev_with_getaddrinfo
{
	my $host = shift @ARG ;

	if ( ! $host ) { return ; }

	my ( $err, @res ) = Socket::getaddrinfo( $host, "", { socktype => Socket::SOCK_RAW } ) ;
	if (  $err ) {
		myprint( "Cannot getaddrinfo of $host: $err\n" ) ;
		return ;
	}

	my @name ;
	while( my $ai = shift @res ) {
		my ( $err, $reverse ) = Socket::getnameinfo( $ai->{addr}, 0, Socket::NIx_NOSERV() ) ;
		if ( $err ) {
			myprint( "Cannot getnameinfo of $host: $err\n" ) ;
			return ;
		}
		$sync->{ debug } and myprint( "$host => $reverse\n" ) ;
		push @name, $reverse ;
	}

    return $name[0] ;
}



sub tests_imapsping
{
	note( 'Entering tests_imapsping()' ) ;

	is( undef, imapsping(  ), 'imapsping: no args => undef' ) ;
	is( undef, imapsping( 'hostnotexist' ), 'imapsping: hostnotexist => undef' ) ;
	is( 1, imapsping( 'imapsync.lamiral.info' ), 'imapsping: imapsync.lamiral.info => 1' ) ;
        is( 1, imapsping( 'ks2ipv6.lamiral.info' ), 'imapsping: ks2ipv6.lamiral.info => 1' ) ;
	note( 'Leaving  tests_imapsping()' ) ;
	return ;
}

sub imapsping
{
	my $host = shift ;
	return tcpping( $host, $IMAP_SSL_PORT ) ;
}

sub tests_tcpping
{
	note( 'Entering tests_tcpping()' ) ;

	is( undef, tcpping(  ), 'tcpping: no args => undef' ) ;
	is( undef, tcpping( 'hostnotexist' ), 'tcpping: one arg => undef' ) ;
	is( undef, tcpping( undef, 888 ), 'tcpping: arg undef, port => undef' ) ;
	is( undef, tcpping( 'hostnotexist', 993 ), 'tcpping: hostnotexist 993 => undef' ) ;
	is( undef, tcpping( 'hostnotexist', 888 ), 'tcpping: hostnotexist 888 => undef' ) ;
	is( 1, tcpping( 'imapsync.lamiral.info', 993 ), 'tcpping: imapsync.lamiral.info 993 => 1' ) ;
	is( 0, tcpping( 'imapsync.lamiral.info', 888 ), 'tcpping: imapsync.lamiral.info 888 => 0' ) ;
	is( 1, tcpping( '5.135.158.182', 993 ), 'tcpping: 5.135.158.182 993 => 1' ) ;
	is( 0, tcpping( '5.135.158.182', 888 ), 'tcpping: 5.135.158.182 888 => 0' ) ;

	# Net::Ping supports ipv6 only after release 1.50
	# http://cpansearch.perl.org/src/RURBAN/Net-Ping-2.59/Changes
	# Anyway I plan to avoid Net-Ping for that too long standing feature
	# Net-Ping is integrated in Perl itself, who knows ipv6 for a long time
	is( 1, tcpping( '2001:41d0:8:d8b6::1', 993 ), 'tcpping: 2001:41d0:8:d8b6::1 993 => 1' ) ;
	is( 0, tcpping( '2001:41d0:8:d8b6::1', 888 ), 'tcpping: 2001:41d0:8:d8b6::1 888 => 0' ) ;

	note( 'Leaving  tests_tcpping()' ) ;
	return ;
}

sub tcpping
{
	if ( 2 != scalar( @ARG ) ) {
		return ;
	}
	my ( $host, $port ) = @ARG ;
	if ( ! $host ) { return ; }
	if ( ! $port ) { return ; }

	my $mytimeout = $TCP_PING_TIMEOUT ;
        require Net::Ping ;
	#my $p = Net::Ping->new( 'tcp' ) ;
	my $p = Net::Ping->new(  ) ;
	$p->{port_num} = $port ;
	$p->service_check( 1 ) ;
	$p->hires( 1 ) ;
	my ($ping_ok, $rtt, $ip ) = $p->ping( $host, $mytimeout ) ;
	if ( ! defined $ping_ok ) { return ; }
	my $rtt_approx = sprintf( "%.3f", $rtt ) ;
	$sync->{ debug } and myprint( "Host $host timeout $mytimeout port $port ok $ping_ok ip $ip acked in $rtt_approx s\n" ) ;
	$p->close(  ) ;
	if( $ping_ok ) {
		return 1 ;
	}else{
		return 0 ;
	}
}

sub tests_sslcheck
{
	note( 'Entering tests_sslcheck()' ) ;

	my $mysync ;

	is( undef, sslcheck( $mysync ), 'sslcheck: no sslcheck => undef' ) ;

	$mysync = {
		sslcheck => 1,
	} ;

	is( 0, sslcheck( $mysync ), 'sslcheck: no host => 0' ) ;

	$mysync = {
		sslcheck => 1,
		host1 => 'imapsync.lamiral.info',
		tls1 => 1,
	} ;

	is( 0, sslcheck( $mysync ), 'sslcheck: tls1 => 0' ) ;

	$mysync = {
		sslcheck => 1,
		host1 => 'imapsync.lamiral.info',
	} ;


	is( 1, sslcheck( $mysync ), 'sslcheck: imapsync.lamiral.info => 1' ) ;
	is( 1, $mysync->{ssl1}, 'sslcheck: imapsync.lamiral.info => ssl1 1' ) ;

	$mysync->{sslcheck} = 0 ;
	is( undef, sslcheck( $mysync ), 'sslcheck: sslcheck off => undef' ) ;

	$mysync = {
		sslcheck => 1,
		host1 => 'imapsync.lamiral.info',
                host2 => 'test2.lamiral.info',
	} ;

        is( 2, sslcheck( $mysync ), 'sslcheck: imapsync.lamiral.info + test2.lamiral.info => 2' ) ;

	$mysync = {
		sslcheck => 1,
		host1 => 'imapsync.lamiral.info',
                host2 => 'test2.lamiral.info',
                tls1  => 1,
	} ;

        is( 1, sslcheck( $mysync ), 'sslcheck: imapsync.lamiral.info + test2.lamiral.info + tls1 => 1' ) ;

	note( 'Leaving  tests_sslcheck()' ) ;
	return ;
}

sub sslcheck
{
	my $mysync = shift ;

	if ( ! $mysync->{sslcheck} ) {
		return ;
	}
	my $nb_on = 0 ;
	$mysync->{ debug } and myprint( "sslcheck\n" ) ;
	if (
		( ! defined $mysync->{port1} )
		and
		( ! defined $mysync->{tls1} )
		and
		( ! defined $mysync->{ssl1} )
		and
		( defined $mysync->{host1} )
	) {
                myprint( "Host1: probing ssl on port $IMAP_SSL_PORT ( use --nosslcheck to avoid this ssl probe ) \n" ) ;
                if (  probe_imapssl( $mysync->{host1} ) ) {
                        $mysync->{ssl1} = 1 ;
                        myprint( "Host1: sslcheck detected open ssl port $IMAP_SSL_PORT so turning ssl on (use --nossl1 --notls1 to turn off SSL and TLS wizardry)\n" ) ;
                        $nb_on++ ;
                }else{
                        myprint( "Host1: sslcheck did not detected open ssl port $IMAP_SSL_PORT. Will use standard $IMAP_PORT port.\n" ) ;
                }
	}

	if (
		( ! defined $mysync->{port2} )
		and
		( ! defined $mysync->{tls2} )
		and
		( ! defined $mysync->{ssl2} )
		and
		( defined $mysync->{host2} )
	) {
                myprint( "Host2: probing ssl on port $IMAP_SSL_PORT ( use --nosslcheck to avoid this ssl probe ) \n" ) ;
                if (  probe_imapssl( $mysync->{host2} ) ) {
                        $mysync->{ssl2} = 1 ;
                        myprint( "Host2: sslcheck detected open ssl port $IMAP_SSL_PORT so turning ssl on (use --nossl2 --notls2 to turn off SSL and TLS wizardry)\n" ) ;
                        $nb_on++ ;
                }else{
                        myprint( "Host2: sslcheck did not detected open ssl port $IMAP_SSL_PORT. Will use standard $IMAP_PORT port.\n" ) ;
                }
	}
	return $nb_on ;
}


sub testslive
{
        my $mysync = shift ;
        $mysync->{host1}     ||= 'test1.lamiral.info' ;
        $mysync->{user1}     ||= 'test1' ;
        $mysync->{password1} ||= 'secret1' ;
        $mysync->{host2}     ||= 'test2.lamiral.info' ;
        $mysync->{user2}     ||= 'test2' ;
        $mysync->{password2} ||= 'secret2' ;
        return ;
}

sub testslive6
{
        my $mysync = shift ;
        $mysync->{host1}     ||= 'ks2ipv6.lamiral.info' ;
        $mysync->{user1}     ||= 'test1' ;
        $mysync->{password1} ||= 'secret1' ;
        $mysync->{host2}     ||= 'ks2ipv6.lamiral.info' ;
        $mysync->{user2}     ||= 'test2' ;
        $mysync->{password2} ||= 'secret2' ;
        return ;
}


sub tests_backslash_caret
{
        note( 'Entering tests_backslash_caret()' ) ;

        is( "lalala", backslash_caret( "lalala" ), 'backslash_caret: lalala => lalala' ) ;
        is( "lalala\n", backslash_caret( "lalala\n" ), 'backslash_caret: lalala => lalala 2nd' ) ;
        is( '^', backslash_caret( '\\' ), 'backslash_caret: \\ => ^' ) ;
        is( "^\n", backslash_caret( "\\\n" ), 'backslash_caret: \\ => ^' ) ;
        is( "\\lalala", backslash_caret( "\\lalala" ), 'backslash_caret: \\lalala => \\lalala' ) ;
        is( "\\lal\\ala", backslash_caret( "\\lal\\ala" ), 'backslash_caret: \\lal\\ala => \\lal\\ala' ) ;
        is( "\\lalala\n", backslash_caret( "\\lalala\n" ), 'backslash_caret: \\lalala => \\lalala 2nd' ) ;
        is( "lalala^\n", backslash_caret( "lalala\\\n" ), 'backslash_caret: lalala\\\n => lalala^\n' ) ;
        is( "lalala^\nlalala^\n", backslash_caret( "lalala\\\nlalala\\\n" ), 'backslash_caret: lalala\\\nlalala\\\n => lalala^\nlalala^\n' ) ;
        is( "lal\\ala^\nlalala^\n", backslash_caret( "lal\\ala\\\nlalala\\\n" ), 'backslash_caret: lal\\ala\\\nlalala\\\n => lal\\ala^\nlalala^\n' ) ;

        note( 'Leaving  tests_backslash_caret()' ) ;
        return ;
}

sub backslash_caret
{
        my $string = shift ;

        $string =~ s{\\ $ }{^}gxms ;

        return $string ;
}

sub tests_split_around_equal
{
        note( 'Entering tests_split_around_equal()' ) ;

        is( undef, split_around_equal(  ), 'split_around_equal: no args => undef' ) ;
        is_deeply( { toto => 'titi' }, { split_around_equal( 'toto=titi' ) }, 'split_around_equal: toto=titi => toto => titi' ) ;
        is_deeply( { A => 'B', C => 'D' }, { split_around_equal( 'A=B=C=D' ) }, 'split_around_equal: toto=titi => toto => titi' ) ;
        is_deeply( { A => 'B', C => 'D' }, { split_around_equal( 'A=B', 'C=D' ) }, 'split_around_equal: A=B C=D => A => B, C=>D' ) ;

        note( 'Leaving  tests_split_around_equal()' ) ;
	return ;
}

sub split_around_equal
{
        if ( ! @ARG ) { return ; } ;
        return map { split /=/mxs, $_ } @ARG ;

}



sub tests_sig_install 
{
        note( 'Entering tests_sig_install()' ) ;

        my $mysync ;
        is( undef, sig_install(  ), 'sig_install: no args => undef' ) ;
        is( undef, sig_install( $mysync ), 'sig_install: arg undef => undef' ) ;
        $mysync = {  } ;
        is( undef, sig_install( $mysync ), 'sig_install: empty hash => undef' ) ;

        SKIP: {
        Readonly my $SKIP_15 => 15 ;
	if ( 'MSWin32' eq $OSNAME ) { skip( 'Tests only for Unix', $SKIP_15 ) ; }
        # Default to ignore USR1 USR2 in case future install fails
        local $SIG{ USR1 } = local $SIG{ USR2 } = sub {  } ;
        kill( 'USR1', $PROCESS_ID ) ;

        $mysync->{ debugsig } = 1 ;
        # Assign USR1 to call sub tototo
        # Surely a better value than undef should be returned when doing real signal stuff
        is( undef, sig_install( $mysync, 'tototo', 'USR1' ), 'sig_install: USR1 tototo' ) ;
        
        is( 1, kill( 'USR1', $PROCESS_ID ), 'sig_install: kill USR1 myself 1' ) ;
        is( 1, $mysync->{ tototo_calls },   'sig_install: tototo call nb 1' ) ;

        #return ;
        # Assign USR2 to call sub tototo
        is( undef, sig_install( $mysync, 'tototo', 'USR2' ), 'sig_install: USR2 tototo' ) ;

        is( 1, kill( 'USR2', $PROCESS_ID ), 'sig_install: kill USR2 myself 1' ) ;
        is( 2, $mysync->{ tototo_calls }, 'sig_install: tototo call nb 2' ) ;

        is( 1, kill( 'USR1', $PROCESS_ID ), 'sig_install: kill USR1 myself 2' ) ;
        is( 3, $mysync->{ tototo_calls }, 'sig_install: tototo call nb 3' ) ;


        local $SIG{ USR1 } = local $SIG{ USR2 } = sub {  } ;
        is( 1, kill( 'USR1', $PROCESS_ID ), 'sig_install: kill USR1 myself 3' ) ;
        is( 3, $mysync->{ tototo_calls }, 'sig_install: tototo call still nb 3' ) ;

        # Assign USR1 + USR2 to call sub tototo
        is( undef, sig_install( $mysync, 'tototo', 'USR1', 'USR2' ), 'sig_install: USR1 USR2 tototo' ) ;
        is( 1, kill( 'USR1', $PROCESS_ID ), 'sig_install: kill USR1 myself 4' ) ;
        is( 4, $mysync->{ tototo_calls }, 'sig_install: tototo call now nb 4' ) ;

        is( 1, kill( 'USR2', $PROCESS_ID ), 'sig_install: kill USR1 myself 2' ) ;
        is( 5, $mysync->{ tototo_calls },  'sig_install: tototo call now nb 5' ) ;
        }


        note( 'Leaving  tests_sig_install()' ) ;
        return ;
}


#
sub sig_install 
{
        my $mysync = shift ;
        if ( ! $mysync ) { return ; }
        my $mysubname = shift ;
        if ( ! $mysubname ) { return ; }

        if ( ! @ARG ) { return ; }
        
        my @signals = @ARG ;
        
        my $mysub = \&$mysubname ;
        #$mysync->{ debugsig } = 1 ;
        $mysync->{ debugsig } and myprint( "In sig_install with sub $mysubname and signal @ARG\n" ) ;

        my $subsignal = sub {
                my $signame = shift ;
                $mysync->{ debugsig } and myprint( "In subsignal with $signame and $mysubname\n" ) ;
                &$mysub( $mysync, $signame ) ;
        } ;

        foreach my $signal ( @signals ) {
                $mysync->{ debugsig } and myprint(  "Installing signal $signal to call sub $mysubname\n") ;
                output( $mysync, "kill -$signal $PROCESS_ID # special behavior: call to sub $mysubname\n" ) ;
                ## no critic (RequireLocalizedPunctuationVars)
                $SIG{ $signal } = $subsignal ;
        }
        return ;
}


sub tototo
{
        my $mysync = shift ;
        myprint("In tototo with @ARG\n" ) ;
        $mysync->{ tototo_calls } += 1 ;
        return ;
}

sub mygetppid
{
        if ( 'MSWin32' eq $OSNAME ) {
                return( 'unknown under MSWin32 (too complicated)'  ) ;
        } else {
                # Unix
                return( getppid(  ) ) ;
        }
}



sub tests_toggle_sleep
{
        note( 'Entering tests_toggle_sleep()' ) ;

        is( undef, toggle_sleep(  ),  'toggle_sleep: no args => undef' ) ;
        my $mysync ;
        is( undef, toggle_sleep( $mysync ),  'toggle_sleep: undef => undef' ) ;
        $mysync = {  } ;
        is( undef, toggle_sleep( $mysync ),  'toggle_sleep: no maxsleep => undef' ) ;

        $mysync->{maxsleep} = 3 ;
        is( 0, toggle_sleep( $mysync ),  'toggle_sleep: 3 => 0' ) ;

        is( $MAX_SLEEP, toggle_sleep( $mysync ),  "toggle_sleep: 0          => $MAX_SLEEP" ) ;
        is( 0,          toggle_sleep( $mysync ),  "toggle_sleep: $MAX_SLEEP => 0" ) ;
        is( $MAX_SLEEP, toggle_sleep( $mysync ),  "toggle_sleep: 0          => $MAX_SLEEP" ) ;
        is( 0,          toggle_sleep( $mysync ),  "toggle_sleep: $MAX_SLEEP => 0" ) ;

        SKIP: {
        Readonly my $SKIP_9 => 9 ;
	if ( 'MSWin32' eq $OSNAME ) { skip( 'Tests only for Unix', $SKIP_9 ) ; }
        # Default to ignore USR1 USR2 in case future install fails
        local $SIG{ USR1 } = sub {  } ;
        kill( 'USR1', $PROCESS_ID ) ;

        $mysync->{ debugsig } = 1 ;
        # Assign USR1 to call sub toggle_sleep
        is( undef, sig_install( $mysync, \&toggle_sleep, 'USR1' ), 'toggle_sleep: install USR1 toggle_sleep' ) ;


        $mysync->{maxsleep} = 4 ;
        is( 1, kill( 'USR1', $PROCESS_ID ), 'toggle_sleep: kill USR1 myself' ) ;
        is( 0, $mysync->{ maxsleep },   'toggle_sleep: toggle_sleep called => sleeps are 0s' ) ;

        is( 1, kill( 'USR1', $PROCESS_ID ), 'toggle_sleep: kill USR1 myself again' ) ;
        is( $MAX_SLEEP, $mysync->{ maxsleep },   "toggle_sleep: toggle_sleep called => sleeps are ${MAX_SLEEP}s" ) ;

        is( 1, kill( 'USR1', $PROCESS_ID ), 'toggle_sleep: kill USR1 myself' ) ;
        is( 0, $mysync->{ maxsleep },   'toggle_sleep: toggle_sleep called => sleeps are 0s' ) ;

        is( 1, kill( 'USR1', $PROCESS_ID ), 'toggle_sleep: kill USR1 myself again' ) ;
        is( $MAX_SLEEP, $mysync->{ maxsleep },   "toggle_sleep: toggle_sleep called => sleeps are ${MAX_SLEEP}s" ) ;
        }

        note( 'Leaving  tests_toggle_sleep()' ) ;
	return ;
}


sub toggle_sleep
{
        my $mysync = shift ;

        myprint("In toggle_sleep with @ARG\n" ) ;

        if ( !defined( $mysync ) ) { return ; }
        if ( !defined( $mysync->{maxsleep} ) ) { return ; }

        $mysync->{ maxsleep } = max( 0, $MAX_SLEEP - $mysync->{maxsleep} ) ;
        myprint("Resetting maxsleep to ", $mysync->{maxsleep}, "s\n" ) ;
        return $mysync->{maxsleep} ;
}

sub mypod2usage
{
        my $fh_pod2usage = shift ;

        pod2usage(
                -exitval   => 'NOEXIT',
                -noperldoc => 1,
                -verbose => 99,
                -sections => [ qw(NAME VERSION USAGE OPTIONS) ],
                -indent => 1,
                -loose => 1,
                -output => $fh_pod2usage,
        ) ;

        return ;
}

sub usage
{
	my $mysync = shift ;

        if ( ! defined $mysync ) { return ; }

        my $usage = q{} ;
        my $usage_from_pod ;
        my $usage_footer = usage_footer( $mysync ) ;

        # pod2usage writes on a filehandle only and I want a variable
        open my $fh_pod2usage, ">", \$usage_from_pod
                or do { warn $OS_ERROR ; return ; } ;
        mypod2usage( $fh_pod2usage ) ;
        close $fh_pod2usage ;

        if ( 'MSWin32' eq $OSNAME ) {
                $usage_from_pod = backslash_caret( $usage_from_pod ) ;
        }
        $usage = join( q{}, $usage_from_pod, $usage_footer ) ;

        return( $usage ) ;
}

sub tests_usage
{
        note( 'Entering tests_usage()' ) ;

        my $usage ;
        like( $usage = usage( $sync ), qr/Name:/, 'usage: contains Name:' ) ;
        myprint( $usage ) ;
        like( $usage, qr/Version:/, 'usage: contains Version:' ) ;
        like( $usage, qr/Usage:/, 'usage: contains Usage:' ) ;
        like( $usage, qr/imapsync/, 'usage: contains imapsync' ) ;

        is( undef, usage(  ), 'usage: no args => undef' ) ;

        note( 'Leaving  tests_usage()' ) ;
        return ;
}


sub usage_footer
{
	my $mysync = shift ;

        my $footer = q{} ;

        my $localhost_info = localhost_info( $mysync ) ;
        my $rcs = $mysync->{rcs} ;
        my $homepage = homepage(  ) ;

        my $imapsync_release = $STR_use_releasecheck  ;

        if ( $mysync->{releasecheck} ) {
                $imapsync_release = check_last_release(  )  ;
        }

        $footer = qq{$localhost_info
$rcs
$imapsync_release
$homepage
} ;
        return( $footer ) ;
}



sub usage_complete
{
        # Unused, I guess this function could be deleted
        my $usage = <<'EOF' ;
--skipheader   reg     : Don't take into account header keyword
                         matching  reg    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 100.
--split2      int      : same thing on host2.
--nofixInboxINBOX      : Don't fix Inbox INBOX mapping.
EOF
        return( $usage ) ;
}

sub myGetOptions
{

        # Started as a copy of Luke Ross Getopt::Long::CGI
        # https://metacpan.org/release/Getopt-Long-CGI
        # So this sub function is under the same license as Getopt-Long-CGI Luke Ross wants it,
        # which was Perl 5.6 or later licenses at the date of the copy.

        my $mysync        = shift @ARG ;
        my $arguments_ref = shift @ARG ;
        my %options       = @ARG ;

        my $mycgi = $mysync->{cgi} ;

        if ( not under_cgi_context() ) {

                # Not CGI - pass upstream for normal command line handling
                return Getopt::Long::GetOptionsFromArray( $arguments_ref, %options ) ;
        }

        # We must be in CGI context now
        if ( ! defined( $mycgi ) ) { return ; }

        my $badthings = 0 ;
        foreach my $key ( sort keys %options ) {
                my $val = $options{$key} ;

                if ( $key !~ m/^([\w\d\|]+)([=:][isf])?([\+!\@\%])?$/mxs ) {
                        $badthings++ ;
                        next ;    # Unknown item
                }

                my $name = [ split '|', $1, 1 ]->[0] ;

                if ( ( $3 || q{} ) eq '+' ) {
                        ${$val} = $mycgi->param( $name ) ;    # "Incremental" integer
                }
                elsif ( $2 ) {
                        my @values = $mycgi->multi_param( $name ) ;
                        my $type   = $2 ;

                        #myprint( "type[$type]values[@values]\$3[", $3 || q{}, "]val[$val]ref(val)[", ref($val), "]\n" ) ;
                        if ( ( $3 || q{} ) eq '%' or ref( $val ) eq 'HASH' ) {
                                my %values = map { split /=/mxs, $_ } @values ;

                                if ( $type =~ m/i$/mxs ) {
                                        foreach my $k ( keys %values ) {
                                                $values{$k} = int $values{$k} ;
                                        }
                                }
                                elsif ( $type =~ m/f$/mxs ) {
                                        foreach my $k ( keys %values ) {
                                                $values{$k} = 0 + $values{$k};
                                        }
                                }
                                if ( 'REF' eq ref $val ) {
                                        %{ ${$val} } = %values ;
                                }
                                else {
                                        %{$val} = %values ;
                                }
                        }
                        else {
                                if ( $type =~ m/i$/mxs ) {
                                        @values = map { q{} ne $_ ? int $_ : undef } @values ;
                                }
                                elsif ( $type =~ m/f$/mxs ) {
                                        @values = map { 0 + $_ } @values ;
                                }
                                if ( ( $3 || q{} ) eq '@' ) {
                                        @{ ${$val} } = @values ;
                                        my @option = map { +( "--$name", "$_" ) } @values ;
                                        push @{ $mysync->{ cmdcgi } }, @option ;
                                }
                                elsif ( ref( $val ) eq 'ARRAY' ) {
                                        @{$val} = @values ;
                                }
                                elsif ( my $value = $values[0] )
                                {
                                        ${$val} = $value ;
                                        push @{ $mysync->{ cmdcgi } }, "--$name", $value ;
                                }
                                else
                                {

                                }
                        }
                }
                else
                {
                        # Checkbox
                        # Considers only --name
                        # Should consider also --no-name and --noname
                        my $value = $mycgi->param( $name ) ;
                        if ( $value )
                        {
                                ${$val} = 1 ;
                                push @{ $mysync->{ cmdcgi } }, "--$name" ;
                        }
                        else
                        {
                                ${$val} = undef ;
                        }
                }
        }
        if ( $badthings ) {
                return ;    # undef or ()
        }
        else {
                return ( 1 ) ;
        }
}


my @blabla ; # just used to check get_options_cgi() with an array

sub tests_get_options_cgi_context
{
	note( 'Entering tests_get_options_cgi()' ) ;

# Temporary, have to think harder about testing CGI context in command line --tests
	# API:
	# * input arguments: two ways, command line or CGI
	#    * the program arguments
	#    * QUERY_STRING env variable
	# * return
	#   * QUERY_STRING length

	# CGI context
	local $ENV{SERVER_SOFTWARE} = 'Votre serviteur' ;

	# Real full test
	# = 'host1=test1.lamiral.info&user1=test1&password1=secret1&host2=test2.lamiral.info&user2=test2&password2=secret2&debugenv=on'
	my $mysync ;
	is( undef, get_options( $mysync ), 'get_options cgi context: no CGI module => undef' ) ;

	require CGI ;
	CGI->import( qw( -no_debug ) ) ;

	is( undef, get_options( $mysync ), 'get_options cgi context: no CGI param => undef' ) ;
	# Testing boolean
	$mysync->{cgi} = CGI->new( 'version=on&debugenv=on' ) ;
	local $ENV{'QUERY_STRING'} = 'version=on&debugenv=on' ;
	is( 22,   get_options( $mysync ), 'get_options cgi context: QUERY_STRING => 22' ) ;
	is(  1,   $mysync->{ version },        'get_options cgi context: --version => 1' ) ;
	# debugenv is not allowed in cgi context
	is(  undef,   $mysync->{debugenv},        'get_options cgi context: $mysync->{debugenv} => undef' ) ;

	# QUERY_STRING in this test is only for return value of get_options
	# Have to think harder, GET/POST context, is this return value a good thing?
	local $ENV{'QUERY_STRING'} = 'host1=test1.lamiral.info&user1=test1' ;
	$mysync->{cgi} = CGI->new( 'host1=test1.lamiral.info&user1=test1' ) ;
	is( 36,      get_options( $mysync,  ), 'get_options cgi context: QUERY_STRING => 36' ) ;
	is( 'test1',  $mysync->{user1},    'get_options cgi context: $mysync->{user1} => test1' ) ;
        #local $ENV{'QUERY_STRING'} = undef ;

	# Testing @
	$mysync->{cgi} = CGI->new( 'blabla=fd1' ) ;
	get_options( $mysync ) ;
	is_deeply( [ 'fd1' ],  [ @blabla ],    'get_options cgi context: @blabla => fd1' ) ;
	$mysync->{cgi} = CGI->new( 'blabla=fd1&blabla=fd2' ) ;
	get_options( $mysync ) ;
	is_deeply( [ 'fd1', 'fd2' ],  [ @blabla ],    'get_options cgi context: @blabla => fd1, fd2' ) ;

	# Testing s@ as ref
	$mysync->{cgi} = CGI->new( 'folder=fd1' ) ;
	get_options( $mysync ) ;
	is_deeply( [ 'fd1' ],  $mysync->{ folder },    'get_options cgi context: $mysync->{ folder } => fd1' ) ;
	$mysync->{cgi} = CGI->new( 'folder=fd1&folder=fd2' ) ;
	get_options( $mysync ) ;
	is_deeply( [ 'fd1', 'fd2' ], $mysync->{ folder },    'get_options cgi context: $mysync->{ folder } => fd1, fd2' ) ;

	# Testing %
	$mysync->{cgi} = CGI->new( 'f1f2h=s1=d1&f1f2h=s2=d2&f1f2h=s3=d3' ) ;
	get_options( $mysync ) ;

	is_deeply( { 's1' => 'd1', 's2' => 'd2', 's3' => 'd3' },
	$mysync->{f1f2h}, 'get_options cgi context: f1f2h => s1=d1 s2=d2 s3=d3' ) ;

	# Testing boolean ! with --noxxx, doesnot work
	$mysync->{cgi} = CGI->new( 'nodry=on' ) ;
        get_options( $mysync ) ;
	is( undef,  $mysync->{dry},    'get_options cgi context: --nodry => $mysync->{dry} => undef' ) ;

	$mysync->{cgi} = CGI->new( 'host1=example.com' ) ;
        get_options( $mysync ) ;
	is( 'example.com',  $mysync->{host1},    'get_options cgi context: --host1=example.com => $mysync->{host1} => example.com' ) ;

        #myprint( Data::Dumper->Dump( [ $mysync ] )  ) ;
	$mysync->{cgi} = CGI->new( 'simulong=' ) ;
        get_options( $mysync ) ;
	is( undef,  $mysync->{simulong},    'get_options cgi context: --simulong= => $mysync->{simulong} => undef' ) ;

	$mysync->{cgi} = CGI->new( 'simulong' ) ;
        get_options( $mysync ) ;
	is( undef,  $mysync->{simulong},    'get_options cgi context: --simulong => $mysync->{simulong} => undef' ) ;

	$mysync->{cgi} = CGI->new( 'simulong=4' ) ;
        get_options( $mysync ) ;
	is( 4,  $mysync->{simulong},    'get_options cgi context: --simulong=4 => $mysync->{simulong} => 4' ) ;
        is( undef,  $mysync->{ folder },    'get_options cgi context: --simulong=4 => $mysync->{ folder } => undef' ) ;
        #myprint( Data::Dumper->Dump( [ $mysync ] )  ) ;

        $mysync ={} ;
	$mysync->{cgi} = CGI->new( 'justfoldersizes=on' ) ;
        get_options( $mysync ) ;
	is( 1,  $mysync->{ justfoldersizes },    'get_options cgi context: --justfoldersizes=1 => justfoldersizes => 1' ) ;
        myprint( Data::Dumper->Dump( [ $mysync ] )  ) ;

	note( 'Leaving  tests_get_options_cgi_context()' ) ;
	return ;
}



sub get_options_cgi
{
        # In CGI context arguments are not in @ARGV but in QUERY_STRING variable (with GET).
	my $mysync = shift @ARG ;
	$mysync->{cgi} || return ;
	my @arguments = @ARG ;
	# final 0 is used to print usage when no option is given
        my $numopt = length $ENV{'QUERY_STRING'} || 1 ;
	$mysync->{f1f2h} = {} ;
        my $opt_ret = myGetOptions(
	$mysync,
	\@arguments,
	'abort'            => \$mysync->{abort},
        'host1=s'          => \$mysync->{host1},
        'host2=s'          => \$mysync->{host2},
        'user1=s'          => \$mysync->{user1},
        'user2=s'          => \$mysync->{user2},
        'password1=s'      => \$mysync->{password1},
        'password2=s'      => \$mysync->{password2},
        'dry!'             => \$mysync->{dry},
        'version'          => \$mysync->{version},
        'ssl1!'            => \$mysync->{ssl1},
        'ssl2!'            => \$mysync->{ssl2},
        'tls1!'            => \$mysync->{tls1},
        'tls2!'            => \$mysync->{tls2},
        'justlogin!'       => \$mysync->{justlogin},
        'justconnect!'     => \$mysync->{justconnect},
        'addheader!'       => \$mysync->{addheader},
        'automap!'         => \$mysync->{automap},
        'justautomap!'     => \$mysync->{justautomap},
	'gmail1'           => \$mysync->{gmail1},
	'gmail2'           => \$mysync->{gmail2},
	'office1'          => \$mysync->{office1},
	'office2'          => \$mysync->{office2},
	'exchange1'        => \$mysync->{exchange1},
	'exchange2'        => \$mysync->{exchange2},
	'domino1'          => \$mysync->{domino1},
	'domino2'          => \$mysync->{domino2},
        'f1f2=s@'          => \$mysync->{f1f2},
        'f1f2h=s%'         => \$mysync->{f1f2h},
        'folder=s@'        => \$mysync->{ folder },
        'blabla=s'         => \@blabla,
        'testslive!'       => \$mysync->{testslive},
        'testslive6!'      => \$mysync->{testslive6},
        'releasecheck!'    => \$mysync->{releasecheck},
        'simulong=i'       => \$mysync->{simulong},
        'debugsleep=f'     => \$mysync->{debugsleep},
        'subfolder1=s'     => \$mysync->{ subfolder1 },
        'subfolder2=s'     => \$mysync->{ subfolder2 },
        'justfolders!'     => \$mysync->{ justfolders },
        'justfoldersizes!' => \$mysync->{ justfoldersizes },
        'delete1!'         => \$mysync->{ delete1 },
        'delete2!'         => \$mysync->{ delete2 },
        'delete2duplicates!'  => \$mysync->{ delete2duplicates },
        'tail!'               => \$mysync->{tail},

#  blabla and f1f2h=s% could be removed but
# tests_get_options_cgi() should be split before
# with a sub tests_myGetOptions()
        ) ;

        $mysync->{ debug } and output( $mysync, "get options: [$opt_ret][$numopt]\n" ) ;

	if ( ! $opt_ret ) {
		return ;
	}
	return $numopt ;
}

sub get_options_cmd
{
        my $mysync = shift @ARG ;
        my @arguments = @ARG ;
        my $mycgi = $mysync->{cgi} ;
        # final 0 is used to print usage when no option is given on command line
        my $numopt = scalar  @arguments || 0 ;
        my $argv   = join "\x00", @arguments ;

        if ( $argv =~ m/-delete\x002/x ) {
                output( $mysync, "May be you mean --delete2 instead of --delete 2\n" ) ;
                return ;
        }
        $mysync->{f1f2h} = {} ;
        my $opt_ret = myGetOptions(
        $mysync,
        \@arguments,
        'debug!'        => \$mysync->{ debug },
        'debuglist!'    => \$debuglist,
        'debugcontent!' => \$debugcontent,
        'debugsleep=f'  => \$mysync->{debugsleep},
        'debugflags!'   => \$debugflags,
        'debugimap!'    => \$debugimap,
        'debugimap1!'   => \$debugimap1,
        'debugimap2!'   => \$debugimap2,
        'debugdev!'     => \$debugdev,
        'debugmemory!'  => \$mysync->{debugmemory},
        'debugfolders!' => \$mysync->{debugfolders},
        'debugssl=i'    => \$mysync->{debugssl},
        'debugcgi!'     => \$debugcgi,
        'debugenv!'     => \$mysync->{debugenv},
        'debugsig!'     => \$mysync->{debugsig},
        'debuglabels!'  => \$mysync->{debuglabels},
        'simulong=i'    => \$mysync->{simulong},
        'abort'         => \$mysync->{abort},
        'host1=s'       => \$mysync->{host1},
        'host2=s'       => \$mysync->{host2},
        'port1=i'       => \$mysync->{port1},
        'port2=i'       => \$mysync->{port2},
        'inet4|ipv4'    => \$mysync->{inet4},
        'inet6|ipv6'    => \$mysync->{inet6},
        'user1=s'     => \$mysync->{user1},
        'user2=s'     => \$mysync->{user2},
        'gmail1'      => \$mysync->{gmail1},
        'gmail2'      => \$mysync->{gmail2},
        'office1'     => \$mysync->{office1},
        'office2'     => \$mysync->{office2},
        'exchange1'   => \$mysync->{exchange1},
        'exchange2'   => \$mysync->{exchange2},
        'domino1'     => \$mysync->{domino1},
        'domino2'     => \$mysync->{domino2},
        'domain1=s'   => \$domain1,
        'domain2=s'   => \$domain2,
        'password1=s' => \$mysync->{password1},
        'password2=s' => \$mysync->{password2},
        'passfile1=s' => \$mysync->{ passfile1 },
        'passfile2=s' => \$mysync->{ passfile2 },
        'authmd5!'    => \$authmd5,
        'authmd51!'   => \$authmd51,
        'authmd52!'   => \$authmd52,
        'sep1=s'      => \$mysync->{ sep1 },
        'sep2=s'      => \$mysync->{ sep2 },
        'sanitize!'         => \$mysync->{ sanitize },
        'folder=s@'         => \$mysync->{ folder },
        'folderrec=s'       => \@folderrec,
        'include=s'         => \@include,
        'exclude=s'         => \@exclude,
        'noexclude'         => \$mysync->{noexclude},
        'folderfirst=s'     => \@folderfirst,
        'folderlast=s'      => \@folderlast,
        'prefix1=s'         => \$prefix1,
        'prefix2=s'         => \$prefix2,
        'subfolder1=s'      => \$mysync->{ subfolder1 },
        'subfolder2=s'      => \$mysync->{ subfolder2 },
        'fixslash2!'        => \$mysync->{ fixslash2 },
        'fixInboxINBOX!'    => \$fixInboxINBOX,
        'regextrans2=s@'    => \$mysync->{ regextrans2 },
        'mixfolders!'       => \$mixfolders,
        'skipemptyfolders!' => \$skipemptyfolders,
        'regexmess=s'       => \@regexmess,
        'noregexmess'       => \$mysync->{noregexmess},
        'skipmess=s'        => \@skipmess,
        'pipemess=s'        => \@pipemess,
        'pipemesscheck!'    => \$pipemesscheck,
        'disarmreadreceipts!' => \$disarmreadreceipts,
        'regexflag=s'         => \@regexflag,
        'noregexflag'         => \$mysync->{noregexflag},
        'filterflags!'        => \$filterflags,
        'flagscase!'          => \$flagscase,
        'syncflagsaftercopy!' => \$syncflagsaftercopy,
        'resyncflags!'        => \$mysync->{ resyncflags },
        'synclabels!'         => \$mysync->{ synclabels },
        'resynclabels!'       => \$mysync->{ resynclabels },
        'delete|delete1!'     => \$mysync->{ delete1 },
        'delete2!'            => \$mysync->{ delete2 },
        'delete2duplicates!'  => \$mysync->{ delete2duplicates },
        'delete2folders!'     => \$delete2folders,
        'delete2foldersonly=s'   => \$delete2foldersonly,
        'delete2foldersbutnot=s' => \$delete2foldersbutnot,
        'syncinternaldates!' => \$syncinternaldates,
        'idatefromheader!'   => \$idatefromheader,
        'syncacls!'          => \$syncacls,
        'maxsize=i'       => \$mysync->{ maxsize },
        'appendlimit=i'   => \$mysync->{ appendlimit },
        'truncmess=i'     => \$mysync->{ truncmess },
        'minsize=i'       => \$minsize,
        'maxage=f'        => \$maxage,
        'minage=f'        => \$minage,
        'search=s'        => \$search,
        'search1=s'       => \$search1,
        'search2=s'       => \$search2,
        'foldersizes!'      => \$foldersizes,
        'foldersizesatend!' => \$foldersizesatend,
        'dry!'              => \$mysync->{dry},
        'expunge1|expunge!' => \$mysync->{ expunge1 },
        'expunge2!'         => \$mysync->{ expunge2 },
        'uidexpunge2!'      => \$mysync->{ uidexpunge2 },
        'subscribed'  => \$subscribed,
        'subscribe!'  => \$subscribe,
        'subscribeall|subscribe_all!'  => \$subscribeall,
        'justbanner!' => \$justbanner,
        'justfolders!'=> \$mysync->{ justfolders },
        'justfoldersizes!' => \$mysync->{ justfoldersizes },
        'fast!'       => \$fast,
        'version'     => \$mysync->{version},
        'help'        => \$help,
        'timeout=i'   => \$timeout,
        'timeout1=i'   => \$mysync->{h1}->{timeout},
        'timeout2=i'   => \$mysync->{h2}->{timeout},
        'skipheader=s' => \$skipheader,
        'useheader=s' => \@useheader,
        'wholeheaderifneeded!'   => \$wholeheaderifneeded,
        'messageidnodomain!' => \$messageidnodomain,
        'skipsize!'   => \$skipsize,
        'allowsizemismatch!' => \$allowsizemismatch,
        'fastio1!'     => \$fastio1,
        'fastio2!'     => \$fastio2,
        'sslcheck!'    => \$mysync->{sslcheck},
        'ssl1!'        => \$mysync->{ssl1},
        'ssl2!'        => \$mysync->{ssl2},
        'ssl1_ssl_version=s' => \$mysync->{h1}->{sslargs}->{SSL_version},
        'ssl2_ssl_version=s' => \$mysync->{h2}->{sslargs}->{SSL_version},
        'sslargs1=s%'        => \$mysync->{h1}->{sslargs},
        'sslargs2=s%'        => \$mysync->{h2}->{sslargs},
        'tls1!'        => \$mysync->{tls1},
        'tls2!'        => \$mysync->{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,
        'tests!'          => \$mysync->{ tests },
        'testsdebug|tests_debug!' => \$mysync->{ testsdebug },
        'testsunit=s@'    => \$mysync->{testsunit},
        'testslive!'      => \$mysync->{testslive},
        'testslive6!'     => \$mysync->{testslive6},
        'justlogin!'      => \$mysync->{justlogin},
        'justconnect!'    => \$mysync->{justconnect},
        'tmpdir=s'        => \$mysync->{ tmpdir },
        'pidfile=s'       => \$mysync->{pidfile},
        'pidfilelocking!' => \$mysync->{pidfilelocking},
        'sigexit=s@'      => \$mysync->{ sigexit },
        'sigreconnect=s@' => \$mysync->{ sigreconnect },
        'sigignore=s@'    => \$mysync->{ sigignore },
        'releasecheck!'   => \$mysync->{releasecheck},
        'modulesversion|modules_version!' => \$modulesversion,
        'usecache!'    => \$usecache,
        'cacheaftercopy!' => \$cacheaftercopy,
        'debugcache!' => \$debugcache,
        'useuid!'     => \$useuid,
        'addheader!'  => \$mysync->{addheader},
        'exitwhenover=i' => \$mysync->{ exitwhenover },
        'checkselectable!' => \$mysync->{ checkselectable },
        'checkfoldersexist!' => \$mysync->{ checkfoldersexist },
        'checkmessageexists!' => \$checkmessageexists,
        'expungeaftereach!' => \$mysync->{ expungeaftereach },
        'abletosearch!'  => \$mysync->{abletosearch},
        'abletosearch1!' => \$mysync->{abletosearch1},
        'abletosearch2!' => \$mysync->{abletosearch2},
        'showpasswords!' => \$mysync->{showpasswords},
        'maxlinelength=i'        => \$maxlinelength,
        'maxlinelengthcmd=s'     => \$maxlinelengthcmd,
        'minmaxlinelength=i'     => \$minmaxlinelength,
        'debugmaxlinelength!'    => \$debugmaxlinelength,
        'fixcolonbug!'           => \$fixcolonbug,
        'create_folder_old!'     => \$create_folder_old,
        'maxmessagespersecond=f' => \$mysync->{maxmessagespersecond},
        'maxbytespersecond=i'    => \$mysync->{maxbytespersecond},
        'maxbytesafter=i'        => \$mysync->{maxbytesafter},
        'maxsleep=f'             => \$mysync->{maxsleep},
        'skipcrossduplicates!'   => \$skipcrossduplicates,
        'debugcrossduplicates!'  => \$debugcrossduplicates,
        'log!'                   => \$mysync->{log},
        'tail!'                  => \$mysync->{tail},
        'logfile=s'        => \$mysync->{logfile},
        'logdir=s'         => \$mysync->{logdir},
        'errorsmax=i'      => \$mysync->{errorsmax},
        'errorsdump!'      => \$mysync->{errorsdump},
        'fetch_hash_set=s' => \$fetch_hash_set,
        'automap!'         => \$mysync->{automap},
        'justautomap!'     => \$mysync->{justautomap},
        'id!'              => \$mysync->{id},
        'f1f2=s@'          => \$mysync->{f1f2},
        'nof1f2'           => \$mysync->{nof1f2},
        'f1f2h=s%'         => \$mysync->{f1f2h},
        'justfolderlists!' => \$mysync->{justfolderlists},
        'delete1emptyfolders' => \$mysync->{delete1emptyfolders},
        ) ;
        #myprint( Data::Dumper->Dump( [ $mysync ] )  ) ;
        $mysync->{ debug } and output( $mysync, "get options: [$opt_ret][$numopt]\n" ) ;
        my $numopt_after = scalar @arguments ;
        #myprint( "get options: [$opt_ret][$numopt][$numopt_after]\n" ) ;
        if ( $numopt_after ) {
                myprint(
                        "Extra arguments found: @arguments\n",
                        "It usually means a quoting issue in the command line ",
                        "or some misspelling options.\n",
                ) ;
                return ;
        }
        if ( ! $opt_ret ) {
                return ;
        }
        return $numopt ;
}



sub tests_get_options
{
	note( 'Entering tests_get_options()' ) ;

	# CAVEAT: still setting global variables, be careful
	# with tests, the context increases! $debug stays on for example.
	# API:
	# * input arguments: two ways, command line or CGI
	#    * the program arguments
	#    * QUERY_STRING env variable
	# * return
	#   * undef if bad things happened like
	#     * options not known
	#     * --delete 2 input
	#   * number of arguments or QUERY_STRING length
	my $mysync = {  } ;
	is( undef, get_options( $mysync, qw( --noexist ) ),                   'get_options: --noexist  => undef' ) ;
        is( undef, $mysync->{ noexist },  'get_options: --noexist  => undef' ) ;
        $mysync = {  } ;
	is( undef, get_options( $mysync, qw( --lalala --noexist --version ) ), 'get_options: --lalala --noexist --version  => undef' ) ;
        is( 1,     $mysync->{ version }, 'get_options: --version => 1' ) ;
        is( undef, $mysync->{ noexist },  'get_options: --noexist  => undef' ) ;
        $mysync = {  } ;
	is( 1,     get_options( $mysync, qw( --delete2 ) ), 'get_options: --delete2 => 1' ) ;
        is( 1, $mysync->{ delete2 },  'get_options: --delete2 => var delete2 = 1' ) ;
        $mysync = {  } ;
	is( undef, get_options( $mysync, qw( --delete 2 ) ), 'get_options: --delete 2 => var undef' ) ;
        is( undef, $mysync->{ delete1 },  'get_options: --delete 2 => var still undef ; good!' ) ;
        $mysync = {  } ;
	is( undef, get_options( $mysync, "--delete  2" ), 'get_options: --delete  2 => undef' ) ;

	is( 1,     get_options( $mysync, "--version" ), 'get_options: --version => 1' ) ;
	is( 1,     get_options( $mysync, "--help" ), 'get_options: --help => 1' ) ;

	is( undef, get_options( $mysync, qw( --noexist --version ) ), 'get_options: --debug --noexist --version  => undef' ) ;
	is( 1,     get_options( $mysync, qw( --version ) ), 'get_options: --version => 1' ) ;
	is( undef, get_options( $mysync, qw( extra ) ), 'get_options: extra => undef' ) ;
	is( undef, get_options( $mysync, qw( extra1 --version extra2 ) ), 'get_options: extra1 --version extra2 => undef' ) ;

        $mysync = {  } ;
        is( 2, get_options( $mysync, qw( --host1 HOST_01) ), 'get_options: --host1 HOST_01 => 1' ) ;
        is( 'HOST_01',  $mysync->{ host1 }, 'get_options: --host1 HOST_01 => HOST_01' ) ;
        #myprint( Data::Dumper->Dump( [ $mysync ] )  ) ;

	note( 'Leaving  tests_get_options()' ) ;
	return ;
}



sub get_options
{
	my $mysync = shift @ARG ;
	my @arguments = @ARG ;
        #myprint( "1 mysync: ", Data::Dumper->Dump( [ $mysync ] ) ) ;
        my $ret ;
	if ( under_cgi_context(  ) ) {
		# CGI context
		$ret = get_options_cgi( $mysync, @arguments )  ;
	}else{
		# Command line context ;
		$ret = get_options_cmd( $mysync, @arguments )  ;
	} ;
        #myprint( "2 mysync: ", Data::Dumper->Dump( [ $mysync ] ) ) ;
        foreach my $key ( sort keys %{ $mysync } ) {
                if ( ! defined $mysync->{$key} ) {
                        delete $mysync->{$key} ;
                        next ;
                }
                if ( 'ARRAY' eq ref( $mysync->{$key} )
                     and 0 == scalar( @{ $mysync->{$key} } ) ) {
                        delete $mysync->{$key} ;
                }
        }
	return $ret ;
}

sub testunitsession
{
	my $mysync = shift ;

	if ( ! $mysync ) { return ; }
	if ( ! $mysync->{ testsunit } ) { return ; }

	my @functions = @{ $mysync->{ testsunit } } ;

	if ( ! @functions ) { return ; }

	SKIP: {
		if ( ! @functions ) { skip 'No test in normal run' ; }
		testsunit( @functions ) ;
                done_testing(  ) ;
	}
	return ;
}

sub tests_count_0s
{
	note( 'Entering tests_count_zeros()' ) ;
	is( 0, count_0s(  ), 'count_0s: no parameters => 0' ) ;
	is( 1, count_0s( 0 ), 'count_0s: 0 => 1' ) ;
	is( 0, count_0s( 1 ), 'count_0s: 1 => 0' ) ;
	is( 1, count_0s( 1, 0, 1 ), 'count_0s: 1, 0, 1 => 1' ) ;
	is( 2, count_0s( 1, 0, 1, 0 ), 'count_0s: 1, 0, 1, 0 => 2' ) ;
	note( 'Leaving  tests_count_zeros()' ) ;
	return ;
}
sub count_0s
{
	my @array = @ARG ;

	if ( ! @array ) { return 0 ; }
	my $nb_zeros = 0 ;
	map { $_ == 0 and $nb_zeros += 1 } @array ;
	return $nb_zeros ;
}

sub tests_report_failures
{
        note( 'Entering tests_report_failures()' ) ;

	is( undef, report_failures(  ), 'report_failures: no parameters => undef' ) ;
	is( "nb 1 - first\n", report_failures( ({'ok' => 0, name => 'first'}) ), 'report_failures: "first" failed => nb 1 - first' ) ;
	is( q{}, report_failures( ( {'ok' => 1, name => 'first'} ) ), 'report_failures: "first" success =>' ) ;
	is( "nb 2 - second\n", report_failures( ( {'ok' => 1, name => 'second'}, {'ok' => 0, name => 'second'} ) ), 'report_failures: "second" failed => nb 2 - second' ) ;
	is( "nb 1 - first\nnb 2 - second\n", report_failures( ( {'ok' => 0, name => 'first'}, {'ok' => 0, name => 'second'} ) ), 'report_failures: both failed => nb 1 - first nb 2 - second' ) ;
	note( 'Leaving  tests_report_failures()' ) ;
	return ;
}

sub report_failures
{
	my @details = @ARG ;

	if ( ! @details ) { return ; }

	my $counter = 1 ;
	my $report  = q{} ;
	foreach my $details ( @details ) {
		if ( ! $details->{ 'ok' } ) {
			my $name = $details->{ 'name' } || 'NONAME' ;
			$report .= "nb $counter - $name\n" ;
		}
		$counter += 1 ;
	}
	return $report ;

}

sub tests_true
{
	note( 'Entering tests_true()' ) ;

	is( 1, 1, 'true: 1 is 1' ) ;
	note( 'Leaving  tests_true()' ) ;
	return ;
}

sub tests_testsunit
{
	note( 'Entering tests_testunit()' ) ;

	is( undef, testsunit(  ), 'testsunit: no parameters => undef' ) ;
	is( undef, testsunit( undef ), 'testsunit: an undef parameter => undef' ) ;
	is( undef, testsunit( q{} ), 'testsunit: an empty parameter => undef' ) ;
	is( undef, testsunit( 'idonotexist' ), 'testsunit: a do not exist function as parameter => undef' ) ;
	is( undef, testsunit( 'tests_true' ), 'testsunit: tests_true => undef' ) ;
	note( 'Leaving  tests_testunit()' ) ;
	return ;
}

sub testsunit
{
	my @functions = @ARG ;

	if ( ! @functions ) { #
                myprint( "testsunit warning: no argument given\n" ) ;
                return ;
        }

	foreach my $function ( @functions ) {
		if ( ! $function ) {
                        myprint( "testsunit warning: argument is empty\n" ) ;
                        next ;
                }
		if ( ! exists &$function ) {
                        myprint( "testsunit warning: function $function does not exist\n" ) ;
                        next ;
                }
		if ( ! defined &$function ) {
                        myprint( "testsunit warning: function $function is not defined\n" ) ;
                        next ;
                }
		my $function_ref = \&{ $function } ;
		&$function_ref() ;
	}
	return ;
}

sub testsdebug
{
        # Now a little obsolete since there is
        # imapsync ... --testsunit "anyfunction"
        my $mysync = shift ;
        if ( ! $mysync->{ testsdebug } ) { return ; }
        SKIP: {
                if ( ! $mysync->{ testsdebug } ) {
                        skip 'No test in normal run' ;
                }

                note( 'Entering testsdebug()' ) ;
                ok( ( ( not -d 'W/tmp/tests' ) or rmtree( 'W/tmp/tests/' ) ), 'testsdebug: rmtree W/tmp/tests' ) ;
                tests_check_binary_embed_all_dyn_libs(  ) ;
                note( 'Leaving  testsdebug()' ) ;
                done_testing(  ) ;
        }
        return ;
}


sub tests
{
        my $mysync = shift ;
        if ( ! $mysync->{ tests } ) { return ; }

        SKIP: {
                skip 'No test in normal run' if ( ! $mysync->{ tests } ) ;
                note( 'Entering tests()' ) ;
                tests_folder_routines(  ) ;
                tests_compare_lists(  ) ;
                tests_regexmess(  ) ;
                tests_skipmess(  ) ;
                tests_flags_regex();
                tests_ucsecond(  ) ;
                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_flagscase(  ) ;
                tests_mkpath(  ) ;
                tests_extract_header(  ) ;
                tests_decompose_header(  ) ;
                tests_epoch(  ) ;
                tests_add_header(  ) ;
                tests_cache_dir_fix(  ) ;
                tests_cache_dir_fix_win(  ) ;
                tests_filter_forbidden_characters(  ) ;
                tests_cache_folder(  ) ;
                tests_time_remaining(  ) ;
                tests_decompose_regex(  ) ;
                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(  ) ;
                tests_setlogfile(  ) ;
                tests_jux_utf8(  ) ;
                tests_pipemess(  ) ;
                tests_jux_utf8_list(  ) ;
                tests_guess_prefix(  ) ;
                tests_guess_separator(  ) ;
                tests_format_for_imap_arg(  ) ;
                tests_imapsync_id(  ) ;
                tests_date_from_rcs(  ) ;
                tests_quota_extract_storage_limit_in_bytes(  ) ;
                tests_quota_extract_storage_current_in_bytes(  ) ;
                tests_guess_special(  ) ;
                tests_do_valid_directory(  ) ;
                tests_delete1emptyfolders(  ) ;
                tests_message_for_host2(  ) ;
                tests_length_ref(  ) ;
                tests_firstline(  ) ;
                tests_diff_or_NA(  ) ;
                tests_match_number(  ) ;
                tests_all_defined(  ) ;
                tests_special_from_folders_hash(  ) ;
		tests_notmatch(  ) ;
		tests_match(  ) ;
		tests_get_options(  ) ;
		tests_get_options_cgi_context(  ) ;
		tests_rand32(  ) ;
		tests_hashsynclocal(  ) ;
		tests_hashsync(  ) ;
		tests_output(  ) ;
		tests_output_reset_with(  ) ;
		tests_output_start(  ) ;
		tests_check_last_release(  ) ;
		tests_loadavg(  ) ;
		tests_cpu_number(  ) ;
		tests_load_and_delay(  ) ;
		#tests_imapsping(  ) ;
		#tests_tcpping(  ) ;
		tests_sslcheck(  ) ;
		tests_not_long_imapsync_version_public(  ) ;
		tests_reconnect_if_needed(  ) ;
		tests_reconnect_12_if_needed(  ) ;
		tests_sleep_if_needed(  ) ;
		tests_string_to_file(  ) ;
		tests_file_to_string(  ) ;
		tests_under_cgi_context(  ) ;
		tests_umask(  ) ;
		tests_umask_str(  ) ;
		tests_set_umask(  ) ;
		tests_createhashfileifneeded(  ) ;
		tests_move_slash(  ) ;
		tests_testsunit(  ) ;
		tests_count_0s(  ) ;
		tests_report_failures(  ) ;
		tests_min(  ) ;
		#tests_resolv(  ) ;
		#tests_resolvrev(  ) ;
		tests_connect_socket(  ) ;
                tests_probe_imapssl(  ) ;
                tests_mailimapclient_connect(  ) ;
                tests_usage(  ) ;
                tests_version_from_rcs(  ) ;
                tests_backslash_caret(  ) ;
                #tests_mailimapclient_connect_bug(  ) ; # it fails with Mail-IMAPClient <= 3.39
                tests_write_pidfile(  ) ;
                tests_remove_pidfile_not_running(  ) ;
                tests_match_a_pid_number(  ) ;
                tests_prefix_seperator_invertion(  ) ;
                tests_is_an_integer(  ) ;
                tests_integer_or_1(  ) ;
                tests_is_number(  ) ;
                tests_sig_install(  ) ;
                tests_template(  ) ;
                tests_split_around_equal(  ) ;
                tests_toggle_sleep(  ) ;
                tests_labels(  ) ;
                tests_synclabels(  ) ;
                tests_uidexpunge_or_expunge(  ) ;
                tests_appendlimit_from_capability(  ) ;
                tests_maxsize_setting(  ) ;
                tests_mock_capability(  ) ;
                tests_appendlimit(  ) ;
                tests_capability_of(  ) ;
                tests_search_in_array(  ) ;
                tests_operators_and_exclam_precedence(  ) ;
                tests_teelaunch(  ) ;
                tests_logfileprepa(  ) ;
                tests_useheader_suggestion(  ) ;
                tests_nb_messages_in_2_not_in_1(  ) ;
                tests_labels_add_subfolder2(  ) ;
                tests_labels_remove_subfolder1(  ) ;
                tests_resynclabels(  ) ;
                tests_labels_remove_special(  ) ;
                tests_uniq(  ) ;
                tests_remove_from_requested_folders(  ) ;
                tests_errors_log(  ) ;
                tests_add_subfolder1_to_folderrec(  ) ;
                tests_sanitize_subfolder(  ) ;
                tests_remove_edging_blanks(  ) ;
                tests_sanitize(  ) ;
                tests_remove_last_char_if_is(  ) ;
                tests_check_binary_embed_all_dyn_libs(  ) ;
                tests_nthline(  ) ;
                tests_secondline(  ) ;
                tests_tail(  ) ;
                tests_truncmess(  ) ;
                #tests_always_fail(  ) ;
                done_testing( 1454 ) ;
                note( 'Leaving  tests()' ) ;
        }
        return ;
}

sub tests_template
{
        note( 'Entering tests_template()' ) ;

        is( undef, undef,  'template: undef is undef' ) ;
        is_deeply( {}, {}, 'template: a hash is a hash' ) ;
        is_deeply( [], [], 'template: an array is an array' ) ;
        note( 'Leaving  tests_template()' ) ;
        return ;
}