#!/usr/bin/perl -W
#
# $Id: clearsubject.pl,v 1.5 2019/04/04 10:26:05 werdna Exp werdna $

$| = 1;
$debug = 0;
#$debug = 1;
#$debug = 3;

sub vprint (@) {
    my ($level) = shift @_;
    warn @_ if $debug >= $level;
}

while (@ARGV) {
    my $thisarg = shift @ARGV;

    vprint 2, "parsing arg $thisarg\n";
    if ($thisarg =~ /^-/ ) {
        if ($thisarg =~ /^-+debug/) {
            $debug++;
            next;
        }
        warn "ignored unexpected option $thisarg\n";
        next;
    }
}

# https://ncona.com/2011/06/using-utf-8-characters-on-an-e-mail-subject/
# has perl code to un-UTF-8 a subject line
# which would be useful.
# RFC 1342

sub convert_subject ($) {
    use utf8;
    use MIME::Base64;
    use Encode;
    use MIME::QuotedPrint qw(decode_qp);

    my ($subject) = @_;
    my $decoded_subject;
    my $character_set = "";
    my $encoding_type = "";
    my $encoded_subject = "";

    $_ = $subject;
    # m/^=\?([a-zA-Z0-9_\-]+)\?([BQ])\?(.*)\?=$/i;
    m/^=\?([\w-]+)\?([BQ])\?(.*)\?=$/i;
    if ($1) {
        $character_set=$1;
        $encoding_type=$2;
        $encoded_subject=$3;
    } else {
        return $subject;
    }

    if ( $debug > 0 ) {
        warn "convert_subject($subject)\n";
        warn "charset\t$character_set\n";
        warn "encoding_type\t$encoding_type\n";
        warn "encoded_subject\t$encoded_subject\n";
    }

    if (uc($character_set) eq 'UTF-8') {
        if (uc($encoding_type) eq 'B') {
            $decoded_subject = decode_base64($encoded_subject);
            #my $windows_1252 = Encode::encode("Windows-1252", $decoded_subject);
            my $ISO88591 = Encode::encode("ISO-8859-1", $decoded_subject);
            my $ascii = $ISO88591;
            $ascii =~ s/[^[:ascii:]]//g;
            # return $ascii;
            vprint 1, "$subject -> $decoded_subject\n";
            return $decoded_subject;
        } elsif (uc($encoding_type) eq 'Q') {
            # $encoding_type eq 'Q'

            $decoded_subject = decode_qp($encoded_subject);
            vprint 1, "$subject -> $decoded_subject\n";
            return $decoded_subject;
        } else {
            warn "unknown encoding_type $encoding_type\n";
        }
    } else {
        # Not Unicode ?
        vprint 2, "charset $character_set supported experimental\n";
        my ($decode);
        if (uc($encoding_type) eq 'B') {
            $decode = decode_base64($encoded_subject);
            vprint 1, "\tdecode_base64 -> $decode\n";
        } elsif (uc($encoding_type) eq 'Q') {
            $decode = decode_qp($encoded_subject);
            vprint 1, "\tdecode_qp -> $decode\n";
        } else {
            warn "unknown encoding_type $encoding_type\n";
            $decode = $encoded_subject;
        }
        #$subject = decode($character_set, $decode);
        #vprint 1, "\tdecode -> $subject\n";
        $subject = $decode;
        Encode::from_to($subject, $character_set, "utf8");
        vprint 1, "\tdecode -> $subject\n";
    }

    return $subject;
}

while (<>) {
    chomp;

    # while ( /^(.*)(=\?.+\?.+\?=)(.*)$/ ) {
    while ( /^(.*)(=\?.+\?.\?.+\?=)(.*)$/ ) {
        my ($lead,$encoded,$trail) = ($1,$2,$3);
        $lead =~ s/^ //; # Ignore the leading space in continuation lines
        $_ = $lead.convert_subject($encoded).$trail;
    }
    print "$_\n";
}