From 489e7846289d4fb66eb4b9fab0fed4af719b98ee Mon Sep 17 00:00:00 2001 From: ndparker <> Date: Thu, 19 Apr 2001 12:40:21 +0000 Subject: [PATCH 1/1] new kernel implemented (not only programming style changes), several bugs fixed, comments added, style changes --- selfforum-cgi/shared/CheckRFC.pm | 178 +++-- selfforum-cgi/shared/Encode/Plain.pm | 799 +++++++++++++--------- selfforum-cgi/shared/Encode/Posting.pm | 383 ++++++----- selfforum-cgi/shared/Posting/Write.pm | 8 +- selfforum-cgi/shared/Template.pm | 337 +++++---- selfforum-cgi/shared/Template/Forum.pm | 89 +-- selfforum-cgi/shared/Template/Posting.pm | 206 +++--- selfforum-cgi/shared/Template/_conf.pm | 5 +- selfforum-cgi/user/config/answer.tmp.xml | 2 +- selfforum-cgi/user/config/fo_view.xml | 12 + selfforum-cgi/user/config/forum.tmp.xml | 38 +- selfforum-cgi/user/config/posting.tmp.xml | 35 + selfforum-cgi/user/fo_posting.pl | 9 +- selfforum-cgi/user/fo_view.pl | 2 +- 14 files changed, 1266 insertions(+), 837 deletions(-) diff --git a/selfforum-cgi/shared/CheckRFC.pm b/selfforum-cgi/shared/CheckRFC.pm index 3a1ed0c..ddde67f 100644 --- a/selfforum-cgi/shared/CheckRFC.pm +++ b/selfforum-cgi/shared/CheckRFC.pm @@ -4,23 +4,39 @@ package CheckRFC; # # # File: shared/CheckRFC.pm # # # -# Authors: Andre Malo , 2001-03-30 # +# Authors: Andre Malo , 2001-04-14 # # # # Description: implement several string checks on RFC correctness # # # ################################################################################ use strict; -use vars qw(%url $email @EXPORT); +use vars qw( + $v56 + %url + @email + @EXPORT + @ISA +); -use autouse 'Carp' => qw(croak); +$v56 = eval q[ + local $SIG{__DIE__}; + require 5.6.0; +]; + +use Carp qw(croak); ################################################################################ # # Export # -use base qw(Exporter); -@EXPORT = qw(is_URL is_email); +require Exporter; +@ISA = qw(Exporter); + +@EXPORT = qw( + is_URL + is_email +); ### is_URL ($@) ################################################################ # @@ -28,7 +44,8 @@ use base qw(Exporter); # # Params: $string string to check # @schemes possible URL schemes in $string -# qw(http ftp news nntp telnet gopher wais mailto file prospero) +# qw( http strict_http ftp news nntp telnet +# gopher wais mailto strict_mailto file prospero) # if there's no scheme given, 'http' is default # use ':ALL' (without quotes) for all schemes # @@ -36,12 +53,27 @@ use base qw(Exporter); # sub is_URL ($@) { my ($string, @schemes) = @_; + + return unless (defined ($string) and length ($string)); + @schemes = qw(http) unless (@schemes); @schemes = keys %url if (@schemes == 1 and $schemes[0] eq ':ALL'); for (@schemes) { croak "unknown url scheme '$_'" unless exists $url{$_}; - return 1 if $string =~ /$url{$_}/; + unless (/mailto/) { + return 1 if ($string =~ /$url{$_}/); + } + else { + return unless ($string =~ /^mailto:(.+)/); + + if ($_ eq 'mailto') { + return 1 if (is_email ($1)); + } + elsif ($_ eq 'strict_mailto') { + return 1 if (is_email ($1,1)); + } + } } # no match => return false @@ -52,20 +84,25 @@ sub is_URL ($@) { # # check email (comments can be nested) # -# Params: $string string to check +# Params: $string - string to check +# $strict - (optional) check strict RFC syntax (no TLD needed) if true # # Return: Status code (Bool) # -sub is_email ($) { +sub is_email ($;$) { my $string = shift; + my $strict = shift; # false if any non-ascii chars + return unless (defined ($string) and length ($string)); return if $string =~ /[\200-\377]/; # remove nested comments - while ($string =~ s/\([^()]*\)//g) {}; + 1 while ($string =~ s/\([^()]*\)//g); + + return ($string =~ /^$email[0]$/) unless $strict; - return ($string =~ /^$email$/); + return ($string =~ /^$email[1]$/); } ### BEGIN # (1) ################################################################ @@ -75,41 +112,59 @@ sub is_email ($) { BEGIN { # Thanx to J. Friedl: - my $esc = '\\\\'; + my $esc = '\\\\'; my $Period = '\.'; - my $space = '\040'; + my $space = '\040'; my $tab = '\t'; - my $OpenBR = '\['; + my $OpenBR = '\['; my $CloseBR = '\]'; - my $OpenParen = '\('; + my $OpenParen = '\('; my $CloseParen = '\)'; - my $NonASCII = '\x80-\xff'; + my $NonASCII = '\x80-\xff'; my $ctrl = '\000-\037'; - my $CRlist = '\n\015'; - my $qtext = qq/[^$esc$NonASCII$CRlist\"]/; - my $dtext = qq/[^$esc$NonASCII$CRlist$OpenBR$CloseBR]/; + my $CRlist = '\n\015'; + my $qtext = qq/[^$esc$NonASCII$CRlist\"]/; + my $dtext = qq/[^$esc$NonASCII$CRlist$OpenBR$CloseBR]/; my $quoted_pair = qq< $esc [^$NonASCII] >; - my $ctext = qq< [^$esc$NonASCII$CRlist()] >; - my $Cnested = qq< $OpenParen $ctext* (?: $quoted_pair $ctext* )* $CloseParen >; - my $comment = qq< $OpenParen $ctext* (?: (?: $quoted_pair | $Cnested ) $ctext* )* $CloseParen >; - my $X = qq< [$space$tab]* (?: $comment [$space$tab]* )* >; + my $ctext = qq< [^$esc$NonASCII$CRlist()] >; + my $Cnested = qq< $OpenParen $ctext* (?: $quoted_pair $ctext* )* $CloseParen >; + my $comment = qq< $OpenParen $ctext* (?: (?: $quoted_pair | $Cnested ) $ctext* )* $CloseParen >; + my $X = qq< [$space$tab]* (?: $comment [$space$tab]* )* >; my $atom_char = qq/[^($space)<>\@,;:\".$esc$OpenBR$CloseBR$ctrl$NonASCII]/; - my $atom = qq< $atom_char+ (?!$atom_char) >; - my $quoted_str = qq< \" $qtext * (?: $quoted_pair $qtext * )* \" >; - my $word = qq< (?: $atom | $quoted_str ) >; + my $atom = qq< $atom_char+ (?!$atom_char) >; + my $quoted_str = qq< \" $qtext * (?: $quoted_pair $qtext * )* \" >; + my $word = qq< (?: $atom | $quoted_str ) >; my $domain_ref = $atom; my $domain_lit = qq< $OpenBR (?: $dtext | $quoted_pair )* $CloseBR >; my $sub_domain = qq< (?: $domain_ref | $domain_lit ) $X >; - my $domain = qq< $sub_domain (?: $Period $X $sub_domain )* >; - my $route = qq< \@ $X $domain (?: , $X \@ $X $domain )* : $X >; - my $local_part = qq< $word $X (?: $Period $X $word $X )* >; - my $addr_spec = qq< $local_part \@ $X $domain >; - my $route_addr = qq[ < $X (?: $route )? $addr_spec > ]; - my $phrase_ctrl = '\000-\010\012-\037'; - my $phrase_char = qq/[^()<>\@,;:\".$esc$OpenBR$CloseBR$NonASCII$phrase_ctrl]/; - my $phrase = qq< $word $phrase_char * (?: (?: $comment | $quoted_str ) $phrase_char * )* >; - $email = qq< $X (?: $addr_spec | $phrase $route_addr ) >; - $email = qr /$email/x; + my $domain; + + @email = (); + for $domain ( + qq< $sub_domain (?: $Period $X $sub_domain )+ >, + qq< $sub_domain (?: $Period $X $sub_domain )* > + ) { + my $route = qq< \@ $X $domain (?: , $X \@ $X $domain )* : $X >; + my $local_part = qq< $word $X (?: $Period $X $word $X )* >; + my $addr_spec = qq< $local_part \@ $X $domain >; + my $route_addr = qq[ < $X (?: $route )? $addr_spec > ]; + my $phrase_ctrl = '\000-\010\012-\037'; + my $phrase_char = qq/[^()<>\@,;:\".$esc$OpenBR$CloseBR$NonASCII$phrase_ctrl]/; + my $phrase = qq< $word $phrase_char * (?: (?: $comment | $quoted_str ) $phrase_char * )* >; + my $email = qq< $X (?: $addr_spec | $phrase $route_addr ) >; + + if ($v56) { + eval q< + local $SIG{__DIE__}; + $email = qr/$email/x; + >; + } + else { + $email =~ s/\s+//g; + } + + push @email => $email; + } } ### BEGIN # (2) ################################################################ @@ -143,7 +198,7 @@ BEGIN { my $password = "(?:(?:$uchar|[;?&=])*)"; my $port = '(?:[0-5]?\d\d?\d?\d?|6[0-4]\d\d\d|65[0-4]\d\d|655[0-2]\d|6553[0-5])'; my $ip4part = '(?:[01]?\d\d?|2[0-4]\d|25[0-5])'; - my $hostnumber = '(?:(?!0+\.0+\.0+\.0+)'."$ip4part\\.$ip4part\\.$ip4part\\.$ip4part)"; + my $hostnumber = '(?:(?!0+\.0+\.0+\.0+)(?!255\.255\.255\.255)'."$ip4part\\.$ip4part\\.$ip4part\\.$ip4part)"; my $toplabel = "(?:(?:$alpha(?:$alphadigit|-)*$alphadigit)|$alpha)"; my $domainlabel = "(?:(?:$alphadigit(?:$alphadigit|-)*$alphadigit)|$alphadigit)"; my $hostname = "(?:(?:$domainlabel\\.)*$toplabel)"; @@ -172,6 +227,7 @@ BEGIN { my $search = "(?:(?:$httpuchar|[;:\@&=~])*)"; my $hpath = "(?:$hsegment(?:/$hsegment)*)"; my $httpurl = "(?:http://$hostport(?:/$hpath(?:\\?$search)?)?(?:#$xchar*)?)"; + my $strict_httpurl = "(?:http://$hostport(?:/$hpath(?:\\?$search)?)?)"; # GOPHER (see also RFC1436) my $gopher_plus = "(?:$xchar*)"; @@ -179,10 +235,6 @@ BEGIN { my $gtype = "(?:$xchar)"; my $gopherurl = "(?:gopher://$hostport(?:/$gtype(?:$selector(?:%09$search(?:%09$gopher_plus)?)?)?)?)"; - # MAILTO (see also RFC822) - my $encoded822addr = "(?:$email)"; - my $mailtourl = "(?:mailto:$encoded822addr)"; - # NEWS (see also RFC1036) my $article = "(?:(?:$uchar|[;/?:&=])+\@$host)"; my $group = "(?:$alpha(?:$alpha|$digit|[.+_-])*)"; @@ -212,18 +264,38 @@ BEGIN { my $ppath = "(?:$psegment(?:/$psegment)*)"; my $prosperourl = "(?:prospero://$hostport/$ppath(?:$fieldspec)*)"; - %url = ( - http => qr/^$httpurl$/, - ftp => qr/^$ftpurl$/, - news => qr/^$newsurl$/, - nntp => qr/^$nntpurl$/, - telnet => qr/^$telneturl$/, - gopher => qr/^$gopherurl$/, - wais => qr/^$waisurl$/, - mailto => qr/^$mailtourl$/, - file => qr/^$fileurl$/, - prospero => qr/^$prosperourl$/ - ); + if ($v56) { + eval q[%url = ( + http => qr/^$httpurl$/, + strict_http => qr/^$strict_httpurl$/, + ftp => qr/^$ftpurl$/, + news => qr/^$newsurl$/, + nntp => qr/^$nntpurl$/, + telnet => qr/^$telneturl$/, + gopher => qr/^$gopherurl$/, + wais => qr/^$waisurl$/, + mailto => 0, + strict_mailto => 0, + file => qr/^$fileurl$/, + prospero => qr/^$prosperourl$/ + );]; + } + else { + %url = ( + http => "^$httpurl\$", + strict_http => "^$strict_httpurl\$", + ftp => "^$ftpurl\$", + news => "^$newsurl\$", + nntp => "^$nntpurl\$", + telnet => "^$telneturl\$", + gopher => "^$gopherurl\$", + wais => "^$waisurl\$", + mailto => 0, + strict_mailto => 0, + file => "^$fileurl\$", + prospero => "^$prosperourl\$" + ); + } } # keeping require happy diff --git a/selfforum-cgi/shared/Encode/Plain.pm b/selfforum-cgi/shared/Encode/Plain.pm index 2fe5634..f2085ce 100644 --- a/selfforum-cgi/shared/Encode/Plain.pm +++ b/selfforum-cgi/shared/Encode/Plain.pm @@ -1,403 +1,534 @@ -# Encode/Plain.pm - -# ==================================================== -# Autor: n.d.p. / 2001-01-07 -# lm : n.d.p. / 2001-02-25 -# ==================================================== -# Funktion: -# Codierung von non-ASCII-Zeichen fuer -# HTML -# ==================================================== - -use strict; - package Encode::Plain; -require 5.6.0; +################################################################################ +# # +# File: shared/Encode/Plain.pm # +# # +# Authors: André Malo , 2001-04-12 # +# # +# Description: Encode text for HTML Output (entities, spaces) # +# # +################################################################################ -use vars qw(@EXPORT %sonder %unimap $utf8); +use strict; +use vars qw( + @EXPORT + %sonder + %unimap + $utf8 + $v56 +); -# ==================================================== -# Funktionsexport -# ==================================================== +$v56 = eval {local $SIG{__DIE__}; require 5.6.0;}; +################################################################################ +# +# Export +# use base qw(Exporter); @EXPORT = qw(plain multiline toUTF8); -################################ -# sub plain +### sub myunpack ############################################################### +# +# if perl version < 5.6 use myunpack instead of unpack 'U' ;( +# +# Params: $string - UTF8-encoded string to unpack +# +# Return: Number - unpacked UTF8 # -# einfache Sonderzeichen -> -# Entity-Codierung -################################ +sub myunpack ($) { + return unless defined $_[0]; + + my @c = map {ord} split // => shift; + + return ($c[0] & 31) << 6 | $c[1] & 63 + if ( + @c == 2 + and ($c[0] & 224) == 192 + and ($c[1] & 192) == 128 + ); + + return ($c[0] & 15) << 12 | ($c[1] & 63) << 6 | $c[2] && 63 + if ( + @c == 3 + and ($c[0] & 240) == 224 + and ($c[1] & 192) == 128 + and ($c[2] & 192) == 128 + ); + + return; +} +### sub plain ################################################################## +# +# encode characters of plain text into entities for HTML output +# (includes < > " &) +# (excludes space problem) +# +# Params: $old - String (or scalar reference) to encode +# $ref - (optional) (hash reference) Options +# (-amp -except -utf8) +# +# Return: encoded string (or scalar reference) +# sub plain ($;$) { - my ($old,$ref)=@_; + my ($old, $ref) = @_; my $exreg; - return \'' unless (defined $old); + return unless (defined $old); - my $new=(ref ($old))?$$old:$old;; - $ref=($ref or {}); + my $new = ref ($old) ? $$old : $old; + $ref = $ref || {}; + $new ='' unless (defined $new); - # Ausnahmen - my $except=exists($ref->{-except}); + my $unicode = defined ($ref -> {-utf8}) + ? $ref -> {-utf8} + : $utf8; + + # Exceptions + # + my $except = exists($ref->{-except}); if ($except) { - # Referenz, also Liste uebergeben -> umwandeln in Regex if (ref ($ref -> {-except})) { - $exreg = join ('|',map {quotemeta $_} @{$ref -> {-except}});} - - # keine Referenz, also Regex angegeben + # turn list into a regex + # + $exreg = join '|' => map {quotemeta $_} @{$ref -> {-except}}; + } else { + # quote regex delimiters + # $exreg = $ref -> {-except}; - $exreg =~ s/\//\\\//g;}} # LTS :-) + $exreg =~ s|/|\\/|g; + } + } + # encode the &-character + # if (lc($ref->{-amp}) eq 'soft') { if ($except) { - $new=~s/($exreg)|(?:\&(?!(?:#[Xx][\da-fA-F]+|#\d+|[a-zA-Z]+);))/(length($1))?$1:'&'/eg;} - + $new=~s/($exreg)|(?:\&(?!(?:#[Xx][\da-fA-F]+|#\d+|[a-zA-Z]+);))/defined($1)?$1:'&'/eg; + } else { - $new=~s/\&(?!(?:#[Xx][\da-fA-F]+|#\d+|[a-zA-Z]+);)/&/g;}} - + $new=~s/\&(?!(?:#[Xx][\da-fA-F]+|#\d+|[a-zA-Z]+);)/&/g; + } + } elsif (lc($ref->{-amp}) ne 'no') { if ($except) { - $new=~s/($exreg)|\&/(length($1))?$1:'&'/eg;} - + $new=~s/($exreg)|\&/defined($1)?$1:'&'/eg; + } else { - $new=~s/\&/&/g;}} + $new=~s/\&/&/g; + } + } - # Weitere Zeichen + # further characters + # if ($except) { - $new =~ s/($exreg)|/(length($1))?$1:'>'/eg; - $new =~ s/($exreg)|\|/(length($1))?$1:'|'/eg; # nich wahr - $new =~ s/($exreg)|"/(length($1))?$1:'"'/eg; # Diese Zeile wird den Bannerklickern - # zu schaffen machen, sowas aber auch... - - # Der grosse Hash - if ($utf8 or $ref -> {-utf8}) { + $new =~ s/($exreg)|/defined($1)?$1:'>'/eg; + $new =~ s/($exreg)|\|/defined($1)?$1:'|'/eg; + $new =~ s/($exreg)|"/defined($1)?$1:'"'/eg; + + # the big hash + # + if ($unicode) { my $x; - $new =~ s/($exreg)|([\300-\337][\200-\277]|[\340-\357][\200-\277][\200-\277])/ - length($1)?$1:(exists($unimap{$x = unpack('U',$2)})?$unimap{$x}:"&#$x;")/eg;} - - $new =~ s/($exreg)|([\177-\377])/(length($1))?$1:$sonder{$2}/eg;} - + if ($v56) { + $new =~ s/($exreg)|([\300-\337][\200-\277]|[\340-\357][\200-\277][\200-\277])/ + defined($1) + ? $1 + : ( exists($unimap{$x = unpack('U',$2)}) + ? $unimap{$x} + : "&#$x;" + ) + /eg; + } + else { + $new =~ s/($exreg)|([\300-\337][\200-\277]|[\340-\357][\200-\277][\200-\277])/ + defined($1) + ? $1 + : ( exists($unimap{$x = myunpack($2)}) + ? $unimap{$x} + : "&#$x;" + ) + /eg; + } + } + $new =~ s/($exreg)|([\177-\377])/defined($1)?$1:$sonder{$2}/eg; + } else { + # no exceptions + # $new =~ s//>/g; $new =~ s/\|/|/g; $new =~ s/"/"/g; - # Der grosse Hash - if ($utf8 or $ref -> {-utf8}) { + # the big hash + # + if ($unicode) { my $x; - $new =~ s/([\300-\337][\200-\277]|[\340-\357][\200-\277][\200-\277])/ - exists($unimap{$x = unpack('U',$1)})?$unimap{$x}:"&#$x;"/eg;} - - $new =~ s/([\177-\377])/$sonder{$1}/g;} - - # Zeichen <= 31 - $new=~s/([\001-\010\013\014\016-\037])/'&#'.ord($1).';'/eg; + if ($v56) { + $new =~ s/([\300-\337][\200-\277]|[\340-\357][\200-\277][\200-\277])/ + exists($unimap{$x = unpack('U',$1)}) + ? $unimap{$x} + : "&#$x;" + /eg; + } + else { + $new =~ s/([\300-\337][\200-\277]|[\340-\357][\200-\277][\200-\277])/ + exists($unimap{$x = myunpack($1)}) + ? $unimap{$x} + : "&#$x;" + /eg; + } + } + $new =~ s/([\177-\377])/$sonder{$1}/g; + } + + # characters < 32, but whitespaces + # + $new=~s/([^\041-\377\000\s])/ + '&#' . ord($1) . ';' + /eg; $new=~s/\000/ /g; - # Rueckgabe - ref($old)?\$new:$new; + # return + # + ref $old + ? \$new + : $new; } -################################ -# sub multiline +### sub multiline ############################################################## +# +# solve the space problem # -# Whitespacecodierung -# fuer Leerzeilen -################################ +# Params: $old - String (or scalar reference): text to encode +# +# Return: scalar reference: encoded string +# +sub multiline ($) { + my $old = shift; + my $string=(ref ($old)) + ? $$old + : $old; -sub multiline { - my $old=shift; - my $string=(ref ($old))?$$old:$old; + $string='' unless (defined $string); - # Zeilenumbrueche normalisieren + # normalize newlines + # $string=~s/\015\012|\015|\012/\n/g; - # Zeilenumbrueche in
umwandeln + # turn \n into
+ # $string=~s/\n/
/g; - # mehr als ein aufeinanderfolgendes - # Leerzeichen in feste Leerzeichen umwandeln + # more than 1 space =>   + # $string=~s/(\s\s+)/(' ' x (length($1)-1)) . ' '/eg; - # Leerzeichen nach einem
in feste - # Spaces umwandeln - $string=~s/(?:^|(
))\s/$1 /g; + # Single Spaces after
=>   + # (save ascii arts ;) + # + $string=~s/(?:^|(
))\s/($1?$1:'').' '/eg; - # Rueckgabe + # return + # \$string; } +### sub toUTF8 ################################################################# +# +# map ISO-8859-1 to UTF8 +# +# Params: String or scalar reference: string to map +# +# Return: String or scalar reference: mapped string +# sub toUTF8 ($) { my $ref = shift; - my $string = ref($ref)?$$ref:$ref; - no warnings 'utf8'; - - $string =~ tr/\x80-\xff//CU; - - ref($ref)?\$string:$string; + my $string = ref($ref) + ? $$ref + : $ref; + + if ($v56) { + no warnings 'utf8'; + $string =~ tr/\x80-\xff//CU; + } + else { + $string =~ s + {([\x80-\xff])} + { chr((ord ($1) >> 6) | 192) + .chr((ord ($1) & 191)) + }eg; + } + + ref($ref) + ? \$string + : $string; } -# ==================================================== -# Modulinitialisierung -# ==================================================== - +################################################################################ +# +# package init +# BEGIN { $utf8 = 0; - # Latin 1 + geraten - %sonder=("\177" => '', # Delete-Zeichen - "\200" => '€', # Euro-Zeichen - "\201" => 'ü', # ue - DOS-Zeichensatz - "\202" => '‚', # einfaches Anfuehrungszeichen unten - "\203" => 'ƒ', # forte - "\204" => '„', # doppelte Anfuehrungszeichen unten - "\205" => '…', # drei punkte - "\206" => '†', # dagger - "\207" => '‡', # Dagger - "\210" => 'ˆ', # circ - "\211" => '‰', # Promille - "\212" => 'Š', # so ein S mit Haken drueber :-) - "\213" => '‹', # lsaquo - "\214" => 'Œ', # OE (so verhakelt - daenisch?) wer weiss das schon - "\215" => 'ì', # Codepage 850; - "\216" => 'Ž', # Z mit Haken drueber (Latin Extended B) - "\217" => 'Å', # Codepage 850 (Win) - "\220" => 'ü', # ue - Mac-Zeichensatz - "\221" => "'", # einfache Anfuehrungszeichen oben - "\222" => "'", # dito - "\223" => '“', # doppelte Anfuehrungszeichen oben - "\224" => '“', # dito - "\225" => '•', # Bullet - "\226" => '-', # Bindestrich - "\227" => '-', # dito - "\230" => '˜', # tilde...? - "\231" => '™', # Trade-Mark - "\232" => 'š', # kleines s mit Haken drueber - "\233" => '›', # rsaquo; - "\234" => 'œ', # oe verhakelt - "\235" => 'Ø', # Codepage 850 (Win) - "\236" => '×', # Codepage 850 (Win) - "\237" => 'Ÿ', # Y mit Punkten drueber - "\240" => ' ', # nbsp; - "\241" => '¡', # umgedrehtes ! - "\242" => '¢', # cent-Zeichen - "\243" => '£', # (engl.)Pfund-Zeichen - "\244" => '¤', # Waehrungszeichen - "\245" => '¥', # Yen halt :-) - "\246" => '¦', # eigentlich soll es wohl ein | sein .-) - "\247" => '§', # Paragraph - "\250" => '¨', # zwei Punkte oben - "\251" => '©', # (C) - "\252" => 'ª', # hochgestelltes unterstrichenes a - "\253" => '«', # left-pointing double angle quotation mark (besser koennte ichs auch nicht beschreiben...) - "\254" => '¬', # Negationszeichen - "\255" => '-', # Bindestrich - "\256" => '®', # (R) - "\257" => 'ß', # sz, was auch immer fuern Zeichensatz (DOS?) - "\260" => '°', # Grad-Zeichen - "\261" => '±', # Plusminus - "\262" => '²', # hoch 2 - "\263" => '³', # hoch 3 - "\264" => '´', # Acute - "\265" => 'µ', # my-Zeichen (griech) - "\266" => '¶', # Absatzzeichen - "\267" => '·', # Mal-Zeichen - "\270" => '¸', - "\271" => '¹', # hoch 1 - "\272" => 'º', # masculine ordinal indicator (spanish) - "\273" => '»', # right-pointing double angle quotation mark - "\274" => '¼', # 1/4 - "\275" => '½', # 1/2 - "\276" => '¾', # 3/4 - "\277" => '¿', # umgedrehtes ? - "\300" => 'À', - "\301" => 'Á', - "\302" => 'Â', - "\303" => 'Ã', - "\304" => 'Ä', - "\305" => 'Å', - "\306" => 'Æ', - "\307" => 'Ç', - "\310" => 'È', - "\311" => 'É', - "\312" => 'Ê', - "\313" => 'Ë', - "\314" => 'Ì', - "\315" => 'Í', - "\316" => 'Î', - "\317" => 'Ï', - "\320" => 'Ð', # keine Ahnung, was das wohl sein soll, auf jeden Fall was islaendisches... - "\321" => 'Ñ', - "\322" => 'Ò', - "\323" => 'Ó', - "\324" => 'Ô', - "\325" => 'Õ', - "\326" => 'Ö', - "\327" => '×', # eigentlich × funzt afaik aber nicht aufm Mac (ob das hier funktioniert, weiss ich nicht) - "\330" => 'Ø', - "\331" => 'Ù', - "\332" => 'Ú', - "\333" => 'Û', - "\334" => 'Ü', - "\335" => 'Ý', - "\336" => 'Þ', - "\337" => 'ß', - "\340" => 'à', - "\341" => 'á', - "\342" => 'â', - "\343" => 'ã', - "\344" => 'ä', - "\345" => 'å', - "\346" => 'æ', - "\347" => 'ç', - "\350" => 'è', - "\351" => 'é', - "\352" => 'ê', - "\353" => 'ë', - "\354" => 'ì', - "\355" => 'í', - "\356" => 'î', - "\357" => 'ï', - "\360" => 'ð', - "\361" => 'ñ', - "\362" => 'ò', - "\363" => 'ó', - "\364" => 'ô', - "\365" => 'õ', - "\366" => 'ö', - "\367" => '÷', - "\370" => 'ø', - "\371" => 'ù', - "\372" => 'ú', - "\373" => 'û', - "\374" => 'ü', - "\375" => 'ý', - "\376" => 'þ', - "\377" => 'ÿ'); + # Latin 1 + guessed + # + %sonder=( + "\177" => '', + "\200" => '€', + "\201" => 'ü', + "\202" => '‚', + "\203" => 'ƒ', + "\204" => '„', + "\205" => '…', + "\206" => '†', + "\207" => '‡', + "\210" => 'ˆ', + "\211" => '‰', + "\212" => 'Š', + "\213" => '‹', + "\214" => 'Œ', + "\215" => 'ì', + "\216" => 'Ž', + "\217" => 'Å', + "\220" => 'ü', + "\221" => "'", + "\222" => "'", + "\223" => '“', + "\224" => '“', + "\225" => '•', + "\226" => '-', + "\227" => '-', + "\230" => '˜', + "\231" => '™', + "\232" => 'š', + "\233" => '›', + "\234" => 'œ', + "\235" => 'Ø', + "\236" => '×', + "\237" => 'Ÿ', + "\240" => ' ', + "\241" => '¡', + "\242" => '¢', + "\243" => '£', + "\244" => '¤', + "\245" => '¥', + "\246" => '¦', + "\247" => '§', + "\250" => '¨', + "\251" => '©', + "\252" => 'ª', + "\253" => '«', + "\254" => '¬', + "\255" => '-', + "\256" => '®', + "\257" => 'ß', + "\260" => '°', + "\261" => '±', + "\262" => '²', + "\263" => '³', + "\264" => '´', + "\265" => 'µ', + "\266" => '¶', + "\267" => '·', + "\270" => '¸', + "\271" => '¹', + "\272" => 'º', + "\273" => '»', + "\274" => '¼', + "\275" => '½', + "\276" => '¾', + "\277" => '¿', + "\300" => 'À', + "\301" => 'Á', + "\302" => 'Â', + "\303" => 'Ã', + "\304" => 'Ä', + "\305" => 'Å', + "\306" => 'Æ', + "\307" => 'Ç', + "\310" => 'È', + "\311" => 'É', + "\312" => 'Ê', + "\313" => 'Ë', + "\314" => 'Ì', + "\315" => 'Í', + "\316" => 'Î', + "\317" => 'Ï', + "\320" => 'Ð', + "\321" => 'Ñ', + "\322" => 'Ò', + "\323" => 'Ó', + "\324" => 'Ô', + "\325" => 'Õ', + "\326" => 'Ö', + "\327" => '×', + "\330" => 'Ø', + "\331" => 'Ù', + "\332" => 'Ú', + "\333" => 'Û', + "\334" => 'Ü', + "\335" => 'Ý', + "\336" => 'Þ', + "\337" => 'ß', + "\340" => 'à', + "\341" => 'á', + "\342" => 'â', + "\343" => 'ã', + "\344" => 'ä', + "\345" => 'å', + "\346" => 'æ', + "\347" => 'ç', + "\350" => 'è', + "\351" => 'é', + "\352" => 'ê', + "\353" => 'ë', + "\354" => 'ì', + "\355" => 'í', + "\356" => 'î', + "\357" => 'ï', + "\360" => 'ð', + "\361" => 'ñ', + "\362" => 'ò', + "\363" => 'ó', + "\364" => 'ô', + "\365" => 'õ', + "\366" => 'ö', + "\367" => '÷', + "\370" => 'ø', + "\371" => 'ù', + "\372" => 'ú', + "\373" => 'û', + "\374" => 'ü', + "\375" => 'ý', + "\376" => 'þ', + "\377" => 'ÿ' + ); # Unicode-Mapping - %unimap=(128 => '€', - 129 => 'ü', - 130 => '‚', - 131 => 'ƒ', - 132 => '„', - 133 => '…', - 134 => '†', - 135 => '‡', - 136 => 'ˆ', - 137 => '‰', - 138 => 'Š', - 139 => '‹', - 140 => 'Œ', - 141 => 'ì', - 142 => 'Ž', - 143 => 'Å', - 144 => 'ü', - 145 => "'", - 146 => "'", - 147 => '“', - 148 => '“', - 149 => '•', - 150 => '-', - 151 => '-', - 152 => '˜', - 153 => '™', - 154 => 'š', - 155 => '›', - 156 => 'œ', - 157 => 'Ø', - 158 => '×', - 159 => 'Ÿ', - 160 => ' ', - 163 => '£', - 165 => '¥', - 167 => '§', - 169 => '©', - 171 => '«', - 173 => '-', - 174 => '®', - 175 => 'ß', - 180 => '´', - 184 => '¸', - 185 => '¹', - 187 => '»', - 192 => 'À', - 193 => 'Á', - 194 => 'Â', - 195 => 'Ã', - 196 => 'Ä', - 197 => 'Å', - 198 => 'Æ', - 199 => 'Ç', - 200 => 'È', - 201 => 'É', - 202 => 'Ê', - 203 => 'Ë', - 204 => 'Ì', - 205 => 'Í', - 206 => 'Î', - 207 => 'Ï', - 208 => 'Ð', - 209 => 'Ñ', - 210 => 'Ò', - 211 => 'Ó', - 212 => 'Ô', - 213 => 'Õ', - 214 => 'Ö', - 216 => 'Ø', - 217 => 'Ù', - 218 => 'Ú', - 219 => 'Û', - 220 => 'Ü', - 221 => 'Ý', - 222 => 'Þ', - 223 => 'ß', - 224 => 'à', - 225 => 'á', - 226 => 'â', - 227 => 'ã', - 228 => 'ä', - 229 => 'å', - 230 => 'æ', - 231 => 'ç', - 232 => 'è', - 233 => 'é', - 234 => 'ê', - 235 => 'ë', - 236 => 'ì', - 237 => 'í', - 238 => 'î', - 239 => 'ï', - 240 => 'ð', - 241 => 'ñ', - 242 => 'ò', - 243 => 'ó', - 244 => 'ô', - 245 => 'õ', - 246 => 'ö', - 247 => '÷', - 248 => 'ø', - 249 => 'ù', - 250 => 'ú', - 251 => 'û', - 252 => 'ü', - 253 => 'ý', - 254 => 'þ', - 255 => 'ÿ'); + %unimap=( + 128 => '€', + 129 => 'ü', + 130 => '‚', + 131 => 'ƒ', + 132 => '„', + 133 => '…', + 134 => '†', + 135 => '‡', + 136 => 'ˆ', + 137 => '‰', + 138 => 'Š', + 139 => '‹', + 140 => 'Œ', + 141 => 'ì', + 142 => 'Ž', + 143 => 'Å', + 144 => 'ü', + 145 => "'", + 146 => "'", + 147 => '“', + 148 => '“', + 149 => '•', + 150 => '-', + 151 => '-', + 152 => '˜', + 153 => '™', + 154 => 'š', + 155 => '›', + 156 => 'œ', + 157 => 'Ø', + 158 => '×', + 159 => 'Ÿ', + 160 => ' ', + 163 => '£', + 165 => '¥', + 167 => '§', + 169 => '©', + 171 => '«', + 173 => '-', + 174 => '®', + 175 => 'ß', + 180 => '´', + 184 => '¸', + 185 => '¹', + 187 => '»', + 192 => 'À', + 193 => 'Á', + 194 => 'Â', + 195 => 'Ã', + 196 => 'Ä', + 197 => 'Å', + 198 => 'Æ', + 199 => 'Ç', + 200 => 'È', + 201 => 'É', + 202 => 'Ê', + 203 => 'Ë', + 204 => 'Ì', + 205 => 'Í', + 206 => 'Î', + 207 => 'Ï', + 208 => 'Ð', + 209 => 'Ñ', + 210 => 'Ò', + 211 => 'Ó', + 212 => 'Ô', + 213 => 'Õ', + 214 => 'Ö', + 216 => 'Ø', + 217 => 'Ù', + 218 => 'Ú', + 219 => 'Û', + 220 => 'Ü', + 221 => 'Ý', + 222 => 'Þ', + 223 => 'ß', + 224 => 'à', + 225 => 'á', + 226 => 'â', + 227 => 'ã', + 228 => 'ä', + 229 => 'å', + 230 => 'æ', + 231 => 'ç', + 232 => 'è', + 233 => 'é', + 234 => 'ê', + 235 => 'ë', + 236 => 'ì', + 237 => 'í', + 238 => 'î', + 239 => 'ï', + 240 => 'ð', + 241 => 'ñ', + 242 => 'ò', + 243 => 'ó', + 244 => 'ô', + 245 => 'õ', + 246 => 'ö', + 247 => '÷', + 248 => 'ø', + 249 => 'ù', + 250 => 'ú', + 251 => 'û', + 252 => 'ü', + 253 => 'ý', + 254 => 'þ', + 255 => 'ÿ' + ); } -# making require happy +# keeping require happy 1; -# ==================================================== -# end of Encode::Plain -# ==================================================== \ No newline at end of file +# +# +### end of Encode::Plain ####################################################### \ No newline at end of file diff --git a/selfforum-cgi/shared/Encode/Posting.pm b/selfforum-cgi/shared/Encode/Posting.pm index 80c414b..c0815f4 100644 --- a/selfforum-cgi/shared/Encode/Posting.pm +++ b/selfforum-cgi/shared/Encode/Posting.pm @@ -1,230 +1,247 @@ -# Posting.pm +package Encode::Posting; -# ==================================================== -# Autor: n.d.p. / 2001-01-07 -# lm : n.d.p. / 2001-02-25 -# ==================================================== -# Funktion: -# Spezielle Codierung eines Postingtextes -# ==================================================== +################################################################################ +# # +# File: shared/Encode/Posting.pm # +# # +# Authors: André Malo , 2001-04-10 # +# # +# Description: prepare a Posting text for saving and visual (HTML) output # +# # +################################################################################ use strict; -package Encode::Posting; - -use vars qw(@EXPORT); use Encode::Plain; $Encode::Plain::utf8 = 1; +use CheckRFC; -# ==================================================== -# Funktionsexport -# ==================================================== - +################################################################################ +# +# Export +# use base qw(Exporter); -@EXPORT = qw(encoded_body answer_field message_field); +@Encode::Posting::EXPORT = qw( + encoded_body + answer_field + message_field +); -################################ -# sub encoded_body +### sub rel_uri ($$) ########################################################### +# +# generate an absolute URI from a absolute|relative one +# (not for public use) # -# Nachrichtentext in gueltiges -# HTML konvertieren -################################ +# Params: $uri - URI +# $base - base URI +# +# Return: abs URI as string +# +sub rel_uri ($$) { + my ($uri, $base) = @_; + + "http://$ENV{HTTP_HOST}". + ($uri =~ m|^/| + ? $uri + : "$base$uri"); +} +### sub encoded_body ($;$) ##################################################### +# +# prepare posting text for saving +# +# Params: $posting - scalar reference of the raw text +# $params - hash reference +# (quoteChars messages) +# +# Return: scalar reference of the encoded text +# sub encoded_body ($;$) { my $posting = ${+shift}; my $params = shift; - $posting =~ s/[ \t]$//gm; # Whitespaces am Zeilenende entfernen - $posting =~s /\s+$//; # Whitespaces am Stringende entfernen - $posting = ${plain (\$posting)}; # Sonderzeichen maskieren + $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+$//; # kill whitespaces (newlines) at the end of the string (text) + + # check the special syntaxes: + + my $base = $params -> {base_uri}; + # collect all [link:...] strings + # + my @rawlinks; + push @rawlinks => [$1 => $2] while ($posting =~ /\[([Ll][Ii][Nn][Kk]):\s*([^\]\s]+)\s*\]/g); + my @links = grep { + is_URL ( $_ -> [1] => ':ALL') + 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')) + } @rawlinks; + + # collect all [image:...] strings + # + my @rawimages; + 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<^\.?\.?/(?!/)|\?> + and is_URL (rel_uri ($_ -> [1], $base) => 'http')) + } @rawimages; + + # collect all [iframe:...] strings + # + my @rawiframes; + 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<^\.?\.?/(?!/)|\?> + and is_URL (rel_uri ($_ -> [1], $base) => 'http')) + } @rawiframes; + + # collect all [msg:...] strings + # + $params -> {messages} = {} unless (defined $params -> {messages}); + my %msg = map {lc($_) => $params -> {messages} -> {$_}} keys %{$params -> {messages}}; - # Quotingzeichen normalisieren (\177) - my $quote = plain($params -> {quoteChars}); - my $qquote = quotemeta $quote; - my $len = length ($quote); - $posting =~ s!^((?:$qquote)+)(.*)$!"\177" x (length($1)/$len) .$2!gem if (length ($qquote)); + my @rawmsgs; + push @rawmsgs => [$1 => $2] while ($posting =~ /\[([Mm][Ss][Gg]):\s*([^\]\s]+)\s*\]/g); + my @msgs = grep {exists ($msg{lc($_ -> [1])})} @rawmsgs; - # Multine - $posting = ${multiline (\$posting)}; + # encode Entities and special characters + # + $posting = ${plain (\$posting)}; - # normaler Link - $posting =~ s{\[link:\s* - ((?:ftp:// # hier beginnt $1 - | https?:// - | about: - | view-source: - | gopher:// - | mailto: - | news: - | nntp:// - | 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|&(?!amp;)|\(|\)|
)) # der Begrenzer (\s, ] oder Zeilenende) - } - {$1$2}gix; # und der Link - - # javascript-links extra - my $klammer1='\((?:[^)])*\)'; - my $klammer2="\\((?:$klammer1|(?:[^)])*)\\)"; - my $klammer3="\\((?:$klammer2|(?:[^)])*)\\)"; - my $klammer4="\\((?:$klammer3|(?:[^)])*)\\)"; - - $posting =~ s{\[link:\s* - (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|\]|(\(|\)|&(?!amp;)|
)) # der Begrenzer (\s, ] oder Zeilenende) - } - {$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|\(|\)|&(?!amp;)|
)) # der Begrenzer (\s, ] oder Zeilenende) - } - {$2}gix; # und das Bild - - # iframe - $posting =~ s{\[iframe:\s* - ((?:ftp:// - | https?:// - | about: - | view-source: - | gopher:// - | mailto: - | news: - | nntp:// - | 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|\(|\)|&(?!amp;)|
)) # der Begrenzer (\s, ] oder Zeilenende) - } - {$2}gix; + # encode the special syntaxes + # + $posting =~ s!$_!$1! + for (map {qr/\[\Q${plain(\$_->[0])}\E:\s*(\Q${plain(\$_->[1])}\E)\s*\]/} @links); - # [msg...] - $params -> {messages} = {} unless (defined $params -> {messages}); - my %msg = %{$params -> {messages}}; - foreach (keys %msg) { - $posting =~ s/\[msg:\s*$_(?:\s*\]|\s)/''.plain($msg{$_}->{alt}).''/gei;} + $posting =~ s!$_!! + for (map {qr/\[\Q${plain(\$_->[0])}\E:\s*(\Q${plain(\$_->[1])}\E)\s*\]/} @images); + + $posting =~ s!$_!! + for (map {qr/\[\Q${plain(\$_->[0])}\E:\s*(\Q${plain(\$_->[1])}\E)\s*\]/} @iframes); + + %msg = map {plain($_) => $msg{$_}} keys %msg; + $posting =~ s!$_!''.plain($msg{lc $1}->{alt}).''!e + for (map {qr/\[\Q${plain(\$_->[0])}\E:\s*(\Q${plain(\$_->[1])}\E)\s*\]/} @msgs); + + # normalize quote characters (quote => \177) + # + my $quote = plain(defined $params -> {quoteChars} ? $params -> {quoteChars} : ''); + my $len = length ($quote); + $posting =~ s!^((?:\Q$quote\E)+)!"\177" x (length($1)/$len)!gem if ($len); + + # \n =>
, fix spaces + # + $posting = ${multiline (\$posting)}; - # Rueckgabe + # return + # \$posting; } -################################ -# sub answer_field +### sub answer_field ($$) ###################################################### +# +# create the content of the answer textarea +# +# Params: $posting - scalar reference +# (posting text, 'encoded_body' encoded) +# $params - hash reference +# (quoteArea quoteChars messages) +# +# Return: scalar reference # -# Antwort HTML einer Message -# erzeugen -################################ - sub answer_field ($$) { my $posting = shift; - my $params = shift; - $params = {} unless (defined $params); + my $params = shift || {}; - # ================ - # Antwortfeld - # ================ my $area = $$posting; - my $qchar = $params -> {quoteChars}; - $area =~ s/(?:^|(
))(?!
)/$1 || '' . "\177"/eg if ($params -> {quoteArea}); # Antwortfeld quoten?! - $area =~ s/\177/$qchar/g; # normalisierte Quotes jedenfalls in Chars umsetzen + $area =~ s/
/\n/g; #
=> \n + $area =~ s/&(?:#160|nbsp);/ /g; # nbsp => ' ' - # HTML-Zeug zurueckuebersetzen + $area =~ s/^(.)/\177$1/gm if ($params -> {quoteArea}); # shift a quoting character + $area =~ s/^(\177+)/$qchar x length ($1)/gem; # decode normalized quoting characters - $params -> {messages} = {} unless (defined $params -> {messages}); # um Fehlermeldungen auszuschliessen... - my %msg = map {($params -> {messages} -> {$_} -> {src} => $_)} keys %{$params -> {messages}}; + # recode special syntaxes + # from HTML to [...] constructions + # + $params -> {messages} = {} unless (defined $params -> {messages}); # avoid error messages + my %msg = map { + $params -> {messages} -> {$_} -> {src} => $_ + } keys %{$params -> {messages}}; # we have to lookup reverse ... - $area =~ s{]+>.*?|]+>|]*>|.*?} - {if (defined $1) {"[iframe: $1]"} - elsif (defined $2) {"[msg: $msg{$2}]"} - elsif (defined $3) {"[image: $3]"} - elsif (defined $4) {"[link: $4]"}}eg; - $area =~ s/
/\n/g; - $area =~ s/&(?:#160|nbsp);/ /g; + # [msg...] + $area =~ s{(]+>)} { + defined $msg{$2} + ? "[msg: $msg{$2}]" + : $1; + }ge; - # Rueckgabe + # [iframe...] + $area =~ s{]+>.*?} {[iframe: $1]}g; + + # [image...] + $area =~ s{]*>}{[image: $1]}g; + + # [link...] + $area =~ s{.*?}{[link: $1]}g; + + # return + # \$area; } -################################ -# sub message_field +### sub message_field ($$) ##################################################### +# +# prepare the posting text for visual output +# +# Params: $posting - scalar reference +# (raw posting text, 'encoded_body' encoded) +# $params - hash reference +# (quoteChars quoting startCite endCite) +# +# Return: scalar rerence (prepared posting text) # -# HTML eines Postingtextes -# erzeugen -################################ - sub message_field ($$) { my $posting = ${+shift}; - my $params = shift; - $params = {} unless (defined $params); + my $params = shift || {}; + + + if ($params -> {quoting}) { # quotes are displayed as special? + my @array = [0 => []]; + + for (split /
/ => $posting) { + my $l = length ((/^(\177*)/)[0]); + if ($array[-1][0] == $l) { + push @{$array[-1][-1]} => $_; + } + else { + push @array => [$l => [$_]]; + } + } + shift @array unless @{$array[0][-1]}; + + $posting = join '
' => map { + $_->[0] + ? join join ('
' => @{$_->[-1]}) => ($params->{startCite}, $params->{endCite}) + : (join '
' => @{$_->[-1]}); + } @array; + } - # ================ - # Postingtext - # ================ my $qchar = $params -> {quoteChars}; + $posting =~ s/\177/$qchar/g; # \177 => quote chars - if ($params -> {quoting}) { # Quotes bekommen eine extra Klasse? - # ueberfluessige Abstaende entfernen, - # sie werden eh wieder auseinandergezogen... - $posting =~ s/(\177(?:[^<]|<(?!br>))*
)
(?=\177)/$1/g; - $posting =~ s/(\177(?:[^<]|<(?!br>))*
)
(?!\177)/$1/g; - - my ($last_level, $level, $line, $q, @new)=(-1,0); - - foreach $line (split (/
/,$posting)) { # Zeilenweise gucken, - ($q) = ($line =~ /^(\177+)/g); # wieviele - $level = length ($q or ''); # Quotingchars am Anfang stehen - if ($level != $last_level) { # wenn sich was verandert... - # ... dann TU ETWAS! - - if ($last_level <= 0 and $level > 0) {$last_level = $level; $line='
'.$params -> {startCite} . $line} - elsif ($level > 0) {$last_level = $level; $line=$params -> {endCite} . '
' . $params -> {startCite} . $line} - elsif ($level == 0 and $last_level > 0) {$last_level = -1; $line = $params -> {endCite} . '
' . $line}} - - push @new,$line} - - $new[0] =~ s/^
//; - $posting = (join '
',@new) . (($last_level > 0)?$params -> {endCite}:'');} - - $posting =~ s/\177/$qchar/g; # normalisierte Quotes in Chars umsetzen - - # Rueckgabe + # return + # \$posting; } - -# ==================================================== -# Modulinitialisierung -# ==================================================== - -# making require happy +# keeping 'require' happy 1; -# ==================================================== -# end of Encode::Posting -# ==================================================== \ No newline at end of file +# +# +### end of Encode::Posting ##################################################### \ No newline at end of file diff --git a/selfforum-cgi/shared/Posting/Write.pm b/selfforum-cgi/shared/Posting/Write.pm index b7d7893..507cd81 100644 --- a/selfforum-cgi/shared/Posting/Write.pm +++ b/selfforum-cgi/shared/Posting/Write.pm @@ -78,7 +78,8 @@ sub write_new_thread ($) { body => encoded_body( \($param -> {body}), { quoteChars => $param -> {quoteChars}, - messages => $param -> {messages} + messages => $param -> {messages}, + base_uri => $param -> {base_uri} } ), time => $param -> {time}, @@ -179,7 +180,8 @@ sub write_reply_posting ($) { ${encoded_body( \($param -> {body}), { quoteChars => $param -> {quoteChars}, - messages => $param -> {messages} + messages => $param -> {messages}, + base_uri => $param -> {base_uri} } )} ) @@ -236,7 +238,7 @@ sub write_reply_posting ($) { return (0, $thread, $mid); } -# keeping 'require' happy +# keep 'require' happy # 1; diff --git a/selfforum-cgi/shared/Template.pm b/selfforum-cgi/shared/Template.pm index e74d1d2..44da2cc 100644 --- a/selfforum-cgi/shared/Template.pm +++ b/selfforum-cgi/shared/Template.pm @@ -1,155 +1,203 @@ -# Template.pm +package Template; -# ==================================================== -# Autor: n.d.p. / 2001-01-06 -# lm : n.d.p. / 2001-01-25 -# ==================================================== -# Funktion: -# Ausfuellen von Templates -# ==================================================== +################################################################################ +# # +# File: shared/Template.pm # +# # +# Authors: André Malo , 2001-04-12 # +# # +# Description: Handle XML based HTML-Templates # +# # +################################################################################ use strict; +use vars qw($xml_dom_used); -package Template; - -use autouse 'Carp' => qw(croak confess); -use XML::DOM; +use Carp qw(croak confess); -# ==================================================== -# Methoden -# ==================================================== +BEGIN { + $xml_dom_used = eval q[ + local $SIG{__DIE__}; + use XML::DOM; + 1; + ]; +} -################################ -# sub new +### sub new #################################################################### +# +# constructor +# +# Params: ~none~ +# +# Return: Template object # -# Konstruktor -################################ - sub new { - my $instance=shift; - my $class=(ref($instance) or $instance); + my $instance = shift; - my $self = {}; - $self = bless $self,$class; + my $self = bless {} => ref($instance) || $instance; $self -> file (+shift); - # Rueckgabe + # return $self; } -################################ -# sub file +### sub file ################################################################### +# +# assign new template file to object +# parse the template file +# +# Params: $new - (optional) new template file +# +# Return: scalar - old filename or if there's no old filename given # -# Datei zuweisen und parsen -################################ - sub file { my $self = shift; - my $old = $self -> {file}; - my $new = shift; + my $new = shift; + my $old = $self -> {file}; $self -> {file} = $new if (defined $new); $self -> parse_file; + # return $old; } -################################ -# sub insert +### sub insert ################################################################# +# +# return the placeholder surrounded by meta delimiters +# +# Params: $name - name of placeholder +# +# Return: scalar - placeholder surrounded by meta delimiters # -# Bezeichner in Metazeichen -# eingeschlossen zurueckgeben -################################ - sub insert { - my $self=shift; - croak "no template file specified" unless (defined $self -> {file}); + my $self = shift; + my $name = shift; - my $name=shift; + croak "no template file specified" + unless (defined $self -> {file}); - # Rueckgabe + # return $self -> {metaon} . $name . $self -> {metaoff}; } -################################ -# sub list +### sub list ################################################################### +# +# fill in a complete list +# +# Params: $name - name of the atomic scrap +# $array - list of hashes (same strcuture like the hash used by 'scrap') +# +# Return: scalar reference - filled in list # -# komplette Liste einsetzen -################################ - sub list { - my $self=shift; - my $name=shift; + my $self = shift; + my $name = shift; - croak "no template file specified" unless (defined $self->{file}); + croak "no template file specified" + unless (defined $self -> {file}); - my $list = join '', map { ${ $self -> scrap ($name, $_) } } @{ +shift }; +# no warnings 'uninitialized'; + my $list = join '' => map { ${ $self -> scrap ($name, $_) } } @{ +shift }; - # Rueckgabe + # return \$list; } -################################ -# sub scrap +### sub scrap ################################################################## +# +# fill in a template scrap +# +# Params: $name - name of the scrap +# +# Return: scalar reference - filled in scrap # -# Schnipsel ausfuellen -################################ - sub scrap { - my $self=shift; - my $name=shift; - - croak "no template file specified" unless (defined $self->{file}); - - my %params; + my $self = shift; + my $name = shift; - # Parameter holen - # Als Values werden nur die Referenzen gespeichert - %params = map { my $ref = $_; map { ($_ => ( (ref ($ref -> {$_} ) )?$ref -> {$_}: \($ref -> {$_} ) ) ) } keys %$ref } splice @_; + croak "no template file specified" + unless (defined $self -> {file}); - # und einsetzen - my $scrap=$self->{parsed}->{$name}; - my $qmon=quotemeta $self->{metaon}; - my $qmoff=quotemeta $self->{metaoff}; + return \'' unless (defined $name and defined ($self -> {parsed} -> {$name})); - # und zwar solange, bis nichts mehr da ist - while ($scrap =~ s<$qmon\s*([_a-zA-Z]\S*)\s*$qmoff>[ - my $x=''; - if ( exists ( $params{$1} ) ) { $x = ${$params{$1}} } - elsif (exists ( $self -> {parsed} -> {$1} ) ) { $x = $self -> {parsed} -> {$1}} - $x;]geo ){}; + # fetch parameters + # (and normalize - save only the references in %params) + # + my %params; + %params = map { + my $ref = $_; + map { + ($_ => ( + ref ($ref -> {$_}) + ? (defined ${$ref -> {$_}} ? $ref -> {$_} : \'') + : \(defined $ref -> {$_} ? $ref -> {$_} : '')) + ) + } keys %$ref + } splice @_; + + # fill in... + # + my $scrap = $self -> {parsed} -> {$name}; + my $qmon = quotemeta $self -> {metaon}; + my $qmoff = quotemeta $self -> {metaoff}; - $self -> parse_if (\$scrap,\%params); + # ...until we've replaced all placeholders + # + 1 while ( + $scrap =~ s + < + $qmon \s* + ([_a-zA-Z] \S*) + \s* $qmoff + > + [ (exists ( $params{$1} ) ) + ? ${$params{$1}} + : ( exists ( $self -> {parsed} -> {$1} ) + ? $self -> {parsed} -> {$1} + : '' + ); + ]gex + ); + + # parse conditional blocks + # + $self -> parse_if ( + \$scrap, + \%params + ); - # Rueckgabe + # return \$scrap; } -# ==================================================== -# Private Funktionen/Methoden -# ==================================================== - -################################ -# sub parse_file +### sub parse_file ############################################################# +# +# read in and parse template file +# +# Params: ~none~ +# +# Return: Status Code (Boolean) # -# Template einlesen & parsen -################################ - sub parse_file { my $self = shift; + my $filename = $self -> {file}; + + if ($xml_dom_used) { - if (-f $self -> {file}) { - my $filename = $self -> {file}; + # parse template using XML::DOM + # my $xml = eval { local $SIG{__DIE__}; new XML::DOM::Parser -> parsefile ($filename); }; - croak "error in template file '$filename': $@" if ($@); + croak "error while parsing template file '$filename': $@" if ($@); my $template = $xml -> getElementsByTagName ('Template', 0) -> item (0); - # Metas bestimmen + # extract meta delimiters + # $self -> {metaon} = $template -> getAttribute ('metaon'); $self -> {metaoff} = $template -> getAttribute ('metaoff'); @@ -166,18 +214,73 @@ sub parse_file { $self -> {parsed} -> {$name} = $_ -> getFirstChild -> getData; $self -> {parsed} -> {$name} =~ s/^\s+|\s+$//g;} - return 1; # alles klar + return 1; # looks fine + } + else { + # XML::DOM not available... + # parse the template using both hands ;) + # + + my ($xml, $root, $template); + local (*FILE, $/); + + open FILE, "< $filename" or croak "error while reading template file '$filename': $!"; + $xml = ; + close FILE or croak "error while closing template file '$filename' after reading: $!"; + + ($root, $template) = ($1, $2) if ($xml =~ m|("]*(?:"[^"]*"[^>"]*)*>)(.*)|s); + croak "error while parsing template file '$filename': missing root element 'Template'" + unless (defined $root and defined $template); + + # extract meta delimiters + # + $self -> {metaon} = $1 if ($root =~ /\smetaon\s*=\s*"([^"]+)"/); + $self -> {metaoff} = $1 if ($root =~ /\smetaoff\s*=\s*"([^"]+)"/); + + croak "missing meta defintion(s) in template file '$filename'." unless ($self -> {metaon} and $self -> {metaoff}); + + # don't use any other entities than " ' < > and & + # (while using non XML::DOM - version) + # + for ('metaon', 'metaoff') { + $self -> {$_} =~ s/"/"/g; $self -> {$_} =~ s/'/'/g; + $self -> {$_} =~ s/</ {$_} =~ s/>/>/g; + $self -> {$_} =~ s/&/&/g; + } + + $self -> {parsed} = {}; + while ($template =~ m|\s*)[^\]]*)*)\]\]>\s*|g) { + + my ($name, $content) = ($1, $2); + + croak "Element 'Scrap' requires attribute 'id' in template file '$filename'" + unless (defined $name and length $name); + + croak "double defined id '$name' in template file '$filename'" + if (exists ($self -> {parsed} -> {$name})); + + croak "use '/^[_a-zA-Z]\\S*\$/' for 'Scrap'-ids in template file '$filename' (wrong: '$name')" + unless ($name =~ /^[_a-zA-Z]\S*$/); + + $content =~ s/^\s+//; $content =~ s/\s+$//; + $self -> {parsed} -> {$name} = $content; + } + + return 1; # looks fine } - 0; + return; # anything failed (??) } -################################ -# sub parse_if +### sub parse_if ############################################################### +# +# parse conditional blocks +# +# Params: $scrap - scalar reference of the template scrap +# $params - hash reference: values from the application +# +# Return: ~none~, ($$scrap will be modified) # -# %IF - Anweisungen parsen -################################ - sub parse_if { my $self = shift; my ($scrap, $params) = @_; @@ -185,29 +288,22 @@ sub parse_if { my $qmon = quotemeta $self -> {metaon}; my $qmoff = quotemeta $self -> {metaoff}; - # der folgende Regex ist ein bisschen fies ... - # ... aber er funktioniert :-) - # - # pfff - rekursive Strukturen iterativ parsen ist nicht wirklich witzig - # + # the following regex is just not optimized, + # but it works ;) 1 while ($$scrap =~ s { - ($qmon\s*%(?:IF|ELSE)\s+.+?\s*$qmoff.*?) # Wenn IF oder ELSE von - (?=$qmon\s*%IF\s+.+?\s*$qmoff) # IF gefolgt werden, soll - # dieses Stueck uebersprungen - # werden und erstmal mit der - # naechsten Ebene weitergemacht - # werden. - - |( # hier beginnt $2 - $qmon\s*%IF\s+(.+?)\s*$qmoff # IF + ($qmon\s*%(?:IF|ELSE)\s+.+?\s*$qmoff.*?) # skip this part + (?=$qmon\s*%IF\s+.+?\s*$qmoff) # if %IF or %ELSE are followed by %IF + + |( # $2 starts here + $qmon\s*%IF\s+(.+?)\s*$qmoff # %IF (.*?) # $4 (?: - $qmon\s*%ENDIF\s*$qmoff # gefolgt von ENDIF - | # oder - $qmon\s*%ELSE\s*$qmoff # von ELSE... ($4 ELSE $5) - (.*?) - $qmon\s*%ENDIF\s*$qmoff # und ENDIF + $qmon\s*%ENDIF\s*$qmoff # followed by %ENDIF + | # or + $qmon\s*%ELSE\s*$qmoff # %ELSE... + (.*?) # $5 + $qmon\s*%ENDIF\s*$qmoff # ...and ENDIF ) ) } @@ -218,6 +314,7 @@ sub parse_if { for (split /\s+/,$t3) { next unless ( exists($params->{$_}) + and defined ${$params->{$_}} and length ${$params->{$_}} ); @@ -231,14 +328,14 @@ sub parse_if { } $ret; - }gosex); + }gsex); return; } -# keep require happy +# keeping 'require' happy 1; # # -### end of Template ############################################################ +### end of Template ############################################################ \ No newline at end of file diff --git a/selfforum-cgi/shared/Template/Forum.pm b/selfforum-cgi/shared/Template/Forum.pm index c03f05a..9140478 100644 --- a/selfforum-cgi/shared/Template/Forum.pm +++ b/selfforum-cgi/shared/Template/Forum.pm @@ -1,18 +1,17 @@ -# Template/Forum.pm +package Template::Forum; -# ==================================================== -# Autor: n.d.p. / 2001-01-12 -# lm : n.d.p. / 2001-01-12 -# ==================================================== -# Funktion: -# Erzeugung der HTML-Ausgabe der -# Forumshauptdatei -# ==================================================== +################################################################################ +# # +# File: shared/Template/Forum.pm # +# # +# Authors: André Malo , 2001-04-19 # +# # +# Description: print Forum main file to STDOUT # +# # +################################################################################ use strict; -package Template::Forum; - use Lock qw(:READ); use Encode::Plain; $Encode::Plain::utf8 = 1; use Posting::_lib qw(get_all_threads long_hr_time); @@ -20,19 +19,23 @@ use Template; use Template::_conf; use Template::_thread; -# ==================================================== -# Funktionsexport -# ==================================================== - +################################################################################ +# +# Export +# use base qw(Exporter); @Template::Forum::EXPORT = qw(print_forum_as_HTML); -################################ -# sub print_forum_as_HTML +### sub print_forum_as_HTML ($$$) ############################################## +# +# print Forum main file to STDOUT +# +# Params: $mainfile - main xml file name +# $tempfile - template file name +# $param - hash reference (see doc for details) +# +# Return: ~none~ # -# HTML erstellen -################################ - sub print_forum_as_HTML ($$$) { my ($mainfile, $tempfile, $param) = @_; my $assign = $param -> {assign}; @@ -42,29 +45,39 @@ sub print_forum_as_HTML ($$$) { my ($threads, $stat); unless ($stat = lock_file ($mainfile)) { - if ($stat == 0) { + if (defined $stat) { violent_unlock_file ($mainfile); - print "aha!" - # ueberlastet + print ${$template -> scrap ( + $assign -> {errorDoc}, + { $assign -> {errorText} => $template -> insert ($assign -> {'occupied'}) } + )}; } - else { - # Mastersperre... + print ${$template -> scrap ( + $assign -> {errorDoc}, + { $assign -> {errorText} => $template -> insert ($assign -> {'notAvailable'}) } + )}; }} else { - my $view = get_view_params ({adminDefault => $param -> {adminDefault} - }); + my $view = get_view_params ( + { adminDefault => $param -> {adminDefault} } + ); $threads = get_all_threads ($mainfile, $param -> {showDeleted}, $view -> {sortedMsg}); violent_unlock_file ($mainfile) unless (unlock_file ($mainfile)); - print ${$template -> scrap ($assign -> {mainDocStart}, - {$assign -> {loadingTime} => plain (long_hr_time (time)) } )},"\n
"; + print ${$template -> scrap ( + $assign -> {mainDocStart}, + { $assign -> {loadingTime} => plain (long_hr_time (time)) } + ) + },"\n
"; - my $tpar = {template => $param -> {tree}, - cgi => $param -> {cgi}, - start => -1}; + my $tpar = { + template => $param -> {tree}, + cgi => $param -> {cgi}, + start => -1 + }; my @threads; @@ -82,13 +95,9 @@ sub print_forum_as_HTML ($$$) { return; } -# ==================================================== -# Modulinitialisierung -# ==================================================== - -# making require happy +# keep require happy 1; -# ==================================================== -# end of Template::Forum -# ==================================================== \ No newline at end of file +# +# +### end of Template::Forum ##################################################### diff --git a/selfforum-cgi/shared/Template/Posting.pm b/selfforum-cgi/shared/Template/Posting.pm index 5081a1a..348a7db 100644 --- a/selfforum-cgi/shared/Template/Posting.pm +++ b/selfforum-cgi/shared/Template/Posting.pm @@ -55,102 +55,127 @@ sub print_posting_as_HTML ($$$) { my ($threadpath, $tempfile, $param) = @_; my $template = new Template $tempfile; + my $assign = $param -> {assign}; - # Datei sperren... (eigentlich) my $view = get_view_params ({ adminDefault => $param -> {adminDefault} }); - my $xml = parse_xml_file ($threadpath.'t'.$param -> {thread}.'.xml'); - - my ($mnode, $tnode) = get_message_node ($xml, 't'.$param -> {thread}, 'm'.$param -> {posting}); - my $pnode = $mnode -> getParentNode; - my $header = get_message_header ($mnode); - my $msg = parse_single_thread ($tnode, $param -> {showDeleted}, $view -> {sortedMsg}); - my $pheader = ($pnode -> getNodeName eq 'Message')?get_message_header ($pnode):{}; - - my $assign = $param -> {assign}; - my $formdata = $param -> {form} -> {data}; - my $formact = $param -> {form} -> {action}; - - my $body = get_message_body ($xml, 'm'.$param -> {posting}); - - my $text = message_field ( - $body, - { quoteChars => plain($view -> {quoteChars}), - quoting => 1, - startCite => ${$template -> scrap ($assign -> {startCite})}, - endCite => ${$template -> scrap ($assign -> {endCite})} + my ($xmlfile, $locked, $xml) = ($threadpath.'t'.$param -> {thread}.'.xml', 0); + + unless (($locked = lock_file ($xmlfile)) and ($xml = parse_xml_file ($xmlfile))) { + violent_unlock_file ($xmlfile); + print ${$template -> scrap ( + $assign -> {errorDoc}, + { $assign -> {errorText} => $template -> insert ( + $assign -> {(defined $locked) + ? 'occupied' + : 'notAvailable' + }) + } + )}; + } + else { + violent_unlock_file ($xmlfile) unless (unlock_file($xmlfile)); + + my ($mnode, $tnode) = get_message_node ($xml, 't'.$param -> {thread}, 'm'.$param -> {posting}); + + unless ($mnode and not $mnode->getAttribute('invisible')) { + print ${$template -> scrap ( + $assign -> {errorDoc}, + { $assign -> {errorText} => $template -> insert ($assign -> {'notAvailable'}) } + )}; } - ); - - my $area = answer_field ( - $body, - { quoteArea => 1, - quoteChars => plain($view -> {quoteChars}), - messages => $param -> {messages} + else { + my $pnode = $mnode -> getParentNode; + my $header = get_message_header ($mnode); + my $msg = parse_single_thread ($tnode, $param -> {showDeleted}, $view -> {sortedMsg}); + my $pheader = ($pnode -> getNodeName eq 'Message')?get_message_header ($pnode):{}; + + my $formdata = $param -> {form} -> {data}; + my $formact = $param -> {form} -> {action}; + + my $body = get_message_body ($xml, 'm'.$param -> {posting}); + + my $text = message_field ( + $body, + { quoteChars => plain($view -> {quoteChars}), + quoting => $view -> {quoting}, + startCite => ${$template -> scrap ($assign -> {startCite})}, + endCite => ${$template -> scrap ($assign -> {endCite})} + } + ); + + my $area = answer_field ( + $body, + { quoteArea => 1, + quoteChars => plain($view -> {quoteChars}), + messages => $param -> {messages} + } + ); + + my $pars = {}; + + $pars -> {$formdata -> {$_} -> {assign} -> {name}} = plain($formdata -> {$_} -> {name}) + for (qw( + posterBody + uniqueID + followUp + quoteChar + userID + posterName + posterEmail + posterURL + posterImage + ) + ); + + my $cgi = $param -> {cgi}; + + my $tpar = { + thread => $param -> {thread}, + template => $param -> {tree}, + start => $param -> {posting}, + cgi => $cgi + }; + + my $parent_pars; + + $parent_pars = { + $assign->{parentTitle} => plain(defined $pheader->{subject} ? $pheader->{subject} : ''), + $assign->{parentCat} => plain(defined $pheader->{category} ? $pheader->{category} : ''), + $assign->{parentName} => plain(defined $pheader->{name} ? $pheader->{name} : ''), + $assign->{parentTime} => plain(hr_time($pheader->{time})), + $assign->{parentLink} => query_string ( + { $cgi -> {thread} => $param -> {thread}, + $cgi -> {posting} => ($pnode -> getAttribute ('id') =~ /(\d+)/)[0] + }) + } if (%$pheader); + + print ${$template -> scrap ( + $assign->{mainDoc}, + { $assign->{name} => plain(defined $header->{name} ? $header->{name} : ''), + $assign->{email} => plain(defined $header->{email} ? $header->{email} : ''), + $assign->{home} => plain(defined $header->{home} ? $header->{home} : ''), + $assign->{image} => plain(defined $header->{image} ? $header->{image} : ''), + $assign->{time} => plain(hr_time($header->{time})), + $assign->{message} => $text, + $assign->{messageTitle} => plain(defined $header->{subject} ? $header->{subject} : ''), + $assign->{messageCat} => plain(defined $header->{category} ? $header->{category} : ''), + $param->{tree}->{main} => html_thread ($msg, $template, $tpar), + $formact->{post}->{assign} => $formact->{post}->{url}, + $formact->{vote}->{assign} => $formact->{vote}->{url}, + $formdata->{posterBody}->{assign}->{value} => $area, + $formdata->{uniqueID} ->{assign}->{value} => plain(unique_id), + $formdata->{followUp} ->{assign}->{value} => plain($param -> {thread}.';'.$param -> {posting}), + $formdata->{quoteChar} ->{assign}->{value} => "ÿ".plain(defined $view -> {quoteChars} ? $view -> {quoteChars} : ''), + $formdata->{userID} ->{assign}->{value} => '' + }, + $pars, + $parent_pars + )}; } - ); - - my $pars = {}; - - $pars -> {$formdata -> {$_} -> {assign} -> {name}} = plain($formdata -> {$_} -> {name}) - for (qw( - posterBody - uniqueID - followUp - quoteChar - userID - posterName - posterEmail - posterURL - posterImage - )); - - my $cgi = $param -> {cgi}; - - my $tpar = { - thread => $param -> {thread}, - template => $param -> {tree}, - start => $param -> {posting}, - cgi => $cgi - }; - - my $parent_pars; - - $parent_pars = { - $assign->{parentTitle} => plain($pheader->{subject}), - $assign->{parentCat} => plain($pheader->{category}), - $assign->{parentName} => plain($pheader->{name}), - $assign->{parentTime} => plain(hr_time($pheader->{time})), - $assign->{parentLink} => query_string ( - { $cgi -> {thread} => $param -> {thread}, - $cgi -> {posting} => ($pnode -> getAttribute ('id') =~ /(\d+)/)[0] - }) - } if (%$pheader); - - print ${$template -> scrap ( - $assign->{mainDoc}, - { $assign->{name} => plain($header->{name}), - $assign->{email} => plain($header->{email}), - $assign->{home} => plain($header->{home}), - $assign->{image} => plain($header->{image}), - $assign->{time} => plain(hr_time($header->{time})), - $assign->{message} => $text, - $assign->{messageTitle} => plain($header->{subject}), - $assign->{messageCat} => plain($header->{category}), - $param->{tree}->{main} => html_thread ($msg, $template, $tpar), - $formact->{post}->{assign} => $formact->{post}->{url}, - $formact->{vote}->{assign} => $formact->{vote}->{url}, - $formdata->{posterBody}->{assign}->{value} => $area, - $formdata->{uniqueID} ->{assign}->{value} => plain(unique_id), - $formdata->{followUp} ->{assign}->{value} => plain($param -> {thread}.';'.$param -> {posting}), - $formdata->{quoteChar} ->{assign}->{value} => "ÿ".plain($view -> {quoteChars}), - $formdata->{userID} ->{assign}->{value} => '' - }, - $pars, - $parent_pars - )}; + } return; } @@ -190,5 +215,4 @@ sub message_as_HTML ($$$) { # # -### end of Template::Posting ################################################### - +### end of Template::Posting ################################################### \ No newline at end of file diff --git a/selfforum-cgi/shared/Template/_conf.pm b/selfforum-cgi/shared/Template/_conf.pm index 6528d38..6f1e130 100644 --- a/selfforum-cgi/shared/Template/_conf.pm +++ b/selfforum-cgi/shared/Template/_conf.pm @@ -31,8 +31,9 @@ sub get_view_params ($) { my $default = $param -> {adminDefault}; my %hash; - %hash = (quoteChars => $default -> {View} -> {quoteChars}, - sortedMsg => $default -> {View} -> {sortMessages}, + %hash = (quoting => $default -> {View} -> {quoting}, + quoteChars => $default -> {View} -> {quoteChars}, + sortedMsg => $default -> {View} -> {sortMessages}, sortedThreads => $default -> {View} -> {sortThreads} ); diff --git a/selfforum-cgi/user/config/answer.tmp.xml b/selfforum-cgi/user/config/answer.tmp.xml index 5c35301..7ba30ff 100644 --- a/selfforum-cgi/user/config/answer.tmp.xml +++ b/selfforum-cgi/user/config/answer.tmp.xml @@ -202,7 +202,7 @@ --> ]]> -
]]> + ]]>