X-Git-Url: https://git.p6c8.net/selfforum.git/blobdiff_plain/42e7ab8a13679442f2cd7524ab7fa38bb2166951..f91793544f0d5c7f978e5cf6214d9882d7c4db7c:/selfforum-cgi/shared/Encode/Posting.pm diff --git a/selfforum-cgi/shared/Encode/Posting.pm b/selfforum-cgi/shared/Encode/Posting.pm index e35e648..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,12 +221,12 @@ sub message_field ($$) { my $posting = ${+shift}; my $params = shift || {}; - my $break = '
'; + 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]} => $_; @@ -226,7 +238,7 @@ sub message_field ($$) { shift @array unless @{$array[0][-1]}; my $ll=0; - $posting = join '
' => map { + $posting = join $break => map { my $string = $_->[0] ? (($ll and $ll != $_->[0]) ? $break : '') . join join ($break => @{$_->[-1]}) @@ -244,7 +256,7 @@ sub message_field ($$) { \$posting; } -# keeping 'require' happy +# keep 'require' happy 1; #