/[wait]/trunk/lib/WAIT/Table.pm

This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!

Diff of /trunk/lib/WAIT/Table.pm

Parent Directory | Revision Log | View Patch Patch

-revision 42 by ulpfr,
Wed Nov 15 08:54:25 2000 UTC
+revision 86 by dpavlin,
Mon May 24 13:41:28 2004 UTC
 Line 4
  # Author          : Ulrich Pfeifer
  # Created On      : Thu Aug  8 13:05:10 1996
  # Last Modified By: Ulrich Pfeifer
- # Last Modified On: Tue Nov 14 16:19:17 2000
+ # Last Modified On: Sat Apr 27 17:20:31 2002
  # Language        : CPerl
- # Update Count    : 149
+ # Update Count    : 172
  # Status          : Unknown, Use with caution!
  #
  # Copyright (c) 1996-1997, Ulrich Pfeifer
 Line 32 
 require WAIT::Parse::Base;
  use strict;
  use Carp;
  # use autouse Carp => qw( croak($) );
- use DB_File;
+ use BerkeleyDB;
  use Fcntl;
  use LockFile::Simple ();
 Line 159 
 sub new {
    }
    $self->{file}     = $parm{file}     or croak "No file specified";
-   if (-d  $self->{file}){
+   if (-e  $self->{file}){
-     warn "Warning: Directory '$self->{file}' already exists\n";
+     warn "Warning: file '$self->{file}' already exists\n";
-   } elsif (!mkdir($self->{file}, 0775)) {
-     croak "Could not 'mkdir $self->{file}': $!\n";
    }
    $self->{djk}      = $parm{djk}      if defined $parm{djk};
-Line 223 
 sub create_index {
+Line 221 
 sub create_index {
    my $name = join '-', @_;
    $self->{indexes}->{$name} =
-     new WAIT::Index file => $self->{file}.'/'.$name, attr => $_;
+     new WAIT::Index file => $self->{file}, name => $name, attr => $_;
  }
  =head2 Creating an inverted index
-Line 337 
 sub drop {
+Line 335 
 sub drop {
      for (values %{$self->{indexes}}) {
        $_->drop;
      }
-     unlink "$file/records";
+     rmdir "$file.read" or warn "Could not rmdir '$file/read'";
-     rmdir "$file/read" or warn "Could not rmdir '$file/read'";
+     unlink "$file";
-     # $self->unlock;
-     ! (!-e $file or rmdir $file);
    } else {
      croak ref($self)."::drop called directly";
    }
-Line 384 
 sub open {
+Line 380 
 sub open {
    $self->getlock($self->{mode});
+   my $dbmode = ($self->{mode} & O_CREAT) ? DB_CREATE : 0;
    unless (defined $self->{dbh}) {
      if ($USE_RECNO) {
-       $self->{dbh} = tie(@{$self->{db}}, 'DB_File', $file,
+       tie(%{$self->{db}}, 'BerkeleyDB::Recno',
-                          $self->{mode}, 0664, $DB_RECNO);
+           -Filename => $self->{file},
+           -Subname  => 'records',
+           -Flags    => $dbmode);
      } else {
        $self->{dbh} =
-         tie(%{$self->{db}}, 'DB_File', $file,
+         tie(%{$self->{db}}, 'BerkeleyDB::Btree',
-                          $self->{mode}, 0664, $DB_BTREE);
+             -Filename => $self->{file},
+             -Subname  => 'records',
+             -Mode     => 0664,
+             -Flags    => $dbmode);
      }
    }
-Line 597 
 sub set {
+Line 599 
 sub set {
      warn "Cannot set iattr[$iattr] without write lock. Nothing done";
      return;
    }
+   # in the rare case that they haven't written a single record yet, we
+   # make sure, the inverted inherits our $self->{mode}:
+   defined $self->{db} or $self->open;
    for my $att (keys %{$self->{inverted}}) {
-     if ($] > 5.003) {         # avoid bug in perl up to 5.003_05
+     require WAIT::InvertedIndex;
+     if ($^V gt v5.003) {         # avoid bug in perl up to 5.003_05
        my $idx;
        for $idx (@{$self->{inverted}->{$att}}) {
          $idx->set($iattr, $value);
-Line 670 
 sub getlock {
+Line 678 
 sub getlock {
    # autoclean cleans on DESTROY, stale sends SIGZERO to the owner
    #
    my $lockmgr = LockFile::Simple->make(-autoclean => 1, -stale => 1);
-   my $file    = $self->{file} . '/records';
+   my $file    = $self->{file};
-   my $lockdir = $self->{file} . '/read';
+   my $lockdir = $self->{file} . '.read';
    unless (-d $lockdir) {
      mkdir $lockdir, 0755 or die "Could not mkdir $lockdir: $!";
-Line 692 
 sub getlock {
+Line 700 
 sub getlock {
      }
      # Get the preliminary write lock
-     $self->{write_lock} = $lockmgr->lock($self->{file} . '/write')
+     $self->{write_lock} = $lockmgr->lock($self->{file} . '.write')
-       or die "Can't lock '$self->{file}/write'";
+       or die "Can't lock '$self->{file}.write'";
      # If we actually want to write we must check if there are any
      # readers.  The write lock is confirmed if wen cannot find any
-Line 720 
 sub getlock {
+Line 728 
 sub getlock {
      return $self if $self->{read_lock};
      # Get the preliminary write lock to protect the directory
-     # operations.  If we already have a write lock, it will go.
+     # operations.
-     $self->{write_lock} ||= $lockmgr->lock($self->{file} . '/write')
+     my $write_lock = $lockmgr->lock($self->{file} . '.read/write')
-       or die "Can't lock '$self->{file}/write'";
+       or die "Can't lock '$self->{file}.read/write'";
      # Find a new read slot.  Maybe the plain file would be better?
      my $id = time;
-Line 735 
 sub getlock {
+Line 743 
 sub getlock {
        or die "Can't lock '$lockdir/$id'";
      # We are a reader now. So we release the write lock
-     $self->{write_lock}->release;
+     $write_lock->release;
-     delete $self->{write_lock};
    }
    return $self;
  }

 Legend:



Removed from v.42
 


changed lines


 
Added in v.86
 Legend:



Removed from v.42
 


changed lines


 
Added in v.86
-Removed from v.42
+Added in v.86

	ViewVC Help
Powered by ViewVC 1.1.26