view release on metacpan or  search on metacpan

lib/WAIT/Index.pm  view on Meta::CPAN

#                              -*- 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;