style changes in fo_view.pl

fo_posting.pl is not yet ready...

diff --git a/selfforum-cgi/user/fo_posting.pl b/selfforum-cgi/user/fo_posting.pl
index 8c9f8da8f97f5aa35bab956a76e50707871a6fed..472eaab420cced7af0f1a4ce1ff80cf3d55250f2 100644 (file)
--- a/selfforum-cgi/user/fo_posting.pl
+++ b/selfforum-cgi/user/fo_posting.pl
@@ -24,21 +24,16 @@ 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);
 
 # load script configuration and admin default conf.
 my $conf         = read_script_conf ($Bin, $Shared, $Script);


@@ -48,13 +43,50 @@ my $adminDefault = read_admin_conf ($conf -> {files} -> {adminDefault});
 my $response = new Posting::Response ($conf, $adminDefault);
 
 # fetch and parse the cgi-params
 my $response = new Posting::Response ($conf, $adminDefault);
 
 # fetch and parse the cgi-params

+#

 $response -> parse_cgi;
 
 $response -> parse_cgi;
 

+# no further checks after fatal errors
+#
+if ($response -> success or $response -> error_type ne 'fatal') {
+  $response -> success (
+       $response -> check_reply
+    && $response -> check_dupe
+    && $response -> success
+  );
+}
+
+
+# handle errors or save the posting
+#
+$response -> handle_error or $response -> save;
+
+# show response
+#
+$response -> response;
+
+#
+#
+### main end ###################################################################

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

+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 success {$_[0] -> {check_success} = defined $_[1]?$_[1]:$_[0] -> {check_success}}
+sub error_type {$_[0] -> {error} -> {type}}
+

 ### sub new ####################################################################
 #
 # initialising the Posting::Response object
 ### sub new ####################################################################
 #
 # initialising the Posting::Response object


@@ -80,29 +112,169 @@ 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 and $self -> check_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 ############################################################
+#
+# check whether a reply is legal
+# (followup posting must exists)
+#
+# Return: Status Code (Bool)
+#
+sub check_reply {
+  my $self = shift;
+
+  # return true unless it's not a reply
+  #
+  return 1 unless $self -> {response} -> {reply};
+
+
+}
+
+### sub check_dupe #############################################################
+#
+# check whether this form request is a dupe
+# (unique id already exists)
+#
+# Return: Status Code (Bool)
+#
+sub check_dupe {
+  my $self = shift;
+
+  return 1 if ($self -> {response} -> {new_thread});

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


@@ -110,12 +282,12 @@ 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;


@@ -131,7 +303,7 @@ sub check_cgi {
         and $got_keys{$formdata -> {userID} -> {name}}
         )
      ) {
         and $got_keys{$formdata -> {userID} -> {name}}
         )
      ) {

-    $self -> {response} = {new_thread => 1};
+    $self -> {response} -> {new_thread} = 1;

     return 1;
   }
 
     return 1;
   }
 


@@ -170,7 +342,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 +362,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 +372,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 +384,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 +409,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 +427,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 +445,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 +459,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 +468,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 +477,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 +512,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 +524,8 @@ sub fetch {
   #
   $q -> param ($formdata -> {$_} -> {name} => '')
     for (@{$self -> {fetch}});
   #
   $q -> param ($formdata -> {$_} -> {name} => '')
     for (@{$self -> {fetch}});

+
+  return;

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

diff --git a/selfforum-cgi/user/fo_view.pl b/selfforum-cgi/user/fo_view.pl
index fb2ab8c5d5b99a197f0788860b80031d5853b897..8da8f6d938b9142d2c0ab9d9bcc96e7ce2670f72 100644 (file)
--- a/selfforum-cgi/user/fo_view.pl
+++ b/selfforum-cgi/user/fo_view.pl
@@ -1,7 +1,16 @@
-#!/usr/bin/perl
+#!/usr/bin/perl -wT

 
 

-use strict;
+################################################################################
+#                                                                              #
+# File:        user/fo_view.pl                                                 #
+#                                                                              #
+# Authors:     André Malo <nd@o3media.de>, 2001-03-31                          #
+#                                                                              #
+# Description: display the forum main file or a single posting                 #
+#                                                                              #
+################################################################################

 
 

+use strict;

 use vars qw($Bin $Shared $Script);
 
 BEGIN {
 use vars qw($Bin $Shared $Script);
 
 BEGIN {


@@ -35,29 +44,36 @@ my $adminDefault = read_admin_conf ($conf -> {files} -> {adminDefault});
 my $forum_file = $conf -> {files} -> {forum};
 my $message_path = $conf -> {files} -> {messagePath};
 
 my $forum_file = $conf -> {files} -> {forum};
 my $message_path = $conf -> {files} -> {messagePath};
 

-#use Lock qw(:ALL);release_file($forum_file);die;
-

 my ($tid, $mid) = (param ($cgi -> {thread}), param ($cgi -> {posting}));
 
 if (defined ($tid) and defined ($mid)) {
 my ($tid, $mid) = (param ($cgi -> {thread}), param ($cgi -> {posting}));
 
 if (defined ($tid) and defined ($mid)) {

-  print_posting_as_HTML ($message_path,
-                         $show_posting -> {templateFile},
-                        {assign       => $show_posting -> {assign},
-                         thread       => $tid,
-                         posting      => $mid,
-                         adminDefault => $adminDefault,
-                         messages     => $show_posting -> {messages},
-                         form         => $show_posting -> {form},
-                         cgi          => $cgi,
-                         tree         => $tree
-                        });}
+  print_posting_as_HTML (
+    $message_path,
+    $show_posting -> {templateFile},
+    { assign       => $show_posting -> {assign},
+      thread       => $tid,
+      posting      => $mid,
+      adminDefault => $adminDefault,
+      messages     => $show_posting -> {messages},
+      form         => $show_posting -> {form},
+      cgi          => $cgi,
+      tree         => $tree
+    }
+  );
+}

 
 else {
 
 else {

-  print_forum_as_HTML ($forum_file,
-                       $show_forum -> {templateFile},
-                      {assign       => $show_forum -> {assign},
-                       adminDefault => $adminDefault,
-                       cgi          => $cgi,
-                       tree         => $tree
-                      });}
-# eos
\ No newline at end of file
+  print_forum_as_HTML (
+    $forum_file,
+    $show_forum -> {templateFile},
+    { assign       => $show_forum -> {assign},
+      adminDefault => $adminDefault,
+      cgi          => $cgi,
+      tree         => $tree
+    }
+  );
+}
+
+#
+#
+### end of fo_view.pl ##########################################################