X-Git-Url: https://git.p6c8.net/selfforum.git/blobdiff_plain/489e7846289d4fb66eb4b9fab0fed4af719b98ee..f91793544f0d5c7f978e5cf6214d9882d7c4db7c:/selfforum-cgi/shared/Encode/Posting.pm?ds=sidebyside diff --git a/selfforum-cgi/shared/Encode/Posting.pm b/selfforum-cgi/shared/Encode/Posting.pm index c0815f4..ff7b65c 100644 --- a/selfforum-cgi/shared/Encode/Posting.pm +++ b/selfforum-cgi/shared/Encode/Posting.pm @@ -4,23 +4,36 @@ package Encode::Posting; # # # File: shared/Encode/Posting.pm # # # -# Authors: André Malo , 2001-04-10 # +# Authors: André Malo # # # # Description: prepare a Posting text for saving and visual (HTML) output # # # ################################################################################ use strict; +use vars qw( + @EXPORT +); use Encode::Plain; $Encode::Plain::utf8 = 1; use CheckRFC; +################################################################################ +# +# Version check +# +# last modified: +# $Date$ (GMT) +# by $Author$ +# +sub VERSION {(q$Revision$ =~ /([\d.]+)\s*$/)[0] or '0.0'} + ################################################################################ # # Export # use base qw(Exporter); -@Encode::Posting::EXPORT = qw( +@EXPORT = qw( encoded_body answer_field message_field @@ -60,7 +73,7 @@ sub encoded_body ($;$) { my $params = shift; $posting =~ s/\015\012|\015|\012/\n/g; # normalize newlines - $posting =~ s/[^\S\n]$//gm; # kill whitespaces at the end of all lines + $posting =~ s/[^\S\n]+$//gm; # kill whitespaces at the end of all lines $posting =~ s/\s+$//; # kill whitespaces (newlines) at the end of the string (text) # check the special syntaxes: @@ -71,9 +84,9 @@ sub encoded_body ($;$) { my @rawlinks; push @rawlinks => [$1 => $2] while ($posting =~ /\[([Ll][Ii][Nn][Kk]):\s*([^\]\s]+)\s*\]/g); my @links = grep { - is_URL ( $_ -> [1] => ':ALL') + is_URL ( $_ -> [1] => qw(http ftp news nntp telnet gopher mailto)) or is_URL (($_ -> [1] =~ /^[Vv][Ii][Ee][Ww]-[Ss][Oo][Uu][Rr][Cc][Ee]:(.+)/)[0] || '' => 'http') - or ( $_ -> [1] =~ m<^\.?\.?/(?!/)|\?> + or ( $_ -> [1] =~ m<^(?:\.?\.?/(?!/)|\?)> and is_URL (rel_uri ($_ -> [1], $base) => 'http')) } @rawlinks; @@ -83,7 +96,7 @@ sub encoded_body ($;$) { push @rawimages => [$1 => $2] while ($posting =~ /\[([Ii][Mm][Aa][Gg][Ee]):\s*([^\]\s]+)\s*\]/g); my @images = grep { is_URL ($_ -> [1] => 'strict_http') - or ( $_ -> [1] =~ m<^\.?\.?/(?!/)|\?> + or ( $_ -> [1] =~ m<^(?:\.?\.?/(?!/)|\?)> and is_URL (rel_uri ($_ -> [1], $base) => 'http')) } @rawimages; @@ -93,8 +106,7 @@ sub encoded_body ($;$) { push @rawiframes => [$1 => $2] while ($posting =~ /\[([Ii][Ff][Rr][Aa][Mm][Ee]):\s*([^\]\s]+)\s*\]/g); my @iframes = grep { is_URL ($_ -> [1] => 'http') - or is_URL (($_ -> [1] =~ /^[Vv][Ii][Ee][Ww]-[Ss][Oo][Uu][Rr][Cc][Ee]:(.+)/)[0] || '' => 'http') - or ( $_ -> [1] =~ m<^\.?\.?/(?!/)|\?> + or ( $_ -> [1] =~ m<^(?:\.?\.?/(?!/)|\?)> and is_URL (rel_uri ($_ -> [1], $base) => 'http')) } @rawiframes; @@ -159,8 +171,8 @@ sub answer_field ($$) { my $area = $$posting; my $qchar = $params -> {quoteChars}; - $area =~ s/
/\n/g; #
=> \n - $area =~ s/&(?:#160|nbsp);/ /g; # nbsp => ' ' + $area =~ s//\n/g; #
=> \n + $area =~ s/&(?:#160|nbsp);/ /g; # nbsp => ' ' $area =~ s/^(.)/\177$1/gm if ($params -> {quoteArea}); # shift a quoting character $area =~ s/^(\177+)/$qchar x length ($1)/gem; # decode normalized quoting characters @@ -209,11 +221,12 @@ sub message_field ($$) { my $posting = ${+shift}; my $params = shift || {}; + my $break = '
'; if ($params -> {quoting}) { # quotes are displayed as special? my @array = [0 => []]; - for (split /
/ => $posting) { + for (split // => $posting) { my $l = length ((/^(\177*)/)[0]); if ($array[-1][0] == $l) { push @{$array[-1][-1]} => $_; @@ -224,10 +237,14 @@ sub message_field ($$) { } shift @array unless @{$array[0][-1]}; - $posting = join '
' => map { - $_->[0] - ? join join ('
' => @{$_->[-1]}) => ($params->{startCite}, $params->{endCite}) - : (join '
' => @{$_->[-1]}); + my $ll=0; + $posting = join $break => map { + my $string = $_->[0] + ? (($ll and $ll != $_->[0]) ? $break : '') . + join join ($break => @{$_->[-1]}) + => ($params->{startCite}, $params->{endCite}) + : (join $break => @{$_->[-1]}); + $ll = $_->[0]; $string; } @array; } @@ -239,7 +256,7 @@ sub message_field ($$) { \$posting; } -# keeping 'require' happy +# keep 'require' happy 1; #