4 |
# Author : Ulrich Pfeifer |
# Author : Ulrich Pfeifer |
5 |
# Created On : Thu Aug 8 13:05:10 1996 |
# Created On : Thu Aug 8 13:05:10 1996 |
6 |
# Last Modified By: Ulrich Pfeifer |
# Last Modified By: Ulrich Pfeifer |
7 |
# Last Modified On: Mon May 8 20:20:58 2000 |
# Last Modified On: Fri May 19 14:51:14 2000 |
8 |
# Language : CPerl |
# Language : CPerl |
9 |
# Update Count : 131 |
# Update Count : 133 |
10 |
# Status : Unknown, Use with caution! |
# Status : Unknown, Use with caution! |
11 |
# |
# |
12 |
# Copyright (c) 1996-1997, Ulrich Pfeifer |
# Copyright (c) 1996-1997, Ulrich Pfeifer |
405 |
return $self if $self->{write_lock}; |
return $self if $self->{write_lock}; |
406 |
|
|
407 |
# If we actually want to write we must check if there are any readers |
# If we actually want to write we must check if there are any readers |
408 |
|
local *DIR; |
409 |
opendir DIR, $lockdir or |
opendir DIR, $lockdir or |
410 |
die "Could not opendir '$lockdir': $!"; |
die "Could not opendir '$lockdir': $!"; |
411 |
for my $lockfile (grep { -f "$lockdir/$_" } readdir DIR) { |
for my $lockfile (grep { -f "$lockdir/$_" } readdir DIR) { |
420 |
die "Cannot write table '$file' while it's in use"; |
die "Cannot write table '$file' while it's in use"; |
421 |
} |
} |
422 |
} |
} |
423 |
|
closedir DIR; |
424 |
} else { |
} else { |
425 |
# this is a hack. We do not check for reopening ... |
# this is a hack. We do not check for reopening ... |
426 |
return $self if $self->{read_lock}; |
return $self if $self->{read_lock}; |
611 |
} |
} |
612 |
|
|
613 |
sub unpack { |
sub unpack { |
614 |
my $self = shift; |
my($self, $tuple) = @_; |
615 |
my $tuple = shift; |
|
616 |
return unless defined $tuple; |
unless (defined $tuple){ |
617 |
|
# require Carp; # unfortunately gives us "bizarre copy...." :-((((( |
618 |
|
warn("Debug: somebody called unpack without argument tuple!"); |
619 |
|
return; |
620 |
|
} |
621 |
|
|
622 |
my $att; |
my $att; |
623 |
my @result; |
my @result; |
632 |
sub set { |
sub set { |
633 |
my ($self, $iattr, $value) = @_; |
my ($self, $iattr, $value) = @_; |
634 |
|
|
635 |
return unless $self->{write_lock}; |
unless ($self->{write_lock}){ |
636 |
|
warn "Cannot set iattr[$iattr] without write lock. Nothing done"; |
637 |
|
return; |
638 |
|
} |
639 |
for my $att (keys %{$self->{inverted}}) { |
for my $att (keys %{$self->{inverted}}) { |
640 |
if ($] > 5.003) { # avoid bug in perl up to 5.003_05 |
if ($] > 5.003) { # avoid bug in perl up to 5.003_05 |
641 |
my $idx; |
my $idx; |
656 |
if (exists $self->{'access'}) { |
if (exists $self->{'access'}) { |
657 |
eval {$self->{'access'}->close}; # dont bother if not opened |
eval {$self->{'access'}->close}; # dont bother if not opened |
658 |
} |
} |
659 |
for (values %{$self->{indexes}}) { |
if ($WAIT::Index::VERSION) { |
660 |
require WAIT::Index; |
for (values %{$self->{indexes}}) { |
661 |
$_->close(); |
$_->close(); |
662 |
|
} |
663 |
} |
} |
664 |
if (defined $self->{inverted}) { |
if (defined $self->{inverted} && $WAIT::InvertedIndex::VERSION) { |
665 |
|
# require WAIT::InvertedIndex; Uli: we can avoid closing indexes: |
666 |
|
# if WAIT::InvertedIndex has not been loaded, they cannot have |
667 |
|
# been altered so far |
668 |
my $att; |
my $att; |
669 |
for $att (keys %{$self->{inverted}}) { |
for $att (keys %{$self->{inverted}}) { |
670 |
if ($] > 5.003) { # avoid bug in perl up to 5.003_05 |
if ($] > 5.003) { # avoid bug in perl up to 5.003_05 |