imapsync/W/learn/imap_rename_regex

#!/usr/bin/perl -w

# $Id: imap_rename_regex,v 1.5 2015/08/15 03:42:01 gilles Exp gilles $

use Mail::IMAPClient;

++$| ;

$ARGV[3] or die "usage: $0 host user password regex do_it\n";

my $host = $ARGV[0] ;
my $user = $ARGV[1] ;
my $password = $ARGV[2] ;
my $regex = $ARGV[3] ;
my $doit = $ARGV[4] || 0 ;

my $imap = Mail::IMAPClient->new(  ) ;
$imap->Debug( 1 ) ;
$imap->Server( $host ) ;
$imap->Ssl( 1 ) ;
$imap->connect(  ) or die ;
$imap->IsUnconnected(  ) ;
$imap->User( $user ) ;
$imap->Password( $password ) ;
$imap->login(  ) or die ;
$imap->Uid( 1 ) ;
$imap->Peek( 1 ) ;

my @folders = $imap->folders(  ) ;

foreach my $folder ( @folders ) {
	print "$folder\n" ;
        my $folder_new = $folder ;
        if ( eval( "\$folder_new =~ $regex" ) 
	     and ( $folder_new ne $folder ) ) {
        	print "Renaming [$folder] -> [$folder_new]\n" ;
		$imap->noop(  ) ;
                if ( $doit and $imap->rename( $folder, $folder_new ) ) {
                	print "renamed ok [$folder] -> [$folder_new]\n" ;
                }else{
                	print "KO renamed [$folder] -> [$folder_new]\n" ;
                }
        } 
}

$imap->logout();