#! /usr/bin/perl
################################################################
###
###				 immv
###
### Author:  Internet Message Group <img@mew.org>
### Created: Apr 23, 1997
### Revised: Sep  5, 1998
###

BEGIN {
    use lib '/usr/lib';
};

my $VERSION = "immv version 980905(IM100)";

$Prog = 'immv';

##
## Require packages
##

use IM::Config;
use IM::Folder;
use IM::File;
use IM::MsgStore;
use IM::Util;
use integer;
use strict;
use vars qw($Prog $EXPLANATION @OptConfig
	    @msgs
	    $opt_link $opt_noharm $opt_src @opt_dst
	    $opt_verbose $opt_debug $opt_help);

##
## Environments
##

my %NewMsgCache = ();
my %ImapHandleCache = ();

$EXPLANATION = "
$Prog :: Internet Message Move
$VERSION

Usage: $Prog [options] +folder... msgs...
";

@OptConfig = (
    'src;f;;'     => "Set source folder.",
    'dst;F@;;'    => "Set destination folders.",
    'link;b;;'    => "Remain original msg in src folder.",
    'noharm;b;;'  => "Display the commands but do not actually execute them.",
    'verbose;b;;' => 'With verbose messages.',
    'debug;d;;'   => "With debug message.",
    'help;b;;'    => "Show this message.",
    );

##
## Profile and option processing
##

init_opt(\@OptConfig);
read_cfg();
read_opt(\@ARGV); # help?
help($EXPLANATION) && exit $EXIT_SUCCESS if $opt_help;

debug_option($opt_debug) if $opt_debug;

##
## Main
##

@opt_dst = uniq(@opt_dst);

@opt_dst || im_die "no folder specified.\n";
@ARGV    || im_die "no message specified.\n";

@msgs  = @ARGV;

immv($opt_src, \@opt_dst, \@msgs);
exit $EXIT_SUCCESS;

##################################################
##
## Work horse
##
sub immv ($$$) {
    my ($src, $dsts, $msgs) = @_;
    my @msg_paths;

    if ($src =~ /^%/o) {
	require IM::Imap && import IM::Imap;
	require IM::GetPass && import IM::GetPass;
    }
    for (my $i = 0; $i < @{$dsts}; $i++) {
        if (${$dsts}[$i] =~ /^%/o) {
	    require IM::Imap && import IM::Imap;	  
	    require IM::GetPass && import IM::GetPass;
	}
    }

    chk_folder_existance($src, @{$dsts}); # ignore IMAP folders

    $opt_link = 1 if (grep($src eq $_, @{$dsts}));
    @{$dsts} = grep($src ne $_, @{$dsts});

    open_imap_folders(0, $src);
    open_imap_folders(1, @{$dsts});

    if ($src !~ /^%/) {
	chk_msg_existance($src, @{$msgs});
    } else {
	my ($HANDLE, $srcacct, $srcset);
	my ($getbox, $link) = ('+inbox', 0);
	my $link_1st;

	$srcacct = imap_folder_acct($src);
	$HANDLE = $ImapHandleCache{$srcacct};
	if (imap_select($HANDLE, imap_folder_name($src), 1) < 0) {
	    im_warn("can't select $src source folder.\n");
	    close_imap_folders();
	    exit($EXIT_ERROR);
	}
	$srcset = imap_range2set($HANDLE, @{$msgs});

	for (my $i = 0; $i < @{$dsts}; $i++) {
	    if (imap_folder_acct(${$dsts}[$i]) eq $srcacct) {
		my $dst = splice(@{$dsts}, $i, 1); $i--;
		if (imap_copy($HANDLE,
			      $srcset,
			      imap_folder_name($dst), 0) < 0) {
		    im_warn("can't copy to $dst folder.\n");
		    close_imap_folders();
		    exit($EXIT_ERROR);
		}
	    } elsif (!$link && ${$dsts}[$i] =~ /^\+/) {
		($getbox, $link) = (splice(@{$dsts}, $i, 1), 1); $i--;
		($link_1st) = (get_impath($getbox, 'new') =~ m|([^/]+)$|);
		get_imap_messages($HANDLE, $getbox, @{$msgs});
	    }
	}
	unless (@{$dsts}) {
	    imap_delete($HANDLE, $srcset) unless ($opt_link);
	    close_imap_folders();
	    return 0;
	}

	unless ($link) {
	    ($link_1st) = (get_impath($getbox, 'new') =~ m|([^/]+)$|);
	    get_imap_messages($HANDLE, $getbox, @{$msgs});
	}
	imap_delete($HANDLE, $srcset) unless ($opt_link);

	$src = $getbox;
	$opt_link = $link;
	$msgs = ["$link_1st-last"];
    }

    @msg_paths = get_impath($src, @{$msgs});
    foreach (@msg_paths){
	refile_one($_, $dsts);
    }
    close_imap_folders();
    return 0;
}

sub refile_one ($$) {
    my ($src_path, $dsts) = @_;
    my ($dst_path, $link_it);

    foreach (@{$dsts}){
	unless (/^%/) {
	    if ($NewMsgCache{$_}){
		$NewMsgCache{$_} =~ s|([^/]+)$|$1+1|e; # increment cache
		$dst_path = $NewMsgCache{$_};
	    } else {
		$dst_path = $NewMsgCache{$_} = get_impath($_, 'new');
	    }
	    if ($opt_link){
		im_link($src_path, $dst_path) || die $@;      # XXX
	    } elsif ($link_it){
		im_link($link_it, $dst_path) || die $@;       # XXX
	    } else {
		im_rename($src_path, $dst_path) || die $@;    # XXX
		$link_it = $dst_path;
	    }
	    touch_folder($dst_path) unless ($opt_noharm);
	} else {
	    my $HANDLE = $ImapHandleCache{imap_folder_acct($_)};
	    my $idst = imap_folder_name($_);
	    put_imap_message($HANDLE, $idst, $link_it || $src_path);
	}
    }
    if (!$opt_link && !$link_it) {
	im_unlink($src_path);
    }
}

sub uniq (@) {
    my @array = @_;
    my %hash;

    foreach (@array){
	$hash{$_} = $_;
    }
    return keys(%hash);
}

##
## IMAP subroutines
##

sub get_imap_messages ($$@) {
    my ($HANDLE, $dst, @ranges) = @_;
    my @msgs = imap_range2msgs($HANDLE, @ranges);

    if ($msgs[0] < 0) {
	im_warn("can't find source message(s).\n");
	close_imap_folders();
	exit($EXIT_ERROR);
    }
    foreach (@msgs) {
	my ($rc, $msgref) = imap_get($HANDLE, $_);
	if ($rc < 0) {
	    im_warn("can't get msg $_ from source folder.\n");
	    close_imap_folders();
	    exit($EXIT_ERROR);
	}
	local $main::opt_noscan = 1; # for quiet store_message
	if (store_message($msgref, $dst) < 0) {
	    im_warn("can't store msg $_ to $dst folder.\n");
	    close_imap_folders();
	    exit($EXIT_ERROR);
	}
    }
}

sub put_imap_message ($$$) {
    my ($HANDLE, $dst, $src_path) = @_;
    my @Message;
    local (*SRC);

    unless (open(SRC, "<$src_path")) {
	im_warn("can't open local message $src_path.\n");
	close_imap_folders();
	exit($EXIT_ERROR);
    }
    local $_;
    while (<SRC>) {
	push(@Message, $_);
    }
    if (imap_put($HANDLE, $dst, \@Message) < 0) {
	im_warn("can't store msg $src_path to $dst folder.\n");
	close(SRC);
	close_imap_folders();
	exit($EXIT_ERROR);
    }
    close(SRC);
}

sub open_imap_folders ($@) {
    my ($create, @folders) = @_;

    foreach (@folders) {
	next unless (/^%/);
	my $acct = imap_folder_acct($_);
	my $ifld = imap_folder_name($_);
	my ($rc, $HANDLE);

	unless ($HANDLE = $ImapHandleCache{$acct}) {
	    my ($pass, $agtfound, $interact) = ('', 0, 0);
	    my ($dummy, $auth, $user, $host)
		= imap_spec(imap_folder_regname($_));

	    if (usepwagent()) {
		$pass = loadpass('imap', $auth, $host, $user);
		$agtfound = 1 if ($pass ne '');
	    }
	    if ($pass eq '' && usepwfiles()) {
		$pass = findpass('imap', $auth, $host, $user);
	    }
	    if ($pass eq '') {
		$pass = getpass("Password for $acct: ");
		$interact = 1;
	    }

	    ($rc, $HANDLE) = imap_open($auth, $host, $user, $pass);
	    if ($rc < 0) {
		im_warn("can't open IMAP connection to $host.\n");
		savepass('imap', $auth, $host, $user, '')
		    if ($agtfound && usepwagent());
		close_imap_folders();
		exit($EXIT_ERROR);
	    }
	    savepass('imap', $auth, $host, $user, $pass)
		if ($interact && $pass ne '' && usepwagent());
	    $ImapHandleCache{$acct} = $HANDLE;
	}

	if ((imap_select($HANDLE, $ifld, 1) < 0) && $create) {
	    if (imap_create_folder($HANDLE, $ifld) < 0) {
		im_warn("can't create $_ folder.\n");
		close_imap_folders();
		exit($EXIT_ERROR);
	    }
	}
    }
}

sub close_imap_folders () {
    foreach (keys(%ImapHandleCache)) {
	imap_close($ImapHandleCache{$_});
    }
    %ImapHandleCache = ();
}

### Copyright (C) 1997, 1998 IM developing team.
### All rights reserved.
### 
### Redistribution and use in source and binary forms, with or without
### modification, are permitted provided that the following conditions
### are met:
### 
### 1. Redistributions of source code must retain the above copyright
###    notice, this list of conditions and the following disclaimer.
### 2. Redistributions in binary form must reproduce the above copyright
###    notice, this list of conditions and the following disclaimer in the
###    documentation and/or other materials provided with the distribution.
### 3. Neither the name of the team nor the names of its contributors
###    may be used to endorse or promote products derived from this software
###    without specific prior written permission.
### 
### THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND
### ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
### IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
### PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE TEAM OR CONTRIBUTORS BE
### LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
### CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
### SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
### BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
### WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
### OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
### IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

### Local Variables:
### mode: perl
### End:
