From: ndparker <> Date: Tue, 1 May 2001 00:11:53 +0000 (+0000) Subject: fixed some bugs, prepared the 0.98 release X-Git-Url: https://git.p6c8.net/selfforum.git/commitdiff_plain/cee4397796b2a1015b88addca2de54fe50dbc3f8 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 27a8c93..09bb103 100644 --- 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); - $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)); diff --git a/selfforum-cgi/shared/Lock.pm b/selfforum-cgi/shared/Lock.pm index 3f01861..a611ce6 100644 --- 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 + file_removed ); %EXPORT_TAGS = ( @@ -138,7 +139,7 @@ sub w_unlock_file ($;$) { # try do decrement the reference counter # - if (set_ref($filename,-1,$timeout)) { + if (set_ref($filename, -1, $timeout)) { delete $LOCKED{$filename}; return 1; } @@ -325,6 +326,15 @@ sub w_release_file ($) { 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) @@ -584,6 +594,10 @@ sub x_release_file ($) { 1; } +sub x_file_removed ($) { + release_file (shift); +} + ### sub w_simple_lock ($;$) #################################################### ### sub w_simple_unlock ($) #################################################### # @@ -600,7 +614,7 @@ sub w_simple_lock ($;$) { my $timeout = shift || $Timeout; my $lockfile = lockfile $filename; - for (1..$timeout) { + for (0..$timeout) { unlink $lockfile and return 1; sleep(1); } @@ -640,7 +654,7 @@ sub x_simple_lock ($;$) { my $timeout = shift || $Timeout; my $lockfile = lockfile $filename; - for (1..$timeout) { + for (0..$timeout) { symlink $filename,$lockfile and return 1; sleep(1); } @@ -702,7 +716,7 @@ sub w_set_ref ($$$) { 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; @@ -761,7 +775,7 @@ sub x_set_ref ($$$) { 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; @@ -793,16 +807,14 @@ sub get_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 = ; + close REF; # 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; + *file_removed = \&x_file_removed; *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; + *file_removed = \&w_file_removed; *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 4e1e8de..d937b9d 100644 --- 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 File::Path; use Lock qw(:ALL); my $O_BINARY = eval "O_BINARY"; @@ -22,7 +23,7 @@ $O_BINARY = 0 if ($@); # # Constructor # -# Params: $filename - full qualified cache file name +# Params: $pathname - full qualified cache path # # Return: Posting::Cache object # @@ -30,11 +31,7 @@ sub new { 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; } @@ -64,98 +61,174 @@ sub set_error { return; } -### sub set_file ############################################################### +### sub set_path ############################################################### # # 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; } -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 -# (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 ($$) { - 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 # -# Params: ~none~ +# Params: hash reference +# (posting, thread) # # Return: Status code (Bool) # +sub add_view { + my ($self, $param) = @_; + + $self -> mod_wrap ( + \&r_add_view, + $param + ); +} 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; - defined ($pos = find_pos $I, $param->{posting}) or return; + defined ($pos = find_pos $handle, $param->{posting}) or return; 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 ################################################################### @@ -167,20 +240,35 @@ sub add_view { # # 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 { - 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); - 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, @@ -191,8 +279,8 @@ sub r_pick { time => $_->[0] || 0, IP => $_->[1] || 0 } - } [split /;/] - } split ' ' => $buf + } [split ' '] + } @records } }; @@ -200,14 +288,6 @@ sub r_pick { 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 @@ -216,22 +296,27 @@ sub pick { # # 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, @@ -245,67 +330,52 @@ sub r_summary { 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 ############################################################ @@ -317,207 +387,253 @@ sub repair_cache { # # Return: Status code (Bool) # +sub add_posting { + my $self = shift; + $self -> add_wrap ( + \&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 $\; - 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) # -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 -# for writing into temp files +# for garbage collection # # 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 $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 { - 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 { - 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 { - 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; } -### sub read_wrap ############################################################## +### sub read_wrap ############################################################### # # file lock, open, execute, close, unlock wrapper -# for reading +# for reading of summary file # # Params: $gosub - sub reference (for execution) # @param - params (for $gosub) @@ -528,111 +644,68 @@ sub read_wrap { 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 { - 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 { - 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; } -### sub write_wrap ############################################################## +### sub mod_wrap ################################################################ # # 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) # -sub write_wrap { +sub mod_wrap { 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 { - 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 { - 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 diff --git a/selfforum-cgi/shared/Posting/_lib.pm b/selfforum-cgi/shared/Posting/_lib.pm index 82240d5..9a53307 100644 --- 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, $/); - open FILE, $file or return undef; + open FILE,"< $file" or return; my $xml = join '', ; - close(FILE) or return undef; + close(FILE) or return; if (wantarray) { diff --git a/selfforum-cgi/shared/Template/Posting.pm b/selfforum-cgi/shared/Template/Posting.pm index 0ffb6c2..4cae38d 100644 --- 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}) { - my $cache = new Posting::Cache ($param->{cachefile}); + my $cache = new Posting::Cache ($param->{cachepath}); $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 180233c..f4c6da0 100644 --- 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; +# shorten the main file? +# +$request -> severance; + # # ### main end ################################################################### @@ -70,6 +74,7 @@ $request -> response; ### 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; @@ -124,6 +129,21 @@ sub new { 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 @@ -430,7 +450,7 @@ sub save { }; } 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] diff --git a/selfforum-cgi/user/fo_view.pl b/selfforum-cgi/user/fo_view.pl index 7470dc7..bc9190f 100644 --- 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, - 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 7dddc53..a37fbe5 100644 --- 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; -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})) { @@ -105,7 +105,7 @@ print_posting_as_HTML ( cgi => $cgi, tree => $tree, voted => $voted || '', - cachefile => $conf -> {files} -> {cacheFile} + cachepath => $conf -> {files} -> {cachePath} } );