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

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

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

  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;

use Data::Dumper;
print Dumper($self);

  print STDERR "## dir: $dir name: $name path: ",$self->file,"\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, -Home => $self->path),
                                   );
  unless (defined($attr)) {
      use Data::Dumper;
      print Dumper($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 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;
}


=head2 C<$db-E<gt>close;>

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

=cut

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

  for my $att (qw(file 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 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 "ALERT: no file argument, no file 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	ulpfr	13	unless ($name) {
87			croak("No name specified");
88			}
89	ulpfr	10
90	ulpfr	13	unless (-d $dir){
91			croak("Directory '$dir' does not exits: $!");
92			}
93
94			if (-d "$dir/$name") {
95			warn "Warning: Directory '$dir/$name' already exists";
96			} else {
97			unless (mkdir "$dir/$name", 0775) {
98			croak("Could not mkdir '$dir/$name': $!");
99			}
100			}
101
102	dpavlin	108	$self->{dir} = $dir;
103	ulpfr	10	$self->{name} = $name;
104	dpavlin	108
105			use Data::Dumper;
106			print Dumper($self);
107
108			print STDERR "## dir: $dir name: $name path: ",$self->file,"\n";
109
110			my $env= BerkeleyDB::Env->new(
111			-Home => $self->path,
112			-Flags => DB_CREATE\|DB_INIT_MPOOL\|DB_INIT_CDB\|DB_PRIVATE,
113			# Cachesize => 102410248,
114			# Pagesize => 8*1024, # environment doesn't understand Pagesize parameter!
115			-Verbose => 1,
116			-ErrFile => $self->path."/error.log",
117			);
118			unless ($env) {
119			confess("Could not create environment: $BerkeleyDB::Error");
120			}
121
122			$self->{env} = $env;
123
124			# apperently (! learned from trial and error) while the Env doesn't
125			# understand Pagesize, the very first table needs to set it up if we
126			# want to deviate from the default. And all tables need to follow
127			# this lead. I'm doing so explicitly, it looks prettier to me
128			$self->{_attr} = BerkeleyDB::Btree->new(
129			-Filename => $self->maindbfile,
130			-Subname => "_attr",
131			-Flags => DB_CREATE,
132			-Mode => 0664,
133			-Env => $env,
134			$WAIT::Database::Cachesize?(Cachesize => $WAIT::Database::Cachesize):(),
135			$WAIT::Database::Pagesize?(Pagesize => $WAIT::Database::Pagesize):(),
136			);
137
138			print STDERR "### created ",$self->maindbfile,"\n";
139
140			unless (defined($self->{_attr})) {
141			die("Cannot open [".$self->maindbfile."] _attr: $BerkeleyDB::Error");
142			}
143
144
145			# Use of BerkeleyDB::Env->new here could maybe some day be a way to
146			# introduce a smart locking mechanism? Whatever... it is currently
147			# kein Thema: remember, that the database has a $self->path which
148			# is a directory and there are no berkeley tables in this
149			# directory, but there is one subdirectory in this directory for
150			# each table object.
151
152	ulpfr	10	$self->{uniqueatt} = $parm{uniqueatt};
153	dpavlin	108	$self->{mode} = O_RDWR;
154			$self;
155	ulpfr	10	}
156
157
158	ulpfr	13	=head2 Constructor open
159	ulpfr	10
160	ulpfr	13	$db = WAIT::Database->open(
161			name => "foo",
162			directory => "bar"
163			);
164
165	ulpfr	10	Open an existing database I<foo> in directory I<bar>.
166
167			=cut
168
169			sub open {
170			my $type = shift;
171			my %parm = @_;
172			my $dir = $parm{directory} \|\| '.';
173			my $name = $parm{name} or croak "No name specified";
174	dpavlin	108	my $self = bless {}, ref($type) \|\| $type;
175	ulpfr	13
176	dpavlin	108	my $mode = (exists $parm{mode})?$parm{mode}:(O_CREAT \| O_RDWR);
177			$self->{dir} = $dir; # will be overwritten by the thaw below, but we need it now
178			$self->{name} = $name;
179	ulpfr	10
180	dpavlin	108	my $env;
181
182			if ($mode & O_RDWR) {
183			my $flags = DB_CREATE\|DB_INIT_MPOOL\|DB_INIT_CDB;
184			warn "setting flags for envorinment 'writing'";
185			$env = BerkeleyDB::Env->new(
186			-Home => $self->path,
187			-Flags => $flags,
188			);
189			unless ($env) {
190			confess("Could not create environment in [".$self->path."]: $BerkeleyDB::Error");
191	ulpfr	10	}
192	dpavlin	108	} else {
193			# in der Datei neo-lieferung.pl habe ich in Punkt 2.6 darueber
194			# lamentiert, dass der Readonly-User kein Environment bekommt.
195			# Es muesste ein Klacks sein, dafuer einen Schalter
196			# bereitzustellen. Kostet mich aber zu viel Denkzeit.
197			# warn "DEBUG: setting env to NIL";
198			$env = "";
199	ulpfr	10	}
200	dpavlin	108	# warn "DEBUG: trying to open the database for _attr";
201			my $maindbfile = $self->maindbfile;
202			my $attr = BerkeleyDB::Btree->new(
203			-Filename => $maindbfile,
204			-Subname => "_attr",
205			$env ? (-Env => $env) : (-Flags => DB_RDONLY, -Home => $self->path),
206			);
207			unless (defined($attr)) {
208			use Data::Dumper;
209			print Dumper($attr);
210			croak "Cannot open [$maindbfile] _attr: $BerkeleyDB::Error; mdbf[$maindbfile] env[$env]";
211			}
212			# warn "DEBUG: opened the database for _attr";
213			$attr->db_get(0, my $dat);
214			# warn sprintf "DEBUG: got _attr record. time[%.6f] length(dat)[%d]", Time::HiRes::time(), length $dat;
215			$self = thaw $dat;
216			# warn sprintf "DEBUG: thawed _attr rec. time[%.6f]", Time::HiRes::time();
217			$self->{_attr} = $attr;
218	ulpfr	10
219	ulpfr	13	return unless defined $self;
220	ulpfr	19
221	dpavlin	108	$self->{mode} = $mode;
222			$self->{env} = $env;
223			$self->{dir} = $dir; # yes, again
224			$self->{name} = $name;
225			$self->walkncomplete;
226	ulpfr	19
227	ulpfr	10	$self;
228			}
229
230	dpavlin	108	sub walkncomplete {
231			my $self = shift;
232			$self->maindbfile;
233			$self->path;
234			for my $t (values %{$self->{tables} \|\| {}}) {
235			$t->{file} \|\|= $self->{file};
236			$t->{maindbfile} \|\|= $self->{maindbfile};
237			$t->{mode} = $self->{mode};
238			for my $ind (values %{$t->{indexes}}) {
239			$ind->{file} \|\|= $self->{file};
240			$ind->{maindbfile} \|\|= $self->{maindbfile};
241			$ind->{mode} = $self->{mode};
242			}
243			for my $inv (values %{$t->{inverted}}) {
244			for my $ind (@$inv) {
245			$ind->{file} \|\|= $self->{file};
246			$ind->{maindbfile} \|\|= $self->{maindbfile};
247			$ind->{mode} = $self->{mode};
248			}
249			}
250			}
251			}
252	ulpfr	10
253	dpavlin	108	=head2 dispose
254	ulpfr	10
255			Dispose a database. Remove all associated files. This may fail if the
256			database or one of its tables is still open. Failure will be indicated
257			by a false return value.
258
259	dpavlin	108	$db->dispose;
260
261			WAIT::Database->dispose(name=>'name', directory=>'/dir/to/db/');
262
263	ulpfr	10	=cut
264
265			sub dispose {
266	dpavlin	108	my $path;
267	ulpfr	10
268			if (ref $_[0]) { # called with instance
269			croak "Database readonly" unless $_[0]->{mode} & (O_CREAT \| O_RDWR);
270	dpavlin	108	$path = $_[0]->path;
271	ulpfr	10	$_[0]->close;
272			} else {
273			my $type = shift;
274			my %parm = @_;
275			my $base = $parm{directory} \|\| '.';
276	dpavlin	108	my $name = $parm{name} \|\| croak "No name specified";
277			$path = "$base/$name";
278	ulpfr	10	}
279	dpavlin	108	croak "No such database '$path'" unless -e "$path";
280	ulpfr	10
281	dpavlin	108	my $ret = rmtree($path, 0, 1);
282
283	ulpfr	13	$ret;
284	ulpfr	10	}
285
286
287			=head2 C<$db-E<gt>close;>
288
289			Close a database saving all meta data after closing all associated tables.
290
291			=cut
292
293			sub close {
294			my $self = $_[0];
295	ulpfr	19
296	dpavlin	108	for my $table (values %{$self->{tables}}) {
297	ulpfr	10	$table->close if ref($table);
298			}
299			return 1 unless $self->{mode} & (O_RDWR \| O_CREAT);
300
301	dpavlin	108	for my $att (qw(file maindbfile name env)) {
302			delete $self->{$att} \|\| confess "can't delete '$att'";
303	ulpfr	10	}
304
305	dpavlin	108	my $db = $self->{_attr};
306			delete $self->{_attr} \|\| confess "can't delete _attr";
307	ulpfr	19
308	dpavlin	108	my $dat = nfreeze $self;
309			$db->db_put(0, $dat);
310
311			#warn "DEBUG: Removing env[$env] before closing database";
312			undef $env;
313			#warn "DEBUG: Removed it.";
314
315	ulpfr	10	undef $_[0];
316	dpavlin	108	return 1;
317	ulpfr	10	}
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			confess "ALERT: no file argument, no file attribute???" unless $path;
380			$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