#!/usr/bin/perl
use strict;
use warnings;
use diagnostics;
use Data::Dumper;

my $testtext = <<TEXTPLAIN
Kleiner Test mit Umlauten:
ae = 'ä'
Ae = 'A'
oe = 'ö'
Oe = 'Ö'
ue = 'ü'
Ue = 'Ü'
ss = 'ß'
Euro = '€'
At = '\@'
TEXTPLAIN
;
print "Mime: ".mime_encode($testtext)."\n\n\n";
print "qp: ".qp_encode($testtext)."\n\n\n";

#--------#
    sub mime_encode {
        return '' if !defined $_[0] || $_[0] eq '';
        my $return = $_[0];
        my $noprint = "\\x00-\\x1F\\x7F-\\xFF";
        my ($word,@lines);
        my $line = '';
        $return =~ s{[a-zA-Z0-9\x7F-\xFF]{1,18}}{
            $word = $&;
            (($word !~ /[$noprint]/o)
            ? $word
            : "=?ISO-8859-15?Q?".&_encode($word,$noprint)."?=");
        }xeg;
        my @words = split(/ /,$return);
        foreach $word (@words) {
            my $sameword = 0;
            if (length($word) > 75) {
                while ($word) {
                    if ($word =~ /^(.+?\?=)(=\?.*)$/) {
                        addword($1,\$line,\@lines,$sameword);
                        $word = $2;
                    }
                    else {
                        addword($word,\$line,\@lines,$sameword);
                        $word = '';
                    }
                    $sameword = 1;
                }
            }
            else { addword($word,\$line,\@lines,$sameword); }
        }
        push(@lines,$line."\n") if ($line);
        return substr(join('',@lines),1);
        sub addword {
            my ($word,$line,$lines,$sameword) = @_;
            if (!$sameword && $word =~ /^=\?[^\?]+?\?[Qq]\?(.+\?=)$/) {
                my $newword = $1;
                if ($$line =~ /^(.+)\?=$/) {
                    $$line = $1.'_';
                    if (length($$line) + length($newword) > $75) {
                        $$line .= '?=';
                        push(@$lines,$$line."\n");
                        $$line = ' '.$word;
                    }
                    else { $$line .= $newword }
                    return 0;
                }
            }
            if (length($$line) > 0 && length($$line) + length($word) > 75) {
                push(@$lines,$$line."\n");
                $$line = '';
            }
            $$line .= ' '.$word;
        }
        sub _encode {
            my ($str,$noprint) = @_;
            $str =~ s{[\?\=\_$noprint]}{sprintf("=%02X",ord($&))}eog;
            $str;
        }
    }

    sub qp_encode {
        my $text = shift;
        $text =~ s/([^ \t\n!-<>-~])/sprintf("=%02X", ord($1))/eg;
        $text =~ s/([ \t]+)$/
            join('', map { sprintf("=%02X", ord($_)) } split('', $1))/egm;
        my $ret = '';
        $ret .= "$1=\n"
            while $text =~ s/(.*?^[^\n]{73} (?:
             [^=\n]{2} (?! [^=\n]{0,1} $)
            |[^=\n]    (?! [^=\n]{0,2} $)
            |          (?! [^=\n]{0,3} $)
            ))//xsm;
        $ret.$text;
    }