CheckRFC now matches a http-uri including the fragment identifier

redesign of fo_posting.pl, not yet ready, be patient, please ;-)

diff --git a/selfforum-cgi/shared/CheckRFC.pm b/selfforum-cgi/shared/CheckRFC.pm
index 6c64adeed5c15d71194dd88556a519e0dc880c45..35d47d8659c3bb9fe61f933dc36297544d772770 100644 (file)
--- a/selfforum-cgi/shared/CheckRFC.pm
+++ b/selfforum-cgi/shared/CheckRFC.pm
@@ -172,7 +172,7 @@ BEGIN {
   my $hsegment       =  "(?:(?:$httpuchar|[;:\@&=~])*)";
   my $search         =  "(?:(?:$httpuchar|[;:\@&=~])*)";
   my $hpath          =  "(?:$hsegment(?:/$hsegment)*)";
   my $hsegment       =  "(?:(?:$httpuchar|[;:\@&=~])*)";
   my $search         =  "(?:(?:$httpuchar|[;:\@&=~])*)";
   my $hpath          =  "(?:$hsegment(?:/$hsegment)*)";

-  my $httpurl        =  "(?:http://$hostport(?:/$hpath(?:\\?$search)?)?)";
+  my $httpurl        =  "(?:http://$hostport(?:/$hpath(?:\\?$search)?)?(?:#$xchar*)?)";

 
   # GOPHER (see also RFC1436)
   my $gopher_plus    =  "(?:$xchar*)";
 
   # GOPHER (see also RFC1436)
   my $gopher_plus    =  "(?:$xchar*)";

diff --git a/selfforum-cgi/user/config/answer.tmp.xml b/selfforum-cgi/user/config/answer.tmp.xml
index 8ea9c3e84b683b137072e104109a884dfb65d68d..a7d99703f2bb16e1b845737d263d8435e956e18e 100644 (file)
--- a/selfforum-cgi/user/config/answer.tmp.xml
+++ b/selfforum-cgi/user/config/answer.tmp.xml
@@ -163,7 +163,7 @@
 -->
 
   <Scrap id="POST_FORM"><![CDATA[
 -->
 
   <Scrap id="POST_FORM"><![CDATA[

-<form method="post" action="{&& _FORM_ACTION &&}">{&& %IF _FORM_FUP_VALUE &&}
+<form accept-charset="iso-8859-1, UTF-8" method="post" action="{&& _FORM_ACTION &&}">{&& %IF _FORM_FUP_VALUE &&}

 <input type="hidden" name="{&& _FORM_FUP_NAME &&}" value="{&& _FORM_FUP_VALUE &&}">{&& %ENDIF &&}{&& %IF _FORM_UID_VALUE &&}
 <input type="hidden" name="{&& _FORM_UID_NAME &&}" value="{&& _FORM_UID_VALUE &&}">{&& %ENDIF &&}
 <input type="hidden" name="{&& _FORM_UNID_NAME &&}" value="{&& _FORM_UNID_VALUE &&}">
 <input type="hidden" name="{&& _FORM_FUP_NAME &&}" value="{&& _FORM_FUP_VALUE &&}">{&& %ENDIF &&}{&& %IF _FORM_UID_VALUE &&}
 <input type="hidden" name="{&& _FORM_UID_NAME &&}" value="{&& _FORM_UID_VALUE &&}">{&& %ENDIF &&}
 <input type="hidden" name="{&& _FORM_UNID_NAME &&}" value="{&& _FORM_UNID_VALUE &&}">

diff --git a/selfforum-cgi/user/config/fo_posting.xml b/selfforum-cgi/user/config/fo_posting.xml
index fd6e4fc6eb31ea8bfbe48801c0a63accba6af9d5..d39d8a2d0d545377b9be012a307039b919408ce9 100644 (file)
--- a/selfforum-cgi/user/config/fo_posting.xml
+++ b/selfforum-cgi/user/config/fo_posting.xml
@@ -46,7 +46,7 @@
       <Property name="form">
         <Property name="action">
           <Property name="post">
       <Property name="form">
         <Property name="action">
           <Property name="post">

-            <Variable name="url">/cgi-local/user/fo_posting.pl</Variable>
+            <Variable name="url">/cgi-local/dev/env.pl</Variable>

             <Variable name="assign">_FORM_ACTION</Variable>
           </Property>
         </Property>
             <Variable name="assign">_FORM_ACTION</Variable>
           </Property>
         </Property>


@@ -69,6 +69,8 @@
             <ListItem>posterName</ListItem>
             <ListItem>posterEmail</ListItem>
             <ListItem>posterBody</ListItem>
             <ListItem>posterName</ListItem>
             <ListItem>posterEmail</ListItem>
             <ListItem>posterBody</ListItem>

+            <ListItem>posterCategory</ListItem>
+            <ListItem>posterSubject</ListItem>

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


@@ -163,7 +165,8 @@
             <Variable name="name">category</Variable>
             <Variable name="maxlength">18</Variable>
             <Variable name="minlength">3</Variable>
             <Variable name="name">category</Variable>
             <Variable name="maxlength">18</Variable>
             <Variable name="minlength">3</Variable>

-            <Variable name="errorType">repeat</Variable>
+            <Variable name="errorType">fetch</Variable>
+            <Variable name="header">category</Variable>

             <List name="values">
               <ListItem>ASP</ListItem>
               <ListItem>BROWSER</ListItem>
             <List name="values">
               <ListItem>ASP</ListItem>
               <ListItem>BROWSER</ListItem>


@@ -172,7 +175,7 @@
               <ListItem>DATENBANK</ListItem>
               <ListItem>DESIGN</ListItem>
               <ListItem>DHTML</ListItem>
               <ListItem>DATENBANK</ListItem>
               <ListItem>DESIGN</ListItem>
               <ListItem>DHTML</ListItem>

-              <ListItem>E_MAIL</ListItem>
+              <ListItem>E-MAIL</ListItem>

               <ListItem>FTP</ListItem>
               <ListItem>GRAFIK</ListItem>
               <ListItem>HTML</ListItem>
               <ListItem>FTP</ListItem>
               <ListItem>GRAFIK</ListItem>
               <ListItem>HTML</ListItem>


@@ -209,7 +212,8 @@
             <Variable name="name">subject</Variable>
             <Variable name="maxlength">64</Variable>
             <Variable name="minlength">4</Variable>
             <Variable name="name">subject</Variable>
             <Variable name="maxlength">64</Variable>
             <Variable name="minlength">4</Variable>

-            <Variable name="errorType">repeat</Variable>
+            <Variable name="errorType">fetch</Variable>
+            <Variable name="header">subject</Variable>

           </Property>
 
           <Property name="posterBody">
           </Property>
 
           <Property name="posterBody">


@@ -237,7 +241,8 @@
             </Property>
             <Variable name="name">url</Variable>
             <Variable name="maxlength">1024</Variable>
             </Property>
             <Variable name="name">url</Variable>
             <Variable name="maxlength">1024</Variable>

-            <Variable name="errorType">repeat</Variable>
+            <Variable name="type">http-url</Variable>
+            <Variable name="errorType">kill</Variable>

           </Property>
 
           <Property name="posterImage">
           </Property>
 
           <Property name="posterImage">


@@ -248,7 +253,8 @@
             </Property>
             <Variable name="name">image</Variable>
             <Variable name="maxlength">1024</Variable>
             </Property>
             <Variable name="name">image</Variable>
             <Variable name="maxlength">1024</Variable>

-            <Variable name="errorType">repeat</Variable>
+            <Variable name="type">http-url</Variable>
+            <Variable name="errorType">kill</Variable>

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

diff --git a/selfforum-cgi/user/config/fo_view.xml b/selfforum-cgi/user/config/fo_view.xml
index 3b507ad69cac6cae47fcee41011d204773ea4122..a647105f839e5650c823ab2c99bfe6fc6c0937c1 100644 (file)
--- a/selfforum-cgi/user/config/fo_view.xml
+++ b/selfforum-cgi/user/config/fo_view.xml
@@ -68,7 +68,7 @@
       <Property name="form">
         <Property name="action">
           <Property name="post">
       <Property name="form">
         <Property name="action">
           <Property name="post">

-            <Variable name="url">/cgi-local/user/fo_posting.pl</Variable>
+            <Variable name="url">/cgi-local/dev/env.pl</Variable>

             <Variable name="assign">_FORM_ACTION</Variable>
           </Property>
 
             <Variable name="assign">_FORM_ACTION</Variable>
           </Property>
 

diff --git a/selfforum-cgi/user/config/posting.tmp.xml b/selfforum-cgi/user/config/posting.tmp.xml
index 32b1ce07beb8a4f22bda0125309458d7fb7c80c2..67df7b591c5573aef63cfbc807d2ebf4fa7e08bb 100644 (file)
--- a/selfforum-cgi/user/config/posting.tmp.xml
+++ b/selfforum-cgi/user/config/posting.tmp.xml
@@ -38,7 +38,7 @@
 <dl>{&& _THREAD &&}</dl>{&& %ENDIF &&}
 <h3>Eigene Antwort schreiben</h3>
 <p>Die Nachricht, auf die Sie antworten, ist im Feld des Nachrichtentextes noch mal komplett zitiert. Entfernen Sie bei langen Nachrichten bitte alle Passagen aus dem Zitat bis auf jene, auf die Sie selbst Bezug nehmen wollen.</p>
 <dl>{&& _THREAD &&}</dl>{&& %ENDIF &&}
 <h3>Eigene Antwort schreiben</h3>
 <p>Die Nachricht, auf die Sie antworten, ist im Feld des Nachrichtentextes noch mal komplett zitiert. Entfernen Sie bei langen Nachrichten bitte alle Passagen aus dem Zitat bis auf jene, auf die Sie selbst Bezug nehmen wollen.</p>

-<form method="post" action="{&& _FORM_ACTION &&}">
+<form accept-charset="iso-8859-1, UTF-8" method="post" action="{&& _FORM_ACTION &&}">

 <input type="hidden" name="{&& _FORM_FUP_NAME &&}" value="{&& _FORM_FUP_VALUE &&}">{&& %IF _FORM_UID_VALUE &&}
 <input type="hidden" name="{&& _FORM_UID_NAME &&}" value="{&& _FORM_UID_VALUE &&}">{&& %ENDIF &&}
 <input type="hidden" name="{&& _FORM_UNID_NAME &&}" value="{&& _FORM_UNID_VALUE &&}">
 <input type="hidden" name="{&& _FORM_FUP_NAME &&}" value="{&& _FORM_FUP_VALUE &&}">{&& %IF _FORM_UID_VALUE &&}
 <input type="hidden" name="{&& _FORM_UID_NAME &&}" value="{&& _FORM_UID_VALUE &&}">{&& %ENDIF &&}
 <input type="hidden" name="{&& _FORM_UNID_NAME &&}" value="{&& _FORM_UNID_VALUE &&}">

diff --git a/selfforum-cgi/user/fo_posting.pl b/selfforum-cgi/user/fo_posting.pl
index 9bc7eb03a1ff80a3678b4685a5cd8421f18ec68e..e59d2c4340a72081392d51c5608927b4f45d63aa 100644 (file)
--- a/selfforum-cgi/user/fo_posting.pl
+++ b/selfforum-cgi/user/fo_posting.pl
@@ -1,18 +1,21 @@
-#!/usr/bin/perl
+#!/usr/bin/perl -wT

 
 ################################################################################
 #                                                                              #
 # File:        user/fo_posting.pl                                              #
 #                                                                              #
 
 ################################################################################
 #                                                                              #
 # File:        user/fo_posting.pl                                              #
 #                                                                              #

-# Authors:     André Malo <nd@o3media.de>, 2001-01-25                          #
+# Authors:     André Malo <nd@o3media.de>, 2001-03-30                          #

 #                                                                              #
 # Description: Accept new postings, display "Neue Nachricht" page              #
 #                                                                              #
 #                                                                              #
 # Description: Accept new postings, display "Neue Nachricht" page              #
 #                                                                              #

+# not ready, be patient please                                                 #
+#                                                                              #

 ################################################################################
 
 use strict;
 ################################################################################
 
 use strict;

-use vars qw($Bin $Shared $Script %subhash $httpurl $flocked);
+use vars qw($Bin $Shared $Script);

 
 

+# locate the script

 BEGIN {
   my $null = $0; $null =~ s/\\/\//g; # for win :-(
   ($Bin)    = ($null =~ /^(.*)\/.*$/)? $1 : '.';
 BEGIN {
   my $null = $0; $null =~ s/\\/\//g; # for win :-(
   ($Bin)    = ($null =~ /^(.*)\/.*$/)? $1 : '.';


@@ -20,518 +23,325 @@ BEGIN {
   ($Script) = ($null =~ /^.*\/(.*)$/)? $1 : $null;
 }
 
   ($Script) = ($null =~ /^.*\/(.*)$/)? $1 : $null;
 }
 

-use CGI::Carp qw(fatalsToBrowser);
-

 use lib "$Shared";
 use lib "$Shared";

+#use CGI::Carp qw(fatalsToBrowser);
+

 use Conf;
 use Encode::Plain; $Encode::Plain::utf8 = 1;
 use Encode::Posting;
 use Id;
 use Lock qw(:ALL);
 use Conf;
 use Encode::Plain; $Encode::Plain::utf8 = 1;
 use Encode::Posting;
 use Id;
 use Lock qw(:ALL);

-use Mail;
-use Posting::_lib qw(get_all_threads get_message_node get_message_header hr_time);
+use CheckRFC;
+use Posting::_lib qw(get_all_threads get_message_node get_message_header hr_time parse_xml_file);

 use Posting::Write;
 use Template;
 use Template::Posting;
 
 use Posting::Write;
 use Template;
 use Template::Posting;
 

-use CGI qw(param header);
+use CGI;

 use XML::DOM;
 
 use XML::DOM;
 

-print header (-type => 'text/html');
-
-our $conf = read_script_conf ($Bin, $Shared, $Script);
-
-our $show_posting = $conf -> {show} -> {Posting};
-our $assign   = $show_posting -> {assign};
-our $formmust = $show_posting -> {form} -> {must};
-our $formdata = $show_posting -> {form} -> {data};
-our $formact  = $show_posting -> {form} -> {action};
-our $template = new Template $show_posting -> {templateFile};
-our $pars = {};
-our ($failed, %dparam, $threads, $last_thread, $last_message, $ftid, $fmid, $flocked);
-
-sub forum_filename () {$conf -> {files} -> {forum};}
-sub message_path () {$conf -> {files} -> {messagePath};}
-
-################################
+# load script configuration and admin default conf.
+my $conf         = read_script_conf ($Bin, $Shared, $Script);
+my $adminDefault = read_admin_conf ($conf -> {files} -> {adminDefault});

 
 

-# Formfelder ausfuellen (Namen)
-for (qw(posterBody uniqueID followUp quoteChar userID posterName posterEmail posterCategory posterSubject posterURL posterImage)) {
-  $pars -> {$formdata -> {$_} -> {assign} -> {name}} = plain($formdata -> {$_} -> {name});}
+# Initializing the request
+my $response = new Posting::Response ($conf, $adminDefault);

 
 

-my $checked = &check_param;
+# fetch and parse the cgi-params
+$response -> parse_cgi;

 
 

-unless (exists ($subhash {$checked})) {
-  &print_fatal ($assign -> {unknownError});}
-
-else {
-  unless ($checked eq 'newThread') {
-    $checked = &check_reply_dupe() || $checked;}
-
-  unless (exists ($subhash {$checked})) {
-    &print_fatal ($assign -> {unknownError});}
-  else {
-    &{$subhash {$checked}};}
-
-  if ($flocked) {
-    violent_unlock_file (forum_filename) unless (write_unlock_file (forum_filename));}}
-
-# ====================================================
-# end of main / Funktionen
-# ====================================================

 
 

+################################################################################
+### Posting::Response ##########################################################
+package Posting::Response;

 
 

-### check_reply_dupe () ########################################################
-#
-# Reply moeglich? Doppelposting?
+### sub new ####################################################################

 #
 #

-# Params: -none-
-# Return: Dupe check result
-#         'Dupe'  - Posting is a dupe
-#         Nothing - ok.
+# initialising the Posting::Response object
+# check parameters and fill in object properties

 #
 #

-sub check_reply_dupe () {
-  my $stat;
-
-  unless ($stat = write_lock_file (forum_filename)) {
-    if ($stat == 0) {
-      # ueberlastet oder so
-      violent_unlock_file (forum_filename);
-      return 'Occupied';
-    } else {
-      return 'masterLock';
-    }
-  } else {
-    my ($i, %msg, %unids);
-
-    $flocked = 1;
+sub new {
+  my ($class, $conf, $adminDefault) = @_;

 
 

-    ($threads, $last_thread, $last_message, undef, my $unids) = get_all_threads (forum_filename, 1, 0);
-    ($ftid,$fmid) = split /;/,$dparam{$formdata -> {followUp} -> {name}},2;
+  my $sp = $conf -> {show} -> {Posting};

 
 

-    # Thread existiert nicht
-    if (exists($dparam{$formdata -> {followUp} -> {name}})) {
-      return 'noReply' unless (exists($threads -> {$ftid}));
+  my $self = {
+       conf => {
+         original => $conf,
+         admin    => $adminDefault,

 
 

-      # nur nicht geloeschte Messages beachten
-      for ($i=0; $i < @{$threads -> {$ftid}}; $i++) {
-        if ($threads -> {$ftid} -> [$i] -> {deleted}) {
-          $i+=$threads -> {$ftid} -> [$i] -> {answers};}
+         message_path    => $conf -> {files} -> {messagePath},
+         forum_file_name => $conf -> {files} -> {forum},

 
 

-        else {
-          $msg{$threads -> {$ftid} -> [$i] -> {mid}}=$i;}}
+         show_posting    => $sp,
+         assign          => $sp -> {assign},
+         form_must       => $sp -> {form} -> {must},
+         form_data       => $sp -> {form} -> {data},
+         form_action     => $sp -> {form} -> {action},
+       },

 
 

-      # Message existiert nicht
-      if (exists($dparam{$formdata -> {followUp} -> {name}})) {
-        return 'noReply' unless (exists($msg{$fmid}));}
-
-      %unids = map {$_ => 1} @{$threads -> {$ftid} -> [$msg{$fmid}] -> {unids}};
-    } else {
-      %unids = map {$_ => 1} @$unids;
-    }
+       template => new Template $sp -> {templateFile}
+     };

 
 

-    # jetzt endlich
-    return 'Dupe' if (exists ($unids{$dparam{$formdata -> {uniqueID} -> {name}}}));
-  }
-
-  return;
+  bless $self, $class;

 }
 
 }
 

-################################
-# sub got_new
+### sub parse_cgi ##############################################################

 #
 #

-# Eroeffnungsposting speichern
-################################
-
-sub got_new () {
-
-  my $time = time;
-  my $pars = {author        => $dparam {$formdata -> {posterName} -> {name}},
-              email         => $dparam {$formdata -> {posterEmail} -> {name}},
-              category      => $dparam {$formdata -> {posterCategory} -> {name}},
-              subject       => $dparam {$formdata -> {posterSubject} -> {name}},
-              body          => $dparam {$formdata -> {posterBody} -> {name}},
-              homepage      => $dparam {$formdata -> {posterURL} -> {name}},
-              image         => $dparam {$formdata -> {posterImage} -> {name}},
-              time          => $time,
-              uniqueID      => $dparam {$formdata -> {uniqueID} -> {name}},
-              ip            => $ENV{REMOTE_ADDR},
-              forumFile     => forum_filename,
-              messagePath   => message_path,
-              lastThread    => $last_thread,
-              lastMessage   => $last_message,
-              parsedThreads => $threads,
-              dtd           => 'forum.dtd',
-              quoteChars    => toUTF8('»» '),
-              messages      => $conf -> {template} -> {messages}};
-
-  my ($stat, $xml, $mid) = write_posting ($pars);
-  violent_unlock_file (forum_filename) unless (write_unlock_file (forum_filename));
-  $flocked = undef;
-
-  if ($stat) {
-    print "Och noe...: $stat";}
-
-  else {
-    my $thx = $show_posting -> {thanx};
-
-    print ${$template -> scrap ($assign -> {docThx},
-                               {$thx -> {author}   => plain ($dparam {$formdata -> {posterName} -> {name}}),
-                                $thx -> {email}    => plain ($dparam {$formdata -> {posterEmail} -> {name}}),
-                                $thx -> {time}     => plain (hr_time($time)),
-                                $thx -> {body}     => message_as_HTML ($xml, $template,
-                                                                      {posting => $mid,
-                                                                       assign  => $assign}),
-                                $thx -> {category} => plain ($dparam {$formdata -> {posterCategory} -> {name}}),
-                                $thx -> {home}     => plain ($dparam {$formdata -> {posterURL} -> {name}}),
-                                $thx -> {image}    => plain ($dparam {$formdata -> {posterImage} -> {name}}),
-                                $thx -> {subject}  => plain ($dparam {$formdata -> {posterSubject} -> {name}})})};
-  }
-  return;
-}
-
-################################
-# sub got_reply
+# fetch and decode cgi-parameters,
+# find out the kind of response requested by the user (new message, reply)

 #
 #

-# Antwortposting speichern
-################################
-
-sub got_reply () {
-  my $stat;
-
-  my $time = time;
-  my $pars = {author        => $dparam {$formdata -> {posterName} -> {name}},
-              email         => $dparam {$formdata -> {posterEmail} -> {name}},
-              category      => $dparam {$formdata -> {posterCategory} -> {name}},
-              subject       => $dparam {$formdata -> {posterSubject} -> {name}},
-              body          => $dparam {$formdata -> {posterBody} -> {name}},
-              homepage      => $dparam {$formdata -> {posterURL} -> {name}},
-              image         => $dparam {$formdata -> {posterImage} -> {name}},
-              time          => $time,
-              uniqueID      => $dparam {$formdata -> {uniqueID} -> {name}},
-              ip            => $ENV{REMOTE_ADDR},
-              parentMessage => $fmid,
-              thread        => $ftid,
-              forumFile     => forum_filename,
-              messagePath   => message_path,
-              lastThread    => $last_thread,
-              lastMessage   => $last_message,
-              parsedThreads => $threads,
-              dtd           => 'forum.dtd',
-              quoteChars    => toUTF8('»» '),
-              messages      => $conf -> {template} -> {messages}};
-
-  ($stat, my $xml, my $mid) = write_posting ($pars);
-  violent_unlock_file (forum_filename) unless (write_unlock_file (forum_filename));
-  $flocked = undef;
-
-  if ($stat) {
-    print "Och noe...: $stat";}
-
-  else {
-    my $thx = $show_posting -> {thanx};
-
-    print ${$template -> scrap ($assign -> {docThx},
-                               {$thx -> {author}   => plain ($dparam {$formdata -> {posterName} -> {name}}),
-                                $thx -> {email}    => plain ($dparam {$formdata -> {posterEmail} -> {name}}),
-                                $thx -> {time}     => plain (hr_time($time)),
-                                $thx -> {body}     => message_as_HTML ($xml, $template,
-                                                                      {posting => $mid,
-                                                                       assign  => $assign}),
-                                $thx -> {category} => plain ($dparam {$formdata -> {posterCategory} -> {name}}),
-                                $thx -> {home}     => plain ($dparam {$formdata -> {posterURL} -> {name}}),
-                                $thx -> {image}    => plain ($dparam {$formdata -> {posterImage} -> {name}}),
-                                $thx -> {subject}  => plain ($dparam {$formdata -> {posterSubject} -> {name}})})};}
-}
-
-################################
-# sub new_thread
+# Return: Status Code (Bool)
+#         try out the error method, if false

 #
 #

-# HTML fuer Eroeffnungsposting
-################################
-
-sub new_thread () {
-  my $list = [map {{$assign -> {optval} => plain($_)}} @{$formdata -> {posterCategory} -> {values}}];
-
-  # spaeter kommen noch userspezifische Daten dazu...
-  print ${$template -> scrap ($assign -> {docNew},
-                             {$formdata->{uniqueID}      ->{assign}->{value} => plain(unique_id),
-                              $formdata->{quoteChar}     ->{assign}->{value} => '&#255;'.plain(toUTF8('»» ')),
-                              $formact->{post}->{assign}                     => $formact->{post}->{url},
-                              $formdata->{posterCategory}->{assign}->{value} => $template->list ($assign -> {option}, $list)
-                             },$pars)};
-}
+sub parse_cgi {
+  my $self = shift;

 
 

-################################
-# diverse subs
-#
-# Fehlermeldungen
-################################
-
-sub no_reply ()         {&print_fatal ($assign -> {noReply});}
-sub dupe_posting ()     {&print_fatal ($assign -> {dupe});}
-sub missing_key ()      {&print_fatal ($assign -> {wrongPar});}
-sub unexpected_key ()   {&print_fatal ($assign -> {wrongPar});}
-sub unknown_encoding () {&print_fatal ($assign -> {wrongCode});}
-sub too_short () {
-  if ($formdata -> {$failed} -> {errorType} eq 'repeat') {
-    &print_error ($formdata -> {$failed} -> {assign} -> {tooShort},
-                  $formdata -> {$failed} -> {minlength});}
+  # create the CGI object
+  my $q = new CGI;
+  $self -> {cgi_object} = $q;

 
 

-  else {
-    &print_fatal ($formdata -> {$failed} -> {assign} -> {tooShort});}
+  # check the params
+  return unless $self -> check_cgi;

 }
 
 }
 

-sub too_long () {
-  if ($formdata -> {$failed} -> {errorType} eq 'repeat') {
-    &print_error ($formdata -> {$failed} -> {assign} -> {tooLong},
-                  $formdata -> {$failed} -> {maxlength});}
-
-  else {
-    &print_fatal ($formdata -> {$failed} -> {assign} -> {tooLong});}
-}
-
-sub wrong_mail () {print_error ($formdata -> {$failed} -> {assign} -> {wrong});}
-sub occupied () {print_error ($assign -> {occupied});}
-
-################################
-# sub print_fatal
+### sub check_cgi ##############################################################

 #
 #

-# fatale Fehlerausgabe
-################################
-
-sub print_fatal ($) {
-  print ${$template -> scrap ($assign -> {docFatal},
-                             {$assign -> {errorMessage} => $template -> insert ($_[0])
-                             },$pars)};
-}
-
-################################
-# sub print_error
+# cgi params are like raw eggs...

 #
 #

-# Fehlerausgabe, Moeglichkeit
-# zur Korrektur
-################################
-
-sub print_error ($;$) {
-  &fillin;
-  print ${$template -> scrap ($assign -> {docError},
-                             {$assign -> {errorMessage} => $template -> insert ($_[0]),
-                              $assign -> {charNum}      => $_[1]
-                             },$pars)};
-}
-
-################################
-# sub fetch_subject
+# Return: Status Code (Bool)
+#         creates content for the error method if anything fails

 #
 #

-# Subject und Category besorgen
-# (wenn noch nicht vorhanden)
-################################
+sub check_cgi {
+  my $self = shift;

 
 

-sub fetch_subject () {
-
-  my %must = map {$_ => 1} @{$formmust -> {exists $dparam{$formdata -> {followUp} -> {name}}?'reply':'new'}};
+  # find out the count of the submitted keys and the keys themselves
+  #
+  my %got_keys     = map {($_ => 1)} $self -> {cgi_object} -> param;
+  my $cnt_got_keys = keys %got_keys;
+  my $formdata = $self -> {conf} -> {form_data};
+  my $formmust = $self -> {conf} -> {form_must};

 
 

-  if ( ($must{posterCategory} and not exists ($dparam{$formdata -> {posterCategory} -> {name}})) or
-       ($must{posterSubject} and not exists ($dparam{$formdata -> {posterSubject} -> {name}})))
-  {
-    my $filename = message_path.'t'.$ftid.'.xml';
+  # user requested the 'new thread' page
+  # (no params or only the user-ID has been submitted)
+  #
+  if ($cnt_got_keys == 0 or (
+        exists ($formdata -> {userID})
+        and $cnt_got_keys == 1
+        and $got_keys{$formdata -> {userID} -> {name}}
+        )
+     ) {
+    $self -> {response} = {new_thread => 1};
+    return 1;
+  }

 
 

-    if (-f $filename and lock_file ($filename))
-    {
-      my $xml = new XML::DOM::Parser -> parsefile ($filename);
-      violent_unlock_file($filename) unless unlock_file ($filename);
+  ###################################################
+  # now we know, we've got a filled out form
+  # we do the following steps to check it:
+  #
+  # 1st: create a reverse Hash (CGI-key - identifier)
+  # 2nd: did we get _all_ must-keys?
+  #      check whether reply or new message request
+  # 3rd: did we get too many keys?
+  # 4th: do _all_ requested values accord to
+  #      expectations?
+  #      fetch the "missing" keys
+  #

 
 

-      my $mnode = get_message_node ($xml, "t$ftid", "m$fmid");
-      my $header = get_message_header ($mnode);
+  # 1
+  #
+  my %name = map {($formdata -> {$_} -> {name} => $_)} keys %$formdata;

 
 

-      $dparam{$formdata -> {posterCategory} -> {name}} = $header -> {category};
-      $dparam{$formdata -> {posterSubject} -> {name}} = $header -> {subject};
-    }
-  }
-}
+  # 2
+  #
+  $self -> {response} -> {reply} = $got_keys {$formdata -> {followUp} -> {name}}? 1 : 0;
+  $self -> {response} -> {new}   = not $self -> {response} -> {reply};

 
 

-################################
-# sub fillin
-#
-# Fuellen von $pars
-# (bereits vorhandene Formdaten)
-################################
+  # define the fetch array (values to fetch from parent message)
+  #
+  $self -> {fetch} = [];

 
 

-sub fillin () {
-  fetch_subject;
+  for ( @{$formmust -> {$self -> {response} -> {reply}?'reply':'new'}} ) {

 
 

-  my $list = [map {{$assign -> {optval} => plain($_),
-                    (($_ eq $dparam{$formdata -> {posterCategory} -> {name}})?($assign -> {optsel} => 1):())}}
-                @{$formdata -> {posterCategory} -> {values}}];
+    unless ($got_keys {$formdata -> {$_} -> {name}}) {

 
 

-  $pars -> {$formdata->{posterCategory}->{assign}->{value}} = $template->list ($assign -> {option}, $list);
-  $pars -> {$formact ->{post}->{assign}}                    = $formact->{post}->{url};
-  $pars -> {$formdata->{quoteChar}->{assign}->{value}}      = '&#255;'.plain($dparam {$formdata -> {quoteChar} -> {name}} or '');
+      # only miss the key unless we're able to fetch it from parent posting
+      #
+      unless (
+           $self -> {response} -> {new}
+        or $formdata -> {$name {$_}} -> {errorType} eq 'fetch') {

 
 

-  # Formfelder ausfuellen (Werte)
-  for (qw(uniqueID userID followUp posterName posterEmail posterSubject posterBody posterURL posterImage)) {
-    $pars -> {$formdata->{$_}->{assign}->{value}} = plain($dparam {$formdata -> {$_} -> {name}});}
-}
+        $self -> {error} = {spec => 'missing_key'};
+        return;
+      }
+      else {
+        # keep in mind to fetch the value later
+        #
+        push @{$self -> {fetch}} => $name {$_};
+      }
+    }
+  }

 
 

-################################
-# sub decode_param
-#
-# CGI-Parameter decodieren
-# (rudimentaerer UTF8-support)
-################################
+  # 3
+  #
+  for ($self -> {cgi_object} -> param) {
+    unless (exists ($name {$_})) {
+      $self -> {error} = {
+        spec => 'unexpected_key',
+        desc => $name{$_}
+      };
+      return;
+    }
+  }

 
 

-sub decode_param () {
-  my $code = param ($formdata -> {quoteChar} -> {name});
-  my @array;
+  # 4
+  #
+  unless ($self -> decode_param) {
+    $self -> {error} = {spec => 'unknown_encoding'};
+    return;
+  };

 
 

-  # UTF-8 ([hoechst-]wahrscheinlich)
-  if ($code =~ /^\303\277/) {
+  # I'm lazy - I know...
+  my $q = $self -> {cgi_object};

 
 

-    foreach (param) {
-      @array=param ($_);
+  if ($self -> {response} -> {reply}) {

 
 

-      if (@array == 1) {
-        $dparam{$_} = $array[0];}
+    # get the parent-identifiers if we got a reply
+    #
+    my ($ftid, $fmid) = split /;/ => $q -> param ($formdata -> {followUp} -> {name}) => 2;

 
 

-      else {
-        $dparam{$_} = \@array;}}}
+    unless ($ftid =~ /\d+/ and $fmid =~ /\d+/) {
+      $self -> {error} = {spec => 'unknown_followup'};
+      return;
+    }
+    $self -> {fup_tid} = $ftid;
+    $self -> {fup_mid} = $fmid;

 
 

-  # Latin 1 (hoffentlich - eigentlich ist es gar keine Codierung...)
-  elsif ($code =~ /^\377/) {
-    foreach (param) {
-      @array=param ($_);
+    # now fetching the missing keys
+    # if it fails, they're too short, too... ;)
+    #
+    $self -> fetch;
+  }

 
 

-      if (@array == 1) {
-        $dparam{$_} = toUTF8($array[0]);}
+  # now we can check on length, type etc.
+  #
+  for (keys %got_keys) {

 
 

-      else {
-        $dparam{$_} = [map {toUTF8($_)} @array];}}}
+    my $val = $q -> param ($_);

 
 

-  # unbekannte Codierung
-  else {
-    return;}
+    $val =~ s/\302\240/ /g;    # convert nbsp to normal spaces
+    $q -> param ($_ => $val);  # write it back

 
 

-  # ersten beiden Zeichen der Quotechars loeschen (Indikator [&#255; (als UTF8)])
-  $dparam {$formdata -> {quoteChar} -> {name}} = ($dparam {$formdata -> {quoteChar} -> {name}} =~ /..(.*)/)[0];
+    # too long?
+    #
+    if (length $val > $formdata -> {$name {$_}} -> {maxlength}) {
+      $self -> {error} = {
+        spec => 'too_long',
+        desc => $name{$_}
+      };
+      return;
+    }

 
 

-  delete $dparam {$formdata -> {posterURL} -> {name}}
-    unless ($dparam {$formdata -> {posterURL} -> {name}} =~ /$httpurl/);
+    # too short?
+    # (only check if there's defined a minimum length)
+    #
+    if (exists ($formdata -> {$name {$_}} -> {minlength})) {
+
+      # kill the whitespaces to get only the visible characters...
+      #
+      (my $val_ww = $val) =~ s/\s+//g;
+
+      if (length $val_ww < $formdata -> {$name {$_}} -> {minlength}) {
+        $self -> {error} = {
+          spec => 'too_short',
+          desc => $name{$_}
+        };
+        return;
+      }
+    }

 
 

-  delete $dparam {$formdata -> {posterImage} -> {name}}
-    unless ($dparam {$formdata -> {posterImage} -> {name}} =~ /$httpurl/);
+#    return 'wrongMail' if ($formdata -> {$name{$_}} -> {type} eq 'email' and length ($dparam{$_}) and not is_mail_address ($dparam{$_}));
+  }

 
 

-  # Codierung erkannt, alles klar
+  # ok, looks good.

   1;
 }
 
   1;
 }
 

-################################
-# sub check_param
+#  delete $dparam {$formdata -> {posterURL} -> {name}}
+#    unless ($dparam {$formdata -> {posterURL} -> {name}} =~ /$httpurl/);

 #
 #

-# CGI-Parameter pruefen
-################################
+#  delete $dparam {$formdata -> {posterImage} -> {name}}
+#    unless ($dparam {$formdata -> {posterImage} -> {name}} =~ /$httpurl/);

 
 

-sub check_param () {
-  my %gotKeys    = map {($_ => 1)} param;
-  my $numGotKeys = keys %gotKeys;
+### sub fetch ##################################################################
+#
+# fetch "missing" keys from parent posting
+#
+sub fetch {
+  my $self = shift;
+  my $q = $self -> {cgi_object};
+  my $formdata = $self -> {conf} -> {form_data};

 
 

-  # Threaderoeffnung, Ersteingabe (leere Seite)
-  return 'newThread' if ($numGotKeys == 0 or
-                         (($numGotKeys == 1) and ($gotKeys {$formdata -> {userID} -> {name}})));
+  if (@{$self -> {fetch}}) {
+    my $filename = $self -> {conf} -> {message_path}.'t'.$self -> {fup_tid}.'.xml';

 
 

-  # =======================================================
-  # ab hier steht fest, wir haben ein ausgefuelltes
-  # Formular bekommen
-  #
-  # 1. Umrechnungshash bauen (CGI-Key => Identifier)
-  # 2. alle must-keys vorhanden?
-  # 3. zuviele Parameter uebermittelt?
-  # 4. entsprechen die Daten den Anforderungen?
-  #    (alle, nicht nur die must-Daten)
+    if (lock_file ($filename)) {
+      my $xml = parse_xml_file ($filename);
+      violent_unlock_file($filename) unless unlock_file ($filename);

 
 

-  # 1
-  # ===
-  my %name = map {($formdata -> {$_} -> {name} => $_)} keys %$formdata;
+      if ($xml) {
+        my $mnode = get_message_node ($xml, 't'.$self -> {fup_tid}, 'm'.$self -> {fup_mid});
+        if ($mnode) {
+          my $header = get_message_header ($mnode);

 
 

-  # 2
-  # ===
-  $failed=1;
-  foreach (@{$formmust -> {$gotKeys {$formdata -> {followUp} -> {name}}?'reply':'new'}}) {
-    return 'missingKey' unless ($gotKeys {$formdata -> {$_} -> {name}});
+          $q -> param ($formdata -> {$_} -> {name} => $header -> {$formdata -> {$_} -> {header}})
+            for (@{$self -> {fetch}});
+        }
+      }
+    }

   }
 
   }
 

-  # 3
-  # ===
-  foreach (param) {
-    $failed = $name {$_};
-    return 'unexpectedKey' unless (exists ($name {$_}));
-  }
+  # fetching failed:
+  # fillout the values with an empty string
+  #
+  $q -> param ($formdata -> {$_} -> {name} => '')
+    for (@{$self -> {fetch}});
+}

 
 

-  # 4
-  # ===
-  return 'unknownEncoding' unless (decode_param);
+### sub decode_param ###########################################################
+#
+# convert submitted form data into UTF-8
+# unless it's not encoded yet
+#
+# Return: Status Code (Bool)
+#         false if unknown encoding (like UTF-7 for instance)
+#
+sub decode_param {
+  my $self = shift;

 
 

-  foreach (keys %dparam) {
-    $failed = $name {$_};
+  my $q = $self -> {cgi_object};
+  my $formdata = $self -> {conf} -> {form_data};

 
 

-    return 'tooLong'   if (length($dparam{$_}) > $formdata -> {$name {$_}} -> {maxlength});
-    return 'tooShort'  if (@{[$dparam{$_} =~ /(\S)/g]} < $formdata -> {$name {$_}} -> {minlength});
-    return 'wrongMail' if ($formdata -> {$name{$_}} -> {type} eq 'email' and length ($dparam{$_}) and not is_mail_address ($dparam{$_}));
-  }
+  my $code = $q -> param ($formdata -> {quoteChar} -> {name});
+  my @array;

 
 

-  $failed=0;
-  return $gotKeys {$formdata -> {followUp} -> {name}}?'gotReply':'gotNew';
-}
+  # Latin 1 (we hope so - there's no real way to find out :-( )
+  if ($code =~ /^\377/) {
+    $q -> param ($_ => map {toUTF8($_)} $q -> param ($_)) for ($q -> param);
+  }
+  else {
+    # UTF-8 is (probably) correct,
+    # other encodings we don't know and fail
+    return unless $code =~ /^\303\277/;
+  }

 
 

-# ====================================================
-# Initialisierung
-# ====================================================
+  # remove the &#255; (encoded as UTF-8) from quotechars
+  $q -> param ($formdata -> {quoteChar} -> {name} => substr ($code, 2));

 
 

-BEGIN {
-  %subhash = (newThread       => \&new_thread,
-              missingKey      => \&missing_key,
-              unexpectedKey   => \&unexpected_key,
-              unknownEncoding => \&unknown_encoding,
-              tooShort        => \&too_short,
-              tooLong         => \&too_long,
-              wrongMail       => \&wrong_mail,
-              Occupied        => \&occupied,
-              Dupe            => \&dupe_posting,
-              noReply         => \&no_reply,
-              gotReply        => \&got_reply,
-              gotNew          => \&got_new
-              );
-
-  # Die RFC-gerechte URL-Erkennung ist aus dem Forum
-  # (thx2Cheatah - wo auch immer er sie (in der Form) her hat :-)
-  my $lowalpha       =  '(?:[a-z])';
-  my $hialpha        =  '(?:[A-Z])';
-  my $alpha          =  "(?:$lowalpha|$hialpha)";
-  my $digit          =  '(?:\d)';
-  my $safe           =  '(?:[$_.+-])';
-  my $hex            =  '(?:[\dA-Fa-f])';
-  my $escape         =  "(?:%$hex$hex)";
-  my $digits         =  '(?:\d+)';
-  my $alphadigit     =  "(?:$alpha|\\d)";
-
-  # URL schemeparts for ip based protocols:
-  my $port           =  "(?:$digits)";
-  my $hostnumber     =  "(?:$digits\\.$digits\\.$digits\\.$digits)";
-  my $toplabel       =  "(?:(?:$alpha(?:$alphadigit|-)*$alphadigit)|$alpha)";
-  my $domainlabel    =  "(?:(?:$alphadigit(?:$alphadigit|-)*$alphadigit)|$alphadigit)";
-  my $hostname       =  "(?:(?:$domainlabel\\.)*$toplabel)";
-  my $host           =  "(?:(?:$hostname)|(?:$hostnumber))";
-  my $hostport       =  "(?:(?:$host)(?::$port)?)";
-
-  my $httpuchar      =  "(?:(?:$alpha|$digit|$safe|(?:[!*\',]))|$escape)";
-  my $hsegment       =  "(?:(?:$httpuchar|[;:\@&=~])*)";
-  my $search         =  "(?:(?:$httpuchar|[;:\@&=~])*)";
-  my $hpath          =  "(?:$hsegment(?:/$hsegment)*)";
-
-  # das alles ergibt eine gueltige URL :-)
-  $httpurl           =  "^(?:https?://$hostport(?:/$hpath(?:\\?$search)?)?)\$";
+  # ok, params now should be UTF-8 encoded
+  1;

 }
 
 }
 

-# ====================================================
-# end of fo_posting.pl
-# ====================================================
\ No newline at end of file
+#
+#
+### end of fo_posting.pl #######################################################
\ No newline at end of file