/[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 77 by laperla, Mon Apr 8 21:00:08 2002 UTC revision 85 by ulpfr, Fri May 3 16:16:10 2002 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: Wed Jan 23 14:15:15 2002  # Last Modified On: Sat Apr 27 17:20:31 2002
8  # Language        : CPerl  # Language        : CPerl
9  # Update Count    : 152  # Update Count    : 172
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 DB_File;  use BerkeleyDB;
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 (-d  $self->{file}){    if (-e  $self->{file}){
163      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";  
164    }    }
165    
166    $self->{djk}      = $parm{djk}      if defined $parm{djk};    $self->{djk}      = $parm{djk}      if defined $parm{djk};
# Line 223  sub create_index { Line 221  sub create_index {
221    
222    my $name = join '-', @_;    my $name = join '-', @_;
223    $self->{indexes}->{$name} =    $self->{indexes}->{$name} =
224      new WAIT::Index file => $self->{file}.'/'.$name, attr => $_;      new WAIT::Index file => $self->{file}, name => $name, attr => $_;
225  }  }
226    
227  =head2 Creating an inverted index  =head2 Creating an inverted index
# Line 337  sub drop { Line 335  sub drop {
335      for (values %{$self->{indexes}}) {      for (values %{$self->{indexes}}) {
336        $_->drop;        $_->drop;
337      }      }
338      unlink "$file/records";      rmdir "$file.read" or warn "Could not rmdir '$file/read'";
339      rmdir "$file/read" or warn "Could not rmdir '$file/read'";      unlink "$file";
340        
     # $self->unlock;  
     ! (!-e $file or rmdir $file);  
341    } else {    } else {
342      croak ref($self)."::drop called directly";      croak ref($self)."::drop called directly";
343    }    }
# Line 384  sub open { Line 380  sub open {
380    
381    $self->getlock($self->{mode});    $self->getlock($self->{mode});
382    
383      my $dbmode = ($self->{mode} & O_CREAT) ? DB_CREATE : 0;
384    unless (defined $self->{dbh}) {    unless (defined $self->{dbh}) {
385      if ($USE_RECNO) {      if ($USE_RECNO) {
386        $self->{dbh} = tie(@{$self->{db}}, 'DB_File', $file,        tie(%{$self->{db}}, 'BerkeleyDB::Recno',
387                           $self->{mode}, 0664, $DB_RECNO);            -Filename => $self->{file},
388              -Subname  => 'records',
389              -Flags    => $dbmode);
390      } else {      } else {
391        $self->{dbh} =        $self->{dbh} =
392          tie(%{$self->{db}}, 'DB_File', $file,          tie(%{$self->{db}}, 'BerkeleyDB::Btree',
393                           $self->{mode}, 0664, $DB_BTREE);              -Filename => $self->{file},
394                -Subname  => 'records',
395                -Mode     => 0664,
396                -Flags    => $dbmode);
397      }      }
398    }    }
399        
# Line 675  sub getlock { Line 677  sub getlock {
677    # autoclean cleans on DESTROY, stale sends SIGZERO to the owner    # autoclean cleans on DESTROY, stale sends SIGZERO to the owner
678    #    #
679    my $lockmgr = LockFile::Simple->make(-autoclean => 1, -stale => 1);    my $lockmgr = LockFile::Simple->make(-autoclean => 1, -stale => 1);
680    my $file    = $self->{file} . '/records';    my $file    = $self->{file};
681    my $lockdir = $self->{file} . '/read';    my $lockdir = $self->{file} . '.read';
682    
683    unless (-d $lockdir) {    unless (-d $lockdir) {
684      mkdir $lockdir, 0755 or die "Could not mkdir $lockdir: $!";      mkdir $lockdir, 0755 or die "Could not mkdir $lockdir: $!";
# Line 697  sub getlock { Line 699  sub getlock {
699      }      }
700    
701      # Get the preliminary write lock      # Get the preliminary write lock
702      $self->{write_lock} = $lockmgr->lock($self->{file} . '/write')      $self->{write_lock} = $lockmgr->lock($self->{file} . '.write')
703        or die "Can't lock '$self->{file}/write'";        or die "Can't lock '$self->{file}.write'";
704            
705      # 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
706      # readers.  The write lock is confirmed if wen cannot find any      # readers.  The write lock is confirmed if wen cannot find any
# Line 727  sub getlock { Line 729  sub getlock {
729      # Get the preliminary write lock to protect the directory      # Get the preliminary write lock to protect the directory
730      # operations.      # operations.
731    
732      my $write_lock = $lockmgr->lock($self->{file} . '/read/write')      my $write_lock = $lockmgr->lock($self->{file} . '.read/write')
733        or die "Can't lock '$self->{file}/read/write'";        or die "Can't lock '$self->{file}.read/write'";
734    
735      # Find a new read slot.  Maybe the plain file would be better?      # Find a new read slot.  Maybe the plain file would be better?
736      my $id = time;      my $id = time;
Legend:
Removed from v.77  
changed lines
  Added in v.85
  ViewVC Help
Powered by ViewVC 1.1.26