--- branches/CPAN/lib/WAIT/Index.pm	2000/04/28 15:41:10	11
+++ trunk/lib/WAIT/Index.pm	2004/05/24 13:44:01	88
@@ -1,12 +1,12 @@
-#                              -*- Mode: Perl -*- 
+#                              -*- 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
+# Last Modified On: Sat Apr 27 18:06:47 2002
 # Language        : CPerl
-# Update Count    : 107
+# Update Count    : 128
 # Status          : Unknown, Use with caution!
 # 
 # Copyright (c) 1996-1997, Ulrich Pfeifer
@@ -15,21 +15,29 @@
 package WAIT::Index;
 use WAIT::IndexScan;
 use strict;
-use DB_File;
+use BerkeleyDB;
 use Fcntl;
+use vars qw($VERSION);
 
-sub fail {
-  $@ .= join "\n", @_;
-  return undef;
-}
+$VERSION = "1.801"; # Table.pm tests if we are loaded by checking $VERSION
 
 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");
+  unless ($self->{file} = $parm{file}) {
+    require Carp;
+    Carp::croak("No file specified");
+  }
+  unless ($self->{name} = $parm{name}) {
+    require Carp;
+    Carp::croak("No name specified");
+  }
+  unless ($self->{attr} = $parm{attr}) {
+    require Carp;
+    Carp::croak("No attributes specified");
+  }
   bless $self, ref($type) || $type;
 }
 
@@ -37,10 +45,10 @@
   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";
+  } else {                            # notify our database
+    require Carp;
+    Carp::croak(ref($self)."::drop called directly");
   }
 }
 
@@ -48,11 +56,15 @@
   my $self = shift;
   my $file = $self->{file};
 
-  if (exists $self->{dbh}) {
+  if ($self->{dbh}) {
     $self->{dbh};
   } else {
-    $self->{dbh} = tie(%{$self->{db}}, 'DB_File', $file,
-                       $self->{mode}, 0664, $DB_BTREE);
+    my $dbmode = ($self->{mode} & O_CREAT) ? DB_CREATE : 0;
+    $self->{dbh} = tie(%{$self->{db}}, 'BerkeleyDB::Btree',
+                       -Filename => $self->{file},
+                       -Subname  => 'records',
+                       -Flags    => $dbmode,
+                       -Mode     => 0664);
   }
 }
 
@@ -69,6 +81,7 @@
     # duplicate entry
     return undef;
   }
+  print STDERR "$tuple => $key\n";
   $self->{db}->{$tuple} = $key;
 }
 
@@ -80,14 +93,15 @@
 
   my $tuple = join($;, map($parm{$_}, @{$self->{attr}}));
 
-  exists $self->{db}->{$tuple} && $self->{db}->{$tuple};
+  print STDERR "$tuple <= ", $self->{db}->{$tuple}, "\n";
+  $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));
@@ -101,14 +115,14 @@
 
   defined $self->{db} or $self->open;
 
-  my $tuple = join($;, map($parm{$_}, @{$self->{attr}}));
-  
+  my $tuple = join($;, map($parm{$_}||"", @{$self->{attr}}));
+
   delete $self->{db}->{$tuple};
 }
 
 sub sync {
   my $self = shift;
-  $self->{dbh}->sync if $self->{dbh};
+  $self->{dbh}->db_sync if $self->{dbh};
 }
 
 sub close {
@@ -118,8 +132,8 @@
 
   if ($self->{dbh}) {
     delete $self->{dbh};
-    untie %{$self->{db}};
     delete $self->{db};
+    #untie %{$self->{db}};
   }
 }
 
@@ -128,7 +142,7 @@
 sub open_scan {
   my $self = shift;
   my $code = shift;
-  
+
   $self->{dbh} or $self->open;
   new WAIT::IndexScan $self, $code;
 }