#!/usr/bin/perl -w

use strict;
use warnings;
use utf8;

BEGIN {
    unshift @INC, ( $ENV{POPHOME} || '@POPHOME@' ) . '/lib'
      unless $ENV{KUNDE_NO_PERLPATH};
}

use Encode qw(decode encode);
use Getopt::Long qw(GetOptions);
use Mail::Header;
use UTFkram qw(decode_anything);

use constant { HARD_ERROR => 100, SOFT_ERROR => 111 };

GetOptions(
    'help|?' => sub {
        exec perldoc => -F => $0
          or die "Cannot exec('perldoc -F $0'): $!\n";
    },
    'log!'       => \my $Log,
    'smtp-mode!' => \my $SmtpMode,
    'undup!'     => \( my $Undup = 1 ),
) or exit 1;

my @header;
while (<STDIN>) {
    last if $_ eq "\n";
    push @header, $_;
}
my $mh = my::Mail::Header->new(\@header)
  or die "Kann keinen Mail::Header erzeugen.\n";

my $n_changes;
while (<>) {
    $_ = decode_anything($_);
    next if !/\S/ || /^\s*#/;
    chomp;
    my ( $old, $new ) = split /\t/;

    my $re_old_content;
    $old =~ s/:\s+(.*)// and $re_old_content = qr/$1/i;

    my $new_content;
    $new =~ s/:\s+(.*)// and $new_content = encode( 'MIME-Header', $1 );

    my $i = 0;
    for ( $mh->get($old) ) {
        chomp;
        next
          if defined $re_old_content
          && decode( 'MIME-Header', $_ ) !~ /$re_old_content/;
        $new_content = $_ unless defined $new_content;

        if ( $Undup && $mh->exists( $new, $new_content ) ) {
            $mh->delete( $old, $i );
            print STDERR <<_ if $Log;
Deleted header "$old: $_", because "$new: $new_content" already exists.
_
        }
        elsif ( lc $old eq lc $new ) {
            $mh->replace( $old, $new_content, $i );
            print STDERR <<_ if $Log;
Replaced content "$_" of header $old by "$new_content".
_
        }
        else {
            $mh->delete( $old, $i );
            $mh->add( $new, $new_content );
            print STDERR <<_ if $Log;
Replaced header "$old: $_" by "$new: $new_content".\n)
_
        }
        ++$n_changes;
    }
    continue { ++$i }
}

print $n_changes ? $mh->as_string : @header, "\n";
while (<STDIN>) {
    print;
    last if $SmtpMode && /^\.(?:\cM\cJ|\n)\z/;
}

{
    package my::Mail::Header;

    use base 'Mail::Header';

    sub exists {
        my ( $self, $tag, $content ) = @_;
        return $self->count($tag) unless defined $content;
        my $found = 0;
        for ( $self->get($tag) ) {
            chomp;
            ++$found if $_ eq $content;
        }
        $found;
    }
}

__END__

=encoding utf8

=head1 NAME

rewrite_header - Filter zum Umschreiben von Mail-Headern

=head1 SYNOPSE

    ... | rewrite_headers -log headers.otrs2rt | rtmail ...

schreibt die Header der Mail anhand der in der Regeldatei C<headers.otrs2rt>
enthaltenen Regeln um und protokolliert jedes Umschreiben auf der
Standardfehlerausgabe.

Die Regeldatei muss dabei jeweils einzeilige Regeln mit mindestens zwei durch
jeweils genau ein Tabulator-Zeichen getrennten Feldern enthalten:

=over 4

=item alter Header

Wird hier nur der Tag angegeben (z. B. "X-RT-Queue"), so matcht die Regel
auf alle Header dieses Namens, unabhängig von ihrem Inhalt.
Durch einen zusätzlichen regulären Ausdruck kann die Regel auf einschlägige
Header mit bestimmten Inhalten beschränkt werden, z. B.
"X-Autoreply: ^(off|no)"

=item neuer Header

Wird hier nur der Tag angegeben (z. B. "X-RT-Queue"), so wird der Inhalt aus dem
alten Header unverändert übernommen.
Wird zusätzlich Inhalt angegeben, so wird der alte Inhalt durch diesen neuen
ersetzt.
Ein komplizierteres Umschreiben alter auf neue Inhalte ist derzeit nicht
vorgesehen.

=item Kommentar (optional)

wird ignoriert

=back

Außerdem darf sie Leerzeilen und mit C<#> beginnende Kommentarzeilen enthalten;
diese werden ignoriert.

Es können auch mehrere Regeldateien angegeben werden.

Die Dateien werden der Reihe nach zeilenweise abgearbeitet, und jede Regel wird
auf alle passenden Header-Einträge angewandt.
Sprich:

=over 4

=item *

Man kann einfach spezifischere Regel über allgemeinere schreiben, vorausgesetzt,
die spezifischere Regel schreibt den Header so um, dass die allgemeinere für das
Ergebnis nicht mehr greift, z. B.:

	X-noris-Ticket-ArticleType: ^extern\b	X-RT-Extern: yes
	X-noris-Ticket-ArticleType	X-RT-Extern: no

=item *

Es ist auch möglich, einen Header durch mehrere Regeln mehrfach umzuschreiben,
wenn man sich denn unbedingt ins Knie schießen möchte.

=back

=head1 OPTIONEN

=over 4

=item -log

Jedes Umschreiben eines Headers wird auf der Standardfehlerausgabe
protokolliert.

=item -smtp-mode

Bei Verwendung dieser Option wird die Eingabe als beendet erachtet,
sobald eine Zeile gefunden wird, die nur einen C<.> enthält.

=item -no-undup

Normalerweise werden keine Header erzeugt, die es so (inkl. identischem Inhalt)
schon gibt.
Das kann durch Verwendung dieser Option jedoch abgeschaltet werden.

=item -help

=item -?

um (nur) diese Dokumentation anzeigen zu lassen

=back
