/[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!
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 88 by dpavlin, Mon May 24 13:44:01 2004 UTC revision 89 by dpavlin, Mon May 24 20:57:08 2004 UTC
# Line 4  Line 4 
4  # Author          : Ulrich Pfeifer  # Author          : Ulrich Pfeifer
5  # Created On      : Thu Aug  8 13:05:10 1996  # Created On      : Thu Aug  8 13:05:10 1996
6  # Last Modified By: Ulrich Pfeifer  # Last Modified By: Ulrich Pfeifer
7  # Last Modified On: Sat Apr 27 17:20:31 2002  # Last Modified On: Wed Jan 23 14:15:15 2002
8  # Language        : CPerl  # Language        : CPerl
9  # Update Count    : 172  # Update Count    : 152
10  # Status          : Unknown, Use with caution!  # Status          : Unknown, Use with caution!
11  #  #
12  # Copyright (c) 1996-1997, Ulrich Pfeifer  # Copyright (c) 1996-1997, Ulrich Pfeifer
# Line 32  require WAIT::Parse::Base; Line 32  require WAIT::Parse::Base;
32  use strict;  use strict;
33  use Carp;  use Carp;
34  # use autouse Carp => qw( croak($) );  # use autouse Carp => qw( croak($) );
35  use BerkeleyDB;  use DB_File;
36  use Fcntl;  use Fcntl;
37  use LockFile::Simple ();  use LockFile::Simple ();
38    
# Line 159  sub new { Line 159  sub new {
159    }    }
160    
161    $self->{file}     = $parm{file}     or croak "No file specified";    $self->{file}     = $parm{file}     or croak "No file specified";
162    if (-e  $self->{file}){    if (-d  $self->{file}){
163      warn "Warning: file '$self->{file}' already exists\n";      warn "Warning: Directory '$self->{file}' already exists\n";
164      } elsif (!mkdir($self->{file}, 0775)) {
165        croak "Could not 'mkdir $self->{file}': $!\n";
166    }    }
167    
168    $self->{djk}      = $parm{djk}      if defined $parm{djk};    $self->{djk}      = $parm{djk}      if defined $parm{djk};
# Line 221  sub create_index { Line 223  sub create_index {
223    
224    my $name = join '-', @_;    my $name = join '-', @_;
225    $self->{indexes}->{$name} =    $self->{indexes}->{$name} =
226      new WAIT::Index file => $self->{file}, name => $name, attr => $_;      new WAIT::Index file => $self->{file}.'/'.$name, attr => $_;
227  }  }
228    
229  =head2 Creating an inverted index  =head2 Creating an inverted index
# Line 335  sub drop { Line 337  sub drop {
337      for (values %{$self->{indexes}}) {      for (values %{$self->{indexes}}) {
338        $_->drop;        $_->drop;
339      }      }
340      rmdir "$file.read" or warn "Could not rmdir '$file/read'";      unlink "$file/records";
341      unlink "$file";      rmdir "$file/read" or warn "Could not rmdir '$file/read'";
342        
343        # $self->unlock;
344        ! (!-e $file or rmdir $file);
345    } else {    } else {
346      croak ref($self)."::drop called directly";      croak ref($self)."::drop called directly";
347    }    }
# Line 380  sub open { Line 384  sub open {
384    
385    $self->getlock($self->{mode});    $self->getlock($self->{mode});
386    
   my $dbmode = ($self->{mode} & O_CREAT) ? DB_CREATE : 0;  
387    unless (defined $self->{dbh}) {    unless (defined $self->{dbh}) {
388      if ($USE_RECNO) {      if ($USE_RECNO) {
389        tie(%{$self->{db}}, 'BerkeleyDB::Recno',        $self->{dbh} = tie(@{$self->{db}}, 'DB_File', $file,
390            -Filename => $self->{file},                           $self->{mode}, 0664, $DB_RECNO);
           -Subname  => 'records',  
           -Flags    => $dbmode);  
391      } else {      } else {
392        $self->{dbh} =        $self->{dbh} =
393          tie(%{$self->{db}}, 'BerkeleyDB::Btree',          tie(%{$self->{db}}, 'DB_File', $file,
394              -Filename => $self->{file},                           $self->{mode}, 0664, $DB_BTREE);
             -Subname  => 'records',  
             -Mode     => 0664,  
             -Flags    => $dbmode);  
395      }      }
396    }    }
397        
# Line 678  sub getlock { Line 676  sub getlock {
676    # autoclean cleans on DESTROY, stale sends SIGZERO to the owner    # autoclean cleans on DESTROY, stale sends SIGZERO to the owner
677    #    #
678    my $lockmgr = LockFile::Simple->make(-autoclean => 1, -stale => 1);    my $lockmgr = LockFile::Simple->make(-autoclean => 1, -stale => 1);
679    my $file    = $self->{file};    my $file    = $self->{file} . '/records';
680    my $lockdir = $self->{file} . '.read';    my $lockdir = $self->{file} . '/read';
681    
682    unless (-d $lockdir) {    unless (-d $lockdir) {
683      mkdir $lockdir, 0755 or die "Could not mkdir $lockdir: $!";      mkdir $lockdir, 0755 or die "Could not mkdir $lockdir: $!";
# Line 700  sub getlock { Line 698  sub getlock {
698      }      }
699    
700      # Get the preliminary write lock      # Get the preliminary write lock
701      $self->{write_lock} = $lockmgr->lock($self->{file} . '.write')      $self->{write_lock} = $lockmgr->lock($self->{file} . '/write')
702        or die "Can't lock '$self->{file}.write'";        or die "Can't lock '$self->{file}/write'";
703            
704      # If we actually want to write we must check if there are any      # If we actually want to write we must check if there are any
705      # readers.  The write lock is confirmed if wen cannot find any      # readers.  The write lock is confirmed if wen cannot find any
# Line 730  sub getlock { Line 728  sub getlock {
728      # Get the preliminary write lock to protect the directory      # Get the preliminary write lock to protect the directory
729      # operations.      # operations.
730    
731      my $write_lock = $lockmgr->lock($self->{file} . '.read/write')      my $write_lock = $lockmgr->lock($self->{file} . '/read/write')
732        or die "Can't lock '$self->{file}.read/write'";        or die "Can't lock '$self->{file}/read/write'";
733    
734      # Find a new read slot.  Maybe the plain file would be better?      # Find a new read slot.  Maybe the plain file would be better?
735      my $id = time;      my $id = time;
Legend:
Removed from v.88  
changed lines
  Added in v.89
  ViewVC Help
Powered by ViewVC 1.1.26