\n|; } else { $ret .= qq|| . mhonarc::htmlize($file) . qq|
\n|; } } } elsif ($pdata =~ /\S/) { # plain text my(@subret) = filter($fields, \$pdata, $isdecode, $args); $ret .= shift @subret; push(@files, @subret); } ++$i; } ## Done with uudecode $ret = ' ' if $ret eq ''; return ($ret, @files); } ## Check for HTML data if requested if ($args =~ s/\bhtmlcheck\b//i && $$data =~ /\A\s*<(?:html\b|x-html\b|!doctype\s+html\s)/i) { return do_html($fields, $data, $isdecode, $args); } my($charset, $nourl, $igncharset, $nonfixed, $keepspace, $maxwidth, $target, $xhtml); my(%asis) = ( ); $nourl = ($mhonarc::NOURL || ($args =~ /\bnourl\b/i)); $nonfixed = ($args =~ /\bnonfixed\b/i); $keepspace = ($args =~ /\bkeepspace\b/i); if ($args =~ /\bmaxwidth=(\d+)/i) { $maxwidth = $1; } else { $maxwidth = 0; } $target = ""; if ($args =~ /\btarget="([^"]+)"/i) { $target = $1; } elsif ($args =~ /\btarget=(\S+)/i) { $target = $1; } $target =~ s/['"]//g; if ($target) { $target = qq/target="$target"/; } ## Grab charset parameter $charset = $fields->{'x-mha-charset'}; ## Grab format parameter (if defined) my $textformat = 'fixed'; if ( ($args !~ /\bdisableflowed\b/i) && (defined($fields->{'content-type'}[0])) && ($fields->{'content-type'}[0] =~ /\bformat\s*=\s*([^\s;]+)/i) ) { $textformat = lc $1; $textformat =~ s/['";\s]//g; } my $startq = ""; my $endq = ""; my $startfixq = ""; my $endfixq = ""; my $css_class = ""; if ($args =~ /\bquoteclass=(\S+)/i) { $css_class = $1; $css_class =~ s/[^\w\.\-]//g; } my $quote_style = Q_FIXED; my $fancyquote = $args =~ /\bfancyquote\b/i; if ($fancyquote || ($textformat eq 'flowed')) { $quote_style = ($textformat eq 'flowed') ? Q_FLOWED : Q_FANCY; $startq = ($css_class) ? qq|
| : $StartFlowedQuote; $endq = $EndFlowedQuote; if (!$nonfixed) { $startfixq = $StartFixedQuote; $endfixq = $EndFixedQuote; } } elsif ($args =~ /\bquote\b/i) { $quote_style = Q_SIMPLE; } ## Check if certain charsets should be left alone if ($args =~ /\basis=(\S+)/i) { my $t = lc $1; $t =~ s/['"]//g; local($_); foreach (split(':', $t)) { $asis{$_} = 1; } } ## Check MIMECharSetConverters if charset should be left alone my($charcnv, $real_charset_name) = readmail::MAILload_charset_converter($charset); if (defined($charcnv) && $charcnv eq '-decode-') { $asis{$charset} = 1; } ## Fixup any EOL mess $$data =~ s/\r?\n/\n/g; $$data =~ s/\r/\n/g; ## Check if max-width set if (($maxwidth > 0) && ($quote_style != Q_FLOWED)) { $$data =~ s/^(.*)$/&break_line($1, $maxwidth)/gem; } ## Convert data according to charset if (!$asis{$charset}) { # Registered in CHARSETCONVERTERS if (defined($charcnv) && defined(&$charcnv)) { $$data = &$charcnv($$data, $real_charset_name); # Other } else { warn qq/\n/, qq/Warning: Unrecognized character set: $charset\n/, qq/ Message-Id: <$mhonarc::MHAmsgid>\n/, qq/ Message Number: $mhonarc::MHAmsgnum\n/; mhonarc::htmlize($data); } } else { mhonarc::htmlize($data); } # XXX: Initial algorithms for flowed and fancy processing # used the s/// operator. However, for large messages, this could # cause perl to crash (seg fault) (verified with perl v5.6.1 and # v5.8.0). Hence, code changed to use m//g and substr(), which # appears to avoid perl crashing (ehood, Dec 2002). # # Initial code for format=flowed contributed by Ken Hirsch (May 2002). # text/plain; format=flowed defined in RFC2646 if ($quote_style == Q_FLOWED) { my($chunk, $qd, $offset); my $currdepth = 0; my $ret=''; $$data =~ s!^\n!!mg; while (length($$data) > 0) { # Divide message into chunks by "quote-depth", # which is the number of leading > signs ($qd) = $$data =~ /^((?:>)*)/; $chunk = ''; pos($$data) = 0; if ($qd eq '') { # Non-quoted text: We special case this since we can # use a fixed pattern to grab the chunk. if ($$data =~ /^(?=>)/mgo) { $offset = pos($$data); $chunk = substr($$data, 0, $offset); substr($$data, 0, $offset) = ''; } else { $chunk = $$data; $$data = ''; } } else { # Quoted text: It would be nice to not have # to compile a new pattern each time. if ($$data =~ /^(?!$qd(?!>))/mg) { $offset = pos($$data); $chunk = substr($$data, 0, $offset); substr($$data, 0, $offset) = ''; } else { $chunk = $$data; $$data = ''; } $chunk =~ s/^$qd_re//mg; } $chunk =~ s/^$qd ?//mg; # N.B. also takes care of # space-stuffing $chunk =~ s/^-- $/--/mg; # special case for '-- ' my @paras = split(/(\n\n)/, $chunk); my $para; $chunk = ''; foreach $para (@paras) { if ($para =~ /\A\n+\Z/) { $chunk .= "
\n" x length($para); next; } $para =~ s/^\n/
/; my $nls = ($para =~ tr/\n/\n/); if (($para =~ / \n/) || ($para =~ / \Z/) || ($nls < 1) || (($nls == 1) && ($para =~ /\S/) && ($para =~ /\n\Z/))) { # flowed format $para =~ s/^(|.*[^ ])(\n)(?!\Z)/ ($keepspace ? &preserve_space($1) : $1) . '
'.$2/mgex; if ($nonfixed) { $chunk .= $para; } else { $chunk .= ''.$para.''; } } else { # fixed format $para =~ s/^(.*)$ /&break_line($1, $maxwidth+(length($1)-&html_length($1))) /gemx if $maxwidth > 0; if ($nonfixed) { $para =~ s/(\n)/
$1/g; if ($keepspace) { $para =~ s/^(.*)$/&preserve_space($1)/gem; } $chunk .= $para; } else { $chunk .= $startfixq . $para . $endfixq; } } } my $newdepth = length($qd)/length('>'); if ($currdepth < $newdepth) { $chunk = $startq x ($newdepth - $currdepth) . $chunk; } elsif ($currdepth > $newdepth) { $chunk = $endq x ($currdepth - $newdepth) . $chunk; } $currdepth = $newdepth; $ret .= $chunk; } if ($currdepth > 0) { $ret .= $endq x $currdepth; } ## Post-processing cleanup $ret =~ s/<\/pre>\s*
\s*((?:
\s*)+)/<\/pre>$1/g; $$data = $ret; } elsif ($quote_style == Q_FANCY) { # Fancy code very similiar to flowed code, but simplier. # Some stuff is "duplicated", but this is written to use # ${HQuoteChars}, which would allow for alternate # quote characters beyond '>'. my($chunk, $qd, $qd_re, $offset); my $currdepth = 0; my $ret=''; # Compress '>'s to have not spacing, makes latter patterns # simplier. $$data =~ s/(?:^|\G(${HQuoteChars}))[ ]?/$1/gm; while (length($$data) > 0) { ($qd) = $$data =~ /\A((?:${HQuoteChars})*)/o; $chunk = ''; pos($$data) = 0; if ($qd eq '') { # Non-quoted text: We special case this since we can # use a fixed pattern to grab the chunk. if ($$data =~ /^(?=${HQuoteChars})/mgo) { $offset = pos($$data); $chunk = substr($$data, 0, $offset); substr($$data, 0, $offset) = ''; } else { $chunk = $$data; $$data = ''; } } else { # Quoted text: Make sure any regex specials are escaped # before using in pattern. It would be nice to not have # to compile a new pattern each time. $qd_re = "\Q$qd\E"; if ($$data =~ /^(?!$qd_re(?!${HQuoteChars}))/mg) { $offset = pos($$data); $chunk = substr($$data, 0, $offset); substr($$data, 0, $offset) = ''; } else { $chunk = $$data; $$data = ''; } $chunk =~ s/^$qd_re//mg; } if ($nonfixed) { $chunk =~ s/(\n)/
$1/g; if ($keepspace) { $chunk =~ s/^(.*)$/&preserve_space($1)/gem; } } else { # GUI browsers ignore first \n after, so we double it # to make sure a blank line is rendered $chunk =~ s/\A\n/\n\n/; $chunk = $startfixq . $chunk . $endfixq; } $qd =~ s/\s+//g; my $newdepth = html_length($qd); if ($currdepth < $newdepth) { $chunk = $startq x ($newdepth - $currdepth) . $chunk; } elsif ($currdepth > $newdepth) { $chunk = $endq x ($currdepth - $newdepth) . $chunk; } $currdepth = $newdepth; $ret .= $chunk; } if ($currdepth > 0) { $ret .= $endq x $currdepth; } $$data = $ret; } else { ## Check for simple quoting if ($quote_style == Q_SIMPLE) { $$data =~ s@^( ?${HQuoteChars})(.*)$@$1$2@gom; } ## Check if using nonfixed font if ($nonfixed) { $$data =~ s/(\r?\n)/
$1/g; if ($keepspace) { $$data =~ s/^(.*)$/&preserve_space($1)/gem; } } else { $$data = '' . $$data . ''; } } ## Convert URLs to hyperlinks $$data =~ s@($HUrlExp)@$1@gio unless $nourl; $$data = ' ' if $$data eq ''; ($$data); } ##---------------------------------------------------------------------------## sub do_html { my($fields, $data, $isdecode, $args) = @_; if (readmail::MAILis_excluded('text/html')) { return (&$readmail::ExcludedPartFunc('text/plain HTML')); } my $html_filter = readmail::load_filter('text/html'); if (defined($html_filter) && defined(&$html_filter)) { return (&$html_filter($fields, $data, $isdecode, readmail::get_filter_args( 'text/html', 'text/*', $html_filter))); } else { require 'mhtxthtml.pl'; return (m2h_text_html::filter($fields, $data, $isdecode, readmail::get_filter_args( 'text/html', 'text/*', 'm2h_text_html::filter'))); } } ##---------------------------------------------------------------------------## sub preserve_space { my($str) = shift; 1 while $str =~ s/^([^\t]*)(\t+)/$1 . ' ' x (length($2) * 8 - length($1) % 8)/e; $str =~ s/ /\ /g; $str; } ##---------------------------------------------------------------------------## sub break_line { my($str) = shift; my($width) = shift; my($q, $new) = ('', ''); my($try, $trywidth, $len); ## Translate tabs to spaces 1 while $str =~ s/^([^\t]*)(\t+)/$1 . ' ' x (length($2) * 8 - length($1) % 8)/e; ## Do nothing if str <= width return $str if length($str) <= $width; ## See if str begins with a quote char if ($str =~ s/^([ ]?(?:$QuoteChars[ ]?)+)//o) { $q = $1; $width -= length($q); } ## Create new string by breaking up str while ($str ne "") { # If $str less than width, break out if (length($str) <= $width) { $new .= $q . $str; last; } # handle case where no-whitespace line larger than width if (($str =~ /^(\S+)/) && (($len = length($1)) >= $width)) { $new .= $q . $1; substr($str, 0, $len) = ""; next; } # Break string at whitespace $try = ''; $trywidth = $width; $try = substr($str, 0, $trywidth); if ($try =~ /(\S+)$/) { $trywidth -= length($1); $new .= $q . substr($str, 0, $trywidth); } else { $new .= $q . $try; } substr($str, 0, $trywidth) = ''; } continue { $new .= "\n" if $str; } $new; } sub html_length { local $_; my $len = length($_[0]); foreach ($_[0] =~ /(\&[^;]+);/g) { $len -= length($_); } $len; } ##---------------------------------------------------------------------------## 1;