charset results from the CPAN

AxKit2
    my $output = "<xmlmail>\n" .
                "<header>\n" .
                $from . $date . $subject . "@to" . "@cc" . "@x_headers" .
                "</header>\n" .
                "<body>";
    
    # Do all the body parts
    my @bodies = $mail->bodies;
    while (@bodies) {
        my ($type, $fh) = splice(@bodies, 0, 2);
        if ($type =~ /html/i) {
            # warn("Found a html body part\n");
            my $in = do { local $/; <$fh> };

            my $string = '';

            my ($lfh, $file) = tempfile(DIR => "/tmp");
            binmode($lfh, ":utf8") if $] > 5.007;
            print $lfh $in;
            close($lfh);
            
            warn("Tidying: $file\n");
            open(TIDY, "tidy --hide-comments true --force-output true --show-warnings false --word-2000 true -upper -numeric -quiet -asxml -utf8 $file |") || die $!;
            binmode(TIDY, ":utf8") if $] > 5.007;
            my $tidied = '';
            while (<TIDY>) {
                $tidied .= $_;
            }
            close(TIDY);
            unlink($file);
            
            if ($tidied) {
                # warn("Using XML::LibXSLT\n");
                eval {
                my $xslfile = $client->config->docroot . "/htmlstrip.xsl";
                # warn("($xslfile) : $@");
                my $p = XML::LibXML->new;
                local $XML::LibXML::match_cb;
                #local $XML::LibXML::read_cb;
                #local $XML::LibXML::close_cb;
                #local $XML::LibXML::open_cb;
                $p->recover(1);
                my $xsld = $p->parse_file($xslfile);
                my $xslt = XML::LibXSLT->new->parse_stylesheet($xsld);
                my $dom = $p->parse_string($tidied);
                my $res = $xslt->transform($dom);
                $string = $xslt->output_string($res);
                $string =~ s/<\?xml[^>]*\?>//; # strip xml decl
                $string =~ s/\A.*<htmlpart>/<htmlpart>/s;
                };
           }
           
           if (!$string) {
                $string = '';
                warn("Lynxing file\n");
                my ($lfh, $file) = tempfile(DIR => "/tmp");
                binmode($lfh, ":utf8") if $] > 5.007;
                print $lfh $in;
                close($lfh);
                $ENV{LYNX_TEMP_SPACE} = "/tmp";
                open(LYNX, "lynx -dump -raw -nolist -display_charset=utf-8 -width=72 -force_html $file 2>&1 |") || die $!;
                while (<LYNX>) {
                    $string .= $_;
                }
                close(LYNX);
                unlink($file);
                $string =~ s/\n{2,}/\n\n/g;
                $string = "<htmlpart pre='1'>" . 
                          xml_escape(wrap("","",$string)) . 
                          "</htmlpart>";
            }
            
            if (!$string) {
                # XML::LibXML failed, as did lynx, so just display the raw HTML
                $string = "<htmlpart pre='1'>" . xml_escape(wrap("","",$in)) . "</htmlpart>";
            }
            
            $output .= $string;
        }
        else {
            # assume plain text
            $output .= "<textpart>";
            while (my $line = <$fh>) {
                $output .= ($line =~ /^\s*$/ ? "\n" : xml_escape(wrap("","",$line)));
            }
            $output .= "</textpart>";
        }
    }
    
    $output .= "</body>\n" .
                "</xmlmail>\n";
    
    # ensure this is parsable before returning
    my $p = XML::LibXML->new;
    $p->recover(1);
    my $dom = eval { $p->parse_string($output) };
    if ($@) {
        warn($@);
        return "<xmlmail><body>Unable to parse this email</body></xmlmail>";
    }
    $dom->setEncoding('UTF-8');
    return $dom->documentElement->toString;
}

# secret changes on each restart, but that's fine as the user will have to
# login again anyway
our $SECRET = join('', map {chr} map {40 + rand(85)} (0..10));

sub encookie {
    my ($login) = @_;
    my $date = time;
    return "$login:$date:" . sha1_hex("$login:$date:$SECRET");
}

sub decookie {
    my ($cookie) = @_;
    my ($login, $date, $sha1) = split(':', $cookie, 3);
    no warnings 'uninitialized';
    die "cookie '$cookie' does not match this login" unless $sha1 eq sha1_hex("$login:$date:$SECRET");
    die "cookie timed out" unless (time - $date) < 3600; # 1 hour timeout
    return $login;
( run in 0.803 second using v1.01-cache-2.11-cpan-39bf76dae61 )