new kernel implemented (not only programming style changes), several bugs fixed,...

diff --git a/selfforum-cgi/shared/CheckRFC.pm b/selfforum-cgi/shared/CheckRFC.pm
index 3a1ed0c3cc2b05d3779f1c71ab95f3d811fc7099..ddde67f6a569d163698514f4e6278d806739b5ea 100644 (file)
--- a/selfforum-cgi/shared/CheckRFC.pm
+++ b/selfforum-cgi/shared/CheckRFC.pm
@@ -4,23 +4,39 @@ package CheckRFC;
 #                                                                              #
 # File:        shared/CheckRFC.pm                                              #
 #                                                                              #
 #                                                                              #
 # File:        shared/CheckRFC.pm                                              #
 #                                                                              #

-# Authors:     Andre Malo       <nd@o3media.de>, 2001-03-30                    #
+# Authors:     Andre Malo       <nd@o3media.de>, 2001-04-14                    #

 #                                                                              #
 # Description: implement several string checks on RFC correctness              #
 #                                                                              #
 ################################################################################
 
 use strict;
 #                                                                              #
 # 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
 #
 
 ################################################################################
 #
 # Export
 #

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

 
 ### is_URL ($@) ################################################################
 #
 
 ### is_URL ($@) ################################################################
 #


@@ -28,7 +44,8 @@ use base qw(Exporter);
 #
 # Params: $string  string to check
 #         @schemes possible URL schemes in $string
 #
 # 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
 #
 #                  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) = @_;
 #
 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{$_};
   @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
   }
 
   # no match => return false


@@ -52,20 +84,25 @@ sub is_URL ($@) {
 #
 # check email (comments can be nested)
 #
 #
 # 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)
 #
 #
 # Return: Status code (Bool)
 #

-sub is_email ($) {
+sub is_email ($;$) {

   my $string = shift;
   my $string = shift;

+  my $strict = shift;

 
   # false if any non-ascii chars
 
   # false if any non-ascii chars

+  return unless (defined ($string) and length ($string));

   return if $string =~ /[\200-\377]/;
 
   # remove nested comments
   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) ################################################################
 }
 
 ### BEGIN # (1) ################################################################


@@ -75,41 +112,59 @@ sub is_email ($) {
 BEGIN {
   # Thanx to J. Friedl:
 
 BEGIN {
   # Thanx to J. Friedl:
 

-  my $esc        = '\\\\';
+  my $esc         = '\\\\';

   my $Period      = '\.';
   my $Period      = '\.';

-  my $space      = '\040';
+  my $space       = '\040';

   my $tab         = '\t';
   my $tab         = '\t';

-  my $OpenBR     = '\[';
+  my $OpenBR      = '\[';

   my $CloseBR     = '\]';
   my $CloseBR     = '\]';

-  my $OpenParen  = '\(';
+  my $OpenParen   = '\(';

   my $CloseParen  = '\)';
   my $CloseParen  = '\)';

-  my $NonASCII   = '\x80-\xff';
+  my $NonASCII    = '\x80-\xff';

   my $ctrl        = '\000-\037';
   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 $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_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_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) ################################################################
 }
 
 ### 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 $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)";
   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 $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*)";
 
   # 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)?)?)?)?)";
 
   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|[.+_-])*)";
   # 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)*)";
 
   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
 }
 
 # keeping require happy

diff --git a/selfforum-cgi/shared/Encode/Plain.pm b/selfforum-cgi/shared/Encode/Plain.pm
index 2fe5634f854145a6a79270ecdc37f6e9a11e548a..f2085ce13d2acd3371c709c64a93e98d84f022ee 100644 (file)
--- 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;
 
 package Encode::Plain;
 

-require 5.6.0;
+################################################################################
+#                                                                              #
+# File:        shared/Encode/Plain.pm                                          #
+#                                                                              #
+# Authors:     André Malo <nd@o3media.de>, 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);
 
 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 ($;$) {
 sub plain ($;$) {

-  my ($old,$ref)=@_;
+  my ($old, $ref) = @_;

   my $exreg;
 
   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) {
 
   if ($except) {
 

-    # Referenz, also Liste uebergeben -> umwandeln in Regex

     if (ref ($ref -> {-except})) {
     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 {
     else {

+      # quote regex delimiters
+      #

       $exreg = $ref -> {-except};
       $exreg = $ref -> {-except};

-      $exreg =~ s/\//\\\//g;}}      # LTS :-)
+      $exreg =~ s|/|\\/|g;
+    }
+  }

 
 

+  # encode the &-character
+  #

   if (lc($ref->{-amp}) eq 'soft') {
 
     if ($except) {
   if (lc($ref->{-amp}) eq 'soft') {
 
     if ($except) {

-      $new=~s/($exreg)|(?:\&(?!(?:#[Xx][\da-fA-F]+|#\d+|[a-zA-Z]+);))/(length($1))?$1:'&amp;'/eg;}
-
+      $new=~s/($exreg)|(?:\&(?!(?:#[Xx][\da-fA-F]+|#\d+|[a-zA-Z]+);))/defined($1)?$1:'&amp;'/eg;
+    }

     else {
     else {

-      $new=~s/\&(?!(?:#[Xx][\da-fA-F]+|#\d+|[a-zA-Z]+);)/&amp;/g;}}
-
+      $new=~s/\&(?!(?:#[Xx][\da-fA-F]+|#\d+|[a-zA-Z]+);)/&amp;/g;
+    }
+  }

   elsif (lc($ref->{-amp}) ne 'no') {
 
     if ($except) {
   elsif (lc($ref->{-amp}) ne 'no') {
 
     if ($except) {

-      $new=~s/($exreg)|\&/(length($1))?$1:'&amp;'/eg;}
-
+      $new=~s/($exreg)|\&/defined($1)?$1:'&amp;'/eg;
+    }

     else {
     else {

-      $new=~s/\&/&amp;/g;}}
+      $new=~s/\&/&amp;/g;
+    }
+  }

 
 

-    #  Weitere Zeichen
+  # further characters
+  #

   if ($except) {
   if ($except) {

-    $new =~ s/($exreg)|</(length($1))?$1:'&lt;'/eg;     # HTML ausschalten
-    $new =~ s/($exreg)|>/(length($1))?$1:'&gt;'/eg;
-    $new =~ s/($exreg)|\|/(length($1))?$1:'&#124;'/eg;  # nich wahr
-    $new =~ s/($exreg)|"/(length($1))?$1:'&quot;'/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:'&lt;'/eg;
+    $new =~ s/($exreg)|>/defined($1)?$1:'&gt;'/eg;
+    $new =~ s/($exreg)|\|/defined($1)?$1:'&#124;'/eg;
+    $new =~ s/($exreg)|"/defined($1)?$1:'&quot;'/eg;
+
+    # the big hash
+    #
+    if ($unicode) {

       my $x;
       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 {
   else {

+    # no exceptions
+    #

     $new =~ s/</&lt;/g;
     $new =~ s/>/&gt;/g;
     $new =~ s/\|/&#124;/g;
     $new =~ s/"/&quot;/g;
 
     $new =~ s/</&lt;/g;
     $new =~ s/>/&gt;/g;
     $new =~ s/\|/&#124;/g;
     $new =~ s/"/&quot;/g;
 

-    # Der grosse Hash
-    if ($utf8 or $ref -> {-utf8}) {
+    # the big hash
+    #
+    if ($unicode) {

       my $x;
       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;
 
   $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;
 
   $string=~s/\015\012|\015|\012/\n/g;
 

-  # Zeilenumbrueche in <br> umwandeln
+  # turn \n into <br>
+  #

   $string=~s/\n/<br>/g;
 
   $string=~s/\n/<br>/g;
 

-  # mehr als ein aufeinanderfolgendes
-  # Leerzeichen in feste Leerzeichen umwandeln
+  # more than 1 space => &nbsp;
+  #

   $string=~s/(\s\s+)/('&nbsp;' x (length($1)-1)) . ' '/eg;
 
   $string=~s/(\s\s+)/('&nbsp;' x (length($1)-1)) . ' '/eg;
 

-  # Leerzeichen nach einem <br> in feste
-  # Spaces umwandeln
-  $string=~s/(?:^|(<br>))\s/$1&nbsp;/g;
+  # Single Spaces after <br> => &nbsp;
+  # (save ascii arts ;)
+  #
+  $string=~s/(?:^|(<br>))\s/($1?$1:'').'&nbsp;'/eg;

 
 

-  # Rueckgabe
+  # return
+  #

   \$string;
 }
 
   \$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;
 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;
 
 BEGIN {
   $utf8 = 0;
 

-  # Latin 1 + geraten
-  %sonder=("\177" => '&#127;',    # Delete-Zeichen
-           "\200" => '&#8364;',   # Euro-Zeichen
-           "\201" => '&uuml;',    # ue - DOS-Zeichensatz
-           "\202" => '&#8218;',   # einfaches Anfuehrungszeichen unten
-           "\203" => '&#402;',    # forte
-           "\204" => '&#8222;',   # doppelte Anfuehrungszeichen unten
-           "\205" => '&#8230;',   # drei punkte
-           "\206" => '&#8224;',   # dagger
-           "\207" => '&#8225;',   # Dagger
-           "\210" => '&#710;',    # circ
-           "\211" => '&#8240;',   # Promille
-           "\212" => '&#352;',    # so ein S mit Haken drueber :-)
-           "\213" => '&#8249;',   # lsaquo
-           "\214" => '&#338;',    # OE (so verhakelt - daenisch?) wer weiss das schon
-           "\215" => '&igrave;',  # Codepage 850;
-           "\216" => '&#381;',    # Z mit Haken drueber (Latin Extended B)
-           "\217" => '&Aring;',   # Codepage 850 (Win)
-           "\220" => '&uuml;',    # ue - Mac-Zeichensatz
-           "\221" => "'",         # einfache Anfuehrungszeichen oben
-           "\222" => "'",         # dito
-           "\223" => '&#8220;',   # doppelte Anfuehrungszeichen oben
-           "\224" => '&#8220;',   # dito
-           "\225" => '&#8226;',   # Bullet
-           "\226" => '-',         # Bindestrich
-           "\227" => '-',         # dito
-           "\230" => '&#732;',    # tilde...?
-           "\231" => '&#8482;',   # Trade-Mark
-           "\232" => '&#353;',    # kleines s mit Haken drueber
-           "\233" => '&#8250;',   # rsaquo;
-           "\234" => '&#339;',    # oe verhakelt
-           "\235" => '&#216;',    # Codepage 850 (Win)
-           "\236" => '&#215;',    # Codepage 850 (Win)
-           "\237" => '&#376;',    # Y mit Punkten drueber
-           "\240" => '&nbsp;',    # nbsp;
-           "\241" => '&#161;',    # umgedrehtes !
-           "\242" => '&#162;',    # cent-Zeichen
-           "\243" => '&pound;',   # (engl.)Pfund-Zeichen
-           "\244" => '&#164;',    # Waehrungszeichen
-           "\245" => '&yen;',     # Yen halt :-)
-           "\246" => '&#166;',    # eigentlich soll es wohl ein | sein .-)
-           "\247" => '&sect;',    # Paragraph
-           "\250" => '&#168;',    # zwei Punkte oben
-           "\251" => '&copy;',    # (C)
-           "\252" => '&#170;',    # hochgestelltes unterstrichenes a
-           "\253" => '&laquo;',   # left-pointing double angle quotation mark (besser koennte ichs auch nicht beschreiben...)
-           "\254" => '&#172;',    # Negationszeichen
-           "\255" => '-',         # Bindestrich
-           "\256" => '&reg;',     # (R)
-           "\257" => '&szlig;',   # sz, was auch immer fuern Zeichensatz (DOS?)
-           "\260" => '&#176;',    # Grad-Zeichen
-           "\261" => '&#177;',    # Plusminus
-           "\262" => '&#178;',    # hoch 2
-           "\263" => '&#179;',    # hoch 3
-           "\264" => '&acute;',   # Acute
-           "\265" => '&#181;',    # my-Zeichen (griech)
-           "\266" => '&#182;',    # Absatzzeichen
-           "\267" => '&#183;',    # Mal-Zeichen
-           "\270" => '&cedil;',
-           "\271" => '&sup1;',    # hoch 1
-           "\272" => '&#186;',    # masculine ordinal indicator (spanish)
-           "\273" => '&raquo;',   # right-pointing double angle quotation mark
-           "\274" => '&#188;',    # 1/4
-           "\275" => '&#189;',    # 1/2
-           "\276" => '&#190;',    # 3/4
-           "\277" => '&#191;',    # umgedrehtes ?
-           "\300" => '&Agrave;',
-           "\301" => '&Aacute;',
-           "\302" => '&Acirc;',
-           "\303" => '&Atilde;',
-           "\304" => '&Auml;',
-           "\305" => '&Aring;',
-           "\306" => '&AElig;',
-           "\307" => '&Ccedil;',
-           "\310" => '&Egrave;',
-           "\311" => '&Eacute;',
-           "\312" => '&Ecirc;',
-           "\313" => '&Euml;',
-           "\314" => '&Igrave;',
-           "\315" => '&Iacute;',
-           "\316" => '&Icirc;',
-           "\317" => '&Iuml;',
-           "\320" => '&ETH;',     # keine Ahnung, was das wohl sein soll, auf jeden Fall was islaendisches...
-           "\321" => '&Ntilde;',
-           "\322" => '&Ograve;',
-           "\323" => '&Oacute;',
-           "\324" => '&Ocirc;',
-           "\325" => '&Otilde;',
-           "\326" => '&Ouml;',
-           "\327" => '&#215;',    # eigentlich &times; funzt afaik aber nicht aufm Mac (ob das hier funktioniert, weiss ich nicht)
-           "\330" => '&Oslash;',
-           "\331" => '&Ugrave;',
-           "\332" => '&Uacute;',
-           "\333" => '&Ucirc;',
-           "\334" => '&Uuml;',
-           "\335" => '&Yacute;',
-           "\336" => '&THORN;',
-           "\337" => '&szlig;',
-           "\340" => '&agrave;',
-           "\341" => '&aacute;',
-           "\342" => '&acirc;',
-           "\343" => '&atilde;',
-           "\344" => '&auml;',
-           "\345" => '&aring;',
-           "\346" => '&aelig;',
-           "\347" => '&ccedil;',
-           "\350" => '&egrave;',
-           "\351" => '&eacute;',
-           "\352" => '&ecirc;',
-           "\353" => '&euml;',
-           "\354" => '&igrave;',
-           "\355" => '&iacute;',
-           "\356" => '&icirc;',
-           "\357" => '&iuml;',
-           "\360" => '&eth;',
-           "\361" => '&ntilde;',
-           "\362" => '&ograve;',
-           "\363" => '&oacute;',
-           "\364" => '&ocirc;',
-           "\365" => '&otilde;',
-           "\366" => '&ouml;',
-           "\367" => '&divide;',
-           "\370" => '&oslash;',
-           "\371" => '&ugrave;',
-           "\372" => '&uacute;',
-           "\373" => '&ucirc;',
-           "\374" => '&uuml;',
-           "\375" => '&yacute;',
-           "\376" => '&thorn;',
-           "\377" => '&yuml;');
+  # Latin 1 + guessed
+  #
+  %sonder=(
+    "\177" => '&#127;',
+    "\200" => '&#8364;',
+    "\201" => '&uuml;',
+    "\202" => '&#8218;',
+    "\203" => '&#402;',
+    "\204" => '&#8222;',
+    "\205" => '&#8230;',
+    "\206" => '&#8224;',
+    "\207" => '&#8225;',
+    "\210" => '&#710;',
+    "\211" => '&#8240;',
+    "\212" => '&#352;',
+    "\213" => '&#8249;',
+    "\214" => '&#338;',
+    "\215" => '&igrave;',
+    "\216" => '&#381;',
+    "\217" => '&Aring;',
+    "\220" => '&uuml;',
+    "\221" => "'",
+    "\222" => "'",
+    "\223" => '&#8220;',
+    "\224" => '&#8220;',
+    "\225" => '&#8226;',
+    "\226" => '-',
+    "\227" => '-',
+    "\230" => '&#732;',
+    "\231" => '&#8482;',
+    "\232" => '&#353;',
+    "\233" => '&#8250;',
+    "\234" => '&#339;',
+    "\235" => '&#216;',
+    "\236" => '&#215;',
+    "\237" => '&#376;',
+    "\240" => '&nbsp;',
+    "\241" => '&#161;',
+    "\242" => '&#162;',
+    "\243" => '&pound;',
+    "\244" => '&#164;',
+    "\245" => '&yen;',
+    "\246" => '&#166;',
+    "\247" => '&sect;',
+    "\250" => '&#168;',
+    "\251" => '&copy;',
+    "\252" => '&#170;',
+    "\253" => '&laquo;',
+    "\254" => '&#172;',
+    "\255" => '-',
+    "\256" => '&reg;',
+    "\257" => '&szlig;',
+    "\260" => '&#176;',
+    "\261" => '&#177;',
+    "\262" => '&#178;',
+    "\263" => '&#179;',
+    "\264" => '&acute;',
+    "\265" => '&#181;',
+    "\266" => '&#182;',
+    "\267" => '&#183;',
+    "\270" => '&cedil;',
+    "\271" => '&sup1;',
+    "\272" => '&#186;',
+    "\273" => '&raquo;',
+    "\274" => '&#188;',
+    "\275" => '&#189;',
+    "\276" => '&#190;',
+    "\277" => '&#191;',
+    "\300" => '&Agrave;',
+    "\301" => '&Aacute;',
+    "\302" => '&Acirc;',
+    "\303" => '&Atilde;',
+    "\304" => '&Auml;',
+    "\305" => '&Aring;',
+    "\306" => '&AElig;',
+    "\307" => '&Ccedil;',
+    "\310" => '&Egrave;',
+    "\311" => '&Eacute;',
+    "\312" => '&Ecirc;',
+    "\313" => '&Euml;',
+    "\314" => '&Igrave;',
+    "\315" => '&Iacute;',
+    "\316" => '&Icirc;',
+    "\317" => '&Iuml;',
+    "\320" => '&ETH;',
+    "\321" => '&Ntilde;',
+    "\322" => '&Ograve;',
+    "\323" => '&Oacute;',
+    "\324" => '&Ocirc;',
+    "\325" => '&Otilde;',
+    "\326" => '&Ouml;',
+    "\327" => '&#215;',
+    "\330" => '&Oslash;',
+    "\331" => '&Ugrave;',
+    "\332" => '&Uacute;',
+    "\333" => '&Ucirc;',
+    "\334" => '&Uuml;',
+    "\335" => '&Yacute;',
+    "\336" => '&THORN;',
+    "\337" => '&szlig;',
+    "\340" => '&agrave;',
+    "\341" => '&aacute;',
+    "\342" => '&acirc;',
+    "\343" => '&atilde;',
+    "\344" => '&auml;',
+    "\345" => '&aring;',
+    "\346" => '&aelig;',
+    "\347" => '&ccedil;',
+    "\350" => '&egrave;',
+    "\351" => '&eacute;',
+    "\352" => '&ecirc;',
+    "\353" => '&euml;',
+    "\354" => '&igrave;',
+    "\355" => '&iacute;',
+    "\356" => '&icirc;',
+    "\357" => '&iuml;',
+    "\360" => '&eth;',
+    "\361" => '&ntilde;',
+    "\362" => '&ograve;',
+    "\363" => '&oacute;',
+    "\364" => '&ocirc;',
+    "\365" => '&otilde;',
+    "\366" => '&ouml;',
+    "\367" => '&divide;',
+    "\370" => '&oslash;',
+    "\371" => '&ugrave;',
+    "\372" => '&uacute;',
+    "\373" => '&ucirc;',
+    "\374" => '&uuml;',
+    "\375" => '&yacute;',
+    "\376" => '&thorn;',
+    "\377" => '&yuml;'
+  );

 
   # Unicode-Mapping
 
   # Unicode-Mapping

-  %unimap=(128 => '&#8364;',
-           129 => '&uuml;',
-           130 => '&#8218;',
-           131 => '&#402;',
-           132 => '&#8222;',
-           133 => '&#8230;',
-           134 => '&#8224;',
-           135 => '&#8225;',
-           136 => '&#710;',
-           137 => '&#8240;',
-           138 => '&#352;',
-           139 => '&#8249;',
-           140 => '&#338;',
-           141 => '&igrave;',
-           142 => '&#381;',
-           143 => '&Aring;',
-           144 => '&uuml;',
-           145 => "'",
-           146 => "'",
-           147 => '&#8220;',
-           148 => '&#8220;',
-           149 => '&#8226;',
-           150 => '-',
-           151 => '-',
-           152 => '&#732;',
-           153 => '&#8482;',
-           154 => '&#353;',
-           155 => '&#8250;',
-           156 => '&#339;',
-           157 => '&#216;',
-           158 => '&#215;',
-           159 => '&#376;',
-           160 => '&nbsp;',
-           163 => '&pound;',
-           165 => '&yen;',
-           167 => '&sect;',
-           169 => '&copy;',
-           171 => '&laquo;',
-           173 => '-',
-           174 => '&reg;',
-           175 => '&szlig;',
-           180 => '&acute;',
-           184 => '&cedil;',
-           185 => '&sup1;',
-           187 => '&raquo;',
-           192 => '&Agrave;',
-           193 => '&Aacute;',
-           194 => '&Acirc;',
-           195 => '&Atilde;',
-           196 => '&Auml;',
-           197 => '&Aring;',
-           198 => '&AElig;',
-           199 => '&Ccedil;',
-           200 => '&Egrave;',
-           201 => '&Eacute;',
-           202 => '&Ecirc;',
-           203 => '&Euml;',
-           204 => '&Igrave;',
-           205 => '&Iacute;',
-           206 => '&Icirc;',
-           207 => '&Iuml;',
-           208 => '&ETH;',
-           209 => '&Ntilde;',
-           210 => '&Ograve;',
-           211 => '&Oacute;',
-           212 => '&Ocirc;',
-           213 => '&Otilde;',
-           214 => '&Ouml;',
-           216 => '&Oslash;',
-           217 => '&Ugrave;',
-           218 => '&Uacute;',
-           219 => '&Ucirc;',
-           220 => '&Uuml;',
-           221 => '&Yacute;',
-           222 => '&THORN;',
-           223 => '&szlig;',
-           224 => '&agrave;',
-           225 => '&aacute;',
-           226 => '&acirc;',
-           227 => '&atilde;',
-           228 => '&auml;',
-           229 => '&aring;',
-           230 => '&aelig;',
-           231 => '&ccedil;',
-           232 => '&egrave;',
-           233 => '&eacute;',
-           234 => '&ecirc;',
-           235 => '&euml;',
-           236 => '&igrave;',
-           237 => '&iacute;',
-           238 => '&icirc;',
-           239 => '&iuml;',
-           240 => '&eth;',
-           241 => '&ntilde;',
-           242 => '&ograve;',
-           243 => '&oacute;',
-           244 => '&ocirc;',
-           245 => '&otilde;',
-           246 => '&ouml;',
-           247 => '&divide;',
-           248 => '&oslash;',
-           249 => '&ugrave;',
-           250 => '&uacute;',
-           251 => '&ucirc;',
-           252 => '&uuml;',
-           253 => '&yacute;',
-           254 => '&thorn;',
-           255 => '&yuml;');
+  %unimap=(
+    128 => '&#8364;',
+    129 => '&uuml;',
+    130 => '&#8218;',
+    131 => '&#402;',
+    132 => '&#8222;',
+    133 => '&#8230;',
+    134 => '&#8224;',
+    135 => '&#8225;',
+    136 => '&#710;',
+    137 => '&#8240;',
+    138 => '&#352;',
+    139 => '&#8249;',
+    140 => '&#338;',
+    141 => '&igrave;',
+    142 => '&#381;',
+    143 => '&Aring;',
+    144 => '&uuml;',
+    145 => "'",
+    146 => "'",
+    147 => '&#8220;',
+    148 => '&#8220;',
+    149 => '&#8226;',
+    150 => '-',
+    151 => '-',
+    152 => '&#732;',
+    153 => '&#8482;',
+    154 => '&#353;',
+    155 => '&#8250;',
+    156 => '&#339;',
+    157 => '&#216;',
+    158 => '&#215;',
+    159 => '&#376;',
+    160 => '&nbsp;',
+    163 => '&pound;',
+    165 => '&yen;',
+    167 => '&sect;',
+    169 => '&copy;',
+    171 => '&laquo;',
+    173 => '-',
+    174 => '&reg;',
+    175 => '&szlig;',
+    180 => '&acute;',
+    184 => '&cedil;',
+    185 => '&sup1;',
+    187 => '&raquo;',
+    192 => '&Agrave;',
+    193 => '&Aacute;',
+    194 => '&Acirc;',
+    195 => '&Atilde;',
+    196 => '&Auml;',
+    197 => '&Aring;',
+    198 => '&AElig;',
+    199 => '&Ccedil;',
+    200 => '&Egrave;',
+    201 => '&Eacute;',
+    202 => '&Ecirc;',
+    203 => '&Euml;',
+    204 => '&Igrave;',
+    205 => '&Iacute;',
+    206 => '&Icirc;',
+    207 => '&Iuml;',
+    208 => '&ETH;',
+    209 => '&Ntilde;',
+    210 => '&Ograve;',
+    211 => '&Oacute;',
+    212 => '&Ocirc;',
+    213 => '&Otilde;',
+    214 => '&Ouml;',
+    216 => '&Oslash;',
+    217 => '&Ugrave;',
+    218 => '&Uacute;',
+    219 => '&Ucirc;',
+    220 => '&Uuml;',
+    221 => '&Yacute;',
+    222 => '&THORN;',
+    223 => '&szlig;',
+    224 => '&agrave;',
+    225 => '&aacute;',
+    226 => '&acirc;',
+    227 => '&atilde;',
+    228 => '&auml;',
+    229 => '&aring;',
+    230 => '&aelig;',
+    231 => '&ccedil;',
+    232 => '&egrave;',
+    233 => '&eacute;',
+    234 => '&ecirc;',
+    235 => '&euml;',
+    236 => '&igrave;',
+    237 => '&iacute;',
+    238 => '&icirc;',
+    239 => '&iuml;',
+    240 => '&eth;',
+    241 => '&ntilde;',
+    242 => '&ograve;',
+    243 => '&oacute;',
+    244 => '&ocirc;',
+    245 => '&otilde;',
+    246 => '&ouml;',
+    247 => '&divide;',
+    248 => '&oslash;',
+    249 => '&ugrave;',
+    250 => '&uacute;',
+    251 => '&ucirc;',
+    252 => '&uuml;',
+    253 => '&yacute;',
+    254 => '&thorn;',
+    255 => '&yuml;'
+  );

 }
 
 }
 

-# making require happy
+# keeping require happy

 1;
 
 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 80c414bfe3fa188dd05b2726c211bb6abd0703b5..c0815f4ce89b45cb0ef0f3aac4c5d389e3a7609a 100644 (file)
--- 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 <nd@o3media.de>, 2001-04-10                          #
+#                                                                              #
+# Description: prepare a Posting text for saving and visual (HTML) output      #
+#                                                                              #
+################################################################################

 
 use strict;
 
 
 use strict;
 

-package Encode::Posting;
-
-use vars qw(@EXPORT);

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

+use CheckRFC;

 
 

-# ====================================================
-# Funktionsexport
-# ====================================================
-
+################################################################################
+#
+# Export
+#

 use base qw(Exporter);
 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;
 
 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;)|\(|\)|<br>)) # der Begrenzer (\s, ] oder Zeilenende)
-              }
-              {<a href="$1">$1</a>$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;)|<br>)) # der Begrenzer (\s, ] oder Zeilenende)
-              }
-              {<a href="$1">$1</a>$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;)|<br>)) # der Begrenzer (\s, ] oder Zeilenende)
-              }
-              {<img src="$1" border=0 alt="">$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;)|<br>)) # der Begrenzer (\s, ] oder Zeilenende)
-              }
-              {<iframe src="$1" width="90%" height="90%"><a href="$1">$1</a></iframe>$2}gix;
+  # encode the special syntaxes
+  #
+  $posting =~ s!$_!<a href="$1">$1</a>!
+    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)/'<img src="'.$msg{$_} -> {src}.'" width='.$msg{$_}->{width}.' height='.$msg{$_}->{height}.' border=0 alt="'.plain($msg{$_}->{alt}).'">'/gei;}
+  $posting =~ s!$_!<img src="$1" border=0 alt="">!
+    for (map {qr/\[\Q${plain(\$_->[0])}\E:\s*(\Q${plain(\$_->[1])}\E)\s*\]/} @images);
+
+  $posting =~ s!$_!<iframe src="$1" width="90%" height="90%"><a href="$1">$1</a></iframe>!
+    for (map {qr/\[\Q${plain(\$_->[0])}\E:\s*(\Q${plain(\$_->[1])}\E)\s*\]/} @iframes);
+
+  %msg = map {plain($_) => $msg{$_}} keys %msg;
+  $posting =~ s!$_!'<img src="'.$msg{lc $1} -> {src}.'" width='.$msg{lc $1}->{width}.' height='.$msg{lc $1}->{height}.' border=0 alt="'.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 => <br>, fix spaces
+  #
+  $posting = ${multiline (\$posting)};

 
 

-  # Rueckgabe
+  # return
+  #

   \$posting;
 }
 
   \$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;
 sub answer_field ($$) {
   my $posting = shift;

-  my $params = shift;
-  $params = {} unless (defined $params);
+  my $params = shift || {};

 
 

-  # ================
-  # Antwortfeld
-  # ================

   my $area = $$posting;
   my $area = $$posting;

-

   my $qchar = $params -> {quoteChars};
 
   my $qchar = $params -> {quoteChars};
 

-  $area =~ s/(?:^|(<br>))(?!<br>)/$1 || '' . "\177"/eg if ($params -> {quoteArea}); # Antwortfeld quoten?!
-  $area =~ s/\177/$qchar/g; # normalisierte Quotes jedenfalls in Chars umsetzen
+  $area =~ s/<br>/\n/g;            # <br> => \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{<iframe\s+src="([^"]*)"[^>]+>.*?</iframe>|<img\s+src="([^"]*)"\s+width[^>]+>|<img src="([^"]*)"[^>]*>|<a href="([^"]*)">.*?</a>}
-            {if    (defined $1) {"[iframe: $1]"}
-             elsif (defined $2) {"[msg: $msg{$2}]"}
-             elsif (defined $3) {"[image: $3]"}
-             elsif (defined $4) {"[link: $4]"}}eg;
-  $area =~ s/<br>/\n/g;
-  $area =~ s/&(?:#160|nbsp);/ /g;
+  # [msg...]
+  $area =~ s{(<img\s+src="([^"]+)"\s+width[^>]+>)} {
+    defined $msg{$2}
+    ? "[msg: $msg{$2}]"
+    : $1;
+  }ge;

 
 

-  # Rueckgabe
+  # [iframe...]
+  $area =~ s{<iframe\s+src="([^"]*)"[^>]+>.*?</iframe>} {[iframe: $1]}g;
+
+  # [image...]
+  $area =~ s{<img src="([^"]*)"[^>]*>}{[image: $1]}g;
+
+  # [link...]
+  $area =~ s{<a href="([^"]*)">.*?</a>}{[link: $1]}g;
+
+  # return
+  #

   \$area;
 }
 
   \$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};
 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 /<br>/ => $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 '<br>' => map {
+      $_->[0]
+        ? join join ('<br>' => @{$_->[-1]}) => ($params->{startCite}, $params->{endCite})
+        : (join '<br>' => @{$_->[-1]});
+    } @array;
+  }

 
 

-  # ================
-  # Postingtext
-  # ================

   my $qchar = $params -> {quoteChars};
   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>))*<br>)<br>(?=\177)/$1/g;
-    $posting =~ s/(\177(?:[^<]|<(?!br>))*<br>)<br>(?!\177)/$1/g;
-
-    my ($last_level, $level, $line, $q, @new)=(-1,0);
-
-    foreach $line (split (/<br>/,$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='<br>'.$params -> {startCite} . $line}
-        elsif ($level > 0) {$last_level = $level; $line=$params -> {endCite} . '<br>' . $params -> {startCite} . $line}
-        elsif ($level == 0 and $last_level > 0) {$last_level = -1; $line = $params -> {endCite} . '<br>' . $line}}
-
-      push @new,$line}
-
-    $new[0] =~ s/^<br>//;
-    $posting = (join '<br>',@new) . (($last_level > 0)?$params -> {endCite}:'');}
-
-  $posting =~ s/\177/$qchar/g; # normalisierte Quotes in Chars umsetzen
-
-  # Rueckgabe
+  # return
+  #

   \$posting;
 }
 
   \$posting;
 }
 

-
-# ====================================================
-# Modulinitialisierung
-# ====================================================
-
-# making require happy
+# keeping 'require' happy

 1;
 
 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 b7d78935aa677cc2edf60a8abcef039647c616e6..507cd81337b121778ea8bf018cb101122e921795 100644 (file)
--- 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},
     body     => encoded_body(
       \($param -> {body}),
       { quoteChars => $param -> {quoteChars},

-        messages   => $param -> {messages}
+        messages   => $param -> {messages},
+        base_uri   => $param -> {base_uri}

       }
     ),
     time     => $param -> {time},
       }
     ),
     time     => $param -> {time},


@@ -179,7 +180,8 @@ sub write_reply_posting ($) {
         ${encoded_body(
           \($param -> {body}),
           { quoteChars => $param -> {quoteChars},
         ${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);
 }
 
   return (0, $thread, $mid);
 }
 

-# keeping 'require' happy
+# keep 'require' happy

 #
 1;
 
 #
 1;
 

diff --git a/selfforum-cgi/shared/Template.pm b/selfforum-cgi/shared/Template.pm
index e74d1d24dcad70a7b2c8ba9b64bd0935fd3eafcb..44da2cc3d1c831b02ff1e41cf58edfd1dea76619 100644 (file)
--- 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 <nd@o3media.de>, 2001-04-12                          #
+#                                                                              #
+# Description: Handle XML based HTML-Templates                                 #
+#                                                                              #
+################################################################################

 
 use strict;
 
 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 {
 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);
 
 
   $self -> file (+shift);
 

-  # Rueckgabe
+  # return

   $self;
 }
 
   $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;
 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;
 
 
   $self -> {file} = $new if (defined $new);
   $self -> parse_file;
 

+  # return

   $old;
 }
 
   $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 {
 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};
 }
 
   $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 {
 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;
 }
 
   \$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 {
 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;
 }
 
   \$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;
 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);
     };
     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);
 
 
     my $template = $xml -> getElementsByTagName ('Template', 0) -> item (0);
 

-    # Metas bestimmen
+    # extract meta delimiters
+    #

     $self -> {metaon}  = $template -> getAttribute ('metaon');
     $self -> {metaoff} = $template -> getAttribute ('metaoff');
 
     $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;}
 
       $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 = <FILE>;
+    close FILE or croak "error while closing template file '$filename' after reading: $!";
+
+    ($root, $template) = ($1, $2) if ($xml =~ m|(<Template\s+[^>"]*(?:"[^"]*"[^>"]*)*>)(.*)</Template\s*>|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 &quot; &apos; &lt; &gt; and &amp;
+    # (while using non XML::DOM - version)
+    #
+    for ('metaon', 'metaoff') {
+      $self -> {$_} =~ s/&quot;/"/g;  $self -> {$_} =~ s/&apos;/'/g;
+      $self -> {$_} =~ s/&lt;/</g;    $self -> {$_} =~ s/&gt;/>/g;
+      $self -> {$_} =~ s/&amp;/&/g;
+    }
+
+    $self -> {parsed} = {};
+    while ($template =~ m|<Scrap\s+(?:id\s*=\s*"([^"]+)")?\s*>\s*<!\[CDATA\[([^\]]*(?:\](?!\]>)[^\]]*)*)\]\]>\s*</Scrap\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) = @_;
 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};
 
   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 {
 
   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
      (?:
      (.*?)                                   # $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->{$_})
       for (split /\s+/,$t3) {
         next unless (
           exists($params->{$_})

+          and defined ${$params->{$_}}

           and length ${$params->{$_}}
         );
 
           and length ${$params->{$_}}
         );
 


@@ -231,14 +328,14 @@ sub parse_if {
     }
 
     $ret;
     }
 
     $ret;

-  }gosex);
+  }gsex);

 
   return;
 }
 
 
   return;
 }
 

-# keep require happy
+# keeping 'require' happy

 1;
 
 #
 #
 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 c03f05a236fde7657fb61e42b7122c6dec10ce93..9140478016004869c6f2f5df95aca5bda8812ed9 100644 (file)
--- 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 <nd@o3media.de>, 2001-04-19                          #
+#                                                                              #
+# Description: print Forum main file to STDOUT                                 #
+#                                                                              #
+################################################################################

 
 use strict;
 
 
 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);
 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;
 
 use Template::_conf;
 use Template::_thread;
 

-# ====================================================
-# Funktionsexport
-# ====================================================
-
+################################################################################
+#
+# Export
+#

 use base qw(Exporter);
 @Template::Forum::EXPORT = qw(print_forum_as_HTML);
 
 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};
 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)) {
   my ($threads, $stat);
 
   unless ($stat = lock_file ($mainfile)) {

-    if ($stat == 0) {
+    if (defined $stat) {

       violent_unlock_file ($mainfile);
       violent_unlock_file ($mainfile);

-      print "aha!"
-      # ueberlastet
+      print ${$template -> scrap (
+        $assign -> {errorDoc},
+        { $assign -> {errorText} => $template -> insert ($assign -> {'occupied'}) }
+      )};

     }
     }

-

     else {
     else {

-     # Mastersperre...
+      print ${$template -> scrap (
+        $assign -> {errorDoc},
+        { $assign -> {errorText} => $template -> insert ($assign -> {'notAvailable'}) }
+      )};

     }}
 
   else {
     }}
 
   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));
 
 
     $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<dl>";
+    print ${$template -> scrap (
+      $assign -> {mainDocStart},
+      {  $assign -> {loadingTime} => plain (long_hr_time (time)) }
+      )
+    },"\n<dl>";

 
 

-    my $tpar = {template => $param -> {tree},
-                cgi      => $param -> {cgi},
-                start    => -1};
+    my $tpar = {
+      template => $param -> {tree},
+      cgi      => $param -> {cgi},
+      start    => -1
+    };

 
     my @threads;
 
 
     my @threads;
 


@@ -82,13 +95,9 @@ sub print_forum_as_HTML ($$$) {
   return;
 }
 
   return;
 }
 

-# ====================================================
-# Modulinitialisierung
-# ====================================================
-
-# making require happy
+# keep require happy

 1;
 
 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 5081a1a9a8b182e7ace6c793bfac89d73775b606..348a7dbb07797d7c2f16e1d153dc1b1fbc4f453b 100644 (file)
--- 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 ($threadpath, $tempfile, $param) = @_;
 
   my $template = new Template $tempfile;

+  my $assign = $param -> {assign};

 
 

-  # Datei sperren... (eigentlich)

   my $view = get_view_params ({
     adminDefault => $param -> {adminDefault}
   });
 
   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;
 }
 
   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 6528d38b9c71187d2776561f4354dc4961714de4..6f1e130c9be63aef2ea4ee44f4f3077be13bdd9c 100644 (file)
--- 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;
 
   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}
           );
 
            sortedThreads => $default -> {View} -> {sortThreads}
           );
 

diff --git a/selfforum-cgi/user/config/answer.tmp.xml b/selfforum-cgi/user/config/answer.tmp.xml
index 5c35301d27187333db76aef9adddfe36aeccb83f..7ba30fffa5be5dc2697a53fbdb5c55218de198a8 100644 (file)
--- a/selfforum-cgi/user/config/answer.tmp.xml
+++ b/selfforum-cgi/user/config/answer.tmp.xml
@@ -202,7 +202,7 @@
 -->
 
 <Scrap id="CITE_START"><![CDATA[ <span style="color:#800000;"> ]]></Scrap>
 -->
 
 <Scrap id="CITE_START"><![CDATA[ <span style="color:#800000;"> ]]></Scrap>

-<Scrap id="CITE_END"><![CDATA[ </span><br> ]]></Scrap>
+<Scrap id="CITE_END"><![CDATA[ </span> ]]></Scrap>

 
 <!--
        Links/URLs
 
 <!--
        Links/URLs

diff --git a/selfforum-cgi/user/config/fo_view.xml b/selfforum-cgi/user/config/fo_view.xml
index 3b507ad69cac6cae47fcee41011d204773ea4122..b6bbe85c65428d37a027a6c904e988bd4c33701f 100644 (file)
--- a/selfforum-cgi/user/config/fo_view.xml
+++ b/selfforum-cgi/user/config/fo_view.xml
@@ -38,6 +38,13 @@
         <Variable name="mainDocEnd">DOC_FORUM_END</Variable>
         <Variable name="loadingTime">_LOAD_TIME</Variable>
         <Variable name="cssFile">_CSS_FILE</Variable>
         <Variable name="mainDocEnd">DOC_FORUM_END</Variable>
         <Variable name="loadingTime">_LOAD_TIME</Variable>
         <Variable name="cssFile">_CSS_FILE</Variable>

+        <Variable name="errorDoc">DOC_ERROR</Variable>
+        <Variable name="startCite">CITE_START</Variable>
+        <Variable name="endCite">CITE_END</Variable>
+
+        <Variable name="notAvailable">_N_A</Variable>
+        <Variable name="occupied">_OCCUPIED</Variable>
+        <Variable name="errorText">_ERROR_TEXT</Variable>

       </Property>
 
     </Property>
       </Property>
 
     </Property>


@@ -47,6 +54,7 @@
 
       <Property name="assign">
         <Variable name="mainDoc">DOC_POSTING</Variable>
 
       <Property name="assign">
         <Variable name="mainDoc">DOC_POSTING</Variable>

+        <Variable name="errorDoc">DOC_ERROR</Variable>

         <Variable name="cssFile">_CSS_FILE</Variable>
         <Variable name="message">_MESSAGE</Variable>
         <Variable name="name">_BEF_NAME</Variable>
         <Variable name="cssFile">_CSS_FILE</Variable>
         <Variable name="message">_MESSAGE</Variable>
         <Variable name="name">_BEF_NAME</Variable>


@@ -63,6 +71,10 @@
         <Variable name="parentLink">_REF_LINK</Variable>
         <Variable name="startCite">CITE_START</Variable>
         <Variable name="endCite">CITE_END</Variable>
         <Variable name="parentLink">_REF_LINK</Variable>
         <Variable name="startCite">CITE_START</Variable>
         <Variable name="endCite">CITE_END</Variable>

+
+        <Variable name="notAvailable">_N_A</Variable>
+        <Variable name="occupied">_OCCUPIED</Variable>
+        <Variable name="errorText">_ERROR_TEXT</Variable>

       </Property>
 
       <Property name="form">
       </Property>
 
       <Property name="form">

diff --git a/selfforum-cgi/user/config/forum.tmp.xml b/selfforum-cgi/user/config/forum.tmp.xml
index 4ed9a2e84595f4f54d3edb7e1f25578bd08e859f..6242b07fb64dd70b20501a1e9055040330fe4a31 100644 (file)
--- a/selfforum-cgi/user/config/forum.tmp.xml
+++ b/selfforum-cgi/user/config/forum.tmp.xml
@@ -68,12 +68,40 @@
 </html>
   ]]></Scrap>
 
 </html>
   ]]></Scrap>
 

-  <Scrap id="TREE_CLOSED"><![CDATA[
-<a href="{&& _COMMAND &&}">{&& IMG_XCLOSED &&}</a> (<b>{&& _CATEGORY &&}</b>) <a href="{&& _LINK &&}"><b>{&& _TITLE &&}</b></a> von <b>{&& _NAME &&}</b>, {&& _TIME &&}
-  ]]></Scrap>
+<Scrap id="_N_A"><![CDATA[Das Forum ist zur Zeit aus Wartungsgr&uuml;nden geschlossen. Versuchen Sie es bitte sp&auml;ter nocheinmal.]]></Scrap>
+<Scrap id="_OCCUPIED"><![CDATA[Das Forum ist tempor&auml;r nicht verf&uuml;gbar. Versuchen Sie es bitte in einigen Minuten nocheinmal.]]></Scrap>
+
+  <Scrap id="DOC_ERROR"><![CDATA[
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
+
+<html>
+<head>
+       <meta http-equiv="expires" content="0">
+       <meta name="robots" content="noindex">
+
+       <title>SELFHTML Forum: Fehler</title>
+
+       <link rel="stylesheet" type="text/css" href="{&& _CSS_FILE &&}">
+</head>

 
 

-  <Scrap id="TREE_CLOSED_NC"><![CDATA[
-<a href="{&& _COMMAND &&}">{&& IMG_XCLOSED &&}</a> <a href="{&& _LINK &&}"><b>{&& _TITLE &&}</b></a> von <b>{&& _NAME &&}</b>, {&& _TIME &&}
+<body bgcolor="#FFFFFF" text="#000000" link="#AA5522" vlink="#772200" alink="#000000">
+<table cellpadding="4" cellspacing="0" border="0" width="100%"><tr><td bgcolor="#FFEEDD" class="nav"><a class="an" name="top">{&& IMG_X2 &&}</a>&nbsp;{&& LINK_SELFAKTUELL &&}&nbsp;{&& IMG_X2 &&}&nbsp;{&& LINK_SELFLIVE &&}&nbsp;{&& IMG_X2 &&}&nbsp;{&& LINK_SELFFORUM &&}</td></tr></table><table cellpadding="4" cellspacing="0" border="0" width="100%">
+<tr><td bgcolor="#EEEEEE" class="doc" width="110">{&& IMG_XWEB &&}</td>
+       <td bgcolor="#EEEEEE" class="doc" valign="bottom" width="100%"><h2>SELFHTML Forum:<br>Fehler</h2></td></tr>
+<tr><td bgcolor="#EEEEEE" class="doc" valign="top" align="center">{&& IMG_X5 &&}</td>
+       <td bgcolor="#FFFFFF" valign="top">
+               <p>{&& IMG_XGDOWN &&}&nbsp;<a href="#a1"><b>Fehler</b></a></p></td></tr>
+<tr><td colspan="2" bgcolor="#EEEEEE" class="doc"><a href="#bottom">{&& IMG_XGDOWN &&}</a>&#160;</td></tr>
+</table>
+<h2 class="Sh2"><a class="an" name="a1">Fehler</a></h2>
+<p>{&& _ERROR_TEXT &&}</p>
+<table cellpadding="4" cellspacing="0" border="0" width="100%">
+<tr><td bgcolor="#EEEEEE" class="doc"><a href="#top">{&& IMG_XGOUP &&}</a></td></tr>
+<tr><td bgcolor="#FFEEDD" class="nav"><a class="an" name="bottom">{&& IMG_X2 &&}</a>&nbsp;{&& LINK_SELFAKTUELL &&}&nbsp;{&& IMG_X2 &&}&nbsp;{&& LINK_SELFLIVE &&} {&& IMG_X2 &&}&nbsp;{&& LINK_SELFFORUM &&}</td></tr>
+</table>
+<p>&copy; 2000 {&& IMG_XGMAIL &&}&nbsp;<a href="mailto:{&& MAIL_SELF &&}">{&& MAIL_SELF &&}</a></p>
+</body>
+</html>

   ]]></Scrap>
 
   <Scrap id="TREE_START"><![CDATA[
   ]]></Scrap>
 
   <Scrap id="TREE_START"><![CDATA[

diff --git a/selfforum-cgi/user/config/posting.tmp.xml b/selfforum-cgi/user/config/posting.tmp.xml
index 67df7b591c5573aef63cfbc807d2ebf4fa7e08bb..f73a2ae4d8741ea690a8d44ef9b018224bd5194e 100644 (file)
--- a/selfforum-cgi/user/config/posting.tmp.xml
+++ b/selfforum-cgi/user/config/posting.tmp.xml
@@ -70,6 +70,41 @@
 </html>
   ]]></Scrap>
 
 </html>
   ]]></Scrap>
 

+<Scrap id="_N_A"><![CDATA[Das angeforderte Posting ist nicht verf&uuml;gbar.]]></Scrap>
+<Scrap id="_OCCUPIED"><![CDATA[Das angeforderte Posting ist tempor&auml;r nicht verf&uuml;gbar. Versuchen Sie es bitte in einigen Minuten nocheinmal.]]></Scrap>
+
+  <Scrap id="DOC_ERROR"><![CDATA[
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
+
+<html>
+<head>
+       <meta http-equiv="expires" content="0">
+       <meta name="robots" content="noindex">
+
+       <title>SELFHTML Forum: Fehler</title>
+
+       <link rel="stylesheet" type="text/css" href="{&& _CSS_FILE &&}">
+</head>
+
+<body bgcolor="#FFFFFF" text="#000000" link="#AA5522" vlink="#772200" alink="#000000">
+<table cellpadding="4" cellspacing="0" border="0" width="100%"><tr><td bgcolor="#FFEEDD" class="nav"><a class="an" name="top">{&& IMG_X2 &&}</a>&nbsp;{&& LINK_SELFAKTUELL &&}&nbsp;{&& IMG_X2 &&}&nbsp;{&& LINK_SELFLIVE &&}&nbsp;{&& IMG_X2 &&}&nbsp;{&& LINK_SELFFORUM &&}</td></tr></table><table cellpadding="4" cellspacing="0" border="0" width="100%">
+<tr><td bgcolor="#EEEEEE" class="doc" width="110">{&& IMG_XWEB &&}</td>
+       <td bgcolor="#EEEEEE" class="doc" valign="bottom" width="100%"><h2>SELFHTML Forum:<br>Fehler</h2></td></tr>
+<tr><td bgcolor="#EEEEEE" class="doc" valign="top" align="center">{&& IMG_X5 &&}</td>
+       <td bgcolor="#FFFFFF" valign="top">
+               <p>{&& IMG_XGDOWN &&}&nbsp;<a href="#a1"><b>Fehler</b></a></p></td></tr>
+<tr><td colspan="2" bgcolor="#EEEEEE" class="doc"><a href="#bottom">{&& IMG_XGDOWN &&}</a>&#160;</td></tr>
+</table>
+<h2 class="Sh2"><a class="an" name="a1">Fehler</a></h2>
+<p>{&& _ERROR_TEXT &&}</p>
+<table cellpadding="4" cellspacing="0" border="0" width="100%">
+<tr><td bgcolor="#EEEEEE" class="doc"><a href="#top">{&& IMG_XGOUP &&}</a></td></tr>
+<tr><td bgcolor="#FFEEDD" class="nav"><a class="an" name="bottom">{&& IMG_X2 &&}</a>&nbsp;{&& LINK_SELFAKTUELL &&}&nbsp;{&& IMG_X2 &&}&nbsp;{&& LINK_SELFLIVE &&} {&& IMG_X2 &&}&nbsp;{&& LINK_SELFFORUM &&}</td></tr>
+</table>
+<p>&copy; 2000 {&& IMG_XGMAIL &&}&nbsp;<a href="mailto:{&& MAIL_SELF &&}">{&& MAIL_SELF &&}</a></p>
+</body>
+</html>
+  ]]></Scrap>

 
 <!--
        ***** Schnipsel *****
 
 <!--
        ***** Schnipsel *****

diff --git a/selfforum-cgi/user/fo_posting.pl b/selfforum-cgi/user/fo_posting.pl
index dad9b8f2ff525ae09a31428099812959da5a688e..111f045492a1a5f929ba3f3bf52141c8485daedc 100644 (file)
--- a/selfforum-cgi/user/fo_posting.pl
+++ b/selfforum-cgi/user/fo_posting.pl
@@ -375,7 +375,8 @@ sub save {
           lastMessage   => $f -> {last_message},
           parsedThreads => $f -> {threads},
           dtd           => $f -> {dtd},
           lastMessage   => $f -> {last_message},
           parsedThreads => $f -> {threads},
           dtd           => $f -> {dtd},

-          messages      => $self -> {template} -> {messages} || {},
+          messages      => $self -> {conf} -> {template} -> {messages} || {},
+          base_uri      => $self -> {conf} -> {original} -> {files} -> {forum_base}

         };
 
         # set the variables if defined..
         };
 
         # set the variables if defined..


@@ -423,8 +424,8 @@ sub save {
           #
           $self -> {response} -> {doc}  = $self -> {conf} -> {assign} -> {docThx};
           $self -> {response} -> {pars} = {
           #
           $self -> {response} -> {doc}  = $self -> {conf} -> {assign} -> {docThx};
           $self -> {response} -> {pars} = {

-            $thx -> {time}     => plain (hr_time($time)),
-            $thx -> {body}     => message_as_HTML (
+            $thx -> {time} => plain (hr_time($time)),
+            $thx -> {body} => message_as_HTML (

               $xml,
               $self -> {template},
               { posting    => $mid,
               $xml,
               $self -> {template},
               { posting    => $mid,


@@ -500,7 +501,7 @@ sub load_main_file {
   my $lock_stat;
 
   unless ($lock_stat = write_lock_file ($self -> {conf} -> {forum_file_name})) {
   my $lock_stat;
 
   unless ($lock_stat = write_lock_file ($self -> {conf} -> {forum_file_name})) {

-    if (defined $lock_stat and $lock_stat == 0) {
+    if (defined $lock_stat) {

       # occupied or no w-bit set for the directory..., hmmm
       #
       violent_unlock_file ($self -> {conf} -> {forum_file_name});
       # occupied or no w-bit set for the directory..., hmmm
       #
       violent_unlock_file ($self -> {conf} -> {forum_file_name});

diff --git a/selfforum-cgi/user/fo_view.pl b/selfforum-cgi/user/fo_view.pl
index 766fc10a3d78cf65b6393c99f4ef681c4d3b1a9c..cd29709f6c0e697c98de9b5cc4ded387a0b2ed8b 100644 (file)
--- a/selfforum-cgi/user/fo_view.pl
+++ b/selfforum-cgi/user/fo_view.pl
@@ -54,7 +54,7 @@ if (defined ($tid) and defined ($mid)) {
       thread       => $tid,
       posting      => $mid,
       adminDefault => $adminDefault,
       thread       => $tid,
       posting      => $mid,
       adminDefault => $adminDefault,

-      messages     => $show_posting -> {messages},
+      messages     => $conf -> {template} -> {messages},

       form         => $show_posting -> {form},
       cgi          => $cgi,
       tree         => $tree
       form         => $show_posting -> {form},
       cgi          => $cgi,
       tree         => $tree