several style changes

[selfforum.git] / selfforum-cgi / user / fo_posting.pl

diff --git a/selfforum-cgi/user/fo_posting.pl b/selfforum-cgi/user/fo_posting.pl
index 8c9f8da8f97f5aa35bab956a76e50707871a6fed..41099deef32aa1fe2f146c48d2508cc03125f06f 100644 (file)
--- a/selfforum-cgi/user/fo_posting.pl
+++ b/selfforum-cgi/user/fo_posting.pl
@@ -24,40 +24,59 @@ BEGIN {
 }
 
 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 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 CGI::Carp qw(fatalsToBrowser);

 
 

-use CGI;
-use XML::DOM;
+#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();

 
 # load script configuration and admin default conf.
 my $conf         = read_script_conf ($Bin, $Shared, $Script);
 my $adminDefault = read_admin_conf ($conf -> {files} -> {adminDefault});
 
 
 # load script configuration and admin default conf.
 my $conf         = read_script_conf ($Bin, $Shared, $Script);
 my $adminDefault = read_admin_conf ($conf -> {files} -> {adminDefault});
 

-# Initializing the request
-my $response = new Posting::Response ($conf, $adminDefault);
+# Initialize the request
+#
+my $request = new Posting::Request ($conf, $adminDefault);

 
 # fetch and parse the cgi-params
 
 # fetch and parse the cgi-params

-$response -> parse_cgi;
+#
+$request -> parse_cgi;
+
+# handle errors or save the posting
+#
+$request -> handle_error or $request -> save;
+
+# show response
+#
+$request -> response;

 
 

+#
+#
+### main end ###################################################################

 
 ################################################################################
 
 ################################################################################

-### Posting::Response ##########################################################
-package Posting::Response;
+### Posting::Request ###########################################################
+package Posting::Request;
+
+use Lock          qw(:ALL);
+use Posting::_lib qw(
+      hr_time
+      parse_xml_file
+      get_all_threads get_message_node get_message_header
+      KEEP_DELETED
+    );
+
+use autouse 'CheckRFC' => qw[ is_email($) is_URL($@) ];
+use CGI;

 
 ### sub new ####################################################################
 #
 
 ### sub new ####################################################################
 #

-# initialising the Posting::Response object
+# initialising the Posting::Request object

 # check parameters and fill in object properties
 #
 sub new {
 # check parameters and fill in object properties
 #
 sub new {


@@ -80,29 +99,231 @@ sub new {
          form_action     => $sp -> {form} -> {action},
        },
 
          form_action     => $sp -> {form} -> {action},
        },
 

-       template => new Template $sp -> {templateFile}
+       template => new Template $sp -> {templateFile},
+       response => {},
+       forum    => {},
+       error    => {}

      };
 
   bless $self, $class;
 }
 
      };
 
   bless $self, $class;
 }
 

+### sub save ###################################################################
+#
+# save posting
+# check on legal reply or dupe is released here
+#
+# Return: -none-
+#
+sub save {
+  my $self = shift;
+
+  # if an empty 'new message' document, there's nothing to save
+  #
+  return if ($self -> {response} -> {new_thread});
+
+  # lock and load the forum main file
+  #
+  if ($self -> load_main_file) {
+
+    # if a reply - is it legal?
+    # is it a dupe?
+    #
+    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 {
+        $self -> {error} = {
+          spec => 'unknown_error',
+          type => 'fatal'
+        };
+      }
+    }
+  }
+
+  # unlock forum main file
+  #
+  if ($self -> {forum} -> {flocked}) {
+    violent_unlock_file($self -> {forum_file_name}) unless unlock_file ($self -> {forum_file_name});
+    $self -> {forum} -> {flocked} = 0;
+  }
+
+  $self -> handle_error unless $self -> {check_success};
+
+  return;
+}
+

 ### sub parse_cgi ##############################################################
 #
 # fetch and decode cgi-parameters,
 # find out the kind of response requested by the user (new message, reply)
 #
 ### sub parse_cgi ##############################################################
 #
 # fetch and decode cgi-parameters,
 # find out the kind of response requested by the user (new message, reply)
 #

-# Return: Status Code (Bool)
-#         try out the error method, if false
+# Return: -none-

 #
 sub parse_cgi {
   my $self = shift;
 
   # create the CGI object
 #
 sub parse_cgi {
   my $self = shift;
 
   # create the CGI object

+  #

   my $q = new CGI;
   $self -> {cgi_object} = $q;
 
   # check the params
   my $q = new CGI;
   $self -> {cgi_object} = $q;
 
   # check the params

-  return unless $self -> check_cgi;
+  #
+  $self -> {check_success} = $self -> check_cgi;
+
+  return;
+}
+
+### sub load_main_file #########################################################
+#
+# load and parse the forum main file
+#
+# Return: Success (true/false)
+#
+sub load_main_file {
+  my $self = shift;
+  my $lock_stat;
+
+  unless ($lock_stat = write_lock_file ($self ->{forum_file_name})) {
+    if ($lock_stat == 0) {
+      # occupied or no w-bit set for the directory..., hmmm
+      #
+      violent_unlock_file ($self -> {forum_file_name});
+      $self -> {error} = {
+        spec => 'occupied',
+        type => 'fatal'
+      };
+      return;
+    }
+    else {
+      # master lock is set
+      #
+      $self -> {error} = {
+        spec => 'master_lock',
+        type => 'fatal'
+      };
+      return;
+    }
+  }
+  else {
+    $self -> {forum} -> {flocked} = 1;
+    ( $self -> {forum} -> {threads},
+      $self -> {forum} -> {last_thread},
+      $self -> {forum} -> {last_message},
+      undef,
+      $self -> {forum} -> {unids}
+    ) = get_all_threads ($self -> {forum_file_name}, KEEP_DELETED);
+  }
+
+  # ok, looks good
+  1;
+}
+
+### sub check_reply_dupe #######################################################
+#
+# check whether a reply is legal
+# (followup posting must exists)
+#
+# check whether this form request is a dupe
+# (unique id already exists)
+#
+# Return: Status Code (Bool)
+#
+sub check_reply_dupe {
+  my $self = shift;
+
+  # return true unless it's not a reply
+  #
+  return 1 unless (
+    $self -> {response} -> {reply}
+    and $self -> {response} -> {new}
+  );
+
+  my %unids;
+
+  if ($self -> {response} -> {reply}) {
+
+    my ($threads, $ftid, $fmid, $i, %msg, %unids) = (
+          $self -> {forum} -> {threads},
+          $self -> {fup_tid},
+          $self -> {fup_mid}
+       );
+
+    # thread doesn't exist
+    #
+    unless (exists($threads -> {$ftid})) {
+      $self -> {error} = {
+        spec => 'no_reply',
+        type => 'fatal'
+      };
+      return;
+    }
+
+    # build a reverse lookup hash (mid => number in array)
+    # and ignore invisible messages
+    # (users can't reply to "deleted" msg)
+    #
+    for ($i=0; $i < @{$threads -> {$ftid}}; $i++) {
+
+      if ($threads -> {$ftid} -> [$i] -> {deleted}) {
+        $i+=$threads -> {$ftid} -> [$i] -> {answers};
+      }
+      else {
+        $msg{$threads -> {$ftid} -> [$i] -> {mid}}=$i;
+      }
+    }
+
+    # message doesn't exist
+    #
+    unless (exists($msg{$fmid})) {
+      $self -> {error} = {
+        spec => 'no_reply',
+        type => 'fatal'
+      };
+      return;
+    }
+
+    # build a unique id lookup hash
+    # use the unids of parent message's kids
+    #
+    %unids = map {$_ => 1} @{$threads -> {$ftid} -> [$msg{$fmid}] -> {unids}};
+  }
+  else {
+    # build a unique id lookup hash, too
+    # but use only the level-zero-messages
+    #
+    %unids = map {$_ => 1} @{$self -> {unids}};
+  }
+
+  # now check on dupe
+  #
+  if (exists ($unids{
+                $self -> {cgi_object} -> param (
+                  $self -> {conf} -> {form_data} -> {uniqueID} -> {name})})) {
+    $self -> {error} = {
+      spec => 'dupe',
+      type => 'fatal'
+    };
+    return;
+  }
+
+  # ok, looks fine
+  1;

 }
 
 ### sub check_cgi ##############################################################
 }
 
 ### sub check_cgi ##############################################################


@@ -110,28 +331,28 @@ sub parse_cgi {
 # cgi params are like raw eggs...
 #
 # Return: Status Code (Bool)
 # cgi params are like raw eggs...
 #
 # Return: Status Code (Bool)

-#         creates content for the error method if anything fails
+#         creates content for the handle_error method if anything fails

 #
 sub check_cgi {
   my $self = shift;
 
 #
 sub check_cgi {
   my $self = shift;
 

-  # find out the count of the submitted keys and the keys themselves
+  # count the submitted keys and get the keys themselves

   #
   my %got_keys     = map {($_ => 1)} $self -> {cgi_object} -> param;
   my $cnt_got_keys = keys %got_keys;
   #
   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};
+  my $formdata     = $self -> {conf} -> {form_data};
+  my $formmust     = $self -> {conf} -> {form_must};

 
   # user requested the 'new thread' page
 
   # user requested the 'new thread' page

-  # (no params or only the user-ID has been submitted)
+  # (no params but perhaps the user-ID have been submitted)

   #
   if ($cnt_got_keys == 0 or (
         exists ($formdata -> {userID})
         and $cnt_got_keys == 1
         and $got_keys{$formdata -> {userID} -> {name}}
   #
   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};
+        )) {
+    $self -> {response} -> {new_thread} = 1;
+    $self -> {check_success} = 1;

     return 1;
   }
 
     return 1;
   }
 


@@ -170,7 +391,10 @@ sub check_cgi {
            $self -> {response} -> {new}
         or $formdata -> {$name {$_}} -> {errorType} eq 'fetch') {
 
            $self -> {response} -> {new}
         or $formdata -> {$name {$_}} -> {errorType} eq 'fetch') {
 

-        $self -> {error} = {spec => 'missing_key'};
+        $self -> {error} = {
+          spec => 'missing_key',
+          type => 'fatal'
+        };

         return;
       }
       else {
         return;
       }
       else {


@@ -187,7 +411,8 @@ sub check_cgi {
     unless (exists ($name {$_})) {
       $self -> {error} = {
         spec => 'unexpected_key',
     unless (exists ($name {$_})) {
       $self -> {error} = {
         spec => 'unexpected_key',

-        desc => $name{$_}
+        desc => $name{$_},
+        type => 'fatal'

       };
       return;
     }
       };
       return;
     }


@@ -196,7 +421,10 @@ sub check_cgi {
   # 4
   #
   unless ($self -> decode_param) {
   # 4
   #
   unless ($self -> decode_param) {

-    $self -> {error} = {spec => 'unknown_encoding'};
+    $self -> {error} = {
+      spec => 'unknown_encoding',
+      type => 'fatal'
+    };

     return;
   };
 
     return;
   };
 


@@ -205,12 +433,15 @@ sub check_cgi {
 
   if ($self -> {response} -> {reply}) {
 
 
   if ($self -> {response} -> {reply}) {
 

-    # get the parent-identifiers if we got a reply
+    # get the parent-identifiers if we got a reply request

     #
     my ($ftid, $fmid) = split /;/ => $q -> param ($formdata -> {followUp} -> {name}) => 2;
 
     unless ($ftid =~ /\d+/ and $fmid =~ /\d+/) {
     #
     my ($ftid, $fmid) = split /;/ => $q -> param ($formdata -> {followUp} -> {name}) => 2;
 
     unless ($ftid =~ /\d+/ and $fmid =~ /\d+/) {

-      $self -> {error} = {spec => 'unknown_followup'};
+      $self -> {error} = {
+        spec => 'unknown_followup',
+        type => 'fatal'
+      };

       return;
     }
     $self -> {fup_tid} = $ftid;
       return;
     }
     $self -> {fup_tid} = $ftid;


@@ -227,6 +458,8 @@ sub check_cgi {
   #
   for (keys %got_keys) {
 
   #
   for (keys %got_keys) {
 

+    # we are sure, we've got only one value for one key
+    #

     my $val = $q -> param ($_);
 
     $val =~ s/\302\240/ /g;           # convert nbsp (UTF-8 encoded) into normal spaces
     my $val = $q -> param ($_);
 
     $val =~ s/\302\240/ /g;           # convert nbsp (UTF-8 encoded) into normal spaces


@@ -243,7 +476,8 @@ sub check_cgi {
     if (length $val > $formdata -> {$name {$_}} -> {maxlength}) {
       $self -> {error} = {
         spec => 'too_long',
     if (length $val > $formdata -> {$name {$_}} -> {maxlength}) {
       $self -> {error} = {
         spec => 'too_long',

-        desc => $name{$_}
+        desc => $name{$_},
+        type => $formdata -> {$name {$_}} -> {errorType}

       };
       return;
     }
       };
       return;
     }


@@ -260,7 +494,8 @@ sub check_cgi {
       if (length $val_ww < $formdata -> {$name {$_}} -> {minlength}) {
         $self -> {error} = {
           spec => 'too_short',
       if (length $val_ww < $formdata -> {$name {$_}} -> {minlength}) {
         $self -> {error} = {
           spec => 'too_short',

-          desc => $name{$_}
+          desc => $name{$_},
+          type => $formdata -> {$name {$_}} -> {errorType}

         };
         return;
       }
         };
         return;
       }


@@ -273,7 +508,8 @@ sub check_cgi {
       if ($formdata -> {$name {$_}} -> {type} eq 'email' and not is_email $val) {
         $self -> {error} = {
           spec => 'wrong_mail',
       if ($formdata -> {$name {$_}} -> {type} eq 'email' and not is_email $val) {
         $self -> {error} = {
           spec => 'wrong_mail',

-          desc => $name{$_}
+          desc => $name{$_},
+          type => $formdata -> {$name {$_}} -> {errorType}

         };
         return;
       }
         };
         return;
       }


@@ -281,7 +517,8 @@ sub check_cgi {
       elsif ($formdata -> {$name {$_}} -> {type} eq 'http-url' and not is_URL $val => 'http') {
         $self -> {error} = {
           spec => 'wrong_http_url',
       elsif ($formdata -> {$name {$_}} -> {type} eq 'http-url' and not is_URL $val => 'http') {
         $self -> {error} = {
           spec => 'wrong_http_url',

-          desc => $name{$_}
+          desc => $name{$_},
+          type => $formdata -> {$name {$_}} -> {errorType}

         };
         return;
       }
         };
         return;
       }


@@ -289,7 +526,8 @@ sub check_cgi {
       elsif ($formdata -> {$name {$_}} -> {type} eq 'url' and not is_URL $val => ':ALL') {
         $self -> {error} = {
           spec => 'wrong_url',
       elsif ($formdata -> {$name {$_}} -> {type} eq 'url' and not is_URL $val => ':ALL') {
         $self -> {error} = {
           spec => 'wrong_url',

-          desc => $name{$_}
+          desc => $name{$_},
+          type => $formdata -> {$name {$_}} -> {errorType}

         };
         return;
       }
         };
         return;
       }


@@ -323,6 +561,8 @@ sub fetch {
 
           $q -> param ($formdata -> {$_} -> {name} => $header -> {$formdata -> {$_} -> {header}})
             for (@{$self -> {fetch}});
 
           $q -> param ($formdata -> {$_} -> {name} => $header -> {$formdata -> {$_} -> {header}})
             for (@{$self -> {fetch}});

+
+          return;

         }
       }
     }
         }
       }
     }


@@ -333,6 +573,8 @@ sub fetch {
   #
   $q -> param ($formdata -> {$_} -> {name} => '')
     for (@{$self -> {fetch}});
   #
   $q -> param ($formdata -> {$_} -> {name} => '')
     for (@{$self -> {fetch}});

+
+  return;

 }
 
 ### sub decode_param ###########################################################
 }
 
 ### sub decode_param ###########################################################