X-Git-Url: https://git.p6c8.net/selfforum.git/blobdiff_plain/ba659b53059e637777865e646f0f2a6fb7f2988e..f69abb46fffae25b517a067d1afc532c67fd9ca3:/selfforum-cgi/shared/Encode/Posting.pm diff --git a/selfforum-cgi/shared/Encode/Posting.pm b/selfforum-cgi/shared/Encode/Posting.pm index b12420f..80c414b 100644 --- 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 -# lm : n.d.p. / 2001-01-08 +# lm : n.d.p. / 2001-02-25 # ==================================================== # Funktion: # Spezielle Codierung eines Postingtextes @@ -12,15 +12,14 @@ use strict; package Encode::Posting; -use vars qw(@ISA @EXPORT); +use vars qw(@EXPORT); 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); ################################ @@ -49,7 +48,7 @@ sub encoded_body ($;$) { # normaler Link $posting =~ s{\[link:\s* - ((?:ftp:// # hier beginnt $1 + ((?:ftp:// # hier beginnt $1 | https?:// | about: | view-source: @@ -60,14 +59,14 @@ sub encoded_body ($;$) { | 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|\(|\)|
)) # 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;)|\(|\)|
)) # der Begrenzer (\s, ] oder Zeilenende) } - {$1$2}gix; # und der Link + {$1$2}gix; # und der Link # javascript-links extra my $klammer1='\((?:[^)])*\)'; @@ -76,27 +75,27 @@ sub encoded_body ($;$) { 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|\]|(\(|\)|
)) # 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;)|
)) # der Begrenzer (\s, ] oder Zeilenende) } - {$1$2}gix; # und der Link + {$1$2}gix; # und der Link # 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|\(|\)|
)) # 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;)|
)) # der Begrenzer (\s, ] oder Zeilenende) } {$2}gix; # und das Bild @@ -113,13 +112,13 @@ sub encoded_body ($;$) { | 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|\(|\)|
)) # 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;)|
)) # der Begrenzer (\s, ] oder Zeilenende) } {$2}gix; @@ -152,7 +151,7 @@ sub answer_field ($$) { my $qchar = $params -> {quoteChars}; - $area =~ s/(?:^|(
))(?!
)/$1\177/g if ($params -> {quoteArea}); # Antwortfeld quoten?! + $area =~ s/(?:^|(
))(?!
)/$1 || '' . "\177"/eg if ($params -> {quoteArea}); # Antwortfeld quoten?! $area =~ s/\177/$qchar/g; # normalisierte Quotes jedenfalls in Chars umsetzen # HTML-Zeug zurueckuebersetzen @@ -199,7 +198,7 @@ sub message_field ($$) { foreach $line (split (/
/,$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!