#!/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;
	}