#!/usr/local/cpanel/3rdparty/bin/perl

###########
## mvmail
## Used to help transfer email using IMAP or rsync.
## Wiki link:      https://confluence.endurance.com/display/HGS2/Migrations%3A+mvmail
## Please submit all bug reports at https://jira.endurance.com
##
## Based on the GPL imapmigrate utility at http://sourceforge.net/projects/cyrus-utils/
############


# To link:
# The dependent modules to link have to be in the currnet directory:
#      Mail/IMAPClient.pm
#      Crypt/PasswdMD5.pm
# perl-link.pl -s imapm -m Mail::IMAPClient -m Crypt::PasswdMD5 -o imapm-linked
# Comment out the __END__ on line 174 (in the Crypt::PasswdMD5 


# Todo: 
#
#--list
#imap_list     <-- list version of imap_transfer
#imap_listmail <-- list version of imap_copymail
#
#http://search.cpan.org/~djkernen/Mail-IMAPClient/IMAPClient.pod#message_count
#       my $msgcount = $imap->message_count($folder); 
#        defined($msgcount) or die "Could not message_count: $@\n";
#

#I have seen a Smartermail IMAP server at the old host that does not accept the Mail::IMAPClient login.  This is apparently because it is not rfc compliant.  To work around this, line 305 of Mail::IMAPClient.pm may need to be changed to:
#my $string =    "Login " . ( $has_quotes ? $id : qq("$id") ) . " " . "\"" . $self->Password . "\"\r\n";

#
#---------------------------------------------------------------
#---------------- use and require statements -------------------
#---------------------------------------------------------------
#use strict;
use Data::Dumper;
use Digest::MD5 qw(md5);
#  perl-link processed: use Crypt::PasswdMD5;

BEGIN {
#
# Crypt::PasswdMD5: Module to provide an interoperable crypt() 
#	function for modern Unix O/S. This is based on the code for
#
# /usr/src/libcrypt/crypt.c
#
# on a FreeBSD 2.2.5-RELEASE system, which included the following
# notice.
#
# ----------------------------------------------------------------------------
# "THE BEER-WARE LICENSE" (Revision 42):
# <phk@login.dknet.dk> wrote this file.  As long as you retain this notice you
# can do whatever you want with this stuff. If we meet some day, and you think
# this stuff is worth it, you can buy me a beer in return.   Poul-Henning Kamp
# ----------------------------------------------------------------------------
#
# $Id: PasswdMD5.pm,v 1.3 2004/02/17 11:21:38 lem Exp $
#
################

package Crypt::PasswdMD5;
$VERSION='1.3';
require 5.000;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(unix_md5_crypt apache_md5_crypt);

=head1 NAME

Crypt::PasswdMD5 - Provides interoperable MD5-based crypt() functions

=head1 SYNOPSIS

    use Crypt::PasswdMD5;

    $cryptedpassword = unix_md5_crypt($password, $salt);
    $apachepassword = apache_md5_crypt($password, $salt);


=head1 DESCRIPTION

the C<unix_md5_crypt()> provides a crypt()-compatible interface to the
rather new MD5-based crypt() function found in modern operating systems.
It's based on the implementation found on FreeBSD 2.2.[56]-RELEASE and
contains the following license in it:

 "THE BEER-WARE LICENSE" (Revision 42):
 <phk@login.dknet.dk> wrote this file.  As long as you retain this notice you
 can do whatever you want with this stuff. If we meet some day, and you think
 this stuff is worth it, you can buy me a beer in return.   Poul-Henning Kamp

C<apache_md5_crypt()> provides a function compatible with Apache's
C<.htpasswd> files. This was contributed by Bryan Hart <bryan@eai.com>.
As suggested by William A. Rowe, Jr. <wrowe@lnd.com>, it is 
exported by default.

For both functions, if a salt value is not supplied, a random salt will be
generated.  Contributed by John Peacock <jpeacock@cpan.org>.

=cut

$Magic = q/$1$/;			# Magic string
$itoa64 = "./0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz";

use Digest::MD5;

sub to64 {
    my ($v, $n) = @_;
    my $ret = '';
    while (--$n >= 0) {
	$ret .= substr($itoa64, $v & 0x3f, 1);
	$v >>= 6;
    }
    $ret;
}

sub apache_md5_crypt {
	# change the Magic string to match the one used by Apache
	local $Magic = q/$apr1$/;
	
	unix_md5_crypt(@_);
}

sub unix_md5_crypt {
    my($pw, $salt) = @_;
    my $passwd;

    if ( defined $salt ) {

	$salt =~ s/^\Q$Magic//;	# Take care of the magic string if
				# if present.

	$salt =~ s/^(.*)\$.*$/$1/;	# Salt can have up to 8 chars...
	$salt = substr($salt, 0, 8);
    }
    else {
	$salt = '';	 	# in case no salt was proffered
	$salt .= substr($itoa64,int(rand(64)+1),1)
			while length($salt) < 8;
    }

    $ctx = new Digest::MD5;		# Here we start the calculation
    $ctx->add($pw);		# Original password...
    $ctx->add($Magic);		# ...our magic string...
    $ctx->add($salt);		# ...the salt...

    my ($final) = new Digest::MD5;
    $final->add($pw);
    $final->add($salt);
    $final->add($pw);
    $final = $final->digest;

    for ($pl = length($pw); $pl > 0; $pl -= 16) {
	$ctx->add(substr($final, 0, $pl > 16 ? 16 : $pl));
    }

				# Now the 'weird' xform

    for ($i = length($pw); $i; $i >>= 1) {
	if ($i & 1) { $ctx->add(pack("C", 0)); }
				# This comes from the original version,
				# where a memset() is done to $final
				# before this loop.
	else { $ctx->add(substr($pw, 0, 1)); }
    }

    $final = $ctx->digest;
				# The following is supposed to make
				# things run slower. In perl, perhaps
				# it'll be *really* slow!

    for ($i = 0; $i < 1000; $i++) {
	$ctx1 = new Digest::MD5;
	if ($i & 1) { $ctx1->add($pw); }
	else { $ctx1->add(substr($final, 0, 16)); }
	if ($i % 3) { $ctx1->add($salt); }
	if ($i % 7) { $ctx1->add($pw); }
	if ($i & 1) { $ctx1->add(substr($final, 0, 16)); }
	else { $ctx1->add($pw); }
	$final = $ctx1->digest;
    }
    
				# Final xform

    $passwd = '';
    $passwd .= to64(int(unpack("C", (substr($final, 0, 1))) << 16)
		    | int(unpack("C", (substr($final, 6, 1))) << 8)
		    | int(unpack("C", (substr($final, 12, 1)))), 4);
    $passwd .= to64(int(unpack("C", (substr($final, 1, 1))) << 16)
		    | int(unpack("C", (substr($final, 7, 1))) << 8)
		    | int(unpack("C", (substr($final, 13, 1)))), 4);
    $passwd .= to64(int(unpack("C", (substr($final, 2, 1))) << 16)
		    | int(unpack("C", (substr($final, 8, 1))) << 8)
		    | int(unpack("C", (substr($final, 14, 1)))), 4);
    $passwd .= to64(int(unpack("C", (substr($final, 3, 1))) << 16)
		    | int(unpack("C", (substr($final, 9, 1))) << 8)
		    | int(unpack("C", (substr($final, 15, 1)))), 4);
    $passwd .= to64(int(unpack("C", (substr($final, 4, 1))) << 16)
		    | int(unpack("C", (substr($final, 10, 1))) << 8)
		    | int(unpack("C", (substr($final, 5, 1)))), 4);
    $passwd .= to64(int(unpack("C", substr($final, 11, 1))), 2);

    $final = '';
    $Magic . $salt . q/$/ . $passwd;
}

1;

#__END__

=pod

=head2 EXPORT

None by default.


=head1 HISTORY

$Id: PasswdMD5.pm,v 1.3 2004/02/17 11:21:38 lem Exp $

 19980710 luismunoz@cpan.org: Initial release
 19990402 bryan@eai.com: Added apache_md5_crypt to create a valid hash
                        for use in .htpasswd files
 20001006 wrowe@lnd.com: Requested apache_md5_crypt to be
			exported by default.
 20010706 luismunoz@cpan.org: Use Digest::MD5 instead of the (obsolete) MD5.

$Log: PasswdMD5.pm,v $
Revision 1.3  2004/02/17 11:21:38  lem
Modified the POD so that ABSTRACT can work
Added usage example for apache_md5_crypt()

Revision 1.2  2004/02/17 11:04:35  lem
Added patch for random salts from John Peacock (Thanks John!)
De-MS-DOS-ified the file
Replaced some '' with q// to make Emacs color highlighting happy
Added CVS docs
Completed the missing sections of the POD documentation
Changed my email address to the Perl-related one for consistency
The file is now encoded in ISO-8859-1


=head1 LICENSE AND WARRANTY

This code and all accompanying software comes with NO WARRANTY. You
use it at your own risk.

This code and all accompanying software can be used freely under the
same terms as Perl itself.

=head1 AUTHOR

Luis E. Muņoz <luismunoz@cpan.org>

=head1 SEE ALSO

perl(1).

=cut
};
Crypt::PasswdMD5->import();
$INC{'Crypt/PasswdMD5'} = "/dev/null";
#  perl-link processed: use Mail::IMAPClient::MessageSet;

BEGIN {
package Mail::IMAPClient::MessageSet;
#$Id: MessageSet.pm,v 1.3 2002/12/13 18:08:49 dkernen Exp $

=head1 NAME

Mail::IMAPClient::MessageSet -- an extension to Mail::IMAPClient that
expresses lists of message sequence numbers or message UID's in the shortest
way permissable by RFC2060.

=cut

sub str { 
	# print "Overloaded ", overload::StrVal(${$_[0]}),"\n";
	return overload::StrVal(${$_[0]}); 
}
sub rem {
	my $self = shift;
	my $minus = ref($self)->new(@_);
	my %deleted = map { $_ => 1 } @{$minus->unfold} ;
	${$self} = $self->range(
		map { exists $deleted{$_} ? () : $_ } @{$self->unfold}
	);
	return $self;	
}
sub cat {
	my $self = shift;
	my @a = ("$self",@_);
	${$self} = $self->range(@a);
	return $self;	
}
use overload 	qq/""/ => "str" ,
		qq/.=/=>"cat", 
		qq/+=/=>"cat", 
		qq/-=/=>"rem", 
		q/@{}/=>"unfold", 
		fallback => "TRUE";

sub new {
	my $class = shift;
	my $range = $class->range(@_);
	my $object = \$range;
	bless $object, $class;
	return $object ;	
}

sub range {
	my $class = shift;	
	if ( 	scalar(@_) == 1 and 
		ref($_[0]) =~ /Mail::IMAPClient::MessageSet/
	) {
		return $_[0] ;
	}

	my @msgs = ();
	for my $m (@_) {
		next if !defined($m) or $m eq "";
		if ( ref($m) ) {
		   foreach my $mm (@$m) {
			foreach my $c ( split(/,/,$mm) ) {
			 	if ( $c =~ /:/ ) {
					my($l,$h) = split(/:/,$c) ;
					push @msgs,$l .. $h ;
				} else {
					push @msgs,$c;
				}
			}
		   }
		} else {
			#print STDERR "m=$m\n";
			foreach my $c ( split(/,/,$m) ) {
			 	if ( $c =~ /:/ ) {
					my($l,$h) = split(/:/,$c) ;
					push @msgs,$l .. $h ;
				} else {
					push @msgs,$c;
				}
			}
		}
	} 
	return undef unless @msgs;
	my @range = ();
	my $high = $low = "";
	for my $m (sort {$a<=>$b} @msgs) {
		$low = $m if $low eq "";
		next if $high ne "" and $high == $m ; # been here, done this
		if ( $high eq "" ) { 
			$high = $m ;
		} elsif ( $m == $high + 1 ) {
			$high = $m ;
		} else {
			push @range, $low == $high ? "$low," : "$low:$high," ;
			$low = $m ;
			$high = $m ;
		}
	}
	push @range, $low == $high ? "$low" : "$low:$high" ;
	my $range = join("",@range);
	return $range;
}

sub unfold {
	my $self = $_[0];
	return wantarray ? 
		(	map { my($l,$h)= split(/:/,$_) ; $h?($l..$h):$l }
			split(/,/,$$self) 	
		) : 
		[	map { my($l,$h)= split(/:/,$_) ; $h?($l..$h):$l }
			split(/,/,$$self) 	
		]
	;
}

=head2 DESCRIPTION

The B<Mail::IMAPClient::MessageSet> module is designed to make life easier
for programmers who need to manipulate potentially large sets of IMAP
message UID's or sequence numbers.

This module presents an object-oriented interface into handling your message
sets. The object reference returned by the L<new> method is an overloaded 
reference to a scalar variable that contains the message set's compact
RFC2060 representation. The object is overloaded so that using it like a string
returns this compact message set representation. You can also add messages to
the set (using either a '.=' operator or a '+=' operator) or remove messages
(with the '-=' operator). And if you use it as an array reference, it will 
humor you and act like one by calling L<unfold> for you. (But you need perl 5.6
or above to do this.)

RFC2060 specifies that multiple messages can be provided to certain IMAP
commands by separating them with commas. For example, "1,2,3,4,5" would 
specify messages 1, 2, 3, 4, and (you guessed it!) 5. However, if you are
performing an operation on lots of messages, this string can get quite long.
So long that it may slow down your transaction, and perhaps even cause the
server to reject it. So RFC2060 also permits you to specifiy a range of
messages, so that messages 1, 2, 3, 4 and 5 can also be specified as
"1:5". 

This is where B<Mail::IMAPClient::MessageSet> comes in. It will convert your
message set into the shortest correct syntax. This could potentially save you 
tons of network I/O, as in the case where you want to fetch the flags for
all messages in a 10000 message folder, where the messages are all numbered
sequentially. Delimited as commas, and making the best-case assumption that 
the first message is message "1", it would take 48893 bytes to specify the 
whole message set using the comma-delimited method. To specify it as a range, 
it takes just seven bytes (1:10000). 

=head2 SYNOPSIS

To illustrate, let's take the trivial example of a search that returns these
message uids: 1,3,4,5,6,9,10, as follows:
	
	@msgs = $imap->search("SUBJECT","Virus"); # returns 1,3,4,5,6,9,10
	my $msgset = Mail::IMAPClient::MessageSet->new(@msgs);
	print "$msgset\n";  # prints "1,3:6,9:10\n"
	# add message 14 to the set:
	$msgset += 14;	
	print "$msgset\n";  # prints "1,3:6,9:10,14\n"
	# add messages 16,17,18,19, and 20 to the set:
	$msgset .= "16,17,18:20";	
	print "$msgset\n";  # prints "1,3:6,9:10,14,16:20\n"
	# Hey, I didn't really want message 17 in there; let's take it out:
	$msgset -= 17;
	print "$msgset\n";  # prints "1,3:6,9:10,14,16,18:20\n"
	# Now let's iterate over each message:
	for my $msg (@$msgset) {
		print "$msg\n";
	}       # Prints: "1\n3\n4\n5\n6\n9\n10\n14\n16\n18\n19\n20"

(Note that the L<Mail::IMAPClient> B<Range> method can be used as 
a short-cut to specifying C<Mail::IMAPClient::MessageSet-E<gt>new(@etc)>.) 

=cut

=head1 CLASS METHODS

The only class method you need to worry about is B<new>. And if you create
your B<Mail::IMAPClient::MessageSet> objects via L<Mail::IMAPClient>'s 
B<Range> method then you don't even need to worry about B<new>.

=head2 new

Example:

	my $msgset = Mail::IMAPClient::MessageSet->new(@msgs);

The B<new> method requires at least one argument. That argument can be 
either a message, a comma-separated list of messages, a colon-separated 
range of messages, or a combination of comma-separated messages and 
colon-separated ranges. It can also be a reference to an array of messages,
comma-separated message lists, and colon separated ranges.

If more then one argument is supplied to B<new>, then those arguments should
be more message numbers, lists, and ranges (or references to arrays of them)
just as in the first argument.

The message numbers passed to B<new> can really be any kind of number at
all but to be useful in a L<Mail::IMAPClient> session they should be either
message UID's (if your I<Uid> parameter is true) or message sequence numbers.

The B<new> method will return a reference to a B<Mail::IMAPClient::MessageSet>
object. That object, when double quoted, will act just like a string whose
value is the message set expressed in the shortest possible way, with the
message numbers sorted in ascending order and with duplicates removed. 

=head1 OBJECT METHODS

The only object method currently available to a B<Mail::IMAPClient::MessageSet>
object is the L<unfold> method.

=head2 unfold

Example:

	my $msgset = $imap->Range( $imap->messages ) ;
	my @all_messages = $msgset->unfold;

The B<unfold> method returns an array of messages that belong to the 
message set. If called in a scalar context it returns a reference to the 
array instead.

=head1 OVERRIDDEN OPERATIONS

B<Mail::IMAPClient::MessageSet> overrides a number of operators in order
to make manipulating your message sets easier. The overridden operations are:

=head2 stringify

Attempts to stringify a B<Mail::IMAPClient::MessageSet> object will result in
the compact message specification being returned, which is almost certainly
what you will want.

=head2 Auto-increment

Attempts to autoincrement a B<Mail::IMAPClient::MessageSet> object will 
result in a message (or messages) being added to the object's message set. 

Example:

	$msgset += 34;
	# Message #34 is now in the message set 

=head2 Concatenate

Attempts to concatenate to a B<Mail::IMAPClient::MessageSet> object will 
result in a message (or messages) being added to the object's message set. 

Example:

	$msgset .= "34,35,36,40:45";
	# Messages 34,35,36,40,41,42,43,44,and 45 are now in the message set 

The C<.=> operator and the C<+=> operator can be used interchangeably, but
as you can see by looking at the examples there are times when use of one
has an aesthetic advantage over use of the other.

=head2 Autodecrement

Attempts to autodecrement a B<Mail::IMAPClient::MessageSet> object will 
result in a message being removed from the object's message set. 

Examples:

	$msgset -= 34;
	# Message #34 is no longer in the message set 
	$msgset -= "1:10";
	# Messages 1 through 10 are no longer in the message set 

If you attempt to remove a message that was not in the original message set
then your resulting message set will be the same as the original, only more
expensive. However, if you attempt to remove several messages from the message
set and some of those messages were in the message set and some were not,
the additional overhead of checking for the messages that were not there
is negligable. In either case you get back the message set you want regardless
of whether it was already like that or not.

=cut

=head1 REPORTING BUGS

Please feel free to e-mail the author at C<bug-Mail-IMAPClient@rt.cpan.org>
if you encounter any strange behaviors. Don't worry about hurting my 
feelings or sounding like a whiner or anything like that; 
if there's a problem with this module you'll be doing me a favor by
reporting it.  However, I probably won't be able to do much about it if 
you don't include enough information, so please read and follow these
instructions carefully.

When reporting a bug, please be sure to include the following:

- As much information about your environment as possible. I especially
need to know B<which version of Mail::IMAPClient you are running> and the
B<type/version of IMAP server> to which you are connecting. Your OS and
perl verions would be helpful too.

- As detailed a description of the problem as possible. (What are you
doing? What happens? Have you found a work-around?)

- An example script that demonstrates the problem (preferably with as
few lines of code as possible!) and which calls the Mail::IMAPClient's
L<new> method with the L<Debug> parameter set to "1". (If this generates
a ridiculous amount of output and you're sure you know where the problem
is, you can create your object with debugging turned off and then 
turn it on later, just before you issue the commands that recreate the 
problem. On the other hand, if you can do this you can probably also 
reduce the program rather than reducing the output, and this would be 
the best way to go under most circumstances.)

- Output from the example script when it's running with the Debug
parameter turned on. You can edit the output to remove (or preferably
to "X" out) sensitive data, such as hostnames, user names, and
passwords, but PLEASE do not remove the text that identifies the TYPE
of IMAP server to which you are connecting. Note that in most versions
of B<Mail::IMAPClient>, debugging does not print out the user or
password from the login command line. However, if you use some other
means of authenticating then you may need to edit the debugging output
with an eye to security.

- If something worked in a previous release and doesn't work now,
please tell me which release did work. You don't have to test every
intervening release; just let me know it worked in version x but
doesn't work in version (x+n) or whatever.

- Don't be surprised if I come back asking for a trace of the problem.
To provide this, you should create a file called I<.perldb> in your
current working directory and include the following line of text in
that file:

C<&parse_options("NonStop=1 LineInfo=mail_imapclient_db.out");>

For your debugging convenience, a sample .perldb file, which was
randomly assigned the name F<sample.perldb>, is provided in the
distribution.

Next, without changing your working directory, debug the example script
like this: C<perl -d example_script.pl [ args ]>

Note that in these examples, the script that demonstrates your problem
is named "example_script.pl" and the trace output will be saved in
"mail_imapclient_db.out". You should either change these values to suit
your needs, or change your needs to suit these values.

Bug reports should be mailed to: 

	bug-Mail-IMAPClient@rt.cpan.org

Please remember to place a SHORT description of the problem in the subject
of the message. Please try to be a bit specific; things like "Bug
in Mail::IMAPClient" or "Computer Problem" won't exactly expedite things
on my end.

=head1 REPORTING THINGS THAT ARE NOT BUGS

If you have suggestions for extending this functionality of this module, or
if you have a question and you can't find an answer in any of the 
documentation (including the RFC's, which are included in this distribution
for a reason), then you can e-mail me at the following address:

	comment-Mail-IMAPClient@rt.cpan.org

Please note that this address is for questions, suggestions, and other comments
about B<Mail::IMAPClient>. It's not for reporting bugs, it's not for general 
correspondence, and it's especially not for selling porn, mortgages, Viagra, 
or anything else.

=head1 AUTHOR

	David J. Kernen
	The Kernen Consulting Group, Inc
	DJKERNEN@cpan.org

=cut

=head1 COPYRIGHT

          Copyright 1999, 2000, 2001, 2002 The Kernen Group, Inc.
          All rights reserved.

This program is free software; you can redistribute it and/or modify it
under the terms of either:

=over 4

=item a) the "Artistic License" which comes with this Kit, or

=item b) the GNU General Public License as published by the Free Software 
Foundation; either version 1, or (at your option) any later version.

=back

This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either the GNU
General Public License or the Artistic License for more details. All your
base are belong to us.

=cut

my $not_void = 11; # This module goes all the way up to 11!

# History: 
# $Log: MessageSet.pm,v $
# Revision 1.3  2002/12/13 18:08:49  dkernen
# Made changes for version 2.2.6 (see Changes file for more info)
#
# Revision 1.2  2002/11/08 15:48:42  dkernen
#
# Modified Files: Changes
# 		IMAPClient.pm
# Modified Files: MessageSet.pm
#
# Revision 1.1  2002/10/23 20:45:55  dkernen
#
# Modified Files: Changes IMAPClient.pm MANIFEST Makefile.PL
# Added Files: Makefile.PL MessageSet.pm
#
#
};
Mail::IMAPClient::MessageSet->import();
$INC{'Mail/IMAPClient/MessageSet'} = "/dev/null";
#  perl-link processed: use Mail::IMAPClient;

BEGIN {
package Mail::IMAPClient;

# $Id: IMAPClient.pm,v 20001010.20 2003/06/13 18:30:55 dkernen Exp $

$Mail::IMAPClient::VERSION = '2.2.9';
$Mail::IMAPClient::VERSION = '2.2.9';  	# do it twice to make sure it takes

use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);
use Socket();
use IO::Socket();
use IO::Select();
use IO::File();
use Carp qw(carp);
#use Data::Dumper;
use Errno qw/EAGAIN/;

#print "Found Fcntl in $INC{'Fcntl.pm'}\n";
#Fcntl->import;

use constant Unconnected => 0;

use constant Connected         => 1;         	# connected; not logged in

use constant Authenticated => 2;      		# logged in; no mailbox selected

use constant Selected => 3;   		        # mailbox selected

use constant INDEX => 0;              		# Array index for output line number

use constant TYPE => 1;               		# Array index for line type 
						#    (either OUTPUT, INPUT, or LITERAL)

use constant DATA => 2;                       	# Array index for output line data

use constant NonFolderArg => 1;			# Value to pass to Massage to 
						# indicate non-folder argument



my %SEARCH_KEYS = map { ( $_ => 1 ) } qw/
	ALL ANSWERED BCC BEFORE BODY CC DELETED DRAFT FLAGGED
	FROM HEADER KEYWORD LARGER NEW NOT OLD ON OR RECENT
	SEEN SENTBEFORE SENTON SENTSINCE SINCE SMALLER SUBJECT
	TEXT TO UID UNANSWERED UNDELETED UNDRAFT UNFLAGGED 
	UNKEYWORD UNSEEN
/;

sub _debug {
	my $self = shift;
	return unless $self->Debug;
	my $fh = $self->{Debug_fh} || \*STDERR; 
	print $fh @_;
}

sub MaxTempErrors {
	my $self = shift;
	$_[0]->{Maxtemperrors} = $_[1] if defined($_[1]);
	return $_[0]->{Maxtemperrors};
}

# This function is used by the accessor methods
#
sub _do_accessor {
  my $datum = shift;

  if ( defined($_[1]) and $datum eq 'Fast_io' and ref($_[0]->{Socket})) {
    if ($_[1]) {                      # Passed the "True" flag
      my $fcntl = 0;
      eval { $fcntl=fcntl($_[0]->{Socket}, F_GETFL, 0) } ;
      if ($@) {
      $_[0]->{Fast_io} = 0;
      carp ref($_[0]) . " not using Fast_IO; not available on this platform"
        if ( ( $^W or $_[0]->Debug) and not $_[0]->{_fastio_warning_}++);
      } else {
      $_[0]->{Fast_io} = 1;
      $_[0]->{_fcntl} = $fcntl;
      my $newflags = $fcntl;
      $newflags |= O_NONBLOCK;
      fcntl($_[0]->{Socket}, F_SETFL, $newflags) ;
      
      }
    } else {
      eval { fcntl($_[0]->{Socket}, F_SETFL, $_[0]->{_fcntl}) } 
		if exists $_[0]->{_fcntl};
      $_[0]->{Fast_io} = 0;
      delete $_[0]->{_fcntl} if exists $_[0]->{_fcntl};
    }
  } elsif ( defined($_[1]) and $datum eq 'Socket' ) {
    
    # Get rid of fcntl settings for obsolete socket handles:
    delete $_[0]->{_fcntl} ;
    # Register this handle in a select vector:
    $_[0]->{_select} = IO::Select->new($_[1]) ;
  }
  
  if (scalar(@_) > 1) {
    $@ = $_[1] if $datum eq 'LastError';
    chomp $@ if $datum eq 'LastError';
    return $_[0]->{$datum} = $_[1] ;
  } else {
    return $_[0]->{$datum};
  }
}

# the following for loop sets up eponymous accessor methods for 
# the object's parameters:

BEGIN {
 for my $datum (
		qw( 	State Port Server Folder Fast_io Peek
			User Password Socket Timeout Buffer
			Debug LastError Count Uid Debug_fh Maxtemperrors
			EnableServerResponseInLiteral
			Authmechanism Authcallback Ranges
			Readmethod Showcredentials
			Prewritemethod
		)
 ) {
        no strict 'refs';
        *$datum = sub { _do_accessor($datum, @_); };
 }

 eval {
   require Digest::HMAC_MD5;
   require MIME::Base64;
 };
 if ($@) {
   $Mail::IMAPClient::_CRAM_MD5_ERR =
     "Internal CRAM-MD5 implementation not available: $@";
   $Mail::IMAPClient::_CRAM_MD5_ERR =~ s/\n+$/\n/;
 }
}

sub Wrap { 	shift->Clear(@_); 	}

# The following class method is for creating valid dates in appended msgs:

sub Rfc822_date {
my $class=      shift;
#Date: Fri, 09 Jul 1999 13:10:55 -0000#
my $date =      $class =~ /^\d+$/ ? $class : shift ;
my @date =      gmtime($date);
my @dow  =      qw{ Sun Mon Tue Wed Thu Fri Sat };
my @mnt  =      qw{ Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec};
#
return          sprintf(
                        "%s, %2.2d %s %4.4s %2.2d:%2.2d:%2.2d -%4.4d",
                        $dow[$date[6]],
                        $date[3],
                        $mnt[$date[4]],
                        $date[5]+=1900,
                        $date[2],
                        $date[1],
                        $date[0],
                        $date[8]) ;
}

# The following class method is for creating valid dates for use in IMAP search strings:

sub Rfc2060_date {
my $class=      shift;
# 11-Jan-2000
my $date =      $class =~ /^\d+$/ ? $class : shift ;
my @date =      gmtime($date);
my @mnt  =      qw{ Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec};
#
return          sprintf(
                        "%2.2d-%s-%4.4s",
                        $date[3],
                        $mnt[$date[4]],
                        $date[5]+=1900
		) ;
}

# The following class method strips out <CR>'s so lines end with <LF> 
#	instead of <CR><LF>:

sub Strip_cr {
	my $class = shift;
	unless ( ref($_[0]) or scalar(@_) > 1 ) {
		(my $string = $_[0]) =~ s/\x0d\x0a/\x0a/gm;
		return $string;
	}
	return wantarray ?     	map { s/\x0d\x0a/\0a/gm ; $_ }  
				(ref($_[0]) ? @{$_[0]}  : @_)  		: 
				[ map { s/\x0d\x0a/\x0a/gm ; $_ } 
				  ref($_[0]) ? @{$_[0]} : @_ 
				] ;
}

# The following defines a special method to deal with the Clear parameter:

sub Clear {
	my $self = shift;
	defined(my $clear = shift) or return $self->{Clear}; 
	
	my $oldclear   = $self->{Clear};
	$self->{Clear} = $clear;

	my (@keys) = sort { $b <=> $a } keys %{$self->{"History"}}  ;

	for ( my $i = $clear; $i < @keys ; $i++ ) 
		{ delete $self->{'History'}{$keys[$i]} }

	return $oldclear;
}

# read-only access to the transaction number:
sub Transaction { shift->Count };

# the constructor:
sub new {
	my $class 	= shift;
	my $self  	= 	{
		LastError	=> "", 
		Uid 		=> 1, 
		Count 		=> 0,
		Fast_io 	=> 1,
		"Clear"		=> 5, 
	};
	while (scalar(@_)) {
		$self->{ucfirst(lc($_[0]))} = $_[1]; shift, shift;
	}
	bless $self, ref($class)||$class;

	$self->State(Unconnected);

	$self->{Debug_fh} ||= \*STDERR;
	select((select($self->{Debug_fh}),$|++)[0]) ;
 	$self->_debug("Using Mail::IMAPClient version $Mail::IMAPClient::VERSION " .
		"and perl version " . (defined $^V ? join(".",unpack("CCC",$^V)) : "") . 
		" ($])\n") if $self->Debug;
	$self->LastError(0);
	$self->Maxtemperrors or $self->Maxtemperrors("unlimited") ;
	return $self->connect if $self->Server and !$self->Socket;
	return $self;
}


sub connect {
	my $self = shift;
	
	$self->Port(143) 
		if 	defined ($IO::Socket::INET::VERSION) 
		and 	$IO::Socket::INET::VERSION eq '1.25' 
		and 	!$self->Port;
	%$self = (%$self, @_);
	my $sock = IO::Socket::INET->new(
		PeerAddr => $self->Server		,
                PeerPort => $self->Port||'imap(143)'	,
                Proto    => 'tcp' 			,
                Timeout  => $self->Timeout||0		,
		Debug	=> $self->Debug 		,
	)						;

	unless ( defined($sock) ) {
		
		$self->LastError( "Unable to connect to $self->{Server}: $!\n");	
		$@ 		= "Unable to connect to $self->{Server}: $!";	
		carp 		  "Unable to connect to $self->{Server}: $!" 
				unless defined wantarray;	
		return undef;
	}
	$self->Socket($sock);
	$self->State(Connected);

	$sock->autoflush(1)				;
	
	my ($code, $output);
        $output = "";

        until ( $code ) {

                $output = $self->_read_line or return undef;
                for my $o (@$output) {
			$self->_debug("Connect: Received this from readline: " . 
					join("/",@$o) . "\n");
                        $self->_record($self->Count,$o);	# $o is a ref
                      next unless $o->[TYPE] eq "OUTPUT";
                      ($code) = $o->[DATA] =~ /^\*\s+(OK|BAD|NO)/i  ;
                }

        }

	if ($code =~ /BYE|NO /) {
		$self->State(Unconnected);
		return undef ;
	}

	if ($self->User and $self->Password) {
		return $self->login ;
	} else {
		return $self;	
	}
}
	

sub login {
	my $self = shift;
	return $self->authenticate($self->Authmechanism,$self->Authcallback) 
		if $self->{Authmechanism};

	my $id   = $self->User;
	my $has_quotes = $id =~ /^".*"$/ ? 1 : 0;
	#my $string =   "Login " . ( $has_quotes ? $id : qq("$id") ) . " " . 
	#               "{" . length($self->Password) . 
	#               "}\r\n".$self->Password."\r\n";

	my $string =    "Login " . ( $has_quotes ? $id : qq("$id") ) . " " . "\"" . $self->Password . "\"\r\n";

	$self->_imap_command($string) 
		and $self->State(Authenticated);
	# $self->folders and $self->separator unless $self->NoAutoList;
	unless ( $self->IsAuthenticated) {
		my($carp) 	=  $self->LastError;
		$carp 		=~ s/^[\S]+ ([^\x0d\x0a]*)\x0d?\x0a/$1/;
 		carp $carp unless defined wantarray;
		return undef;
	}
	return $self;
}

sub separator {
	my $self = shift;
	my $target = shift ; 

	unless ( defined($target) ) {
		my $sep = "";
		# 	separator is namespace's 1st thing's 1st thing's 2nd thing:
		eval { 	$sep = $self->namespace->[0][0][1] } 	;
		return $sep if $sep;
	}	
		
	defined($target) or $target = "";
	$target ||= '""' ;
	
	

	# The fact that the response might end with {123} doesn't really matter here:

	unless (exists $self->{"$target${;}SEPARATOR"}) {
		my $list = (grep(/^\*\s+LIST\s+/,($self->list(undef,$target)||("NO")) ))[0] || 
				qq("/");
		my $s = (split(/\s+/,$list))[3];
		defined($s) and $self->{"$target${;}SEPARATOR"} = 
				( $s eq 'NIL' ? 'NIL' : substr($s, 1,length($s)-2) );
	}
	return $self->{$target,'SEPARATOR'};
}

sub sort {
    my $self = shift;
    my @hits;
    my @a = @_;
    $@ = "";
    $a[0] = "($a[0])" unless $a[0] =~ /^\(.*\)$/;      # wrap criteria in parens
    $self->_imap_command( ( $self->Uid ? "UID " : "" ) . "SORT ". join(' ',@a))
         or return wantarray ? @hits : \@hits ;
    my @results =  $self->History($self->Count);

    for my $r (@results) {
        chomp $r;
        $r =~ s/\r$//;
        $r =~ s/^\*\s+SORT\s+// or next;   
        push @hits, grep(/\d/,(split(/\s+/,$r)));
    }
    return wantarray ? @hits : \@hits;     
}

sub list {
	my $self = shift;
	my ($reference, $target) = (shift, shift);
	$reference = "" unless defined($reference);
	$target = '*' unless defined($target);
	$target = '""' if $target eq "";
	$target 	  = $self->Massage($target) unless $target eq '*' or $target eq '""';
	my $string 	=  qq(LIST "$reference" $target);
	$self->_imap_command($string)  or return undef;
	return wantarray ? 	
			$self->History($self->Count) 				  : 
                       	[ map { $_->[DATA] } @{$self->{'History'}{$self->Count}}] ;
}

sub lsub {
	my $self = shift;
	my ($reference, $target) = (shift, shift);
	$reference = "" unless defined($reference);
	$target = '*' unless defined($target);
	$target           = $self->Massage($target);
	my $string      =  qq(LSUB "$reference" $target);
	$self->_imap_command($string)  or return undef;
	return wantarray ?      $self->History($self->Count)            : 
                              [ map { $_->[DATA] } @{$self->{'History'}{$self->Count}}        ] ;
}

sub subscribed {
        my $self = shift;
	my $what = shift ;

        my @folders ;  

	my @list = $self->lsub(undef,( $what? "$what" . 
		$self->separator($what) . "*" : undef ) );
	push @list, $self->lsub(undef, $what) if $what and $self->exists($what) ;

      	# my @list = map { $self->_debug("Pushing $_->[${\(DATA)}] \n"); $_->[DATA] } 
	#	@$output;

	my $m;

	for ($m = 0; $m < scalar(@list); $m++ ) {
		if ($list[$m] && $list[$m]  !~ /\x0d\x0a$/ ) {
			$list[$m] .= $list[$m+1] ;
			$list[$m+1] = "";	
		}
			
		
		# $self->_debug("Subscribed: examining $list[$m]\n");

		push @folders, $1||$2 
			if $list[$m] =~
                        /       ^\*\s+LSUB               # * LSUB
                                \s+\([^\)]*\)\s+         # (Flags)
                                (?:"[^"]*"|NIL)\s+	 # "delimiter" or NIL
                                (?:"([^"]*)"|(.*))\x0d\x0a$  # Name or "Folder name"
                        /ix;

        } 

        # for my $f (@folders) { $f =~ s/^\\FOLDER LITERAL:://;}
	my @clean = () ; my %memory = (); 
	foreach my $f (@folders) { push @clean, $f unless $memory{$f}++ }
        return wantarray ? @clean : \@clean ;
}


sub deleteacl {
	my $self = shift;
	my ($target, $user ) = @_;
	$target 	  = $self->Massage($target);
	$user		  =~ s/^"(.*)"$/$1/;
	$user 	  	  =~ s/"/\\"/g;
	my $string 	=  qq(DELETEACL $target "$user");
	$self->_imap_command($string)  or return undef;

	return wantarray ? 	$self->History($self->Count) 				: 
                              [ map {$_->[DATA] } @{$self->{'History'}{$self->Count}}] ;
}

sub setacl {
        my $self = shift;
        my ($target, $user, $acl) = @_;
        $user = $self->User unless length($user);
        $target = $self->Folder unless length($target);
        $target           = $self->Massage($target);
        $user             =~ s/^"(.*)"$/$1/;
        $user             =~ s/"/\\"/g;
        $acl              =~ s/^"(.*)"$/$1/;
        $acl              =~ s/"/\\"/g;
        my $string      =  qq(SETACL $target "$user" "$acl");
        $self->_imap_command($string)  or return undef;
        return wantarray			?
		$self->History($self->Count)	:
		[map{$_->[DATA]}@{$self->{'History'}{$self->Count}}]
	;
}


sub getacl {
        my $self = shift;
        my ($target) = @_;
        $target = $self->Folder unless defined($target);
        my $mtarget           = $self->Massage($target);
        my $string      =  qq(GETACL $mtarget);
        $self->_imap_command($string)  or return undef;
	my @history = $self->History($self->Count);
	#$self->_debug("Getacl history: ".join("|",@history).">>>End of History<<<" ) ;
	my $perm = ""; 
	my $hash = {};
	for ( my $x = 0; $x < scalar(@history) ; $x++ ) {
        	if ( $history[$x] =~ /^\* ACL/ ) {
			
			$perm = $history[$x]=~ /^\* ACL $/	? 
				$history[++$x].$history[++$x] 	: 
				$history[$x];		

			$perm =~ s/\s?\x0d\x0a$//;
			piece:  until ( $perm =~ /\Q$target\E"?$/ or !$perm) {
				#$self->_debug(qq(Piece: permline=$perm and " 
				#	"pattern = /\Q$target\E"? \$/));
				$perm =~ s/\s([^\s]+)\s?$// or last piece;
				my($p) = $1;
				$perm =~ s/\s([^\s]+)\s?$// or last piece;
				my($u) = $1;
				$hash->{$u} = $p;
				$self->_debug("Permissions: $u => $p \n");
			}
		
		}
	}
        return $hash;
}

sub listrights {
	my $self = shift;
	my ($target, $user) = @_;
	$user = $self->User unless defined($user);
	$target = $self->Folder unless defined($target);
	$target 	  = $self->Massage($target);
	$user		  =~ s/^"(.*)"$/$1/;
	$user 	  	  =~ s/"/\\"/g;
	my $string 	=  qq(LISTRIGHTS $target "$user");
	$self->_imap_command($string)  or return undef;
	my $resp = ( grep(/^\* LISTRIGHTS/, $self->History($self->Count) ) )[0];
	my @rights = split(/\s/,$resp);	
	shift @rights, shift @rights, shift @rights, shift @rights;
	my $rights = join("",@rights);
	$rights =~ s/"//g;	
	return wantarray ? split(//,$rights) : $rights ;
}

sub select {
	my $self = shift;
	my $target = shift ;  
	return undef unless defined($target);

	my $qqtarget = $self->Massage($target);

	my $string 	=  qq/SELECT $qqtarget/;

	my $old = $self->Folder;

	if ($self->_imap_command($string) and $self->State(Selected)) {
		$self->Folder($target);
		return $old||$self;
	} else { 
		return undef;
	}
}

sub message_string {
	my $self = shift;
	my $msg  = shift;
	my $expected_size = $self->size($msg);
	return undef unless(defined $expected_size);	# unable to get size
	my $cmd  =  	$self->has_capability('IMAP4REV1') 				? 
				"BODY" . ( $self->Peek ? '.PEEK[]' : '[]' ) 		: 
				"RFC822" .  ( $self->Peek ? '.PEEK' : ''  )		;

	$self->fetch($msg,$cmd) or return undef;
	
	my $string = "";

	foreach my $result  (@{$self->{"History"}{$self->Transaction}}) { 
              $string .= $result->[DATA] 
		if defined($result) and $self->_is_literal($result) ;
	}      
	# BUG? should probably return undef if length != expected
	if ( length($string) != $expected_size ) { 
		carp "${self}::message_string: " .
			"expected $expected_size bytes but received " . 
			length($string) 
			if $self->Debug or $^W; 
	}
	if ( length($string) > $expected_size ) 
	{ $string = substr($string,0,$expected_size) }
	if ( length($string) < $expected_size ) {
		$self->LastError("${self}::message_string: expected ".
			"$expected_size bytes but received " . 
			length($string)."\n");
		return undef;
	}
	return $string;
}

sub bodypart_string {
	my($self, $msg, $partno, $bytes, $offset) = @_;

	unless ( $self->has_capability('IMAP4REV1') ) {
		$self->LastError(
				"Unable to get body part; server " . 
				$self->Server . 
				" does not support IMAP4REV1"
		);
		return undef;
	}
	my $cmd = "BODY" . ( $self->Peek ? ".PEEK[$partno]" : "[$partno]" ) 	;
	$offset ||= 0 ;
	$cmd .= "<$offset.$bytes>" if $bytes;

	$self->fetch($msg,$cmd) or return undef;
	
	my $string = "";

	foreach my $result  (@{$self->{"History"}{$self->Transaction}}) { 
              $string .= $result->[DATA] 
		if defined($result) and $self->_is_literal($result) ;
	}      
	return $string;
}

sub message_to_file {
	my $self = shift;
	my $fh   = shift;
	my @msgs = @_;
	my $handle;

	if ( ref($fh) ) {
		$handle = $fh;
	} else { 
		$handle = IO::File->new(">>$fh");
		unless ( defined($handle)) {
			$@ = "Unable to open $fh: $!";
			$self->LastError("Unable to open $fh: $!\n");
			carp $@ if $^W;
			return undef;
		}
		binmode $handle;	# For those of you who need something like this...
	} 

        my $clear = $self->Clear;
	my $cmd = $self->Peek ? 'BODY.PEEK[]' : 'BODY[]';
	$cmd = $self->Peek ? 'RFC822.PEEK' : 'RFC822' unless $self->imap4rev1;
	
	my $string = ( $self->Uid ? "UID " : "" ) . "FETCH " . join(",",@msgs) . " $cmd";

        $self->Clear($clear)
                if $self->Count >= $clear and $clear > 0;

        my $trans       = $self->Count($self->Count+1);

        $string         = "$trans $string" ;

        $self->_record($trans,[ 0, "INPUT", "$string\x0d\x0a"] );

        my $feedback = $self->_send_line("$string");

        unless ($feedback) {
                $self->LastError( "Error sending '$string' to IMAP: $!\n");
                $@ = "Error sending '$string' to IMAP: $!";
                return undef;
        }

        my ($code, $output);
        $output = "";

        READ: until ( $code)  {
                $output = $self->_read_line($handle) or return undef; # avoid possible infinite loop
                for my $o (@$output) {
                        $self->_record($trans,$o);	# $o is a ref
                        # $self->_debug("Received from readline: ${\($o->[DATA])}<<END OF RESULT>>\n");
                        next unless $self->_is_output($o);
                        ($code) = $o->[DATA] =~ /^$trans (OK|BAD|NO)/mi ;
                        if ($o->[DATA] =~ /^\*\s+BYE/im) {
                                $self->State(Unconnected);
                                return undef ;
                        }
                }
        }

        # $self->_debug("Command $string: returned $code\n");
	close $handle unless ref($fh);
        return $code =~ /^OK/im ? $self : undef ;

}

sub message_uid {
	my $self = shift;
	my $msg  = shift;
	my @uid = $self->fetch($msg,"UID");
	my $uid;
	while ( my $u = shift @uid and !$uid) {
		($uid) = $u =~ /\(UID\s+(\d+)\s*\)\r?$/;
	}
	return $uid;
}

sub original_migrate {
	my($self,$peer,$msgs,$folder) = @_;
	unless ( eval { $peer->IsConnected } ) {
		$self->LastError("Invalid or unconnected " .  ref($self). 
				 " object used as target for migrate." );
		return undef;
	}
	unless ($folder) {
		$folder = $self->Folder;
		$peer->exists($folder) 		or 
			$peer->create($folder) 	or 
			(
				$self->LastError("Unable to created folder $folder on target mailbox: ".
					"$peer->LastError") and 
				return undef 
			) ;
	}			
	if ( $msgs =~ /^all$/i ) { $msgs = $self->search("ALL") }
	foreach my $mid ( ref($msgs) ? @$msgs : $msgs ) {
		my $uid = $peer->append($folder,$self->message_string($mid));
		$self->LastError("Trouble appending to peer: " . $peer->LastError . "\n");
	}
}


sub migrate {

	my($self,$peer,$msgs,$folder) 	= @_;
	my($toSock,$fromSock) 		= ( $peer->Socket, $self->Socket);
	my $bufferSize 			= $self->Buffer || 4096;
	my $fromBuffer 			= "";
	my $clear 			= $self->Clear;

	unless ( eval { $peer->IsConnected } ) {
		$self->LastError("Invalid or unconnected " . 
			ref($self) . " object used as target for migrate. $@");
		return undef;
	}

	unless ($folder) {
		$folder = $self->Folder 	or
			$self->LastError( "No folder selected on source mailbox.") 
			and return undef;

		$peer->exists($folder)		or 
			$peer->create($folder)	or 
			(
				$self->LastError(
				  "Unable to create folder $folder on target mailbox: ".
				  $peer->LastError . "\n"
				) and return undef 
			) ;
	}
	$msgs or $msgs eq "0" or $msgs = "all";	
	if ( $msgs =~ /^all$/i ) { $msgs = $self->search("ALL") }
	my $range = $self->Range($msgs) ;
	$self->_debug("Migrating the following msgs from $folder: " . 
		" $range\n");
		# ( ref($msgs) ? join(", ",@$msgs) : $msgs) );

	#MIGMSG:	foreach my $mid ( ref($msgs) ? @$msgs : (split(/,\s*/,$msgs)) ) {#}
	MIGMSG:	foreach my $mid ( $range->unfold ) {
		# Set up counters for size of msg and portion of msg remaining to
		# process:
		$self->_debug("Migrating message $mid in folder $folder\n") 
			if $self->Debug;
		my $leftSoFar = my $size = $self->size($mid);

		# fetch internaldate and flags of original message:
		my $intDate = '"' . $self->internaldate($mid) . '"' ;
		my $flags   = "(" . join(" ",grep(!/\\Recent/i,$self->flags($mid)) ) . ")" ;
		$flags = "" if  $flags eq "()" ;

		# set up transaction numbers for from and to connections:
		my $trans       = $self->Count($self->Count+1);
		my $ptrans      = $peer->Count($peer->Count+1);

		# If msg size is less than buffersize then do whole msg in one 
		# transaction:
		if ( $size <= $bufferSize ) {
			my $new_mid = $peer->append_string($peer->Massage($folder),
					$self->message_string($mid) ,$flags,
					$intDate) ;
		        $self->_debug("Copied message $mid in folder $folder to " . 
				    $peer->User .
				    '@' . $peer->Server . 
				    ". New Message UID is $new_mid.\n" 
		        ) if $self->Debug;

		        $peer->_debug("Copied message $mid in folder $folder from " . 
				$self->User .
				'@' . $self->Server . ". New Message UID is $new_mid.\n" 
		        ) if $peer->Debug;


			next MIGMSG;
		}

		# otherwise break it up into digestible pieces:
		my ($cmd, $pattern);
		if ( $self->imap4rev1 ) {
			# imap4rev1 supports FETCH BODY 
			$cmd = $self->Peek ? 'BODY.PEEK[]' : 'BODY[]';
			$pattern = sub {
                                #$self->_debug("Data fed to pattern: $_[0]<END>\n");
                                my($one) = $_[0] =~ /\(.*BODY\[\]<\d+> \{(\d+)\}/i ; # ;-)
					# or $self->_debug("Didn't match pattern\n") ; 
                                #$self->_debug("Returning from pattern: $1\n") if defined($1);
				return $one ;
                        } ;
		} else {
			# older imaps use (deprecated) FETCH RFC822:
			$cmd = $self->Peek ? 'RFC822.PEEK' : 'RFC822' ;
			$pattern = sub {
				my($one) = shift =~ /\(RFC822\[\]<\d+> \{(\d+)\}/i; 
				return $one ;
			};
		}


		# Now let's warn the peer that there's a message coming:

		my $pstring = 	"$ptrans APPEND " . 
				$self->Massage($folder). 
				" " . 
				( $flags ? "$flags " : () ) . 
				( $intDate ? "$intDate " : () ) . 
				"{" . $size . "}"  ;

		$self->_debug("About to issue APPEND command to peer " .
			"for msg $mid\n") 		if $self->Debug;

		my $feedback2 = $peer->_send_line( $pstring ) ;

		$peer->_record($ptrans,[ 
			0, 
			"INPUT", 
			"$pstring" ,
		] ) ;
		unless ($feedback2) {
		   $self->LastError("Error sending '$pstring' to target IMAP: $!\n");
		   return undef;
		}
		# Get the "+ Go ahead" response:
		my $code = 0;
		until ($code eq '+' or $code =~ /NO|BAD|OK/ ) {
	  	  my $readSoFar = 0 ;
		  $readSoFar += sysread($toSock,$fromBuffer,1,$readSoFar)||0
			until $fromBuffer =~ /\x0d\x0a/;

		  #$peer->_debug("migrate: response from target server: " .
		  #	"$fromBuffer<END>\n") 	if $peer->Debug;

		  ($code)= $fromBuffer =~ /^(\+)|^(?:\d+\s(?:BAD|NO))/ ;
		  $code ||=0;

		  $peer->_debug( "$folder: received $fromBuffer from server\n") 
		  if $peer->Debug;

	  	  # ... and log it in the history buffers
		  $self->_record($trans,[ 
			0, 
			"OUTPUT", 
			"Mail::IMAPClient migrating message $mid to $peer->User\@$peer->Server"
		  ] ) ;
		  $peer->_record($ptrans,[ 
			0, 
			"OUTPUT", 
			$fromBuffer
		  ] ) ;


		}
		unless ( $code eq '+'  ) {
			$^W and warn "$@\n";
			$self->Debug and $self->_debug("Error writing to target host: $@\n");
			next MIGMSG;	
		}
		# Here is where we start sticking in UID if that parameter
		# is turned on:	
		my $string = ( $self->Uid ? "UID " : "" ) . "FETCH $mid $cmd";

		# Clean up history buffer if necessary:
		$self->Clear($clear)
			if $self->Count >= $clear and $clear > 0;


	   # position will tell us how far from beginning of msg the
	   # next IMAP FETCH should start (1st time start at offet zero):
	   my $position = 0;
	   #$self->_debug("There are $leftSoFar bytes left versus a buffer of $bufferSize bytes.\n");
	   my $chunkCount = 0;
	   while ( $leftSoFar > 0 ) {
		$self->_debug("Starting chunk " . ++$chunkCount . "\n");

		my $newstring         ="$trans $string<$position."  .
					( $leftSoFar > $bufferSize ? $bufferSize : $leftSoFar ) . 
					">" ;

		$self->_record($trans,[ 0, "INPUT", "$newstring\x0d\x0a"] );
		$self->_debug("Issuing migration command: $newstring\n" )
			if $self->Debug;;

		my $feedback = $self->_send_line("$newstring");

		unless ($feedback) {
		   $self->LastError("Error sending '$newstring' to source IMAP: $!\n");
		   return undef;
		}
		my $chunk = "";
		until ($chunk = $pattern->($fromBuffer) ) {
		   $fromBuffer = "" ;
	    	   until ( $fromBuffer=~/\x0d\x0a$/ ) {
	    	   	sysread($fromSock,$fromBuffer,1,length($fromBuffer)) ; 
			#$self->_debug("migrate chunk $chunkCount:" . 
			#	"Read from source: $fromBuffer<END>\n");
		   }
		   
		   $self->_record($trans,[ 0, "OUTPUT", "$fromBuffer"] ) ;

		   if ( $fromBuffer =~ /^$trans (?:NO|BAD)/ ) {
			$self->LastError($fromBuffer) ;
			next MIGMSG;
		   }

		   if ( $fromBuffer =~ /^$trans (?:OK)/ ) {
			$self->LastError("Unexpected good return code " .
				"from source host: " . $fromBuffer) ;
			next MIGMSG;
		   }

		}
		$fromBuffer = "";
		my $readSoFar = 0 ;
		$readSoFar += sysread($fromSock,$fromBuffer,$chunk-$readSoFar,$readSoFar)||0
			until $readSoFar >= $chunk;
		#$self->_debug("migrateRead: chunk=$chunk readSoFar=$readSoFar " .
		#	"Buffer=$fromBuffer<END_OF_BUFFER\n") if $self->Debug;

		my $wroteSoFar 	= 0;
		my $temperrs 	= 0;
		my $optimize 	= 0;

		until ( $wroteSoFar >= $chunk ) {
		 #$peer->_debug("Chunk $chunkCount: Next write will attempt to write " .
		 #	"this substring:\n" .
		 #	substr($fromBuffer,$wroteSoFar,$chunk-$wroteSoFar) .
		 #	"<END_OF_SUBSTRING>\n"
		 #);

		 until ( $wroteSoFar >= $readSoFar ) {
		    $!=0;
		    my $ret = syswrite(
				$toSock,
				$fromBuffer,
				$chunk - $wroteSoFar, 
				$wroteSoFar )||0 ;

		    $wroteSoFar += $ret;

		    if ($! == &EAGAIN ) {
			if ( 	$self->{Maxtemperrors} !~ /^unlimited/i
			    	and $temperrs++ > ($self->{Maxtemperrors}||10) 
			) {
				$self->LastError("Persistent '${!}' errors\n");
				$self->_debug("Persistent '${!}' errors\n");
				return undef;
			}
			$optimize = 1;
		    } else {
			# avoid infinite loops on syswrite error
			return undef unless(defined $ret);	 
		    }
		    # Optimization of wait time between syswrite calls
		    # only runs if syscalls run too fast and fill the 
		    # buffer causing "EAGAIN: Resource Temp. Unavail" errors. The
		    # premise is that $maxwrite will be approx. the same as 
		    # the smallest buffer between the sending and receiving side. 
		    # Waiting time between syscalls should ideally be exactly as 
		    # long as it takes the receiving side to empty that buffer, 
		    # minus a little bit to prevent it from
		    # emptying completely and wasting time in the select call.
		    if ($optimize) {
		        my $waittime = .02; 
		    	$maxwrite = $ret if $maxwrite < $ret;
		    	push( @last5writes, $ret );
		    	shift( @last5writes ) if $#last5writes > 5;
			    my $bufferavail = 0;
			    $bufferavail += $_ for ( @last5writes );
			    $bufferavail /= ($#last5writes||1);
			    # Buffer is staying pretty full; 
			    # we should increase the wait period
			    # to reduce transmission overhead/number of packets sent
			    if ( $bufferavail < .4 * $maxwrite ) {
				$waittime *= 1.3;

			    # Buffer is nearly or totally empty; 
			    # we're wasting time in select
			    # call that could be used to send data, 
			    # so reduce the wait period
			    } elsif ( $bufferavail > .9 * $maxwrite ) {
				$waittime *= .5;
			    }
		    	CORE::select(undef, undef, undef, $waittime);
		    }
		    if ( defined($ret) ) {
			$temperrs = 0  ;
		    }
		    $peer->_debug("Chunk $chunkCount: " .
			"Wrote $wroteSoFar bytes (out of $chunk)\n");
		   }
		}
		$position += $readSoFar ;
		$leftSoFar -= $readSoFar;
		$fromBuffer = "";
		# Finish up reading the server response from the fetch cmd
		# 	on the source system:
		{
		my $code = 0;
		until ( $code)  {

			# escape infinite loop if read_line never returns any data:

			$self->_debug("Reading from source server; expecting " .
				"') OK' type response\n") if $self->Debug;

			$output = $self->_read_line or return undef; 
			for my $o (@$output) {

				$self->_record($trans,$o);      # $o is a ref

				# $self->_debug("Received from readline: " .
				# "${\($o->[DATA])}<<END OF RESULT>>\n");

				next unless $self->_is_output($o);

				($code) = $o->[DATA] =~ /^$trans (OK|BAD|NO)/mi ;

				if ($o->[DATA] =~ /^\*\s+BYE/im) {
					$self->State(Unconnected);
					return undef ;
				}
	   		}
	   	}
	   	} # end scope for my $code
	   }
	   # Now let's send a <CR><LF> to the peer to signal end of APPEND cmd:
	   {
	    my $wroteSoFar = 0;
	    $fromBuffer = "\x0d\x0a";
	    $!=0;
	    $wroteSoFar += syswrite($toSock,$fromBuffer,2-$wroteSoFar,$wroteSoFar)||0 
	    		until $wroteSoFar >= 2;

	   }
	   # Finally, let's get the new message's UID from the peer:
	   my $new_mid = "";
           {
                my $code = 0;
                until ( $code)  {
                        # escape infinite loop if read_line never returns any data:
			$peer->_debug("Reading from target: " .
				"expecting new uid in response\n") if $peer->Debug;

                        $output = $peer->_read_line or next MIGMSG;

                        for my $o (@$output) {

                                $peer->_record($ptrans,$o);      # $o is a ref

                                # $peer->_debug("Received from readline: " .
                                # "${\($o->[DATA])}<<END OF RESULT>>\n");

                                next unless $peer->_is_output($o);

                                ($code) = $o->[DATA] =~ /^$ptrans (OK|BAD|NO)/mi ;
				($new_mid)= $o->[DATA] =~ /APPENDUID \d+ (\d+)/ if $code;
				#$peer->_debug("Code line: " . $o->[DATA] . 
				#	"\nCode=$code mid=$new_mid\n" ) if $code;

                                if ($o->[DATA] =~ /^\*\s+BYE/im) {
                                        $peer->State(Unconnected);
                                        return undef ;
                                }
                        }
			$new_mid||="unknown" ;
                }
             } # end scope for my $code

	     $self->_debug("Copied message $mid in folder $folder to " . $peer->User .
			    '@' . $peer->Server . ". New Message UID is $new_mid.\n" 
	     ) if $self->Debug;

	     $peer->_debug("Copied message $mid in folder $folder from " . $self->User .
			    '@' . $self->Server . ". New Message UID is $new_mid.\n" 
	     ) if $peer->Debug;


	  # ... and finish up reading the server response from the fetch cmd
	  # 	on the source system:
	      # {
	#	my $code = 0;
	#	until ( $code)  {
	#		# escape infinite loop if read_line never returns any data:
        #      		unless ($output = $self->_read_line ) {
	#			$self->_debug($self->LastError) ;
	#			next MIGMSG;
	#		}
	#		for my $o (@$output) {
#
#				$self->_record($trans,$o);      # $o is a ref
#
#				# $self->_debug("Received from readline: " .
#				# "${\($o->[DATA])}<<END OF RESULT>>\n");
#
#				next unless $self->_is_output($o);
#
#			 	($code) = $o->[DATA] =~ /^$trans (OK|BAD|NO)/mi ;
#
#			      	if ($o->[DATA] =~ /^\*\s+BYE/im) {
#					$self->State(Unconnected);
#					return undef ;
#				}
#			}
#		}
#		}
		
	     	# and clean up the I/O buffer:
	     	$fromBuffer = "";
	     }
	return $self;	
}


sub body_string {
	my $self = shift;
	my $msg  = shift;
	my $ref = $self->fetch($msg,"BODY" . ( $self->Peek ? ".PEEK" : "" ) . "[TEXT]");

        my $string = "";
    	foreach my $result  (@{$ref}) 	{ 
                $string .= $result->[DATA] if defined($result) and $self->_is_literal($result) ;
        }
	return $string if $string;

        my $head = shift @$ref;
        $self->_debug("body_string: first shift = '$head'\n");

        until ( (! $head)  or $head =~ /(?:.*FETCH .*\(.*BODY\[TEXT\])|(?:^\d+ BAD )|(?:^\d NO )/i ) {
                $self->_debug("body_string: shifted '$head'\n");
                $head = shift(@$ref) ;
        }
	unless ( scalar(@$ref) ) {
			$self->LastError("Unable to parse server response from " . $self->LastIMAPCommand );
			return undef ;
	}
	my $popped ; $popped = pop @$ref until 	
			( 
				( 	defined($popped) and 
					# (-:	Smile!
					$popped =~ /\)\x0d\x0a$/ 
				) 	or
					not grep(
						# (-:	Smile again!
						/\)\x0d\x0a$/,
						@$ref
					)
			);

        if      ($head =~ /BODY\[TEXT\]\s*$/i )     {       # Next line is a literal
                        $string .= shift @$ref while scalar(@$ref);
                        $self->_debug("String is now $string\n") if $self->Debug;
        }

        return $string||undef;
}


sub examine {
	my $self = shift;
	my $target = shift ; return undef unless defined($target);
	$target = $self->Massage($target);
	my $string 	=  qq/EXAMINE $target/;

	my $old = $self->Folder;

	if ($self->_imap_command($string) and $self->State(Selected)) {
		$self->Folder($target);
		return $old||$self;
	} else { 
		return undef;
	}
}

sub idle {
	my $self = shift;
	my $good = '+';
	my $count = $self->Count +1;
	return $self->_imap_command("IDLE",$good) ? $count : undef;
}

sub done {
	my $self 	= shift;

	my $count 	= shift||$self->Count;

	my $clear = "";
	$clear = $self->Clear;

	$self->Clear($clear) 
		if $self->Count >= $clear and $clear > 0;

	my $string = "DONE\x0d\x0a";
	$self->_record($count,[ $self->_next_index($count), "INPUT", "$string\x0d\x0a"] );

	my $feedback = $self->_send_line("$string",1);

	unless ($feedback) {
		$self->LastError( "Error sending '$string' to IMAP: $!\n");
		return undef;
	}

	my ($code, $output);	
	$output = "";

	until ( $code and $code =~ /(OK|BAD|NO)/m ) {

		$output = $self->_read_line or return undef;	
		for my $o (@$output) { 
			$self->_record($count,$o);	# $o is a ref
			next unless $self->_is_output($o);
                      	($code) = $o->[DATA] =~ /^(?:$count) (OK|BAD|NO)/m  ;
                      if ($o->[DATA] =~ /^\*\s+BYE/) {
				$self->State(Unconnected);
			}
		}
	}	
	return $code =~ /^OK/ ? @{$self->Results} : undef ;

}

sub tag_and_run {
	my $self = shift;
	my $string = shift;
	my $good = shift;
	$self->_imap_command($string,$good);
	return @{$self->Results};
}
# _{name} methods are undocumented and meant to be private.

# _imap_command runs a command, inserting the correct tag
# and <CR><LF> and whatnot.
# When updating _imap_command, remember to examine the run method, too, since it is very similar.
#

sub _imap_command {
	
	my $self 	= shift;
	my $string 	= shift 	or return undef;
	my $good 	= shift 	|| 'GOOD';

	my $qgood = quotemeta($good);

	my $clear = "";
	$clear = $self->Clear;

	$self->Clear($clear) 
		if $self->Count >= $clear and $clear > 0;

	my $count 	= $self->Count($self->Count+1);

	$string 	= "$count $string" ;

	$self->_record($count,[ 0, "INPUT", "$string\x0d\x0a"] );

	my $feedback = $self->_send_line("$string");

	unless ($feedback) {
		$self->LastError( "Error sending '$string' to IMAP: $!\n");
		$@ = "Error sending '$string' to IMAP: $!";
		carp "Error sending '$string' to IMAP: $!" if $^W;
		return undef;
	}

	my ($code, $output);	
	$output = "";

	READ: until ( $code)  {
	    	# escape infinite loop if read_line never returns any data:
              	$output = $self->_read_line or return undef; 

		for my $o (@$output) { 
			$self->_record($count,$o);	# $o is a ref
                      # $self->_debug("Received from readline: ${\($o->[DATA])}<<END OF RESULT>>\n");
			next unless $self->_is_output($o);
			if ( $good eq '+' ) {
                      		$o->[DATA] =~ /^$count (OK|BAD|NO|$qgood)|^($qgood)/mi ;
				$code = $1||$2 ;
			} else {
                      		($code) = $o->[DATA] =~ /^$count (OK|BAD|NO|$qgood)/mi ;
			}
                      if ($o->[DATA] =~ /^\*\s+BYE/im) {
				$self->State(Unconnected);
				return undef ;
			}
		}
	}	
	
	# $self->_debug("Command $string: returned $code\n");
	return $code =~ /^OK|$qgood/im ? $self : undef ;

}

sub run {
	my $self 	= shift;
	my $string 	= shift 	or return undef;
	my $good 	= shift 	|| 'GOOD';
	my $count 	= $self->Count($self->Count+1);
	my($tag)	= $string =~ /^(\S+) /  ;

	unless ($tag) {
		$self->LastError("Invalid string passed to run method; no tag found.\n");
	}

	my $qgood = quotemeta($good);

	my $clear = "";
	$clear = $self->Clear;

	$self->Clear($clear) 
		if $self->Count >= $clear and $clear > 0;

	$self->_record($count,[ $self->_next_index($count), "INPUT", "$string"] );

	my $feedback = $self->_send_line("$string",1);

	unless ($feedback) {
		$self->LastError( "Error sending '$string' to IMAP: $!\n");
		return undef;
	}

	my ($code, $output);	
	$output = "";

	until ( $code =~ /(OK|BAD|NO|$qgood)/m ) {

		$output = $self->_read_line or return undef;	
		for my $o (@$output) { 
			$self->_record($count,$o);	# $o is a ref
			next unless $self->_is_output($o);
			if ( $good eq '+' ) {
			   $o->[DATA] =~ /^(?:$tag|\*) (OK|BAD|NO|$qgood)|(^$qgood)/m  ;
			   $code = $1||$2;
			} else {
                      		($code) = 
				   $o->[DATA] =~ /^(?:$tag|\*) (OK|BAD|NO|$qgood)/m  ;
			}
                      if ($o->[DATA] =~ /^\*\s+BYE/) {
				$self->State(Unconnected);
			}
		}
	}	
	$self->{'History'}{$tag} = $self->{"History"}{$count} unless $tag eq $count;
	return $code =~ /^OK|$qgood/ ? @{$self->Results} : undef ;

}
#sub bodystruct {	# return bodystruct 
#}

# _record saves the conversation into the History structure:
sub _record {

	my ($self,$count,$array) = ( shift, shift, shift);
	local($^W)= undef;

	#$self->_debug(sprintf("in _record: count is $count, values are %s/%s/%s and caller is " . 
	#	join(":",caller()) . "\n",@$array));
	
      if (    #       $array->[DATA] and 
              $array->[DATA] =~ /^\d+ LOGIN/i and
		! $self->Showcredentials
      ) { 

              $array->[DATA] =~ s/LOGIN.*/LOGIN XXXXXXXX XXXXXXXX/i ;
	}

	push @{$self->{"History"}{$count}}, $array;

      if ( $array->[DATA] =~ /^\d+\s+(BAD|NO)\s/im ) {
              $self->LastError("$array->[DATA]") ;
              $@ = $array->[DATA];
              carp "$array->[DATA]" if $^W ;
	}
	return $self;
}

#_send_line writes to the socket:
sub _send_line {
	my($self,$string,$suppress) = (shift, shift, shift);

	#$self->_debug("_send_line: Connection state = " . 
	#		$self->State . " and socket fh = " . 
	#		($self->Socket||"undef") . "\n")
	#if $self->Debug;

	unless ($self->IsConnected and $self->Socket) {
		$self->LastError("NO Not connected.\n");
		carp "Not connected" if $^W;
		return undef;
	}

	unless ($string =~ /\x0d\x0a$/ or $suppress ) {

		chomp $string;
		$string .= "\x0d" unless $string =~ /\x0d$/;	
		$string .= "\x0a" ;
	}
	if ( 
		$string =~ /^[^\x0a{]*\{(\d+)\}\x0d\x0a/ 	   # ;-}
	) 	{
		my($p1,$p2,$len) ;
		if ( ($p1,$len)   = 
			$string =~ /^([^\x0a{]*\{(\d+)\}\x0d\x0a)/ # } for vi
			and  (
				$len < 32766 ? 
				( ($p2) = $string =~ /
					^[^\x0a{]*
					\{\d+\}
					\x0d\x0a
					(
						.{$len}
						.*\x0d\x0a
					)
				/x ) :

				( ($p2) = $string =~ /	^[^\x0a{]*
							\{\d+\}
							\x0d\x0a
							(.*\x0d\x0a)
						    /x 	
				   and length($p2) == $len  ) # }} for vi
		     )
		) {
			$self->_debug("Sending literal string " .
				"in two parts: $p1\n\tthen: $p2\n");
			$self->_send_line($p1) or return undef;
			$output = $self->_read_line or return undef;
			foreach my $o (@$output) {
				# $o is already an array ref:
				$self->_record($self->Count,$o);              
                              ($code) = $o->[DATA] =~ /(^\+|NO|BAD)/i;
                              if ($o->[DATA] =~ /^\*\s+BYE/) {
					$self->State(Unconnected);
					close $fh;
					return undef ;
                              } elsif ( $o->[DATA]=~ /^\d+\s+(NO|BAD)/i ) {
					close $fh;
					return undef;
				}
			}
			if ( $code eq '+' ) 	{ $string = $p2; } 
			else 			{ return undef ; }
		}
		
	}
	if ($self->Debug) {
		my $dstring = $string;
		if ( $dstring =~ m[\d+\s+Login\s+]i) {
			$dstring =~ 
			  s(\b(?:\Q$self->{Password}\E|\Q$self->{User}\E)\b)
			('X' x length($self->{Password}))eg;
		}
		_debug $self, "Sending: $dstring\n" if $self->Debug;
	}
	my $total = 0;
	my $temperrs = 0;
	my $optimize = 0;
     	my $maxwrite = 0;
     	my $waittime = .02;
     	my @last5writes = (1);
	$string = $self->Prewritemethod->($self,$string) if $self->Prewritemethod;
	_debug $self, "Sending: $string\n" if $self->Debug and $self->Prewritemethod;

	until ($total >= length($string)) {
		my $ret = 0;
	        $!=0;
		$ret =	syswrite(	
					$self->Socket, 
					$string, 
					length($string)-$total, 
					$total
					);
		$ret||=0;
		if ($! == &EAGAIN ) {
			if ( 	$self->{Maxtemperrors} !~ /^unlimited/i
			    	and $temperrs++ > ($self->{Maxtemperrors}||10) 
			) {
				$self->LastError("Persistent '${!}' errors\n");
				$self->_debug("Persistent '${!}' errors\n");
				return undef;
			}
			$optimize = 1;
		} else {
			# avoid infinite loops on syswrite error
			return undef unless(defined $ret);	 
		}
		# Optimization of wait time between syswrite calls
		# only runs if syscalls run too fast and fill the 
		# buffer causing "EAGAIN: Resource Temp. Unavail" errors. The
		# premise is that $maxwrite will be approx. the same as 
		# the smallest buffer between the sending and receiving side. 
		# Waiting time between syscalls should ideally be exactly as 
		# long as it takes the receiving side to empty that buffer, 
		# minus a little bit to prevent it from
		# emptying completely and wasting time in the select call.
		if ($optimize) {
		    $maxwrite = $ret if $maxwrite < $ret;
		    push( @last5writes, $ret );
		    shift( @last5writes ) if $#last5writes > 5;
		    my $bufferavail = 0;
		    $bufferavail += $_ for ( @last5writes );
		    $bufferavail /= $#last5writes;
		    # Buffer is staying pretty full; 
		    # we should increase the wait period
		    # to reduce transmission overhead/number of packets sent
		    if ( $bufferavail < .4 * $maxwrite ) {
			$waittime *= 1.3;

		    # Buffer is nearly or totally empty; 
		    # we're wasting time in select
		    # call that could be used to send data, 
		    # so reduce the wait period
		    } elsif ( $bufferavail > .9 * $maxwrite ) {
			$waittime *= .5;
		    }
		    $self->_debug("Output buffer full; waiting $waittime seconds for relief\n");
		    CORE::select(undef, undef, undef, $waittime);
		}
		if ( defined($ret) ) {
			$temperrs = 0  ;
			$total += $ret ;
		}
	}
	_debug $self,"Sent $total bytes\n" if $self->Debug;
	return $total;
}

# _read_line reads from the socket. It is called by:
# 	append	append_file	authenticate	connect		_imap_command
#
# It is also re-implemented in:
#	message_to_file
#
# syntax: $output = $self->_readline( ( $literal_callback|undef ) , ( $output_callback|undef ) ) ;
# 	  Both input argument are optional, but if supplied must either be a filehandle, coderef, or undef.
#
#	Returned argument is a reference to an array of arrays, ie: 
#	$output = [ 
#			[ $index, 'OUTPUT'|'LITERAL', $output_line ] ,
#			[ $index, 'OUTPUT'|'LITERAL', $output_line ] ,
#			... 	# etc,
#	];

sub _read_line {
	my $self 	= shift;	
	my $sh		= $self->Socket;
	my $literal_callback    = shift;
	my $output_callback = shift;
	
	unless ($self->IsConnected and $self->Socket) {
		$self->LastError("NO Not connected.\n");
		carp "Not connected" if $^W;
		return undef;
	}

	my $iBuffer	= ""; 
	my $oBuffer	= [];
	my $count	= 0;
	my $index	= $self->_next_index($self->Transaction);
	my $rvec 	= my $ready = my $errors = 0; 
	my $timeout	= $self->Timeout;

	my $readlen 	= 1;
	my $fast_io	= $self->Fast_io;	# Remember setting to reduce future method calls

	if ( $fast_io ) {
		
		# set fcntl if necessary:
		exists $self->{_fcntl} or $self->Fast_io($fast_io);
		$readlen = $self->{Buffer}||4096;
	}
	until (	
		# there's stuff in output buffer:
		scalar(@$oBuffer)	and 			

		# the last thing there has cr-lf:
                $oBuffer->[-1][DATA] =~ /\x0d\x0a$/  and     

		# that thing is an output line:
                $oBuffer->[-1][TYPE]    eq "OUTPUT"  and     

		# and the input buffer has been MT'ed:
		$iBuffer		eq "" 		

	) {
              my $transno = $self->Transaction;  # used below in several places
		if ($timeout) {
			vec($rvec, fileno($self->Socket), 1) = 1;
			my @ready = $self->{_select}->can_read($timeout) ;
			unless ( @ready ) {
				$self->LastError("Tag $transno: " .
					"Timeout after $timeout seconds " .
					"waiting for data from server\n");	
				$self->_record($transno,
					[	$self->_next_index($transno),
						"ERROR",
						"$transno * NO Timeout after ".
						"$timeout seconds " .
						"during read from " .
						"server\x0d\x0a"
					]
				);
				$self->LastError(
					"Timeout after $timeout seconds " .
					"during read from server\x0d\x0a"
				);
				return undef;
			}
		}
		
		local($^W) = undef;	# Now quiet down warnings

		# read "$readlen" bytes (or less):
              # need to check return code from $self->_sysread 
  	      #	in case other end has shut down!!!
              my $ret = $self->_sysread( $sh, \$iBuffer, $readlen, length($iBuffer)) ;
	      # $self->_debug("Read so far: $iBuffer<<END>>\n");
              if($timeout and ! defined($ret)) { # Blocking read error...
                  my $msg = "Error while reading data from server: $!\x0d\x0a";
                  $self->_record($transno,
                                 [ $self->_next_index($transno),
                                   "ERROR", "$transno * NO $msg "
                                   ]);
                  $@ = "$msg";
                  return undef;
              }
              elsif(defined($ret) and $ret == 0) {    # Caught EOF...
                  my $msg="Socket closed while reading data from server.\x0d\x0a";
                  $self->_record($transno,
                                 [ $self->_next_index($transno),
                                   "ERROR", "$transno * NO $msg "
                                   ]);
                  $@ = "$msg";
                  return undef;
              }
              # successfully wrote to other end, keep going...
              $count += $ret;
		LINES: while ( $iBuffer =~ s/^(.*?\x0d?\x0a)// ) {
		   my $current_line = $1;

		   # $self->_debug("BUFFER: pulled from buffer: <BEGIN>${current_line}<END>\n" .
		   # 	"and left with buffer contents of: <BEGIN>${iBuffer}<END>\n");

		   LITERAL: if ($current_line =~ s/\{(\d+)\}\x0d\x0a$//) {
			# This part handles IMAP "Literals", 
			# which according to rfc2060 look something like this:
			# [tag]|* BLAH BLAH {nnn}\r\n
			# [nnn bytes of literally transmitted stuff]
			# [part of line that follows literal data]\r\n

			# Set $len to be length of impending literal:
			my $len = $1 ;
			
			$self->_debug("LITERAL: received literal in line ".
				"$current_line of length $len; ".
				"attempting to ".
				"retrieve from the " . length($iBuffer) . 
				" bytes in: $iBuffer<END_OF_iBuffer>\n");

			# Xfer up to $len bytes from front of $iBuffer to $litstring: 
			my $litstring = substr($iBuffer, 0, $len);
			$iBuffer = substr($iBuffer, length($litstring), 
					length($iBuffer) - length($litstring) ) ;

			# Figure out what's left to read (i.e. what part of 
			# literal wasn't in buffer):
			my $remainder_count = $len - length($litstring);
			my $callback_value = "";

			if ( defined($literal_callback) ) 	{	
				if 	( $literal_callback =~ /GLOB/) 	{	
					print $literal_callback $litstring ;
					$litstring = "";
				} elsif ($literal_callback =~ /CODE/ ) {
					# Don't do a thing

				} else 	{
					$self->LastError(
						ref($literal_callback) . 
						" is an invalid callback type; " .
						"must be a filehandle or coderef\n"
					); 
				}

		
			}
			if ($remainder_count > 0 and $timeout) {
				# If we're doing timeouts then here we set up select 
				# and wait for data from the the IMAP socket.
				vec($rvec, fileno($self->Socket), 1) = 1;
				unless ( CORE::select( $ready = $rvec, 
							undef, 
							$errors = $rvec, 
							$timeout) 
				) {	
					# Select failed; that means bad news. 
					# Better tell someone.
					$self->LastError("Tag " . $transno . 
						": Timeout waiting for literal data " .
						"from server\n");	
					carp "Tag " . $transno . 
						": Timeout waiting for literal data " .
						"from server\n"
						if $self->Debug or $^W;	
					return undef;
				}	
			} 
			
			fcntl($sh, F_SETFL, $self->{_fcntl}) 
				if $fast_io and defined($self->{_fcntl});
			while ( $remainder_count > 0 ) {	   # As long as not done,
				$self->_debug("Still need $remainder_count to " .
					"complete literal string\n");
				my $ret	= $self->_sysread(   	   # bytes read
						$sh, 		   # IMAP handle 
						\$litstring,	   # place to read into
						$remainder_count,  # bytes left to read
						length($litstring) # offset to read into
				) ;
				$self->_debug("Received ret=$ret and buffer = " .
				"\n$litstring<END>\nwhile processing LITERAL\n");
				if ( $timeout and !defined($ret)) { # possible timeout
					$self->_record($transno, [ 
						$self->_next_index($transno),
						"ERROR",
						"$transno * NO Error reading data " .
						"from server: $!\n"
						]
					);
					return undef;
				} elsif ( $ret == 0 and eof($sh) ) {
					$self->_record($transno, [ 
						$self->_next_index($transno),
						"ERROR",
						"$transno * ".
						"BYE Server unexpectedly " .
						"closed connection: $!\n"	
						]
					);
					$self->State(Unconnected);
					return undef;
				}
				# decrement remaining bytes by amt read:
				$remainder_count -= $ret;	   

				if ( length($litstring) > $len ) {
                                    # copy the extra struff into the iBuffer:
                                    $iBuffer = substr(
                                        $litstring,   
                                        $len, 
                                        length($litstring) - $len 
                                    );
                                    $litstring = substr($litstring, 0, $len) ;
                                }

				if ( defined($literal_callback) ) {
					if ( $literal_callback =~ /GLOB/ ) {
						print $literal_callback $litstring;
						$litstring = "";
					} 
				}

			}
			$literal_callback->($litstring) 
				if defined($litstring) and 
				$literal_callback =~ /CODE/;

			$self->Fast_io($fast_io) if $fast_io;

		# Now let's make sure there are no IMAP server output lines 
		# (i.e. [tag|*] BAD|NO|OK Text) embedded in the literal string
		# (There shouldn't be but I've seen it done!), but only if
		# EnableServerResponseInLiteral is set to true

			my $embedded_output = 0;
			my $lastline = ( split(/\x0d?\x0a/,$litstring))[-1] 
				if $litstring;

			if ( 	$self->EnableServerResponseInLiteral and
				$lastline and 
				$lastline =~ /^(?:\*|(\d+))\s(BAD|NO|OK)/i 
			) {
			  $litstring =~ s/\Q$lastline\E\x0d?\x0a//;
			  $embedded_output++;

			  $self->_debug("Got server output mixed in " .
					"with literal: $lastline\n"
			  ) 	if $self->Debug;

			}
		  	# Finally, we need to stuff the literal onto the 
			# end of the oBuffer:
			push @$oBuffer, [ $index++, "OUTPUT" , $current_line],
					[ $index++, "LITERAL", $litstring   ];
			push @$oBuffer,	[ $index++, "OUTPUT",  $lastline    ] 
					if $embedded_output;

		  } else { 
			push @$oBuffer, [ $index++, "OUTPUT" , $current_line ]; 
		  }
		
		}
		#$self->_debug("iBuffer is now: $iBuffer<<END OF BUFFER>>\n");
	}
	#	_debug $self, "Buffer is now $buffer\n";
      _debug $self, "Read: " . join("",map {$_->[DATA]} @$oBuffer) ."\n" 
		if $self->Debug;
	return scalar(@$oBuffer) ? $oBuffer : undef ;
}

sub _sysread {
	my $self = shift @_;
	if ( exists $self->{Readmethod} )  {
		return $self->Readmethod->($self,@_) ;
	} else {
		my($handle,$buffer,$count,$offset) = @_;
		return sysread( $handle, $$buffer, $count, $offset);
	}
}

=begin obsolete

sub old_read_line {
	my $self 	= shift;	
	my $sh		= $self->Socket;
	my $literal_callback    = shift;
	my $output_callback = shift;
	
	unless ($self->IsConnected and $self->Socket) {
		$self->LastError("NO Not connected.\n");
		carp "Not connected" if $^W;
		return undef;
	}

	my $iBuffer	= ""; 
	my $oBuffer	= [];
	my $count	= 0;
	my $index	= $self->_next_index($self->Transaction);
	my $rvec 	= my $ready = my $errors = 0; 
	my $timeout	= $self->Timeout;

	my $readlen 	= 1;
	my $fast_io	= $self->Fast_io;	# Remember setting to reduce future method calls

	if ( $fast_io ) {
		
		# set fcntl if necessary:
		exists $self->{_fcntl} or $self->Fast_io($fast_io);
		$readlen = $self->{Buffer}||4096;
	}
	until (	
		# there's stuff in output buffer:
		scalar(@$oBuffer)	and 			

		# the last thing there has cr-lf:
                $oBuffer->[-1][DATA] =~ /\x0d\x0a$/  and     

		# that thing is an output line:
                $oBuffer->[-1][TYPE]    eq "OUTPUT"  and     

		# and the input buffer has been MT'ed:
		$iBuffer		eq "" 		

	) {
              my $transno = $self->Transaction;  # used below in several places
		if ($timeout) {
			vec($rvec, fileno($self->Socket), 1) = 1;
			my @ready = $self->{_select}->can_read($timeout) ;
			unless ( @ready ) {
				$self->LastError("Tag $transno: " .
					"Timeout after $timeout seconds " .
					"waiting for data from server\n");	
				$self->_record($transno,
					[	$self->_next_index($transno),
						"ERROR",
						"$transno * NO Timeout after ".
						"$timeout seconds " .
						"during read from " .
						"server\x0d\x0a"
					]
				);
				$self->LastError(
					"Timeout after $timeout seconds " .
					"during read from server\x0d\x0a"
				);
				return undef;
			}
		}
		
		local($^W) = undef;	# Now quiet down warnings

		# read "$readlen" bytes (or less):
              # need to check return code from sysread in case other end has shut down!!!
              my $ret = sysread( $sh, $iBuffer, $readlen, length($iBuffer)) ;
		# $self->_debug("Read so far: $iBuffer<<END>>\n");
              if($timeout and ! defined($ret)) { # Blocking read error...
                  my $msg = "Error while reading data from server: $!\x0d\x0a";
                  $self->_record($transno,
                                 [ $self->_next_index($transno),
                                   "ERROR", "$transno * NO $msg "
                                   ]);
                  $@ = "$msg";
                  return undef;
              }
              elsif(defined($ret) and $ret == 0) {    # Caught EOF...
                  my $msg="Socket closed while reading data from server.\x0d\x0a";
                  $self->_record($transno,
                                 [ $self->_next_index($transno),
                                   "ERROR", "$transno * NO $msg "
                                   ]);
                  $@ = "$msg";
                  return undef;
              }
              # successfully wrote to other end, keep going...
              $count += $ret;
		LINES: while ( $iBuffer =~ s/^(.*?\x0d?\x0a)// ) {
		   my $current_line = $1;

		   # $self->_debug("BUFFER: pulled from buffer: <BEGIN>${current_line}<END>\n" .
		   # 	"and left with buffer contents of: <BEGIN>${iBuffer}<END>\n");

		   LITERAL: if ($current_line =~ s/\{(\d+)\}\x0d\x0a$//) {
			# This part handles IMAP "Literals", which according to rfc2060 look something like this:
			# [tag]|* BLAH BLAH {nnn}\r\n
			# [nnn bytes of literally transmitted stuff]
			# [part of line that follows literal data]\r\n

			# Set $len to be length of impending literal:
			my $len = $1 ;
			
			$self->_debug("LITERAL: received literal in line $current_line of length $len; ".
			"attempting to ".
			"retrieve from the " . length($iBuffer) . " bytes in: $iBuffer<END_OF_iBuffer>\n");

			# Transfer up to $len bytes from front of $iBuffer to $litstring: 
			my $litstring = substr($iBuffer, 0, $len);
			$iBuffer = substr($iBuffer, length($litstring), length($iBuffer) - length($litstring) ) ;

			# Figure out what's left to read (i.e. what part of literal wasn't in buffer):
			my $remainder_count = $len - length($litstring);
			my $callback_value = "";

			if ( defined($literal_callback) ) 	{	
				if 	( $literal_callback =~ /GLOB/) 	{	
					print $literal_callback $litstring ;
					$litstring = "";
				} elsif ($literal_callback =~ /CODE/ ) {
					# Don't do a thing

				} else 	{
					$self->LastError(
						ref($literal_callback) . 
						" is an invalid callback type; must be a filehandle or coderef"
					); 
				}

		
			}
			if ($remainder_count > 0 and $timeout) {
				# If we're doing timeouts then here we set up select and wait for data from the
				# the IMAP socket.
				vec($rvec, fileno($self->Socket), 1) = 1;
				unless ( CORE::select( $ready = $rvec, 
							undef, 
							$errors = $rvec, 
							$timeout) 
				) {	
					# Select failed; that means bad news. 
					# Better tell someone.
					$self->LastError("Tag " . $transno . 
						": Timeout waiting for literal data " .
						"from server\n");	
					carp "Tag " . $transno . 
						": Timeout waiting for literal data " .
						"from server\n"
						if $self->Debug or $^W;	
					return undef;
				}	
			} 
			
			fcntl($sh, F_SETFL, $self->{_fcntl}) 
				if $fast_io and defined($self->{_fcntl});
			while ( $remainder_count > 0 ) {	   # As long as not done,

				my $ret	= sysread(	   	   # bytes read
						$sh, 		   # IMAP handle 
						$litstring,	   # place to read into
						$remainder_count,  # bytes left to read
						length($litstring) # offset to read into
				) ;
				if ( $timeout and !defined($ret)) { # possible timeout
					$self->_record($transno, [ 
						$self->_next_index($transno),
						"ERROR",
						"$transno * NO Error reading data " .
						"from server: $!\n"
						]
					);
					return undef;
				} elsif ( $ret == 0 and eof($sh) ) {
					$self->_record($transno, [ 
						$self->_next_index($transno),
						"ERROR",
						"$transno * ".
						"BYE Server unexpectedly " .
						"closed connection: $!\n"	
						]
					);
					$self->State(Unconnected);
					return undef;
				}
				# decrement remaining bytes by amt read:
				$remainder_count -= $ret;	   

				if ( defined($literal_callback) ) {
					if ( $literal_callback =~ /GLOB/ ) {
						print $literal_callback $litstring;
						$litstring = "";
					} 
				}

			}
			$literal_callback->($litstring) 
				if defined($litstring) and 
				$literal_callback =~ /CODE/;

			$self->Fast_io($fast_io) if $fast_io;

		# Now let's make sure there are no IMAP server output lines 
		# (i.e. [tag|*] BAD|NO|OK Text) embedded in the literal string
		# (There shouldn't be but I've seen it done!), but only if
		# EnableServerResponseInLiteral is set to true

			my $embedded_output = 0;
			my $lastline = ( split(/\x0d?\x0a/,$litstring))[-1] 
				if $litstring;

			if ( 	$self->EnableServerResponseInLiteral and
				$lastline and 
				$lastline =~ /^(?:\*|(\d+))\s(BAD|NO|OK)/i 
			) {
			  $litstring =~ s/\Q$lastline\E\x0d?\x0a//;
			  $embedded_output++;

			  $self->_debug("Got server output mixed in " .
					"with literal: $lastline\n"
			  ) 	if $self->Debug;

			}
		  	# Finally, we need to stuff the literal onto the 
			# end of the oBuffer:
			push @$oBuffer, [ $index++, "OUTPUT" , $current_line],
					[ $index++, "LITERAL", $litstring   ];
			push @$oBuffer,	[ $index++, "OUTPUT",  $lastline    ] 
					if $embedded_output;

		  } else { 
			push @$oBuffer, [ $index++, "OUTPUT" , $current_line ]; 
		  }
		
		}
		#$self->_debug("iBuffer is now: $iBuffer<<END OF BUFFER>>\n");
	}
	#	_debug $self, "Buffer is now $buffer\n";
      _debug $self, "Read: " . join("",map {$_->[DATA]} @$oBuffer) ."\n" 
		if $self->Debug;
	return scalar(@$oBuffer) ? $oBuffer : undef ;
}

=end obsolete

=cut


sub Report {
	my $self = shift;
#	$self->_debug( "Dumper: " . Data::Dumper::Dumper($self) . 
#			"\nReporting on following keys: " . join(", ",keys %{$self->{'History'}}). "\n");
	return 	map { 
                      map { $_->[DATA] } @{$self->{"History"}{$_}} 
	}		sort { $a <=> $b } keys %{$self->{"History"}}
	;
}


sub Results {
	my $self 	= shift	;
	my $transaction = shift||$self->Count;
	
	return wantarray 							? 
              map {$_->[DATA] }       @{$self->{"History"}{$transaction}}     : 
              [ map {$_->[DATA] }     @{$self->{"History"}{$transaction}} ]   ;
}


sub LastIMAPCommand {
      my @a = map { $_->[DATA] } @{$_[0]->{"History"}{$_[1]||$_[0]->Transaction}};
	return shift @a;
}


sub History {
      my @a = map { $_->[DATA] } @{$_[0]->{"History"}{$_[1]||$_[0]->Transaction}};
	shift @a;
	return wantarray ? @a : \@a ;

}

sub Escaped_results {
	my @a;
	foreach  my $line (@{$_[0]->{"History"}{$_[1]||$_[0]->Transaction}} ) {
		if (  defined($line) and $_[0]->_is_literal($line) ) { 
			$line->[DATA] =~ s/([\\\(\)"\x0d\x0a])/\\$1/g ;
			push @a, qq("$line->[DATA]");
		} else {
      			push @a, $line->[DATA] ;
		}
	}
	# $a[0] is the ALWAYS the command ; I make sure of that in _imap_command
	shift @a;	
	return wantarray ? @a : \@a ;
}

sub Unescape {
	shift @_ if $_[1];
	my $whatever = shift;
	$whatever =~ s/\\([\\\(\)"\x0d\x0a])/$1/g if defined $whatever;
	return $whatever;
}

sub logout {
	my $self = shift;
	my $string = "LOGOUT";
	$self->_imap_command($string) ; 
	$self->{Folders} = undef;
	$self->{_IMAP4REV1} = undef;
	eval {$self->Socket->close if defined($self->Socket)} ; 
	$self->{Socket} = undef;
	$self->State(Unconnected);
	return $self;
}

sub folders {
        my $self = shift;
	my $what = shift ;
        return wantarray ?      @{$self->{Folders}} :
                                $self->{Folders} 
                if ref($self->{Folders}) and !$what;
	
        my @folders ;  
	my @list = $self->list(undef,( $what? "$what" . $self->separator($what) . "*" : undef ) );
	push @list, $self->list(undef, $what) if $what and $self->exists($what) ;
	# my @list = 
	# foreach (@list) { $self->_debug("Pushing $_\n"); }
	my $m;

	for ($m = 0; $m < scalar(@list); $m++ ) {
		# $self->_debug("Folders: examining $list[$m]\n");

		if ($list[$m] && $list[$m]  !~ /\x0d\x0a$/ ) {
			$self->_debug("folders: concatenating $list[$m] and " . $list[$m+1] . "\n") ;
			$list[$m] .= $list[$m+1] ;
			$list[$m+1] = "";	
			$list[$m] .= "\x0d\x0a" unless $list[$m] =~ /\x0d\x0a$/;
		}
			
		

		push @folders, $1||$2 
			if $list[$m] =~
                        /       ^\*\s+LIST               # * LIST
                                \s+\([^\)]*\)\s+         # (Flags)
                                (?:"[^"]*"|NIL)\s+	 # "delimiter" or NIL
                                (?:"([^"]*)"|(.*))\x0d\x0a$  # Name or "Folder name"
                        /ix;
		$folders[-1] = '"' . $folders[-1] . '"' 
			if $1 and !$self->exists($folders[-1]) ;
		# $self->_debug("folders: line $list[$m]: 1=$1 and 2=$2\n");
        } 

        # for my $f (@folders) { $f =~ s/^\\FOLDER LITERAL:://;}
	my @clean = (); my %memory = ();
	foreach my $f (@folders) { push @clean, $f unless $memory{$f}++ }
        $self->{Folders} = \@clean unless $what;

        return wantarray ? @clean : \@clean ;
}


sub exists {
	my ($self,$what) = (shift,shift);
	return $self if $self->STATUS($self->Massage($what),"(MESSAGES)");
	return undef;
}

# Updated to handle embedded literal strings
sub get_bodystructure {
	my($self,$msg) = @_;
	unless ( eval {require Mail::IMAPClient::BodyStructure ; 1 } ) {
		$self->LastError("Unable to use get_bodystructure: $@\n");
		return undef;
	}
	my @out = $self->fetch($msg,"BODYSTRUCTURE");
	my $bs = "";
	my $output = grep(	
		/BODYSTRUCTURE \(/i,  @out	 # Wee! ;-)
	); 
	if ( $output =~ /\r\n$/ ) {
		eval { $bs = Mail::IMAPClient::BodyStructure->new( $output )};  
	} else {
		$self->_debug("get_bodystructure: reassembling original response\n");
		my $start = 0;
		foreach my $o (@{$self->{"History"}{$self->Transaction}}) {
			next unless $self->_is_output_or_literal($o);
			$self->_debug("o->[DATA] is ".$o->[DATA]."\n");
			next unless $start or 
				$o->[DATA] =~ /BODYSTRUCTURE \(/i and ++$start;	  # Hi, vi! ;-)
			if ( length($output) and $self->_is_literal($o) ) {
				my $data = $o->[DATA];
				$data =~ s/"/\\"/g;
				$data =~ s/\(/\\\(/g;
				$data =~ s/\)/\\\)/g;
				$output .= '"'.$data.'"';
			} else {
				$output .= $o->[DATA] ;
			}
			$self->_debug("get_bodystructure: reassembled output=$output<END>\n");
		}
		eval { $bs = Mail::IMAPClient::BodyStructure->new( $output )};  
	}
	$self->_debug("get_bodystructure: msg $msg returns this ref: ". 
		( $bs ? " $bs" : " UNDEF" ) 
		."\n");
	return $bs;
}

# Updated to handle embedded literal strings 
sub get_envelope {
	my($self,$msg) = @_;
	unless ( eval {require Mail::IMAPClient::BodyStructure ; 1 } ) {
		$self->LastError("Unable to use get_envelope: $@\n");
		return undef;
	}
	my @out = $self->fetch($msg,"ENVELOPE");
	my $bs = "";
	my $output = grep(	
		/ENVELOPE \(/i,  @out	 # Wee! ;-)
	); 
	if ( $output =~ /\r\n$/ ) {
		eval { 
		 $bs = Mail::IMAPClient::BodyStructure::Envelope->new($output)
		};
	} else {
		$self->_debug("get_envelope: " .
			"reassembling original response\n");
		my $start = 0;
		foreach my $o (@{$self->{"History"}{$self->Transaction}}) {
			next unless $self->_is_output_or_literal($o);
			$self->_debug("o->[DATA] is ".$o->[DATA]."\n");
			next unless $start or 
				$o->[DATA] =~ /ENVELOPE \(/i and ++$start;
				# Hi, vi! ;-)
			if ( length($output) and $self->_is_literal($o) ) {
				my $data = $o->[DATA];
				$data =~ s/"/\\"/g;
				$data =~ s/\(/\\\(/g;
				$data =~ s/\)/\\\)/g;
				$output .= '"'.$data.'"';
			} else {
				$output .= $o->[DATA] ;
			}
			$self->_debug("get_envelope: " .
				"reassembled output=$output<END>\n");
		}
		eval { 
		  $bs=Mail::IMAPClient::BodyStructure::Envelope->new($output)
		};  
	}
	$self->_debug("get_envelope: msg $msg returns this ref: ". 
		( $bs ? " $bs" : " UNDEF" ) 
		."\n");
	return $bs;
}

=begin obsolete

sub old_get_envelope {
	my($self,$msg) = @_;
	unless ( eval {require Mail::IMAPClient::BodyStructure ; 1 } ) {
		$self->LastError("Unable to use get_envelope: $@\n");
		return undef;
	}
	my $bs = "";
	my @out = $self->fetch($msg,"ENVELOPE");
	my $output = grep(	
		/ENVELOPE \(/i,  @out	 # Wee! ;-)
	); 
	if ( $output =~ /\r\n$/ ) {
		eval { $bs = Mail::IMAPClient::BodyStructure::Envelope->new( $output )};  
	} else {
		$self->_debug("get_envelope: reassembling original response\n");
		my $start = 0;
		foreach my $o (@{$self->{"History"}{$self->Transaction}}) {
			next unless $self->_is_output_or_literal($o);
			$self->_debug("o->[DATA] is ".$o->[DATA]."\n");
			next unless $start or 
				$o->[DATA] =~ /ENVELOPE \(/i and ++$start;	  # Hi, vi! ;-)
			if ( length($output) and $self->_is_literal($o) ) {
				my $data = $o->[DATA];
				$data =~ s/"/\\"/g;
				$data =~ s/\(/\\\(/g;
				$data =~ s/\)/\\\)/g;
				$output .= '"'.$data.'"';
			} else {
				$output .= $o->[DATA] ;
			}
		}
		$self->_debug("get_envelope: reassembled output=$output<END>\n");
		eval { $bs = Mail::IMAPClient::BodyStructure->new( $output )};  
	}
	$self->_debug("get_envelope: msg $msg returns this ref: ". 
		( $bs ? " $bs" : " UNDEF" ) 
		."\n");
	return $bs;
}

=end obsolete

=cut


sub fetch {

	my $self = shift;
	my $what = shift||"ALL";
	#ref($what) and $what = join(",",@$what);	
	if ( $what eq 'ALL' ) {
		$what = $self->Range($self->messages );
	} elsif (ref($what) or $what =~ /^[,:\d]+\w*$/)  {
		$what = $self->Range($what);	
	}
	$self->_imap_command( ( $self->Uid ? "UID " : "" ) .
				"FETCH $what" . ( @_ ? " " . join(" ",@_) : '' )
	) 	 					or return undef;
	return wantarray ? 	$self->History($self->Count) 	: 
                              [ map { $_->[DATA] } @{$self->{'History'}{$self->Count}} ];

}


sub fetch_hash {
	my $self = shift;
	my $hash = ref($_[-1]) ? pop @_ : {};
	my @words = @_;
	for (@words) { 
		s/([\( ])FAST([\) ])/${1}FLAGS INTERNALDATE RFC822\.SIZE$2/i  ;
		s/([\( ])FULL([\) ])/${1}FLAGS INTERNALDATE RFC822\.SIZE ENVELOPE BODY$2/i  ;
	}
	my $msgref = scalar($self->messages);
	my $output = scalar($self->fetch($msgref,"(" . join(" ",@_) . ")")) 
	; #	unless grep(/\b(?:FAST|FULL)\b/i,@words);
	my $x;
	for ($x = 0;  $x <= $#$output ; $x++) {
		my $entry = {};
		my $l = $output->[$x];
		if ($self->Uid) {	
			my($uid) = $l =~ /\((?:.* )?UID (\d+).*\)/i;
			next unless $uid;
			if ( exists $hash->{$uid} ) {
				$entry = $hash->{$uid} ;
			} else {
				$hash->{$uid} ||= $entry;
			}
		} else {
			my($mid) = $l =~ /^\* (\d+) FETCH/i;
			next unless $mid;
			if ( exists $hash->{$mid} ) {
				$entry = $hash->{$mid} ;
			} else {
				$hash->{$mid} ||= $entry;
			}
		}
			
		foreach my $w (@words) {
		   if ( $l =~ /\Q$w\E\s*$/i ) {
			$entry->{$w} = $output->[$x+1];
			$entry->{$w} =~ s/(?:\x0a?\x0d)+$//g;
			chomp $entry->{$w};
		   } else {
			$l =~ /\( 	    # open paren followed by ... 
				(?:.*\s)?   # ...optional stuff and a space
				\Q$w\E\s    # escaped fetch field<sp>
				(?:"	    # then: a dbl-quote
				  (\\.|   # then bslashed anychar(s) or ...
				   [^"]+)   # ... nonquote char(s)
				"|	    # then closing quote; or ...
				\(	    # ...an open paren
				  (\\.|     # then bslashed anychar or ...
				   [^\)]+)  # ... non-close-paren char
				\)|	    # then closing paren; or ...
				(\S+))	    # unquoted string
				(?:\s.*)?   # possibly followed by space-stuff
				\)	    # close paren
			/xi;
			$entry->{$w}=defined($1)?$1:defined($2)?$2:$3;
		   }
		}
	}
	return wantarray ? %$hash : $hash;
}
sub AUTOLOAD {

	my $self = shift;
	return undef if $Mail::IMAPClient::AUTOLOAD =~ /DESTROY$/;
	delete $self->{Folders}  ;
	my $autoload = $Mail::IMAPClient::AUTOLOAD;
	$autoload =~ s/.*:://;
	if (	
			$^W
		and	$autoload =~ /^[a-z]+$/
		and	$autoload !~ 
				/^	(?:
						store	 |
						copy	 |
						subscribe|
						create	 |
						delete	 |
						close	 |
						expunge
					)$
				/x 
	) {
		carp 	"$autoload is all lower-case. " .
			"May conflict with future methods. " .
			"Change method name to be mixed case or all upper case to ensure " .
			"upward compatability"
	}
	if (scalar(@_)) {
		my @a = @_;
		if (	
			$autoload =~ 
				/^(?:subscribe|delete|myrights)$/i
		) {
			$a[-1] = $self->Massage($a[-1]) ;
		} elsif (	
			$autoload =~ 
				/^(?:create)$/i
		) {
			$a[0] = $self->Massage($a[0]) ;
		} elsif (
			$autoload =~ /^(?:store|copy)$/i
		) {
			$autoload = "UID $autoload"
				if $self->Uid;
		} elsif (
			$autoload =~ /^(?:expunge)$/i and defined($_[0])
		) {
			my $old;
			if ( $_[0] ne $self->Folder ) {
				$old = $self->Folder; $self->select($_[0]); 
			} 	
			my $succ = $self->_imap_command(qq/$autoload/) ;
			$self->select($old);
			return undef unless $succ;
			return wantarray ? 	$self->History($self->Count) 	: 
                                              map {$_->[DATA]}@{$self->{'History'}{$self->Count}}     ;
			
		}
		$self->_debug("Autoloading: $autoload " . ( @a ? join(" ",@a):"" ) ."\n" )
			if $self->Debug;
		return undef 
			unless $self->_imap_command(
			 	qq/$autoload/ .  ( @a ? " " . join(" ",@a) : "" )
			)  ;
	} else {
		$self->Folder(undef) if $autoload =~ /^(?:close)/i ; 
		$self->_imap_command(qq/$autoload/) or return undef;
	}
	return wantarray ? 	$self->History($self->Count) 	: 
                              [map {$_->[DATA] } @{$self->{'History'}{$self->Count}}] ;

}

sub rename {
    my $self = shift;
    my ($from, $to) = @_;
    local($_);
    if ($from =~ /^"(.*)"$/) {
	$from = $1 unless $self->exists($from);
        $from =~ s/"/\\"/g;
    }
    if ($to =~ /^"(.*)"$/) {
	$to = $1 unless $self->exists($from) and $from =~ /^".*"$/;
        $to =~ s/"/\\"/g;
    }
    $self->_imap_command(qq(RENAME "$from" "$to")) or return undef;
    return $self;
}

sub status {

	my $self = shift;
	my $box = shift ;  
	return undef unless defined($box);
	$box = $self->Massage($box);
	my @pieces = @_;
	$self->_imap_command("STATUS $box (". (join(" ",@_)||'MESSAGES'). ")") or return undef;
	return wantarray ? 	$self->History($self->Count) 	: 
                              [map{$_->[DATA]}@{$self->{'History'}{$self->Count}}];

}


# Can take a list of messages now.
# If a single message, returns array or ref to array of flags
# If a ref to array of messages, returns a ref to hash of msgid => flag arr
# See parse_headers for more information
# 2000-03-22 Adrian Smith (adrian.smith@ucpag.com)

sub flags {
	my $self = shift;
	my $msgspec = shift;
	my $flagset = {};
	my $msg;
	my $u_f = $self->Uid;

	# Determine if set of messages or just one
	if (ref($msgspec) eq 'ARRAY' ) {
		$msg = $self->Range($msgspec) ;
	} elsif ( !ref($msgspec) ) 	{
		$msg = $msgspec;
		if ( scalar(@_) ) {
			$msgspec = $self->Range($msg) ;
			$msgspec += $_ for (@_);
			$msg = $msgspec;
		}
	} elsif ( ref($msgspec) =~ /MessageSet/ ) {
		if ( scalar(@_) ) {
			$msgspec += $_ for @_;
		}
	} else {
		$self->LastError("Invalid argument passed to fetch.\n");
		return undef;
	}

	# Send command
	unless ( $self->fetch($msg,"FLAGS") ) {
		return undef;
	}

	# Parse results, setting entry in result hash for each line
 	foreach my $resultline ($self->Results) {
		$self->_debug("flags: line = '$resultline'\n") ;
		if (	$resultline =~ 
			/\*\s+(\d+)\s+FETCH\s+	# * nnn FETCH 
			 \(			# open-paren
			 (?:\s?UID\s(\d+)\s?)?	# optional: UID nnn <space>
			 FLAGS\s?\((.*)\)\s?	# FLAGS (\Flag1 \Flag2) <space>
			 (?:\s?UID\s(\d+))?	# optional: UID nnn
			 \) 			# close-paren
			/x
		) {
			{ local($^W=0);
			 $self->_debug("flags: line = '$resultline' " .
			   "and 1,2,3,4 = $1,$2,$3,$4\n") 
			 if $self->Debug;
			}
			my $mailid = $u_f ? ( $2||$4) : $1;
			my $flagsString = $3 ;
			my @flags = map { s/\s+$//; $_ } split(/\s+/, $flagsString);
			$flagset->{$mailid} = \@flags;
		}
	}

	# Did the guy want just one response? Return it if so
	unless (ref($msgspec) ) {
		my $flagsref = $flagset->{$msgspec};
		return wantarray ? @$flagsref : $flagsref;
	}

	# Or did he want a hash from msgid to flag array?
	return $flagset;
}

# parse_headers modified to allow second param to also be a
# reference to a list of numbers. If this is a case, the headers
# are read from all the specified messages, and a reference to
# an hash of mail numbers to references to hashes, are returned.
# I found, with a mailbox of 300 messages, this was
# *significantly* faster against our mailserver (< 1 second
# vs. 20 seconds)
#
# 2000-03-22 Adrian Smith (adrian.smith@ucpag.com)

sub parse_headers {
	my($self,$msgspec,@fields) = @_;
	my(%fieldmap) = map { ( lc($_),$_ )  } @fields;
	my $msg; my $string; my $field;

	# Make $msg a comma separated list, of messages we want
        if (ref($msgspec) eq 'ARRAY') {
		#$msg = join(',', @$msgspec);
		$msg = $self->Range($msgspec);
	} else {
		$msg = $msgspec;
	}

	if ($fields[0] 	=~ 	/^[Aa][Ll]{2}$/ 	) { 

		$string = 	"$msg body" . 
		# use ".peek" if Peek parameter is a) defined and true, 
		# 	or b) undefined, but not if it's defined and untrue:

		( 	defined($self->Peek) 		? 
			( $self->Peek ? ".peek" : "" ) 	: 
			".peek" 
		) .  "[header]" 			; 

	} else {
		$string	= 	"$msg body" .
		# use ".peek" if Peek parameter is a) defined and true, or 
		# b) undefined, but not if it's defined and untrue:

		( defined($self->Peek) 			? 
			( $self->Peek ? ".peek" : "" ) 	: 
			".peek" 
		) .  "[header.fields ("	. join(" ",@fields) 	. ')]' ;
	}

	my @raw=$self->fetch(	$string	) or return undef;

	my $headers = {};	# hash from message ids to header hash
	my $h = 0;		# reference to hash of current msgid, or 0 between msgs
	
        for my $header (map { split(/(?:\x0d\x0a)/,$_) } @raw) {
                local($^W) = undef;
                if ( $header =~ /^\*\s+\d+\s+FETCH\s+\(.*BODY\[HEADER(?:\]|\.FIELDS)/i) {
                        if ($self->Uid) {
                                if ( my($msgid) = $header =~ /UID\s+(\d+)/ ) {
                                        $h = {};
                                        $headers->{$msgid} = $h;
                                } else {
                                        $h = {};
                                }
                        } else {
                                if ( my($msgid) = $header =~ /^\*\s+(\d+)/ ) {
                                        #start of new message header:
                                        $h = {};
                                        $headers->{$msgid} = $h;
                                }
                        }
                }
                next if $header =~ /^\s+$/;

                # ( for vi
                if ($header =~ /^\)/) {           # end of this message
                        $h = 0;                   # set to be between messages
                        next;
                }
                # check for '<optional_white_space>UID<white_space><UID_number><optional_white_space>)'
                # when parsing headers by UID.
                if ($self->Uid and my($msgid) = $header =~ /^\s*UID\s+(\d+)\s*\)/) {
                        $headers->{$msgid} = $h;        # store in results against this message
                        $h = 0;                 	# set to be between messages
                        next;
                }

		if ($h != 0) {			  # do we expect this to be a header?
               		my $hdr = $header;
               		chomp $hdr;
               		$hdr =~ s/\r$//;   
               		if ($hdr =~ s/^(\S+):\s*//) { 
                       		$field = exists $fieldmap{lc($1)} ? $fieldmap{lc($1)} : $1 ;
                       		push @{$h->{$field}} , $hdr ;
               		} elsif ($hdr =~ s/^.*FETCH\s\(.*BODY\[HEADER\.FIELDS.*\)\]\s(\S+):\s*//) { 
                       		$field = exists $fieldmap{lc($1)} ? $fieldmap{lc($1)} : $1 ;
                       		push @{$h->{$field}} , $hdr ;
               		} elsif ( ref($h->{$field}) eq 'ARRAY') {
			        
					$hdr =~ s/^\s+/ /;
                       			$h->{$field}[-1] .= $hdr ;
               		}
		}
	}
	my $candump = 0;
	if ($self->Debug) {
		eval {
			require Data::Dumper;
			Data::Dumper->import;
		};
		$candump++ unless $@;
	}
	# if we asked for one message, just return its hash,
	# otherwise, return hash of numbers => header hash
	# if (ref($msgspec) eq 'ARRAY') {
	if (ref($msgspec) ) {
		#_debug $self,"Structure from parse_headers:\n", 
		#	Dumper($headers) 
		#	if $self->Debug;
		return $headers;
	} else {
		#_debug $self, "Structure from parse_headers:\n", 
		#	Dumper($headers->{$msgspec}) 
		#	if $self->Debug;
		return $headers->{$msgspec};
	}
}

sub subject { return $_[0]->get_header($_[1],"Subject") }
sub date { return $_[0]->get_header($_[1],"Date") }
sub rfc822_header { get_header(@_) }

sub get_header {
	my($self , $msg, $header ) = @_;
	my $val = 0;
	eval { $val = $self->parse_headers($msg,$header)->{$header}[0] };
	return defined($val)? $val : undef;
}

sub recent_count {
	my ($self, $folder) = (shift, shift);

	$self->status($folder, 'RECENT') or return undef;

	chomp(my $r = ( grep { s/\*\s+STATUS\s+.*\(RECENT\s+(\d+)\s*\)/$1/ }
			$self->History($self->Transaction)
	)[0]);

	$r =~ s/\D//g;

	return $r;
}

sub message_count {
	
	my ($self, $folder) = (shift, shift);
	$folder ||= $self->Folder;
	
	$self->status($folder, 'MESSAGES') or return undef;
        foreach my $result  (@{$self->{"History"}{$self->Transaction}}) {
              return $1 if $result->[DATA] =~ /\(MESSAGES\s+(\d+)\s*\)/ ;
        }

	return undef;

}

{
for my $datum (
                qw(     recent seen
                        unseen messages
                 )
) {
        no strict 'refs';
        *$datum = sub {
		my $self = shift;
		#my @hits;

		#my $hits = $self->search($datum eq "messages" ? "ALL" : "$datum")
		#	 or return undef;
		#print "Received $hits from search and array context flag is ",
		#	wantarry,"\n";
		#if ( scalar(@$hits) ) {
		#	return wantarray ? @$hits : $hits ;
		#}
		return $self->search($datum eq "messages" ? "ALL" : "$datum") ;


        };
}
}
{
for my $datum (
                qw(     sentbefore 	sentsince 	senton
			since 		before 		on
                 )
) {
	no strict 'refs';
	*$datum = sub {

		my($self,$time) = (shift,shift);

		my @hits; my $imapdate;
		my @mnt  =      qw{ Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec};

		if ( $time =~ /\d\d-\D\D\D-\d\d\d\d/ ) {
			$imapdate = $time;
		} elsif ( $time =~ /^\d+$/ ) {
			my @ltime = localtime($time);
			$imapdate = sprintf(	"%2.2d-%s-%4.4d", 
						$ltime[3], $mnt[$ltime[4]], $ltime[5] + 1900);
		} else {
			$self->LastError("Invalid date format supplied to '$datum' method.");
			return undef;
		}
		$self->_imap_command( ($self->Uid ? "UID " : "") . "SEARCH $datum $imapdate")
			or return undef;
		my @results =  $self->History($self->Count)     ;

		for my $r (@results) {

		       chomp $r;
		       $r =~ s/\r$//;
		       $r =~ s/^\*\s+SEARCH\s+//i or next;
		       push @hits, grep(/\d/,(split(/\s+/,$r)));
			_debug $self, "Hits are now: ",join(',',@hits),"\n" if $self->Debug;
		}

		return wantarray ? @hits : \@hits;
	}
}
}

sub or {

	my $self = shift ;
	my @what = @_; 
	my @hits;

	if ( scalar(@what) < 2 ) {
		$self->LastError("Invalid number of arguments passed to or method.\n");
		return undef;
	}

	my $or = "OR " . $self->Massage(shift @what);
	$or .= " " . $self->Massage(shift @what);
		

	for my $w ( @what ) {
		my $w = $self->Massage($w) ;
		$or = "OR " . $or . " " . $w ;
	}

	$self->_imap_command( ($self->Uid ? "UID " : "") . "SEARCH $or")
		or return undef;
	my @results =  $self->History($self->Count)     ;

	for my $r (@results) {

	       chomp $r;
	       $r =~ s/\r$//;
	       $r =~ s/^\*\s+SEARCH\s+//i or next;
	       push @hits, grep(/\d/,(split(/\s+/,$r)));
		_debug $self, "Hits are now: ",join(',',@hits),"\n" 
				if $self->Debug;
	}

	return wantarray ? @hits : \@hits;
}

#sub Strip_cr {
#	my $self = shift;

#	my $in = $_[0]||$self ;

#	$in =~ s/\r//g  ;

#	return $in;
#}


sub disconnect { $_[0]->logout }


sub search {

	my $self = shift;
	my @hits;
	my @a = @_;
	$@ = "";
	# massage?
	$a[-1] = $self->Massage($a[-1],1) 
		if scalar(@a) > 1 and !exists($SEARCH_KEYS{uc($a[-1])}); 
	$self->_imap_command( ( $self->Uid ? "UID " : "" ) . "SEARCH ". join(' ',@a)) 
			 or return undef;
	my $results =  $self->History($self->Count) ;


	for my $r (@$results) {
	#$self->_debug("Considering the search result line: $r");			
               chomp $r;
               $r =~ s/\r\n?/ /g;
               $r =~ s/^\*\s+SEARCH\s+(?=.*\d.*)// or next;
               my @h = grep(/^\d+$/,(split(/\s+/,$r)));
	       push @hits, @h if scalar(@h) ; # and grep(/\d/,@h) );

	}

	$self->{LastError}="Search completed successfully but found no matching messages\n"
		unless scalar(@hits);

	if ( wantarray ) {
		return @hits;
	} else {
		if ($self->Ranges) {
			#print STDERR "Fetch: Returning range\n";
			return scalar(@hits) ? $self->Range(\@hits) : undef;
		} else {
			#print STDERR "Fetch: Returning ref\n";
			return scalar(@hits) ? \@hits : undef;
		}
	}
}

sub thread {
	# returns a Thread data structure
	#
	# $imap->thread($algorythm, $charset, @search_args);
	my $self = shift;

	my $algorythm     = shift;
	   $algorythm   ||= $self->has_capability("THREAD=REFERENCES") ? "REFERENCES" : "ORDEREDSUBJECT";
	my $charset 	  = shift;
	   $charset 	||= "UTF-8";

	my @a = @_;

	$a[0]||="ALL" ;
	my @hits;
	# massage?

	$a[-1] = $self->Massage($a[-1],1) 
		if scalar(@a) > 1 and !exists($SEARCH_KEYS{uc($a[-1])}); 
	$self->_imap_command( ( $self->Uid ? "UID " : "" ) . 
				"THREAD $algorythm $charset " . 
				join(' ',@a)
	) or return undef;
	my $results =  $self->History($self->Count) ;

	my $thread = "";
	for my $r (@$results) {
		#$self->_debug("Considering the search result line: $r");			
               	chomp $r;
               	$r =~ s/\r\n?/ /g;
               	if ( $r =~ /^\*\s+THREAD\s+/ ) {
			eval { require "Mail/IMAPClient/Thread.pm" }
				or ( $self->LastError($@), return undef);
			my $parser = Mail::IMAPClient::Thread->new();
			$thread = $parser->start($r) ;
		} else {
			next;
		}
	       	#while ( $r =~ /(\([^\)]*\))/ ) { 
		#	push @hits, [ split(/ /,$1) ] ;
		#}
	}

	$self->{LastError}="Thread search completed successfully but found no matching messages\n"
		unless ref($thread);
	return $thread ||undef;

	if ( wantarray ) {

		return @hits;
	} else {
		return scalar(@hits) ? \@hits : undef;
	}
}




sub delete_message {

	my $self = shift;
	my $count = 0;
	my @msgs = ();
	for my $arg (@_) {
		if (ref($arg) eq 'ARRAY') {
			push @msgs, @{$arg};
		} else {
			push @msgs, split(/\,/,$arg);
		}
	}
	

	$self->store(join(',',@msgs),'+FLAGS.SILENT','(\Deleted)') and $count = scalar(@msgs);

	return $count;
}

sub restore_message {

	my $self = shift;
	my @msgs = ();
	for my $arg (@_) {
		if (ref($arg) eq 'ARRAY') {
			push @msgs, @{$arg};
		} else {
			push @msgs, split(/\,/,$arg);
		}
	}
	

	$self->store(join(',',@msgs),'-FLAGS','(\Deleted)') ;
	my $count = grep(
			/
				^\*			# Start with an asterisk
				\s\d+			# then a space then a number
				\sFETCH			# then a space then the string 'FETCH'
				\s\(			# then a space then an open paren :-) 
				.*			# plus optional anything
				FLAGS			# then the string "FLAGS"
				.*			# plus anything else
				(?!\\Deleted)		# but never "\Deleted"
			/x,
			$self->Results
	);
	

	return $count;
}


sub uidvalidity {

	my $self = shift; my $folder = shift;

	my $vline = (grep(/UIDVALIDITY/i, $self->status($folder, "UIDVALIDITY")))[0];

	my($validity) = $vline =~ /\(UIDVALIDITY\s+([^\)]+)/;

	return $validity;
}

# 3 status folder (uidnext)
# * STATUS folder (UIDNEXT 290)

sub uidnext {

	my $self = shift; my $folder = $self->Massage(shift);

	my $line = (grep(/UIDNEXT/i, $self->status($folder, "UIDNEXT")))[0];

	my($uidnext) = $line =~ /\(UIDNEXT\s+([^\)]+)/;

	return $uidnext;
}

sub capability {

	my $self = shift;

	$self->_imap_command('CAPABILITY') or return undef;

	my @caps = ref($self->{CAPABILITY}) 		? 
			keys %{$self->{CAPABILITY}} 	: 
			map { split } 
				grep (s/^\*\s+CAPABILITY\s+//, 
				$self->History($self->Count));

	unless ( exists $self->{CAPABILITY} ) { 
		for (@caps) { 
			$self->{CAPABILITY}{uc($_)}++ ;
			if (/=/) {
				my($k,$v)=split(/=/,$_) ;
				$self->{uc($k)} = uc($v) ;
			}
		} 
	}
	

	return wantarray ? @caps : \@caps;
}

sub has_capability {
	my $self = shift;
	$self->capability;
	local($^W)=0;
	return $self->{CAPABILITY}{uc($_[0])};
}

sub imap4rev1 {
	my $self = shift;
	return exists($self->{_IMAP4REV1}) ?  
		$self->{_IMAP4REV1} : 
		$self->{_IMAP4REV1} = $self->has_capability(IMAP4REV1) ;
}

sub namespace {
	# Returns a (reference to a?) nested list as follows:
	# [ 
	#  [
	#   [ $user_prefix,  $user_delim  ] (,[$user_prefix2  ,$user_delim  ], [etc,etc] ),
	#  ],
	#  [
	#   [ $shared_prefix,$shared_delim] (,[$shared_prefix2,$shared_delim], [etc,etc] ),
	#  ],
	#  [
	#   [$public_prefix, $public_delim] (,[$public_prefix2,$public_delim], [etc,etc] ),
	#  ],
	# ] ;
		
	my $self = shift;
	unless ( $self->has_capability("NAMESPACE") ) {
			my $error = $self->Count . " NO NAMESPACE not supported by " . $self->Server ;
			$self->LastError("$error\n") ;
			$self->_debug("$error\n") ;
			$@ = $error;
			carp "$@" if $^W;
			return undef;
	}
	my $namespace = (map({ /^\* NAMESPACE (.*)/ ? $1 : () } @{$self->_imap_command("NAMESPACE")->Results}))[0] ;
	$namespace =~ s/\x0d?\x0a$//;
	my($personal,$shared,$public) = $namespace =~ m#
		(NIL|\((?:\([^\)]+\)\s*)+\))\s
		(NIL|\((?:\([^\)]+\)\s*)+\))\s
		(NIL|\((?:\([^\)]+\)\s*)+\))
	#xi;
	
	my @ns = ();
	$self->_debug("NAMESPACE: pers=$personal, shared=$shared, pub=$public\n");
	push @ns, map {
		$_ =~ s/^\((.*)\)$/$1/;
		my @pieces = m#\(([^\)]*)\)#g;
		$self->_debug("NAMESPACE pieces: " . join(", ",@pieces) . "\n");
		my $ref = [];
		foreach my $atom (@pieces) {
			push @$ref, [ $atom =~ m#"([^"]*)"\s*#g ] ;
		}
		$_ =~ /^NIL$/i ? undef : $ref;
	} ( $personal, $shared, $public) ;
	return wantarray ? @ns : \@ns;
}

# Contributed by jwm3
sub internaldate {
        my $self = shift;
        my $msg  = shift;
        $self->_imap_command( ( $self->Uid ? "UID " : "" ) . "FETCH $msg INTERNALDATE") or return undef;
        my $internalDate = join("", $self->History($self->Count));
        $internalDate =~ s/^.*INTERNALDATE "//si;
        $internalDate =~ s/\".*$//s;
        return $internalDate;
}

sub is_parent {
	my ($self, $folder) = (shift, shift);
	# $self->_debug("Checking parentage ".( $folder ? "for folder $folder" : "" )."\n");
        my $list = $self->list(undef, $folder)||"NO NO BAD BAD";
	my $line = '';

        for (my $m = 0; $m < scalar(@$list); $m++ ) {
		#$self->_debug("Judging whether or not $list->[$m] is fit for parenthood\n");
		return undef 
		  if $list->[$m] =~ /NoInferior/i;       # let's not beat around the bush!

                if ($list->[$m]  =~ s/(\{\d+\})\x0d\x0a$// ) {
                        $list->[$m] .= $list->[$m+1];
                        $list->[$m+1] = "";
                }

	    	$line = $list->[$m]
                        if $list->[$m] =~
                        /       ^\*\s+LIST              # * LIST
                                \s+\([^\)]*\)\s+            # (Flags)
                                "[^"]*"\s+              # "delimiter"
                                (?:"([^"]*)"|(.*))\x0d\x0a$  # Name or "Folder name"
                        /x;
	}	
	if ( $line eq "" ) {
		$self->_debug("Warning: separator method found no correct o/p in:\n\t" .
			join("\t",@list)."\n");
	}
	my($f) = $line =~ /^\*\s+LIST\s+\(([^\)]*)\s*\)/ if $line;
	return  1 if $f =~ /HasChildren/i ;
	return 0 if $f =~ /HasNoChildren/i ;
	unless ( $f =~ /\\/) {		# no flags at all unless there's a backslash
		my $sep = $self->separator($folder);
		return 1 if scalar(grep /^${folder}${sep}/, $self->folders);
		return 0;
	}
}

sub selectable {my($s,$f)=@_;return grep(/NoSelect/i,$s->list("",$f))?0:1;}

sub append_string {

        my $self = shift;
        my $folder = $self->Massage(shift);

	my $text = shift;
	$text =~ s/\x0d?\x0a/\x0d\x0a/g;
 
	my($flags,$date) = (shift,shift);

	if (defined($flags)) {
		$flags =~ s/^\s+//g;
		$flags =~ s/\s+$//g;
	}

	if (defined($date)) {
		$date =~ s/^\s+//g;
		$date =~ s/\s+$//g;
	}

	$flags = "($flags)"  if $flags and $flags !~ /^\(.*\)$/ ;
	$date  = qq/"$date"/ if $date  and $date  !~ /^"/ 	;

        my $clear = $self->Clear;

        $self->Clear($clear)
                if $self->Count >= $clear and $clear > 0;

	my $count 	= $self->Count($self->Count+1);

        my $string = 	  "$count APPEND $folder "  	  . 
			( $flags ? "$flags " : "" 	) . 
			( $date ? "$date " : "" 	) . 
			"{" . length($text)  . "}\x0d\x0a" ;

        $self->_record($count,[ $self->_next_index($count), "INPUT", "$string\x0d\x0a" ] );

	# Step 1: Send the append command.

	my $feedback = $self->_send_line("$string");

	unless ($feedback) {
		$self->LastError("Error sending '$string' to IMAP: $!\n");
		return undef;
	}

	my ($code, $output) = ("","");	
	
	# Step 2: Get the "+ go ahead" response
	until ( $code ) {
		$output = $self->_read_line or return undef;	
		foreach my $o (@$output) { 

			$self->_record($count,$o);	# $o is already an array ref
			next unless $self->_is_output($o);

                      ($code) = $o->[DATA] =~ /(^\+|^\d*\s*NO|^\d*\s*BAD)/i ;

                      if ($o->[DATA] =~ /^\*\s+BYE/i) {
                              $self->LastError("Error trying to append string: " . 
						$o->[DATA]. "; Disconnected.\n");
                              $self->_debug("Error trying to append string: " . $o->[DATA]. 
					"; Disconnected.\n");
                              carp("Error trying to append string: " . $o->[DATA] ."; Disconnected") if $^W;
				$self->State(Unconnected);

                      } elsif ( $o->[DATA] =~ /^\d*\s*(NO|BAD)/i ) { # i and / transposed!!!
                              $self->LastError("Error trying to append string: " . $o->[DATA]  . "\n");
                              $self->_debug("Error trying to append string: " . $o->[DATA] . "\n");
                              carp("Error trying to append string: " . $o->[DATA]) if $^W;
				return undef;
			}
		}
	}	
	
	$self->_record($count,[ $self->_next_index($count), "INPUT", "$text\x0d\x0a" ] );

	# Step 3: Send the actual text of the message:
        $feedback = $self->_send_line("$text\x0d\x0a");

        unless ($feedback) {
                $self->LastError("Error sending append msg text to IMAP: $!\n");
                return undef;
        }
	$code = undef;			# clear out code

	# Step 4: Figure out the results:
        until ($code) {
                $output = $self->_read_line or return undef;
              $self->_debug("Append results: " . map({ $_->[DATA] } @$output) . "\n" )
			if $self->Debug;
                foreach my $o (@$output) {
			$self->_record($count,$o); # $o is already an array ref

                      ($code) = $o->[DATA] =~ /^(?:$count|\*) (OK|NO|BAD)/im  ;
			
                      if ($o->[DATA] =~ /^\*\s+BYE/im) {
				$self->State(Unconnected);
                              $self->LastError("Error trying to append: " . $o->[DATA] . "\n");
                              $self->_debug("Error trying to append: " . $o->[DATA] . "\n");
                              carp("Error trying to append: " . $o->[DATA] ) if $^W;
			}
			if ($code and $code !~ /^OK/im) {
                              $self->LastError("Error trying to append: " . $o->[DATA] . "\n");
                              $self->_debug("Error trying to append: " . $o->[DATA] . "\n");
                              carp("Error trying to append: " . $o->[DATA] ) if $^W;
				return undef;
			}
        	}
	}

      my($uid) = join("",map { $_->[TYPE] eq "OUTPUT" ? $_->[DATA] : () } @$output ) =~ m#\s+(\d+)\]#;

        return defined($uid) ? $uid : $self;
}
sub append {

        my $self = shift;
	# now that we're passing thru to append_string we won't massage here
        # my $folder = $self->Massage(shift); 
        my $folder = shift;

	my $text = join("\x0d\x0a",@_);
	$text =~ s/\x0d?\x0a/\x0d\x0a/g;
	return $self->append_string($folder,$text);
}

sub append_file {

        my $self 	= shift;
        my $folder 	= $self->Massage(shift);
	my $file 	= shift; 
	my $control 	= shift || undef;
	my $count 	= $self->Count($self->Count+1);


	unless ( -f $file ) {
		$self->LastError("File $file not found.\n");
		return undef;
	}

	my $fh = IO::File->new($file) ;

	unless ($fh) {
		$self->LastError("Unable to open $file: $!\n");
		$@ = "Unable to open $file: $!" ;
		carp "unable to open $file: $!" if $^W;
		return undef;
	}

	my $bare_nl_count = scalar grep { /^\x0a$|[^\x0d]\x0a$/} <$fh>;

	seek($fh,0,0);
	
        my $clear = $self->Clear;

        $self->Clear($clear)
                if $self->Count >= $clear and $clear > 0;

	my $length = ( -s $file ) + $bare_nl_count;

        my $string = "$count APPEND $folder {" . $length  . "}\x0d\x0a" ;

        $self->_record($count,[ $self->_next_index($count), "INPUT", "$string" ] );

	my $feedback = $self->_send_line("$string");

	unless ($feedback) {
		$self->LastError("Error sending '$string' to IMAP: $!\n");
		close $fh;
		return undef;
	}

	my ($code, $output) = ("","");	
	
	until ( $code ) {
		$output = $self->_read_line or close $fh, return undef;	
		foreach my $o (@$output) {
			$self->_record($count,$o);		# $o is already an array ref
                      ($code) = $o->[DATA] =~ /(^\+|^\d+\sNO|^\d+\sBAD)/i; 
                      if ($o->[DATA] =~ /^\*\s+BYE/) {
                              carp $o->[DATA] if $^W;
				$self->State(Unconnected);
				close $fh;
				return undef ;
                      } elsif ( $o->[DATA]=~ /^\d+\s+(NO|BAD)/i ) {
                              carp $o->[DATA] if $^W;
				close $fh;
				return undef;
			}
		}
	}	
	
	{ 	# Narrow scope
		# Slurp up headers: later we'll make this more efficient I guess
		local $/ = "\x0d\x0a\x0d\x0a"; 
		my $text = <$fh>;
		$text =~ s/\x0d?\x0a/\x0d\x0a/g;
		$self->_record($count,[ $self->_next_index($count), "INPUT", "{From file $file}" ] ) ;
		$feedback = $self->_send_line($text);

		unless ($feedback) {
			$self->LastError("Error sending append msg text to IMAP: $!\n");
			close $fh;
			return undef;
		}
		_debug $self, "control points to $$control\n" if ref($control) and $self->Debug;
		$/ = 	ref($control) ?  "\x0a" : $control ? $control : 	"\x0a";	
		while (defined($text = <$fh>)) {
			$text =~ s/\x0d?\x0a/\x0d\x0a/g;
			$self->_record(	$count,
					[ $self->_next_index($count), "INPUT", "{from $file}\x0d\x0a" ] 
			);
			$feedback = $self->_send_line($text,1);

			unless ($feedback) {
				$self->LastError("Error sending append msg text to IMAP: $!\n");
				close $fh;
				return undef;
			}
		}
		$feedback = $self->_send_line("\x0d\x0a");

		unless ($feedback) {
			$self->LastError("Error sending append msg text to IMAP: $!\n");
			close $fh;
			return undef;
		}
	} 

	# Now for the crucial test: Did the append work or not?
	($code, $output) = ("","");	

	my $uid = undef;	
	until ( $code ) {
		$output = $self->_read_line or return undef;	
		foreach my $o (@$output) {
			$self->_record($count,$o);		# $o is already an array ref
                      $self->_debug("append_file: Deciding if " . $o->[DATA] . " has the code.\n") 
				if $self->Debug;
                      ($code) = $o->[DATA]  =~ /^\d+\s(NO|BAD|OK)/i; 
			# try to grab new msg's uid from o/p
                      $o->[DATA]  =~ m#UID\s+\d+\s+(\d+)\]# and $uid = $1; 
                      if ($o->[DATA] =~ /^\*\s+BYE/) {
                              carp $o->[DATA] if $^W;
				$self->State(Unconnected);
				close $fh;
				return undef ;
                      } elsif ( $o->[DATA]=~ /^\d+\s+(NO|BAD)/i ) {
                              carp $o->[DATA] if $^W;
				close $fh;
				return undef;
			}
		}
	}	
	close $fh;

	if ($code !~ /^OK/i) {
		return undef;
	}


        return defined($uid) ? $uid : $self;
}


sub authenticate {

        my $self 	= shift;
        my $scheme 	= shift;
        my $response 	= shift;
	
	$scheme   ||= $self->Authmechanism;
	$response ||= $self->Authcallback;
        my $clear = $self->Clear;

        $self->Clear($clear)
                if $self->Count >= $clear and $clear > 0;

	my $count 	= $self->Count($self->Count+1);


        my $string = "$count AUTHENTICATE $scheme";

        $self->_record($count,[ $self->_next_index($self->Transaction), 
				"INPUT", "$string\x0d\x0a"] );

	my $feedback = $self->_send_line("$string");

	unless ($feedback) {
		$self->LastError("Error sending '$string' to IMAP: $!\n");
		return undef;
	}

	my ($code, $output);	
	
	until ($code) {
		$output = $self->_read_line or return undef;	
		foreach my $o (@$output) {
			$self->_record($count,$o);	# $o is a ref
			($code) = $o->[DATA] =~ /^\+(.*)$/ ;
			if ($o->[DATA] =~ /^\*\s+BYE/) {
				$self->State(Unconnected);
				return undef ;
			}
		}
	}	
	
        return undef if $code =~ /^BAD|^NO/ ;

        if ('CRAM-MD5' eq $scheme && ! $response) {
          if ($Mail::IMAPClient::_CRAM_MD5_ERR) {
            $self->LastError($Mail::IMAPClient::_CRAM_MD5_ERR);
            carp $Mail::IMAPClient::_CRAM_MD5_ERR if $^W;
          } else {
            $response = \&_cram_md5;
          }
        }

        $feedback = $self->_send_line($response->($code, $self));

        unless ($feedback) {
                $self->LastError("Error sending append msg text to IMAP: $!\n");
                return undef;
        }

	$code = ""; 	# clear code
        until ($code) {
                $output = $self->_read_line or return undef;
		foreach my $o (@$output) {
                	$self->_record($count,$o);	# $o is a ref
			if ( ($code) = $o->[DATA] =~ /^\+ (.*)$/ ) {
				$feedback = $self->_send_line($response->($code,$self));
				unless ($feedback) {
					$self->LastError("Error sending append msg text to IMAP: $!\n");
					return undef;
				}
				$code = "" ;		# Clear code; we're still not finished
			} else {
				$o->[DATA] =~ /^$count (OK|NO|BAD)/ and $code = $1;
				if ($o->[DATA] =~ /^\*\s+BYE/) {
					$self->State(Unconnected);
					return undef ;
				}
			}
		}
        }

        $code =~ /^OK/ and $self->State(Authenticated) ;
        return $code =~ /^OK/ ? $self : undef ;

}

# UIDPLUS response from a copy: [COPYUID (uidvalidity) (origuid) (newuid)]
sub copy {

	my($self, $target, @msgs) = @_;

	$target = $self->Massage($target);
	if ( $self->Ranges ) {
		@msgs = ($self->Range(@msgs));
	} else {
		@msgs   = sort { $a <=> $b } map { ref($_)? @$_ : split(',',$_) } @msgs;
	}

	$self->_imap_command( 
	  ( 	$self->Uid ? "UID " : "" ) . 
		"COPY " . 
		( $self->Ranges ? $self->Range(@msgs) : 
		join(',',map { ref($_)? @$_ : $_ } @msgs)) . 
		" $target"
	) 			or return undef		;
	my @results =  $self->History($self->Count) 	;
	
	my @uids;

	for my $r (@results) {
			
               chomp $r;
               $r =~ s/\r$//;
               $r =~ s/^.*\[COPYUID\s+\d+\s+[\d:,]+\s+([\d:,]+)\].*/$1/ or next;
               push @uids, ( $r =~ /(\d+):(\d+)/ ? $1 ... $2 : split(/,/,$r) ) ;

	}

	return scalar(@uids) ? join(",",@uids) : $self;
}

sub move {

	my($self, $target, @msgs) = @_;

	$self->create($target) and $self->subscribe($target) 
		unless $self->exists($target);
	
	my $uids = $self->copy($target, map { ref($_) =~ /ARRAY/ ? @{$_} : $_ } @msgs) 
		or return undef;

	$self->delete_message(@msgs) or carp $self->LastError;
	
	return $uids;
}

sub set_flag {
	my($self, $flag, @msgs) = @_;
	if ( ref($msgs[0]) =~ /ARRAY/ ) { @msgs = @{$msgs[0]} };
	$flag =~ /^\\/ or $flag = "\\" . $flag 
		if $flag =~ /^(Answered|Flagged|Deleted|Seen|Draft)$/i;
	if ( $self->Ranges ) {
		$self->store( $self->Range(@msgs), "+FLAGS.SILENT (" . $flag . ")" );
	} else {
		$self->store( join(",",@msgs), "+FLAGS.SILENT (" . $flag . ")" );
	}
}

sub see {
	my($self, @msgs) = @_;
	if ( ref($msgs[0]) =~ /ARRAY/ ) { @msgs = @{$msgs[0]} };
	$self->set_flag('\\Seen', @msgs);
}

sub mark {
	my($self, @msgs) = @_;
	if ( ref($msgs[0]) =~ /ARRAY/ ) { @msgs = @{$msgs[0]} };
	$self->set_flag('\\Flagged', @msgs);
}

sub unmark {
	my($self, @msgs) = @_;
	if ( ref($msgs[0]) =~ /ARRAY/ ) { @msgs = @{$msgs[0]} };
	$self->unset_flag('\\Flagged', @msgs);
}

sub unset_flag {
	my($self, $flag, @msgs) = @_;
	if ( ref($msgs[0]) =~ /ARRAY/ ) { @msgs = @{$msgs[0]} };
	$flag =~ /^\\/ or $flag = "\\" . $flag 
		if $flag =~ /^(Answered|Flagged|Deleted|Seen|Draft)$/i;
	$self->store( join(",",@msgs), "-FLAGS.SILENT (" . $flag . ")" );
}

sub deny_seeing {
	my($self, @msgs) = @_;
	if ( ref($msgs[0]) =~ /ARRAY/ ) { @msgs = @{$msgs[0]} };
	$self->unset_flag('\\Seen', @msgs);
}

sub size {

	my ($self,$msg) = @_;
	# return undef unless fetch is successful
	my @data = $self->fetch($msg,"(RFC822.SIZE)");
	return undef unless defined($data[0]);
	my($size) = grep(/RFC822\.SIZE/,@data);

	$size =~ /RFC822\.SIZE\s+(\d+)/;
	
	return $1;
}

sub getquotaroot {
	my $self = shift;
	my $what = shift;
	$what = ( $what ? $self->Massage($what) : "INBOX" ) ;
	$self->_imap_command("getquotaroot $what") or return undef;
	return $self->Results;
}

sub getquota {
	my $self = shift;
	my $what = shift;
	$what = ( $what ? $self->Massage($what) : "user/$self->{User}" ) ;
	$self->_imap_command("getquota $what") or return undef;
	return $self->Results;
}

sub quota 	{
	my $self = shift;
	my ($what) = shift||"INBOX";
	$self->_imap_command("getquota $what")||$self->getquotaroot("$what");
	return (	map { s/.*STORAGE\s+\d+\s+(\d+).*\n$/$1/ ? $_ : () } $self->Results
	)[0] ;
}

sub quota_usage 	{
	my $self = shift;
	my ($what) = shift||"INBOX";
	$self->_imap_command("getquota $what")||$self->getquotaroot("$what");
	return (	map { s/.*STORAGE\s+(\d+)\s+\d+.*\n$/$1/ ? $_ : () } $self->Results
	)[0] ;
}
sub Quote {
	my($class,$arg) = @_;
	return $class->Massage($arg,NonFolderArg);
}

sub Massage {
	my $self= shift;
	my $arg = shift;
	my $notFolder = shift;
	return unless $arg;
	my $escaped_arg = $arg; $escaped_arg =~ s/"/\\"/g;
	$arg 	= substr($arg,1,length($arg)-2) if $arg =~ /^".*"$/
                and ! ( $notFolder or $self->STATUS(qq("$escaped_arg"),"(MESSAGES)"));

	if ($arg =~ /["\\]/) {
		$arg = "{" . length($arg) . "}\x0d\x0a$arg" ;
	} elsif ($arg =~ /\s|[{}()]/) {
		$arg = qq("${arg}") unless $arg =~ /^"/;
	} 

	return $arg;
}

sub unseen_count {

	my ($self, $folder) = (shift, shift);
	$folder ||= $self->Folder;
	$self->status($folder, 'UNSEEN') or return undef;

	chomp(	my $r = ( grep 
			  { s/\*\s+STATUS\s+.*\(UNSEEN\s+(\d+)\s*\)/$1/ }
			  $self->History($self->Transaction)
			)[0]
	);

	$r =~ s/\D//g;
	return $r;
}



# Status Routines:


sub Status            { $_[0]->State                           ;       }
sub IsUnconnected     { ($_[0]->State == Unconnected)  ? 1 : 0 ;       }
sub IsConnected       { ($_[0]->State >= Connected)    ? 1 : 0 ;       }
sub IsAuthenticated   { ($_[0]->State >= Authenticated)? 1 : 0 ;       }
sub IsSelected        { ($_[0]->State == Selected)     ? 1 : 0 ;       }               


# The following private methods all work on an output line array.
# _data returns the data portion of an output array:
sub _data {   defined $_[1] and ref $_[1] and defined $_[1]->[TYPE] or return undef; $_[1]->[DATA]; }

# _index returns the index portion of an output array:
sub _index {  defined $_[1] and ref $_[1] and defined $_[1]->[TYPE] or return undef; $_[1]->[INDEX]; }

# _type returns the type portion of an output array:
sub _type {  defined $_[1] and ref $_[1] and defined $_[1]->[TYPE] or return undef; $_[1]->[TYPE]; }

# _is_literal returns true if this is a literal:
sub _is_literal { defined $_[1] and ref $_[1] and defined $_[1]->[TYPE] and $_[1]->[TYPE] eq "LITERAL" };

# _is_output_or_literal returns true if this is an 
#  	output line (or the literal part of one):
sub _is_output_or_literal { 
              defined $_[1] and ref $_[1] and defined $_[1]->[TYPE] and 
			($_[1]->[TYPE] eq "OUTPUT" || $_[1]->[TYPE] eq "LITERAL") 
};

# _is_output returns true if this is an output line:
sub _is_output { defined $_[1] and ref $_[1] and defined $_[1]->[TYPE] and $_[1]->[TYPE] eq "OUTPUT" };

# _is_input returns true if this is an input line:
sub _is_input { defined $_[1] and ref $_[1] and defined $_[1]->[TYPE] and $_[1]->[TYPE] eq "INPUT" };

# _next_index returns next_index for a transaction; may legitimately return 0 when successful.
sub _next_index { 
      defined(scalar(@{$_[0]->{'History'}{$_[1]||$_[0]->Transaction}}))       ? 
		scalar(@{$_[0]->{'History'}{$_[1]||$_[0]->Transaction}}) 		: 0 
};

sub _cram_md5 {
  my ($code, $client) = @_;
  my $hmac = Digest::HMAC_MD5::hmac_md5_hex(MIME::Base64::decode($code),
                                            $client->Password());
  return MIME::Base64::encode($client->User() . " $hmac");
}



sub Range {
	#require "Mail/IMAPClient/MessageSet.pm";
	my $self = shift;
	my $targ = $_[0];
	#print "Arg is ",ref($targ),"\n";
	if (@_ == 1 and ref($targ) =~ /Mail::IMAPClient::MessageSet/ ) {
		return $targ;
	}
	my $range = Mail::IMAPClient::MessageSet->new(@_);
	#print "Returning $range :",ref($range)," == $range\n";
	return $range;
}

my $not_void = 1;
};
Mail::IMAPClient->import();
$INC{'Mail/IMAPClient'} = "/dev/null";
#  perl-link processed: use Mail::POP3Client;

BEGIN {
#******************************************************************************
# $Id: POP3Client.pm,v 2.18 2008/02/27 03:03:21 ssd Exp $
#
# Description:  POP3Client module - acts as interface to POP3 server
# Author:       Sean Dowd <pop3client@dowds.net>
#
# Copyright (c) 1999-2008  Sean Dowd.  All rights reserved.
# This module is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
#
#******************************************************************************

package Mail::POP3Client;

#use strict;
use warnings;
use Carp;
use IO::Socket qw(SOCK_STREAM);

use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

require Exporter;

@ISA = qw(Exporter);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
@EXPORT = qw(

);

my $ID =q( $Id: POP3Client.pm,v 2.18 2008/02/27 03:03:21 ssd Exp $ );
$VERSION = substr q$Revision: 2.18 $, 10;


# Preloaded methods go here.

#******************************************************************************
#* constructor
#* new Mail::POP3Client( USER => user,
#*                       PASSWORD => pass,
#*                       HOST => host,
#*                       AUTH_MODE => [BEST|APOP|CRAM-MD5|PASS],
#*                       TIMEOUT => 30,
#*                       LOCALADDR => 'xxx.xxx.xxx.xxx[:xx]',
#*                       DEBUG => 1 );
#* OR (deprecated)
#* new Mail::POP3Client( user, pass, host [, port, debug, auth_mode, local_addr])
#******************************************************************************
sub new
{
  my $classname = shift;
  my $self = {
	      DEBUG => 0,
	      SERVER => "pop3",
	      PORT => 110,
	      COUNT => -1,
	      SIZE => -1,
	      ADDR => "",
	      STATE => 'DEAD',
	      MESG => 'OK',
	      BANNER => '',
	      MESG_ID => '',
	      AUTH_MODE => 'BEST',
	      EOL => "\015\012",
	      TIMEOUT => 60,
	      STRIPCR => 0,
	      LOCALADDR => undef,
	      SOCKET => undef,
	      USESSL => 0,
	     };
  $self->{tranlog} = ();
  $^O =~ /MacOS/i && ($self->{STRIPCR} = 1);
  bless( $self, $classname );
  $self->_init( @_ );

  if ( defined($self->User()) && defined($self->Pass()) )
    {
      $self->Connect();
    }

  return $self;
}



#******************************************************************************
#* initialize - check for old-style params
#******************************************************************************
sub _init {
  my $self = shift;

  # if it looks like a hash
  if ( @_ && (scalar( @_ ) % 2 == 0) )
    {
      # ... and smells like a hash...
      my %hashargs = @_;
      if ( ( defined($hashargs{USER}) &&
	     defined($hashargs{PASSWORD}) ) ||
	   defined($hashargs{HOST})
	 )
	{
	  # ... then it must be a hash!  Push all values into my internal hash.
	  foreach my $key ( keys %hashargs )
	    {
	      $self->{$key} = $hashargs{$key};
	    }
	}
      else {$self->_initOldStyle( @_ );}
    }
  else {$self->_initOldStyle( @_ );}
}

#******************************************************************************
#* initialize using the old positional parameter style new - deprecated
#******************************************************************************
sub _initOldStyle {
  my $self = shift;
  $self->User( shift );
  $self->Pass( shift );
  my $host = shift;
  $host && $self->Host( $host );
  my $port = shift;
  $port && $self->Port( $port );
  my $debug = shift;
  $debug && $self->Debug( $debug );
  my $auth_mode = shift;
  $auth_mode && ($self->{AUTH_MODE} = $auth_mode);
  my $localaddr = shift;
  $localaddr && ($self->{LOCALADDR} = $localaddr);
}

#******************************************************************************
#* What version are we?
#******************************************************************************
sub Version {
  return $VERSION;
}


#******************************************************************************
#* Is the socket alive?
#******************************************************************************
sub Alive
{
  my $me = shift;
  $me->State =~ /^AUTHORIZATION$|^TRANSACTION$/i;
} # end Alive


#******************************************************************************
#* What's the frequency Kenneth?
#******************************************************************************
sub State
{
  my $me = shift;
  my $stat = shift or return $me->{STATE};
  $me->{STATE} = $stat;
} # end Stat


#******************************************************************************
#* Got anything to say?
#******************************************************************************
sub Message
{
  my $me = shift;
  my $msg = shift or return $me->{MESG};
  $me->{MESG} = $msg;
} # end Message


#******************************************************************************
#* set/query debugging
#******************************************************************************
sub Debug
{
  my $me = shift;
  my $debug = shift or return $me->{DEBUG};
  $me->{DEBUG} = $debug;

} # end Debug


#******************************************************************************
#* set/query the port number
#******************************************************************************
sub Port
{
  my $me = shift;
  my $port = shift or return $me->{PORT};

  $me->{PORT} = $port;

} # end port


#******************************************************************************
#* set the host
#******************************************************************************
sub Host
{
  my $me = shift;
  my $host = shift or return $me->{HOST};

#  $me->{INTERNET_ADDR} = inet_aton( $host ) or
#    $me->Message( "Could not inet_aton: $host, $!") and return;
  $me->{HOST} = $host;
} # end host

#******************************************************************************
#* set the local address
#******************************************************************************
sub LocalAddr
{
  my $me = shift;
  my $addr = shift or return $me->{LOCALADDR};

  $me->{LOCALADDR} = $addr;
}


#******************************************************************************
#* query the socket to use as a file handle - allows you to set the
#* socket too to allow SSL (thanks to Jamie LeTual)
#******************************************************************************
sub Socket {
  my $me = shift;
  my $socket = shift or return $me->{'SOCKET'};
  $me->{'SOCKET'} = $socket;
}

sub AuthMode {
  my $me = shift;
  my $mode = shift;
  return $me->{'AUTH_MODE'} unless $mode;
  $me->{'AUTH_MODE'} = $mode;
}

#******************************************************************************
#* set/query the USER
#******************************************************************************
sub User
{
  my $me = shift;
  my $user = shift or return $me->{USER};
  $me->{USER} = $user;

} # end User


#******************************************************************************
#* set/query the password
#******************************************************************************
sub Pass
{
  my $me = shift;
  my $pass = shift or return $me->{PASSWORD};
  $me->{PASSWORD} = $pass;

} # end Pass

sub Password { Pass(@_); }

#******************************************************************************
#*
#******************************************************************************
sub Count
{
  my $me = shift;
  my $c = shift;
  if (defined $c and length($c) > 0) {
    $me->{COUNT} = $c;
  } else {
    return $me->{COUNT};
  }

} # end Count


#******************************************************************************
#* set/query the size of the mailbox
#******************************************************************************
sub Size
{
  my $me = shift;
  my $c = shift;
  if (defined $c and length($c) > 0) {
    $me->{SIZE} = $c;
  } else {
    return $me->{SIZE};
  }

} # end Size


#******************************************************************************
#*
#******************************************************************************
sub EOL {
  my $me = shift;
  return $me->{'EOL'};
}


#******************************************************************************
#*
#******************************************************************************
sub Close
{
  my $me = shift;

  # only send the QUIT message is the socket is still connected.  Some
  # POP3 servers close the socket after a failed authentication.  It
  # is unclear whether the RFC allows this or not, so we'll attempt to
  # check the condition of the socket before sending data here.
  if ($me->Alive() && $me->Socket() && $me->Socket()->connected() ) {
    $me->_sockprint( "QUIT", $me->EOL );

    # from Patrick Bourdon - need this because some servers do not
    # delete in all cases.  RFC says server can respond (in UPDATE
    # state only, otherwise always OK).
    my $line = $me->_sockread();
    unless (defined $line) {
	$me->Message("Socket read failed for QUIT");
	# XXX: Should add the following?
	#$me->State('DEAD');
	undef $me->{SOCKET};
	return 0;
    }
    $me->Message( $line );
    close( $me->Socket() ) or $me->Message("close failed: $!") and do {
      undef $me->{SOCKET};
      return 0;
    };
    $me->State('DEAD');
    undef $me->{SOCKET};
    $line =~ /^\+OK/i || return 0;
  }
  1;
} # end Close

sub close { Close(@_); }
sub logout { Close(@_); }

#******************************************************************************
#*
#******************************************************************************
sub DESTROY
{
  my $me = shift;
  $me->Close;
} # end DESTROY


#******************************************************************************
#* Connect to the specified POP server
#******************************************************************************
sub Connect
{
  my ($me, $host, $port) = @_;

  $host and $me->Host($host);
  $port and $me->Port($port);

  $me->Close();

  my $s = $me->{SOCKET};
  $s || do {
    if ( $me->{USESSL} ) {
      if ( $me->Port() == 110 ) { $me->Port( 995 ); }
        eval {
	  require IO::Socket::SSL;
	};
      $@ and $me->Message("Could not load IO::Socket::SSL: $@") and return 0;
      $s = IO::Socket::SSL->new( PeerAddr => $me->Host(),
				 PeerPort => $me->Port(),
				 Proto    => "tcp",
				 Type      => SOCK_STREAM,
				 LocalAddr => $me->LocalAddr(),
				 Timeout   => $me->{TIMEOUT} )
	or $me->Message( "could not connect SSL socket [$me->{HOST}, $me->{PORT}]: $!" )
	  and return 0;
      $me->{SOCKET} = $s;
      
    } else {
      $s = IO::Socket::INET->new( PeerAddr  => $me->Host(),
				  PeerPort  => $me->Port(),
				  Proto     => "tcp",
				  Type      => SOCK_STREAM,
				  LocalAddr => $me->LocalAddr(),
				  Timeout   => $me->{TIMEOUT} )
	or
	  $me->Message( "could not connect socket [$me->{HOST}, $me->{PORT}]: $!" )
	    and
	      return 0;
      $me->{SOCKET} = $s;
    }
  };

  $s->autoflush( 1 );

  defined(my $msg = $me->_sockread()) or $me->Message("Could not read") and return 0;
  chomp $msg;
  $me->{BANNER}= $msg;

  # add check for servers that return -ERR on connect (not in RFC1939)
  $me->Message($msg);
  $msg =~ /^\+OK/i || return 0;

  my $atom = qr([-_\w!#$%&'*+/=?^`{|}~]+);
  $me->{MESG_ID}= $1 if ($msg =~/(<$atom(?:\.$atom)*\@$atom(?:\.$atom)*>)/o);
  $me->Message($msg);

  $me->State('AUTHORIZATION');
  defined($me->User()) and defined($me->Pass()) and $me->Login();

} # end Connect

sub connect { Connect(@_); }

#******************************************************************************
#* login to the POP server. If the AUTH_MODE is set to BEST, and the server
#* appears to support APOP, it will try APOP, if that fails, then it will try
#* SASL CRAM-MD5 if the server appears to support it, and finally PASS.
#* If the AUTH_MODE is set to APOP, and the server appears to support APOP, it
#* will use APOP or it will fail to log in. Likewise, for AUTH_MODE CRAM-MD5,
#* no PASS-fallback is made. Otherwise password is sent in clear text.
#******************************************************************************
sub Login
{
  my $me= shift;
  return 1 if $me->State eq 'TRANSACTION';  # Already logged in

  if ($me->{AUTH_MODE} eq 'BEST') {
    my $retval;
    if ($me->{MESG_ID}) {
      $retval = $me->Login_APOP();
      return($retval) if ($me->State eq 'TRANSACTION');
    }
    my $has_cram_md5 = 0;
    foreach my $capa ($me->Capa()) {
      $capa =~ /^SASL.*?\sCRAM-MD5\b/ and $has_cram_md5 = 1 and last;
    }
    if ($has_cram_md5) {
      $retval = $me->Login_CRAM_MD5();
      return($retval) if ($me->State() eq 'TRANSACTION');
    }
  }
  elsif ($me->{AUTH_MODE} eq 'APOP') {
    return(0) if (!$me->{MESG_ID});   # fail if the server does not support APOP
    return($me->Login_APOP());
  }
  elsif ($me->{AUTH_MODE} eq 'CRAM-MD5') {
    return($me->Login_CRAM_MD5());
  }
  elsif ($me->{AUTH_MODE} ne 'PASS') {
    $me->Message("Programing error. AUTH_MODE (".$me->{AUTH_MODE}.") not BEST | APOP | CRAM-MD5 | PASS.");
    return(0);
  }
  return($me->Login_Pass());
}

sub login { Login(@_); }

#******************************************************************************
#* login to the POP server using APOP (md5) authentication.
#******************************************************************************
sub Login_APOP
{
  my $me = shift;
  eval {
    require Digest::MD5;
  };
  $@ and $me->Message("APOP failed: $@") and return 0;

  my $hash = Digest::MD5::md5_hex($me->{MESG_ID} . $me->Pass());

  $me->_checkstate('AUTHORIZATION', 'APOP') or return 0;
  $me->_sockprint( "APOP " , $me->User , ' ', $hash, $me->EOL );
  my $line = $me->_sockread();
  unless (defined $line) {
      $me->Message("Socket read failed for APOP");
      $me->State('AUTHORIZATION');
      return 0;
  }
  chomp $line;
  $me->Message($line);
  print $line . "\n"; # Print what the server replied with after our login.
  # some servers will close here...
  $me->NOOP() || do {
    $me->State('DEAD');
    undef $me->{SOCKET};
    $me->Message("APOP failed: server has closed the socket");
    return 0;
  };

  $line =~ /^\+OK/ or $me->Message("APOP failed: $line") and return 0;
  $me->State('TRANSACTION');

  $me->POPStat() or return 0;
}


#******************************************************************************
#* login to the POP server using CRAM-MD5 (RFC 2195) authentication.
#******************************************************************************
sub Login_CRAM_MD5
{
  my $me = shift;

  eval {
    require Digest::HMAC_MD5;
    require MIME::Base64;
  };
  $@ and $me->Message("AUTH CRAM-MD5 failed: $@") and return 0;

  $me->_checkstate('AUTHORIZATION', 'AUTH') or return 0;
  $me->_sockprint('AUTH CRAM-MD5', $me->EOL());
  my $line = $me->_sockread();
  chomp $line;
  $me->Message($line);

  if ($line =~ /^\+ (.+)$/) {

    my $hmac =
      Digest::HMAC_MD5::hmac_md5_hex(MIME::Base64::decode($1), $me->Pass());
    (my $response = MIME::Base64::encode($me->User() . " $hmac")) =~ s/[\r\n]//g;
    $me->_sockprint($response, $me->EOL());

    $line = $me->_sockread();
    chomp $line;
    $me->Message($line);
    print $line . "\n"; # Print what the server replied with after our login.
    $line =~ /^\+OK/ or
      $me->Message("AUTH CRAM-MD5 failed: $line") and return 0;

  } else {
    $me->Message("AUTH CRAM-MD5 failed: $line") and return 0;
  }

  $me->State('TRANSACTION');

  $me->POPStat() or return 0;
}


#******************************************************************************
#* login to the POP server using simple (cleartext) authentication.
#******************************************************************************
sub Login_Pass
{
  my $me = shift;

  $me->_checkstate('AUTHORIZATION', 'USER') or return 0;
  $me->_sockprint( "USER " , $me->User() , $me->EOL );
  my $line = $me->_sockread();
  unless (defined $line) {
      $me->Message("Socket read failed for USER");
      $me->State('AUTHORIZATION');
      return 0;
  }
  chomp $line;
  $me->Message($line);
  $line =~ /^\+/ or $me->Message("USER failed: $line") and $me->State('AUTHORIZATION')
    and return 0;
  
  $me->_sockprint( "PASS " , $me->Pass() , $me->EOL );
  $line = $me->_sockread();
  unless (defined $line) {
      $me->Message("Socket read failed for PASS");
      $me->State('AUTHORIZATION');
      return 0;
  }
  chomp $line;
  print $line . "\n"; # Print what the server replied with after our login.
  $me->Message($line);
  $line =~ /^\+OK/ or $me->Message("PASS failed: $line") and $me->State('AUTHORIZATION')
    and return 0;
  
  $me->State('TRANSACTION');

  ($me->POPStat() >= 0) or return 0;

} # end Login


#******************************************************************************
#* Get the Head of a message number.  If you give an optional number
#* of lines you will get the first n lines of the body also.  This
#* allows you to preview a message.
#******************************************************************************
sub Head
{
  my $me = shift;
  my $num = shift;
  my $lines = shift;
  $lines ||= 0;
  $lines =~ /\d+/ || ($lines = 0);

  my $header = '';

  $me->_checkstate('TRANSACTION', 'TOP') or return;
  $me->_sockprint( "TOP $num $lines", $me->EOL );
  my $line = $me->_sockread();
  unless (defined $line) {
      $me->Message("Socket read failed for TOP");
      return;
  }
  chomp $line;
  $line =~ /^\+OK/ or $me->Message("Bad return from TOP: $line") and return;
  $line =~ /^\+OK (\d+) / and my $buflen = $1;

  while (1) {
    $line = $me->_sockread();
    unless (defined $line) {
	$me->Message("Socket read failed for TOP");
	return;
    }
    last if $line =~ /^\.\s*$/;
    $line =~ s/^\.\././;
    $header .= $line;
  }

  return wantarray ? split(/\r?\n/, $header) : $header;
} # end Head


#******************************************************************************
#* Get the header and body of a message
#******************************************************************************
sub HeadAndBody
{
  my $me = shift;
  my $num = shift;
  my $mandb = '';

  $me->_checkstate('TRANSACTION', 'RETR') or return;
  $me->_sockprint( "RETR $num", $me->EOL );
  my $line = $me->_sockread();
  unless (defined $line) {
      $me->Message("Socket read failed for RETR");
      return;
  }
  chomp $line;
  $line =~ /^\+OK/ or $me->Message("Bad return from RETR: $line") and return;
  $line =~ /^\+OK (\d+) / and my $buflen = $1;

  while (1) {
    $line = $me->_sockread();
    unless (defined $line) {
	$me->Message("Socket read failed for RETR");
	return;
    }
    last if $line =~ /^\.\s*$/;
    # convert any '..' at the start of a line to '.'
    $line =~ s/^\.\././;
    $mandb .= $line;
  }

  return wantarray ? split(/\r?\n/, $mandb) : $mandb;

} # end HeadAndBody

sub message_string { HeadAndBody(@_); }

#******************************************************************************
#* get the head and body of a message and write it to a file handle.
#* Sends the raw data: does no CR/NL stripping or mapping.
#******************************************************************************
sub HeadAndBodyToFile
{
  local ($, , $\);
  my $me = shift;
  my $fh = shift;
  my $num = shift;
  my $body = '';

  $me->_checkstate('TRANSACTION', 'RETR') or return;
  $me->_sockprint( "RETR $num", $me->EOL );
  my $line = $me->_sockread();
  unless (defined $line) {
      $me->Message("Socket read failed for RETR");
      return 0;
  }
  chomp $line;
  $line =~ /^\+OK/ or $me->Message("Bad return from RETR: $line") and return 0;
  $line =~ /^\+OK (\d+) / and my $buflen = $1;

  while (1) {
    $line = $me->_sockread();
    unless (defined $line) {
	$me->Message("Socket read failed for RETR");
	return 0;
    }
    last if $line =~ /^\.\s*$/;
    # convert any '..' at the start of a line to '.'
    $line =~ s/^\.\././;
    print $fh $line;
  }
  return 1;
} # end BodyToFile



#******************************************************************************
#* get the body of a message
#******************************************************************************
sub Body
{
  my $me = shift;
  my $num = shift;
  my $body = '';

  $me->_checkstate('TRANSACTION', 'RETR') or return;
  $me->_sockprint( "RETR $num", $me->EOL );
  my $line = $me->_sockread();
  unless (defined $line) {
      $me->Message("Socket read failed for RETR");
      return;
  }
  chomp $line;
  $line =~ /^\+OK/ or $me->Message("Bad return from RETR: $line") and return;
  $line =~ /^\+OK (\d+) / and my $buflen = $1;

  # skip the header
  do {
    $line = $me->_sockread();
    unless (defined $line) {
	$me->Message("Socket read failed for RETR");
	return;
    }
    $line =~ s/[\r\n]//g;
  } until $line =~ /^(\s*|\.)$/;
  $line =~ /^\.\s*$/ && return;  # we found a header only!  Lotus Notes seems to do this.

  while (1) {
    $line = $me->_sockread();
    unless (defined $line) {
	$me->Message("Socket read failed for RETR");
	return;
    }
    last if $line =~ /^\.\s*$/;
    # convert any '..' at the start of a line to '.'
    $line =~ s/^\.\././;
    $body .= $line;
  }

  return wantarray ? split(/\r?\n/, $body) : $body;

} # end Body


#******************************************************************************
#* get the body of a message and write it to a file handle.  Sends the raw data:
#* does no CR/NL stripping or mapping.
#******************************************************************************
sub BodyToFile
{
  local ($, , $\);
  my $me = shift;
  my $fh = shift;
  my $num = shift;
  my $body = '';

  $me->_checkstate('TRANSACTION', 'RETR') or return;
  $me->_sockprint( "RETR $num", $me->EOL );
  my $line = $me->_sockread();
  unless (defined $line) {
      $me->Message("Socket read failed for RETR");
      return;
  }
  chomp $line;
  $line =~ /^\+OK/ or $me->Message("Bad return from RETR: $line") and return;
  $line =~ /^\+OK (\d+) / and my $buflen = $1;

  # skip the header
  do {
    $line = $me->_sockread();
    unless (defined $line) {
	$me->Message("Socket read failed for RETR");
	return;
    }
    $line =~ s/[\r\n]//g;
  } until $line =~ /^(\s*|\.)$/;
  $line =~ /^\.\s*$/ && return;  # we found a header only!  Lotus Notes seems to do this.

  while (1) {
    $line = $me->_sockread();
    unless (defined $line) {
	$me->Message("Socket read failed for RETR");
	return;
    }
    chomp $line;
    last if $line =~ /^\.\s*$/;
    # convert any '..' at the start of a line to '.'
    $line =~ s/^\.\././;
    print $fh $line, "\n";
  }
} # end BodyToFile



#******************************************************************************
#* handle a STAT command - returns the number of messages in the box
#******************************************************************************
sub POPStat
{
  my $me = shift;

  $me->_checkstate('TRANSACTION', 'STAT') or return -1;
  $me->_sockprint( "STAT", $me->EOL );
  my $line = $me->_sockread();
  unless (defined $line) {
      $me->Message("Socket read failed for STAT");
      return -1;
  }
  $line =~ /^\+OK/ or $me->Message("STAT failed: $line") and return -1;
  $line =~ /^\+OK (\d+) (\d+)/ and $me->Count($1), $me->Size($2);

  return $me->Count();
}


#******************************************************************************
#* issue the LIST command
#******************************************************************************
sub List {
  my $me = shift;
  my $num = shift || '';
  my $CMD = shift || 'LIST';
  $CMD=~ tr/a-z/A-Z/;

  $me->Alive() or return;

  my @retarray = ();
  my $ret = '';

  $me->_checkstate('TRANSACTION', $CMD) or return;
  $me->_sockprint($CMD, $num ? " $num" : '', $me->EOL());

  my $line = $me->_sockread();
  unless (defined $line) {
      $me->Message("Socket read failed for LIST");
      return;
  }
  $line =~ /^\+OK/ or $me->Message("$line") and return;
  if ($num) {
    $line =~ s/^\+OK\s*//;
    return $line;
  }
  while( defined( $line = $me->_sockread() ) ) {
    $line =~ /^\.\s*$/ and last;
    $ret .= $line;
    chomp $line;
    push(@retarray, $line);
  }
  if ($ret) {
    return wantarray ? @retarray : $ret;
  }
}

#******************************************************************************
#* issue the LIST command, but return results in an indexed array.
#******************************************************************************
sub ListArray {
  my $me = shift;
  my $num = shift || '';
  my $CMD = shift || 'LIST';
  $CMD=~ tr/a-z/A-Z/;

  $me->Alive() or return;

  my @retarray = ();
  my $ret = '';

  $me->_checkstate('TRANSACTION', $CMD) or return;
  $me->_sockprint($CMD, $num ? " $num" : '', $me->EOL());
  my $line = $me->_sockread();
  unless (defined $line) {
      $me->Message("Socket read failed for LIST");
      return;
  }
  $line =~ /^\+OK/ or $me->Message("$line") and return;
  if ($num) {
    $line =~ s/^\+OK\s*//;
    return $line;
  }
  while( defined( $line = $me->_sockread() ) ) {
    $line =~ /^\.\s*$/ and last;
    $ret .= $line;
    chomp $line;
    my ($num, $uidl) = split('\s+', $line);
    $retarray[$num] = $uidl;
  }
  if ($ret) {
    return wantarray ? @retarray : $ret;
  }
}


#******************************************************************************
#* retrieve the given message number - uses HeadAndBody
#******************************************************************************
sub Retrieve {
  return HeadAndBody( @_ );
}

#******************************************************************************
#* retrieve the given message number to the given file handle- uses
#* HeadAndBodyToFile
#******************************************************************************
sub RetrieveToFile {
  return HeadAndBodyToFile( @_ );
}


#******************************************************************************
#* implement the LAST command - see the rfc (1081) OBSOLETED by RFC
#******************************************************************************
sub Last
{
  my $me = shift;

  $me->_checkstate('TRANSACTION', 'LAST') or return;
  $me->_sockprint( "LAST", $me->EOL );
  my $line = $me->_sockread();
  unless (defined $line) {
      $me->Message("Socket read failed for LAST");
      return 0;
  }

  $line =~ /\+OK (\d+)\D*$/ and return $1;
}


#******************************************************************************
#* reset the deletion stat
#******************************************************************************
sub Reset
{
  my $me = shift;

  $me->_checkstate('TRANSACTION', 'RSET') or return;
  $me->_sockprint( "RSET", $me->EOL );
  my $line = $me->_sockread();
  unless (defined $line) {
      $me->Message("Socket read failed for RSET");
      return 0;
  }
  $line =~ /^\+OK/ and return 1;
  return 0;
}


#******************************************************************************
#* delete the given message number
#******************************************************************************
sub Delete {
  my $me = shift;
  my $num = shift || return;

  $me->_checkstate('TRANSACTION', 'DELE') or return;
  $me->_sockprint( "DELE $num",  $me->EOL );
  my $line = $me->_sockread();
  unless (defined $line) {
      $me->Message("Socket read failed for DELE");
      return 0;
  }
  $me->Message($line);
  $line =~ /^\+OK/ && return 1;
  return 0;
}

sub delete_message { Delete(@_); }

#******************************************************************************
#* UIDL - submitted by Dion Almaer (dion@member.com)
#******************************************************************************
sub Uidl
{
  my $me = shift;
  my $num = shift || '';

  $me->Alive() or return;

  my @retarray = ();
  my $ret = '';

  $me->_checkstate('TRANSACTION', 'UIDL') or return;
  $me->_sockprint('UIDL', $num ? " $num" : '', $me->EOL());
  my $line = $me->_sockread();
  unless (defined $line) {
      $me->Message("Socket read failed for UIDL");
      return;
  }
  $line =~ /^\+OK/ or $me->Message($line) and return;
  if ($num) {
    $line =~ s/^\+OK\s*//;
    return $line;
  }
  while( defined( $line = $me->_sockread() ) ) {
    $line =~ /^\.\s*$/ and last;
    $ret .= $line;
    chomp $line;
    my ($num, $uidl) = split('\s+', $line);
    $retarray[$num] = $uidl;
  }
  if ($ret) {
    return wantarray ? @retarray : $ret;
  }
}


#******************************************************************************
#* CAPA - query server capabilities, see RFC 2449
#******************************************************************************
sub Capa {

  my $me = shift;

  # no state check here, all are allowed

  $me->Alive() or return;

  my @retarray = ();
  my $ret = '';

  $me->_sockprint('CAPA', $me->EOL());

  my $line = $me->_sockread();
  $line =~ /^\+OK/ or $me->Message($line) and return;

  while(defined($line = $me->_sockread())) {
    $line =~ /^\.\s*$/ and last;
    $ret .= $line;
    chomp $line;
    push(@retarray, $line);
  }

  if ($ret) {
    return wantarray ? @retarray : $ret;
  }
}

#******************************************************************************
#* XTND - submitted by Chris Moates (six@mox.net)
#******************************************************************************
sub Xtnd {
  my $me = shift;
  my $xtndarg = shift || '';

  if ($xtndarg eq '') { 
    $me->Message("XTND requires a string argument");
    return;
  }

  my $s = $me->Socket();
  $me->_checkstate('TRANSACTION', 'XTND') or return;
  $me->Alive() or return;
 
  $me->_sockprint( "XTND $xtndarg", $me->EOL );
  my $line = $me->_sockread();
  $line =~ /^\+OK/ or $me->Message($line) and return;
  $line =~ s/^\+OK\s*//;
  return $line;
}

#******************************************************************************
#* NOOP - used to check socket
#******************************************************************************
sub NOOP {
  my $me = shift;

  my $s = $me->Socket();
  $me->Alive() or return 0;
 
  $me->_sockprint( "NOOP", $me->EOL );
  my $line = $me->_sockread();
  defined( $line ) or return 0;
  $line =~ /^\+OK/ or return 0;
  return 1;
}


#******************************************************************************
#* Mail::IMAPClient compatibility functions (wsnyder@wsnyder.org)
#******************************************************************************

# Empty stubs
sub Peek {}
sub Uid {}

# Pop doesn't have concept of different folders
sub folders { return ('INBOX'); }
sub Folder { return ('INBOX'); }
sub select {}

# Message accessing
sub unseen {
    my $me = shift;
    my $count = $me->Count;
    return () if !$count;
    return ( 1..$count);
}

#*****************************************************************************
#* Check the state before issuing a command
#*****************************************************************************
sub _checkstate
{
  my ($me, $state, $cmd) = @_;
  my $currstate = $me->State();
  if ($currstate ne $state) {
    $me->Message("POP3 command $cmd may be given only in the '$state' state " .
                 "(current state is '$currstate').");
    return 0;
  } else {
    return 1;
  }
}


#*****************************************************************************
#* funnel all read/write through here to allow easier debugging
#* (mitra@earth.path.net)
#*****************************************************************************
sub _sockprint
{
  local ($, , $\);
  my $me = shift;
  my $s = $me->Socket();
  $me->Debug and Carp::carp "POP3 -> ", @_;
  my $outline = "@_";
  chomp $outline;
  push(@{$me->{tranlog}}, $outline);
  print $s @_;
}

sub _sockread
{
  my $me = shift;
  my $line = $me->Socket()->getline();
  unless (defined $line) {
      return;
  }

  # Macs seem to leave CR's or LF's sitting on the socket.  This
  # removes them.
  $me->{STRIPCR} && ($line =~ s/^[\r]+//);

  $me->Debug and Carp::carp "POP3 <- ", $line;
  $line =~ /^[\\+\\-](OK|ERR)/i && do {
    my $l = $line;
    chomp $l;
    push(@{$me->{tranlog}}, $l);
  };
  return $line;
}


# end package Mail::POP3Client

# Autoload methods go after =cut, and are processed by the autosplit program.

1;
#__END__



################################################################################
# POD Documentation (perldoc Mail::POP3Client or pod2html this_file)
################################################################################

=head1 NAME

Mail::POP3Client - Perl 5 module to talk to a POP3 (RFC1939) server

=head1 SYNOPSIS

  use Mail::POP3Client;
  $pop = new Mail::POP3Client( USER     => "me",
			       PASSWORD => "mypassword",
			       HOST     => "pop3.do.main" );
  for( $i = 1; $i <= $pop->Count(); $i++ ) {
    foreach( $pop->Head( $i ) ) {
      /^(From|Subject):\s+/i && print $_, "\n";
    }
  }
  $pop->Close();

  # OR with SSL
  $pop = new Mail::POP3Client( USER     => "me",
			       PASSWORD => "mypassword",
			       HOST     => "pop3.do.main",
			       USESSL   => true,
			     );

  # OR
  $pop2 = new Mail::POP3Client( HOST  => "pop3.otherdo.main" );
  $pop2->User( "somebody" );
  $pop2->Pass( "doublesecret" );
  $pop2->Connect() >= 0 || die $pop2->Message();
  $pop2->Close();

  # OR to use your own SSL socket...
  my $socket = IO::Socket::SSL->new( PeerAddr => 'pop.securedo.main',
                                     PeerPort => 993,
                                     Proto    => 'tcp') || die "No socket!";
  my $pop = Mail::POP3Client->new();
  $pop->User('somebody');
  $pop->Pass('doublesecret');
  $pop->Socket($socket);
  $pop->Connect();

=head1 DESCRIPTION

This module implements an Object-Oriented interface to a POP3 server.
It implements RFC1939 (http://www.faqs.org/rfcs/rfc1939.html)

=head1 EXAMPLES

Here is a simple example to list out the From: and Subject: headers in
your remote mailbox:

  #!/usr/local/bin/perl

  use Mail::POP3Client;

  $pop = new Mail::POP3Client( USER     => "me",
			       PASSWORD => "mypassword",
			       HOST     => "pop3.do.main" );
  for ($i = 1; $i <= $pop->Count(); $i++) {
    foreach ( $pop->Head( $i ) ) {
      /^(From|Subject):\s+/i and print $_, "\n";
    }
    print "\n";
  }

=head1 CONSTRUCTORS

Old style (deprecated):
   new Mail::POP3Client( USER, PASSWORD [, HOST, PORT, DEBUG, AUTH_MODE] );

New style (shown with defaults):
   new Mail::POP3Client( USER      => "",
                         PASSWORD  => "",
                         HOST      => "pop3",
                         PORT      => 110,
                         AUTH_MODE => 'BEST',
                         DEBUG     => 0,
                         TIMEOUT   => 60,
                         LOCALADDR => 'xxx.xxx.xxx.xxx[:xx]',
                         SOCKET => undef,
                         USESSL => 0,
                       );

=over 4

=item *
USER is the userID of the account on the POP server

=item *
PASSWORD is the cleartext password for the userID

=item *
HOST is the POP server name or IP address (default = 'pop3')

=item *
PORT is the POP server port (default = 110)

=item *
DEBUG - any non-null, non-zero value turns on debugging (default = 0)

=item *
AUTH_MODE - pass 'APOP' to force APOP (MD5) authorization. (default is 'BEST')

=item *
TIMEOUT - set a timeout value for socket operations (default = 60)

=item *
LOCALADDR - allow selecting a local inet address to use

=back

=head1 METHODS

These commands are intended to make writing a POP3 client easier.
They do not necessarily map directly to POP3 commands defined in
RFC1081 or RFC1939, although all commands should be supported.  Some
commands return multiple lines as an array in an array context.

=over 8

=item I<new>( USER => 'user', PASSWORD => 'password', HOST => 'host',
              PORT => 110, DEBUG => 0, AUTH_MODE => 'BEST', TIMEOUT => 60,,
              LOCALADDR => 'xxx.xxx.xxx.xxx[:xx]', SOCKET => undef, USESSL => 0 )
)

Construct a new POP3 connection with this.  You should use the
hash-style constructor.  B<The old positional constructor is
deprecated and will be removed in a future release.  It is strongly
recommended that you convert your code to the new version.>

You should give it at least 2 arguments: USER and PASSWORD.  The
default HOST is 'pop3' which may or may not work for you.  You can
specify a different PORT (be careful here).

new will attempt to Connect to and Login to the POP3 server if you
supply a USER and PASSWORD.  If you do not supply them in the
constructor, you will need to call Connect yourself.

The valid values for AUTH_MODE are 'BEST', 'PASS', 'APOP' and 'CRAM-MD5'.
BEST says to try APOP if the server appears to support it and it can be
used to successfully log on, next try similarly with CRAM-MD5, and finally
revert to PASS. APOP and CRAM-MD5 imply that an MD5 checksum will be
used instead of sending your password in cleartext.  However,
B<if the server does not claim to support APOP or CRAM-MD5,
the cleartext method will be used. Be careful.> There are a few
servers that will send a timestamp in the banner greeting, but APOP
will not work with them (for instance if the server does not know your
password in cleartext).  If you think your authentication information
is correct, run in DEBUG mode and look for errors regarding
authorization.  If so, then you may have to use 'PASS' for that server.
The same applies to CRAM-MD5, too.

If you enable debugging with DEBUG => 1, socket traffic will be echoed
to STDERR.

Another warning, it's impossible to differentiate between a timeout
and a failure.

If you pass a true value for USESSL, the port will be changed to 995 if
it is not set or is 110.  Otherwise, it will use your port.  If USESSL
is true, IO::Socket::SSL will be loaded.  If it is not in your perl,
the call to connect will fail.

new returns a valid Mail::POP3Client object in all cases.  To test for
a connection failure, you will need to check the number of messages:
-1 indicates a connection error.  This will likely change sometime in
the future to return undef on an error, setting $! as a side effect.
This change will not happen in any 2.x version.

=item I<Head>( MESSAGE_NUMBER [, PREVIEW_LINES ] )

Get the headers of the specified message, either as an array or as a
string, depending on context.

You can also specify a number of preview lines which will be returned
with the headers.  This may not be supported by all POP3 server
implementations as it is marked as optional in the RFC.  Submitted by
Dennis Moroney <dennis@hub.iwl.net>.

=item I<Body>( MESSAGE_NUMBER )

Get the body of the specified message, either as an array of lines or
as a string, depending on context.

=item I<BodyToFile>( FILE_HANDLE, MESSAGE_NUMBER )

Get the body of the specified message and write it to the given file handle.
my $fh = new IO::Handle();
$fh->fdopen( fileno( STDOUT ), "w" );
$pop->BodyToFile( $fh, 1 );

Does no stripping of NL or CR.


=item I<HeadAndBody>( MESSAGE_NUMBER )

Get the head and body of the specified message, either as an array of
lines or as a string, depending on context.

=over 4

=item Example

foreach ( $pop->HeadAndBody( 1 ) )
   print $_, "\n";

prints out the complete text of message 1.

=back

=item I<HeadAndBodyToFile>( FILE_HANDLE, MESSAGE_NUMBER )

Get the head and body of the specified message and write it to the given file handle.
my $fh = new IO::Handle();
$fh->fdopen( fileno( STDOUT ), "w" );
$pop->HeadAndBodyToFile( $fh, 1 );

Does no stripping of NL or CR.


=item I<Retrieve>( MESSAGE_NUMBER )

Same as HeadAndBody.

=item I<RetrieveToFile>( FILE_HANDLE, MESSAGE_NUMBER )

Same as HeadAndBodyToFile.

=item I<Delete>( MESSAGE_NUMBER )

Mark the specified message number as DELETED.  Becomes effective upon
QUIT (invoking the Close method).  Can be reset with a Reset message.

=item I<Connect>

Start the connection to the POP3 server.  You can pass in the host and
port.  Returns 1 if the connection succeeds, or 0 if it fails (Message
will contain a reason).  The constructor always returns a blessed
reference to a Mail::POP3Client obhect.  This may change in a version
3.x release, but never in a 2.x release.

=item I<Close>

Close the connection gracefully.  POP3 says this will perform any
pending deletes on the server.

=item I<Alive>

Return true or false on whether the connection is active.

=item I<Socket>

Return the file descriptor for the socket, or set if supplied.

=item I<Size>

Set/Return the size of the remote mailbox.  Set by POPStat.

=item I<Count>

Set/Return the number of remote messages.  Set during Login.

=item I<Message>

The last status message received from the server or a message
describing any problem encountered.

=item I<State>

The internal state of the connection: DEAD, AUTHORIZATION, TRANSACTION.

=item I<POPStat>

Return the results of a POP3 STAT command.  Sets the size of the
mailbox.

=item I<List>([message_number])

Returns the size of the given message number when called with an
argument using the following format:

   <message_number> <size_in_bytes>

If message_number is omitted, List behaves the same as ListArray,
returning an indexed array of the sizes of each message in the same
format.

You can parse the size in bytes using split:
 ($msgnum, $size) = split('\s+', $pop -> List( n ));


=item I<ListArray>

Return a list of sizes of each message.  This returns an indexed
array, with each message number as an index (starting from 1) and the
value as the next entry on the line.  Beware that some servers send
additional info for each message for the list command.  That info may
be lost.

=item I<Uidl>( [MESSAGE_NUMBER] )

Return the unique ID for the given message (or all of them).  Returns
an indexed array with an entry for each valid message number.
Indexing begins at 1 to coincide with the server's indexing.

=item I<Capa>

Query server capabilities, as described in RFC 2449. Returns the
capabilities in an array. Valid in all states.

=item I<XTND>

Optional extended commands.  Transaction state only.

=item I<Last>

Return the number of the last message, retrieved from the server.

=item I<Reset>

Tell the server to unmark any message marked for deletion.

=item I<User>( [USER_NAME] )

Set/Return the current user name.

=item I<Pass>( [PASSWORD] )

Set/Return the current user name.

=item I<Login>

Attempt to login to the server connection.

=item I<Host>( [HOSTNAME] )

Set/Return the current host.

=item I<Port>( [PORT_NUMBER] )

Set/Return the current port number.

=back

=head1 IMAP COMPATIBILITY

Basic Mail::IMAPClient method calls are also supported: close, connect,
login, message_string, Password, and unseen.  Also, empty stubs are
provided for Folder, folders, Peek, select, and Uid.

=head1 REQUIREMENTS

This module does not have mandatory requirements for modules that are not part
of the standard Perl distribution. However, APOP needs need Digest::MD5 and
CRAM-MD5 needs Digest::HMAC_MD5 and MIME::Base64.

=head1 AUTHOR

Sean Dowd <pop3client@dowds.net>

=head1 CREDITS

Based loosely on News::NNTPClient by Rodger Anderson
<rodger@boi.hp.com>.

=head1 SEE ALSO

perl(1)

the Digest::MD5 manpage, the Digest::HMAC_MD5 manpage, the MIME::Base64 manpage

RFC 1939: Post Office Protocol - Version 3

RFC 2195: IMAP/POP AUTHorize Extension for Simple Challenge/Response

RFC 2449: POP3 Extension Mechanism

=cut
};
Mail::POP3Client->import();
$INC{'Mail/POP3Client'} = "/dev/null";
#  perl-link processed: use Mail::MailUser;

BEGIN {
#---------- MailUser Class -----------------
# Meant to keep information about an email account organized.
package MailUser;
#use strict;
sub new {                          #Constructor
     my $class = shift;
     my $self  = {};
     $self->{srcuser}    = undef; # Source      IMAP/POP3 username
     $self->{srcpass}    = undef; # Source      IMAP/POP3 password
     $self->{dstuser}    = undef; # Destination IMAP/POP3 username
     $self->{dstpass}    = undef; # Destination IMAP/POP3 password
     $self->{status}     = undef; # Status of the user: OK=ok, Other means
                                  #  there's a login error or problem in
                                  #  the maillist file, etc.
     $self->{srcstatus}  = undef; # Status of the source account login check.
     $self->{dststatus}  = undef; # Status of the dest   account login check.    __
     $self->{folder}     = undef; # Current IMAP folder for this user.             |
     $self->{message}    = undef; # Current IMAP message number for this user.     |--> Tracked in mvmail
     $self->{done}       = undef; # 0=Transfer is not done for this user. 1=done.__|     status database.
     bless($self, $class);
     return $self;
}

};
Mail::MailUser->import();
$INC{'Mail/MailUser'} = "/dev/null";
#  perl-link processed: use Mail::RsyncUser;

BEGIN {
#---------- MailUser Class -----------------
# Meant to keep information about an email account organized.
package RsyncUser;
#use strict;
sub new {                          #Constructor
     my $class = shift;
     my $self  = {};
     $self->{srcuser} = undef;
     $self->{filepath}     = undef; # Path to the MailDir files
     $self->{password}     = undef;
     $self->{status}       = undef; # Status of the email transfer.
     bless($self, $class);
     return $self;
}

};
Mail::RsyncUser->import();
$INC{'Mail/RsyncUser'} = "/dev/null";
use Getopt::Long;
use Tie::File;
use IO::Socket::SSL;
use Term::ANSIColor qw(:constants);
use Cpanel::Version;
use DBI;
use Data::Validate::Domain;
use JSON;
my $tokensupport;
my $token_name;
my $json;
my $currversion = Cpanel::Version::getversionnumber();

if (is_cpanel()) {  #If this is cPanel, then prepare to use some cPanel modules.
     if (eval {require cPanel::PublicAPI;}) {
             require cPanel::PublicAPI;
     } else {
             print "[!] Failed to load the necessary modules for this script to function properly. Please install cPanel::PublicAPI via '/scripts/perlinstaller cPanel::PublicAPI'\n";
             exit 1;
     }
     use lib "/usr/local/cpanel/";
     require Cpanel::PasswdStrength::Generate;
     require Cpanel::PasswdStrength::Check;
     #my $apic = cPanel::PublicAPI->new();
     #Token Support
     if ( $currversion >= 11.64 ){
                #Clean up the API Token before exit
                END{
                        if($token_name){
                                `whmapi1 api_token_revoke token_name=$token_name`;
                        }
                }
                my $token_list = `whmapi1 api_token_list --output=json`;
                my $listjson = from_json($token_list);
                my $current_time = time();
		stale_tokens();
                $token_name = "mvmail_".time();
                $json = `whmapi1 api_token_create token_name=$token_name --output=json`;
                $token = from_json($json)->{'data'}{'token'};
		my $revoked;
                $SIG{INT} = sub { unless ($revoked) { $revoked = 1; fork or exec('whmapi1', 'api_token_revoke', "token_name=$token_name"); }} 
     } elsif ( !-s "/root/.accesshash" ) {
        $ENV{'REMOTE_USER'} = 'root';
        system('/usr/local/cpanel/bin/realmkaccesshash');
     }
}

sub stale_tokens{
        my $token_list = `whmapi1 api_token_list --output=json`;
        my $listjson = from_json($token_list);
        my $current_time = time();
        if ($currversion >= 11.68){
                foreach my $token_name (%{$listjson->{'data'}{'tokens'}}){
                        if( $token_name =~ /mvmail_/ ){
                                my $token_time = $token_name;
                                $token_time =~ s/\D//g;
                                if ( ($token_time + 432000) < $current_time ){
                                        #Token is 5 days older than now, removing.
                                        `whmapi1 api_token_revoke token_name=$token_name`;
                                }
                        }
                }
        } else {
                foreach my $token_data (@{$listjson->{'data'}{'tokens'}}){
                        if( $token_data->{'name'} =~ /mvmail_/ ){
                                my $token_time = $token_data->{'name'};
                                $token_time =~ s/\D//g;
                                if ( ($token_time + 432000) < $current_time ){
                                        #Token is 5 days older than now, removing.
                                        `whmapi1 api_token_revoke token_name=$token_data->{'name'}`;
                                }
                        }
                }
        }
}

#---------------------------------------------------------------
#-------------------- Global Variables -------------------------
#---------------------------------------------------------------
my @userlist          = ();
my @filtered_userlist = ();
my $localhost   = find_primary_ip();
my $remotehost;
my $userlist_filename;
my $clean;         #Flag that says whether or not the email address list is clean/free of errors.

# Set $| to automatically flush the print buffer after every print call
# so you can watch what's happening if you pipe output to a logfile
# and then "tail -f logfile"
# $| = 1;

my $debug = 0;    # Set this to 1 for debugging output - generates LOTS
                  # of output from IMAP
my $verbose = 1;  # Set this to 1 for debugging output - generates LOTS
                  # of output, message headers and folder ops
my $copyEmptyFolders = 1; # Should folders that exist on the old server but are
                          # empty be created on the new server? Set this value 
                          # to 0 if not.

my $usealtnamespace = 0; # Use altnamespace mode: folders on the new mail server 
                      # can be at the same hierarchy level as INBOX, but inbox
                      # can have no inferior folders (subfolders) if this is 1 
                      # if this is set to 0, assumes Cyrus mode: all folders
                      # must be subfolders of the INBOX


# fix exchange-server braindead non-RFC-compliant newlines
# that gag other IMAP servers because there's no carriage-return 
# character...  WARNING! USE WITH CAUTION!
# set this option to 1 only if you dare... could possibly screw up
# encoded data in attachments??? Well... probably not, but 
# this is the only code that alters message content (which can
# be a very touchy business). It scans the full content of each and
# every message, adding carriage returns before plain newlines 
# i.e replacing \n with \r\n
my $fixnewlines = 0;

# This is one you probably don't want to change
# list of characters Cyrus will accept in mailbox names
# characters in mailbox names not in this list will be converted to dashes
my $goodchars = " \+,\-.0-9:=\@A-Z_a-z~/";

##### END OF CONFIGURATION OPTIONS #####

# Get folder delimiter character on each server
# Declared globally to reduce the amount of arguments
# that need to be passed between subroutines.
#
# Short of the server changing implementations mid-sync
# (har har) we can calculate this once and leave the result
# as a pair of global vars.
#
# Values are filled in the first time the system connects
# to the Old and New imap servers. (And at present re-calculated
# for each user, but really, this is peanuts.)
my ($oldDelim) = "";
my ($newDelim) = "";
my ($newDelimLiteral) = "";
my ($oldDelimLiteral) = "";
my $oldPrefix  = "";
my $newPrefix  = "";

my $timestamp = `date`;
my @moveusers;
my $statdb;   # Status database handle.

#---------------------------------------------------------------
#---------------- Parse command line args ----------------------
#---------------------------------------------------------------
my $desthost;      # Destination host.  If this is set then it is not assumed that email is transferring
                   #  to the same server that the script is running on.  Local email account checks are skipped.
my $bind_address;  # Local IP address to bind to when connecting.
my $rsyncpull  = 0; # 1 = Print commands to transfer using rsync, "pulling" from the source server.
my $rsyncpush  = 0; # 1 = Print commands to transfer using rsync, "pushing" to the destination server.
my $ssyncpull  = 0; # 1 = Print commands to transfer using ssync, "pulling" from the source server.
my $ssyncpush  = 0; # 1 = Print commands to transfer using ssync, "pushing" to the destination server.
my $showdirs   = 0; # 1 = Print each email address to STDOUT along with its corresponding directory.
my $ssl        = 0; # 1 = Use IMAPS to connect to the old host (port 993), 0=Use IMAP (port 143).
my $pop3       = 0; # 1 = Use POP3.  0 = Use IMAP if none of the rsync options were given.
my $test       = 0; # 1 = Test mode. Check the logins.  0=Actually do the transfers.
my $noprompt   = 0; # 1 = Don't show prompts.  0 = prompt as needed.
my $resume;
my $resumeflag = 0;
my $maxsize    = 1000; #Maximum message size for a message in an IMAP transfer.  Default to ridiculously large message.
my $resumemessage = -1;

GetOptions ('dirs'           => \$showdirs,   #Grab command line options.
            'rsync-pull'     => \$rsyncpull,
            'rsync-push'     => \$rsyncpush,
            'ssync-pull'     => \$ssyncpull,
            'ssync-push'     => \$ssyncpush,
            'ssl'            => \$ssl,
            'bind-address=s' => \$bind_address,
            'desthost=s'     => \$desthost,
            'test'           => \$test,
            'noprompt'       => \$noprompt,
            'resume=s'       => \$resume,        #Undocumented because it should not usually be needed or used.
            'maxsize=i'      => \$maxsize,
            'resumemessage=s' => \$resumemessage,#Undocumented because it should not usually be needed or used.
            'pop3'           => \$pop3);

$maxsize = $maxsize * 1048576; #Convert 

if ($showdirs) {
     if ($#ARGV != 0) {
          show_usage();
          exit 1;
     }
     $userlist_filename = $ARGV[0];
}else {
     if ($#ARGV != 1) {                 #If arguments are given and --list is given, then show an error.
          show_usage();
          exit 1;
     }
     $remotehost = $ARGV[0];
     $userlist_filename = $ARGV[1];
     #Normally $localhost is the destination.  But if $desthost is set, then that means the user is saying
     # they are running the script from a 3rd party server.  In this case 
     if ($desthost) { #Normally $localhost is the destination.  But if $desthost is set, then that will be considered
          $localhost = $desthost; # the "local" host even though in .
     }
}

init_status_database($userlist_filename);

$SIG{PIPE} = \&pipe_handler; #Set a handler for when the connection breaks.
sub pipe_handler {
     print RED . "Broken pipe (PIPE).  Please restart mvmail to ensure a complete transfer.  Saving status to $userlist_filename.status\n" . RESET;
     write_status_database(\@userlist);
     $statdb->disconnect();
     exit(13);
}

$SIG{SIGPIPE} = \&sigpipe_handler; #Set a handler for when the connection breaks.
sub sigpipe_handler {
     print RED . "Broken pipe (SIGPIPE).  Please restart mvmail to ensure a complete transfer.  Saving status to $userlist_filename.status\n" . RESET;
     write_status_database(\@userlist);
     $statdb->disconnect();
     exit(13);
}

$SIG{INT} = \&sigint_handler; #Set a handler for when the connection breaks.
sub sigint_handler {
     print YELLOW . "Mail transfer interrupted.  Saving status to $userlist_filename.status\n" . RESET;
     write_status_database(\@userlist);
     $statdb->disconnect();
     exit(0);
}

#---------------------------------------------------------------
#----------------------- Main ----------------------------------
#---------------------------------------------------------------

## Read the file with the email addresses.
if ($rsyncpull || $rsyncpush || $ssyncpull || $ssyncpush) {
     if (!read_rsync_file($userlist_filename, \@userlist)) {
          print "Read of the file $userlist_filename failed.\n";
          exit 1;
     }
}else{
     if (!read_imap_file($userlist_filename, \@userlist)) {
          print "Read of the file $userlist_filename failed.\n";
          exit 1;
     }
}

if ($showdirs) {
     # Print email addresses and their maildir directories.
     show_dirs(\@userlist);
}elsif ($rsyncpull) {
     $clean = rsyncpull_cleanup_userlist(\@userlist);
     if (!$clean) { #If the userlist wasn't perfectly clean, ask if the user wants to continue with the transfer.
          confirm_continue_exit();
     }
     rsync_pull(\@userlist);
}elsif ($rsyncpush) {
     $clean = rsyncpush_cleanup_userlist(\@userlist);
     if (!$clean) { #If the userlist wasn't perfectly clean, ask if the user wants to continue with the transfer.
          confirm_continue_exit();
     }
     rsync_push(\@userlist);
}elsif ($ssyncpull) {
     $clean = rsyncpull_cleanup_userlist(\@userlist);
     if (!$clean) { #If the userlist wasn't perfectly clean, ask if the user wants to continue with the transfer.
          confirm_continue_exit();
     }
     ssync_pull(\@userlist);
}elsif ($ssyncpush) {
     $clean = rsyncpush_cleanup_userlist(\@userlist);
     if (!$clean) { #If the userlist wasn't perfectly clean, ask if the user wants to continue with the transfer.
          confirm_continue_exit();
     }
     ssync_push(\@userlist);
}elsif ($pop3 && $test) { #Test POP3 logins
     $clean = imap_cleanup_desthost_userlist(\@userlist);
     pop3_test_logins(\@userlist);
}elsif ($pop3 && !$test) { #Transfre from a POP3 server at the old host.
     if ($desthost) {# If the script is running on a 3rd party server, then us a less strict cleanup sub.
          $clean = imap_cleanup_desthost_userlist(\@userlist);
          if (!$clean) { #If the userlist wasn't perfectly clean, ask if the user wants to continue with the transfer.
               confirm_continue_exit();
          }
          pop3_transfer(\@userlist);
     }else{
          $clean = imap_cleanup_userlist(\@userlist);
          if (!$clean) { #If the userlist wasn't perfectly clean, ask if the user wants to continue with the transfer.
               confirm_continue_exit();
          }
          pop3_transfer(\@userlist);
     }
}elsif ($test) { # Test IMAP logins
     $clean = imap_cleanup_desthost_userlist(\@userlist);
     imap_test_logins(\@userlist);
}else { #Assume that we are doing an IMAP/IMAPS transfer and the script is on the destination server.
     if ($desthost) {# If the script is running on a 3rd party server, then us a less strict cleanup sub.
          $clean = imap_cleanup_desthost_userlist(\@userlist);
          if (!$clean) { #If the userlist wasn't perfectly clean, ask if the user wants to continue with the transfer.
               confirm_continue_exit();
          }
          read_status_database(\@userlist);
          imap_transfer(\@userlist);
     }else{
          $clean = imap_cleanup_userlist(\@userlist);
          if (!$clean) { #If the userlist wasn't perfectly clean, ask if the user wants to continue with the transfer.
               confirm_continue_exit();
          }
          read_status_database(\@userlist);
          imap_transfer(\@userlist);
     }
}

#------------------------------------------------------------------
#--------------------- Print Summary Info -------------------------
#------------------------------------------------------------------
if ($test) {
     summarize_src_dest(\@userlist);
}else{
     summarize_status(\@userlist);
     write_status_database(\@userlist);
     $statdb->disconnect();
     exit 0;
}     
$statdb->disconnect();

sub summarize_src {
     my $userlist = shift;
     print "-------------- Source -------------";
     print YELLOW . "\nSuccessful email addresses:\n" . RESET;
     foreach my $user (@{$userlist}) {
          if ($user->{srcstatus} eq "ok") {
               print GREEN . $user->{srcuser} . "\n" . RESET;
          }
     }
     print YELLOW . "\nFailed email addresses:\n" . RESET;
     foreach my $user (@{$userlist}) {
          if ($user->{srcstatus} ne "ok") {
               print RED . $user->{srcuser} . "\n" . RESET;
          }
     }
}

# Summarize the status of each email address.
# Input:  ref to @userlist array.
# Output: Summary of successful and failed email addresses is printed.
sub summarize_status {
     my $userlist = shift;
     print YELLOW . "\nSuccessful email addresses:\n" . RESET;
     foreach my $user (@{$userlist}) {
          if ($user->{status} eq "ok") {
               print GREEN . $user->{srcuser} . "\n" . RESET;
          }
     }
     print YELLOW . "\nFailed email addresses:\n" . RESET;
     foreach my $user (@{$userlist}) {
          if ($user->{status} ne "ok") {
               print RED . $user->{srcuser} . "\n" . RESET;
          }
     }
}

# Print a summary of which email logins were successful
# for both the source and the dest.
# Input:  ref to @userlist array.
# Output: Summary info is printed.
sub summarize_src_dest {
     my $userlist = shift;
     print "\n    Login Test Summary:\n\n";
     print "    -------------- Source -------------   ------------- Dest ----------------\n";
     foreach my $user (@{$userlist}) {
          if ($user->{srcstatus} eq "ok" && $user->{dststatus} eq "ok") {
               print "[*] ";
          }else {
               print "[!] ";
          }
          if ($user->{srcstatus} eq "ok") {
               print GREEN;
          }else {
               print RED;
          }
          printf("%-35s   ", $user->{srcuser});
          if ($user->{dststatus} eq "ok") {
               print GREEN;
          }else {
               print RED;
          }
          printf("%-35s   \n" . RESET, $user->{dstuser});
     }
}

# Prompt to continue.  If user does not answer y or yes, exit.
sub confirm_continue_exit {
     print "Would you like to continue?\n";
     if (!confirm_continue()) {
          exit 0;
     }
}


# Confirm to continue.
# Input:  Keyboard input
# Output: 1=yes
#         0=no
sub confirm_continue {
     if ($noprompt) { #If user gave --noprompt option, then assume they want to answer yes to everything.
          return 1;
     }
     my $in = <STDIN>; # Prompt for an answer.
     chomp($in);       # Clean up the input.
     $in = lc($in);
     if ($in eq "y" || $in eq "yes") {
          return 1;
     }
     return 0;
}

sub ssync_push {
     my $userlist = $_[0];
     foreach my $user (@{$userlist}) {
          if ($user->{status} eq "ok") {
               my $localdir = mailacct_exists($user->{srcuser});
               if ($localdir) {
                    print "ssync $localhost:$localdir/ $remotehost:" . $user->{filepath} . "/\n";
               }else {
                    print RED . "Warning:" . RESET . " Email account " . $user->{srcuser} . " does not exist.\n";
               }
          }
     }
}

sub ssync_pull {
     my $userlist = $_[0];
     foreach my $user (@{$userlist}) {
          if ($user->{status} eq "ok") {
               my $localdir = mailacct_exists($user->{srcuser});
               if ($localdir) {
                    print "ssync $remotehost:" . $user->{filepath} . "/ $localhost:$localdir/\n";
               }else {
                    print RED . "Warning:" . RESET . " Email account " . $user->{srcuser} . " does not exist.\n";
               }
          }
     }
}


# Produce rsync commands that run locally and "pull" email content from the other server.
# Input: $userlist - An array reference where each element is "user@domain.com /path/to/maildir
#        Global variable $remotehost
#
# Todo: Change this to rsyncfrom and add an rsyncto sub.
#
sub rsync_pull {
     my $userlist = $_[0];
     print "PASS=\n";
     print "# The above variable will need to be set.\n";
     foreach my $user (@{$userlist}) {
          if ($user->{status} eq "ok") {
               my $localdir = mailacct_exists($user->{srcuser});
               if ($localdir) {
                    print "expect -c\"set timeout -1;spawn rsync --bwlimit=3200 --progress -a -e \"ssh\" root\@$remotehost:" . $user->{filepath} . "/ $localdir/ ;match_max 100000;expect -exact \\\"ssword: \\\";send -- \\\"\$PASS\\r\\\";expect eof\"\n";
               }else {
                    print RED . "Warning:" . RESET . " Email account " . $user->{srcuser} . " does not exist.\n";
               }
          }
     }
}

# Input: $userlist - An array reference where each element is "user@domain.com /path/to/maildir
#        Global variable $remotehost
#
# Todo: Change this to rsyncfrom and add an rsyncto sub.
#
sub rsync_push {
     my $userlist = $_[0];
     print "PASS=\n";
     print "# The above variable will need to be set.\n";
     foreach my $user (@{$userlist}) {
          if ($user->{status} eq "ok") {
               my $localdir = mailacct_exists($user->{srcuser});
               if ($localdir) {
                    print "expect -c\"set timeout -1;spawn rsync --bwlimit=3200 --progress -a -e \"ssh\" $localdir/ root\@$remotehost:" . $user->{filepath} . "/ ;match_max 100000;expect -exact \\\"ssword: \\\";send -- \\\"\$PASS\\r\\\";expect eof\"\n";
               }else {
                    print RED . "Warning:" . RESET . " Email account " . $user->{srcuser} . " does not exist.\n";
               }
          }
     }
}

# Pre-check the list of email addresses for an rsync transfer in which the remote server is the destination.
# Input:  Reference to an array containing the list file contents where each line is in the form:
#              email1@address.com /path/to/Maildir/on/source/server
#         Reference to an array to be populated with the cleaned up list.
# Output: 2nd array populated.  It will have invalid lines deleted.
#         Return value: 1=OK, 0=Not all lines checked out perfectly. (Return value is used to know whether or not to ask the user to continue).
sub rsyncpush_cleanup_userlist {
     my $userlist          = $_[0];
     my $clean             = 1; #Flag representing a clean list of email addresses.  1 = clean list with no problems.  0 = problems found.
     foreach my $user (@{$userlist}) {
          if (!defined($user->{srcuser}) || !defined($user->{filepath})) { #Make sure all fields are there.
               $clean=0;
               print "The line is not valid.  Not all of the fields appear to be defined.\n\n";
               next;
          }
          if (length($user->{srcuser}) == 0 || length($user->{filepath}) == 0) { #Make sure all fields are there.
               $clean=0;
               print "The line is not valid.  Not all of the fields appear to be defined.\n\n";
               next;
          }
          #Check the user
          my $count = ($user->{srcuser} =~ tr/\@//);  # Count the @ symbols.  If there's <> 1 then the email address is invalid.
          if ($count != 1) {
               $clean = 0; 
               print RED . "Warning:" . RESET . " Email account " . $user->{srcuser} . " does not appear to be valid.  There should be one and only one \@ symbol.  Skipping.\n\n";
               next;
          }
          my $domain = $user->{srcuser};
          $domain =~ s/.*\@//;
          if (!valid_domain($domain)) {
               $clean = 0;
               print RED . "Warning:" . RESET . " Email account " . $user->{srcuser} . " does not appear to be valid (the domain appears incorrect).  Skipping.\n\n";
               next;
          }
          if (!mailacct_exists($user->{srcuser})) {
               $clean = 0;
               print "The email account " . $user->{srcuser} . " does not exist.  Skipping.\n\n";
               next;
          }
          $user->{srcuser} =~ s/ *$//;
          $user->{password} =~ s/ *$//;
          $user->{status} = "ok";
     }
     return $clean;
}



# Pre-check the list of email addresses for an rsync transfer in which the this server is the destination.
# Input:  Reference to an array containing the list file contents where each line is in the form:
#              email1@address.com /path/to/Maildir/on/source/server [optional password]
#         Reference to an array to be populated with the cleaned up list.
# Output: 2nd array populated.  It will have invalid lines deleted, and any email addresses included that were interactively added.
#         Return value: 1=OK, 0=Not all lines checked out perfectly. (Return value is used to know whether or not to ask the user to continue).
sub rsyncpull_cleanup_userlist {
     my $userlist          = $_[0];
     my $clean             = 1; #Flag representing a clean list of email addresses.  1 = clean list with no problems.  0 = problems found.
     foreach my $user (@{$userlist}) {
          #my ($user, $path, $pass) = split(/\s/, $line);
          if (!defined($user->{srcuser}) || !defined($user->{filepath})) { #Make sure all fields are there.
               $clean=0;
               print "Not all of the fields appear to be defined: Email:" . $user->{srcuser} . " Path:" . $user->{filepath} . "\n\n";
               next;
          }
          if (length($user->{srcuser}) == 0 || length($user->{filepath}) == 0) { #Make sure all fields are there.
               $clean=0;
               print "Not all of the fields appear to be defined: Email:" . $user->{srcuser} . " Path:" . $user->{filepath} . "\n\n";
               next;
          }
          #Check the olduser
          my $count = ($user->{srcuser} =~ tr/\@//);  # Count the @ symbols.  If there's <> 1 then the email address is invalid.
          if ($count != 1) {
               $clean = 0;
               print RED . "Warning:" . RESET . " Email account " . $user->{srcuser} . " does not appear to be valid.  There should be one and only one \@ symbol.  Skipping.\n\n";
               next;
          }
          my $old_domain = $user->{srcuser};
          $old_domain =~ s/.*\@//;
          if (!valid_domain($old_domain)) {
               $clean = 0;
               print RED . "Warning:" . RESET . " Email account " . $user->{srcuser} . " does not appear to be valid (the domain appears incorrect).  Skipping.\n\n";
               next;
          }
          if (!mailacct_exists($user->{srcuser})) {
               $clean = 0;
               print "The email account " . $user->{srcuser} . " does not exist.  Would you like to create it (y/n)?\n";
               if (confirm_continue()) {
                    $user->{password} = create_email($user->{srcuser}, $user->{password});
                    if ($user->{password}) {
                         print GREEN . "Created email account " . $user->{srcuser} . " with password $pass\n\n" . RESET;
                    }else {
                         print RED . "WARNING:" . RESET . " Cannot transfer " . $user->{srcuser} . " because ";
                         print "there was a problem creating the email address.  Skipping.\n\n";
                         next;
                    }
               }else {
                    print RED . "Warning:" . RESET . " Cannot transfer " . $user->{srcuser} . " because the email address does not exist.  Skipping.\n\n";
                    next;
               }
          }
          $user->{srcuser} =~ s/ *$//;
          $user->{password} =~ s/ *$//;
          $user->{status} = "ok";
     }
     return $clean;
}



# Pre-check the list of email addresses for an imap transfer.
# Input:  Reference to an array containing the list file contents where each line is in the form:
#              email1@address.com password1 email2@address.com password2
#         Reference to an array to be populated with the cleaned up list.
# Output: 2nd array populated.  It will have invalid lines deleted, and any email addresses included that were interactively added.
#         Return value: 1=OK, 0=Not all lines checked out perfectly. (Return value is used to know whether or not to ask the user to continue).
sub imap_cleanup_userlist {
     my $userlist          = $_[0];
     my $clean             = 1; #Flag representing a clean list of email addresses.  1 = clean list with no problems.  0 = problems found.
     foreach my $user (@{$userlist}) {
          if (!defined($user->{srcuser}) || !defined($user->{srcpass}) || !defined($user->{dstuser}) || !defined($user->{dstpass})) { #Make sure all fields are there.
               $clean = 0;
               print "The line is not valid.  Not all of the fields appear to be defined:\n";
               print "srcuser: " . $user->{srcuser} . " srcpass: " . $user->{srcpass} . " dstuser: " . $user->{dstuser} . " dstpass: " . $user->{dstpass} . "\n";
               next;
          }
          if (length($user->{srcuser})==0 || length($user->{srcpass})==0 || length($user->{dstuser})==0 || length($user->{dstpass})==0) { #Make sure all fields are there.
               $clean = 0;
               print "The line is not valid.  Not all of the fields appear to be defined:\n";
               print "srcuser: " . $user->{srcuser} . " srcpass: " . $user->{srcpass} . " dstuser: " . $user->{dstuser} . " dstpass: " . $user->{dstpass} . "\n";
               next;
          }

          #In cPanel, an email address is lower case, so make sure our destination email is lower case.
          $user->{dstuser} = lc($user->{dstuser});

          #Check the newuser
          my $count = ($user->{dstuser} =~ tr/\@//);  # Count the @ symbols.  If there's <> 1 then the email address is invalid.
          if ($count != 1) {
               $clean = 0;
               print RED . "Warning:" . RESET . " Email account " . $user->{dstuser} . " does not appear to be valid.  There should be one and only one \@ symbol.  Skipping this line.\n";
               next;
          }
          my $new_domain = $user->{dstuser};
          $new_domain =~ s/.*\@//;
          if (!valid_domain($new_domain)) {
               $clean = 0;
               print RED . "Warning:" . RESET . " Email account " . $user->{dstuser} . " does not appear to be valid (the domain appears incorrect).  Skipping this line.\n";
               next;
          }
          if (!mailacct_exists($user->{dstuser})) {
               $clean = 0;
               print "The email account " . $user->{dstuser} . " does not exist.  Would you like to create it (y/n)?\n";
               if (confirm_continue()) {
                    $user->{dstpass} = create_email($user->{dstuser}, $user->{dstpass});
                    if ($user->{dstpass}) {
                         print GREEN . "Created email account " . $user->{dstuser} . " with password " . $user->{dstpass} . "\n\n" . RESET;
                    }else {
                         print "WARNING! Cannot transfer " . $user->{dstuser} . " because the email address does not exist and ";
                         print "there was a problem creating the email address.  Skipping this line.\n";
                         next;
                    }
               }else {
                    print "WARNING! Cannot transfer " . $user->{dstuser} . " because the email address does not exist.  Skipping this line.\n";
                    next;
               }
          }
          $user->{srcuser} =~ s/ *$//;
          $user->{srcpass} =~ s/ *$//;
          $user->{dstuser} =~ s/ *$//;
          $user->{dstpass} =~ s/ *$//;
          $user->{status} = "ok";
     }
     return $clean;
}

# Pre-check the list of email addresses for an imap transfer that is being done from a 3rd party server.
#  In other words the script is not running on the source or the destination server.
# Input:  Reference to an array containing the list file contents where each line is in the form:
#              email1@address.com password1 email2@address.com password2
#         Reference to an array to be populated with the cleaned up list.
# Output: 2nd array populated.  It will have invalid lines deleted, and any email addresses included that were interactively added.
#         Return value: 1=OK, 0=Not all lines checked out perfectly. (Return value is used to know whether or not to ask the user to continue).
sub imap_cleanup_desthost_userlist {
     my $userlist          = $_[0];
     my $clean             = 1; #Flag representing a clean list of email addresses.  1 = clean list with no problems.  0 = problems found.
     foreach my $user (@{$userlist}) {
          if (!defined($user->{srcuser}) || !defined($user->{srcpass}) || !defined($user->{dstuser}) || !defined($user->{dstpass})) { #Make sure all fields are there.
               $clean = 0;
               print "The line is not valid.  Not all of the fields appear to be defined:\n";
               print "srcuser: " . $user->{srcuser} . " srcpass: " . $user->{srcpass} . " dstuser: " . $user->{dstuser} . " dstpass: " . $user->{dstpass} . "\n";
               next;
          }
          if (length($user->{srcuser})==0 || length($user->{srcpass})==0 || length($user->{dstuser})==0 || length($user->{dstpass})==0) { #Make sure all fields are there.
               $clean = 0;
               print "The line is not valid.  Not all of the fields appear to be defined:\n";
               print "srcuser: " . $user->{srcuser} . " srcpass: " . $user->{srcpass} . " dstuser: " . $user->{dstuser} . " dstpass: " . $user->{dstpass} . "\n";
               next;
          }

          #Check the newuser
          my $count = ($user->{dstuser} =~ tr/\@//);  # Count the @ symbols.  If there's <> 1 then the email address is invalid.
          if ($count != 1) {
               $clean = 0;
               print RED . "Warning:" . RESET . " Email account " . $user->{dstuser} . " does not appear to be valid.  There should be one and only one \@ symbol.  Skipping this line.\n";
               next;
          }
          my $new_domain = $user->{dstuser};
          $new_domain =~ s/.*\@//;
          if (!valid_domain($new_domain)) {
               $clean = 0;
               print RED . "Warning:" . RESET . " Email account " . $user->{dstuser} . " does not appear to be valid (the domain appears incorrect).  Skipping this line.\n";
               next;
          }
          $user->{srcuser} =~ s/ *$//;
          $user->{srcpass} =~ s/ *$//;
          $user->{dstuser} =~ s/ *$//;
          $user->{dstpass} =~ s/ *$//;
          $user->{status} = "ok";
     }
     return $clean;
}


# Show the directory associated with each email address (works on Plesk or cPanel).
# Input:  $userlist - An array reference where each element is user@domain.com
#         This list should already be sanitized, so there is minimal error checking.
# Output: Each email address is printed with its directory.
#         i.e. admin@somedomain.com /home/somed/mail/somedomain.com/admin
sub show_dirs {
     my $userlist = $_[0];
     foreach my $user (@{$userlist}) {

          #Check for a valid email address.
          my $count = ($user->{srcuser} =~ tr/\@//);  # Count the @ symbols.  If there's <> 1 then the email address is invalid.
          if ($count != 1) {
               $clean = 0;
               print "Email account " . $user->{srcuser}. " does not appear to be valid.  There should be one and only one \@ symbol.\n";
               next;
          }

          my $dir = mailacct_exists($user->{srcuser});
          if ($dir) {
               print $user->{srcuser} . " " . "$dir\n";
          }else {
               print RED . "Warning:" . RESET . " Email account " . $user->{srcuser} . " does not exist.\n";
          }
     }
}


# Domain matching regex from http://www.regextester.com/examples.html
sub valid_domain {
    my $domain = $_[0];
    if ($domain eq is_domain($domain)) {
         return 1;     # Valid domain
    }
    return 0;          # Invalid domain
}

#---------------------------------------------------------------
#------------------- POP3 Subroutines --------------------------
#---------------------------------------------------------------

# Test the POP3 logins for a list of email accounts.
# Input:  $userlist - An array reference where each element is
#                    user\@fromdomain.com frompassword user\@todomain.com topassword
#         Global variable $timestamp
# Output: The ->{status} members of the MailUser objects in $userlist are updated with "error" for any failed accounts.
sub pop3_test_logins {
     my $userlist = shift;
     my $src_grand_total = 0;
     my $dst_grand_total = 0;
     my %src_user_total;
     my %dst_user_total;
     print "Testing POP3 source logins...\n";
     foreach my $user (@{$userlist}) {
         next if($user->{status} ne "ok");
         my $result = pop3_test_login($remotehost, $user->{srcuser}, $user->{srcpass});
         if ($result == -1) {
              $user->{srcstatus} = "error";
         }else{
              $user->{srcstatus} = "ok";
	      $src_user_total{$user->{srcuser}} = $result;
              $src_grand_total = $src_grand_total + $result;
         }
     }

     print "Testing POP3 destination logins...\n";
     foreach my $user (@{$userlist}) {
         next if($user->{status} ne "ok");
         my $result = pop3_test_login($localhost, $user->{dstuser}, $user->{dstpass});
         if ($result == -1) {
              $user->{dststatus} = "error";
         }else{
              $user->{dststatus} = "ok";
	      $dst_user_total{$user->{dstuser}} = $result;
              $dst_grand_total = $dst_grand_total + $result;
         }
     }
     foreach my $user (keys %src_user_total){
         print "Total messages for $user at source:      $src_user_total{$user}\n";
         print "Total messages for $user at destination: $dst_user_total{$user}\n";
     }
     print "Total messages for all accounts at the source:      $src_grand_total\n";
     print "Total messages for all accounts at the destination: $dst_grand_total\n";
}

# Test the POP3 for one email account.
# Input:  MailUser object.
#         Global variable: $remotehost
# Output: 1=OK, 0=Error.
sub pop3_test_login {
    my $host = shift;
    my $user = shift;
    my $pass = shift;
    my $total_messages = 0;
    my $pop  = pop3_make_connection($host, $user, $pass);
    if (!$pop) {return -1;}
    $total_messages = $pop->Count();
    print "Folder: INBOX  Messages: " . $total_messages . "\n";
    close($pop->Socket());
    return $total_messages
}

# Perform an POP3 transfer of a list of email accounts.
# Input: $userlist - An array reference where each element is
#                    user\@fromdomain.com frompassword user\@todomain.com topassword
#        Global variable $timestamp
sub pop3_transfer {
     my $userlist = $_[0];
     print "POP3 user migration begun $timestamp\n";

     foreach my $user (@{$userlist}) {
         next if($user->{status} ne "ok");
         my $result = pop3_copymail($user);
         if (!$result) {
              $user->{status} = "error";
         }
     }
     
     print "POP3 user migration completed. \n";
}

# Copy the email for one email account.
# Input:  MailUser object.
#         Global variables: $remotehost, $localhost
# Output: 1=OK, 0=Error.
sub pop3_copymail {
    my $user = $_[0]; 
    my $msgid;      # Current message ID being transferred.
    my $new_msgids; # Hash ref containing message IDs on the destination account.
    my $header = "";
    $oldpop  = pop3_make_connection($remotehost, $user->{srcuser}, $user->{srcpass});
    if (!$oldpop) {return 0;}
    $newimap = imap_make_connection($localhost, $user->{dstuser}, $user->{dstpass});
    if (!$newimap) {return 0;}
    #select folder for writing to the new IMAP server
    unless($newimap->select("INBOX")) {
       print "Can't select new folder INBOX on new IMAP host: $@\n";
       return 0;
    }
    
    # List out the headers of the dest acct so we can skip duplicates.
    for my $msg ($newimap->search("ALL")) {
        $new_msgids->{ $newimap->get_header($msg,"Message-ID") } = 1;
    }

    #print $new_msgids->{"<1951308b0ab811a7aec39f936be77faf.squirrel\@50.116.81.64>"};
    for ($i = 1; $i <= $oldpop->Count(); $i++) {
        my @msgheader = $oldpop->Head( $i );
        my $msgsize   = $oldpop->List( $i ); #Has message number and size (i.e. "1 12000")
        $msgsize =~ m/[0-9]+\s+([0-9]+).*/;  #Extract just the size.
        $msgsize = $1;
        foreach $header (@msgheader) {
            if ($header =~ /^Message-ID:/) {
                 $header =~ s/Message-ID:\s*//;
                 $msgid = $header;
                 last;
            }
        }
        if ($new_msgids->{$msgid} == 1) {
             print "Skipping $i - $msgid: Already Exists\n";
        }elsif ($msgsize > $maxsize) {
             my $printable_maxsize = sprintf("%.1f", $maxsize / 1048576);
             print "Skipping $i - $msgid - Message size $msgsize exceeds maximum size limit of $printable_maxsize Mb\n";     
        }else{
             print "Copying $i - $msgid. Size: $msgsize\n";
             $msgtext = $oldpop->HeadAndBody( $i );        
             $newimap->append_string("INBOX", $msgtext);
        }
    }
    close($oldpop->Socket());
    return 1;
}

sub pop3_make_connection {
     $host = $_[0];
     $user = $_[1];
     $pass = $_[2];
     my $pop;
     my $pop_socket;

     if ($ssl) {
         #Make SSL connection
         print "Opening POP3S connection to $host for $user.\n" if($verbose);
         $pop_socket = IO::Socket::SSL->new(
              PeerAddr        => $host,
              PeerPort        => 995,
              LocalAddr       => $bind_address,
              SSL_verify_mode => 0
         );
         if (!$pop_socket) {
              print "Socket creation failed: $@\n";
              return undef;
         }
     }else{
         #Make plaintext connection
         print "Opening POP3 connection to $host for $user.\n" if($verbose);
         $pop_socket = IO::Socket::INET->new(
              PeerAddr => $host,
              PeerPort => 110,
              LocalAddr => $bind_address
         );
         if (!$pop_socket) {
              print "Socket creation failed: $@\n";
              return undef;
         }

     }
     $pop = Mail::POP3Client->new();
     $pop->User($user);
     $pop->Pass($pass);
     $pop->Socket($pop_socket);
     $pop->AuthMode("PASS");
     if (!$pop->Connect()) {
          return undef;
     }
     return $pop;
}

#---------------------------------------------------------------
#------------------- IMAP Subroutines --------------------------
#---------------------------------------------------------------

# List all of the email folders for a list of email accounts.
# Input: $userlist - An array reference where each element is
#                    user\@fromdomain.com frompassword user\@todomain.com topassword
#  Output: The ->{status} members of the MailUser objects in $userlist are updated with "error" for any failed accounts.
#         Folders and message counts are listed for successful accounts.
sub imap_test_logins {
     my $userlist    = $_[0];
     my $src_grand_total = 0;
     my $dst_grand_total = 0;
     my %src_user_total;
     my %dst_user_total;
     print "Testing IMAP source logins...\n";
     foreach my $user (@{$userlist}) {
         next if($user->{status} ne "ok");
         my $result = imap_listmail($remotehost, $user->{srcuser}, $user->{srcpass});
         if ($result == -1) {
              $user->{srcstatus} = "error";
         }else{
              $user->{srcstatus} = "ok";
	      $src_user_total{$user->{srcuser}} = $result;
              $src_grand_total = $src_grand_total + $result;
         }
     }
     summarize_src(\@userlist);
     print "Testing IMAP destination logins...\n";
     foreach my $user (@{$userlist}) {
         next if($user->{status} ne "ok");
         my $result = imap_listmail($localhost, $user->{dstuser}, $user->{dstpass});
         if ($result == -1) {
              $user->{dststatus} = "error";
         }else{
              $user->{dststatus} = "ok";
	      $dst_user_total{$user->{dstuser}} = $result;
              $dst_grand_total = $dst_grand_total + $result;
         }
     }
     foreach my $user (keys %src_user_total){
         print "Total messages for $user at source:      $src_user_total{$user}\n";
         print "Total messages for $user at destination: $dst_user_total{$user}\n";
     }
     print "Total messages for all accounts at the source:      $src_grand_total\n";
     print "Total messages for all accounts at the destination: $dst_grand_total\n";
}

# Perform an IMAP transfer of a list of email accounts.
# Input: $userlist - An array reference where each element is
#                    user\@fromdomain.com frompassword user\@todomain.com topassword
#        Global variable $timestamp
sub imap_transfer {
     my $userlist = $_[0];
     print "IMAP user migration begun $timestamp\n";

     foreach my $user (@{$userlist}) {
         next if($user->{srcuser} eq "" || $user->{status} ne "ok" || $user->{done} != 0);
         $user->{dstuser} = $user->{srcuser} if (!defined($user->{dstuser}) or ($user->{dstuser} eq ""));
         $user->{dstpass} = $user->{srcpass} if (!defined($user->{dstpass}) or ($user->{dstpass} eq ""));
         my $result = imap_copymail($user);
         if (!$result) {
              $user->{status} = "error";
              $user->{done} = 0;
         }else{
              $user->{done} = 1;
         }
     }
     print "IMAP user migration completed. \n";
}


# Establish an IMAP connection to an IMAP server.
# Input:  Host to connect to.
#         Username
#         Password
#         $ssl     global variable.
#         $verbose global variable.
#         $debug   global variable.
# Output: Mail::IMAPClient object
#         or undef if it failed.
sub imap_make_connection {
     $host = $_[0];
     $user = $_[1];
     $pass = $_[2];
     my $imap;
     my $imap_socket;

     if ($ssl) { #Create the SSL connection (see http://www.perlmonks.org/?node_id=649742)
          print "Opening IMAPS connection to $host for $user.\n" if($verbose);
          $imap_socket = IO::Socket::SSL->new(
               PeerAddr        => $host,
               PeerPort        => 993,
               LocalAddr       => $bind_address,
               SSL_verify_mode => 0
          );
          if (!$imap_socket) {
               print "Socket creation failed: $@\n";
               return undef;
          }
          my $greeting = <$imap_socket>;
          my ($id, $answer) = split /\s+/, $greeting;
          if ($answer ne "OK") {
               print "Unexpected greeting from IMAPS host: $greeting\n";
               return undef;
          }
          $imap = new Mail::IMAPClient(User=>$user,
                                          Password=>$pass,
                                          Debug=>$debug,
                                          Timeout=>0,
                                          Clear=>1,
                                          Peek=>"TRUE",
                                          Socket=> $imap_socket);
      
          if(!$imap) {
              print "Could not connect to \"from\" host as $user. Copy failed: $@\n";
              return undef;
          }
          $imap->State(Mail::IMAPClient::Connected());
          $imap->login();
          if (imap_disabled($imap)) {
               print RED . "The mail server has IMAP disabled.\n" . RESET;
               return undef;
          }
          if (!$imap->IsAuthenticated()) {
               print "Failed to log into the IMAPS host: " . $imap->LastError() . "\n";
               return undef;
          }
     }else { # Create a non-SSL connection.
          print "Opening IMAP connection to $host for $user.\n" if($verbose);
          $imap_socket = IO::Socket::INET->new(
               PeerAddr => $host,
               PeerPort => 143,
               LocalAddr => $bind_address
          );
          if (!$imap_socket) {
               print "Socket creation failed: $@\n";
               return undef;
          }
          my $greeting = <$imap_socket>;
          my ($id, $answer) = split /\s+/, $greeting;
          if ($answer ne "OK") {
               print "Unexpected greeting from the IMAP host: $greeting\n";
               return undef;
          }
          $imap = new Mail::IMAPClient(User=>$user,
                                          Password=>$pass,
                                          Debug=>$debug,
                                          Timeout=>0,
                                          Clear=>1,
                                          Peek=>"TRUE",
                                          Socket=> $imap_socket);
          if(!$imap) {
               print "Could not connect to \"to\" host as $user. Copy failed: $@\n";
               return undef;
          }
          $imap->State(Mail::IMAPClient::Connected());
          $imap->login();
          if (imap_disabled($imap)) {
               print RED . "The mail server has IMAP disabled.\n" . RESET;
               return undef;
          } 
          if (!$imap->IsAuthenticated()) {
               print "Failed to log into the IMAP host: " . $imap->LastError() . "\n";
               return undef;
          }
     }
     return $imap;
}

# Check to see if the IMAP server indicated that IMAP is disabled (GoDaddy does this)
# Input:  $imap object
# Output: 1=disabled, 0=enabled
sub imap_disabled {
     my $imap = shift;
     foreach my $output ($imap->Results()) {
          if ($output =~ /IMAP support is NOT enabled/) {
               return 1;
          }
     }
     return 0;
}

# List the email folders at the old IMAP host for a single user.
# Output: 1=OK, 0=Error
#         Folder listing is printed.
sub imap_listmail {
    my $host           = shift;
    my $user           = shift;
    my $pass           = shift;
    my $errors         = "";
    my $total_messages = 0;
    my $imap           = imap_make_connection($host, $user, $pass);
    if(!$imap) {
        print "Error connecting to $host for $user\n";
        return -1;
    }
    my @folders = $imap->list();
    if (!$imap->State()) { # Some servers will authenticate (i.e. a1 "OK LOGIN Ok."), then immediately follow it with
         print "Connection lost with old host for $user\n"; # "* BYE IMAP access disabled for this account."
         return -1;           # So we have to check here to make sure we still have a connection.
    }
    for( my $i = 0; $i < $#folders; $i++ ) {
	$folders[ $i ] =~ /.*\((.*)\) \S+ \"?([^\"]*)/;
	my $foldername = $2;
	chomp( $foldername );
        $foldername =~ s/[\x00-\x1F]//g; # Remove non-printable characters from the folder name.
        my $count=$imap->message_count($foldername);
        print "Folder: $foldername  Messages: $count\n";
        $total_messages = $total_messages + $count;
    }
    $imap->logout();
    undef $imap;
    print "Total messages for $user: $total_messages\n";
    return $total_messages;
}

# perform the actual copying of all mailboxes to the IMAP server 
# for a single user.
# Output: 1=OK, 0=Error
sub imap_copymail {
    my $user = $_[0];
    my $errors = "";
    my $status = 1;
    print "Begin migrating user $user->{srcuser} --> $user->{dstuser}\n";

    print "Source: ";
    my $oldimap = imap_make_connection($remotehost, $user->{srcuser}, $user->{srcpass});
    if(!$oldimap) {
        return 0;
    }

    print "Dest: ";
    my $newimap = imap_make_connection($localhost, $user->{dstuser}, $user->{dstpass});
    if(!$newimap) {
        return 0;
    }

    buildDelimiters($oldimap,$newimap);
    $oldPrefix = findPrefix($oldimap);
    $newPrefix = findPrefix($newimap);

    # Loop once per mailbox(folder) on the old server, copying each one
    my @folders = $oldimap->list();
    if (!$oldimap->State()) { # Some servers will authenticate (i.e. a1 "OK LOGIN Ok."), then immediately follow it with
         print "Connection lost with old host for $user->{srcuser}\n"; # "* BYE IMAP access disabled for this account."
         return 0;           # So we have to check here to make sure we still have a connection.
    }
    for( my $i = 0; $i < $#folders; $i++ ) {

	$folders[ $i ] =~ /.*\((.*)\) \S+ \"?([^\"]*)/;

	my $attributes = $1;
	my $foldername = $2;
    
	chomp( $foldername );
        $foldername =~ s/[\x00-\x1F]//g; # Remove non-printable characters from the folder name.

        # Look at --resume and status database "folder" field to determine which folder to resume on.
        # Note that --resume and the "folder" field from the database refer to the same thing.
        if (length($resume) > 0) {
             $user->{folder} = $resume;
        }
        if (length($user->{folder}) == 0 || $user->{folder} eq $foldername) {
             $resumeflag = 1;
        }
        if (!$resumeflag) {
             print "Skipping folder $foldername\n";
             next;
        }

        # if the \NoSelect attribute is set for the mailbox, we can't copy
        # anything from it anyway - skip this folder
	if(( $attributes =~ /Noselect/i )||( !$foldername )) {
            splice( @folders, $i, 1 );    #remove this line from array
            $i--; # compensate for the fact that we just shortened the array
        } else {
	    my $count=$oldimap->message_count($foldername);
	    # if the folder doesn't contain any messages, we might not want to copy
	    # it. See the $copyEmptyFolders option at the beginning of this script
	    if (!$copyEmptyFolders && ($oldimap->message_count($foldername) == 0)) {
		if($debug) {
		    print "Folder $foldername on 'from' server is empty";
		    print " - skipping folder\n";
		}
		next;
	    }
            $user->{folder} = $foldername; #Keep track of the folder so we can save it to the status db and continue later.
	    $errors = copyFolder($user, $oldimap,$newimap,$foldername);
	    $resumemessage = -1; #Reset resumemessage and $user->{message} to the default
            $user->{message} = 0; # now that we've copied the first folder, even if it was set.
 
	    if ( $errors ne '') {
		print "Error $foldername: $errors\n";
                $status = 0;
	    }
        }
    }

    #unless( defined( @folders )) {
    #return "No folders found on the old server! User copy failed.\n";
    #}
    
    #for my $folder (@folders) {
    #
    #}

    $oldimap->logout();
    $newimap->logout();

    undef $oldimap;
    undef $newimap;

    print "User $user->{srcuser} --> $user->{dstuser} data copy result: ";
    if( $errors eq "" && $status == 1) {
        print "Successful!\n";
    } else {
        print "\nERRORS:\n" . $errors . "\nWARNING! ERRORS ENCOUNTERED.\n";
        $status = 0;
    }
    return $status;
}

# Read through the mailbox listing to determine the prefix for an IMAP server
# Some IMAP server start all mailbox names with a prefix such as INBOX.  This is important because mailboxes cannot be created outside of this prefix.
# Input:  IMAPClient object.
# Output: The name of the prefix.
#
# Sample mailbox list as we see it from the IMAP server (i.e. the @listing array):
#* LIST (\HasChildren) "." "INBOX"
#* LIST (\HasNoChildren) "." "INBOX.Sent"
#* LIST (\HasNoChildren) "." "INBOX.folder2"
#* LIST (\HasNoChildren) "." "INBOX.Trash"
#* LIST (\HasNoChildren) "." "INBOX.Junk"
#* LIST (\HasNoChildren) "." "INBOX.mytest"
#* LIST (\HasNoChildren) "." "INBOX.Drafts"
#3 OK List completed.
sub findPrefix {
    my $imap                = $_[0];
    my $delimiter           = ""; #Delimiter that separates folders from subfolders. (i.e. Delimiter is / in INBOX/Sent)
    my $reference_prefix    = ""; #Prefix found in the first record, which is used as a reference.
    my $curprefix           = ""; #Current prefix of a given line in the list.
    my @listing = $imap->list("", "*") or die "Error while trying to find IMAP prefix: $@\n";
    my $loopcount = 0;
    foreach my $line (@listing) {
         if ($line =~ /^[^"]*"(.)"\s*\"*([a-zA-Z0-9$1]*)\"*\s*$/)  { #If this is an actual list line and not something like "OK LIST completed", then process the line.
              $delimiter =  $1;                           #Extract the delimiter and the prefix.
              $curprefix =  $2;
              $delimiter =~ s/(\W)/\\$1/g; 
              $curprefix =~ s/$delimiter.*//;
              if ($loopcount == 0) {
                   $reference_prefix = $curprefix;        #If this is the first line, then set our reference prefix.
              }else {
                   if ($curprefix ne $reference_prefix) { #If it's not the first line, then stop the loop if/when we
                        last;                             # find a prefix that doesn't match the reference prefix. 
                   }
              }
              $loopcount++;
         }
    }
    if ($loopcount < 2) {
         $curprefix = "";                            #If there was only one line (or no lines), then the prefix is blank.
    }
    return $curprefix;
}

sub buildDelimiters {
    my ($oldimap, $newimap) = @_;
    ($oldDelim) = $oldimap->list("","");
    ($newDelim) = $newimap->list("","");

    # Remove all returned text except for the item in the first set of
    # double-quotes, which should be the delimiter character for the server
    # Then, if the delimiter is not alphanumeric, put a backslash in front
    # of it to make sure Perl interprets it as a literal character later
    $oldDelim =~ s/^[^"]*"(.)".*".*".*$/$1/; 
    $newDelim =~ s/^[^"]*"(.)".*".*".*$/$1/; 
    chomp($oldDelim);
    chomp($newDelim);
    $newDelimLiteral = $newDelim; # save an unaltered copy (no backslash)
    $oldDelimLiteral = $oldDelim;
    $oldDelim =~ s/(\W)/\\$1/g;
    $newDelim =~ s/(\W)/\\$1/g;

}

sub newFolderName {
    my ($folder)=@_;
    my $newfolder = $folder;

    $newfolder =~ s/\[[a-zA-Z]*\]\///g; # Remove prefix like [Gmail]/
    
    # Remove the old prefix from the folder name if there was one and it isn't the folder name.
    #  (i.e. If the old prefix is INBOX and the old folder name is INBOX, then we don't want turn "INBOX" into "".)
    if (length($oldPrefix) > 0 && $newfolder ne $oldPrefix) {
         $newfolder =~ s/^$oldPrefix$oldDelim//;
    }

    if ($newfolder =~ /^$newPrefix$/i) { #If $newfolder and $newPrefix match (case insensitive) (i.e. Inbox and INBOX matches),
         $newfolder = $newPrefix;        # make $newfolder match $newPrefix exactly.
    }

    # Prepend the new prefix if there is a new prefix and the new prefix is not the new folder name.
    #  (i.e. If the prefix is INBOX and the folder is INBOX, then we don't want to make it INBOX/INBOX.)
    if (length($newPrefix) > 0 && $newfolder ne $newPrefix) {
         $newfolder =~ s/^/$newPrefix$oldDelimLiteral/;
    }

    # We need to account for the possibility that the folder delimiters 
    # on the new server may be different from those on the old server,
    # and that the old server may have allowed users to include the 
    # new server's delimiter in the literal text of their folder names
    if ($oldDelimLiteral ne $newDelimLiteral) {
	# If $newDelim exists as a literal in the foldername,
	# we'll replace with "-". It's probably just punctuation and
	# hopefully won't be missed by the users. Yuck, but I can't
	# think of a better alternative.
	#$newfolder =~ s/$newDelim/-/g;    
	$newfolder =~ s/$oldDelim/$newDelimLiteral/g; 
    }
    
    # the Newfolder name can't contain any characters cyrus doesn't like.
    # Replace with "-". Again, yuck. 
    $newfolder =~ s/[\"]//og;
    $newfolder =~ s/[^$goodchars]/-/og;

    return $newfolder;
}


sub copyFolder {
    my ($user, $oldimap, $newimap, $folder) = @_;

    if ($resumemessage > -1) {
         $user->{message} = $resumemessage;
    }

    # Remove any non-printable characters from $newfolder.
    $folder =~ s/[^[:print:]]+//g;

    my $newfolder=newFolderName($folder);
    print "Syncing $folder -> $newfolder\n" if($verbose);
    my $errors='';

    # if the folder already exists, there's something amiss - print
    # an error and skip to the next folder, unless the folder is the
    # INBOX, which should be created automatically when you add a new user.
    
    if (($newimap->exists($newfolder)) && ($newfolder ne "INBOX")) {
	$errors .= "Folder exists error: $newfolder\n";
    } else {
	# create folder on new IMAP server
	if ($newfolder ne "INBOX") {
	    unless ($newimap->create($newfolder)) {
		$errors .= "Can't create folder $newfolder:". $@;
		return $errors;
	    }
	}
	
	$newimap->subscribe($newfolder);
    }
    #select folder for reading on old IMAP server
    unless($oldimap->examine($folder)) {
	$errors .= "Can't select folder $folder on old IMAP host: $@\n"; 
	return $errors;
    }
    
    #select folder for writing to the new IMAP server
    unless($newimap->select($newfolder)) {
	$errors .= "Can't select new folder $newfolder on new IMAP host: $@\n"; 
	return $errors;
    }
    
    # get a list of message ID numbers in the selected folder, 
    # and for each one get the text of the message and the read/unread
    # and other IMAP flags, and copy them to the new server 

    # don't copy messages that already exist on the new server
    my %newmessages;
    for my $msg ($newimap->search("ALL")) {
        $newmessages{ $newimap->get_header($msg,"Message-ID") } = 1;
    }

    for my $msg ($oldimap->search("ALL")) {

        if ( $msg < $user->{message}) {
            print "Skipping... $msg\n";
            next;
        }

        $user->{message} = $msg; #Keep track of the message number so we can save it to the status db and continue later.

	my $mid = $oldimap->get_header($msg,"Message-ID");
        if ( $newmessages{$mid} == 1 )  {
            print "Skipping $msg - $folder/$mid - already exists\n" if($verbose);
	    next;
	}

        my $msgsize = $oldimap->size($msg);
        if ($msgsize > $maxsize) {
             my $printable_maxsize = sprintf("%.1f", $maxsize / 1048576);
             print "Skipping $msg - $folder/$mid - Message size $msgsize exceeds maximum size limit of $printable_maxsize Mb\n";
             next;
        }

	my $msgtext = $oldimap->message_string($msg);
        print "Copying $msg - $folder/$mid. Size: $msgsize\n" if($verbose);	
	# fix exchange-server braindead non-RFC-compliant newlines
	# that gag other IMAP servers because there's no carriage-return 
	# character... <<WARNING>>:
	# set this option only if you dare... could possibly screw up
	# encoded data in attachments??? well... not if 7-bit ...maybe
	# this is the only code that alters message content which can
	# be a very touchy business. USE WITH CAUTION
	if ($fixnewlines == 1) {
	    $msgtext =~ s/([^\r])\n/$1\r\n/g;
	}
	
	my @flags = $oldimap->flags($msg);
	my $msgdate = $oldimap->internaldate($msg);
	my $flg = "";
	for (@flags) {
            if (lc($_) eq "\\recent") { next; }
            if (lc($_) eq "\\forwarded") { next; }
            if (lc($_) eq "\\x-eon-has-attachment") { next; }
	    $flg .= $_ . " ";    
	}
	chop($flg);
	
	$newimap->append_string($newfolder, $msgtext, $flg, $msgdate);
	undef $mid;
	undef $msgtext;
	undef @flags;
    }
    
    return '';
}








#--------------------------------------------------------------------------------
#----- Unified subroutines (cPanel or Plesk) ------------------------------------
#--------------------------------------------------------------------------------

# Read a file into an array.
# Input:  Filename to read
#         Reference to an array to read into.
# Output: Array is populated with contents of the file.
#         Return value is 1 on success, 0 on failure.
sub read_imap_file {
     my $filename = $_[0];
     my $userlist = $_[1];
     eval {                              #Read the mysql password.
          open (my $INFILE, $filename);
          while (<$INFILE>) {          
               $_ =~ s/\s*(\S+)\s+/$1 /g;
               chomp($_);
               my $user = MailUser->new();
               ($user->{srcuser}, $user->{srcpass}, $user->{dstuser}, $user->{dstpass}) = split(/\s/, $_);
               push (@{$userlist}, $user);
          }
          close $INFILE;
     } or do {
          return 0;   #Failure
     };
     return 1;        #Success
}

# Read a file into an array.
# Input:  Filename to read
#         Reference to an array to read into.
# Output: Array is populated with contents of the file.
#         Return value is 1 on success, 0 on failure.
sub read_rsync_file {
     my $filename = $_[0];
     my $userlist = $_[1];
     eval {                              #Read the mysql password.
          open (my $INFILE, $filename);
          while (<$INFILE>) {          
               $_ =~ s/\s*(\S+)\s+/$1 /g;
               chomp($_);
               my $user = RsyncUser->new();
               ($user->{srcuser}, $user->{filepath}, $user->{password}) = split(/\s/, $_);
               push (@{$userlist}, $user);
          }
          close $INFILE;
     } or do {
          return 0;   #Failure
     };
     return 1;        #Success
}


# Create an email address.
# Input:  Email address to create (i.e. info@somedomain.com)
#         Password for email account.  Optional.  If none is passed, then one will be generated.
# Output: 0 returned upon failure
#         The new email account password is returned upon success.
sub create_email {
     my $email_address = $_[0];
     my $password      = $_[1];
     if (is_cpanel()) {
          return cpanel_create_email($email_address, $password);
     }else {
          return plesk_create_email($email_address, $password);
     }
}

# Find out if an email address exists.
# Input:  Email address
# Output: 1 = exists
#         0 = Does not exist.
sub mailacct_exists {
     my $email_address = $_[0];
     if (is_cpanel()) {
          return cpanel_mailacct_exists($email_address);
     }else {
          return plesk_mailacct_exists($email_address);
     } 
}

# Check to see if a domain exists on Plesk.
# Input:  Domain Name
# Output: 0 = Domain does not exist.
#         1 = Domain exists.
sub domain_exists {
     my $domain = $_[0];
     if (is_cpanel()) {
          if (find_domain_owner($domain)) {
               return 1;                    #If a domain owner is found, then the domain exists.
          }
     }else {
          if (plesk_domain_exists($domain)) {
               return 1;
          }
     }
     return 0;
}

# Determine whether this is a cPanel server or a Plesk server.
# Input:  nothing
# Output: 1 = cPanel
#         0 = Plesk 
sub is_cpanel {
     if (-s "/etc/psa/.psa.shadow") {
          return 0;   # A key Plesk file is here, so it must not be cPanel.
     }
     return 1;
}

# Determine whether or not a password is encrypted.
# Input:  Password
# Output: 1=Encrypted
#         0=Not encrypted
sub password_encrypted {
     my $password = $_[0];
     if ($password =~ m/^\$[0-9]/) {
          return 1;
     }
     return 0;
}

#--------------------------------------------------------------------------------
#----------- cPanel Subroutines -------------------------------------------------
#--------------------------------------------------------------------------------


# Create an email account
# Input:  Email address to create (i.e. admin@somedomain.com)
#         Password for email account.  Optional.  If none is passed, then one will be generated.
# Output: 0 returned upon failure
#         The new email account password is returned upon success.
sub cpanel_create_email {
     my $email_address = $_[0];
     my $password      = $_[1];
     if (!$password) {
          $password    = cpanel_makepassword();
     }
     #todo: validate email address.
     my $email_user    =  $email_address;
     $email_user       =~ s/\@.*//;
     my $domain        =  $email_address;
     $domain           =~ s/.*\@//;
     my $cpuser        =  find_domain_owner($domain);
     if (!$cpuser) {
          print "The domain $domain does not appear to be on this server.  Failed to create the email address $email_address.\n";
          return 0;
     }
     my $apic;
     if ($token){
          $apic = cPanel::PublicAPI->new( ssl_verify_mode => '0', api_token => $token );
     }
     else{
          $apic = cPanel::PublicAPI->new( ssl_verify_mode => '0' );
     }
     my $response = $apic->cpanel_api2_request('whostmgr',
       { 'module' => 'Email', 'func' => 'addpop', },
       { 'user' => $cpuser, 'domain' => $domain, 'email' => $email_user,
         'password' => $password},
     );
     
     # $response is not consistent, so we have to see if part of it is an array before continuing.
     if (ref($response->{cpanelresult}->{data}) eq "ARRAY") {
          if (!$response->{cpanelresult}->{data}[0]->{result}) {
               print $response->{cpanelresult}->{data}[0]->{reason} . "\n";
               return 0;
          }
     }else {
          if (!$response->{cpanelresult}->{data}->{result}) {
               print $response->{cpanelresult}->{data}->{reason} . "\n";
               return 0;
          }
     }
     if (password_encrypted ($password)) {
          cpanel_update_email_password($email_address, $password);
     }
     return $password;
}

#Input:  Domain
#Output: Username of account that owns the domain.
sub find_domain_owner {
     my $domain  = $_[0];
     my $user;
     open (my $INFILE, "/etc/userdomains"); #Read /etc/userdomains which contains all domains and their associated usernames.
     my @userdomains = <$INFILE>;
     close $INFILE;
     foreach my $line (@userdomains) {      #Find the matching domain
          chomp($line);
          my $trydom = $line;
          $trydom =~ s/:.*//;
          if ($domain eq $trydom) {
               $user = $line;               #When we find the matching domain, set $user = the associated username.
               $user =~ s/.*: //;
               last;
          }
     }
     return $user;
}

#Make a 15 character random password starting with a letter.
# Input:  Nothing
# Output: The password string in the return value.
sub cpanel_makepassword {
     my $password;
     do {
          $password = Cpanel::PasswdStrength::Generate::generate_password(15);
     } while (!Cpanel::PasswdStrength::Check::check_password_strength('pw' => $password, 'app' => "passwd"));
     return $password;
}

# Example of checking for an email account using the API instead:
#   "xml-api/cpanel?user=mailmov&cpanel_xmlapi_module=Email&cpanel_xmlapi_func=listpops&cpanel_xmlapi_apiversion=2&regex=test2@mailmove.org"
# Find out if an email address exists on a cPanel server.
# Input:  Email address
# Output: Path to the email folder if it exists.
#         0 = Does not exist.
sub cpanel_mailacct_exists {
     my $email_address =  $_[0];
     my $domain        =  $email_address;
     $domain           =~ s/.*\@//;
     my $email_user    =  $email_address;
     $email_user       =~ s/\@.*//;
     my $cpuser        =  find_domain_owner($domain);
     if (!$cpuser) {
          return 0;       #If the domain doesn't exist, then neither does the email address.
     }
     if (-e "/home4/$cpuser/mail/$domain/$email_user") {
          return "/home4/$cpuser/mail/$domain/$email_user";
     }
     if (-e "/home3/$cpuser/mail/$domain/$email_user") {
          return "/home3/$cpuser/mail/$domain/$email_user";
     }
     if (-e "/home2/$cpuser/mail/$domain/$email_user") {
          return "/home2/$cpuser/mail/$domain/$email_user";
     }
     if (-e "/home1/$cpuser/mail/$domain/$email_user") {
          return "/home1/$cpuser/mail/$domain/$email_user";
     }
     if (-e "/home/$cpuser/mail/$domain/$email_user") {
          return "/home/$cpuser/mail/$domain/$email_user";
     }
     return 0;
}

sub cpanel_update_email_password {
     my $email_addr   =  $_[0];
     my $password     =  $_[1];
     my $email_user   =  $email_addr;
        $email_user   =~ s/\@.*//;
     my $email_domain =  $email_addr;
        $email_domain =~ s/.*\@//;
     my $shadow_file  =  cpanel_find_shadow_file($email_addr);
     # Tie the config file to the @lines array so we can modify the file the same way we mod an array.
     tie my @lines, 'Tie::File', $shadow_file or die "Failed to open $shadow_file\n";

     # Loop through each line of the file, looking for the lines to change.
     # Example line: test3:$1$OgEc4rUM$y6KYO0HDq9AXFdt6i9gTq0:15513::::::
     foreach my $line (@lines) {
          my $user_candidate = $line;
          $user_candidate =~ s/:.*//;
          if ($user_candidate eq $email_user) {
               $line =~ m/([^:]+):[^:]+:(.*)/; #Capture the parts before and after the password to prepare for password replacement.
               $line =  "$1:$password:$2";     #Replace the password.
               last;                           #We found and replaced what we're looking for, so no need to continue looping.
          }
     }
     untie @lines;
}

# Find the shadow file that contains the password for an email account.
sub cpanel_find_shadow_file {
     my $email_addr   =  $_[0];
     my $email_domain =  $email_addr;
        $email_domain =~ s/.*\@//;
     my $cpuser       =  find_domain_owner($email_domain);
     my $apic;
     if ($token){
          $apic = cPanel::PublicAPI->new( ssl_verify_mode => '0', api_token => $token );
     }
     else{
          $apic = cPanel::PublicAPI->new( ssl_verify_mode => '0' );
     }
     my $response = $apic->whm_api('accountsummary',{'user' => $cpuser});
     if (!$response) {
          print "Error finding the shadow file for the email address: $email_addr\n";
          return undef;
     }
     my $partition = $response->{acct}[0]->{partition};
     if (!$partition) {
          print "Error finding the shadow file for the email address: $email_addr.  " . $response->{statusmsg} . "\n";
     }
     my $shadow = "/" . $partition . "/" . $cpuser . "/etc/" . $email_domain . "/shadow";
     return $shadow;
}



#--------------------------------------------------------------
#--------- Plesk Subroutines ----------------------------------
#--------------------------------------------------------------


# Find out if an email address exists on a Plesk server.
# Input:  Email address
# Output: Path to the email folder if it exists.
#         0 = Does not exist. 
sub plesk_mailacct_exists {
     my $email_address =  $_[0];
     my $domain        =  $email_address;
     $domain           =~ s/.*\@//;
     my $email_user    =  $email_address;
     $email_user       =~ s/\@.*//;
     if (-e "/var/qmail/mailnames/$domain/$email_user/Maildir") {
          return "/var/qmail/mailnames/$domain/$email_user/Maildir";
     }
     return 0; 
}

# Create an email account in Plesk.
# Input:  Email address to create (i.e. admin@somedomain.com)
#         Password for email account.  Optional.  If none is passed, then one will be generated.
# Output: 0 returned upon failure
#         The new email account password is returned upon success.
sub plesk_create_email {
     my $email_address = $_[0];
     my $password      = $_[1];
     if (!$password) {
          $password    = makepassword(15);
     }
     #todo: validate email address.
     my $ret           =  0;
     my $email_user    =  $email_address;
        $email_user    =~ s/\@.*//;
     my $domain        =  $email_address;
        $domain        =~ s/.*\@//;
     my $cpuser        =  find_domain_owner($domain);
     my $crypt_pw;
     if (password_encrypted($password)) {  #Make sure the password is encrypted.
          $crypt_pw = $password;
     }else {
          $crypt_pw = cryptpassword($password);
     }
     my @output = `/usr/local/psa/bin/mail -c $email_user\@$domain -passwd '$crypt_pw' -passwd_type encrypted -mailbox true 2>&1`;
     foreach my $out (@output) { #Print the output from the external call.
          print $out . "\n";
     }
     if (($? >> 8) > 0) {     #Check the return code, and exit if the external call failed.
          print "Error creating email account: $ret\n";
          return 0;
     }
     return $password;
}

# Create a password that can be used as an email password.
# Input:  Length of the desired password.
# Output: The password.
sub makepassword {
     my $pwlength = $_[0];
     my $alphachars = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ";
     my $chars = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ";
     my $x = 0;
     my $pass = substr($alphachars,rand(length($alphachars)),1); #Make the password start with a non-numeric character.
     for ($x = 0; $x < $pwlength-1; $x=$x+1) {                       #Then add 14 more alphanumeric characters.
          $pass = $pass . substr($chars,rand(length($chars)),1);
     }
     return $pass;
}


sub cryptpassword {
     my $plaintext_password = $_[0];
     my $salt = makepassword(9);
     $salt = substr($salt,1);    #Chop off 1st chr (which is alpha only), leaving us with an 8 chr alphpnumeric string.
     my $cryptedpassword = unix_md5_crypt($plaintext_password, $salt);
     return $cryptedpassword;
}


# Check to see if a domain exists on Plesk.
# Input:  Domain Name
# Output: 0 = Domain does not exist.
#         1 = Domain exists.
sub plesk_domain_exists {
     my $domain = $_[0];
     my $mysqlpass;
     eval {                                           #Read the mysql password.
          open (my $INFILE, "/etc/psa/.psa.shadow");
          $mysqlpass = <$INFILE>;                     #Sluuuuurp
          close $INFILE;
     } or do {
          logg("Error reading the MySQL password from /etc/psa/.psa.shadow");
          return 1;
     };
     chomp($mysqlpass);
     my $psadomtest = `mysql -ss -u'admin' -p'$mysqlpass' -e"select name from domains where name = '$domain';" psa`;
     chomp($psadomtest);
     $psadomtest = lc($psadomtest); #Convert both strings to lower case for a case-insensitive comparison.
     $domain     = lc($domain);
     if ($psadomtest eq $domain) { #If the domain in the psa database matches our test domain, then
          return 1;                # return an affirmative.
     }
     return 0; #Domain is not on the server.
}

#--------------------------------------------------------------
#--------- Miscellaneous Subroutines --------------------------
#--------------------------------------------------------------

sub show_usage {
my $usage = <<END;
Usage: mvmail remote_host userlistfile [--ssl] [--bind-address=ip] [--desthost=host/ip]     (Perform an IMAP email transfer from a remote host)
       By default, an IMAP transfer is done.

              --pop3             - Perform a POP3 transfer instead of IMAP.
              --ssl              - Use IMAPS on port 993 (or POP3S on port 995) instead of the default IMAP on port 143.
              --bind-address     - Specify a local IP address to bind to.
              --desthost         - Specify a destination host to transfer to (when running script on a 3rd party machine).
              --noprompt         - Don't promt.  Assume all answers are yes. (use with caution).
              --test             - Test the email logins at the old host (for use with pop3 and imap transfers).  Also lists folders and message counts.
              --maxsize=size     - Maximum message size (in megabytes) to transfer.  Messages that exceed maxsize will be skipped with a warning. 
              userlistfile should be in the form:
              user\@fromdomain.com frompassword user\@todomain.com topassword
or
       mvmail --dirs userlistfile                    (List directories for a list of email addresses.)
              userlistfile should be in the form:
              user\@domain.com
or
       mvmail --rsync-pull remote_host userlistfile. (Print rsync commands to pull email from a remote source server)
              userlistfile should be in the form:
              user\@domain.com /remote/path/to/maildir [optional password]
or
       mvmail --rsync-push remote_host userlistfile. (Print rsync commands to push email to a remote destination server)
              userlistfile should be in the form:
              user\@domain.com /remote/path/to/maildir
or
       mvmail --ssync-pull remote_host userlistfile. (Print rsync commands to push email to a remote destination server)
              userlistfile should be in the form:
              user\@domain.com /remote/path/to/maildir [optional password]
or
       mvmail --ssync-push remote_host userlistfile. (Print rsync commands to push email to a remote destination server)
              userlistfile should be in the form:
              user\@domain.com /remote/path/to/maildir
END

     print $usage . "\n";
}

# Find out the primary IP address of this server.
# Input:  Nothing
# Output: IP address
#         or "" if there was a problem.
sub find_primary_ip {
     my $ip = `hostname -i`;
     chomp($ip);
     if (valid_ip($ip)) {
          return $ip;
     }
     return "";
}

sub valid_ip {
     my $ip = $_[0];
     if ($ip =~ m/^([1-9]|[1-9][0-9]|1[0-9][0-9]|2[0-4][0-9]|25[0-5])(\.([0-9]|[1-9][0-9]|1[0-9][0-9]|2[0-4][0-9]|25[0-5])){3}$/) {
          return 1; # Valid IP
     }
     return 0;      # Invalid IP
}

#--------------------------------------------------------------------------------------------------
#---------------------------------- Status database Subroutines -----------------------------------
#--------------------------------------------------------------------------------------------------


# Initialize the database file.
# Input:  Filename of the mvmaillist file.
#         Global variable $statdb
# Output: 0=Fail
#         1=Successfully initialized.
#         $mvmaillist is populated with a reference to the DBI object.
sub init_status_database {
     my $mvmaillist = shift;
     $mvmaillist .= ".status";
     if (-s $mvmaillist) { # If the database exists, then just open it.
          $statdb = DBI->connect("dbi:SQLite:dbname=$mvmaillist", "", "");
          return 1;
     }
     eval { # If the database did not exist, then open a new one and create the status table.
          $statdb = DBI->connect("dbi:SQLite:dbname=$mvmaillist", "", "");
          $statdb->do("CREATE TABLE IF NOT EXISTS status (email_address TEXT, current_folder TEXT, current_message INTEGER, done INTEGER DEFAULT 0)");
     } or do {
          print STDERR "Error opening the status file: $mvmaillist";
          return 0;
     };
     return 1;
}

# Read the migration status for all of the users.
# Note: The migration status and the login status are two different things:
#       The migration status read here is the current folder and message the transfer is at for a given MailUser obj.
#         (MailUser->{folder} and MailUser->{message})
#       The login status is shown in MailUser->{srcstatus} and MailUser->{dststatus}.
#
# Input:  Reference to an array of MailUser objects.
#         Global database handle $statdb
# Output: Update the array of MailUser objects with the migration status.
sub read_status_database {
     my $userlist   = shift;

     my $sql = "select email_address, current_folder, current_message, done from status";
     my $sth = $statdb->prepare($sql);
     if (! $sth) {
          print STDERR "Failed to prepare the select statement while loading the transfer state from the database.\n";
          return 0; #Could not execute the statement.
     }
     if (! $sth->execute()) {
          print STDERR "Failed to execute the select statement while loading the transfer state from the database.\n";
          return 0; #Could not execute the statement.
     }
     while (my @row = $sth->fetchrow_array()) {
          if (scalar(@row) != 4) {
               print STDERR "Failed to execute the select statement while loading the transfer state from the database.\n";
               return 0; #Could not execute the statement.
          }
          my $email  = $row[0];
          my $folder = $row[1];
          my $curmsg = $row[2];
          my $done   = $row[3];
          foreach my $user (@{$userlist}) { #Look for the user that matches this database record.
               next if($user->{srcuser} eq "" || $user->{status} ne "ok");
               if ($user->{srcuser} eq $email) {
                    $user->{folder}  = $folder;
                    $user->{message} = $curmsg;
                    $user->{done}    = $done;
               }
          }
     }
}

sub write_status_database {
     my $userlist   = shift;
     my $sql;
     my $sth;
     $sth = $statdb->prepare("DELETE FROM 'status'");
     if (!$sth->execute()) {
          print STDERR "Error clearing the status table while saving the email transfer state.  $DBI::errstr\n";
          return 0;
     }
     foreach my $user (@{$userlist}) {
          $sql  = "INSERT INTO 'status' (email_address, current_folder, current_message, done) values(?, ?, ?, ?)";
          $sth = $statdb->prepare($sql);
          if (!$sth->execute($user->{srcuser}, $user->{folder}, $user->{message}, $user->{done})) {
               print STDERR "Error saving transfer state: $DBI::errstr\n";
               return 0;
          }
     }
     return 1;  #No problems detected.
}