/[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 112 by dpavlin, Tue Jul 13 19:50:13 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;    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 179  sub open { Line 168  sub open {
168    
169    my $env;    my $env;
170    
171      return if (! -d $self->path);
172    
173    if ($mode & O_RDWR) {    if ($mode & O_RDWR) {
174      my $flags = DB_CREATE|DB_INIT_MPOOL|DB_INIT_CDB;      my $flags = DB_CREATE|DB_INIT_MPOOL|DB_INIT_CDB;
175      warn "setting flags for envorinment 'writing'";      #warn "setting flags for envorinment 'writing'";
176      $env = BerkeleyDB::Env->new(      $env = BerkeleyDB::Env->new(
177                                  -Home => $self->path,                                  -Home => $self->path,
178                                  -Flags => $flags,                                  -Flags => $flags,
# Line 197  sub open { Line 188  sub open {
188      # warn "DEBUG: setting env to NIL";      # warn "DEBUG: setting env to NIL";
189      $env = "";      $env = "";
190    }    }
191    # warn "DEBUG: trying to open the database for _attr";  
192      #warn "DEBUG: trying to open the database for _attr";
193    my $maindbfile = $self->maindbfile;    my $maindbfile = $self->maindbfile;
194    my $attr = BerkeleyDB::Btree->new(    my $attr = BerkeleyDB::Btree->new(
195                                      -Filename => $maindbfile,                                      -Filename => $maindbfile,
196                                      -Subname  => "_attr",                                      -Subname  => "_attr",
197                                      $env ? (-Env => $env) : (-Flags => DB_RDONLY, -Home => $self->path),                                      $env ? (-Env => $env) : (-Flags => DB_RDONLY),
198                                     );                                     );
199    unless (defined($attr)) {    unless (defined($attr)) {
       use Data::Dumper;  
       print Dumper($attr);  
200        croak "Cannot open [$maindbfile] _attr: $BerkeleyDB::Error; mdbf[$maindbfile] env[$env]";        croak "Cannot open [$maindbfile] _attr: $BerkeleyDB::Error; mdbf[$maindbfile] env[$env]";
201    }    }
202    # warn "DEBUG: opened the database for _attr";  
203      #warn "DEBUG: opened the database for _attr";
204    $attr->db_get(0, my $dat);    $attr->db_get(0, my $dat);
205    # 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;
206    $self = thaw $dat;    $self = thaw $dat;
207    # warn sprintf "DEBUG: thawed _attr rec. time[%.6f]", Time::HiRes::time();    #warn sprintf "DEBUG: thawed _attr rec. time[%.6f]", Time::HiRes::time();
208    $self->{_attr} = $attr;    $self->{_attr} = $attr;
209    
210    return unless defined $self;    return unless defined $self;
# Line 250  sub walkncomplete { Line 241  sub walkncomplete {
241    }    }
242  }  }
243    
 =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;  
   
  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;  
 }  
244    
245    =head2 close
 =head2 C<$db-E<gt>close;>  
246    
247  Close a database saving all meta data after closing all associated tables.  Close a database saving all meta data after closing all associated tables.
248    
249     $db->close;
250    
251  =cut  =cut
252    
253  sub close {  sub close {
254      # my $self = shift would increase refcount!
255    my $self = $_[0];    my $self = $_[0];
256        
257    for my $table (values %{$self->{tables}}) {    for my $table (values %{$self->{tables}}) {
# Line 298  sub close { Line 259  sub close {
259    }    }
260    return 1 unless $self->{mode} & (O_RDWR | O_CREAT);    return 1 unless $self->{mode} & (O_RDWR | O_CREAT);
261    
262    for my $att (qw(file maindbfile name env)) {    my $env = $self->{env};
263    
264      for my $att (qw(path maindbfile name env)) {
265      delete $self->{$att} || confess "can't delete '$att'";      delete $self->{$att} || confess "can't delete '$att'";
266    }    }
267    
# Line 308  sub close { Line 271  sub close {
271    my $dat = nfreeze $self;    my $dat = nfreeze $self;
272    $db->db_put(0, $dat);    $db->db_put(0, $dat);
273    
274      undef $db;
275    
276    #warn "DEBUG: Removing env[$env] before closing database";    #warn "DEBUG: Removing env[$env] before closing database";
277    undef $env;    undef $env;
278    #warn "DEBUG: Removed it.";    #warn "DEBUG: Removed it.";
# Line 317  sub close { Line 282  sub close {
282  }  }
283    
284    
285    =head2 dispose
286    
287    Dispose a database. Remove all associated files. This may fail if the
288    database or one of its tables is still open. Failure will be indicated
289    by a false return value.
290    
291     $db->dispose;
292    
293     WAIT::Database->dispose(name=>'name', directory=>'/dir/to/db/');
294    
295    =cut
296    
297    sub dispose {
298      # my $self = shift would increase refcount!
299    
300      my $path;
301    
302      if (ref $_[0]) {               # called with instance
303        croak "no mode" unless defined($_[0]->{mode});
304        croak "Database readonly" unless $_[0]->{mode} & (O_CREAT | O_RDWR);
305        $path = $_[0]->path;
306        $_[0]->close;
307      } else {
308        shift;
309        my %parm = @_;
310        my $base = $parm{directory} || '.';
311        my $name = $parm{name}      || croak "No name specified";
312        $path = "$base/$name";
313      }
314      croak "No such database '$path'" unless -e "$path";
315    
316      #warn "DEBUG: removing $path";
317      my $ret = rmtree($path, 0, 1);
318    
319      return $ret;
320    }
321    
322    
323  =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<);>
324    
325  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 379  sub maindbfile {
379    my($self,$path) = @_;    my($self,$path) = @_;
380    return $self->{maindbfile} if $self->{maindbfile};    return $self->{maindbfile} if $self->{maindbfile};
381    $path ||= $self->path;    $path ||= $self->path;
382    confess "ALERT: no file argument, no file attribute???" unless $path;    confess "no path argument or attribute" unless $path;
383    $self->{maindbfile} = "etat";    $self->{maindbfile} = "etat";
384  }  }
385    
Legend:
Removed from v.108  
changed lines
  Added in v.112
  ViewVC Help
Powered by ViewVC 1.1.26