#!/usr/local/bin/perl
#
# header.pl     ver.2.0         Y.Sakazume
#
# usage: header.pl <list_name> <number_file>
#
########################################################################

$Domain      = "";      # Set Mail Domainname if you need Reply-To: header.
$ForceReplyTo = 0;      # If ForceReplayTo is set to 1, Reply-To: header
                        # is replaced whether it already exist.

                        # Domain = NULL and ForceReplyTo = 0, Reply-To: header
                        # removed.

use MIME::Base64;

my ($prefix, $index, $replyto, $subject, $encoded, $decoded, $re);

$prefix = $ARGV[0];
if (-e $ARGV[1]) {
    open(INDEX, "+<" . $ARGV[1]);
    chop($index = <INDEX>);
    close(INDEX);
    $index =~ s/:.*//;
    $index++;
}

while (<STDIN>) {
    chop;
    if (/^$/) { # escape if end of header
        last;
    }
    if (s/^Subject:\s*//) {
        $encoded = $_;
        $encoded =~ s/^.*=\?iso-2022-jp\?B\?(.*)\?=.*$/$1/;
        $decoded = decode_base64($encoded);
        s/^(.*)=\?iso-2022-jp\?B\?.*\?=(.*)$/$1$decoded$2/;

        if (s/^((RE|Re|re|FW|Fw|fw):\s)+//){
            $re = "Re: ";
        }

        s/^(Re: )*\[$prefix\s*\d+\]\s*/$1/;	# remove prefix

        if(/^[\000-\177]*$/){
            # ascii
            print "Subject: [$prefix $index] " . $re . $_ . "\n";
        }
        else {
            # multibytes
            print "Subject: [$prefix $index] " . $re . "=?iso-2022-jp?B?" . encode_base64($_,'') . "?=\n";
        }
    }
    elsif(s/^Reply-[Tt]o:\s//i){
        $replyto = $_;
        unless($ForceReplyTo){
            print "Reply-To: " . $replyto . "\n";
        }
    }
    else {
        print; print "\n";
    }
}

if($Domain){
    if($ForceReplyTo eq 1) {
        print "Reply-To: " . $prefix . "@" . $Domain . "\n";
    }
    if($ForceReplyTo eq 0 && $replyto eq '') {
        print "Reply-To: " . $prefix . "@" . $Domain . "\n";
    }
}

print "\n";     # end of header
print <STDIN>;
exit(0);