fixed some bugs, prepared the 0.98 release

diff --git a/selfforum-cgi/shared/Conf/Admin.pm b/selfforum-cgi/shared/Conf/Admin.pm
index 27a8c936ec7ce45540279e63ee52e5382f054c11..09bb103554fe2b211d11bd388b8f4130974bfe18 100644 (file)
--- a/selfforum-cgi/shared/Conf/Admin.pm
+++ b/selfforum-cgi/shared/Conf/Admin.pm
@@ -70,7 +70,10 @@ sub read_admin_conf ($) {
                       quoteChars    => $char?$char -> getFirstChild -> getData:undef};
 
       my $voting = $forum -> getElementsByTagName ('Voting', 0) -> item (0);
                       quoteChars    => $char?$char -> getFirstChild -> getData:undef};
 
       my $voting = $forum -> getElementsByTagName ('Voting', 0) -> item (0);

-      $conf {Voting} = {voteLock => $voting -> getAttribute ('voteLock')};
+      $conf {Voting} = {
+        voteLock => $voting -> getAttribute ('voteLock'),
+        Limit    => $voting -> getAttribute ('Limit')
+      };

 
       # Severance
       $conf {Severance} = &get_severance ($forum -> getElementsByTagName ('Severance', 0) -> item (0));
 
       # Severance
       $conf {Severance} = &get_severance ($forum -> getElementsByTagName ('Severance', 0) -> item (0));

diff --git a/selfforum-cgi/shared/Lock.pm b/selfforum-cgi/shared/Lock.pm
index 3f01861712c1a2c562af21ac2a83b9288f9967e7..a611ce6b44c5757e2712dcc14939412b01fce0b5 100644 (file)
--- a/selfforum-cgi/shared/Lock.pm
+++ b/selfforum-cgi/shared/Lock.pm
@@ -38,6 +38,7 @@ use base qw(Exporter);
   violent_unlock_file
   set_master_lock
   release_file
   violent_unlock_file
   set_master_lock
   release_file

+  file_removed

 );
 
 %EXPORT_TAGS = (
 );
 
 %EXPORT_TAGS = (


@@ -138,7 +139,7 @@ sub w_unlock_file ($;$) {
 
         # try do decrement the reference counter
         #
 
         # try do decrement the reference counter
         #

-        if (set_ref($filename,-1,$timeout)) {
+        if (set_ref($filename, -1, $timeout)) {

           delete $LOCKED{$filename};
           return 1;
         }
           delete $LOCKED{$filename};
           return 1;
         }


@@ -325,6 +326,15 @@ sub w_release_file ($) {
   1;
 }
 
   1;
 }
 

+sub w_file_removed ($) {
+  my $filename = shift;
+
+  unlink reffile($filename);
+  unlink lockfile($filename);
+  unlink lockfile(reffile($filename));
+  unlink masterlockfile($filename);
+}
+

 ################################################################################
 #
 # *n*x section (symlinks possible)
 ################################################################################
 #
 # *n*x section (symlinks possible)


@@ -584,6 +594,10 @@ sub x_release_file ($) {
   1;
 }
 
   1;
 }
 

+sub x_file_removed ($) {
+  release_file (shift);
+}
+

 ### sub w_simple_lock ($;$) ####################################################
 ### sub w_simple_unlock ($) ####################################################
 #
 ### sub w_simple_lock ($;$) ####################################################
 ### sub w_simple_unlock ($) ####################################################
 #


@@ -600,7 +614,7 @@ sub w_simple_lock ($;$) {
   my $timeout  = shift || $Timeout;
   my $lockfile = lockfile $filename;
 
   my $timeout  = shift || $Timeout;
   my $lockfile = lockfile $filename;
 

-  for (1..$timeout) {
+  for (0..$timeout) {

     unlink $lockfile and return 1;
     sleep(1);
   }
     unlink $lockfile and return 1;
     sleep(1);
   }


@@ -640,7 +654,7 @@ sub x_simple_lock ($;$) {
   my $timeout  = shift || $Timeout;
   my $lockfile = lockfile $filename;
 
   my $timeout  = shift || $Timeout;
   my $lockfile = lockfile $filename;
 

-  for (1..$timeout) {
+  for (0..$timeout) {

     symlink $filename,$lockfile and return 1;
     sleep(1);
   }
     symlink $filename,$lockfile and return 1;
     sleep(1);
   }


@@ -702,7 +716,7 @@ sub w_set_ref ($$$) {
     unlink $reffile                                       or return;
   }
   else {
     unlink $reffile                                       or return;
   }
   else {

-    local $\="\n";
+    local $\;

     sysopen (REF, $reffile, O_WRONLY | O_TRUNC | O_CREAT) or return;
     print REF $old                                        or do {
                                                             close REF;
     sysopen (REF, $reffile, O_WRONLY | O_TRUNC | O_CREAT) or return;
     print REF $old                                        or do {
                                                             close REF;


@@ -761,7 +775,7 @@ sub x_set_ref ($$$) {
     unlink $reffile                                       or return;
   }
   else {
     unlink $reffile                                       or return;
   }
   else {

-    local $\="\n";
+    local $\;

     sysopen (REF, $reffile, O_WRONLY | O_TRUNC | O_CREAT) or return;
     print REF $old                                        or do {
                                                             close REF;
     sysopen (REF, $reffile, O_WRONLY | O_TRUNC | O_CREAT) or return;
     print REF $old                                        or do {
                                                             close REF;


@@ -793,16 +807,14 @@ sub get_ref ($) {
   my $reffile  = reffile $filename;
   my $old;
   local *REF;
   my $reffile  = reffile $filename;
   my $old;
   local *REF;

+  local $/;

 
 

-  if (sysopen (REF, $reffile, O_RDONLY)) {
-    local $/="\n";
-    read REF, $old, -s $reffile;
-    close REF;
-    chomp $old;
-  }
+  sysopen (REF, $reffile, O_RDONLY)    or return 0;
+    $old = <REF>;
+  close REF;

 
   # return value
 
   # return value

-  $old or 0;
+  $old;

 }
 
 ################################################################################
 }
 
 ################################################################################


@@ -831,6 +843,7 @@ BEGIN {
     *violent_unlock_file = \&x_violent_unlock_file;
     *set_master_lock     = \&x_set_master_lock;
     *release_file        = \&x_release_file;
     *violent_unlock_file = \&x_violent_unlock_file;
     *set_master_lock     = \&x_set_master_lock;
     *release_file        = \&x_release_file;

+    *file_removed        = \&x_file_removed;

 
     *simple_lock         = \&x_simple_lock;
     *simple_unlock       = \&x_simple_unlock;
 
     *simple_lock         = \&x_simple_lock;
     *simple_unlock       = \&x_simple_unlock;


@@ -845,6 +858,7 @@ BEGIN {
     *violent_unlock_file = \&w_violent_unlock_file;
     *set_master_lock     = \&w_set_master_lock;
     *release_file        = \&w_release_file;
     *violent_unlock_file = \&w_violent_unlock_file;
     *set_master_lock     = \&w_set_master_lock;
     *release_file        = \&w_release_file;

+    *file_removed        = \&w_file_removed;

 
     *simple_lock         = \&w_simple_lock;
     *simple_unlock       = \&w_simple_unlock;
 
     *simple_lock         = \&w_simple_lock;
     *simple_unlock       = \&w_simple_unlock;

diff --git a/selfforum-cgi/shared/Posting/Cache.pm b/selfforum-cgi/shared/Posting/Cache.pm
index 4e1e8de2aefafe388a57d52f9c8652d9e03a915b..d937b9db0891d28931e3cb37894dc99f4ffcc407 100644 (file)
--- a/selfforum-cgi/shared/Posting/Cache.pm
+++ b/selfforum-cgi/shared/Posting/Cache.pm
@@ -13,6 +13,7 @@ package Posting::Cache;
 use strict;
 
 use Fcntl;
 use strict;
 
 use Fcntl;

+use File::Path;

 use Lock qw(:ALL);
 
 my $O_BINARY = eval "O_BINARY";
 use Lock qw(:ALL);
 
 my $O_BINARY = eval "O_BINARY";


@@ -22,7 +23,7 @@ $O_BINARY = 0 if ($@);
 #
 # Constructor
 #
 #
 # Constructor
 #

-# Params: $filename - full qualified cache file name
+# Params: $pathname - full qualified cache path

 #
 # Return: Posting::Cache object
 #
 #
 # Return: Posting::Cache object
 #


@@ -30,11 +31,7 @@ sub new {
   my $self = bless {} => shift;
 
   $self -> clear_error;
   my $self = bless {} => shift;
 
   $self -> clear_error;

-  $self -> set_file (+shift);
-
-  $self -> repair_cache or do {
-    $self -> set_error ('cache '.$self->cachefile.' is broken and not repairable.')
-  };
+  $self -> set_path (+shift);

 
   $self;
 }
 
   $self;
 }


@@ -64,98 +61,174 @@ sub set_error {
   return;
 }
 
   return;
 }
 

-### sub set_file ###############################################################
+### sub set_path ###############################################################

 #
 # set cache file name
 #
 #
 # set cache file name
 #

-# Params: $filename - full qualified cache file name
+# Params: $pathname - full qualified cache path

 #
 #

-sub set_file {
-  my ($self, $filename) = @_;
+sub set_path {
+  my ($self, $pathname) = @_;

 
 

-  $self -> {cachefile} = $filename;
+  $self -> {cachepath} = $pathname;

 
   return;
 }
 
 
   return;
 }
 

-sub cachefile {$_[0] -> {cachefile}}
-sub indexfile {$_[0] -> cachefile . '.index'}
-sub temp_cachefile {$_[0] -> cachefile . '.temp'}
-sub temp_indexfile {$_[0] -> indexfile . '.temp'}
+sub cachepath   {$_[0] -> {cachepath}}
+sub threaddir   {$_[0] -> cachepath          . $_[1] -> {thread}}
+sub threadpath  {$_[0] -> threaddir  ($_[1]) . '/'}
+sub cachefile   {$_[0] -> threadpath ($_[1]) . $_[1] -> {posting} . '.txt'}
+sub summaryfile {$_[0] -> cachepath          . 'summary.bin'}
+
+### sub delete_threads #########################################################
+#
+# remove threads from cache
+#
+# Params: @threads - list of threadnumbers
+#
+# Return: Status Code (Bool)
+#
+sub delete_threads {
+  my ($self, @threads) = @_;
+  my %threads = map {$_ => 1} @threads;
+
+  $self -> mod_wrap (
+    \&r_delete_threads,
+    \%threads
+  );
+}
+sub r_delete_threads {
+  my ($self, $handle, $threads) = @_;
+  my $l = length (pack 'L' => 0);
+  my $reclen = $l << 2;
+  my $len = -s $handle;
+  my $num = int ($len / $reclen) -1;
+  my ($buf, %hash);
+  local $/;
+  local $\;
+
+  for (0..$num) {
+    seek $handle, $_ * $reclen + $l, 0                 or return;
+    read ($handle, $buf, $l) == $l                     or return;
+    if ($threads->{unpack 'L' => $buf}) {
+      seek $handle, $_ * $reclen + $l, 0               or return;
+      print $handle pack ('L' => 0)                    or return;
+    }
+  }
+
+  rmtree ($self->threaddir({thread => $_}), 0, 0)
+    for (keys %$threads);
+
+  1;
+}
+
+### sub garbage_collection #####################################################
+#
+# remove old entrys from the beginning of the cache
+#
+# Params: ~none~
+#
+# Return: ~none~
+#
+sub garbage_collection {
+  my $self = shift;
+
+  $self -> purge_wrap (
+    \&r_garbage_collection
+  );
+}
+sub r_garbage_collection {
+  my ($self, $handle, $file) = @_;
+
+  my $reclen  = length (pack 'L', 0) << 2;
+  my $len = -s $handle;
+  my $num = int ($len / $reclen) -1;
+  my ($z, $buf, $h) = 0;
+  local $/;
+  local $\;
+
+  seek $handle, 0, 0                                 or return;
+  read ($handle, $buf, $len)                         or return;
+  for (0..$num) {
+    (undef, $h) = (unpack 'L2' => substr ($buf, $_ * $reclen, $reclen));
+    last if $h;
+    return unless (defined $h);
+    $z++;
+  }
+  substr ($buf, 0, $z * $reclen) = '';
+
+  seek $file, 0, 0                                   or return;
+  print $file $buf                                   or return;
+
+  # looks good
+  1;
+}

 
 ### sub find_pos ($$) ##########################################################
 #
 # find position in cache file
 
 ### sub find_pos ($$) ##########################################################
 #
 # find position in cache file

-# (binary search in index file)

 #
 #

-# Params: $handle  - index file handle
+# Params: $handle  - summary file handle

 #         $posting - posting number
 #
 # Return: position or false (undef)
 #
 sub find_pos ($$) {
 #         $posting - posting number
 #
 # Return: position or false (undef)
 #
 sub find_pos ($$) {

-  my ($I, $posting) = @_;
-  my $reclen = 2 * length pack 'L',0;
-  my $end = (-s $I) / $reclen;
-
-  $end == int $end                                         or return;
+  my ($handle, $posting) = @_;
+  my $reclen = length (pack 'L',0);
+  my $lreclen = $reclen << 2;
+  seek $handle, 0, 0                                       or return;

 
 

-  my ($start, $buf, $current) = 0;
-
-  while ($start <= $end) {
-    seek $I, ($current = ($start + $end) >> 1)*$reclen, 0  or return;
-    $reclen == read ($I, $buf, $reclen)                    or return;
+  my $buf;
+  read ($handle, $buf, $reclen) == $reclen                 or return;

 
 

-    my ($num, $found) = unpack 'L2',$buf;
+  my $first = unpack ('L' => $buf);
+  $first <= $posting                                       or return;

 
 

-    if ($num == $posting) {
-      return $found;
-    }
-    elsif ($num < $posting) {
-      $start = $current+1
-    }
-    else {
-      $end   = $current-1
-    }
-  }
+  my $pos = ($posting - $first) * $lreclen;
+  seek $handle, $pos, 0                                    or return;

 
 

-  return;
+  $pos;

 }
 
 ### sub add_view ###############################################################
 #
 # increment the views-counter
 #
 }
 
 ### sub add_view ###############################################################
 #
 # increment the views-counter
 #

-# Params: ~none~
+# Params: hash reference
+#         (posting, thread)

 #
 # Return: Status code (Bool)
 #
 #
 # Return: Status code (Bool)
 #

+sub add_view {
+  my ($self, $param) = @_;
+
+  $self -> mod_wrap (
+    \&r_add_view,
+    $param
+  );
+}

 sub r_add_view {
 sub r_add_view {

-  my ($self, $h, $param) = @_;
-  my ($C, $I) = ($h->{C}, $h->{I});
-  my $reclen  = 4 * length pack 'L', 0;
+  my ($self, $handle, $param) = @_;
+  my $reclen  = length (pack 'L', 0) << 2;

   my $pos;
   my $pos;

-  defined ($pos = find_pos $I, $param->{posting})                or return;
+  defined ($pos = find_pos $handle, $param->{posting})                or return;

 
   my $buf;
 
   my $buf;

-  seek $C, $pos, 0                                               or return;
-  read ($C, $buf, $reclen) == $reclen                            or return;
+  seek $handle, $pos, 0                                               or return;
+  read ($handle, $buf, $reclen) == $reclen                            or return;

 
 

-  my ($posting, $thread, $views, $votings) = unpack 'L4',$buf;
-  $thread == $param->{thread}                                    or return;
-  seek $C, $pos, 0                                               or return;
-  print $C pack ('L4' => $posting, $thread, $views+1, $votings)  or return;
+  my ($posting, $thread, $views, $votings) = unpack 'L4' => $buf;
+  $param->{thread} == $thread                                         or return;
+  $param->{posting} == $posting                                       or return;

 
 

-  1;
-}
+  seek $handle, $pos, 0                                               or return;

 
 

-sub add_view {
-  my ($self, $param) = @_;
+  local $\;
+  print $handle pack ('L4' => $posting, $thread, $views+1, $votings)  or return;

 
 

-  $self -> write_wrap (
-    \&r_add_view,
-    $param
-  );
+  1;

 }
 
 ### sub pick ###################################################################
 }
 
 ### sub pick ###################################################################


@@ -167,20 +240,35 @@ sub add_view {
 #
 # Return: hash reference or false
 #
 #
 # Return: hash reference or false
 #

+sub pick {
+  my ($self, $param) = @_;
+
+  $self -> pick_wrap (
+    \&r_pick,
+    $self->cachefile($param),
+    $param
+  ) ? $self -> {pick}
+    : return;
+}

 sub r_pick {
 sub r_pick {

-  my ($self, $h, $param) = @_;
-  my ($C, $I) = ($h->{C}, $h->{I});
-  my $reclen  = 4 * length pack 'L', 0;
+  my ($self, $handle, $file, $param) = @_;
+  my $reclen  = 4 * length (pack 'L' => 0);

   my ($buf, $pos);
   my ($buf, $pos);

-  local $/="\012";
+  local $/="\n";
+
+  defined($pos = find_pos $handle, $param->{posting})                 or return;
+
+  seek $handle, $pos, 0                                               or return;
+  read ($handle, $buf, $reclen) == $reclen                            or return;

 
 

-  defined($pos = find_pos $I, $param->{posting})      or return;
+  my ($posting, $thread, $views, $votings) = unpack 'L4' => $buf;
+  $param->{thread} == $thread                                         or return;
+  $param->{posting} == $posting                                       or return;

 
 

-  seek $C, $pos, 0                                    or return;
-  read ($C, $buf, $reclen) == $reclen                 or return;
+  seek $file, 0, 0                                                    or return;
+  my @records = <$file>;
+  chomp @records;

 
 

-  my ($posting, $thread, $views, $votings) = unpack 'L4', $buf;
-  $buf = <$C>; chomp $buf;

   $self -> {pick} = {
     views   => $views,
     votings => $votings,
   $self -> {pick} = {
     views   => $views,
     votings => $votings,


@@ -191,8 +279,8 @@ sub r_pick {
             time => $_->[0] || 0,
             IP   => $_->[1] || 0
           }
             time => $_->[0] || 0,
             IP   => $_->[1] || 0
           }

-        } [split /;/]
-      } split ' ' => $buf
+        } [split ' ']
+      } @records

     }
   };
 
     }
   };
 


@@ -200,14 +288,6 @@ sub r_pick {
   1;
 }
 
   1;
 }
 

-sub pick {
-  my ($self, $param) = @_;
-
-  $self -> read_wrap (\&r_pick, $param)
-    ? $self -> {pick}
-    : return;
-}
-

 ### sub summary ################################################################
 #
 # read out the cache and return a summary
 ### sub summary ################################################################
 #
 # read out the cache and return a summary


@@ -216,22 +296,27 @@ sub pick {
 #
 # Return: hash reference or false
 #
 #
 # Return: hash reference or false
 #

-sub r_summary {
-  my ($self, $h) = @_;
-  my ($C, $I) = ($h->{C}, $h->{I});
-  my $reclen  = length pack 'L', 0;
-  my $ireclen = 2 * $reclen;
-  my $creclen = 4 * $reclen;
-  my ($buf, $pos, %hash);
-
-
-  while ($ireclen == read ($I, $buf, $ireclen)) {
-    (undef, $pos) = unpack 'L2', $buf;
+sub summary {
+  my $self = shift;

 
 

-    seek $C, $pos, 0                                 or return;
-    read ($C, $buf, $creclen) == $creclen            or return;
+  $self -> read_wrap (\&r_summary)
+    ? $self -> {summary}
+    : return;
+}
+sub r_summary {
+  my ($self, $handle) = @_;
+  my $reclen  = length (pack 'L', 0) << 2;
+  my $len = -s $handle;
+  my $num = int ($len / $reclen) -1;
+  my ($buf, %hash);
+  local $/;
+
+  seek $handle, 0, 0                                 or return;
+  read ($handle, $buf, $len)                         or return;
+  for (0..$num) {
+    my ($posting, $thread, $views, $votings)
+      = (unpack 'L4' => substr ($buf, $_ * $reclen, $reclen));

 
 

-    my ($posting, $thread, $views, $votings) = unpack 'L4', $buf;

     $hash{$thread} = {} unless $hash{$thread};
     $hash{$thread} -> {$posting} = {
       views   => $views,
     $hash{$thread} = {} unless $hash{$thread};
     $hash{$thread} -> {$posting} = {
       views   => $views,


@@ -245,67 +330,52 @@ sub r_summary {
   1;
 }
 
   1;
 }
 

-sub summary {
-  my $self = shift;
-
-  $self -> read_wrap (\&r_summary)
-    ? $self -> {summary}
-    : return;
-}
-
-### sub repair_cache ###########################################################
+### sub add_voting #############################################################

 #
 #

-# check on cache consistance and repair if broken
+# add a voting

 #
 #

-# Params: ~none~
+# Params: $param - hash reference
+#                  (thread, posting, IP, ID, time)

 #
 #

-# Return: sucess code (Bool)
+# Return: Status code (Bool)

 #
 #

-sub r_repair_cache {
-  my ($self, $h) = @_;
-  my ($C, $TC, $TI) = ($h->{C}, $h->{TC}, $h->{TI});
-  my $pos = tell $TC;
-  my ($block);
-  my $reclen = 4 * length pack 'L',0;
-  local $/="\012";
-  local $\;
-
-  while ($reclen == read $C, $block, $reclen) {
-    my $msg = unpack ('L' => $block);
-    my $rest = <$C>;
-    chomp $rest;
-    print $TC $block. $rest. $/;
-    print $TI pack ('L2' => $msg, $pos);
-    $pos = tell $TC;
-  }
+sub add_voting {
+  my ($self, $param) = @_;

 
 

-  1;
+  $self -> vote_wrap (
+    \&r_add_voting,
+    $self->cachefile($param),
+    $param
+  );

 }
 }

+sub r_add_voting {
+  my ($self, $handle, $file, $param) = @_;
+  my $reclen  = length (pack 'L', 0) << 2;
+  my $pos;
+  defined ($pos = find_pos $handle, $param->{posting})          or return;

 
 

-sub repair_cache {
-  my $self = shift;
-
-  return unless ($self->cachefile and $self->indexfile);
-  return 1 if (-f $self->cachefile and -f $self->indexfile);
-
-  unless (-f $self->cachefile) {
-    return if (-f $self->indexfile);
+  my $buf;
+  seek $handle, $pos, 0                                         or return;
+  read ($handle, $buf, $reclen) == $reclen                      or return;

 
 

-    local *FILE;
-    return unless (open FILE, '>'.$self->cachefile);
-    return unless (close FILE);
-    return unless (open FILE, '>'.$self->indexfile);
-    return unless (close FILE);
+  my ($posting, $thread, $views, $votings) = unpack 'L4' => $buf;
+  $param->{thread} == $thread                                   or return;

 
 

-    release_file ($self->cachefile);
-    release_file ($self->indexfile);
-    release_file ($self->temp_indexfile);
-    release_file ($self->temp_cachefile);
+  {
+    local $\="\n";
+    seek $file, 0, 2                                            or return;
+    print $file
+      join (' ' => $param->{time}, $param->{IP}, $param->{ID})  or return;
+  }

 
 

-    return 1;
+  {
+    local $\;
+    seek $handle, $pos, 0                                       or return;
+    print $handle
+      pack ('L4' => $posting, $thread, $views, $votings+1)      or return;

   }
 
   }
 

-  $self -> open_wrap (\&r_repair_cache);
+  1;

 }
 
 ### sub add_posting ############################################################
 }
 
 ### sub add_posting ############################################################


@@ -317,207 +387,253 @@ sub repair_cache {
 #
 # Return: Status code (Bool)
 #
 #
 # Return: Status code (Bool)
 #

+sub add_posting {
+  my $self = shift;
+  $self -> add_wrap (
+    \&r_add_posting,
+    @_
+  );
+}

 sub r_add_posting {
 sub r_add_posting {

-  my ($self, $h, $param) = @_;
-  my ($C, $TC, $TI) = ($h->{C}, $h->{TC}, $h->{TI});
-  my $pos = tell $TC;
-  my ($block, $ins, $msg);
-  my $reclen = 4 * length pack 'L',0;
-  local $/="\012";
+  my ($self, $handle, $param) = @_;
+  local *FILE;

   local $\;
 
   local $\;
 

-  while ($reclen == read $C, $block, $reclen) {
-    $msg = unpack ('L' => $block);
-
-    if ($param -> {posting} == $msg) {
-      $self->set_error("double defined posting id 'm$msg'");
-      return;
-    };
-    next if ($param -> {posting} > $msg or $ins);
-
-    print $TC pack('L4' => $param->{posting}, $param->{thread}, 0, 0), $/;
-    print $TI pack('L2' => $param->{posting}, $pos);
-    $pos = tell $TC;
-    $ins = 1;
+  unless (-d $self -> threaddir($param)) {
+    mkdir $self->threaddir($param)                   or return;

   }
   }

-  continue {
-    my $rest = <$C>;
-    chomp $rest;
-    print $TC $block. $rest. $/;
-    print $TI pack ('L2' => $msg, $pos);
-    $pos = tell $TC;
+  sysopen (
+    FILE,
+    $self->cachefile($param),
+    O_WRONLY | O_CREAT | O_TRUNC
+  )                                                  or return;
+  close FILE                                         or return;
+
+  my $z;
+  if (-s $handle) {
+    my $reclen = length (pack 'L' => 0) << 2;
+    seek $handle, 0-$reclen, 2                       or return;
+    my $buf;
+    read ($handle, $buf, $reclen) == $reclen         or return;
+    $z = unpack 'L' => $buf;
+    if ($z < $param->{posting}) {
+      while (++$z < $param->{posting}) {
+        seek $handle, 0, 2                           or return;
+        print $handle pack(
+          'L4' => $z, 0, 0, 0
+        )                                            or return;
+      }
+      $z = undef;
+    }
+    else {
+      my $pos;
+      defined (
+        $pos = find_pos $handle, $param->{posting}
+      )                                              or return;
+      seek $handle, $pos, 0                          or return;
+    }

   }
   }

-  unless ($ins) {
-    print $TC pack('L4' => $param->{posting}, $param->{thread}, 0, 0), $/;
-    print $TI pack('L2' => $param->{posting}, $pos);
+
+  unless (defined $z) {
+    seek $handle, 0, 2                               or return;

   }
 
   }
 

-  1;
-}
+  print $handle pack(
+    'L4' => $param->{posting}, $param->{thread}, 0, 0
+  )                                                  or return;

 
 

-sub add_posting {
-  my $self = shift;
-  $self -> open_wrap (
-    \&r_add_posting,
-    @_
-  );
+  release_file ($self->cachefile($param));
+
+  1;

 }
 
 }
 

-### sub add_voting #############################################################
+### sub add_wrap ################################################################

 #
 #

-# add a voting (increment vote counter and log the vote data)
+# file lock, open, execute, close, unlock wrapper
+# for adding an empty entry

 #
 #

-# Params: $param - hash reference
-#                  (thread, posting, IP, time, ID)
+# Params: $gosub - sub reference (for execution)
+#         @param - params (for $gosub)

 #
 # Return: Status code (Bool)
 #
 #
 # Return: Status code (Bool)
 #

-sub r_add_voting {
-  my ($self, $h, $param) = @_;
-  my ($C, $TC, $TI) = ($h->{C}, $h->{TC}, $h->{TI});
-  my $pos = tell $TC;
-  my $block;
-  my $reclen = 4 * length pack 'L',0;
-  local $/="\012";
-  local $\;
-
-  while ($reclen == read $C, $block, $reclen) {
-    my $rest = <$C>;
-    chomp $rest;
-    my ($msg, $thread, $views, $votings) = unpack ('L4' => $block);
-
-    $param -> {posting} != $msg or do {
-      $rest = join ' ' => (length $rest ? $rest: (), join ';' => ($param->{time}, $param->{IP}, $param->{ID}));
-      $votings++;
-    };
+sub add_wrap {
+  my ($self, $gosub, @param) = @_;
+  my $status;

 
 

-    print $TC pack ('L4' => ($msg, $thread, $views, $votings)), $rest, $/;
-    print $TI pack ('L2' => $msg, $pos);
-    $pos = tell $TC;
+  unless (write_lock_file ($self->summaryfile)) {
+    violent_unlock_file ($self->summaryfile);
+    $self->set_error ('could not write-lock summary file '.$self->summaryfile);
+  }
+  else {
+    local *SUM;
+    unless (sysopen (SUM, $self->summaryfile, $O_BINARY | O_APPEND | O_CREAT | O_RDWR)) {
+      $self->set_error
+        ('could not open to read/write/append summary file '.$self->summaryfile);
+    }
+    else {
+      $status = $gosub -> (
+        $self,
+        \*SUM,
+        @param
+      );
+      unless (close SUM) {
+        $status=0;
+        $self->set_error('could not close summary file '.$self->summaryfile);
+      }
+    }
+    violent_unlock_file ($self->summaryfile) unless (write_unlock_file ($self->summaryfile));

   }
 
   }
 

-  1;
+  # return
+  $status;

 }
 
 }
 

-sub add_voting {
-  my $self = shift;
-  $self -> open_wrap (
-    \&r_add_voting,
-    @_
-  );
+### sub vote_wrap ###############################################################
+#
+# file lock, open, execute, close, unlock wrapper
+# for adding a vote
+#
+# Params: $gosub - sub reference (for execution)
+#         @param - params (for $gosub)
+#
+# Return: Status code (Bool)
+#
+sub vote_wrap {
+  my ($self, $gosub, $filename, @param) = @_;
+  my $status;
+
+  unless (write_lock_file ($filename)) {
+    violent_unlock_file ($filename);
+    $self->set_error ('could not write-lock cache file '.$filename);
+  }
+  else {
+    local *CACHE;
+    unless (sysopen (CACHE, $filename, O_APPEND | O_CREAT | O_RDWR)) {
+      $self->set_error ('could not open to read/write/append cache file '.$filename);
+    }
+    else {
+      $status = $self -> mod_wrap (
+        $gosub,
+        \*CACHE,
+        @param
+      );
+      unless (close CACHE) {
+        $status=0;
+        $self->set_error('could not close cache file '.$filename);
+      }
+    }
+    violent_unlock_file ($filename) unless (write_unlock_file ($filename));
+  }
+
+  # return
+  $status;

 }
 
 }
 

-### sub open_wrap ##############################################################
+### sub purge_wrap ##############################################################

 #
 # file lock, open, execute, close, unlock wrapper
 #
 # file lock, open, execute, close, unlock wrapper

-# for writing into temp files
+# for garbage collection

 #
 # Params: $gosub - sub reference (for execution)
 #         @param - params (for $gosub)
 #
 # Return: Status code (Bool)
 #
 #
 # Params: $gosub - sub reference (for execution)
 #         @param - params (for $gosub)
 #
 # Return: Status code (Bool)
 #

-sub open_wrap {
+sub purge_wrap {

   my ($self, $gosub, @param) = @_;
   my $status;
   my ($self, $gosub, @param) = @_;
   my $status;

+  my $filename = $self -> summaryfile . '.temp';

 
 

-  unless (write_lock_file ($self->temp_cachefile)) {
-    violent_unlock_file ($self->temp_cachefile);
-    $self->set_error ('could not write-lock temp cache file '.$self->temp_cachefile);
+  unless (write_lock_file ($self->summaryfile)) {
+    violent_unlock_file ($self->summaryfile);
+    $self->set_error ('could not write-lock summary file '.$self->summaryfile);

   }
   else {
   }
   else {

-    unless (write_lock_file ($self->temp_indexfile)) {
-      violent_unlock_file ($self->temp_indexfile);
-      $self->set_error ('could not write-lock temp index file '.$self->temp_indexfile);
+    local *TEMP;
+    unless (sysopen (TEMP, $filename, O_CREAT | O_WRONLY | O_TRUNC | $O_BINARY)) {
+      $self->set_error ('could not open to write temp summary file '.$filename);

     }
     else {
     }
     else {

-      unless (lock_file ($self->cachefile)) {
-        violent_unlock_file ($self->cachefile);
-        $self->set_error ('could not read-lock cache file '.$self->cachefile);
+      local *S;
+      unless (sysopen (S, $self->summaryfile, O_RDONLY | $O_BINARY)) {
+        $self->set_error ('could not open to read summary file '.$self->summaryfile);

       }
       else {
       }
       else {

-        unless (lock_file ($self->indexfile)) {
-          violent_unlock_file ($self->indexfile);
-          $self->set_error ('could not read-lock index file '.$self->indexfile);
+        $status = $gosub -> (
+          $self,
+          \*S,
+          \*TEMP,
+          @param
+        );
+        unless (close S) {
+          $status = 0;
+          $self->set_error('could not close summary file '.$self->summaryfile);

         }
         }

-        else {
-          local (*C, *TC, *TI);
-          unless (sysopen (C, $self->cachefile, O_RDONLY | $O_BINARY)) {
-            $self->set_error ('could not open to read cache file '.$self->cachefile);
-          }
-          else {
-            unless (sysopen (TC, $self->temp_cachefile, O_WRONLY | O_TRUNC | O_CREAT | $O_BINARY)) {
-              $self->set_error ('could not open to write temp cache file '.$self->temp_cachefile);
-            }
-            else {
-              unless (sysopen (TI, $self->temp_indexfile, O_WRONLY | O_TRUNC | O_CREAT | $O_BINARY)) {
-                $self->set_error ('could not open to write temp index file '.$self->temp_indexfile);
-              }
-              else {
-                $status = $gosub -> (
-                  $self,
-                  { C  => \*C,
-                    TC => \*TC,
-                    TI => \*TI
-                  },
-                  @param
-                );
-                unless (close TI) {
-                  $status=0;
-                  $self->set_error('could not close temp index file '.$self->temp_indexfile);
-                }
-              }
-              unless (close TC) {
-                $status=0;
-                $self->set_error('could not close temp cache file '.$self->temp_cachefile);
-              }
-            }
-            unless (close C) {
-              $status=0;
-              $self->set_error('could not close cache file '.$self->cachefile);
-            }
-            if ($status) {
-              unless (write_lock_file ($self->cachefile) and write_lock_file ($self->indexfile)) {
-                $status=0;
-                $self->set_error('could not write-lock cache or index file');
-              }
-              else {
-                unless (unlink $self->indexfile or !-f $self->indexfile) {
-                  $status=0;
-                  $self->set_error('could not unlink '.$self->indexfile);
-                }
-                else {
-                  unless (rename $self->temp_cachefile => $self->cachefile) {
-                    $status=0;
-                    $self->set_error('could not rename '.$self->temp_cachefile);
-                  }
-                  else {
-                    unless (rename $self->temp_indexfile => $self->indexfile) {
-                      $status=0;
-                      $self->set_error('could not rename '.$self->temp_indexfile);
-                    }
-                  }
-                }
-              }
-            }
-          }
-          violent_unlock_file ($self->indexfile) unless (unlock_file ($self->indexfile));
+      }
+      unless (close TEMP) {
+        $status=0;
+        $self->set_error('could not close temp summary file '.$filename);
+      }
+      if ($status) {
+        unless (rename $filename => $self->summaryfile) {
+          $status=0;
+          $self->set_error('could not rename temp summary file '.$filename);

         }
         }

-        violent_unlock_file ($self->cachefile) unless (unlock_file ($self->cachefile));

       }
       }

-      violent_unlock_file ($self->temp_indexfile) unless (write_unlock_file ($self->temp_indexfile));

     }
     }

-    violent_unlock_file ($self->temp_cachefile) unless (write_unlock_file ($self->temp_cachefile));
+    violent_unlock_file ($self->summaryfile) unless (write_unlock_file ($self->summaryfile));
+  }
+
+  # return
+  $status;
+}
+
+### sub pick_wrap ###############################################################
+#
+# file lock, open, execute, close, unlock wrapper
+# for picking a posting
+#
+# Params: $gosub - sub reference (for execution)
+#         @param - params (for $gosub)
+#
+# Return: Status code (Bool)
+#
+sub pick_wrap {
+  my ($self, $gosub, $filename, @param) = @_;
+  my $status;
+
+  unless (lock_file ($filename)) {
+    violent_unlock_file ($filename);
+    $self->set_error ('could not lock cache file '.$filename);
+  }
+  else {
+    local *CACHE;
+    unless (sysopen (CACHE, $filename, O_RDONLY)) {
+      $self->set_error ('could not open to read cache file '.$filename);
+    }
+    else {
+      $status = $self -> read_wrap (
+        $gosub,
+        \*CACHE,
+        @param
+      );
+      unless (close CACHE) {
+        $status=0;
+        $self->set_error('could not close cache file '.$filename);
+      }
+    }
+    violent_unlock_file ($filename) unless (unlock_file ($filename));

   }
 
   # return
   $status;
 }
 
   }
 
   # return
   $status;
 }
 

-### sub read_wrap ##############################################################
+### sub read_wrap ###############################################################

 #
 # file lock, open, execute, close, unlock wrapper
 #
 # file lock, open, execute, close, unlock wrapper

-# for reading
+# for reading of summary file

 #
 # Params: $gosub - sub reference (for execution)
 #         @param - params (for $gosub)
 #
 # Params: $gosub - sub reference (for execution)
 #         @param - params (for $gosub)


@@ -528,111 +644,68 @@ sub read_wrap {
   my ($self, $gosub, @param) = @_;
   my $status;
 
   my ($self, $gosub, @param) = @_;
   my $status;
 

-  unless (lock_file ($self->cachefile)) {
-    violent_unlock_file ($self->cachefile);
-    $self->set_error ('could not read-lock cache file '.$self->cachefile);
+  unless (lock_file ($self->summaryfile)) {
+    violent_unlock_file ($self->summaryfile);
+    $self->set_error ('could not read-lock summary file '.$self->summaryfile);

   }
   else {
   }
   else {

-    unless (lock_file ($self->indexfile)) {
-      violent_unlock_file ($self->indexfile);
-      $self->set_error ('could not read-lock index file '.$self->indexfile);
+    local *S;
+    unless (sysopen (S, $self->summaryfile, O_RDONLY | $O_BINARY)) {
+      $self->set_error ('could not open to read summary file '.$self->summaryfile);

     }
     else {
     }
     else {

-      local (*C, *I);
-      unless (sysopen (C, $self->cachefile, O_RDONLY | $O_BINARY)) {
-        $self->set_error ('could not open to read cache file '.$self->cachefile);
+      $status = $gosub -> (
+        $self,
+        \*S,
+        @param
+      );
+      unless (close S) {
+        $status=0;
+        $self->set_error('could not close summary file '.$self->summaryfile);

       }
       }

-      else {
-        unless (sysopen (I, $self->indexfile, O_RDONLY | $O_BINARY)) {
-          $self->set_error ('could not open to read index file '.$self->indexfile);
-        }
-        else {
-          $status = $gosub -> (
-            $self,
-            { C  => \*C,
-              I => \*I,
-            },
-            @param
-          );
-          unless (close I) {
-            $status=0;
-            $self->set_error('could not close index file '.$self->indexfile);
-          }
-        }
-        unless (close C) {
-          $status=0;
-          $self->set_error('could not close cache file '.$self->cachefile);
-        }
-      }
-      violent_unlock_file ($self->indexfile) unless (unlock_file ($self->indexfile));

     }
     }

-    violent_unlock_file ($self->cachefile) unless (unlock_file ($self->cachefile));
+    violent_unlock_file ($self->summaryfile) unless (unlock_file ($self->summaryfile));

   }
 
   # return
   $status;
 }
 
   }
 
   # return
   $status;
 }
 

-### sub write_wrap ##############################################################
+### sub mod_wrap ################################################################

 #
 # file lock, open, execute, close, unlock wrapper
 #
 # file lock, open, execute, close, unlock wrapper

-# for reading
+# for modification of summary file

 #
 # Params: $gosub - sub reference (for execution)
 #         @param - params (for $gosub)
 #
 # Return: Status code (Bool)
 #
 #
 # Params: $gosub - sub reference (for execution)
 #         @param - params (for $gosub)
 #
 # Return: Status code (Bool)
 #

-sub write_wrap {
+sub mod_wrap {

   my ($self, $gosub, @param) = @_;
   my $status;
 
   my ($self, $gosub, @param) = @_;
   my $status;
 

-  unless (write_lock_file ($self->temp_cachefile)) {
-    violent_unlock_file ($self->temp_cachefile);
-    $self->set_error ('could not write-lock temp cache file '.$self->temp_cachefile);
+  unless (write_lock_file ($self->summaryfile)) {
+    violent_unlock_file ($self->summaryfile);
+    $self->set_error ('could not write-lock summary file '.$self->summaryfile);

   }
   else {
   }
   else {

-    unless (write_lock_file ($self->cachefile)) {
-      violent_unlock_file ($self->cachefile);
-      $self->set_error ('could not write-lock cache file '.$self->cachefile);
+    local *S;
+    unless (sysopen (S, $self->summaryfile, O_RDWR | $O_BINARY)) {
+      $self->set_error ('could not open to read/write summary file '.$self->summaryfile);

     }
     else {
     }
     else {

-      unless (lock_file ($self->indexfile)) {
-        violent_unlock_file ($self->indexfile);
-        $self->set_error ('could not read-lock index file '.$self->indexfile);
-      }
-      else {
-        local (*C, *I);
-        unless (sysopen (C, $self->cachefile, O_RDWR | $O_BINARY)) {
-          $self->set_error ('could not open to read/write cache file '.$self->cachefile);
-        }
-        else {
-          unless (sysopen (I, $self->indexfile, O_RDONLY | $O_BINARY)) {
-            $self->set_error ('could not open to read index file '.$self->indexfile);
-          }
-          else {
-            $status = $gosub -> (
-              $self,
-              { C  => \*C,
-                I => \*I,
-              },
-              @param
-            );
-            unless (close I) {
-              $status=0;
-              $self->set_error('could not close index file '.$self->indexfile);
-            }
-          }
-          unless (close C) {
-            $status=0;
-            $self->set_error('could not close cache file '.$self->cachefile);
-          }
-        }
-        violent_unlock_file ($self->indexfile) unless (unlock_file ($self->indexfile));
+      $status = $gosub -> (
+        $self,
+        \*S,
+        @param
+      );
+      unless (close S) {
+        $status=0;
+        $self->set_error('could not close summary file '.$self->summaryfile);

       }
       }

-      violent_unlock_file ($self->cachefile) unless (write_unlock_file ($self->cachefile));

     }
     }

-    violent_unlock_file ($self->temp_cachefile) unless (write_unlock_file ($self->temp_cachefile));
+    violent_unlock_file ($self->summaryfile) unless (write_unlock_file ($self->summaryfile));

   }
 
   # return
   }
 
   # return

diff --git a/selfforum-cgi/shared/Posting/_lib.pm b/selfforum-cgi/shared/Posting/_lib.pm
index 82240d5694f27e073d14bc1d80a34891494ae1bf..9a5330765d5665087cc0a477bf7ffdb8349d37b1 100644 (file)
--- a/selfforum-cgi/shared/Posting/_lib.pm
+++ b/selfforum-cgi/shared/Posting/_lib.pm
@@ -491,9 +491,9 @@ sub get_all_threads ($$;$)
   my ($last_thread, $last_message, $dtd, @unids, %threads);
   local (*FILE, $/);
 
   my ($last_thread, $last_message, $dtd, @unids, %threads);
   local (*FILE, $/);
 

-  open FILE, $file or return undef;
+  open FILE,"< $file" or return;

   my $xml = join '', <FILE>;
   my $xml = join '', <FILE>;

-  close(FILE) or return undef;
+  close(FILE) or return;

 
   if (wantarray)
   {
 
   if (wantarray)
   {

diff --git a/selfforum-cgi/shared/Template/Posting.pm b/selfforum-cgi/shared/Template/Posting.pm
index 0ffb6c20550cf5204d97955608ec9a155ff4d0ab..4cae38d2c8754da3ec53e0da2837d9c4cb80f8bc 100644 (file)
--- a/selfforum-cgi/shared/Template/Posting.pm
+++ b/selfforum-cgi/shared/Template/Posting.pm
@@ -183,7 +183,7 @@ sub print_posting_as_HTML ($$$) {
       close STDOUT;
 
       if ($param->{firsttime}) {
       close STDOUT;
 
       if ($param->{firsttime}) {

-        my $cache = new Posting::Cache ($param->{cachefile});
+        my $cache = new Posting::Cache ($param->{cachepath});

         $cache -> add_view (
           { thread  => $param -> {thread},
             posting => $param -> {posting}
         $cache -> add_view (
           { thread  => $param -> {thread},
             posting => $param -> {posting}

diff --git a/selfforum-cgi/user/fo_posting.pl b/selfforum-cgi/user/fo_posting.pl
index 180233cf755a2ce3ce6c347d2b009d772e3544f3..f4c6da01071a28913fb5d4bb00db836e61538f5a 100644 (file)
--- a/selfforum-cgi/user/fo_posting.pl
+++ b/selfforum-cgi/user/fo_posting.pl
@@ -62,6 +62,10 @@ $request -> handle_error or $request -> save;
 #
 $request -> response;
 
 #
 $request -> response;
 

+# shorten the main file?
+#
+$request -> severance;
+

 #
 #
 ### main end ###################################################################
 #
 #
 ### main end ###################################################################


@@ -70,6 +74,7 @@ $request -> response;
 ### Posting::Request ###########################################################
 package Posting::Request;
 
 ### Posting::Request ###########################################################
 package Posting::Request;
 

+use Arc::Archive;

 use CheckRFC;
 use Encode::Plain; $Encode::Plain::utf8 = 1; # generally convert from UTF-8
 use Encode::Posting;
 use CheckRFC;
 use Encode::Plain; $Encode::Plain::utf8 = 1; # generally convert from UTF-8
 use Encode::Posting;


@@ -124,6 +129,21 @@ sub new {
   bless $self, $class;
 }
 
   bless $self, $class;
 }
 

+sub severance {
+  my $self = shift;
+
+  my $stat = cut_tail ({
+    forumFile    => $self -> {conf} -> {forum_file_name},
+    messagePath  => $self -> {conf} -> {message_path},
+    archivePath  => $self -> {conf} -> {original} -> {files} -> {archivePath},
+    lockFile     => $self -> {conf} -> {original} -> {files} -> {sev_lock},
+    adminDefault => $self -> {conf} -> {admin},
+    cachePath    => $self -> {conf} -> {original} -> {files} -> {cachePath}
+  });
+#  die $stat->{(keys %$stat)[0]} if (%$stat);
+
+}
+

 ### sub response ###############################################################
 #
 # print the response to STDOUT
 ### sub response ###############################################################
 #
 # print the response to STDOUT


@@ -430,7 +450,7 @@ sub save {
           };
         }
         else {
           };
         }
         else {

-          my $cache = new Posting::Cache ($self->{conf}->{original}->{files}->{cacheFile});
+          my $cache = new Posting::Cache ($self->{conf}->{original}->{files}->{cachePath});

           $cache -> add_posting (
             { thread  => ($tid =~ /(\d+)/)[0],
               posting => ($mid =~ /(\d+)/)[0]
           $cache -> add_posting (
             { thread  => ($tid =~ /(\d+)/)[0],
               posting => ($mid =~ /(\d+)/)[0]

diff --git a/selfforum-cgi/user/fo_view.pl b/selfforum-cgi/user/fo_view.pl
index 7470dc7be958e0833faec25c6aad530e4d1841df..bc9190fb81a6cef9570e5922fd441c8c7913149d 100644 (file)
--- a/selfforum-cgi/user/fo_view.pl
+++ b/selfforum-cgi/user/fo_view.pl
@@ -71,7 +71,7 @@ if (defined ($tid) and defined ($mid)) {
       cgi          => $cgi,
       tree         => $tree,
       firsttime    => 1,
       cgi          => $cgi,
       tree         => $tree,
       firsttime    => 1,

-      cachefile    => $conf -> {files} -> {cacheFile}
+      cachepath    => $conf -> {files} -> {cachePath}

     }
   );
 }
     }
   );
 }

diff --git a/selfforum-cgi/user/fo_voting.pl b/selfforum-cgi/user/fo_voting.pl
index 7dddc53b2451a545640e944ce1b0072b3b2fe896..a37fbe53d68549a44f24e888dbcc0e2a505d34c8 100644 (file)
--- a/selfforum-cgi/user/fo_voting.pl
+++ b/selfforum-cgi/user/fo_voting.pl
@@ -66,7 +66,7 @@ my ($tid, $mid) = map {$_ || 0} split /;/ => $fup, 2;
 $tid = ($tid=~/(\d+)/)[0] || 0;
 $mid = ($mid=~/(\d+)/)[0] || 0;
 
 $tid = ($tid=~/(\d+)/)[0] || 0;
 $mid = ($mid=~/(\d+)/)[0] || 0;
 

-my $cache = new Posting::Cache ($conf->{files}->{cacheFile});
+my $cache = new Posting::Cache ($conf->{files}->{cachePath});

 my $hash;
 
 if ($hash = $cache -> pick ({thread => $tid, posting => $mid})) {
 my $hash;
 
 if ($hash = $cache -> pick ({thread => $tid, posting => $mid})) {


@@ -105,7 +105,7 @@ print_posting_as_HTML (
     cgi          => $cgi,
     tree         => $tree,
     voted        => $voted || '',
     cgi          => $cgi,
     tree         => $tree,
     voted        => $voted || '',

-    cachefile    => $conf -> {files} -> {cacheFile}
+    cachepath    => $conf -> {files} -> {cachePath}

   }
 );
 
   }
 );