use strict;
use Fcntl;
+use File::Path;
use Lock qw(:ALL);
my $O_BINARY = eval "O_BINARY";
#
# Constructor
#
-# Params: $filename - full qualified cache file name
+# Params: $pathname - full qualified cache path
#
# Return: Posting::Cache object
#
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;
}
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 ###################################################################
#
# 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,
time => $_->[0] || 0,
IP => $_->[1] || 0
}
- } [split /;/]
- } split ' ' => $buf
+ } [split ' ']
+ } @records
}
};
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
#
# 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,
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 ############################################################
#
# 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)
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
git.p6c8.net / selfforum.git / blobdiff