added version checks, fixed some issues ;)

[selfforum.git] / selfforum-cgi / shared / Encode / Posting.pm

diff --git a/selfforum-cgi/shared/Encode/Posting.pm b/selfforum-cgi/shared/Encode/Posting.pm
index ffafbf1c0f3aa848f1d43163c615acbe21a800ba..4ff9410304f8044b4c8f186b9e99e28d7590d81c 100644 (file)
--- a/selfforum-cgi/shared/Encode/Posting.pm
+++ b/selfforum-cgi/shared/Encode/Posting.pm
@@ -11,16 +11,26 @@ package Encode::Posting;
 ################################################################################
 
 use strict;
 ################################################################################
 
 use strict;

+use vars qw(
+  @EXPORT
+  $VERSION
+);

 
 use Encode::Plain; $Encode::Plain::utf8 = 1;
 use CheckRFC;
 
 
 use Encode::Plain; $Encode::Plain::utf8 = 1;
 use CheckRFC;
 

+################################################################################
+#
+# Version check
+#
+$VERSION = do { my @r =(q$Revision$ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
+

 ################################################################################
 #
 # Export
 #
 use base qw(Exporter);
 ################################################################################
 #
 # Export
 #
 use base qw(Exporter);

-@Encode::Posting::EXPORT = qw(
+@EXPORT = qw(

   encoded_body
   answer_field
   message_field
   encoded_body
   answer_field
   message_field


@@ -71,7 +81,7 @@ sub encoded_body ($;$) {
   my @rawlinks;
   push @rawlinks => [$1 => $2] while ($posting =~ /\[([Ll][Ii][Nn][Kk]):\s*([^\]\s]+)\s*\]/g);
   my @links = grep {
   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<^(?:\.?\.?/(?!/)|\?)>
       and is_URL (rel_uri ($_ -> [1], $base) => 'http'))
     or is_URL (($_ -> [1] =~ /^[Vv][Ii][Ee][Ww]-[Ss][Oo][Uu][Rr][Cc][Ee]:(.+)/)[0] || '' => 'http')
     or (  $_ -> [1] =~ m<^(?:\.?\.?/(?!/)|\?)>
       and is_URL (rel_uri ($_ -> [1], $base) => 'http'))


@@ -158,8 +168,8 @@ sub answer_field ($$) {
   my $area = $$posting;
   my $qchar = $params -> {quoteChars};
 
   my $area = $$posting;
   my $qchar = $params -> {quoteChars};
 

-  $area =~ s/<br>/\n/g;            # <br> => \n
-  $area =~ s/&(?:#160|nbsp);/ /g;  # nbsp => ' '
+  $area =~ s/<br(?:\s*\/)?>/\n/g;  # <br> => \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
 
   $area =~ s/^(.)/\177$1/gm if ($params -> {quoteArea}); # shift a quoting character
   $area =~ s/^(\177+)/$qchar x length ($1)/gem;          # decode normalized quoting characters


@@ -208,12 +218,12 @@ sub message_field ($$) {
   my $posting = ${+shift};
   my $params = shift || {};
 
   my $posting = ${+shift};
   my $params = shift || {};
 

-  my $break = '<br>';
+  my $break = '<br />';

 
   if ($params -> {quoting}) {       # quotes are displayed as special?
     my @array = [0 => []];
 
 
   if ($params -> {quoting}) {       # quotes are displayed as special?
     my @array = [0 => []];
 

-    for (split /<br>/ => $posting) {
+    for (split /<br(?:\s*\/)?>/ => $posting) {

       my $l = length ((/^(\177*)/)[0]);
       if ($array[-1][0] == $l) {
         push @{$array[-1][-1]} => $_;
       my $l = length ((/^(\177*)/)[0]);
       if ($array[-1][0] == $l) {
         push @{$array[-1][-1]} => $_;


@@ -225,7 +235,7 @@ sub message_field ($$) {
     shift @array unless @{$array[0][-1]};
 
     my $ll=0;
     shift @array unless @{$array[0][-1]};
 
     my $ll=0;

-    $posting = join '<br>' => map {
+    $posting = join $break => map {

       my $string = $_->[0]
         ? (($ll and $ll != $_->[0]) ? $break : '') .
           join join ($break => @{$_->[-1]})
       my $string = $_->[0]
         ? (($ll and $ll != $_->[0]) ? $break : '') .
           join join ($break => @{$_->[-1]})