]> git.p6c8.net - selfforum.git/commitdiff
fo_posting.pl now runs without warnings, it's yet too special, this will be fixed...
authorndparker <>
Wed, 4 Apr 2001 22:57:26 +0000 (22:57 +0000)
committerndparker <>
Wed, 4 Apr 2001 22:57:26 +0000 (22:57 +0000)
the other files were modified to produce no warnings and to work with the current version of fo_posting.pl

selfforum-cgi/shared/Lock.pm
selfforum-cgi/shared/Posting/Write.pm
selfforum-cgi/shared/Posting/_lib.pm
selfforum-cgi/user/config/fo_posting.xml
selfforum-cgi/user/config/fo_view.xml
selfforum-cgi/user/fo_posting.pl
selfforum-cgi/user/fo_view.pl

index 38823af2bf9b9d2a29ff557206433be8602b2dd4..72900639f608e6899c2654f462f7dfd70fac82c4 100644 (file)
@@ -11,6 +11,7 @@ package Lock;
 ################################################################################
 
 use strict;
+use Carp;
 use vars qw(
   @EXPORT_OK
   %EXPORT_TAGS
@@ -554,6 +555,7 @@ sub masterlockfile ($) {
   &lockfile(&masterfile($_[0]));
 }
 sub masterfile ($) {
+  confess unless defined $_[0];
   "$_[0].master";
 }
 
@@ -841,4 +843,4 @@ BEGIN {
 
 #
 #
-### end of Lock ################################################################
+### end of Lock ################################################################
\ No newline at end of file
index 0a76a027c568a13bf5a50f9052472ec7556c9fbe..eed1534639be7e774367cc49cb4218998ba64995 100644 (file)
@@ -56,16 +56,16 @@ sub write_posting ($) {
     $thread = create_new_thread (
       { msg      => $mid,
         ip       => $param -> {ip},
-        name     => $param -> {author},
-        email    => $param -> {email},
-        home     => $param -> {homepage},
-        image    => $param -> {image},
-        category => $param -> {category},
-        subject  => $param -> {subject},
+        name     => $param -> {author}   || '',
+        email    => $param -> {email}    || '',
+        home     => $param -> {homepage} || '',
+        image    => $param -> {image}    || '',
+        category => $param -> {category} || '',
+        subject  => $param -> {subject}  || '',
         time     => $param -> {time},
         dtd      => $param -> {dtd},
         thread   => $tid,
-        body     => $param -> {body},
+        body     => $param -> {body}     || '',
         pars     => $pars
       }
     );
@@ -79,9 +79,10 @@ sub write_posting ($) {
           { mid     => $param -> {lastMessage} + 1,
             unid    => $param -> {uniqueID},
             name    => plain($param -> {author}),
-            cat     => plain(length($param -> {category})?$param->{category}:''),
+            cat     => plain(defined $param -> {category}?$param->{category}:''),
             subject => plain($param -> {subject}),
-            time    => plain($param -> {time})
+            time    => plain($param -> {time}),
+            level   => 0,
           }
          ];
 
index 0f3f015d1050431e3f0fdead3b69242331aef502..810f33443a5244665c16c755110201925c3e21da 100644 (file)
@@ -157,7 +157,7 @@ sub get_message_node ($$$)
 sub parse_xml_file ($) {
   my $file = shift;
   my $xml = eval {
-              local $SIG{__DIE__};
+              local $SIG{__DIE__};      # CGI::Carp works unreliable ;-(
               new XML::DOM::Parser (KeepCDATA => 1) -> parsefile ($file);
             };
 
index a3eda05da4bbf02493085932ba8d56132a797c9c..02d73977cf8232a795590e0710862dcd7cdf778e 100644 (file)
         <Variable name="docFatal">DOC_FATAL</Variable>
         <Variable name="errorMessage">_ERR_MESS</Variable>
         <Variable name="charNum">_NUM</Variable>
-        <Variable name="wrongPar">_MANIPULATED</Variable>
-        <Variable name="wrongCode">_ENCODING</Variable>
+        <Variable name="missing_key">_MANIPULATED</Variable>
+        <Variable name="unexpected_key">_MANIPULATED</Variable>
+        <Variable name="unknown_followup">_MANIPULATED</Variable>
+        <Variable name="unknown_encoding">_ENCODING</Variable>
         <Variable name="occupied">_OCCUPIED</Variable>
-        <Variable name="noReply">_NOREPLY</Variable>
+        <Variable name="master_lock">_MASTERLOCK</Variable>
+        <Variable name="no_reply">_NOREPLY</Variable>
         <Variable name="dupe">_DUPE</Variable>
-        <Variable name="unknownError">_UNKNOWN</Variable>
+        <Variable name="not_saved">_NOT_SAVED</Variable>
+        <Variable name="unknown_error">_UNKNOWN</Variable>
 
         <Variable name="cssFile">_CSS_FILE</Variable>
 
@@ -46,7 +50,7 @@
       <Property name="form">
         <Property name="action">
           <Property name="post">
-            <Variable name="url">/cgi-local/dev/env.pl</Variable>
+            <Variable name="url">/cgi-local/user/fo_posting.pl</Variable>
             <Variable name="assign">_FORM_ACTION</Variable>
           </Property>
         </Property>
@@ -79,7 +83,7 @@
             <Property name="assign">
               <Variable name="name">_FORM_FUP_NAME</Variable>
               <Variable name="value">_FORM_FUP_VALUE</Variable>
-              <Variable name="tooLong">_MANIPULATED</Variable>
+              <Variable name="too_long">_MANIPULATED</Variable>
             </Property>
 
             <Variable name="name">fup</Variable>
@@ -91,7 +95,7 @@
             <Property name="assign">
               <Variable name="name">_FORM_UID_NAME</Variable>
               <Variable name="value">_FORM_UID_VALUE</Variable>
-              <Variable name="tooLong">_MANIPULATED</Variable>
+              <Variable name="too_long">_MANIPULATED</Variable>
             </Property>
 
             <Variable name="name">userid</Variable>
             <Property name="assign">
               <Variable name="name">_FORM_UNID_NAME</Variable>
               <Variable name="value">_FORM_UNID_VALUE</Variable>
-              <Variable name="tooLong">_MANIPULATED</Variable>
+              <Variable name="too_long">_MANIPULATED</Variable>
             </Property>
 
             <Variable name="name">unid</Variable>
             <Property name="assign">
               <Variable name="name">_FORM_QCHAR_NAME</Variable>
               <Variable name="value">_FORM_QCHAR_VALUE</Variable>
-              <Variable name="tooLong">_MANIPULATED</Variable>
+              <Variable name="too_long">_MANIPULATED</Variable>
             </Property>
 
             <Variable name="name">qchar</Variable>
             <Property name="assign">
               <Variable name="name">_FORM_NAME_NAME</Variable>
               <Variable name="value">_FORM_NAME_VALUE</Variable>
-              <Variable name="tooLong">_NAME_TOO_LONG</Variable>
-              <Variable name="tooShort">_NAME_TOO_SHORT</Variable>
+              <Variable name="too_long">_NAME_TOO_LONG</Variable>
+              <Variable name="too_short">_NAME_TOO_SHORT</Variable>
             </Property>
 
             <Variable name="name">name</Variable>
             <Property name="assign">
               <Variable name="name">_FORM_MAIL_NAME</Variable>
               <Variable name="value">_FORM_MAIL_VALUE</Variable>
-              <Variable name="tooLong">_MAIL_TOO_LONG</Variable>
-              <Variable name="tooShort">_MAIL_TOO_SHORT</Variable>
-              <Variable name="wrong">_MAIL_WRONG</Variable>
+              <Variable name="too_long">_MAIL_TOO_LONG</Variable>
+              <Variable name="too_short">_MAIL_TOO_SHORT</Variable>
+              <Variable name="wrong_mail">_MAIL_WRONG</Variable>
             </Property>
 
             <Variable name="name">email</Variable>
             <Property name="assign">
               <Variable name="name">_FORM_CAT_NAME</Variable>
               <Variable name="value">_CATLIST</Variable>
-              <Variable name="tooLong">_CAT_WRONG</Variable>
-              <Variable name="tooShort">_CAT_WRONG</Variable>
-              <Variable name="notSelected">_CAT_WRONG</Variable>
+              <Variable name="too_long">_CAT_WRONG</Variable>
+              <Variable name="too_short">_CAT_WRONG</Variable>
+              <Variable name="no_option">_CAT_WRONG</Variable>
             </Property>
 
             <Variable name="name">category</Variable>
             <Property name="assign">
               <Variable name="name">_FORM_SUBJECT_NAME</Variable>
               <Variable name="value">_FORM_SUBJECT_VALUE</Variable>
-              <Variable name="tooLong">_SUB_TOO_LONG</Variable>
-              <Variable name="tooShort">_SUB_TOO_SHORT</Variable>
+              <Variable name="too_long">_SUB_TOO_LONG</Variable>
+              <Variable name="too_short">_SUB_TOO_SHORT</Variable>
             </Property>
             <Variable name="name">subject</Variable>
             <Variable name="maxlength">64</Variable>
             <Property name="assign">
               <Variable name="name">_FORM_BODY_NAME</Variable>
               <Variable name="value">_FORM_BODY_VALUE</Variable>
-              <Variable name="tooLong">_BODY_TOO_LONG</Variable>
-              <Variable name="tooShort">_BODY_TOO_SHORT</Variable>
+              <Variable name="too_long">_BODY_TOO_LONG</Variable>
+              <Variable name="too_short">_BODY_TOO_SHORT</Variable>
             </Property>
             <Variable name="name">body</Variable>
             <Variable name="maxlength">12288</Variable>
             <Property name="assign">
               <Variable name="name">_FORM_URL_NAME</Variable>
               <Variable name="value">_FORM_URL_VALUE</Variable>
-              <Variable name="tooLong">_URL_TOO_LONG</Variable>
+              <Variable name="too_long">_URL_TOO_LONG</Variable>
             </Property>
             <Variable name="name">url</Variable>
             <Variable name="maxlength">1024</Variable>
             <Property name="assign">
               <Variable name="name">_FORM_IMG_NAME</Variable>
               <Variable name="value">_FORM_IMG_VALUE</Variable>
-              <Variable name="tooLong">_IMG_TOO_LONG</Variable>
+              <Variable name="too_long">_IMG_TOO_LONG</Variable>
             </Property>
             <Variable name="name">image</Variable>
             <Variable name="maxlength">1024</Variable>
index a647105f839e5650c823ab2c99bfe6fc6c0937c1..3b507ad69cac6cae47fcee41011d204773ea4122 100644 (file)
@@ -68,7 +68,7 @@
       <Property name="form">
         <Property name="action">
           <Property name="post">
-            <Variable name="url">/cgi-local/dev/env.pl</Variable>
+            <Variable name="url">/cgi-local/user/fo_posting.pl</Variable>
             <Variable name="assign">_FORM_ACTION</Variable>
           </Property>
 
index 41099deef32aa1fe2f146c48d2508cc03125f06f..77bcb239d352adaf7eb0bc503a79be75c39cdf37 100644 (file)
@@ -1,4 +1,4 @@
-#!/usr/bin/perl -wT
+#!/usr/bin/perl -w
 
 ################################################################################
 #                                                                              #
 #                                                                              #
 ################################################################################
 
+#unknown_error
+#not_saved
+#no_option
+#occupied
+#master_lock
+#no_reply
+#dupe
+#missing_key
+#unexpected_key
+#unknown_encoding
+#unknown_followup
+#too_long
+#too_short
+#wrong_mail
+#wrong_http_url
+#wrong_url
+
 use strict;
 use vars qw($Bin $Shared $Script);
 
 # locate the script
+#
 BEGIN {
   my $null = $0; $null =~ s/\\/\//g; # for win :-(
   ($Bin)    = ($null =~ /^(.*)\/.*$/)? $1 : '.';
@@ -26,16 +44,11 @@ BEGIN {
 use lib "$Shared";
 use CGI::Carp qw(fatalsToBrowser);
 
-#use Conf;
-#use Encode::Plain; $Encode::Plain::utf8 = 1; # generally convert from UTF-8
-#use Id;
-#use Posting::Write;
-#use Template;
-#use Template::Posting;
-
-#use autouse 'Encode::Posting' => qw();
+use Conf;
+use Conf::Admin;
 
 # load script configuration and admin default conf.
+#
 my $conf         = read_script_conf ($Bin, $Shared, $Script);
 my $adminDefault = read_admin_conf ($conf -> {files} -> {adminDefault});
 
@@ -63,15 +76,23 @@ $request -> response;
 ### Posting::Request ###########################################################
 package Posting::Request;
 
+use CheckRFC;
+use Encode::Plain; $Encode::Plain::utf8 = 1; # generally convert from UTF-8
+use Encode::Posting;
 use Lock          qw(:ALL);
 use Posting::_lib qw(
-      hr_time
-      parse_xml_file
-      get_all_threads get_message_node get_message_header
-      KEEP_DELETED
-    );
+  hr_time
+  parse_xml_file
+  get_all_threads
+  get_message_node
+  get_message_header
+  KEEP_DELETED
+);
+use Posting::Write;
+use Id;
+use Template;
+use Template::Posting;
 
-use autouse 'CheckRFC' => qw[ is_email($) is_URL($@) ];
 use CGI;
 
 ### sub new ####################################################################
@@ -94,6 +115,7 @@ sub new {
 
          show_posting    => $sp,
          assign          => $sp -> {assign},
+         template        => $conf -> {template},
          form_must       => $sp -> {form} -> {must},
          form_data       => $sp -> {form} -> {data},
          form_action     => $sp -> {form} -> {action},
@@ -108,6 +130,190 @@ sub new {
   bless $self, $class;
 }
 
+### sub response ###############################################################
+#
+# print the response to STDOUT
+#
+# Return: -none-
+#
+sub response {
+  my $self = shift;
+  my $formdata = $self -> {conf} -> {form_data};
+  my $formact  = $self -> {conf} -> {form_action};
+  my $template = $self -> {template};
+  my $assign   = $self -> {conf} -> {assign};
+  my $q        = $self -> {cgi_object};
+
+  # fill out the form field names
+  #
+  my $pars = {};
+  for (keys %$formdata) {
+    $pars -> {$formdata -> {$_} -> {assign} -> {name}} = plain($formdata -> {$_} -> {name}) if (
+      exists($formdata -> {$_} -> {name})
+      and exists ($formdata -> {$_} -> {assign})
+      and exists ($formdata -> {$_} -> {assign} -> {name})
+    );
+  }
+
+  # response the 'new message' page
+  #
+  if ($self -> {response} -> {new_thread}) {
+    my $list = [map {{$assign -> {optval} => plain($_)}} @{$formdata -> {posterCategory} -> {values}}];
+
+    print $q -> header (-type => 'text/html');
+    print ${$template -> scrap (
+      $assign -> {docNew},
+      { $formdata->{uniqueID}      ->{assign}->{value} => plain(unique_id),
+        $formdata->{quoteChar}     ->{assign}->{value} =>
+          '&#255;'.plain($self -> {conf} -> {admin} -> {View} -> {quoteChars}),
+        $formdata->{posterCategory}->{assign}->{value} => $template->list ($assign -> {option}, $list),
+        $formact->{post}->{assign}                     => $formact->{post}->{url}
+      },
+      $pars
+    )};
+    return;
+  }
+
+  # check the response -> doc
+  #
+  unless ($self -> {response} -> {doc}) {
+    $self -> {error} = {
+      spec => 'unknown_error',
+      type => 'fatal'
+    };
+
+    $self -> handle_error;
+
+    unless ($self -> {response} -> {doc}) {
+      $self -> jerk ('While producing the HTML response an unknown error has occurred.');
+      return;
+    }
+  }
+
+  # ok, print the response document to STDOUT
+  #
+  print $q -> header (-type => 'text/html');
+  print ${$template -> scrap (
+      $self -> {response} -> {doc},
+      $pars,
+      $self -> {response} -> {pars}
+    )
+  };
+
+  return;
+}
+
+### sub handle_error ###########################################################
+#
+# analyze error data and create content for the response method
+#
+# Return: true  if error detected
+#         false otherwise
+#
+sub handle_error {
+  my $self = shift;
+
+  my $spec = $self -> {error} -> {spec};
+
+  return unless ($spec);
+
+  my $assign   = $self -> {conf} -> {assign};
+  my $formdata = $self -> {conf} -> {form_data};
+
+  my $desc = $self -> {error} -> {desc} || '';
+  my $type = $self -> {error} -> {type};
+  my $emsg;
+
+  if (exists ($formdata -> {$desc})
+      and exists ($formdata -> {$desc} -> {assign} -> {$spec})) {
+    $emsg = $formdata -> {$desc} -> {assign} -> {$spec};
+  }
+  else {
+    $emsg = $assign -> {$spec} || '';
+  }
+
+  # fatal errors
+  #
+  if ($type eq 'fatal') {
+    $self -> {response} -> {doc}  = $assign -> {docFatal};
+    $self -> {response} -> {pars} = {
+      $assign -> {errorMessage} => $self -> {template} -> insert ($emsg)
+    };
+  }
+
+  # 'soft' errors
+  # user is able to repair his request
+  #
+  elsif ($type eq 'repeat' or $type eq 'fetch') {
+    $self -> {response} -> {doc} = $assign -> {docError};
+    $self -> fillout_form;
+    $self -> {response} -> {pars} -> {$assign -> {errorMessage}} = $self -> {template} -> insert ($emsg);
+    my $num = $spec eq 'too_long'
+      ? $formdata -> {$desc} -> {maxlength}
+      : ($spec eq 'too_short'
+          ? $formdata -> {$desc} -> {minlength}
+          : undef
+        );
+
+    $self -> {response} -> {pars} -> {$assign -> {charNum}} = $num
+      if $num;
+  }
+
+  1;
+}
+
+### sub fillout_form ###########################################################
+#
+# fill out the form using available form data
+#
+# Return: -none-
+#
+sub fillout_form {
+  my $self = shift;
+
+  my $assign   = $self -> {conf} -> {assign};
+  my $formdata = $self -> {conf} -> {form_data};
+  my $formact  = $self -> {conf} -> {form_action};
+  my $q        = $self -> {cgi_object};
+  my $pars     = {};
+
+  # fill out the form
+  #
+  $pars -> {$formact -> {post} -> {assign}} = $formact -> {post} -> {url};
+
+  for (keys %$formdata) {
+    if ($_ eq 'quoteChar') {
+      $pars -> {$formdata->{$_}->{assign}->{value}}
+      = '&#255;'.plain($q -> param ($formdata -> {quoteChar} -> {name}) or '');
+    }
+    elsif (exists ($formdata -> {$_} -> {name})) {
+      unless (exists ($formdata -> {$_} -> {values})) {
+        $pars -> {$formdata -> {$_} -> {assign} -> {value}}
+        = plain($q -> param ($formdata -> {$_} -> {name}));
+      }
+      else {
+        my $_name = $_;
+        $pars -> {$formdata -> {$_} -> {assign} -> {value}}
+        = $self -> {template} -> list (
+            $assign -> {option},
+            [ map {
+                { $assign -> {optval} => plain($_),
+                  (( $_ eq $q -> param ($formdata -> {$_name} -> {name}))
+                    ? ($assign -> {optsel} => 1)
+                    : ()
+                  )
+                }
+              } @{$formdata -> {$_name} -> {values}}
+            ]
+          );
+      }
+    }
+  }
+
+  $self -> {response} -> {pars} = $pars;
+  return;
+}
+
 ### sub save ###################################################################
 #
 # save posting
@@ -122,6 +328,8 @@ sub save {
   #
   return if ($self -> {response} -> {new_thread});
 
+  $self -> {check_success} = 0;
+
   # lock and load the forum main file
   #
   if ($self -> load_main_file) {
@@ -131,34 +339,88 @@ sub save {
     #
     if ($self -> check_reply_dupe) {
 
-      # we've got an opening
-      #
-      if ($self -> {response} -> {new}) {
-        $self -> save_new;
-      }
-
-      # we've got a reply
-      #
-      elsif ($self -> {response} -> {reply}) {
-        $self -> save_reply;
-      }
-
-      # don't know, if we any time come to this branch
-      # the script is probably broken
-      #
-      else {
+      unless ($self -> {response} -> {reply} or $self -> {response} -> {new}) {
+        # don't know, if we any time come to this branch
+        # the script is probably broken
+        #
         $self -> {error} = {
           spec => 'unknown_error',
           type => 'fatal'
         };
       }
+      else {
+        my $time     = time;
+        my $formdata = $self -> {conf} -> {form_data};
+        my $q        = $self -> {cgi_object};
+        my $f        = $self -> {forum};
+        my $pars     = {
+          author        => $q -> param ($formdata -> {posterName} -> {name}),
+          email         => $q -> param ($formdata -> {posterEmail} -> {name}),
+          category      => $q -> param ($formdata -> {posterCategory} -> {name}),
+          subject       => $q -> param ($formdata -> {posterSubject} -> {name}),
+          body          => $q -> param ($formdata -> {posterBody} -> {name}),
+          homepage      => $q -> param ($formdata -> {posterURL} -> {name}),
+          image         => $q -> param ($formdata -> {posterImage} -> {name}),
+          quoteChars    => $q -> param ($formdata -> {quoteChar} -> {name}),
+          uniqueID      => $q -> param ($formdata -> {uniqueID} -> {name}),
+          time          => $time,
+          ip            => $q -> remote_addr,
+          forumFile     => $self -> {conf} -> {forum_file_name},
+          messagePath   => $self -> {conf} -> {message_path},
+          lastThread    => $f -> {last_thread},
+          lastMessage   => $f -> {last_message},
+          parsedThreads => $f -> {threads},
+          dtd           => $f -> {dtd},
+          messages      => $self -> {template} -> {messages}
+        };
+
+        if ($self -> {response} -> {reply}) {
+          $pars -> {parentMessage} = $self -> {fup_mid};
+          $pars -> {thread}        = $self -> {fup_tid};
+        }
+
+        my ($stat, $xml, $mid) = write_posting ($pars);
+
+        if ($stat) {
+          $self -> {error} = {
+            spec => 'not_saved',
+            desc => $stat,
+            type => 'fatal'
+          };
+        }
+        else {
+          $self -> {check_success} = 1;
+          my $thx      = $self -> {conf} -> {show_posting} -> {thanx};
+
+          # define special response data
+          #
+          $self -> {response} -> {doc}  = $self -> {conf} -> {assign} -> {docThx};
+          $self -> {response} -> {pars} = {
+            $thx -> {subject}  => plain ($q -> param ($formdata -> {posterSubject} -> {name})),
+            $thx -> {author}   => plain ($q -> param ($formdata -> {posterName} -> {name})),
+            $thx -> {email}    => plain ($q -> param ($formdata -> {posterEmail} -> {name})),
+            $thx -> {time}     => plain (hr_time($time)),
+            $thx -> {body}     => message_as_HTML (
+              $xml,
+              $self -> {template},
+              { posting    => $mid,
+                assign     => $self -> {conf} -> {assign},
+                quoteChars => $q -> param ($formdata -> {quoteChar} -> {name}),
+                quoting    => $self -> {conf} -> {admin} -> {View} -> {quoting}
+              }),
+            $thx -> {category} => plain ($q -> param ($formdata -> {posterCategory} -> {name})),
+            $thx -> {home}     => plain ($q -> param ($formdata -> {posterURL} -> {name})),
+            $thx -> {image}    => plain ($q -> param ($formdata -> {posterImage} -> {name}))
+          };
+        }
+      }
     }
   }
 
   # unlock forum main file
   #
   if ($self -> {forum} -> {flocked}) {
-    violent_unlock_file($self -> {forum_file_name}) unless unlock_file ($self -> {forum_file_name});
+    violent_unlock_file($self -> {conf} -> {forum_file_name}) unless write_unlock_file ($self -> {conf} -> {forum_file_name});
     $self -> {forum} -> {flocked} = 0;
   }
 
@@ -179,8 +441,7 @@ sub parse_cgi {
 
   # create the CGI object
   #
-  my $q = new CGI;
-  $self -> {cgi_object} = $q;
+  $self -> {cgi_object} = new CGI;
 
   # check the params
   #
@@ -199,14 +460,14 @@ sub load_main_file {
   my $self = shift;
   my $lock_stat;
 
-  unless ($lock_stat = write_lock_file ($self ->{forum_file_name})) {
-    if ($lock_stat == 0) {
+  unless ($lock_stat = write_lock_file ($self -> {conf} -> {forum_file_name})) {
+    if (defined $lock_stat and $lock_stat == 0) {
       # occupied or no w-bit set for the directory..., hmmm
       #
-      violent_unlock_file ($self -> {forum_file_name});
+      violent_unlock_file ($self -> {conf} -> {forum_file_name});
       $self -> {error} = {
         spec => 'occupied',
-        type => 'fatal'
+        type => 'repeat'
       };
       return;
     }
@@ -225,9 +486,9 @@ sub load_main_file {
     ( $self -> {forum} -> {threads},
       $self -> {forum} -> {last_thread},
       $self -> {forum} -> {last_message},
-      undef,
+      $self -> {forum} -> {dtd},
       $self -> {forum} -> {unids}
-    ) = get_all_threads ($self -> {forum_file_name}, KEEP_DELETED);
+    ) = get_all_threads ($self -> {conf} -> {forum_file_name}, KEEP_DELETED);
   }
 
   # ok, looks good
@@ -246,19 +507,19 @@ sub load_main_file {
 #
 sub check_reply_dupe {
   my $self = shift;
+  my %unids;
 
   # return true unless it's not a reply
+  # or an opening
   #
   return 1 unless (
     $self -> {response} -> {reply}
-    and $self -> {response} -> {new}
+    or $self -> {response} -> {new}
   );
 
-  my %unids;
-
   if ($self -> {response} -> {reply}) {
 
-    my ($threads, $ftid, $fmid, $i, %msg, %unids) = (
+    my ($threads, $ftid, $fmid, $i, %msg) = (
           $self -> {forum} -> {threads},
           $self -> {fup_tid},
           $self -> {fup_mid}
@@ -307,7 +568,7 @@ sub check_reply_dupe {
     # build a unique id lookup hash, too
     # but use only the level-zero-messages
     #
-    %unids = map {$_ => 1} @{$self -> {unids}};
+    %unids = map {$_ => 1} @{$self -> {forum} -> {unids}};
   }
 
   # now check on dupe
@@ -370,7 +631,11 @@ sub check_cgi {
 
   # 1
   #
-  my %name = map {($formdata -> {$_} -> {name} => $_)} keys %$formdata;
+  my %name = map {
+    exists($formdata -> {$_} -> {name})
+    ? ($formdata -> {$_} -> {name} => $_)
+    : ()
+  } keys %$formdata;
 
   # 2
   #
@@ -388,11 +653,12 @@ sub check_cgi {
       # only miss the key unless we're able to fetch it from parent posting
       #
       unless (
-           $self -> {response} -> {new}
-        or $formdata -> {$name {$_}} -> {errorType} eq 'fetch') {
+        not $self -> {response} -> {reply}
+        or $formdata -> {$_} -> {errorType} eq 'fetch') {
 
         $self -> {error} = {
           spec => 'missing_key',
+          desc => $_,
           type => 'fatal'
         };
         return;
@@ -400,14 +666,17 @@ sub check_cgi {
       else {
         # keep in mind to fetch the value later
         #
-        push @{$self -> {fetch}} => $name {$_};
+        push @{$self -> {fetch}} => $_;
       }
     }
   }
 
+  # I'm lazy - I know...
+  my $q = $self -> {cgi_object};
+
   # 3
   #
-  for ($self -> {cgi_object} -> param) {
+  for ($q -> param) {
     unless (exists ($name {$_})) {
       $self -> {error} = {
         spec => 'unexpected_key',
@@ -428,9 +697,6 @@ sub check_cgi {
     return;
   };
 
-  # I'm lazy - I know...
-  my $q = $self -> {cgi_object};
-
   if ($self -> {response} -> {reply}) {
 
     # get the parent-identifiers if we got a reply request
@@ -451,7 +717,7 @@ sub check_cgi {
     # if it fails, they're too short, too... ;)
     #
     $self -> fetch;
-    $got_keys{$_}=1 for (@{$self -> {fetch}});
+    $got_keys{$formdata -> {$_} -> {name}} = 1 for (@{$self -> {fetch}});
   }
 
   # now we can check on length, type etc.
@@ -479,7 +745,7 @@ sub check_cgi {
         desc => $name{$_},
         type => $formdata -> {$name {$_}} -> {errorType}
       };
-      return;
+      $self -> kill_param or return;
     }
 
     # too short?
@@ -497,12 +763,12 @@ sub check_cgi {
           desc => $name{$_},
           type => $formdata -> {$name {$_}} -> {errorType}
         };
-        return;
+        $self -> kill_param or return;
       }
     }
 
     # check the values on expected kinds of content
-    # (email, http-url, url)
+    # (email, http-url, url, option)
     #
     if (exists ($formdata -> {$name {$_}} -> {type}) and length $val) {
       if ($formdata -> {$name {$_}} -> {type} eq 'email' and not is_email $val) {
@@ -511,7 +777,7 @@ sub check_cgi {
           desc => $name{$_},
           type => $formdata -> {$name {$_}} -> {errorType}
         };
-        return;
+        $self -> kill_param or return;
       }
 
       elsif ($formdata -> {$name {$_}} -> {type} eq 'http-url' and not is_URL $val => 'http') {
@@ -520,7 +786,7 @@ sub check_cgi {
           desc => $name{$_},
           type => $formdata -> {$name {$_}} -> {errorType}
         };
-        return;
+        $self -> kill_param or return;
       }
 
       elsif ($formdata -> {$name {$_}} -> {type} eq 'url' and not is_URL $val => ':ALL') {
@@ -529,14 +795,42 @@ sub check_cgi {
           desc => $name{$_},
           type => $formdata -> {$name {$_}} -> {errorType}
         };
-        return;
+        $self -> kill_param or return;
       }
     }
+
+    if (exists ($formdata -> {$name {$_}} -> {values})
+        and not exists ({map {$_ => undef} @{$formdata -> {$name {$_}} -> {values}}} -> {$val})) {
+        $self -> {error} = {
+          spec => 'no_option',
+          desc => $name{$_},
+          type => $formdata -> {$name {$_}} -> {errorType}
+        };
+        $self -> kill_param or return;
+    }
   }
 
   # ok, looks good.
   1;
 }
+### sub kill_param #############################################################
+#
+# kill the param (set it on '') if wrong and declared as 'kill' in config file
+#
+# Return: true  if killed
+#         false otherwise
+#
+sub kill_param {
+  my $self = shift;
+
+  if ($self -> {conf} -> {form_data} -> {$self -> {error} -> {desc}} -> {errorType} eq 'kill') {
+    $self -> {cgi_object} -> param ($self -> {conf} -> {form_data} -> {$self -> {error} -> {desc}} -> {name} => '');
+    $self -> {error} = {};
+    return 1;
+  }
+
+  return;
+}
 
 ### sub fetch ##################################################################
 #
@@ -605,12 +899,28 @@ sub decode_param {
   }
 
   # remove the &#255; (encoded as UTF-8) from quotechars
-  $q -> param ($formdata -> {quoteChar} -> {name} => substr ($code, 2));
+  $q -> param ($formdata -> {quoteChar} -> {name}
+        => substr $q -> param ($formdata -> {quoteChar} -> {name}),2);
 
   # ok, params now should be UTF-8 encoded
   1;
 }
 
+sub jerk {
+  my $text = $_[1] || 'An error has occurred.';
+  print <<EOF;
+Content-type: text/plain\n\n
+
+ Oops.
+
+ $text
+ We will fix it as soon as possible. Thank you for your patience.
+
+ Regards
+    n.d.p.
+EOF
+}
+
 #
 #
 ### end of fo_posting.pl #######################################################
\ No newline at end of file
index 8da8f6d938b9142d2c0ab9d9bcc96e7ce2670f72..766fc10a3d78cf65b6393c99f4ef681c4d3b1a9c 100644 (file)
@@ -1,10 +1,10 @@
-#!/usr/bin/perl -wT
+#!/usr/bin/perl -w
 
 ################################################################################
 #                                                                              #
 # File:        user/fo_view.pl                                                 #
 #                                                                              #
-# Authors:     AndrĂ© Malo <nd@o3media.de>, 2001-03-31                          #
+# Authors:     AndrĂ© Malo <nd@o3media.de>, 2001-04-01                          #
 #                                                                              #
 # Description: display the forum main file or a single posting                 #
 #                                                                              #
@@ -25,8 +25,8 @@ use CGI::Carp qw(fatalsToBrowser);
 
 use Conf;
 use Conf::Admin;
-use autouse 'Template::Forum'   => qw(print_forum_as_HTML($$$));
-use autouse 'Template::Posting' => qw(print_posting_as_HTML($$$));
+use Template::Forum;
+use Template::Posting;
 
 use CGI qw(param header);
 
@@ -76,4 +76,4 @@ else {
 
 #
 #
-### end of fo_view.pl ##########################################################
+### end of fo_view.pl ##########################################################
\ No newline at end of file

patrick-canterino.de