X-Git-Url: https://git.p6c8.net/selfforum.git/blobdiff_plain/050483c4525eb50f57ef5c5c3a33345a5846b4a4..c6b8e3075d2fd6cd5ef345aa686a68cc899eb5fe:/selfforum-cgi/shared/Posting/Cache.pm 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