/[wait]/trunk/lib/WAIT/Database.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/Database.pm

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

revision 108 by dpavlin, Tue Jul 13 17:41:12 2004 UTC revision 116 by dpavlin, Wed Jul 14 09:48:26 2004 UTC
# Line 83  sub create { Line 83  sub create {
83    my $dir  = $parm{directory} || '.';    my $dir  = $parm{directory} || '.';
84    my $name = $parm{name};    my $name = $parm{name};
85    
86    unless ($name) {    croak("No name specified") unless ($name);
     croak("No name specified");  
   }  
87    
88    unless (-d $dir){    croak("Directory '$dir' does not exits: $!") unless (-d $dir);
     croak("Directory '$dir' does not exits: $!");  
   }  
89    
90    if (-d "$dir/$name") {    if (-d "$dir/$name") {
91      warn "Warning: Directory '$dir/$name' already exists";      carp "Warning: directory '$dir/$name' already exists\n";
92    } else {    } else {
93      unless (mkdir "$dir/$name", 0775) {      unless (mkdir "$dir/$name", 0775) {
94        croak("Could not mkdir '$dir/$name': $!");        croak("Could not mkdir '$dir/$name': $!");
# Line 102  sub create { Line 98  sub create {
98    $self->{dir}       = $dir;    $self->{dir}       = $dir;
99    $self->{name}      = $name;    $self->{name}      = $name;
100    
101  use Data::Dumper;    my $env = BerkeleyDB::Env->new(
 print Dumper($self);  
   
   print STDERR "## dir: $dir name: $name path: ",$self->file,"\n";  
   
   my $env= BerkeleyDB::Env->new(  
102                                  -Home => $self->path,                                  -Home => $self->path,
103                                  -Flags => DB_CREATE|DB_INIT_MPOOL|DB_INIT_CDB|DB_PRIVATE,                                  -Flags => DB_CREATE|DB_INIT_MPOOL|DB_INIT_CDB|DB_PRIVATE,
104                                  # Cachesize => 1024*1024*8,                                  # Cachesize => 1024*1024*8,
# Line 135  print Dumper($self); Line 126  print Dumper($self);
126                                            $WAIT::Database::Pagesize?(Pagesize => $WAIT::Database::Pagesize):(),                                            $WAIT::Database::Pagesize?(Pagesize => $WAIT::Database::Pagesize):(),
127                                           );                                           );
128    
 print STDERR "### created ",$self->maindbfile,"\n";  
   
129    unless (defined($self->{_attr})) {    unless (defined($self->{_attr})) {
130      die("Cannot open [".$self->maindbfile."] _attr: $BerkeleyDB::Error");      die("Cannot open [".$self->maindbfile."] _attr: $BerkeleyDB::Error");
131    }    }
# Line 173  sub open { Line 162  sub open {
162    my $name    = $parm{name} or croak "No name specified";    my $name    = $parm{name} or croak "No name specified";
163    my $self = bless {}, ref($type) || $type;    my $self = bless {}, ref($type) || $type;
164    
165      croak("Directory '$dir' does not exits: $!") unless (-d $dir);
166      if (!-d "$dir/$name") {
167        carp "Warning: database '$dir/$name' doesn't exist\n";
168        return;
169      }
170    my $mode = (exists $parm{mode})?$parm{mode}:(O_CREAT | O_RDWR);    my $mode = (exists $parm{mode})?$parm{mode}:(O_CREAT | O_RDWR);
171    $self->{dir}  = $dir; # will be overwritten by the thaw below, but we need it now    $self->{dir}  = $dir; # will be overwritten by the thaw below, but we need it now
172    $self->{name} = $name;    $self->{name} = $name;
173    
174    my $env;    my $env;
175    
176    if ($mode & O_RDWR) {    return if (! -d $self->path);
177      my $flags = DB_CREATE|DB_INIT_MPOOL|DB_INIT_CDB;  
178      warn "setting flags for envorinment 'writing'";    my $flags = DB_CREATE|DB_INIT_MPOOL|DB_INIT_CDB;
179      $env = BerkeleyDB::Env->new(  
180      $env = BerkeleyDB::Env->new(
181                                  -Home => $self->path,                                  -Home => $self->path,
182                                  -Flags => $flags,                                  -Flags => $flags,
183                                 );                               );
184      unless ($env) {    unless ($env) {
185        confess("Could not create environment in [".$self->path."]: $BerkeleyDB::Error");      return if ($parm{mode} & O_RDWR);
186      }      confess("Could not create environment in [".$self->path."]: $BerkeleyDB::Error");
   } else {  
     # in der Datei neo-lieferung.pl habe ich in Punkt 2.6 darueber  
     # lamentiert, dass der Readonly-User kein Environment bekommt.  
     # Es muesste ein Klacks sein, dafuer einen Schalter  
     # bereitzustellen. Kostet mich aber zu viel Denkzeit.  
     # warn "DEBUG: setting env to NIL";  
     $env = "";  
187    }    }
188    # warn "DEBUG: trying to open the database for _attr";  
189      #warn "DEBUG: trying to open the database for _attr";
190    my $maindbfile = $self->maindbfile;    my $maindbfile = $self->maindbfile;
191    my $attr = BerkeleyDB::Btree->new(    my $attr = BerkeleyDB::Btree->new(
192                                      -Filename => $maindbfile,                                      -Filename => $maindbfile,
193                                      -Subname  => "_attr",                                      -Subname  => "_attr",
194                                      $env ? (-Env => $env) : (-Flags => DB_RDONLY, -Home => $self->path),                                      $env ? (-Env => $env) : (-Flags => DB_RDONLY),
195                                     );                                     );
196    unless (defined($attr)) {    unless (defined($attr)) {
197        use Data::Dumper;        return if ($parm{mode} & O_RDWR);
       print Dumper($attr);  
198        croak "Cannot open [$maindbfile] _attr: $BerkeleyDB::Error; mdbf[$maindbfile] env[$env]";        croak "Cannot open [$maindbfile] _attr: $BerkeleyDB::Error; mdbf[$maindbfile] env[$env]";
199    }    }
200    # warn "DEBUG: opened the database for _attr";  
201      #warn "DEBUG: opened the database for _attr";
202    $attr->db_get(0, my $dat);    $attr->db_get(0, my $dat);
203    # warn sprintf "DEBUG: got _attr record. time[%.6f] length(dat)[%d]", Time::HiRes::time(), length $dat;    #warn sprintf "DEBUG: got _attr record. time[%.6f] length(dat)[%d]", Time::HiRes::time(), length $dat;
204    $self = thaw $dat;    $self = thaw $dat;
205    # warn sprintf "DEBUG: thawed _attr rec. time[%.6f]", Time::HiRes::time();    #warn sprintf "DEBUG: thawed _attr rec. time[%.6f]", Time::HiRes::time();
206    $self->{_attr} = $attr;    $self->{_attr} = $attr;
207    
208    return unless defined $self;    return unless defined $self;
# Line 232  sub walkncomplete { Line 221  sub walkncomplete {
221    $self->maindbfile;    $self->maindbfile;
222    $self->path;    $self->path;
223    for my $t (values %{$self->{tables} || {}}) {    for my $t (values %{$self->{tables} || {}}) {
224      $t->{file} ||= $self->{file};      $t->{path} ||= $self->{path};
225      $t->{maindbfile} ||= $self->{maindbfile};      $t->{maindbfile} ||= $self->{maindbfile};
226      $t->{mode} = $self->{mode};      $t->{mode} = $self->{mode};
227      for my $ind (values %{$t->{indexes}}) {      for my $ind (values %{$t->{indexes}}) {
228        $ind->{file} ||= $self->{file};        $ind->{path} ||= $self->{path};
229        $ind->{maindbfile} ||= $self->{maindbfile};        $ind->{maindbfile} ||= $self->{maindbfile};
230        $ind->{mode} = $self->{mode};        $ind->{mode} = $self->{mode};
231      }      }
232      for my $inv (values %{$t->{inverted}}) {      for my $inv (values %{$t->{inverted}}) {
233        for my $ind (@$inv) {        for my $ind (@$inv) {
234          $ind->{file} ||= $self->{file};          $ind->{path} ||= $self->{path};
235          $ind->{maindbfile} ||= $self->{maindbfile};          $ind->{maindbfile} ||= $self->{maindbfile};
236          $ind->{mode} = $self->{mode};          $ind->{mode} = $self->{mode};
237        }        }
# Line 250  sub walkncomplete { Line 239  sub walkncomplete {
239    }    }
240  }  }
241    
 =head2 dispose  
   
 Dispose a database. Remove all associated files. This may fail if the  
 database or one of its tables is still open. Failure will be indicated  
 by a false return value.  
   
  $db->dispose;  
242    
243   WAIT::Database->dispose(name=>'name', directory=>'/dir/to/db/');  =head2 close
   
 =cut  
   
 sub dispose {  
   my $path;  
   
   if (ref $_[0]) {               # called with instance  
     croak "Database readonly" unless $_[0]->{mode} & (O_CREAT | O_RDWR);  
     $path = $_[0]->path;  
     $_[0]->close;  
   } else {  
     my $type = shift;  
     my %parm = @_;  
     my $base = $parm{directory} || '.';  
     my $name = $parm{name}      || croak "No name specified";  
     $path = "$base/$name";  
   }  
   croak "No such database '$path'" unless -e "$path";  
   
   my $ret = rmtree($path, 0, 1);  
   
   $ret;  
 }  
   
   
 =head2 C<$db-E<gt>close;>  
244    
245  Close a database saving all meta data after closing all associated tables.  Close a database saving all meta data after closing all associated tables.
246    
247     $db->close;
248    
249  =cut  =cut
250    
251  sub close {  sub close {
252      # my $self = shift would increase refcount!
253    my $self = $_[0];    my $self = $_[0];
254        
255    for my $table (values %{$self->{tables}}) {    for my $table (values %{$self->{tables}}) {
# Line 298  sub close { Line 257  sub close {
257    }    }
258    return 1 unless $self->{mode} & (O_RDWR | O_CREAT);    return 1 unless $self->{mode} & (O_RDWR | O_CREAT);
259    
260    for my $att (qw(file maindbfile name env)) {    my $env = $self->{env};
261    
262      for my $att (qw(path maindbfile name env)) {
263      delete $self->{$att} || confess "can't delete '$att'";      delete $self->{$att} || confess "can't delete '$att'";
264    }    }
265    
# Line 308  sub close { Line 269  sub close {
269    my $dat = nfreeze $self;    my $dat = nfreeze $self;
270    $db->db_put(0, $dat);    $db->db_put(0, $dat);
271    
272      undef $db;
273    
274    #warn "DEBUG: Removing env[$env] before closing database";    #warn "DEBUG: Removing env[$env] before closing database";
275    undef $env;    undef $env;
276    #warn "DEBUG: Removed it.";    #warn "DEBUG: Removed it.";
# Line 317  sub close { Line 280  sub close {
280  }  }
281    
282    
283    =head2 dispose
284    
285    Dispose a database. Remove all associated files. This may fail if the
286    database or one of its tables is still open. Failure will be indicated
287    by a false return value.
288    
289     $db->dispose;
290    
291     WAIT::Database->dispose(name=>'name', directory=>'/dir/to/db/');
292    
293    =cut
294    
295    sub dispose {
296      # my $self = shift would increase refcount!
297    
298      my $path;
299    
300      if (ref $_[0]) {               # called with instance
301        croak "no mode" unless defined($_[0]->{mode});
302        croak "Database readonly" unless $_[0]->{mode} & (O_CREAT | O_RDWR);
303        $path = $_[0]->path;
304        $_[0]->close;
305      } else {
306        shift;
307        my %parm = @_;
308        my $base = $parm{directory} || '.';
309        my $name = $parm{name}      || croak "No name specified";
310        $path = "$base/$name";
311      }
312      croak "No such database '$path'" unless -e "$path";
313    
314      #warn "DEBUG: removing $path";
315      my $ret = rmtree($path, 0, 1);
316    
317      return $ret;
318    }
319    
320    
321  =head2 C<$db-E<gt>create_table(name =E<gt>> I<tname>, ... C<);>  =head2 C<$db-E<gt>create_table(name =E<gt>> I<tname>, ... C<);>
322    
323  Create a new table with name I<tname>. All parameters are passed to  Create a new table with name I<tname>. All parameters are passed to
# Line 346  sub create_table { Line 347  sub create_table {
347        }        }
348      }      }
349    }    }
350    $self->{tables}->{$name} = WAIT::Table->new(file     => "$path/$name",    $self->{tables}->{$name} = WAIT::Table->new(path     => "$path/$name",
351                                                database => $self,                                                database => $self,
352                                                env      => $self->{env},                                                env      => $self->{env},
353                                                maindbfile  => $self->maindbfile,                                                maindbfile  => $self->maindbfile,
# Line 376  sub maindbfile { Line 377  sub maindbfile {
377    my($self,$path) = @_;    my($self,$path) = @_;
378    return $self->{maindbfile} if $self->{maindbfile};    return $self->{maindbfile} if $self->{maindbfile};
379    $path ||= $self->path;    $path ||= $self->path;
380    confess "ALERT: no file argument, no file attribute???" unless $path;    confess "no path argument or attribute" unless $path;
381    $self->{maindbfile} = "etat";    $self->{maindbfile} = "etat";
382  }  }
383    
# Line 429  sub table { Line 430  sub table {
430  }  }
431    
432    
433  =head2 C<$db-E<gt>drop(name =E<gt>> I<tname>C<);>  =head2 drop
434    
435  Drop the table named I<tname>. The table should be closed before  Drop the table named I<tname>. The table should be closed before
436  calling B<drop>.  calling B<drop>.
437    
438     $db->drop(name => 'tname');
439    
440  =cut  =cut
441    
442  sub drop_table {  sub drop_table {
Legend:
Removed from v.108  
changed lines
  Added in v.116
  ViewVC Help
Powered by ViewVC 1.1.26