#! /usr/local/bin/perl -w
#
# mail-cleanup - remove personal headers such as Received: in mail.
#
# Usage: % mail-cleanup ~/Mail/foobar/*
#
# Note:  mail-cleanup overwrites a mail file. Be careful!
#
# Copyright (C) 2000 Satoru Takabayashi <satoru-t@is.aist-nara.ac.jp>
#     All rights reserved.
#     This is free software with ABSOLUTELY NO WARRANTY.
#
# You can redistribute it and/or modify it under the terms of 
# the GNU General Public License version 2.
#

require 5.004;
use strict;
use FileHandle;

my $fieldpat = "Received:|Delivered-To:|X-UIDL:|X-Authentication-Warning:";

main();

sub main () {
    while (@ARGV) {
	my $mail = shift @ARGV;
	cleanup_headers($mail);
    }
}

sub cleanup_headers ($) {
    my ($mail) = @_;

    print STDERR "$mail\n";
    my @lines = ();
    {
	my $fh = new FileHandle;
	$fh->open($mail) || die "$mail: $!";
	@lines =  <$fh>;
	return if @lines == 0;
	@lines = cleanup_headers_sub(\@lines);
    }
    {
	my $fh = new FileHandle;
	$fh->open("> $mail") || die "$mail: $!";
	print $fh @lines;
    }
}

sub cleanup_headers_sub (\@) {
    my ($lines_ref) = @_;
    my (@lines) = ();

    # Remove very first "From " line.
    shift @$lines_ref if $lines_ref->[0] =~ /^From /i;

    while (@$lines_ref) {
	my $line = shift @$lines_ref;
	last if $line =~ /^[\n\r]*$/;

	# Connect if the next line has leading spaces.
 	while (defined($lines_ref->[0]) && $lines_ref->[0] =~ /^[ \t]+/) {
	    my $nextline = shift @$lines_ref;
	    $line =~ s/([\xa1-\xfe])\s+$/$1/;
	    $nextline =~ s/^\s+([\xa1-\xfe])/$1/;
	    $line .= $nextline;
	}

	unless ($line =~ /^(\S+:) (.*)/) {
	    die "invalid header: $line\n";
	}
	my $field = $1;

	if ($field !~ /^($fieldpat)$/) {
	    push @lines, $line;
	}
    }
    push @lines, "\n";
    push @lines, @$lines_ref;
    return @lines;
}