/[wait]/trunk/lib/WAIT/Index.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/Index.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 108 by dpavlin, Tue Jul 13 17:41:12 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 18:06:47 2002  # Last Modified On: Sun Nov 22 18:44:43 1998
8  # Language        : CPerl  # Language        : CPerl
9  # Update Count    : 128  # Update Count    : 107
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 19  use BerkeleyDB; Line 19  use BerkeleyDB;
19  use Fcntl;  use Fcntl;
20  use vars qw($VERSION);  use vars qw($VERSION);
21    
22  $VERSION = "1.801"; # Table.pm tests if we are loaded by checking $VERSION  $VERSION = "2.000"; # Table.pm tests if we are loaded by checking $VERSION
23    
24  sub new {  sub new {
25    my $type = shift;    my $type = shift;
26    my %parm = @_;    my %parm = @_;
27    my $self = {};    my $self = {};
28    
29    unless ($self->{file} = $parm{file}) {    for my $x (qw(file attr env subname maindbfile tablename)) {
30      require Carp;      unless ($self->{$x} = $parm{$x}) {
31      Carp::croak("No file specified");        require Carp;
32    }        Carp::croak("No $x specified");
33    unless ($self->{name} = $parm{name}) {      }
     require Carp;  
     Carp::croak("No name specified");  
34    }    }
35    unless ($self->{attr} = $parm{attr}) {    bless $self, ref($type) || $type;
36    }
37    
38    for my $accessor (qw(maindbfile tablename subname)) {
39      no strict 'refs';
40      *{$accessor} = sub {
41        my($self) = @_;
42        return $self->{$accessor} if $self->{$accessor};
43      require Carp;      require Carp;
44      Carp::croak("No attributes specified");      Carp::confess("accessor $accessor not there");
45    }    }
   bless $self, ref($type) || $type;  
46  }  }
47    
48  sub drop {  sub drop {
# Line 56  sub open { Line 60  sub open {
60    my $self = shift;    my $self = shift;
61    my $file = $self->{file};    my $file = $self->{file};
62    
63    if ($self->{dbh}) {    if (exists $self->{dbh}) {
64      $self->{dbh};      $self->{dbh};
65    } else {    } else {
66      my $dbmode = ($self->{mode} & O_CREAT) ? DB_CREATE : 0;      my $flags;
67        if ($self->{mode} & O_RDWR) {
68          $flags = DB_CREATE; # | DB_INIT_MPOOL | DB_INIT_CDB;
69          # warn "Flags on index $file set to 'writing'";
70        } else {
71          $flags = DB_RDONLY;
72          # warn "Flags on index $file set to 'readonly'";
73        }
74      $self->{dbh} = tie(%{$self->{db}}, 'BerkeleyDB::Btree',      $self->{dbh} = tie(%{$self->{db}}, 'BerkeleyDB::Btree',
75                         -Filename => $self->{file},                         # Filename => $file,
76                         -Subname  => 'records',                         Filename => $self->maindbfile,
77                         -Flags    => $dbmode,                         $self->{env} ? (Env => $self->{env}) : (),
78                         -Mode     => 0664);                         Subname => join("/",$self->tablename,$self->subname),
79                           Mode => 0664,
80                           Flags => $flags,
81                           $WAIT::Database::Cachesize?(Cachesize => $WAIT::Database::Cachesize):(),
82                           $WAIT::Database::Pagesize?(Pagesize => $WAIT::Database::Pagesize):(),
83                          ) or die $BerkeleyDB::Error;
84    }    }
85  }  }
86    
# Line 81  sub insert { Line 97  sub insert {
97      # duplicate entry      # duplicate entry
98      return undef;      return undef;
99    }    }
   print STDERR "$tuple => $key\n";  
100    $self->{db}->{$tuple} = $key;    $self->{db}->{$tuple} = $key;
101  }  }
102    
# Line 93  sub have { Line 108  sub have {
108    
109    my $tuple = join($;, map($parm{$_}, @{$self->{attr}}));    my $tuple = join($;, map($parm{$_}, @{$self->{attr}}));
110    
   print STDERR "$tuple <= ", $self->{db}->{$tuple}, "\n";  
111    $self->{db}->{$tuple};    $self->{db}->{$tuple};
112  }  }
113    
# Line 122  sub delete { Line 136  sub delete {
136    
137  sub sync {  sub sync {
138    my $self = shift;    my $self = shift;
139    $self->{dbh}->db_sync if $self->{dbh};    $self->{dbh}->sync if $self->{dbh};
140  }  }
141    
142  sub close {  sub close {
# Line 130  sub close { Line 144  sub close {
144    
145    delete $self->{scans} if defined $self->{scans};    delete $self->{scans} if defined $self->{scans};
146    
147      delete $self->{env};
148    if ($self->{dbh}) {    if ($self->{dbh}) {
149      delete $self->{dbh};      delete $self->{dbh};
150      delete $self->{db};      untie %{$self->{db}};
151      #untie %{$self->{db}};      for my $att (qw(db file maindbfile)) {
152          delete $self->{$att};
153        }
154    }    }
155  }  }
156    
Legend:
Removed from v.88  
changed lines
  Added in v.108
  ViewVC Help
Powered by ViewVC 1.1.26