/[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

cvs-head/lib/WAIT/Table.pm revision 77 by laperla, Mon Apr 8 21:00:08 2002 UTC trunk/lib/WAIT/Table.pm revision 88 by dpavlin, Mon May 24 13:44:01 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: 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 603  sub set { Line 605  sub set {
605    defined $self->{db} or $self->open;    defined $self->{db} or $self->open;
606    
607    for my $att (keys %{$self->{inverted}}) {    for my $att (keys %{$self->{inverted}}) {
608      if ($] > 5.003) {         # avoid bug in perl up to 5.003_05      require WAIT::InvertedIndex;
609        if ($^V gt v5.003) {         # avoid bug in perl up to 5.003_05
610        my $idx;        my $idx;
611        for $idx (@{$self->{inverted}->{$att}}) {        for $idx (@{$self->{inverted}->{$att}}) {
612          $idx->set($iattr, $value);          $idx->set($iattr, $value);
# Line 675  sub getlock { Line 678  sub getlock {
678    # autoclean cleans on DESTROY, stale sends SIGZERO to the owner    # autoclean cleans on DESTROY, stale sends SIGZERO to the owner
679    #    #
680    my $lockmgr = LockFile::Simple->make(-autoclean => 1, -stale => 1);    my $lockmgr = LockFile::Simple->make(-autoclean => 1, -stale => 1);
681    my $file    = $self->{file} . '/records';    my $file    = $self->{file};
682    my $lockdir = $self->{file} . '/read';    my $lockdir = $self->{file} . '.read';
683    
684    unless (-d $lockdir) {    unless (-d $lockdir) {
685      mkdir $lockdir, 0755 or die "Could not mkdir $lockdir: $!";      mkdir $lockdir, 0755 or die "Could not mkdir $lockdir: $!";
# Line 697  sub getlock { Line 700  sub getlock {
700      }      }
701    
702      # Get the preliminary write lock      # Get the preliminary write lock
703      $self->{write_lock} = $lockmgr->lock($self->{file} . '/write')      $self->{write_lock} = $lockmgr->lock($self->{file} . '.write')
704        or die "Can't lock '$self->{file}/write'";        or die "Can't lock '$self->{file}.write'";
705            
706      # 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
707      # 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 730  sub getlock {
730      # Get the preliminary write lock to protect the directory      # Get the preliminary write lock to protect the directory
731      # operations.      # operations.
732    
733      my $write_lock = $lockmgr->lock($self->{file} . '/read/write')      my $write_lock = $lockmgr->lock($self->{file} . '.read/write')
734        or die "Can't lock '$self->{file}/read/write'";        or die "Can't lock '$self->{file}.read/write'";
735    
736      # Find a new read slot.  Maybe the plain file would be better?      # Find a new read slot.  Maybe the plain file would be better?
737      my $id = time;      my $id = time;
Legend:
Removed from v.77  
changed lines
  Added in v.88
  ViewVC Help
Powered by ViewVC 1.1.26