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;

  print STDERR "## dir: $dir name: $name\n";

  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):(),
                                         );

print STDERR "### created ",$self->maindbfile,"\n";

  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;

  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;
  
  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);

  #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;

  my $path;

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

  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	print STDERR "## dir: $dir name: $name\n";
102	dpavlin	108
103	dpavlin	110	my $env = BerkeleyDB::Env->new(
104	dpavlin	108	-Home => $self->path,
105			-Flags => DB_CREATE\|DB_INIT_MPOOL\|DB_INIT_CDB\|DB_PRIVATE,
106			# Cachesize => 102410248,
107			# Pagesize => 8*1024, # environment doesn't understand Pagesize parameter!
108			-Verbose => 1,
109			-ErrFile => $self->path."/error.log",
110			);
111			unless ($env) {
112			confess("Could not create environment: $BerkeleyDB::Error");
113			}
114
115			$self->{env} = $env;
116
117			# apperently (! learned from trial and error) while the Env doesn't
118			# understand Pagesize, the very first table needs to set it up if we
119			# want to deviate from the default. And all tables need to follow
120			# this lead. I'm doing so explicitly, it looks prettier to me
121			$self->{_attr} = BerkeleyDB::Btree->new(
122			-Filename => $self->maindbfile,
123			-Subname => "_attr",
124			-Flags => DB_CREATE,
125			-Mode => 0664,
126			-Env => $env,
127			$WAIT::Database::Cachesize?(Cachesize => $WAIT::Database::Cachesize):(),
128			$WAIT::Database::Pagesize?(Pagesize => $WAIT::Database::Pagesize):(),
129			);
130
131			print STDERR "### created ",$self->maindbfile,"\n";
132
133			unless (defined($self->{_attr})) {
134			die("Cannot open [".$self->maindbfile."] _attr: $BerkeleyDB::Error");
135			}
136
137
138			# Use of BerkeleyDB::Env->new here could maybe some day be a way to
139			# introduce a smart locking mechanism? Whatever... it is currently
140			# kein Thema: remember, that the database has a $self->path which
141			# is a directory and there are no berkeley tables in this
142			# directory, but there is one subdirectory in this directory for
143			# each table object.
144
145	ulpfr	10	$self->{uniqueatt} = $parm{uniqueatt};
146	dpavlin	108	$self->{mode} = O_RDWR;
147			$self;
148	ulpfr	10	}
149
150
151	ulpfr	13	=head2 Constructor open
152	ulpfr	10
153	ulpfr	13	$db = WAIT::Database->open(
154			name => "foo",
155			directory => "bar"
156			);
157
158	ulpfr	10	Open an existing database I<foo> in directory I<bar>.
159
160			=cut
161
162			sub open {
163			my $type = shift;
164			my %parm = @_;
165			my $dir = $parm{directory} \|\| '.';
166			my $name = $parm{name} or croak "No name specified";
167	dpavlin	108	my $self = bless {}, ref($type) \|\| $type;
168	ulpfr	13
169	dpavlin	108	my $mode = (exists $parm{mode})?$parm{mode}:(O_CREAT \| O_RDWR);
170			$self->{dir} = $dir; # will be overwritten by the thaw below, but we need it now
171			$self->{name} = $name;
172	ulpfr	10
173	dpavlin	108	my $env;
174
175			if ($mode & O_RDWR) {
176			my $flags = DB_CREATE\|DB_INIT_MPOOL\|DB_INIT_CDB;
177	dpavlin	110	#warn "setting flags for envorinment 'writing'";
178	dpavlin	108	$env = BerkeleyDB::Env->new(
179			-Home => $self->path,
180			-Flags => $flags,
181			);
182			unless ($env) {
183			confess("Could not create environment in [".$self->path."]: $BerkeleyDB::Error");
184	ulpfr	10	}
185	dpavlin	108	} else {
186			# in der Datei neo-lieferung.pl habe ich in Punkt 2.6 darueber
187			# lamentiert, dass der Readonly-User kein Environment bekommt.
188			# Es muesste ein Klacks sein, dafuer einen Schalter
189			# bereitzustellen. Kostet mich aber zu viel Denkzeit.
190			# warn "DEBUG: setting env to NIL";
191			$env = "";
192	ulpfr	10	}
193	dpavlin	110
194			warn "DEBUG: trying to open the database for _attr";
195	dpavlin	108	my $maindbfile = $self->maindbfile;
196			my $attr = BerkeleyDB::Btree->new(
197			-Filename => $maindbfile,
198			-Subname => "_attr",
199	dpavlin	110	$env ? (-Env => $env) : (-Flags => DB_RDONLY),
200	dpavlin	108	);
201			unless (defined($attr)) {
202			croak "Cannot open [$maindbfile] _attr: $BerkeleyDB::Error; mdbf[$maindbfile] env[$env]";
203			}
204	dpavlin	110
205			#warn "DEBUG: opened the database for _attr";
206	dpavlin	108	$attr->db_get(0, my $dat);
207	dpavlin	110	#warn sprintf "DEBUG: got _attr record. time[%.6f] length(dat)[%d]", Time::HiRes::time(), length $dat;
208	dpavlin	108	$self = thaw $dat;
209	dpavlin	110	#warn sprintf "DEBUG: thawed _attr rec. time[%.6f]", Time::HiRes::time();
210	dpavlin	108	$self->{_attr} = $attr;
211	ulpfr	10
212	ulpfr	13	return unless defined $self;
213	ulpfr	19
214	dpavlin	108	$self->{mode} = $mode;
215			$self->{env} = $env;
216			$self->{dir} = $dir; # yes, again
217			$self->{name} = $name;
218			$self->walkncomplete;
219	ulpfr	19
220	ulpfr	10	$self;
221			}
222
223	dpavlin	108	sub walkncomplete {
224			my $self = shift;
225			$self->maindbfile;
226			$self->path;
227			for my $t (values %{$self->{tables} \|\| {}}) {
228			$t->{file} \|\|= $self->{file};
229			$t->{maindbfile} \|\|= $self->{maindbfile};
230			$t->{mode} = $self->{mode};
231			for my $ind (values %{$t->{indexes}}) {
232			$ind->{file} \|\|= $self->{file};
233			$ind->{maindbfile} \|\|= $self->{maindbfile};
234			$ind->{mode} = $self->{mode};
235			}
236			for my $inv (values %{$t->{inverted}}) {
237			for my $ind (@$inv) {
238			$ind->{file} \|\|= $self->{file};
239			$ind->{maindbfile} \|\|= $self->{maindbfile};
240			$ind->{mode} = $self->{mode};
241			}
242			}
243			}
244			}
245	ulpfr	10
246
247	dpavlin	110	=head2 close
248	ulpfr	10
249	dpavlin	110	Close a database saving all meta data after closing all associated tables.
250	dpavlin	108
251	dpavlin	110	$db->close;
252	dpavlin	108
253	ulpfr	10	=cut
254
255			sub close {
256	dpavlin	110	my $self = shift;
257	ulpfr	19
258	dpavlin	108	for my $table (values %{$self->{tables}}) {
259	ulpfr	10	$table->close if ref($table);
260			}
261			return 1 unless $self->{mode} & (O_RDWR \| O_CREAT);
262
263	dpavlin	110	my $env = $self->{env};
264
265			for my $att (qw(path maindbfile name env)) {
266	dpavlin	108	delete $self->{$att} \|\| confess "can't delete '$att'";
267	ulpfr	10	}
268
269	dpavlin	108	my $db = $self->{_attr};
270			delete $self->{_attr} \|\| confess "can't delete _attr";
271	ulpfr	19
272	dpavlin	108	my $dat = nfreeze $self;
273			$db->db_put(0, $dat);
274
275			#warn "DEBUG: Removing env[$env] before closing database";
276			undef $env;
277			#warn "DEBUG: Removed it.";
278
279	ulpfr	10	undef $_[0];
280	dpavlin	108	return 1;
281	ulpfr	10	}
282
283
284	dpavlin	110	=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	ulpfr	13	=head2 C<$db-E<gt>create_table(name =E<gt>> I<tname>, ... C<);>
321	ulpfr	10
322	ulpfr	13	Create a new table with name I<tname>. All parameters are passed to
323			C<WAIT::Table-E<gt>new> together with a filename to use. See
324			L<WAIT::Table> for which attributes are required. The method returns a
325			table handle (C<WAIT::Table::Handle>).
326	ulpfr	10
327			=cut
328
329			sub create_table {
330			my $self = shift;
331			my %parm = @_;
332	ulpfr	13	my $name = $parm{name} or croak "create_table: No name specified";
333			my $attr = $parm{attr} or croak "create_table: No attributes specified";
334	dpavlin	108	my $path = $self->path;
335	ulpfr	10
336			croak "Database readonly" unless $self->{mode} & (O_CREAT \| O_RDWR);
337
338			if (defined $self->{tables}->{$name}) {
339			die "Table '$name' already exists";
340			}
341
342			if ($self->{uniqueatt}) {
343	ulpfr	13	for (@$attr) { # attribute names must be uniqe
344	ulpfr	10	if ($self->{attr}->{$_}) {
345	ulpfr	13	croak("Attribute '$_' is not unique")
346	ulpfr	10	}
347			}
348			}
349	dpavlin	108	$self->{tables}->{$name} = WAIT::Table->new(file => "$path/$name",
350	ulpfr	10	database => $self,
351	dpavlin	108	env => $self->{env},
352			maindbfile => $self->maindbfile,
353			tablename => $name,
354	ulpfr	10	%parm);
355			unless (defined $self->{tables}->{$name}) {# fail gracefully
356			delete $self->{tables}->{$name};
357			return undef;
358			}
359
360			if ($self->{uniqueatt}) {
361			# remember table name for each attribute
362	ulpfr	13	map ($self->{attr}->{$_} = $name, @$attr);
363	ulpfr	10	}
364			WAIT::Table::Handle->new($self, $name);
365			}
366
367	dpavlin	108	=head2 maindbfile
368	ulpfr	10
369	dpavlin	108	Name of BerekelyDB database (without path)
370
371			my $bdb = $db->maindbfile;
372
373			=cut
374
375			sub maindbfile {
376			my($self,$path) = @_;
377			return $self->{maindbfile} if $self->{maindbfile};
378			$path \|\|= $self->path;
379	dpavlin	110	confess "no path argument or attribute" unless $path;
380	dpavlin	108	$self->{maindbfile} = "etat";
381			}
382
383			=head2 path
384
385			Path to database
386
387			my $db_path = $db->path;
388
389			=cut
390
391			sub path {
392			my $self = shift;
393			return $self->{path} if $self->{path};
394			confess("no attribut dir?") unless $self->{dir};
395			confess("no attribut name?") unless $self->{name};
396			$self->{path} = "$self->{dir}/$self->{name}";
397			}
398
399	ulpfr	13	=head2 C<$db-E<gt>table(name =E<gt>> I<tname>C<);>
400	ulpfr	10
401	ulpfr	13	Open a new table with name I<tname>. The method
402	ulpfr	19	returns a table handle (C<WAIT::Table::Handle>).
403	ulpfr	10
404			=cut
405
406			sub sync {
407			my $self = shift;
408
409			for (values %{$self->{tables}}) {
410			$_->sync;
411			}
412			}
413
414			sub table {
415			my $self = shift;
416			my %parm = @_;
417			my $name = $parm{name} or croak "No name specified";
418
419			if (defined $self->{tables}->{$name}) {
420			if (exists $parm{mode}) {
421			$self->{tables}->{$name}->{mode} = $parm{mode};
422			} else {
423			$self->{tables}->{$name}->{mode} = $self->{mode};
424			}
425			WAIT::Table::Handle->new($self,$name);
426			} else {
427	dpavlin	108	croak "No such table '$name'";
428	ulpfr	10	}
429			}
430
431
432	ulpfr	13	=head2 C<$db-E<gt>drop(name =E<gt>> I<tname>C<);>
433	ulpfr	10
434			Drop the table named I<tname>. The table should be closed before
435			calling B<drop>.
436
437			=cut
438
439			sub drop_table {
440			my $self = shift;
441			my %parm = @_;
442			my $name = $parm{name} or croak "No name specified";
443
444			croak "Database readonly" unless $self->{mode} & (O_CREAT \| O_RDWR);
445			if (!defined $self->{tables}->{$name}) {
446			croak "Table '$name' does not exist";
447			}
448			$self->{tables}->{$name}->drop;
449
450			if ($self->{uniqueatt}) {
451			# recycle attribute names
452			for (keys %{$self->{attr}}) {
453			delete $self->{attr}->{$_} if $self->{attr}->{$_} eq $name;
454			}
455			}
456			undef $self->{tables}->{$name}; # Call WAIT::Table::DESTROY here;
457			1;
458			}
459
460
461			1;
462
463
464			=head1 AUTHOR
465
466			Ulrich Pfeifer E<lt>F<pfeifer@ls6.informatik.uni-dortmund.de>E<gt>
467
468			=cut
469
470