# -*-Perl-*-
#######################################################################
### $Id: plaintext.txt,v 1.13 2006/09/16 23:40:28 mate Exp $
### Required bloglines-0.80 later

package plaintext;

use strict;
use Jcode;

#######################################################################
# CONFIGURATION

my %MAP = (
		   '&' => '&',
		   '"' => '"',
		   '&lt;' => '<',
		   '&gt;' => '>',
		   '&apos;' => '\'',
		   '&nbsp;' => ' ',
		   '&copy;' => '(C)',
		   '&#13;' => '',
		   '&#34;' => '"',
		   '&#38;' => '&',
		   '&#39;' => '\'',
		   '&#039;' => '\'',
		   '&#40;' => '(',
		   '&#41;' => ')',
		   '&#42;' => '*',
		   '&#46;' => '.',
		   '&#60;' => '<',
		   '&#62;' => '>',
		   '&#64;' => '@',
		   '&#91;' => '[',
		   '&#92;' => "\\",
		   '&#93;' => ']',
		   '&#160;' => ' ',
		   '&#187;' => '��',
          );

my @ITEM = qw(title creator dc:creator subject description );
my $BLOCKQUOTE = 1;
my $FOLDLEN = 72;
my $LINK_MARK = '* ';

#######################################################################

my $DEBUG = 0;
my $RE = join('|', keys %MAP);

sub setup {

    push @Bloglines::OPTIONS, "plaintext";

    1;
}

sub filter {

    return unless exists $Bloglines::OPTCTL{plaintext};

    my ($pkg, $file, $rss) = @_;

	foreach my $site (@{$rss||[]}) {
		foreach my $i (@ITEM) {
			if (exists $site->{$i}) {
				$site->{$i} = formatter($site->{$i});
			}
		}
		foreach my $item (@{$site->{items}}) {
			foreach my $i (@ITEM) {
				if (exists $item->{$i}) {
					$item->{$i} = formatter($item->{$i});
				}
			}
		}
	}
}

sub formatter {

    my ($string, $fold) = @_;

    $string = Jcode->new($string, 'utf8')->h2z->euc;

    if ($BLOCKQUOTE) {
        $string = blockquote($string, $fold || $FOLDLEN);
    } else {
        my ($footnote);
        $string = jfold(linkextor($string, \$footnote), $fold || $FOLDLEN);
        $string .= "\n\n$footnote" if defined $footnote;
    }

    $string =~ s|\n[\s\t]+\n|\n\n|g if ($string =~ /\n[\s\t]+\n/);
    $string =~ s|\n\n\n+|\n\n|g if ($string =~ /\n\n\n/);
    $string =~ s|^\n+|| if ($string =~ /^\n/);
    $string =~ s|\n+$|| if ($string =~ /\n$/);

    warn "OUTPUT--------\n$string\n========\n" if $DEBUG;

    return $string;

}

sub blockquote {

    my ($string, $fold) = @_;
    my @chunks = split(m/(?=<\/?[Bb][Ll][Oo][Cc][Kk][Qq][Uu][Oo][Tt][Ee])/, $string);
    my $N = scalar @chunks;
    my (@string, $text, $footnote);

    for (my $i = 0; $i < $N; $i++) {
        next unless defined $chunks[$i];
        my $chunk = $chunks[$i];

        warn "chunk[$i]: ",length($chunk)," => $chunk\n" if $DEBUG;

        if ($chunk =~ /^<\/?
                       [Bb][Ll][Oo][Cc][Kk][Qq][Uu][Oo][Tt][Ee]
                       \s*
                       (.*?) # $1 => $args
                       \s*>
                       (.*)  # $2 => $text
                       $/sx) {

            $text = defined $2 ? $2 : next;
            warn "text[$i] => $text\n" if $DEBUG;
            $text = linkextor($text, \$footnote);

            if (unpack("a2", $chunk) ne '</') { # blockquote start
                $text = jfold($text, $fold - 2);
                citation(\$text);
            } else { # end
                $text = jfold($text, $fold);
            }
        } else {
            $text = linkextor($chunk, \$footnote);
            $text = jfold($text, $fold);
        }
        push @string, $text;
    }
    push @string, "\n\n$footnote" if defined $footnote;

    return join('', @string);

}

sub linkextor {

    my ($string, $footref) = @_;
    my @chunks = split(m/(?=<\/?[Aa](?:\s+|\s*>))/, $string);
    my $N = scalar @chunks;
    my (@string, $text);

    for (my $i = 0; $i < $N; $i++) {
        next unless defined $chunks[$i];
        my $chunk = $chunks[$i];

        if ($chunk =~ /^<\/?
                       [Aa]
                       \s*
                       (.*?) # $1 => $args
                       \s*>
                       (.*)  # $2 => $text
                       $/sx) {

            my $args = defined $1 ? $1 : "";
            $text = defined $2 ? $2 : next;
            warn "text[$i] => $text\n" if $DEBUG;
            decode(\$text);
            if (unpack("a2", $chunk) ne '</' && $args =~ m/[Hh][Rr][Ee][Ff]\s*=\s*(["'])(.*?)\1/) {
                $$footref .= "$LINK_MARK$text\n$2\n\n" if $text ne "";
                # $text .= '[*]';
            }
        } else {
            $text = $chunk;
            decode(\$text);
        }
        push @string, $text;
    }

    return join('', @string);

}

sub decode {

    my ($strref) = @_;

    $$strref =~ s|\s*</?[Pp][Rr][Ee][^>]*?>|\n|gs if ($$strref =~ /<\/?[Pp][Rr][Ee]/);
    $$strref =~ s|\s*<[Bb][Rr][^>]*?>|\n|gs if ($$strref =~ /<[Bb][Rr]/);
    $$strref =~ s|\s*</[Pp]\s*>|\n|g if ($$strref =~ /<\/[Pp]\s*>/);
    # $$strref =~ s/<(?:[^>'"]*|".*?"|'*.?')+>//gs if ($$strref =~ /</);
    $$strref =~ s/<[^>]*>//gs if ($$strref =~ /</);

    # �Ō��
    $$strref =~ s|($RE)|$MAP{$1}|gi if ($$strref =~ /\&/);

}

sub citation {

    my ($strref, $level, $mark) = @_;

    $$strref =~ s/^(.+)/\n$1/ if $$strref !~ /^\n/;
    $$strref =~ s/\n+$// if $$strref =~ /\n$/;
    $level ||= 1;
    $mark ||= '> ';
    $mark = $mark x $level;

    $$strref =~ s/\n/\n$mark/g;
    $$strref =~ s/^(\n$mark)/\n$1/;
    $$strref .= "\n\n";

}

sub jfold {

    my ($str, $foldlen) = @_;
    my $ret = "";
    my $len = 0;

    $str =~ s|^[\s\t]+|| if ($str =~ /^[\s\t]+/);

    $foldlen ||= 72;
    while($str =~ m{(\n) |                 #
                    ([\x00-\x7f]) |        # ASCII
                    (\x8e[\xa0-\xdf]) |    # JIS X 0201 Katakana
                    (\x8f[\xa1-\xfe]{2}) | # JIS X 0212:1990
                    ([\xa1-\xfe]{2}) |     # JIS X 0208:1997
                    .}gx) {
        if (defined $1) { $ret .= $1; $len = 0 };
        if (defined $2) { $ret .= $2; $len++ };
        if (defined $3) { $ret .= $3; $len++ };
        if (defined $4) { $ret .= $4; $len += 2 };
        if (defined $5) { $ret .= $5; $len += 2 };

        if ($foldlen <= $len) { $ret .= "\n"; $len = 0 }
    }
    chomp $ret;

    return $ret;

}

1;

__END__
### Local Variables:
### mode: perl
### End:

=head1 NAME

plaintext.pl - format HTML as plaintext for mail

=head1 SYNOPSIS

=head1 DESCRIPTION

=head1 AUTHOR

Yutaka Kojima E<lt>yutaka@asmate.netE<gt>

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

The updated version is available from
http://www.asmate.net/software/perl/bloglines/plugins/

=cut