view release on metacpan or  search on metacpan

Boulder/Store.pm  view on Meta::CPAN

The index is stored in an external file with the extension ".index".
An index file is created even if you haven't indexed any tags.

=item $store->reindex_all()

Call this if the index gets screwed up (or lost).  It rebuilds it
from scratch.

=back

=head1 CAVEATS

Boulder::Store makes heavy use of the flock() call in order to avoid
corruption of DB_File databases when multiple processes try to write
simultaneously.  flock() may not work correctly across NFS mounts,
particularly on Linux machines that are not running the rpc.lockd
daemon.  Please confirm that your flock() works across NFS before
attempting to use Boulder::Store.  If the store.t test hangs during
testing, this is the likely culprit.

=head1 AUTHOR

Lincoln D. Stein <lstein@cshl.org>, Cold Spring Harbor Laboratory,
Cold Spring Harbor, NY.  This module can be used and distributed on
the same terms as Perl itself.

=head1 SEE ALSO

L<Boulder>, L<Boulder::Stream>, L<Stone>

=cut

use Boulder::Stream;
use Carp;
use Fcntl;
use DB_File;

$VERSION = '1.20';

@ISA = 'Boulder::Stream';
$lockfh='lock00000';
$LOCK_SH = 1;
$LOCK_EX = 2;
$LOCK_UN = 8;

# Override the old new() method.
# There is no passthrough behavior in the database version,
# because this is usually undesirable.
# In this case,$in is the pathname to the database to open.
sub new {
    my($package,$in,$writable) = @_;
    my $self = bless {
	'records'=>undef,	# filled in by _open_databases
	'dbrecno'=>undef,	# filled in by _open_databases
	'index'=>undef,		# filled in by _open_databases
	'writable'=>$writable,
	'basename'=>$in,
	'passthru'=>undef,
	'binary'=>'true',
	'nextrecord'=>0,	# next record to retrieve during iterations
	'query_records'=>undef,	# list of records during optimized queries
	'query_test'=>undef,	# an expression to apply to each record during a query
	'IN'=>undef,
	'OUT'=>undef,
	'delim'=>'=',
	'record_stop'=>"\n",
	'line_end'=>'&',
        'index_delim'=>' ',
	'subrec_start'=>"\{",
	'subrec_end'=>"\}"
	},$package;
    return undef unless _lock($self,'lock');
    return _open_databases($self,$in) ? $self : undef;
}

sub DESTROY {
    my $self = shift;
    undef $self->{'dbrecno'};
    untie %{$self->{'index'}};
    untie @{$self->{'records'}};
    _lock($self,'unlock');
}

#####################
# private routines
####################
# Obtain exclusive privileges if database is
# writable.  Otherwise obtain shared privileges.
# Note that this call does not work across file systems,
# at least on non-linux systems.  Should use fcntl()
# instead (but don't have Stevens at hand).
sub _lock {
    my($self,$lockit) = @_;
    my $in = $self->{'basename'};
    my $lockfilename = "$in.lock";
    if ($lockit eq 'lock') {
	$lockfh++;
	open($lockfh,"+>$lockfilename") || return undef;
	$self->{'lockfh'}=$lockfh;
	return flock($lockfh,$self->{'writable'} ? $LOCK_EX : $LOCK_SH);
    } else {
	my $lockfh = $self->{'lockfh'};
	unlink $lockfilename;
	flock($lockfh,$LOCK_UN);
	close($lockfh);
	1;
    }
}

sub _open_databases {
    my $self = shift;

    # Try to open up and/or create the recno and index files
    my($in)=$self->{'basename'};
    my (@records,%index);
    my ($permissions) = $self->{'writable'} ? (O_RDWR|O_CREAT) : O_RDONLY;
    $self->{'dbrecno'} = tie(@records,DB_File,"$in.data",
			     $permissions,0640,$DB_RECNO) || return undef;
    tie(%index,DB_File,"$in.index",$permissions,0640,$DB_HASH) || return undef;