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

branches/CPAN/lib/WAIT/Index.pm revision 11 by unknown, Fri Apr 28 15:41:10 2000 UTC trunk/lib/WAIT/Index.pm revision 115 by dpavlin, Wed Jul 14 07:35:56 2004 UTC
# Line 1  Line 1 
1  #                              -*- Mode: Perl -*-  #                              -*- Mode: Cperl -*-
2  # Index.pm --  # Index.pm --
3  # ITIID           : $ITI$ $Header $__Header$  # ITIID           : $ITI$ $Header $__Header$
4  # Author          : Ulrich Pfeifer  # Author          : Ulrich Pfeifer
# Line 15  Line 15 
15  package WAIT::Index;  package WAIT::Index;
16  use WAIT::IndexScan;  use WAIT::IndexScan;
17  use strict;  use strict;
18  use DB_File;  use BerkeleyDB;
19  use Fcntl;  use Fcntl;
20    use Carp;
21    use vars qw($VERSION);
22    
23  sub fail {  $VERSION = "2.000"; # Table.pm tests if we are loaded by checking $VERSION
   $@ .= join "\n", @_;  
   return undef;  
 }  
24    
25  sub new {  sub new {
26    my $type = shift;    my $type = shift;
27    my %parm = @_;    my %parm = @_;
28    my $self = {};    my $self = {};
29    
30    $self->{file}     = $parm{file}     or return fail("No file specified");    for my $x (qw(path attr env subname maindbfile tablename)) {
31    $self->{attr}     = $parm{attr}     or return fail("No attributes specified");      unless ($self->{$x} = $parm{$x}) {
32          require Carp;
33          Carp::croak("No $x specified");
34        }
35      }
36    bless $self, ref($type) || $type;    bless $self, ref($type) || $type;
37  }  }
38    
39    for my $accessor (qw(maindbfile tablename subname)) {
40      no strict 'refs';
41      *{$accessor} = sub {
42        my($self) = @_;
43        return $self->{$accessor} if $self->{$accessor};
44        require Carp;
45        Carp::confess("accessor $accessor not there");
46      }
47    }
48    
49  sub drop {  sub drop {
50    my $self = shift;    my $self = shift;
51    if ((caller)[0] eq 'WAIT::Table') { # Table knows about this    if ((caller)[0] eq 'WAIT::Table') { # Table knows about this
52      my $file = $self->{file};      my $path = $self->{path};
53        ! (!-e $path or unlink $path);
54      ! (!-e $file or unlink $file);    } else {                            # notify our database
55    } else {                              # notify our database      require Carp;
56      fail ref($self)."::drop called directly";      Carp::croak(ref($self)."::drop called directly");
57    }    }
58  }  }
59    
60  sub open {  sub open {
61    my $self = shift;    my $self = shift;
62    my $file = $self->{file};    my $path = $self->{path};
63    
64    if (exists $self->{dbh}) {    if (exists $self->{dbh}) {
65      $self->{dbh};      $self->{dbh};
66    } else {    } else {
67      $self->{dbh} = tie(%{$self->{db}}, 'DB_File', $file,      my $flags;
68                         $self->{mode}, 0664, $DB_BTREE);      if ($self->{mode} & O_RDWR) {
69          $flags = DB_CREATE; # | DB_INIT_MPOOL | DB_INIT_CDB;
70          # warn "Flags on index $path set to 'writing'";
71        } else {
72          $flags = DB_RDONLY;
73          # warn "Flags on index $path set to 'readonly'";
74        }
75        $self->{dbh} = tie(%{$self->{db}}, 'BerkeleyDB::Btree',
76                           # Filename => $path,
77                           Filename => $self->maindbfile,
78                           $self->{env} ? (Env => $self->{env}) : (),
79                           Subname => join("/",$self->tablename,$self->subname),
80                           Mode => 0664,
81                           Flags => $flags,
82                           $WAIT::Database::Cachesize?(Cachesize => $WAIT::Database::Cachesize):(),
83                           $WAIT::Database::Pagesize?(Pagesize => $WAIT::Database::Pagesize):(),
84                          ) or die $BerkeleyDB::Error;
85    }    }
86  }  }
87    
# Line 80  sub have { Line 109  sub have {
109    
110    my $tuple = join($;, map($parm{$_}, @{$self->{attr}}));    my $tuple = join($;, map($parm{$_}, @{$self->{attr}}));
111    
112    exists $self->{db}->{$tuple} && $self->{db}->{$tuple};    $self->{db}->{$tuple};
113  }  }
114    
115  sub fetch {  sub fetch {
116    my $self  = shift;    my $self  = shift;
117    my %parm  = @_;    my %parm  = @_;
118    my @keys  = @{$self->{attr}->[0]};    my @keys  = @{$self->{attr}->[0]};
119      
120    defined $self->{db} or $self->open;    defined $self->{db} or $self->open;
121    
122    my $key   = join($;, map($parm{$_}, @keys));    my $key   = join($;, map($parm{$_}, @keys));
# Line 101  sub delete { Line 130  sub delete {
130    
131    defined $self->{db} or $self->open;    defined $self->{db} or $self->open;
132    
133    my $tuple = join($;, map($parm{$_}, @{$self->{attr}}));    my $tuple = join($;, map($parm{$_}||"", @{$self->{attr}}));
134      
135    delete $self->{db}->{$tuple};    delete $self->{db}->{$tuple};
136  }  }
137    
138  sub sync {  sub sync {
139    my $self = shift;    my $self = shift;
140    $self->{dbh}->sync if $self->{dbh};    #warn "DEBUG: sync dbh[$self->{dbh}]";
141      if ($self->{dbh}) {
142            unless (defined($self->{dbh}->db_sync)) {
143                    carp "sync failed: $BerkeleyDB::Error";
144            }
145      } else {
146            confess "sync called without dbh";
147      }
148  }  }
149    
150  sub close {  sub close {
# Line 116  sub close { Line 152  sub close {
152    
153    delete $self->{scans} if defined $self->{scans};    delete $self->{scans} if defined $self->{scans};
154    
155      delete $self->{env};
156    if ($self->{dbh}) {    if ($self->{dbh}) {
157      delete $self->{dbh};      delete $self->{dbh};
158      untie %{$self->{db}};      untie %{$self->{db}};
159      delete $self->{db};      for my $att (qw(db path maindbfile)) {
160          delete $self->{$att};
161        }
162    }    }
163  }  }
164    
# Line 128  sub close { Line 167  sub close {
167  sub open_scan {  sub open_scan {
168    my $self = shift;    my $self = shift;
169    my $code = shift;    my $code = shift;
170      
171    $self->{dbh} or $self->open;    $self->{dbh} or $self->open;
172    new WAIT::IndexScan $self, $code;    new WAIT::IndexScan $self, $code;
173  }  }
Legend:
Removed from v.11  
changed lines
  Added in v.115
  ViewVC Help
Powered by ViewVC 1.1.26