#!/usr/bin/perl
#use Net::IMAP::Simple;
#use ./Simple;
use Getopt::Long; 

$exec="imapfoldermanager";
$VERSION='1.3';

 Getopt::Long::Configure ("bundling");  

$ARGC=$#ARGV + 1;

if (($ARGC)<1)
{
	print_usage(0);
	exit;
}

sub print_usage
  {
    my ($examples)=@_;

if ($examples==0)
{

    print << "__END_OF_USAGE__";

************************ Copy[left|right] information ************************

This is imapfoldermanager v$VERSION by Simone Caldana <simone\@caldana.org>
THIS SOFTWARE COMES WITH ABSOLUTELY NO WARRANTY! USE AT YOUR OWN RISK!
This software is published under the GNU Public License.
This software uses a bundled modified version of Net::IMAP::Simple created
by Joao Fonseca. Check at the end of the script for his information.

*****************************************************************************

This script applies the specified operation(s) over a set of IMAP users.
 
For options and more try 
$exec -h
or
$exec --help 

__END_OF_USAGE__
}

if ($examples>=1)
{
    print << "__END_OF_OPTIONS__";                                                                      
Usage:
 
  $exec [<options>] [arg1] [arg2] < {user password list}
 
Where {user password list} (taken from STDIN) is any number of rows in the
form:
 
username password
 
or simply, but only if proxy authentication is enabled:
 
username

Possible options:
 
  -h or --help             shows this help message 
                           used twice shows some notes and examples
  -v or --verbose          be verbose in output (twice for debug)
  -V or --version          show version number

  -S or --server           specifies the IMAP server name
  -P or --port             specifies the IMAP server port

  -f ot --from             specifies the FROM folder
  -t ot --to               specifies the TO folder

  -d or --delete           deletes the FROM folder 
  -c or --create           creates the TO folder 
  -r or --rename           renames FROM folder using TO folder name
  -m or --movemsgs         moves all the messages from FROM folder 
                           to TO folder
  -p or --copymsgs         copies all the messages from FROM folder 
                           to TO folder
  -o or --emptyfolder      deletes all the messages in FROM folder

  -b or --subscribe        subscribes to the TO folder

  -n or --count            counts messages in FROM folder
  -l or --listfolders      list all the user folders
  -k or --lsubfolders      list the user subscribed folders

  -e or --expunge          expunges deleted messages by -m or -o

  -u or --proxyauthuser    specifies proxy user name
  -w or --proxyauthpass    specifies proxy user password
  -x or --proxyauthenable  enables proxy authentication 

__END_OF_OPTIONS__

}

if ($examples>=2)
{

    print << "__END_OF_EXAMPLES__";

Notes:

For lazy users, it also possible to omit -f and -t. If so, the remaining
arguments will be parsed and assigned in order to the missing -f and/or -t
parameter. Handle with care: I suggest to use of -f and -t.
 
(ghost unimplemented options are available, use the (horrible[1]) Source!)

WARNING: proxy authentication is not standard as for RFC2060 and as far as I 
         know is implemented only by Netscape Messaging Server (AKA iPlanet) 
         and Critical Path Messaging Server (aka IMS or NPLEX)
 
[1] yes, this my very first perl script, but as a proof of funcionality I used
    it on a production server and it worked just fine :)

Examples: 

  To list every user folders:
      $exec -vl 
      
  To count messages in a folder:
      $exec -vn -f <foldername>

  To move messages from a folder to another:
      $exec -vm -f <fromfolder> <tofolder>

  To move messages from a folder to a new non-existent one and delete the
  first folder:
      $exec -vcdm -f <fromfolder> -t <newfolder>

  To move messages from a folder to a new non-existent one and delete the
  first folder, subscribing to the new one:
      $exec -vcdmb -f <fromfolder> -t <newfolder>

__END_OF_EXAMPLES__
}

}


$opt_help=''; # -h
$opt_server=''; # -S
$opt_port=143; # -P
$opt_delete=0;  # -d
$opt_movemsgs=0; # -m
$opt_copymsgs=0; # -p
$opt_rename=0; # -r
$opt_count=0; # -n
$opt_create=0; # -c
$opt_subscribe=0; # -b
$opt_listfolders=0; # -l
$opt_lsubfolders=0; # -k
$opt_expunge=0; # -e
$opt_emptyfolder=0; # -o
$opt_synchronous=0; # -y
$opt_from=''; # -f
$opt_to=''; # -t
$opt_simulation=0; # -s
$opt_verbose=0; # -v
$opt_version=0; # -V
$opt_proxyauthuser=0; # -u user
$opt_proxyauthpass=0; # -w password
$opt_proxyauthenable=0; # -x

$opt_arg1='';
$opt_arg2='';


$user='';
$password='';
$proxyuser='';
$proxypass='';

GetOptions('h|help+'=>\$opt_help,'S|server=s' => \$opt_server,'P|port=i'=>\$opt_port,'x|proxyauthenable' => \$opt_proxyauthenable,'u|proxyauthuser=s'=>\$opt_proxyauthuser,'w|proxyauthpass=s'=>\$opt_proxyauthpass,'s|synchronous'=>\$opt_synchronous,'o|emptyfolder'=>\$opt_emptyfolder,'e|expunge'=>\$opt_expunge,'p|copymsgs' => \$opt_copymsgs,'l|listfolders'=>\$opt_listfolders,'k|lsubolders'=>\$opt_lsubfolders,'c|create'=>\$opt_create,'b|subscribe'=>\$opt_subscribe,'d|delete'=>\$opt_delete,'m|movemsgs'=>\$opt_movemsgs,'r|rename'=>\$opt_rename,'n|num'=>\$opt_count,'f|from=s'=>\$opt_from,'t|to=s'=>\$opt_to,'s|simulation'=>\$opt_simulation,'v|verbose+'=>\$opt_verbose,'V|version'=>\$opt_version);

if ($opt_help)
{
	print_usage($opt_help);
	exit;
}

if ($opt_version)
{
	print "$exec v$VERSION by Simone Caldana\n";
	exit;
}

#fallback from lazy users who do not use -f and/or -t
$opt_arg1=$ARGV[0];
$opt_arg2=$ARGV[1];
if ($opt_from eq '') {$opt_from=$opt_arg1;}
if ($opt_to eq '') {$opt_to=$opt_arg2;}
#end fallback

if ($opt_server eq ''){ die "Server name required \n";}
if ($opt_delete and $opt_from eq '') { die "Folder name (-f) needed for deletion\n"; }
if ($opt_create and $opt_to eq ''){ die "Target folder name (-t) needed for creation\n";}
if ($opt_subscribe and $opt_to eq ''){ die "Target folder name (-t) needed for subscription\n";}
if ($opt_movemsgs and ($opt_from eq '' or $opt_to eq '')){ die "From (-f) and To (-t) needed for movemsgs\n";}
if ($opt_copymsgs and ($opt_from eq '' or $opt_to eq '')){ die "From (-f) and To (-t) needed for copymsgs\n";}
if ($opt_rename and ($opt_from eq '' or $opt_to eq '')){ die "From (-f) and To (-t) needed for renaming\n";}
if ($opt_count and $opt_from eq ''){ die "Folder name (-f) needed for counting\n";}
if (($opt_movemsgs + $opt_copymsgs + $opt_emptyfolder)>1){ die "Use either movemsgs or copymsgs or emptyfolder\n";}
if ($opt_create and $opt_rename ){ die "Use either create or rename\n";}
if ($opt_simulation) {die print "Simulation mode not supported\n";}
if ($opt_synchronous) {die print "Synchronous mode not supported\n";}
#print "$opt_proxyauthenable and ($opt_proxyauthuser xor $opt_proxyauthpass\n";
if ($opt_proxyauthenable and ($opt_proxyauthuser xor $opt_proxyauthpass)) { die "Specify neither proxyauthuser nor proxyauthpass or both\n";}

print "server=$opt_server\nport=$opt_port\nfrom=$opt_from\nto=$opt_to\ndelete=$opt_delete\nmcopymsgs=$opt_copymsgs\nmovemsgs=$opt_movemsgs\nrename=$opt_rename\ncount=$opt_count\ncreate=$opt_create\nlistfolders=$opt_listfolders\nemptyfolder=$opt_emptyfolder\nexpunge=$opt_expunge\nproxyauthenable=$opt_proxyauthenable\nproxyauthuser=$opt_proxyauthuser\nproxyauthpass=$opt_proxyauthpass\nsynchronous=$opt_synchronous\nsimulation=$opt_simulation\nverbose=$opt_verbose\nversion=$opt_version\n" if ($opt_verbose>=2);

while (<STDIN>)
{
	$user='';
	$pass='';
	($user,$pass)=split(' ');


		print "Creating server object ($opt_server:$opt_port)\n" if ($opt_verbose);
           $server = new Net::IMAP::Simple( $opt_server, $opt_port );
 
           # login
	if ($opt_proxyauthenable==1)	
	{
	   print "Loggin in as $user using $opt_proxyauthuser as proxy\n" if ($opt_verbose);
           $server->proxylogin ($opt_proxyauthuser, $opt_proxyauthpass, $user );
	}
	else
	{
		
	   print "Loggin in as $user\n" if ($opt_verbose);
           $server->login ($user, $pass );

	}

 SWITCH: {
	 $opt_listfolders==1	    && do {
           			@folders = $server->mailboxes();                                                                      
				print "Listing folders\n" if ($opt_verbose); 
                		foreach $foldernum ( 0..$#folders )
                		{
				 	print "$folders[$foldernum]\n";
				}

		       };
         $opt_lsubfolders==1        && do {
                                @folders = $server->submailboxes();
                                print "Listing subscribed folders\n" if ($opt_verbose);
                                foreach $foldernum ( 0..$#folders )
                                {
                                        print "$folders[$foldernum]\n";
                                }

                       };
	 $opt_create==1	    && do {
				print "Creating folder \"$opt_to\"\n" if ($opt_verbose); 
				$msgs = $server->create_mailbox( $opt_to );
		       };
	 $opt_count==1	    && do {
				print "Counting folder \"$opt_from\"\n" if ($opt_verbose); 
				$msgs = $server->select( $opt_from );
				if ($msgs eq '') {$msgs=-1;}
				print "$user(\"$opt_from\"): $msgs\n";
		       };
	 $opt_create==0 and $opt_rename==1	    && do {
				print "Renaming folder \"$opt_from\" to \"$opt_to\"\n" if ($opt_verbose); 
 				$server->rename_mailbox( $opt_from, $opt_to );           

				last SWITCH;
		       };
	 ($opt_movemsgs==1 or $opt_copymsgs==1 or $opt_emptyfolder)	    && do {
				print "Moving messages from folder \"$opt_from\" to folder \"$opt_to\"\n" if ($opt_verbose and $opt_movemsgs); 
				print "Copying messages from folder \"$opt_from\" to folder \"$opt_to\"\n" if ($opt_verbose and $opt_copymsgs); 
				print "Emptying folder \"$opt_from\"\n" if ($opt_verbose and $opt_emptyfolder); 
				$msgs = $server->select( $opt_from );
				if ($msgs eq '') {$msgs=0;}       
	           		foreach $msg ( 1..$msgs ) {
					if ($opt_copymsgs or $opt_movemsgs) { $server->copy($msg, $opt_to );}
					if ($opt_movemsgs or $opt_emptyfolder) { $server->flagasdeleted( $msg);}
				}

				if ($opt_verbose)
				{
					if ($opt_emptyfolder)
					{
						$str="Deleted";	
					}
					else
					{
						if ($opt_movemsgs)
						{
							$str="Moved";
						}
						else
						{
							if ($opt_copymsgs)
							{
								$str="Copied";
							}
						}
					}
					print "$str $msgs messages\n"; 
				}
           		};
	 $opt_subscribe==1	    && do {
				print "Subscribing folder \"$opt_to\"\n" if ($opt_verbose); 
				$msgs = $server->subscribe_mailbox( $opt_to );
		       };

	 $opt_delete==1	    && do {
				print "Deleting folder \"$opt_from\"\n" if ($opt_verbose); 

				$server->delete_mailbox( $opt_from );                                                              


			    last SWITCH;
		       };

	$nothing = 1;
    }  

	if ($opt_expunge==1) {
		print "Expunging\n" if ($opt_verbose); 

		$server->expunge();
	}         

	$server->quit();                  

}

#################################################
#################################################

#Here is the bundled version of Net::IMAP::Simple

#################################################
#################################################

package Net::IMAP::Simple;

use strict;
use vars qw($VERSION);

$VERSION = '0.93';



use IO::Socket;
use IO::File;






#############################################################################
#
#
#
#############################################################################

sub new {
    my ( $class, $server, $port , %options ) = @_;
    my ( $self );

    if ( ref( $class ) ) {
        $class = ref( $class );
    }

    $self = { %options };
    $self->{count} = 0;
    $self->{sock} = new IO::Socket::INET( "$server:$port" )
        or return;
	
    $self->{sock}->getline();

    bless $self, $class;
    return $self;
}





#############################################################################
#
#
#
#############################################################################

sub _nextid {
    my ( $self ) = @_;

    return $self->{count}++;
}





#############################################################################
#
#
#
#############################################################################

sub _escape {
    my ( $str ) = @_;

    $str =~ s/\\/\\\\/g;
    $str =~ s/\"/\\\"/g;
    $str = "\"$str\"";

    return $str;

}





#############################################################################
#
#
#
#############################################################################

sub _unescape {
    my ( $str ) = @_;

    $str =~ s/^"//g;
    $str =~ s/"$//g;
    $str =~ s/\\\"/\"/g;
    $str =~ s/\\\\/\\/g;

    return $str;

}


 
 
#############################################################################
#
#
#
#############################################################################
 
sub proxylogin {
    my ( $self, $user, $pass, $realuser ) = @_;
    my ( $gu, $sh, $id, $resp );
 
    $sh = $self->{sock};
    $id = $self->_nextid();
	#print "loggin in..."; 
    print $sh "$id LOGIN $user $pass\r\n";
    $self->_waitresponseforid($id);
	#print "logged\nproxying...";
    print $sh "$id PROXYAUTH $realuser\r\n";
    $gu=$self->_waitresponseforid($id);
	#print "proxed\n";

    return $gu;
 
}



#############################################################################
#
#
#
#############################################################################

sub login {
    my ( $self, $user, $pass ) = @_;
    my ( $gu, $sh, $id, $resp );

    $sh = $self->{sock};
    $id = $self->_nextid();
    
    print $sh "$id LOGIN $user $pass\r\n";
    $gu= $self->_waitresponseforid($id);


    return $gu;

}





#############################################################################
#
#
#
#############################################################################

sub select {
    my ( $self, $mbox ) = @_;
    my ( $sh, $id, $resp, $nmsg );

    $sh = $self->{sock};
    $id = $self->_nextid();

    $mbox = _escape( $mbox );
    
    print $sh "$id SELECT $mbox\r\n";
    while ( $resp = $sh->getline() ) {
        if ( $resp =~ /^\*\s+(\d+)\s+EXISTS/i ) {
            $nmsg = $1;
        } elsif ( $resp =~ /^$id\s+(OK|NO|BAD)/i ) {
            last;
        }
    }

    if ( defined $nmsg && $resp =~ /$id\s+OK/i ) {
        $self->{last} = $nmsg;
        return $nmsg;
    }

    return;
}





#############################################################################
#
#
#
#############################################################################

sub top {
    my ( $self, $msgn ) = @_;
    my ( $sh, $id, $resp, $lines );

    $sh = $self->{sock};
    $id = $self->_nextid();
    
    print $sh "$id FETCH $msgn rfc822.header\r\n";

    while ( $resp = $sh->getline() ) {
        if ( $resp =~ /^\*/ ) {
            next;
        }
        if ( $resp =~ /^$id\s+(OK|NO|BAD)/i ) {
            last;
        }
        push @$lines, $resp;
    }

    if ( $resp =~ /$id\s+OK/i ) {
        pop @$lines;
        return $lines;
    }

    return;

}





#############################################################################
#
#
#
#############################################################################

sub seen {
    my ( $self, $msgn ) = @_;
    my ( $sh, $id, $resp, $lines );

    $sh = $self->{sock};
    $id = $self->_nextid();
    
    print $sh "$id FETCH $msgn (FLAGS)\r\n";

    while ( $resp = $sh->getline() ) {
        if ( $resp =~ /^$id\s+(OK|NO|BAD)/i ) {
            last;
        }
        $lines .= $resp;
    }

    if ( $resp =~ /$id\s+OK/i ) {
        return $lines =~ /\\Seen/i;
    }

    return;

}





#############################################################################
#
#
#
#############################################################################

sub list {
    my ( $self, $msgn ) = @_;
    my ( $sh, $id, $resp, $hash );

    $sh = $self->{sock};
    $id = $self->_nextid();

    if ( defined $msgn ) {
        print $sh "$id FETCH $msgn RFC822.SIZE\r\n";
    } else {
        print $sh "$id FETCH 1:$self->{last} RFC822.SIZE\r\n";
    }

    while ( $resp = $sh->getline() ) {
        if ( $resp =~ /^\*\s+(\d+).*RFC822.SIZE\s+(\d+)/i ) {
            $hash->{$1} = $2;
            next;
        }
        if ( $resp =~ /^$id\s+(OK|NO|BAD)/i ) {
            last;
        }
    }
    
    if ( $resp =~ /$id\s+OK/i ) {
        if ( defined $msgn ) {
            return $hash->{$msgn};
        } else {
            return $hash;
        }
    }

    return;
}





#############################################################################
#
#
#
#############################################################################

sub get {
    my ( $self, $msgn ) = @_;
    my ( $sh, $id, $resp, $lines );

    $sh = $self->{sock};
    $id = $self->_nextid();
    
    print $sh "$id FETCH $msgn rfc822\r\n";

    while ( $resp = $sh->getline() ) {
        if ( $resp =~ /^\*/ ) {
            next;
        }
        if ( $resp =~ /^$id\s+(OK|NO|BAD)/i ) {
            last;
        }
        push @$lines, $resp;
    }

    if ( $resp =~ /$id\s+OK/i ) {
        pop @$lines;
        return $lines;
    }

    return;

}





#############################################################################
#
#
#
#############################################################################

sub getfh {
    my ( $self, $msgn ) = @_;
    my ( $sh, $id, $resp, $buffer, $fh );

    $fh = IO::File->new_tmpfile()
        or return;

    $sh = $self->{sock};
    $id = $self->_nextid();
    
    print $sh "$id FETCH $msgn rfc822\r\n";

    while ( $resp = $sh->getline() ) {

        if ( $resp =~ /^\*/ ) {
            next;
        }
        if ( $resp =~ /^$id\s+(OK|NO|BAD)/i ) {
            last;
        }

        print $fh $buffer if ( defined $buffer );
        $buffer = $resp;
    }

    if ( $resp =~ /$id\s+OK/i ) {
        seek $fh, 0, 0;
        return $fh;
    }

    $fh->close();
    return;

}





#############################################################################
#
#
#
#############################################################################

sub quit {
    my ( $self ) = @_;
    my ( $sh, $id );

    $sh = $self->{sock};
#    $id = $self->_nextid();
#    print $sh "$id EXPUNGE\r\n";

    $id = $self->_nextid();
    print $sh "$id LOGOUT\r\n";
    <$sh>;
    close $sh;

    return 1;
}    





#############################################################################
#
#
#
#############################################################################

sub last {
    my ( $self ) = @_;

    return $self->{last};

}





#############################################################################
#
#
#
#############################################################################

sub delete {
    my ( $self, $msgn ) = @_;
    my ( $sh, $id, $resp );

    $sh = $self->{sock};
    $id = $self->_nextid();

    print $sh "$id STORE $msgn +FLAGS (\\Deleted)\r\n";
    while ( ( $resp = $sh->getline() ) && $resp !~ /^$id\s+(OK|NO|BAD)/i ) {
        next;
    }
    if ( $resp =~ /^$id\s+OK/i ) {
        return 1;
    }
        
    return;

}





#############################################################################
#
#
#
#############################################################################

sub mailboxes {
    my ( $self ) = @_;
    my ( $sh, $id, $resp, @list );

    $sh = $self->{sock};
    $id = $self->_nextid();

    print $sh "$id LIST \"\" *\r\n";
    while ( $resp = $sh->getline() ) {
        if ( $resp =~ /^\*\s+LIST.*\s+\{\d+\}\s*$/i ) {
            $resp = $sh->getline();
            chomp( $resp );
            $resp =~ s/\r$//;
            push @list, _escape( $resp );
        } elsif ( $resp =~ /^\*\s+LIST.*\s+(\".*?\")\s*$/i ) {
            push @list, $1;
        } elsif ( $resp =~ /^\*\s+LIST.*\s+(\S+)\s*$/i ) {
            push @list, $1;
        } elsif ( $resp =~ /^$id\s+(OK|NO|BAD)/i ) {
            last;
        }
    }

    if ( $resp =~ /^$id\s+OK/i ) {
        map { $_ = _unescape( $_ ) } @list;

#        map { s/\\\"/\"/g } @list;
#        map { s/^\"// } @list;
#        map { s/\"$// } @list;
        return @list;
    }

    return;
}

sub submailboxes {
    my ( $self ) = @_;
    my ( $sh, $id, $resp, @list );

    $sh = $self->{sock};
    $id = $self->_nextid();

    print $sh "$id LSUB \"\" *\r\n";
    while ( $resp = $sh->getline() ) {
        if ( $resp =~ /^\*\s+LIST.*\s+\{\d+\}\s*$/i ) {
            $resp = $sh->getline();
            chomp( $resp );
            $resp =~ s/\r$//;
            push @list, _escape( $resp );
        } elsif ( $resp =~ /^\*\s+LSUB.*\s+(\".*?\")\s*$/i ) {
            push @list, $1;
        } elsif ( $resp =~ /^\*\s+LSUB.*\s+(\S+)\s*$/i ) {
            push @list, $1;
        } elsif ( $resp =~ /^$id\s+(OK|NO|BAD)/i ) {
            last;
        }
    }

    if ( $resp =~ /^$id\s+OK/i ) {
        map { $_ = _unescape( $_ ) } @list;

#        map { s/\\\"/\"/g } @list;
#        map { s/^\"// } @list;
#        map { s/\"$// } @list;
        return @list;
    }

    return;
}





#############################################################################
#
#
#
#############################################################################

sub create_mailbox {
    my ( $self, $mbox_name ) = @_;
    my ( $sh, $id, $resp, @list );

    $sh = $self->{sock};
    $id = $self->_nextid();

    $mbox_name = _escape( $mbox_name );

    print $sh "$id CREATE $mbox_name\r\n";
    return $self->_waitresponseforid($id);

}





#############################################################################
#
#
#
#############################################################################

sub delete_mailbox {
    my ( $self, $mbox_name ) = @_;
    my ( $sh, $id, $resp, @list );

    $sh = $self->{sock};
    $id = $self->_nextid();

    $mbox_name = _escape( $mbox_name );

    print $sh "$id DELETE $mbox_name\r\n";
    return $self->_waitresponseforid($id);
}


#############################################################################
#
#
#
#############################################################################

sub subscribe_mailbox {
    my ( $self, $mbox_name ) = @_;
    my ( $sh, $id, $resp, @list );

    $sh = $self->{sock};
    $id = $self->_nextid();

    $mbox_name = _escape( $mbox_name );

    print $sh "$id SUBSCRIBE $mbox_name\r\n";
    return $self->_waitresponseforid($id);
}



#############################################################################
#
#
#
#############################################################################

sub rename_mailbox {
    my ( $self, $mbox_name, $new_name ) = @_;
    my ( $sh, $id, $resp, @list );

    $sh = $self->{sock};
    $id = $self->_nextid();

    $mbox_name = _escape( $mbox_name );
    $new_name = _escape( $new_name );

    print $sh "$id RENAME $mbox_name $new_name\r\n";
    return $self->_waitresponseforid($id);
}


#############################################################################
#
#
#
#############################################################################
 
sub _waitresponseforid {
    my ( $self, $id ) = @_;
    my ( $sh, $resp, $exit);
    $sh = $self->{sock};
#print "waiting for response\n";
    while ( $resp = $sh->getline() ) {
#	 print "# $resp\n";
        if ( $resp =~ /^$id\s+(OK|NO|BAD)/i ) {
            last;
        }
    }
	return 1;
}


#############################################################################
#
#
#
#############################################################################

sub copy {
    my ( $self, $msgn, $mbox_name ) = @_;
    my ( $sh, $id, $resp, @list );
#print "$self";
    $sh = $self->{sock};
    $id = $self->_nextid();

    $mbox_name = _escape( $mbox_name );

    print $sh "$id COPY $msgn $mbox_name\r\n";
    #print "$id COPY $msgn $mbox_name\n";

    return $self->_waitresponseforid($id);
}

#############################################################################
#
#
#
#############################################################################
 
sub flagasdeleted {
    my ( $self, $msgn ) = @_;
    my ( $sh, $id, $resp, @list );
 
    $sh = $self->{sock};
    $id = $self->_nextid();
 
 
    print $sh "$id STORE $msgn +FLAGS (\\Deleted)\r\n";
    return $self->_waitresponseforid($id);
}

#############################################################################
#
#
#
#############################################################################
 
sub expunge {
    my ( $self) = @_;
    my ( $sh, $id, $resp, @list );
    $sh = $self->{sock};
    $id = $self->_nextid();
 
    print $sh "$id EXPUNGE\r\n";

    return $self->_waitresponseforid($id);

}




1;
__END__





=head1 NAME

Net::IMAP::Simple - Perl extension for simple IMAP account handling, mostly 
compatible with Net::POP3.

=head1 SYNOPSIS

    use Net::IMAP::Simple;

    # open a connection to the IMAP server
    $server = new Net::IMAP::Simple( 'someserver' );

    # login
    $server->login( 'someuser', 'somepassword' );
    
    # select the desired folder
    $number_of_messages = $server->select( 'somefolder' );

    # go through all the messages in the selected folder
    foreach $msg ( 1..$number_of_messages ) {

        if ( $server->seen( $msg ) {
            print "This message has been read before...\n"
        }

        # get the message, returned as a reference to an array of lines
        $lines = $server->get( $msg );

        # print it
        print @$lines;

        # get the message, returned as a temporary file handle
        $fh = $server->getfh( $msg );
        print <$fh>;
        close $fh;

    }

    # the list of all folders
    @folders = $server->mailboxes();

    # create a folder
    $server->create_mailbox( 'newfolder' );

    # rename a folder
    $server->rename_mailbox( 'newfolder', 'renamedfolder' );

    # delete a folder
    $server->delete_mailbox( 'renamedfolder' );

    # copy a message to another folder
    $server->copy( $self, $msg, 'renamedfolder' );

    # close the connection
    $server->quit();

=head1 DESCRIPTION

This module is a simple way to access IMAP accounts. The API is mostly
equivalent to the Net::POP3 one, with some aditional methods for mailbox
handling.

=head1 BUGS

I don't know how the module reacts to nested mailboxes.

This module was only tested under the following servers:

=over 4

=item *

Netscape IMAP4rev1 Service 3.6

=item *

MS Exchange 5.5.1960.6 IMAPrev1 (Thanks to Edward Chao)

=item *

Cyrus IMAP Server v1.5.19 (Thanks to Edward Chao)

=back

Expect some problems with servers from other vendors (then again, if
all of them are implementing the IMAP protocol, it should work - but
we all know how it goes).

=head1 AUTHOR

Joao Fonseca, joao_g_fonseca@yahoo.com

=head1 SEE ALSO

Net::IMAP(1), Net::POP3(1).

=head1 COPYRIGHT

Copyright (c) 1999 Joao Fonseca. All rights reserved.
This program is free software; you can redistribute it
and/or modify it under the same terms as Perl itself.

=cut

