lib/WAIT/Index.pm

#                              -*- Mode: Perl -*- 
# 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 fail {
  $@ .= join "\n", @_;
  return undef;
}

sub new {
  my $type = shift;
  my %parm = @_;
  my $self = {};

  $self->{file}     = $parm{file}     or return fail("No file specified");
  $self->{attr}     = $parm{attr}     or return fail("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
    fail 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;
1	ulpfr	10	# -- Mode: Perl --
2			# Index.pm --
3			# ITIID : $ITI$ $Header $__Header$
4			# Author : Ulrich Pfeifer
5			# Created On : Thu Aug 8 13:05:10 1996
6			# Last Modified By: Ulrich Pfeifer
7			# Last Modified On: Sun Nov 22 18:44:43 1998
8			# Language : CPerl
9			# Update Count : 107
10			# Status : Unknown, Use with caution!
11			#
12			# Copyright (c) 1996-1997, Ulrich Pfeifer
13			#
14
15			package WAIT::Index;
16			use WAIT::IndexScan;
17			use strict;
18			use DB_File;
19			use Fcntl;
20
21			sub fail {
22			$@ .= join "\n", @_;
23			return undef;
24			}
25
26			sub new {
27			my $type = shift;
28			my %parm = @_;
29			my $self = {};
30
31			$self->{file} = $parm{file} or return fail("No file specified");
32			$self->{attr} = $parm{attr} or return fail("No attributes specified");
33			bless $self, ref($type) \|\| $type;
34			}
35
36			sub drop {
37			my $self = shift;
38			if ((caller)[0] eq 'WAIT::Table') { # Table knows about this
39			my $file = $self->{file};
40
41			! (!-e $file or unlink $file);
42			} else { # notify our database
43			fail ref($self)."::drop called directly";
44			}
45			}
46
47			sub open {
48			my $self = shift;
49			my $file = $self->{file};
50
51			if (exists $self->{dbh}) {
52			$self->{dbh};
53			} else {
54			$self->{dbh} = tie(%{$self->{db}}, 'DB_File', $file,
55			$self->{mode}, 0664, $DB_BTREE);
56			}
57			}
58
59			sub insert {
60			my $self = shift;
61			my $key = shift;
62			my %parm = @_;
63
64			defined $self->{db} or $self->open;
65
66			my $tuple = join($;, map($parm{$_}, @{$self->{attr}}));
67
68			if (exists $self->{db}->{$tuple}) {
69			# duplicate entry
70			return undef;
71			}
72			$self->{db}->{$tuple} = $key;
73			}
74
75			sub have {
76			my $self = shift;
77			my %parm = @_;
78
79			defined $self->{db} or $self->open;
80
81			my $tuple = join($;, map($parm{$_}, @{$self->{attr}}));
82
83			exists $self->{db}->{$tuple} && $self->{db}->{$tuple};
84			}
85
86			sub fetch {
87			my $self = shift;
88			my %parm = @_;
89			my @keys = @{$self->{attr}->[0]};
90
91			defined $self->{db} or $self->open;
92
93			my $key = join($;, map($parm{$_}, @keys));
94			$self->{db}->{$key};
95			}
96
97			sub delete {
98			my $self = shift;
99			my $key = shift;
100			my %parm = @_;
101
102			defined $self->{db} or $self->open;
103
104			my $tuple = join($;, map($parm{$_}, @{$self->{attr}}));
105
106			delete $self->{db}->{$tuple};
107			}
108
109			sub sync {
110			my $self = shift;
111			$self->{dbh}->sync if $self->{dbh};
112			}
113
114			sub close {
115			my $self = shift;
116
117			delete $self->{scans} if defined $self->{scans};
118
119			if ($self->{dbh}) {
120			delete $self->{dbh};
121			untie %{$self->{db}};
122			delete $self->{db};
123			}
124			}
125
126			#sub DESTROY { $_[0]->close }
127
128			sub open_scan {
129			my $self = shift;
130			my $code = shift;
131
132			$self->{dbh} or $self->open;
133			new WAIT::IndexScan $self, $code;
134			}
135
136			1;