/[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 109 by dpavlin, Tue Jul 13 17:41:12 2004 UTC revision 110 by dpavlin, Tue Jul 13 19:05:31 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";      warn "Warning: Directory '$dir/$name' already exists";
# 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;    print STDERR "## dir: $dir name: $name\n";
 print Dumper($self);  
   
   print STDERR "## dir: $dir name: $name path: ",$self->file,"\n";  
102    
103    my $env= BerkeleyDB::Env->new(    my $env = BerkeleyDB::Env->new(
104                                  -Home => $self->path,                                  -Home => $self->path,
105                                  -Flags => DB_CREATE|DB_INIT_MPOOL|DB_INIT_CDB|DB_PRIVATE,                                  -Flags => DB_CREATE|DB_INIT_MPOOL|DB_INIT_CDB|DB_PRIVATE,
106                                  # Cachesize => 1024*1024*8,                                  # Cachesize => 1024*1024*8,
# Line 181  sub open { Line 174  sub open {
174    
175    if ($mode & O_RDWR) {    if ($mode & O_RDWR) {
176      my $flags = DB_CREATE|DB_INIT_MPOOL|DB_INIT_CDB;      my $flags = DB_CREATE|DB_INIT_MPOOL|DB_INIT_CDB;
177      warn "setting flags for envorinment 'writing'";      #warn "setting flags for envorinment 'writing'";
178      $env = BerkeleyDB::Env->new(      $env = BerkeleyDB::Env->new(
179                                  -Home => $self->path,                                  -Home => $self->path,
180                                  -Flags => $flags,                                  -Flags => $flags,
# Line 197  sub open { Line 190  sub open {
190      # warn "DEBUG: setting env to NIL";      # warn "DEBUG: setting env to NIL";
191      $env = "";      $env = "";
192    }    }
193    # warn "DEBUG: trying to open the database for _attr";  
194      warn "DEBUG: trying to open the database for _attr";
195    my $maindbfile = $self->maindbfile;    my $maindbfile = $self->maindbfile;
196    my $attr = BerkeleyDB::Btree->new(    my $attr = BerkeleyDB::Btree->new(
197                                      -Filename => $maindbfile,                                      -Filename => $maindbfile,
198                                      -Subname  => "_attr",                                      -Subname  => "_attr",
199                                      $env ? (-Env => $env) : (-Flags => DB_RDONLY, -Home => $self->path),                                      $env ? (-Env => $env) : (-Flags => DB_RDONLY),
200                                     );                                     );
201    unless (defined($attr)) {    unless (defined($attr)) {
       use Data::Dumper;  
       print Dumper($attr);  
202        croak "Cannot open [$maindbfile] _attr: $BerkeleyDB::Error; mdbf[$maindbfile] env[$env]";        croak "Cannot open [$maindbfile] _attr: $BerkeleyDB::Error; mdbf[$maindbfile] env[$env]";
203    }    }
204    # warn "DEBUG: opened the database for _attr";  
205      #warn "DEBUG: opened the database for _attr";
206    $attr->db_get(0, my $dat);    $attr->db_get(0, my $dat);
207    # 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;
208    $self = thaw $dat;    $self = thaw $dat;
209    # warn sprintf "DEBUG: thawed _attr rec. time[%.6f]", Time::HiRes::time();    #warn sprintf "DEBUG: thawed _attr rec. time[%.6f]", Time::HiRes::time();
210    $self->{_attr} = $attr;    $self->{_attr} = $attr;
211    
212    return unless defined $self;    return unless defined $self;
# Line 250  sub walkncomplete { Line 243  sub walkncomplete {
243    }    }
244  }  }
245    
 =head2 dispose  
246    
247  Dispose a database. Remove all associated files. This may fail if the  =head2 close
 database or one of its tables is still open. Failure will be indicated  
 by a false return value.  
   
  $db->dispose;  
   
  WAIT::Database->dispose(name=>'name', directory=>'/dir/to/db/');  
   
 =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;>  
248    
249  Close a database saving all meta data after closing all associated tables.  Close a database saving all meta data after closing all associated tables.
250    
251     $db->close;
252    
253  =cut  =cut
254    
255  sub close {  sub close {
256    my $self = $_[0];    my $self = shift;
257        
258    for my $table (values %{$self->{tables}}) {    for my $table (values %{$self->{tables}}) {
259      $table->close if ref($table);      $table->close if ref($table);
260    }    }
261    return 1 unless $self->{mode} & (O_RDWR | O_CREAT);    return 1 unless $self->{mode} & (O_RDWR | O_CREAT);
262    
263    for my $att (qw(file maindbfile name env)) {    my $env = $self->{env};
264    
265      for my $att (qw(path maindbfile name env)) {
266      delete $self->{$att} || confess "can't delete '$att'";      delete $self->{$att} || confess "can't delete '$att'";
267    }    }
268    
# Line 317  sub close { Line 281  sub close {
281  }  }
282    
283    
284    =head2 dispose
285    
286    Dispose a database. Remove all associated files. This may fail if the
287    database or one of its tables is still open. Failure will be indicated
288    by a false return value.
289    
290     $db->dispose;
291    
292     WAIT::Database->dispose(name=>'name', directory=>'/dir/to/db/');
293    
294    =cut
295    
296    sub dispose {
297      my $self = shift;
298    
299      my $path;
300    
301      if ($self && ref $self) {               # called with instance
302        croak "no mode" unless defined($self->{mode});
303        croak "Database readonly" unless $self->{mode} & (O_CREAT | O_RDWR);
304        $path = $self->path;
305        $self->close;
306      } else {
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      my $ret = rmtree($path, 0, 1);
315    
316      return $ret;
317    }
318    
319    
320  =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<);>
321    
322  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 376  sub maindbfile { Line 376  sub maindbfile {
376    my($self,$path) = @_;    my($self,$path) = @_;
377    return $self->{maindbfile} if $self->{maindbfile};    return $self->{maindbfile} if $self->{maindbfile};
378    $path ||= $self->path;    $path ||= $self->path;
379    confess "ALERT: no file argument, no file attribute???" unless $path;    confess "no path argument or attribute" unless $path;
380    $self->{maindbfile} = "etat";    $self->{maindbfile} = "etat";
381  }  }
382    
Legend:
Removed from v.109  
changed lines
  Added in v.110
  ViewVC Help
Powered by ViewVC 1.1.26