view release on metacpan or  search on metacpan

examples/imap_to_mbox.pl  view on Meta::CPAN

#!/usr/local/bin/perl
# (c) 1999 Thomas Stromberg, Research Triangle Commerce, Inc.
# This software is protected by the BSD License. No rights reserved anyhow.
# <tstromberg@rtci.com>

# DESC: Reads a users IMAP folders, and converts them to mbox
#       Good for an interim switch-over from say, Exchange to Cyrus IMAP.

# $Header$

# History:
# --------
# 2008/08/07 - Added SSL support, fixed From header printing, and CR 
#		elimination (sobek)

# TODO:
# ----- 
# lsub instead of list option

use warnings;
use strict;

use Mail::IMAPClient;	# a nice set of perl libs for imap 
use IO::Socket::SSL;	# for SSL support

use vars qw($opt_h $opt_u $opt_p $opt_P $opt_s $opt_i $opt_f $opt_m $opt_b
	    $opt_c $opt_r $opt_w $opt_W $opt_S $opt_D $opt_U $opt_d $opt_I
	    $opt_n);

use Getopt::Std; 	# for the command-line overrides. good for user
use File::Path;		# create full file paths. (yummy!)
use File::Basename;	# find a nice basename for a folder.
use Date::Manip;	# to create From header date
$| = 1;

sub connect_imap();
sub find_folders();
sub write_folder($$$$);
sub help();

# Config for the imap migration kit.

getopts('u:p:P:s:i:f:m:b:c:r:w:W:SDUdhIn:') or
    $opt_h = 1;

my $SSL			= $opt_S || 0;
my $SERVER		= $opt_s || 'machine';
my $USER		= $opt_u || 'userid';
my $PASSWORD		= $opt_p || 'password';
my $PORT		= $opt_P || '143';
my $INBOX_PATH		= $opt_i || "/var/mail/$USER"; 
my $DOINBOX		= $opt_I ? 0 : 1 || 1;
my $FOLDERS_PATH	= $opt_f || "./folders/$USER"; 
my $DONT_MOVE		= $opt_m || '.mailboxlist|Trash|INBOXIIMAP|mlbxl'; 
my $READ_DELIMITER	= $opt_r || '/';
my $WRITE_DELIMITER	= $opt_w || '/';
my $WRITE_MODE		= $opt_W || '>';
my $BANNED_CHARS	= $opt_b || '.|^|%';
my $CR			= $opt_c || "\r";
my $NUMBER		= $opt_n || "";
my $DELETE		= $opt_D || 0;
my $DEBUG		= $opt_d || "0";
my $UNSEEN		= $opt_U || 0;
my $FAIL = 0;

my $imap;		# definition for IMAP structure

if ($opt_h) {
    # print help here
    help();
}

sub help() {
    print "imap_to_mbox.pl - with the following optional arguments\:
	-S	Use an SSL connection (default $SSL)
	-s <s>	Server specification (default $SERVER)
	-u <u>	User login (default $USER)
	-p <p>	User password
	-P <p>	Server Port (default $PORT)
	-i <i>	INBOX save path (default $INBOX_PATH)
	-I	skip INBOX (default $DOINBOX)
	-f <f>	Save path for other folders (default $FOLDERS_PATH)
	-m <r>	Regexp for IMAP folders not to be saved:
		$DONT_MOVE
	-r <r>	Read delimiter (default \"$READ_DELIMITER\")
	-w <w>	Write Delimiter (default \"$WRITE_DELIMITER\")
	-b <b>	Banned chars (default \"$BANNED_CHARS\")
	-c <c>	Strip CRs from saved files [for Unix] (default \"$CR\")
	-n <n>	Receive only <n> messages (Default ".($NUMBER ? "$NUMBER" : "all").")
	-U	Unseen messages Only
	-D	Delete downloaded files on server
	-d	Debug mode (default $DEBUG)\n";
    exit 1;
}

## do our magic tricks ######################################
connect_imap();
find_folders();


sub connect_imap()
{
# Open an SSL session to the IMAP server
# Handles the SSL setup, and gives us back a socket
    my $ssl;
    if ($opt_S) {
	$ssl=IO::Socket::SSL->new(
		PeerHost	=> "$SERVER:imaps"
#	,	SSL_version	=> 'SSLv2'	# for older versions of openssl
	);

        defined $ssl
            or die "Error connecting to $SERVER:imaps - $@";

	$ssl->autoflush(1);
    }

    $imap = Mail::IMAPClient->new(
        Socket		=> ($opt_S ? $ssl : 0),
        Server		=> $SERVER,
        User		=> $USER,
        Password	=> $PASSWORD,
        Port		=> $PORT,
        Debug		=> $DEBUG,
        Uid		=> 0,
        Clear		=> 1,
    )
    or die ("Could not connect to $SERVER:$PORT with $USER: $! $?\n");
}

sub find_folders()
{
    my @folders = $imap->folders;
#	push(@folders, "INBOX");

    foreach my $folder (@folders) {
	my $message_count;

	if ($folder eq "INBOX" and $DOINBOX == 0) {
	    print "* $folder is unwanted, skipping.\n";
	    next;
	}
	if (!$UNSEEN) {
	    $message_count = $imap->message_count($folder);
	} else {
	    $message_count = $imap->unseen_count($folder) || 0;
	}
	if(! $message_count) {
	    print "* $folder is empty, skipping.\n";
	    next;
	}
	if($folder =~ /$DONT_MOVE/) {
	    warn "! $folder matches DONT_MOVE ruleset, skipping\n";
	    next;
	}

	my $new_folder = $folder;
	$new_folder =~ s/\./_/g;
	$new_folder =~ s/\Q$READ_DELIMITER/$WRITE_DELIMITER/g;
	my $path
          = $new_folder eq "INBOX" ? "$INBOX_PATH"
          : "$FOLDERS_PATH/$new_folder";

	if ($NUMBER && $NUMBER < $message_count) {
	    printf "x %4i %-45.45s => %s", $NUMBER, $folder, $path;
	    write_folder $folder, $path, 1, $NUMBER;
	} else {