/usr/local/CPAN/WAIT/WAIT/Index.pm
# -*- Mode: Cperl -*-
# Index.pm --
# ITIID : $ITI$ $Header $__Header$
# Author : Ulrich Pfeifer
# Created On : Thu Aug 8 13:05:10 1996
# Last Modified By: Ulrich Pfeifer
# Last Modified On: Sun Nov 22 18:44:43 1998
# Language : CPerl
# Update Count : 107
# Status : Unknown, Use with caution!
#
# Copyright (c) 1996-1997, Ulrich Pfeifer
#
package WAIT::Index;
use WAIT::IndexScan;
use strict;
use DB_File;
use Fcntl;
sub new {
my $type = shift;
my %parm = @_;
my $self = {};
unless ($self->{file} = $parm{file}) {
require Carp;
Carp::croak("No file specified");
}
unless ($self->{attr} = $parm{attr}) {
require Carp;
Carp::croak("No attributes specified");
}
bless $self, ref($type) || $type;
}
sub drop {
my $self = shift;
if ((caller)[0] eq 'WAIT::Table') { # Table knows about this
my $file = $self->{file};
! (!-e $file or unlink $file);
} else { # notify our database
require Carp;
Carp::croak(ref($self)."::drop called directly");
}
}
sub open {
my $self = shift;
my $file = $self->{file};
if (exists $self->{dbh}) {
$self->{dbh};
} else {
$self->{dbh} = tie(%{$self->{db}}, 'DB_File', $file,
$self->{mode}, 0664, $DB_BTREE);
}
}
sub insert {
my $self = shift;
my $key = shift;
my %parm = @_;
defined $self->{db} or $self->open;
my $tuple = join($;, map($parm{$_}, @{$self->{attr}}));
if (exists $self->{db}->{$tuple}) {
# duplicate entry
return undef;
}
$self->{db}->{$tuple} = $key;
}
sub have {
my $self = shift;
my %parm = @_;
defined $self->{db} or $self->open;
my $tuple = join($;, map($parm{$_}, @{$self->{attr}}));
exists $self->{db}->{$tuple} && $self->{db}->{$tuple};
}
sub fetch {
my $self = shift;
my %parm = @_;
my @keys = @{$self->{attr}->[0]};
defined $self->{db} or $self->open;
my $key = join($;, map($parm{$_}, @keys));
$self->{db}->{$key};
}
sub delete {
my $self = shift;
my $key = shift;
my %parm = @_;
defined $self->{db} or $self->open;
my $tuple = join($;, map($parm{$_}||"", @{$self->{attr}}));
delete $self->{db}->{$tuple};
}
sub sync {
my $self = shift;
$self->{dbh}->sync if $self->{dbh};
}
sub close {
my $self = shift;
delete $self->{scans} if defined $self->{scans};
if ($self->{dbh}) {
delete $self->{dbh};
untie %{$self->{db}};
delete $self->{db};
}
}
#sub DESTROY { $_[0]->close }
sub open_scan {
my $self = shift;
my $code = shift;
$self->{dbh} or $self->open;
new WAIT::IndexScan $self, $code;
}
1;