lib/WAIT/Database.pm

#                              -*- Mode: cperl -*- 
# $Basename: Database.pm $
# $Revision: 1.14 $
# Author          : Ulrich Pfeifer
# Created On      : Thu Aug  8 09:44:13 1996
# Last Modified By: Ulrich Pfeifer
# Last Modified On: Sat Apr 15 16:15:29 2000
# Language        : CPerl
# 
# (C) Copyright 1996-2000, Ulrich Pfeifer
# 

=head1 NAME

WAIT::Database - Module fo maintaining WAIT databases

=head1 SYNOPSIS

  require WAIT::Database;

=head1 DESCRIPTION

The modules handles creating, opening, and deleting of databases and
tables.

=cut

package WAIT::Database;

use strict;
use FileHandle ();
use File::Path qw(rmtree);
use WAIT::Table ();
use BerkeleyDB;
use Fcntl;
use Carp; # will use autouse later
use Storable qw(nfreeze thaw);
use vars qw($VERSION);
use Data::Dumper;

$VERSION = "2.000";

#$WAIT::Database::Pagesize = 1*1024;
#$WAIT::Database::Cachesize = 4*1024*1024;

# use autouse Carp => qw( croak($) );

=head2 Constructor create

  $db = WAIT::Database->create(
                               directory => '/dir/to/database/'
                               name      => 'name',
                              );

Create a new database.

=over 10

=item B<name> I<name>

Mandatory name of database

=item B<directory> I<directory>

Directory which should contain the database (defaults to the current
directory).

=item B<uniqueatt> I<true>

If given, the database will require unique attributes over all tables.

The method will croak on failure.

=back

=cut

sub create {
  my $type = shift;
  my %parm = @_;
  my $self = {};
  bless $self => ref($type) || $type;
  my $dir  = $parm{directory} || '.';
  my $name = $parm{name};

  croak("No name specified") unless ($name);

  croak("Directory '$dir' does not exits: $!") unless (-d $dir);

  if (-d "$dir/$name") {
    warn "Warning: Directory '$dir/$name' already exists";
  } else {
    unless (mkdir "$dir/$name", 0775) {
      croak("Could not mkdir '$dir/$name': $!");
    }
  }

  $self->{dir}       = $dir;
  $self->{name}      = $name;

  my $env = BerkeleyDB::Env->new(
                                -Home => $self->path,
                                -Flags => DB_CREATE|DB_INIT_MPOOL|DB_INIT_CDB|DB_PRIVATE,
                                # Cachesize => 1024*1024*8,
                                # Pagesize => 8*1024, # environment doesn't understand Pagesize parameter!
                                -Verbose => 1,
                                -ErrFile => $self->path."/error.log",
                                );
  unless ($env) {
    confess("Could not create environment: $BerkeleyDB::Error");
  }

  $self->{env} = $env;

  # apperently (! learned from trial and error) while the Env doesn't
  # understand Pagesize, the very first table needs to set it up if we
  # want to deviate from the default. And all tables need to follow
  # this lead. I'm doing so explicitly, it looks prettier to me
  $self->{_attr} = BerkeleyDB::Btree->new(
                                          -Filename => $self->maindbfile,
                                          -Subname  => "_attr",
                                          -Flags    => DB_CREATE,
                                          -Mode     => 0664,
                                          -Env      => $env,
                                          $WAIT::Database::Cachesize?(Cachesize => $WAIT::Database::Cachesize):(),
                                          $WAIT::Database::Pagesize?(Pagesize => $WAIT::Database::Pagesize):(),
                                         );

  unless (defined($self->{_attr})) {
    die("Cannot open [".$self->maindbfile."] _attr: $BerkeleyDB::Error");
  }


  # Use of BerkeleyDB::Env->new here could maybe some day be a way to
  # introduce a smart locking mechanism? Whatever... it is currently
  # kein Thema: remember, that the database has a $self->path which
  # is a *directory* and there are no berkeley tables in this
  # directory, but there is one subdirectory in this directory for
  # *each* *table* object.

  $self->{uniqueatt} = $parm{uniqueatt};
  $self->{mode}      = O_RDWR;
  $self;
}


=head2 Constructor open

  $db = WAIT::Database->open(
                             name => "foo",
                             directory => "bar"
                            );

Open an existing database I<foo> in directory I<bar>.

=cut

sub open {
  my $type    = shift;
  my %parm    = @_;
  my $dir     = $parm{directory} || '.';
  my $name    = $parm{name} or croak "No name specified";
  my $self = bless {}, ref($type) || $type;

  my $mode = (exists $parm{mode})?$parm{mode}:(O_CREAT | O_RDWR);
  $self->{dir}  = $dir; # will be overwritten by the thaw below, but we need it now
  $self->{name} = $name;

  my $env;

  return if (! -d $self->path);

  if ($mode & O_RDWR) {
    my $flags = DB_CREATE|DB_INIT_MPOOL|DB_INIT_CDB;
    #warn "setting flags for envorinment 'writing'";
    $env = BerkeleyDB::Env->new(
                                -Home => $self->path,
                                -Flags => $flags,
                               );
    unless ($env) {
      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 = "";
  }

  #warn "DEBUG: trying to open the database for _attr";
  my $maindbfile = $self->maindbfile;
  my $attr = BerkeleyDB::Btree->new(
                                    -Filename => $maindbfile,
                                    -Subname  => "_attr",
                                    $env ? (-Env => $env) : (-Flags => DB_RDONLY),
                                   );
  unless (defined($attr)) {
      croak "Cannot open [$maindbfile] _attr: $BerkeleyDB::Error; mdbf[$maindbfile] env[$env]";
  }

  #warn "DEBUG: opened the database for _attr";
  $attr->db_get(0, my $dat);
  #warn sprintf "DEBUG: got _attr record. time[%.6f] length(dat)[%d]", Time::HiRes::time(), length $dat;
  $self = thaw $dat;
  #warn sprintf "DEBUG: thawed _attr rec. time[%.6f]", Time::HiRes::time();
  $self->{_attr} = $attr;

  return unless defined $self;

  $self->{mode} = $mode;
  $self->{env}  = $env;
  $self->{dir}  = $dir; # yes, again
  $self->{name} = $name;
  $self->walkncomplete;

  $self;
}

sub walkncomplete {
  my $self = shift;
  $self->maindbfile;
  $self->path;
  for my $t (values %{$self->{tables} || {}}) {
    $t->{file} ||= $self->{file};
    $t->{maindbfile} ||= $self->{maindbfile};
    $t->{mode} = $self->{mode};
    for my $ind (values %{$t->{indexes}}) {
      $ind->{file} ||= $self->{file};
      $ind->{maindbfile} ||= $self->{maindbfile};
      $ind->{mode} = $self->{mode};
    }
    for my $inv (values %{$t->{inverted}}) {
      for my $ind (@$inv) {
        $ind->{file} ||= $self->{file};
        $ind->{maindbfile} ||= $self->{maindbfile};
        $ind->{mode} = $self->{mode};
      }
    }
  }
}


=head2 close

Close a database saving all meta data after closing all associated tables.

 $db->close;

=cut

sub close {
  # my $self = shift would increase refcount!
  my $self = $_[0];
  
  for my $table (values %{$self->{tables}}) {
    $table->close if ref($table);
  }
  return 1 unless $self->{mode} & (O_RDWR | O_CREAT);

  my $env = $self->{env};

  for my $att (qw(path maindbfile name env)) {
    delete $self->{$att} || confess "can't delete '$att'";
  }

  my $db = $self->{_attr};
  delete $self->{_attr} || confess "can't delete _attr";

  my $dat = nfreeze $self;
  $db->db_put(0, $dat);

  undef $db;

  #warn "DEBUG: Removing env[$env] before closing database";
  undef $env;
  #warn "DEBUG: Removed it.";

  undef $_[0];
  return 1;
}


=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 $self = shift would increase refcount!

  my $path;

  if (ref $_[0]) {               # called with instance
    croak "no mode" unless defined($_[0]->{mode});
    croak "Database readonly" unless $_[0]->{mode} & (O_CREAT | O_RDWR);
    $path = $_[0]->path;
    $_[0]->close;
  } else {
    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";

  #warn "DEBUG: removing $path";
  my $ret = rmtree($path, 0, 1);

  return $ret;
}


=head2 C<$db-E<gt>create_table(name =E<gt>> I<tname>, ... C<);>

Create a new table with name I<tname>. All parameters are passed to
C<WAIT::Table-E<gt>new> together with a filename to use. See
L<WAIT::Table> for which attributes are required. The method returns a
table handle (C<WAIT::Table::Handle>).

=cut

sub create_table {
  my $self = shift;
  my %parm = @_;
  my $name = $parm{name} or croak "create_table: No name specified";
  my $attr = $parm{attr} or croak "create_table: No attributes specified";
  my $path = $self->path;

  croak "Database readonly" unless $self->{mode} & (O_CREAT | O_RDWR);

  if (defined $self->{tables}->{$name}) {
    die "Table '$name' already exists";
  }

  if ($self->{uniqueatt}) {
    for (@$attr) {      # attribute names must be uniqe
      if ($self->{attr}->{$_}) {
        croak("Attribute '$_' is not unique")
      }
    }
  }
  $self->{tables}->{$name} = WAIT::Table->new(file     => "$path/$name",
                                              database => $self,
                                              env      => $self->{env},
                                              maindbfile  => $self->maindbfile,
                                              tablename   => $name,
                                              %parm);
  unless (defined $self->{tables}->{$name}) {# fail gracefully
    delete $self->{tables}->{$name};
    return undef;
  }

  if ($self->{uniqueatt}) {
    # remember table name for each attribute
    map ($self->{attr}->{$_} = $name, @$attr);
  }
  WAIT::Table::Handle->new($self, $name);
}

=head2 maindbfile

Name of BerekelyDB database (without path)

 my $bdb = $db->maindbfile;

=cut

sub maindbfile {
  my($self,$path) = @_;
  return $self->{maindbfile} if $self->{maindbfile};
  $path ||= $self->path;
  confess "no path argument or attribute" unless $path;
  $self->{maindbfile} = "etat";
}

=head2 path

Path to database

 my $db_path = $db->path;

=cut

sub path {
  my $self = shift;
  return $self->{path} if $self->{path};
  confess("no attribut dir?") unless $self->{dir};
  confess("no attribut name?") unless $self->{name};
  $self->{path} = "$self->{dir}/$self->{name}";
}

=head2 C<$db-E<gt>table(name =E<gt>> I<tname>C<);>

Open a new table with name I<tname>. The method
returns a table handle (C<WAIT::Table::Handle>).

=cut

sub sync {
  my $self = shift;

  for (values %{$self->{tables}}) {
     $_->sync;
  }
}

sub table {
  my $self = shift;
  my %parm = @_;
  my $name = $parm{name} or croak "No name specified";

  if (defined $self->{tables}->{$name}) {
    if (exists $parm{mode}) {
      $self->{tables}->{$name}->{mode} = $parm{mode};
    } else {
      $self->{tables}->{$name}->{mode} = $self->{mode};
    }
    WAIT::Table::Handle->new($self,$name);
  } else {
    croak "No such table '$name'";
  }
}


=head2 C<$db-E<gt>drop(name =E<gt>> I<tname>C<);>

Drop the table named I<tname>. The table should be closed before
calling B<drop>.

=cut

sub drop_table {
  my $self = shift;
  my %parm = @_;
  my $name = $parm{name} or croak "No name specified";

  croak "Database readonly" unless $self->{mode} & (O_CREAT | O_RDWR);
  if (!defined $self->{tables}->{$name}) {
    croak "Table '$name' does not exist";
  }
  $self->{tables}->{$name}->drop;

  if ($self->{uniqueatt}) {
    # recycle attribute names
    for (keys %{$self->{attr}}) {
      delete $self->{attr}->{$_} if $self->{attr}->{$_} eq $name;
    }
  }
  undef $self->{tables}->{$name}; # Call WAIT::Table::DESTROY here;
  1;
}


1;


=head1 AUTHOR

Ulrich Pfeifer E<lt>F<pfeifer@ls6.informatik.uni-dortmund.de>E<gt>

=cut


1	dpavlin	108	# -- Mode: cperl --
2	ulpfr	19	# $Basename: Database.pm $
3			# $Revision: 1.14 $
4	ulpfr	10	# Author : Ulrich Pfeifer
5			# Created On : Thu Aug 8 09:44:13 1996
6			# Last Modified By: Ulrich Pfeifer
7	dpavlin	89	# Last Modified On: Sat Apr 15 16:15:29 2000
8	ulpfr	10	# Language : CPerl
9	ulpfr	19	#
10			# (C) Copyright 1996-2000, Ulrich Pfeifer
11			#
12	ulpfr	10
13			=head1 NAME
14
15			WAIT::Database - Module fo maintaining WAIT databases
16
17			=head1 SYNOPSIS
18
19			require WAIT::Database;
20
21			=head1 DESCRIPTION
22
23			The modules handles creating, opening, and deleting of databases and
24			tables.
25
26			=cut
27
28			package WAIT::Database;
29
30			use strict;
31			use FileHandle ();
32			use File::Path qw(rmtree);
33			use WAIT::Table ();
34	dpavlin	108	use BerkeleyDB;
35	ulpfr	10	use Fcntl;
36	ulpfr	13	use Carp; # will use autouse later
37	dpavlin	108	use Storable qw(nfreeze thaw);
38			use vars qw($VERSION);
39			use Data::Dumper;
40	ulpfr	19
41	dpavlin	108	$VERSION = "2.000";
42	ulpfr	10
43	dpavlin	108	#$WAIT::Database::Pagesize = 1*1024;
44			#$WAIT::Database::Cachesize = 410241024;
45	ulpfr	10
46	dpavlin	108	# use autouse Carp => qw( croak($) );
47	ulpfr	10
48	ulpfr	13	=head2 Constructor create
49	ulpfr	10
50	ulpfr	13	$db = WAIT::Database->create(
51	dpavlin	108	directory => '/dir/to/database/'
52			name => 'name',
53	ulpfr	13	);
54
55			Create a new database.
56
57	ulpfr	10	=over 10
58
59			=item B<name> I<name>
60
61	dpavlin	108	Mandatory name of database
62	ulpfr	10
63			=item B<directory> I<directory>
64
65			Directory which should contain the database (defaults to the current
66			directory).
67
68			=item B<uniqueatt> I<true>
69
70			If given, the database will require unique attributes over all tables.
71
72	ulpfr	13	The method will croak on failure.
73	ulpfr	10
74	ulpfr	13	=back
75
76	ulpfr	10	=cut
77
78			sub create {
79			my $type = shift;
80			my %parm = @_;
81			my $self = {};
82	dpavlin	108	bless $self => ref($type) \|\| $type;
83	ulpfr	10	my $dir = $parm{directory} \|\| '.';
84	ulpfr	13	my $name = $parm{name};
85	ulpfr	10
86	dpavlin	110	croak("No name specified") unless ($name);
87	ulpfr	10
88	dpavlin	110	croak("Directory '$dir' does not exits: $!") unless (-d $dir);
89	ulpfr	13
90			if (-d "$dir/$name") {
91			warn "Warning: Directory '$dir/$name' already exists";
92			} else {
93			unless (mkdir "$dir/$name", 0775) {
94			croak("Could not mkdir '$dir/$name': $!");
95			}
96			}
97
98	dpavlin	108	$self->{dir} = $dir;
99	ulpfr	10	$self->{name} = $name;
100	dpavlin	108
101	dpavlin	110	my $env = BerkeleyDB::Env->new(
102	dpavlin	108	-Home => $self->path,
103			-Flags => DB_CREATE\|DB_INIT_MPOOL\|DB_INIT_CDB\|DB_PRIVATE,
104			# Cachesize => 102410248,
105			# Pagesize => 8*1024, # environment doesn't understand Pagesize parameter!
106			-Verbose => 1,
107			-ErrFile => $self->path."/error.log",
108			);
109			unless ($env) {
110			confess("Could not create environment: $BerkeleyDB::Error");
111			}
112
113			$self->{env} = $env;
114
115			# apperently (! learned from trial and error) while the Env doesn't
116			# understand Pagesize, the very first table needs to set it up if we
117			# want to deviate from the default. And all tables need to follow
118			# this lead. I'm doing so explicitly, it looks prettier to me
119			$self->{_attr} = BerkeleyDB::Btree->new(
120			-Filename => $self->maindbfile,
121			-Subname => "_attr",
122			-Flags => DB_CREATE,
123			-Mode => 0664,
124			-Env => $env,
125			$WAIT::Database::Cachesize?(Cachesize => $WAIT::Database::Cachesize):(),
126			$WAIT::Database::Pagesize?(Pagesize => $WAIT::Database::Pagesize):(),
127			);
128
129			unless (defined($self->{_attr})) {
130			die("Cannot open [".$self->maindbfile."] _attr: $BerkeleyDB::Error");
131			}
132
133
134			# Use of BerkeleyDB::Env->new here could maybe some day be a way to
135			# introduce a smart locking mechanism? Whatever... it is currently
136			# kein Thema: remember, that the database has a $self->path which
137			# is a directory and there are no berkeley tables in this
138			# directory, but there is one subdirectory in this directory for
139			# each table object.
140
141	ulpfr	10	$self->{uniqueatt} = $parm{uniqueatt};
142	dpavlin	108	$self->{mode} = O_RDWR;
143			$self;
144	ulpfr	10	}
145
146
147	ulpfr	13	=head2 Constructor open
148	ulpfr	10
149	ulpfr	13	$db = WAIT::Database->open(
150			name => "foo",
151			directory => "bar"
152			);
153
154	ulpfr	10	Open an existing database I<foo> in directory I<bar>.
155
156			=cut
157
158			sub open {
159			my $type = shift;
160			my %parm = @_;
161			my $dir = $parm{directory} \|\| '.';
162			my $name = $parm{name} or croak "No name specified";
163	dpavlin	108	my $self = bless {}, ref($type) \|\| $type;
164	ulpfr	13
165	dpavlin	108	my $mode = (exists $parm{mode})?$parm{mode}:(O_CREAT \| O_RDWR);
166			$self->{dir} = $dir; # will be overwritten by the thaw below, but we need it now
167			$self->{name} = $name;
168	ulpfr	10
169	dpavlin	108	my $env;
170
171	dpavlin	112	return if (! -d $self->path);
172
173	dpavlin	108	if ($mode & O_RDWR) {
174			my $flags = DB_CREATE\|DB_INIT_MPOOL\|DB_INIT_CDB;
175	dpavlin	110	#warn "setting flags for envorinment 'writing'";
176	dpavlin	108	$env = BerkeleyDB::Env->new(
177			-Home => $self->path,
178			-Flags => $flags,
179			);
180			unless ($env) {
181			confess("Could not create environment in [".$self->path."]: $BerkeleyDB::Error");
182	ulpfr	10	}
183	dpavlin	108	} else {
184			# in der Datei neo-lieferung.pl habe ich in Punkt 2.6 darueber
185			# lamentiert, dass der Readonly-User kein Environment bekommt.
186			# Es muesste ein Klacks sein, dafuer einen Schalter
187			# bereitzustellen. Kostet mich aber zu viel Denkzeit.
188			# warn "DEBUG: setting env to NIL";
189			$env = "";
190	ulpfr	10	}
191	dpavlin	110
192	dpavlin	112	#warn "DEBUG: trying to open the database for _attr";
193	dpavlin	108	my $maindbfile = $self->maindbfile;
194			my $attr = BerkeleyDB::Btree->new(
195			-Filename => $maindbfile,
196			-Subname => "_attr",
197	dpavlin	110	$env ? (-Env => $env) : (-Flags => DB_RDONLY),
198	dpavlin	108	);
199			unless (defined($attr)) {
200			croak "Cannot open [$maindbfile] _attr: $BerkeleyDB::Error; mdbf[$maindbfile] env[$env]";
201			}
202	dpavlin	110
203			#warn "DEBUG: opened the database for _attr";
204	dpavlin	108	$attr->db_get(0, my $dat);
205	dpavlin	110	#warn sprintf "DEBUG: got _attr record. time[%.6f] length(dat)[%d]", Time::HiRes::time(), length $dat;
206	dpavlin	108	$self = thaw $dat;
207	dpavlin	110	#warn sprintf "DEBUG: thawed _attr rec. time[%.6f]", Time::HiRes::time();
208	dpavlin	108	$self->{_attr} = $attr;
209	ulpfr	10
210	ulpfr	13	return unless defined $self;
211	ulpfr	19
212	dpavlin	108	$self->{mode} = $mode;
213			$self->{env} = $env;
214			$self->{dir} = $dir; # yes, again
215			$self->{name} = $name;
216			$self->walkncomplete;
217	ulpfr	19
218	ulpfr	10	$self;
219			}
220
221	dpavlin	108	sub walkncomplete {
222			my $self = shift;
223			$self->maindbfile;
224			$self->path;
225			for my $t (values %{$self->{tables} \|\| {}}) {
226			$t->{file} \|\|= $self->{file};
227			$t->{maindbfile} \|\|= $self->{maindbfile};
228			$t->{mode} = $self->{mode};
229			for my $ind (values %{$t->{indexes}}) {
230			$ind->{file} \|\|= $self->{file};
231			$ind->{maindbfile} \|\|= $self->{maindbfile};
232			$ind->{mode} = $self->{mode};
233			}
234			for my $inv (values %{$t->{inverted}}) {
235			for my $ind (@$inv) {
236			$ind->{file} \|\|= $self->{file};
237			$ind->{maindbfile} \|\|= $self->{maindbfile};
238			$ind->{mode} = $self->{mode};
239			}
240			}
241			}
242			}
243	ulpfr	10
244
245	dpavlin	110	=head2 close
246	ulpfr	10
247	dpavlin	110	Close a database saving all meta data after closing all associated tables.
248	dpavlin	108
249	dpavlin	110	$db->close;
250	dpavlin	108
251	ulpfr	10	=cut
252
253			sub close {
254	dpavlin	112	# my $self = shift would increase refcount!
255			my $self = $_[0];
256	ulpfr	19
257	dpavlin	108	for my $table (values %{$self->{tables}}) {
258	ulpfr	10	$table->close if ref($table);
259			}
260			return 1 unless $self->{mode} & (O_RDWR \| O_CREAT);
261
262	dpavlin	110	my $env = $self->{env};
263
264			for my $att (qw(path maindbfile name env)) {
265	dpavlin	108	delete $self->{$att} \|\| confess "can't delete '$att'";
266	ulpfr	10	}
267
268	dpavlin	108	my $db = $self->{_attr};
269			delete $self->{_attr} \|\| confess "can't delete _attr";
270	ulpfr	19
271	dpavlin	108	my $dat = nfreeze $self;
272			$db->db_put(0, $dat);
273
274	dpavlin	112	undef $db;
275
276	dpavlin	108	#warn "DEBUG: Removing env[$env] before closing database";
277			undef $env;
278			#warn "DEBUG: Removed it.";
279
280	ulpfr	10	undef $_[0];
281	dpavlin	108	return 1;
282	ulpfr	10	}
283
284
285	dpavlin	110	=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	dpavlin	112	# my $self = shift would increase refcount!
299	dpavlin	110
300			my $path;
301
302	dpavlin	112	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	dpavlin	110	} else {
308	dpavlin	112	shift;
309	dpavlin	110	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	dpavlin	112	#warn "DEBUG: removing $path";
317	dpavlin	110	my $ret = rmtree($path, 0, 1);
318
319			return $ret;
320			}
321
322
323	ulpfr	13	=head2 C<$db-E<gt>create_table(name =E<gt>> I<tname>, ... C<);>
324	ulpfr	10
325	ulpfr	13	Create a new table with name I<tname>. All parameters are passed to
326			C<WAIT::Table-E<gt>new> together with a filename to use. See
327			L<WAIT::Table> for which attributes are required. The method returns a
328			table handle (C<WAIT::Table::Handle>).
329	ulpfr	10
330			=cut
331
332			sub create_table {
333			my $self = shift;
334			my %parm = @_;
335	ulpfr	13	my $name = $parm{name} or croak "create_table: No name specified";
336			my $attr = $parm{attr} or croak "create_table: No attributes specified";
337	dpavlin	108	my $path = $self->path;
338	ulpfr	10
339			croak "Database readonly" unless $self->{mode} & (O_CREAT \| O_RDWR);
340
341			if (defined $self->{tables}->{$name}) {
342			die "Table '$name' already exists";
343			}
344
345			if ($self->{uniqueatt}) {
346	ulpfr	13	for (@$attr) { # attribute names must be uniqe
347	ulpfr	10	if ($self->{attr}->{$_}) {
348	ulpfr	13	croak("Attribute '$_' is not unique")
349	ulpfr	10	}
350			}
351			}
352	dpavlin	108	$self->{tables}->{$name} = WAIT::Table->new(file => "$path/$name",
353	ulpfr	10	database => $self,
354	dpavlin	108	env => $self->{env},
355			maindbfile => $self->maindbfile,
356			tablename => $name,
357	ulpfr	10	%parm);
358			unless (defined $self->{tables}->{$name}) {# fail gracefully
359			delete $self->{tables}->{$name};
360			return undef;
361			}
362
363			if ($self->{uniqueatt}) {
364			# remember table name for each attribute
365	ulpfr	13	map ($self->{attr}->{$_} = $name, @$attr);
366	ulpfr	10	}
367			WAIT::Table::Handle->new($self, $name);
368			}
369
370	dpavlin	108	=head2 maindbfile
371	ulpfr	10
372	dpavlin	108	Name of BerekelyDB database (without path)
373
374			my $bdb = $db->maindbfile;
375
376			=cut
377
378			sub maindbfile {
379			my($self,$path) = @_;
380			return $self->{maindbfile} if $self->{maindbfile};
381			$path \|\|= $self->path;
382	dpavlin	110	confess "no path argument or attribute" unless $path;
383	dpavlin	108	$self->{maindbfile} = "etat";
384			}
385
386			=head2 path
387
388			Path to database
389
390			my $db_path = $db->path;
391
392			=cut
393
394			sub path {
395			my $self = shift;
396			return $self->{path} if $self->{path};
397			confess("no attribut dir?") unless $self->{dir};
398			confess("no attribut name?") unless $self->{name};
399			$self->{path} = "$self->{dir}/$self->{name}";
400			}
401
402	ulpfr	13	=head2 C<$db-E<gt>table(name =E<gt>> I<tname>C<);>
403	ulpfr	10
404	ulpfr	13	Open a new table with name I<tname>. The method
405	ulpfr	19	returns a table handle (C<WAIT::Table::Handle>).
406	ulpfr	10
407			=cut
408
409			sub sync {
410			my $self = shift;
411
412			for (values %{$self->{tables}}) {
413			$_->sync;
414			}
415			}
416
417			sub table {
418			my $self = shift;
419			my %parm = @_;
420			my $name = $parm{name} or croak "No name specified";
421
422			if (defined $self->{tables}->{$name}) {
423			if (exists $parm{mode}) {
424			$self->{tables}->{$name}->{mode} = $parm{mode};
425			} else {
426			$self->{tables}->{$name}->{mode} = $self->{mode};
427			}
428			WAIT::Table::Handle->new($self,$name);
429			} else {
430	dpavlin	108	croak "No such table '$name'";
431	ulpfr	10	}
432			}
433
434
435	ulpfr	13	=head2 C<$db-E<gt>drop(name =E<gt>> I<tname>C<);>
436	ulpfr	10
437			Drop the table named I<tname>. The table should be closed before
438			calling B<drop>.
439
440			=cut
441
442			sub drop_table {
443			my $self = shift;
444			my %parm = @_;
445			my $name = $parm{name} or croak "No name specified";
446
447			croak "Database readonly" unless $self->{mode} & (O_CREAT \| O_RDWR);
448			if (!defined $self->{tables}->{$name}) {
449			croak "Table '$name' does not exist";
450			}
451			$self->{tables}->{$name}->drop;
452
453			if ($self->{uniqueatt}) {
454			# recycle attribute names
455			for (keys %{$self->{attr}}) {
456			delete $self->{attr}->{$_} if $self->{attr}->{$_} eq $name;
457			}
458			}
459			undef $self->{tables}->{$name}; # Call WAIT::Table::DESTROY here;
460			1;
461			}
462
463
464			1;
465
466
467			=head1 AUTHOR
468
469			Ulrich Pfeifer E<lt>F<pfeifer@ls6.informatik.uni-dortmund.de>E<gt>
470
471			=cut
472
473