lib/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 BerkeleyDB;
use Fcntl;
use Carp;
use vars qw($VERSION);

$VERSION = "2.000"; # Table.pm tests if we are loaded by checking $VERSION

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

  for my $x (qw(path attr env subname maindbfile tablename)) {
    unless ($self->{$x} = $parm{$x}) {
      require Carp;
      Carp::croak("No $x specified");
    }
  }
  bless $self, ref($type) || $type;
}

for my $accessor (qw(maindbfile tablename subname)) {
  no strict 'refs';
  *{$accessor} = sub {
    my($self) = @_;
    return $self->{$accessor} if $self->{$accessor};
    require Carp;
    Carp::confess("accessor $accessor not there");
  }
}

sub drop {
  my $self = shift;
  if ((caller)[0] eq 'WAIT::Table') { # Table knows about this
    my $path = $self->{path};
    ! (!-e $path or unlink $path);
  } else {                            # notify our database
    require Carp;
    Carp::croak(ref($self)."::drop called directly");
  }
}

sub open {
  my $self = shift;
  my $path = $self->{path};

  if (exists $self->{dbh}) {
    $self->{dbh};
  } else {
    my $flags;
    if ($self->{mode} & O_RDWR) {
      $flags = DB_CREATE; # | DB_INIT_MPOOL | DB_INIT_CDB;
      # warn "Flags on index $path set to 'writing'";
    } else {
      $flags = DB_RDONLY;
      # warn "Flags on index $path set to 'readonly'";
    }
    $self->{dbh} = tie(%{$self->{db}}, 'BerkeleyDB::Btree',
                       # Filename => $path,
                       Filename => $self->maindbfile,
                       $self->{env} ? (Env => $self->{env}) : (),
                       Subname => join("/",$self->tablename,$self->subname),
                       Mode => 0664,
                       Flags => $flags,
                       $WAIT::Database::Cachesize?(Cachesize => $WAIT::Database::Cachesize):(),
                       $WAIT::Database::Pagesize?(Pagesize => $WAIT::Database::Pagesize):(),
                      ) or die $BerkeleyDB::Error;
  }
}

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}}));

  $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;
  #warn "DEBUG: sync dbh[$self->{dbh}]";
  if ($self->{dbh}) {
        unless (defined($self->{dbh}->db_sync)) {
                carp "sync failed: $BerkeleyDB::Error";
        }
  } else {
        confess "sync called without dbh";
  }
}

sub close {
  my $self = shift;

  delete $self->{scans} if defined $self->{scans};

  delete $self->{env};
  if ($self->{dbh}) {
    delete $self->{dbh};
    untie %{$self->{db}};
    for my $att (qw(db path maindbfile)) {
      delete $self->{$att};
    }
  }
}

#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	# -- Mode: Cperl --
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 BerkeleyDB;
19	use Fcntl;
20	use Carp;
21	use vars qw($VERSION);
22
23	$VERSION = "2.000"; # Table.pm tests if we are loaded by checking $VERSION
24
25	sub new {
26	my $type = shift;
27	my %parm = @_;
28	my $self = {};
29
30	for my $x (qw(path attr env subname maindbfile tablename)) {
31	unless ($self->{$x} = $parm{$x}) {
32	require Carp;
33	Carp::croak("No $x specified");
34	}
35	}
36	bless $self, ref($type) \|\| $type;
37	}
38
39	for my $accessor (qw(maindbfile tablename subname)) {
40	no strict 'refs';
41	*{$accessor} = sub {
42	my($self) = @_;
43	return $self->{$accessor} if $self->{$accessor};
44	require Carp;
45	Carp::confess("accessor $accessor not there");
46	}
47	}
48
49	sub drop {
50	my $self = shift;
51	if ((caller)[0] eq 'WAIT::Table') { # Table knows about this
52	my $path = $self->{path};
53	! (!-e $path or unlink $path);
54	} else { # notify our database
55	require Carp;
56	Carp::croak(ref($self)."::drop called directly");
57	}
58	}
59
60	sub open {
61	my $self = shift;
62	my $path = $self->{path};
63
64	if (exists $self->{dbh}) {
65	$self->{dbh};
66	} else {
67	my $flags;
68	if ($self->{mode} & O_RDWR) {
69	$flags = DB_CREATE; # \| DB_INIT_MPOOL \| DB_INIT_CDB;
70	# warn "Flags on index $path set to 'writing'";
71	} else {
72	$flags = DB_RDONLY;
73	# warn "Flags on index $path set to 'readonly'";
74	}
75	$self->{dbh} = tie(%{$self->{db}}, 'BerkeleyDB::Btree',
76	# Filename => $path,
77	Filename => $self->maindbfile,
78	$self->{env} ? (Env => $self->{env}) : (),
79	Subname => join("/",$self->tablename,$self->subname),
80	Mode => 0664,
81	Flags => $flags,
82	$WAIT::Database::Cachesize?(Cachesize => $WAIT::Database::Cachesize):(),
83	$WAIT::Database::Pagesize?(Pagesize => $WAIT::Database::Pagesize):(),
84	) or die $BerkeleyDB::Error;
85	}
86	}
87
88	sub insert {
89	my $self = shift;
90	my $key = shift;
91	my %parm = @_;
92
93	defined $self->{db} or $self->open;
94
95	my $tuple = join($;, map($parm{$_}, @{$self->{attr}}));
96
97	if (exists $self->{db}->{$tuple}) {
98	# duplicate entry
99	return undef;
100	}
101	$self->{db}->{$tuple} = $key;
102	}
103
104	sub have {
105	my $self = shift;
106	my %parm = @_;
107
108	defined $self->{db} or $self->open;
109
110	my $tuple = join($;, map($parm{$_}, @{$self->{attr}}));
111
112	$self->{db}->{$tuple};
113	}
114
115	sub fetch {
116	my $self = shift;
117	my %parm = @_;
118	my @keys = @{$self->{attr}->[0]};
119
120	defined $self->{db} or $self->open;
121
122	my $key = join($;, map($parm{$_}, @keys));
123	$self->{db}->{$key};
124	}
125
126	sub delete {
127	my $self = shift;
128	my $key = shift;
129	my %parm = @_;
130
131	defined $self->{db} or $self->open;
132
133	my $tuple = join($;, map($parm{$_}\|\|"", @{$self->{attr}}));
134
135	delete $self->{db}->{$tuple};
136	}
137
138	sub sync {
139	my $self = shift;
140	#warn "DEBUG: sync dbh[$self->{dbh}]";
141	if ($self->{dbh}) {
142	unless (defined($self->{dbh}->db_sync)) {
143	carp "sync failed: $BerkeleyDB::Error";
144	}
145	} else {
146	confess "sync called without dbh";
147	}
148	}
149
150	sub close {
151	my $self = shift;
152
153	delete $self->{scans} if defined $self->{scans};
154
155	delete $self->{env};
156	if ($self->{dbh}) {
157	delete $self->{dbh};
158	untie %{$self->{db}};
159	for my $att (qw(db path maindbfile)) {
160	delete $self->{$att};
161	}
162	}
163	}
164
165	#sub DESTROY { $_[0]->close }
166
167	sub open_scan {
168	my $self = shift;
169	my $code = shift;
170
171	$self->{dbh} or $self->open;
172	new WAIT::IndexScan $self, $code;
173	}
174
175	1;