Pants Full of Unix

It should have been possible to do this with any one of:

1. fetchmail + procmail
2. Net::IMAP Perl module
3. Mail::Box::IMAP4 Perl module

But in reality, it took a little bit of several (Net::IMAP is woefully unprepared for primetime, so it's right out).

Here's what should work with just Perl:

#!/usr/bin/perl -w

# copyright 2004 gabriel rosenkoetter
#
# Reuse and redistribution, modified or as original, is permitted
# without limitation, provided the above attribution is included.
#
# No warranty is intended or implied.

use strict;
use Mail::IMAPClient;
use Mail::Box::Manager;
use Mail::Box::IMAP4;
use Term::ReadKey;

my $server = 'localhost';
my $username = $ENV{USER};
my $base = "$ENV{HOME}/Mail";
my $verbose = 1;
my @excludes = (
	'Calendar',
	'Contacts',
	'Deleted Items',
	'Drafts',
	'Inbox',
	'INBOX',
	'Journal',
	'Notes',
	'Outbox',
	'Sent Items',
	'Tasks',
	'Public Folders',
	'"Public Folders/"'
);
my @includes = ();
my ($exclude, $include);

ReadMode('noecho');
print "Password for ${username}\@${server}: ";
chomp(my $password = ReadLine(0));
print "\n";
ReadMode('restore');

my $client = Mail::IMAPClient->new (
	Server => $server,
	User => $username,
	Password => $password,
) or die $@;

print "Connected\n" if $verbose;
print "Authenticated\n" if ($verbose && $client->Authenticated());

my $mgr = new Mail::Box::Manager;
$mgr->defaultTrace('WARNINGS', 'DEBUG');

$mgr->registerType(imap4 => 'Mail::Box::IMAP4');

#my $imap = Mail::Box::IMAP4->new(imap_client => $client);
#my @dirs = $imap->listSubFolders;

my $imap = $mgr->open (
	folder => "/",
	type => 'imap4',
	imap_client => $client,
	access => "rw"
) or die $@;
my @dirs = $imap->listSubFolders;

my ($local, $remote, @messages, $message);

FOLDER: foreach my $dir (sort @dirs) {
	foreach $exclude (@excludes) {
		if ($dir =~ m/^$exclude/) {
			print "skipping [$dir] because of exclude [$exclude]\n" if $verbose;
			next FOLDER;
		}
	}
	if ($#includes >= 0) {
		my $matched = 0;
		foreach $include (@includes) {
			if ($dir =~ m/$include/) {
				$matched = 1;
				last;
			}
		}
		if ($matched == 0) {
			print "skipping [$dir] because it's not listed in includes\n" if $verbose;
			next FOLDER;
		}
	}
	print "Copying [$dir]:\n" if $verbose;
	$local = $mgr->open (
		create => 1,
		folder => "=$dir",
		folderdir => $base,
		type => 'maildir',
		access => "rw"
	) or die $@;
	print "  opened locally;\n" if $verbose;
	$remote = $mgr->open (
		folder => "$dir",
		type => 'imap4',
		imap_client => $client,
		access => 'r'
#		access => 'rw'
	) or die $@;
	@messages = $remote->messages;
	print "  opened remotely;\n" if $verbose;
	foreach $message (@messages) {
		print "    moving ", $message->messageId, "... " if $verbose;
		$mgr->moveMessage($local, $message) or die $@;
		print "moved.\n" if $verbose;
	}
	print "  done moving.\n" if $verbose;
	$mgr->close($local);
	$mgr->close($remote);
}

$imap->close;

If you switch to actually removing messages from the server (setting access => 'rw'), this pukes out with errors internal to Mail::Box::IMAP4 which, I'm sure, are fixable, but that's just not on the agenda right now.

Here's what I ended up using:

#!/usr/bin/perl -w

# copyright 2004 gabriel rosenkoetter
#
# Reuse and redistribution, modified or as original, is permitted
# without limitation, provided the above attribution is included.
#
# No warranty is intended or implied.

use strict;
use Mail::IMAPClient;
use Mail::Box::IMAP4;
use Term::ReadKey;

my $server = 'localhost';
my $username = "$ENV{USER}";
my $base = "$ENV{HOME}/Mail";
my $verbose = 1;
my @excludes = (
	'Calendar',
	'Contacts',
	'Deleted Items',
	'Drafts',
	'Inbox',
	'INBOX',
	'Journal',
	'Notes',
	'Outbox',
	'Sent Items',
	'Tasks',
	'Public Folders',
	'"Public Folders/"'
);
my @includes = ();
my ($exclude, $include);

ReadMode('noecho');
print "Password for ${username}\@${server}: ";
chomp(my $password = ReadLine(0));
print "\n";
ReadMode('restore');

my $client = Mail::IMAPClient->new (
	Server => $server,
	User => $username,
	Password => $password,
) or die $@;

print "Connected\n" if $verbose;
print "Authenticated\n" if ($verbose && $client->Authenticated());

my $imap = Mail::Box::IMAP4->new(imap_client => $client);
my @dirs = $imap->listSubFolders;
$imap->close;

my $command_line;

FOLDER: foreach my $dir (sort @dirs) {
	foreach $exclude (@excludes) {
		if ($dir =~ m/^$exclude/) {
			print "skipping [$dir] because of exclude [$exclude]\n" if $verbose;
			next FOLDER;
		}
	}
	if ($#includes >= 0) {
		my $matched = 0;
		foreach $include (@includes) {
			if ($dir =~ m/$include/) {
				$matched = 1;
				last;
			}
		}
		if ($matched == 0) {
			print "skipping [$dir] because it's not listed in includes\n" if $verbose;
			next FOLDER;
		}
	}
	print "Moving [$dir]:\n" if $verbose;

	print "  from imap://$username\@$server/$dir/\n";
	print "  to $base/$dir/\n";
	my $keep = '--nokeep';
	$command_line = "echo poll $server proto imap user $username pass $password ";
	$command_line .= "| fetchmail --folder $dir --fetchmailrc - ";
	$command_line .= "--all $keep --mda \'procmail DEFAULT=$base/$dir/\' ";
	$command_line .= "--verbose" if ($verbose);
#	print $command_line, "\n";
	print qx{$command_line};

	print "  done moving.\n" if $verbose;
}

If nothing else, I get to gloat that I made the damn thing work, but hey, maybe someone else can make use of this.