Template.pm, Template/Posting.pm, Encode/Posting.pm: fixed some bugs (that produced...

[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 b12420fd2dbcfec03ee59125ac1c73ff7e235e99..80c414bfe3fa188dd05b2726c211bb6abd0703b5 100644 (file)
--- a/selfforum-cgi/shared/Encode/Posting.pm
+++ b/selfforum-cgi/shared/Encode/Posting.pm
@@ -2,7 +2,7 @@
 
 # ====================================================
 # Autor: n.d.p. / 2001-01-07
 
 # ====================================================
 # Autor: n.d.p. / 2001-01-07

-# lm   : n.d.p. / 2001-01-08
+# lm   : n.d.p. / 2001-02-25

 # ====================================================
 # Funktion:
 #      Spezielle Codierung eines Postingtextes
 # ====================================================
 # Funktion:
 #      Spezielle Codierung eines Postingtextes


@@ -12,15 +12,14 @@ use strict;
 
 package Encode::Posting;
 
 
 package Encode::Posting;
 

-use vars qw(@ISA @EXPORT);
+use vars qw(@EXPORT);

 use Encode::Plain; $Encode::Plain::utf8 = 1;
 
 # ====================================================
 # Funktionsexport
 # ====================================================
 
 use Encode::Plain; $Encode::Plain::utf8 = 1;
 
 # ====================================================
 # Funktionsexport
 # ====================================================
 

-require Exporter;
-@ISA    = qw(Exporter);
+use base qw(Exporter);

 @EXPORT = qw(encoded_body answer_field message_field);
 
 ################################
 @EXPORT = qw(encoded_body answer_field message_field);
 
 ################################


@@ -49,7 +48,7 @@ sub encoded_body ($;$) {
 
   # normaler Link
   $posting =~ s{\[link:\s*
 
   # normaler Link
   $posting =~ s{\[link:\s*

-               ((?:ftp://                        # hier beginnt $1
+               ((?:ftp://                          # hier beginnt $1

                |   https?://
                |   about:
                |   view-source:
                |   https?://
                |   about:
                |   view-source:


@@ -60,14 +59,14 @@ sub encoded_body ($;$) {
                |   telnet://
                |   wais://
                |   prospero://
                |   telnet://
                |   wais://
                |   prospero://

-               |   \.\.?/                        # relativ auf dem server
-               |   /                             # absolut auf dem server
-               |   (?:[a-zA-Z.\d]+)?\??          # im forum
-               )   [^\s<'()\[\]]+                # auf jeden Fall kein \s und kein ] etc.
-               )                                 # hier ist $1 zuende
-               \s*(?:\]|(\s|\(|\)|<br>))         # der Begrenzer (\s, ] oder Zeilenende)
+               |   \.\.?/                          # relativ auf dem server
+               |   /                               # absolut auf dem server
+               |   (?:[a-zA-Z.\d]+)?\??            # im forum
+               )   [^\s<'()\[\]]+                  # auf jeden Fall kein \s und kein ] etc.
+               )                                   # hier ist $1 zuende
+               \s*(?:\]|(\s|&(?!amp;)|\(|\)|<br>)) # der Begrenzer (\s, ] oder Zeilenende)

               }
               }

-              {<a href="$1">$1</a>$2}gix;        # und der Link
+              {<a href="$1">$1</a>$2}gix;          # und der Link

 
   # javascript-links extra
   my $klammer1='\((?:[^)])*\)';
 
   # javascript-links extra
   my $klammer1='\((?:[^)])*\)';


@@ -76,27 +75,27 @@ sub encoded_body ($;$) {
   my $klammer4="\\((?:$klammer3|(?:[^)])*)\\)";
 
   $posting =~ s{\[link:\s*
   my $klammer4="\\((?:$klammer3|(?:[^)])*)\\)";
 
   $posting =~ s{\[link:\s*

-               (javascript:                      # hier beginnt $1
+               (javascript:                        # hier beginnt $1

                (?:
                (?:

-                 $klammer4                       # Klammern bis Verschachtelungstiefe 4 (sollte reichen?)
-               | '[^\'\\]*(?:\\.[^\'\\]*)*'      # mit ' quotierter String, J.F. sei gedankt
-                                                 # im String sind Escapes zugelassen (also auch \')
-                                                 # damit werden (korrekt gesetzte) Javascript-Links moeglich
-               | [^\s<()'\]]+)+                  # auf jeden Fall kein \s und kein ] (ausser im String)
-               )                                 # hier ist $1 zuende
-               \s*(?:\s|\]|(\(|\)|<br>))         # der Begrenzer (\s, ] oder Zeilenende)
+                 $klammer4                         # Klammern bis Verschachtelungstiefe 4 (sollte reichen?)
+               | '[^\'\\]*(?:\\.[^\'\\]*)*'        # mit ' quotierter String, J.F. sei gedankt
+                                                   # im String sind Escapes zugelassen (also auch \')
+                                                   # damit werden (korrekt gesetzte) Javascript-Links moeglich
+               | [^\s<()'\]]+)+                    # auf jeden Fall kein \s und kein ] (ausser im String)
+               )                                   # hier ist $1 zuende
+               \s*(?:\s|\]|(\(|\)|&(?!amp;)|<br>)) # der Begrenzer (\s, ] oder Zeilenende)

               }
               }

-              {<a href="$1">$1</a>$2}gix;        # und der Link
+              {<a href="$1">$1</a>$2}gix;          # und der Link

 
   # images
   $posting =~ s{\[image:\s*
                ((?:https?://
 
   # images
   $posting =~ s{\[image:\s*
                ((?:https?://

-               |   \.\.?/                        # relativ auf dem server
-               |   /                             # absolut auf dem server
-               |   (?:[a-zA-Z.\d]+)?\??          # im forum
-               )   [^\s<'()\[\]]+                # auf jeden Fall kein \s und kein ] etc.
-               )                                 # hier ist $1 zuende
-               \s*(?:\]|(\s|\(|\)|<br>))         # der Begrenzer (\s, ] oder Zeilenende)
+               |   \.\.?/                          # relativ auf dem server
+               |   /                               # absolut auf dem server
+               |   (?:[a-zA-Z.\d]+)?\??            # im forum
+               )   [^\s<'()\[\]]+                  # auf jeden Fall kein \s und kein ] etc.
+               )                                   # hier ist $1 zuende
+               \s*(?:\]|(\s|\(|\)|&(?!amp;)|<br>)) # der Begrenzer (\s, ] oder Zeilenende)

               }
               {<img src="$1" border=0 alt="">$2}gix; # und das Bild
 
               }
               {<img src="$1" border=0 alt="">$2}gix; # und das Bild
 


@@ -113,13 +112,13 @@ sub encoded_body ($;$) {
                |   telnet://
                |   wais://
                |   prospero://
                |   telnet://
                |   wais://
                |   prospero://

-               |   \.\.?/                        # relativ auf dem server
-               |   /                             # absolut auf dem server
-               |   [a-zA-Z\d]+(?:\.html?|/)      # im forum (koennen eh nur threads oder verweise
-                                                 # auf tiefere verzeichnisse sein)
-               )[^\s<'()\]]+                     # auf jeden Fall kein \s und kein ] etc. (s.o.)
-               )                                 # hier ist $1 zuende
-               \s*(?:\]|(\s|\(|\)|<br>))         # der Begrenzer (\s, ] oder Zeilenende)
+               |   \.\.?/                          # relativ auf dem server
+               |   /                               # absolut auf dem server
+               |   [a-zA-Z\d]+(?:\.html?|/)        # im forum (koennen eh nur threads oder verweise
+                                                   # auf tiefere verzeichnisse sein)
+               )[^\s<'()\]]+                       # auf jeden Fall kein \s und kein ] etc. (s.o.)
+               )                                   # hier ist $1 zuende
+               \s*(?:\]|(\s|\(|\)|&(?!amp;)|<br>)) # der Begrenzer (\s, ] oder Zeilenende)

               }
               {<iframe src="$1" width="90%" height="90%"><a href="$1">$1</a></iframe>$2}gix;
 
               }
               {<iframe src="$1" width="90%" height="90%"><a href="$1">$1</a></iframe>$2}gix;
 


@@ -152,7 +151,7 @@ sub answer_field ($$) {
 
   my $qchar = $params -> {quoteChars};
 
 
   my $qchar = $params -> {quoteChars};
 

-  $area =~ s/(?:^|(<br>))(?!<br>)/$1\177/g if ($params -> {quoteArea}); # Antwortfeld quoten?!
+  $area =~ s/(?:^|(<br>))(?!<br>)/$1 || '' . "\177"/eg if ($params -> {quoteArea}); # Antwortfeld quoten?!

   $area =~ s/\177/$qchar/g; # normalisierte Quotes jedenfalls in Chars umsetzen
 
   # HTML-Zeug zurueckuebersetzen
   $area =~ s/\177/$qchar/g; # normalisierte Quotes jedenfalls in Chars umsetzen
 
   # HTML-Zeug zurueckuebersetzen


@@ -199,7 +198,7 @@ sub message_field ($$) {
 
     foreach $line (split (/<br>/,$posting)) { # Zeilenweise gucken,
       ($q) = ($line =~ /^(\177+)/g);          # wieviele
 
     foreach $line (split (/<br>/,$posting)) { # Zeilenweise gucken,
       ($q) = ($line =~ /^(\177+)/g);          # wieviele

-      $level = length ($q);                   # Quotingchars am Anfang stehen
+      $level = length ($q or '');             # Quotingchars am Anfang stehen

       if ($level != $last_level) {            # wenn sich was verandert...
                                               # ... dann TU ETWAS!
 
       if ($level != $last_level) {            # wenn sich was verandert...
                                               # ... dann TU ETWAS!