--- /dev/null
+package Posting::Cache;
+
+################################################################################
+# #
+# File: shared/Posting/Cache.pm #
+# #
+# Authors: André Malo <nd@o3media.de>, 2001-04-21 #
+# #
+# Description: Views/Voting Cache class #
+# #
+################################################################################
+
+use strict;
+
+use Fcntl;
+use Lock qw(:ALL);
+
+my $O_BINARY = eval "O_BINARY";
+$O_BINARY = 0 if ($@);
+
+### sub new ####################################################################
+#
+# Constructor
+#
+# Params: $filename - full qualified cache file name
+#
+# Return: Posting::Cache object
+#
+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;
+}
+
+### sub clear_error ############################################################
+#
+# clear verbal error data
+#
+# Params: ~none~
+#
+# Return: ~none~
+#
+sub clear_error {
+ my $self = shift;
+
+ $self -> {verb_error} = undef;
+
+ return;
+}
+
+sub error {$_[0]->{verb_error}}
+
+sub set_error {
+ my $self = shift;
+
+ $self -> {verb_error} = +shift;
+
+ return;
+}
+
+### sub set_file ###############################################################
+#
+# set cache file name
+#
+# Params: $filename - full qualified cache file name
+#
+sub set_file {
+ my ($self, $filename) = @_;
+
+ $self -> {cachefile} = $filename;
+
+ return;
+}
+
+sub cachefile {$_[0] -> {cachefile}}
+sub indexfile {$_[0] -> cachefile . '.index'}
+sub temp_cachefile {$_[0] -> cachefile . '.temp'}
+sub temp_indexfile {$_[0] -> indexfile . '.temp'}
+
+### sub find_pos ($$) ##########################################################
+#
+# find position in cache file
+# (binary search in index file)
+#
+# Params: $handle - index 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 ($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 ($num, $found) = unpack 'L2',$buf;
+
+ if ($num == $posting) {
+ return $found;
+ }
+ elsif ($num < $posting) {
+ $start = $current+1
+ }
+ else {
+ $end = $current-1
+ }
+ }
+
+ return;
+}
+
+### sub add_view ###############################################################
+#
+# increment the views-counter
+#
+# Params: ~none~
+#
+# Return: Status code (Bool)
+#
+sub r_add_view {
+ my ($self, $h, $param) = @_;
+ my ($C, $I) = ($h->{C}, $h->{I});
+ my $reclen = 4 * length pack 'L', 0;
+ my $pos;
+ defined ($pos = find_pos $I, $param->{posting}) or return;
+
+ my $buf;
+ seek $C, $pos, 0 or return;
+ read ($C, $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;
+
+ 1;
+}
+
+sub add_view {
+ my ($self, $param) = @_;
+
+ $self -> write_wrap (
+ \&r_add_view,
+ $param
+ );
+}
+
+### sub pick ###################################################################
+#
+# read information of one posting
+#
+# Params: $param - hash reference
+# (thread, posting)
+#
+# Return: hash reference or false
+#
+sub r_pick {
+ my ($self, $h, $param) = @_;
+ my ($C, $I) = ($h->{C}, $h->{I});
+ my $reclen = 4 * length pack 'L', 0;
+ my ($buf, $pos);
+ local $/="\012";
+
+ defined($pos = find_pos $I, $param->{posting}) or return;
+
+ seek $C, $pos, 0 or return;
+ read ($C, $buf, $reclen) == $reclen or return;
+
+ my ($posting, $thread, $views, $votings) = unpack 'L4', $buf;
+ $buf = <$C>; chomp $buf;
+ $self -> {pick} = {
+ views => $views,
+ votings => $votings,
+ voteRef => {
+ map {
+ map {
+ $_->[2] => {
+ time => $_->[0] || 0,
+ IP => $_->[1] || 0
+ }
+ } [split /;/]
+ } split ' ' => $buf
+ }
+ };
+
+ # looks good
+ 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
+#
+# Params: ~none~
+#
+# 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;
+
+ seek $C, $pos, 0 or return;
+ read ($C, $buf, $creclen) == $creclen or return;
+
+ my ($posting, $thread, $views, $votings) = unpack 'L4', $buf;
+ $hash{$thread} = {} unless $hash{$thread};
+ $hash{$thread} -> {$posting} = {
+ views => $views,
+ votings => $votings
+ };
+ }
+
+ $self -> {summary} = \%hash;
+
+ # looks good
+ 1;
+}
+
+sub summary {
+ my $self = shift;
+
+ $self -> read_wrap (\&r_summary)
+ ? $self -> {summary}
+ : return;
+}
+
+### sub repair_cache ###########################################################
+#
+# check on cache consistance and repair if broken
+#
+# Params: ~none~
+#
+# Return: sucess 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;
+ }
+
+ 1;
+}
+
+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);
+
+ local *FILE;
+ return unless (open FILE, '>'.$self->cachefile);
+ return unless (close FILE);
+ return unless (open FILE, '>'.$self->indexfile);
+ return unless (close FILE);
+
+ release_file ($self->cachefile);
+ release_file ($self->indexfile);
+ release_file ($self->temp_indexfile);
+ release_file ($self->temp_cachefile);
+
+ return 1;
+ }
+
+ $self -> open_wrap (\&r_repair_cache);
+}
+
+### sub add_posting ############################################################
+#
+# add an empty cache entry of a posting
+#
+# Params: $param - hash reference
+# (thread, posting)
+#
+# Return: Status code (Bool)
+#
+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";
+ 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;
+ }
+ continue {
+ my $rest = <$C>;
+ chomp $rest;
+ print $TC $block. $rest. $/;
+ print $TI pack ('L2' => $msg, $pos);
+ $pos = tell $TC;
+ }
+ unless ($ins) {
+ print $TC pack('L4' => $param->{posting}, $param->{thread}, 0, 0), $/;
+ print $TI pack('L2' => $param->{posting}, $pos);
+ }
+
+ 1;
+}
+
+sub add_posting {
+ my $self = shift;
+ $self -> open_wrap (
+ \&r_add_posting,
+ @_
+ );
+}
+
+### sub add_voting #############################################################
+#
+# add a voting (increment vote counter and log the vote data)
+#
+# Params: $param - hash reference
+# (thread, posting, IP, time, ID)
+#
+# 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++;
+ };
+
+ print $TC pack ('L4' => ($msg, $thread, $views, $votings)), $rest, $/;
+ print $TI pack ('L2' => $msg, $pos);
+ $pos = tell $TC;
+ }
+
+ 1;
+}
+
+sub add_voting {
+ my $self = shift;
+ $self -> open_wrap (
+ \&r_add_voting,
+ @_
+ );
+}
+
+### sub open_wrap ##############################################################
+#
+# file lock, open, execute, close, unlock wrapper
+# for writing into temp files
+#
+# Params: $gosub - sub reference (for execution)
+# @param - params (for $gosub)
+#
+# Return: Status code (Bool)
+#
+sub open_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);
+ }
+ 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);
+ }
+ else {
+ unless (lock_file ($self->cachefile)) {
+ violent_unlock_file ($self->cachefile);
+ $self->set_error ('could not read-lock cache file '.$self->cachefile);
+ }
+ 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, *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));
+ }
+ 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));
+ }
+
+ # return
+ $status;
+}
+
+### sub read_wrap ##############################################################
+#
+# file lock, open, execute, close, unlock wrapper
+# for reading
+#
+# Params: $gosub - sub reference (for execution)
+# @param - params (for $gosub)
+#
+# Return: Status code (Bool)
+#
+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);
+ }
+ 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_RDONLY | $O_BINARY)) {
+ $self->set_error ('could not open to read 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));
+ }
+ violent_unlock_file ($self->cachefile) unless (unlock_file ($self->cachefile));
+ }
+
+ # return
+ $status;
+}
+
+### sub write_wrap ##############################################################
+#
+# file lock, open, execute, close, unlock wrapper
+# for reading
+#
+# Params: $gosub - sub reference (for execution)
+# @param - params (for $gosub)
+#
+# Return: Status code (Bool)
+#
+sub write_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);
+ }
+ else {
+ unless (write_lock_file ($self->cachefile)) {
+ violent_unlock_file ($self->cachefile);
+ $self->set_error ('could not write-lock cache file '.$self->cachefile);
+ }
+ 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));
+ }
+ violent_unlock_file ($self->cachefile) unless (write_unlock_file ($self->cachefile));
+ }
+ violent_unlock_file ($self->temp_cachefile) unless (write_unlock_file ($self->temp_cachefile));
+ }
+
+ # return
+ $status;
+}
+
+# keep 'require' happy
+#
+1;
+
+#
+#
+### end of Posting::Cache ######################################################
\ No newline at end of file
git.p6c8.net / selfforum.git / commitdiff