#! @im_path_perl@
################################################################
###
###				 imjoin
###
###	      Copyright (C) 1997  Internet Message Group
###
###		     This Perl5 library conforms
###		GNU GENERAL PUBLIC LICENSE Version 2.
###
###
### Author:  Internet Message Group <img@mew.org>
### Created: May  5, 1997
### Revised: @im_revised@
###

my $VERSION = "imjoin @im_version@";

$Prog = 'imjoin';

##
## Require packages
##

use IM::MsgStore qw(store_message);
use IM::Config;
use IM::Util;
use integer;
use strict;
use vars qw($Prog $EXPLANATION @EnvConfig @OptConfig $opt_noscan
	    $opt_src $opt_dst $opt_verbose $opt_debug $opt_help);

##
## Environments
##

$EXPLANATION = "
imjoin :: Join Message/partial Messages
$VERSION

Usage: imjoin [options] msg
";

@OptConfig = (
	      'src;F;;'     => "Folder.",
	      'dst;s;+inbox;' => "Folder.",
	      'verbose;b;;' => 'With verbose messages.',
	      'debug;d;;'   => "With debug message.",
	      'help;b;;'    => "Show this message.",
	      );

##
## Profile and option processing
##

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

debug_option($opt_debug) if $opt_debug;

##
## Main
##

my @msgs = @ARGV;
my $msg = $msgs[0];

$opt_noscan = 1;

my @Message = join_msg(@msgs);

if ($opt_dst eq "stdout") {
    print join('', @Message);
} else {
    store_message(\@Message, $opt_dst);
}

exit $EXIT_SUCCESS;

sub join_msg ($) {
    my @msgs = @_;
    my @paths;
    my @index;
    my @Message;
    local $_;

    if ($#msgs == 0) {
	# search partial messages using history_db
	@paths = get_paths("$opt_src/$msgs[0]");
    } else {
	# all partial message is specified by command line
	require IM::Folder && import IM::Folder qw(message_name);
	my $msg;
	foreach $msg (@msgs) {
	    push(@paths, message_name($opt_src, $msg));
	}
    }

    # sort each part number on each part
    my $total = 0;
    my ($path, $header);
    foreach $path (@paths) {
	if (open(MSG, "<$path")) {
	    $/ = "\n\n";
	    $header = <MSG>;
	    $/ = "\n";
	    close(MSG);
	}

	$header =~ s/\n\s+//g;
	$header =~ s/[ \t]+//g;
	$header =~ s/\n/;\n/g;
	$header = "\n$header";

	my $number = 0;
	my $this_total = 0;
	if ($header =~ /\nContent-Type:Message\/partial(;[^\n]+)\n/i) {
	    my $rest = $1;
	    if ($rest =~ /;number=(\d+);/i) {
		$number = $1;
	    }
	    if ($rest =~ /;total=(\d+);/i) {
		$this_total = $1;
	    }
	}
	if ($number == 0 || $this_total == 0) {
	    im_warn("$_: not a partial message, skipping.\n");
	    next;
	}
	if ($total) {
	    if ($total != $this_total) {
		im_warn("$_: total of partial messages mismatch, skipping.\n");
		next;
	    }
	} else {
	    $total = $this_total;
	}
	$index[$number] = $path;
	im_notice("$path is part $number.\n");
    }   

    # check existance of all partial messages
    my $missing = 0;
    my $i;
    for ($i = 1; $i <= $#index; $i++) {
	if ($index[$i] eq '') {
	    im_err("part $i is missing.\n");
	    exit $EXIT_SUCCESS;
	}
    }

    # show in sequence
    for ($i = 1; $i <= $#index; $i++) {
	if (open(MSG, "<$index[$i]")) {
	    $/ = "\n\n";
	    if ($i == 1) {
		my $header = <MSG>;
		my $skip = 0;
		foreach (split("\n", $header)) {
		    next if (/^[ \t]/ && $skip);
		    $skip = 0;
		    if (/^(Content|Message-ID)/i) {
			$skip = 1;
			next;
		    }
		    last if (/^\n/);
		    push (@Message, "$_\n");
		}
	    } else {
		# skip header part
		<MSG>;
	    }
	    $/ = "\n";
	    while (<MSG>) {
		push(@Message, $_);
	    }
	    close(MSG);
	}
    }

    return @Message;
}

sub get_paths ($) {
    my $msg = shift;
    my $path;
    local $_;

    unless (msgdbfile()) {
	im_die("need history database to join by one message.\n");
	exit $EXIT_ERROR;
    }

    require IM::History;
    import IM::History qw(history_open history_lookup history_close);

    # get master Message-ID
    my $header = '';
    if ($msg =~ /^\+/) {
	$path = &expand_path($msg);
    } else {
	$path = $msg;
    }

    if (open(MSG, "<$path")) {
	$/ = "\n\n";
	$header = <MSG>;
	$/ = "\n";
	close(MSG);
    }

    if ($header eq '') {
	im_err("specified message is not found at $path.\n");
	exit $EXIT_ERROR;
    }

    $header =~ s/\n\s+//g;
    $header =~ s/[ \t]+//g;
    $header =~ s/\n/;\n/g;
    $header = "\n$header";

    my $master = '';

    if ($header =~ m|\nContent-Type:Message/partial;(.*;)?id=([^;]+);|i) {
	$master = $2;
	$master =~ s/^"(.*)"$/$1/;
    } else {
	im_err("specified message is not a partial.\n");
	exit $EXIT_ERROR;
    }

    im_notice("Master Message-ID: $master.\n");

    # get Message-IDs of partial
    if (history_open(0) < 0) {
	im_err("can not open history.\n");
	exit $EXIT_ERROR;
    }
    my $ids = history_lookup("partial:$master", 'LookUpMsg');
    if ($ids eq '') {
	im_err("information on partial messages is not found in history.\n");
	exit $EXIT_ERROR;
    }
    im_notice("partial Message-IDs: $ids.\n");

    # get path and part number on each part
    my @paths;
    foreach (split(',', $ids)) {
	my $locate = history_lookup($_, 'LookUpMsg');
	if ($locate eq '') {
	    im_warn("message $_ not found, skipping.\n");
	    next;
	}
	my $path = &expand_path($locate);
	if ($path eq '') {
	    im_warn("no path for message $locate, skipping.\n");
	    next;
	}
	push(@paths, $path);
    }
    history_close();

    return @paths;
}

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