# CLB with HTML::Parser #a text filter plug-in with HTML::Parser; # ver 0.01 2004.5.17 by Kazeburo use MT; use strict; use HTML::Parser; MT->add_text_filter(clb_with_htmlparser => { label => 'CLB with HTML::Parser', on_format => sub { &filtercode }, }); sub filtercode{ my $text = shift; my $ctx = shift; if($text){ $text=~s/\r\n/\n/g; $text=~s/\r/\n/g; chomp($text); $text .= "\n"; my @paras = split(/\n\n+/, $text); my $filter_block=""; my $ret; foreach my $para (@paras){ $ret .= qq(

) unless $filter_block; my $p=CLBTagFilter->new; $p->set_filter_block($filter_block); $p->set_target("_blank"); $p->parse($para); $p->eof; my $p_para=$p->out_buffer; $filter_block = $p->get_filter_block; $p_para =~ s!\n*\n*$!! unless($filter_block); $p_para .= "\n\n" if($filter_block eq "pre"); $ret .= $p_para; $ret .= qq(

\n) unless $filter_block; } $ret =~ s!

\n*!

!gi; $ret =~ s!\n*

!

!gi; $ret =~ s!

\n*

!!gi; return $ret; }else{ return $text; } } ####################################################################### package CLBTagFilter; use strict; use base qw(HTML::Parser); use URI::Find; sub set_filter_block{ my($self,$filter_block) = @_; $self->{_filter_block}=$filter_block; } sub get_filter_block{ shift->{_filter_block}; } sub set_target{ my($self,$target) = @_; $self->{_target}=$target; } sub blocklevelcheck{ my($self,$tag) = @_; my %block=map {$_=>1} qw(table ol ul dl pre select form blockquote div q h4); return exists $block{$tag}; } ####################################################################### sub _accum_buffer { my $self = shift; push @{$self->{_buffer}}, @_; } sub out_buffer { my $self = shift; my $val = ""; if(ref($self->{_buffer}) eq "ARRAY"){ $val=join '', @{$self->{_buffer}}; }else{ $val = $self->{_buffer}; } return $val; } ####################################################################### sub start { my ($self, $tag, $attr, $attrseq, $origtext) = @_; my $new_text=""; if($self->get_filter_block eq "pre"){ $origtext =~ s//>/g; $new_text.=$origtext; }else{ if($tag eq "a"){ $attr->{target} = $self->{_target} if($self->{_target} && !$attr->{target}); } $new_text .= "<$tag"; $new_text .= " " if(scalar keys %{$attr} >0); $new_text .= join ' ' , map{ qq($_="$attr->{$_}") } keys %{$attr}; $new_text .= ">"; } if($self->blocklevelcheck($tag)){ $self->set_filter_block($tag); $self->_accum_buffer("

\n"); } $self->_accum_buffer($new_text); } sub text{ my ($self, $text) = @_; my $new_text; if($self->get_filter_block eq "pre"){ $text =~ s//>/g; $new_text=$text; }elsif($self->get_filter_block){ #$text =~ s/\n/
\n/g; $new_text .= $text; }else{ $text =~ s/\n/
\n/g; $new_text .= $text; } $self->_accum_buffer($new_text); } sub end{ my ($self, $tag, $origtext) = @_; $self->set_filter_block("") if $self->blocklevelcheck($tag); if($self->get_filter_block eq "pre"){ $origtext =~ s//>/g; } $self->_accum_buffer($origtext); $self->_accum_buffer("

") if $self->blocklevelcheck($tag); } 1;