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") {
    carp "Warning: directory '$dir/$name' already exists\n";
  } 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;

  croak("Directory '$dir' does not exits: $!") unless (-d $dir);
  if (!-d "$dir/$name") {
    carp "Warning: database '$dir/$name' doesn't exist\n";
    return;
  }
  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);

  my $flags = DB_CREATE|DB_INIT_MPOOL|DB_INIT_CDB;

  $env = BerkeleyDB::Env->new(
                                -Home => $self->path,
                                -Flags => $flags,
                             );
  unless ($env) {
    return if ($parm{mode} & O_RDWR);
    confess("Could not create environment in [".$self->path."]: $BerkeleyDB::Error");
  }

  #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)) {
      return if ($parm{mode} & O_RDWR);
      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->{path} ||= $self->{path};
    $t->{maindbfile} ||= $self->{maindbfile};
    $t->{mode} = $self->{mode};
    for my $ind (values %{$t->{indexes}}) {
      $ind->{path} ||= $self->{path};
      $ind->{maindbfile} ||= $self->{maindbfile};
      $ind->{mode} = $self->{mode};
    }
    for my $inv (values %{$t->{inverted}}) {
      for my $ind (@$inv) {
        $ind->{path} ||= $self->{path};
        $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(path     => "$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 drop

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

 $db->drop(name => 'tname');

=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	dpavlin	116	carp "Warning: directory '$dir/$name' already exists\n";
92	ulpfr	13	} 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	116	croak("Directory '$dir' does not exits: $!") unless (-d $dir);
166			if (!-d "$dir/$name") {
167			carp "Warning: database '$dir/$name' doesn't exist\n";
168			return;
169			}
170	dpavlin	108	my $mode = (exists $parm{mode})?$parm{mode}:(O_CREAT \| O_RDWR);
171			$self->{dir} = $dir; # will be overwritten by the thaw below, but we need it now
172			$self->{name} = $name;
173	ulpfr	10
174	dpavlin	108	my $env;
175
176	dpavlin	112	return if (! -d $self->path);
177
178	dpavlin	116	my $flags = DB_CREATE\|DB_INIT_MPOOL\|DB_INIT_CDB;
179
180			$env = BerkeleyDB::Env->new(
181	dpavlin	108	-Home => $self->path,
182			-Flags => $flags,
183	dpavlin	116	);
184			unless ($env) {
185			return if ($parm{mode} & O_RDWR);
186			confess("Could not create environment in [".$self->path."]: $BerkeleyDB::Error");
187	ulpfr	10	}
188	dpavlin	110
189	dpavlin	112	#warn "DEBUG: trying to open the database for _attr";
190	dpavlin	108	my $maindbfile = $self->maindbfile;
191			my $attr = BerkeleyDB::Btree->new(
192			-Filename => $maindbfile,
193			-Subname => "_attr",
194	dpavlin	110	$env ? (-Env => $env) : (-Flags => DB_RDONLY),
195	dpavlin	108	);
196			unless (defined($attr)) {
197	dpavlin	116	return if ($parm{mode} & O_RDWR);
198	dpavlin	108	croak "Cannot open [$maindbfile] _attr: $BerkeleyDB::Error; mdbf[$maindbfile] env[$env]";
199			}
200	dpavlin	110
201			#warn "DEBUG: opened the database for _attr";
202	dpavlin	108	$attr->db_get(0, my $dat);
203	dpavlin	110	#warn sprintf "DEBUG: got _attr record. time[%.6f] length(dat)[%d]", Time::HiRes::time(), length $dat;
204	dpavlin	108	$self = thaw $dat;
205	dpavlin	110	#warn sprintf "DEBUG: thawed _attr rec. time[%.6f]", Time::HiRes::time();
206	dpavlin	108	$self->{_attr} = $attr;
207	ulpfr	10
208	ulpfr	13	return unless defined $self;
209	ulpfr	19
210	dpavlin	108	$self->{mode} = $mode;
211			$self->{env} = $env;
212			$self->{dir} = $dir; # yes, again
213			$self->{name} = $name;
214			$self->walkncomplete;
215	ulpfr	19
216	ulpfr	10	$self;
217			}
218
219	dpavlin	108	sub walkncomplete {
220			my $self = shift;
221			$self->maindbfile;
222			$self->path;
223			for my $t (values %{$self->{tables} \|\| {}}) {
224	dpavlin	114	$t->{path} \|\|= $self->{path};
225	dpavlin	108	$t->{maindbfile} \|\|= $self->{maindbfile};
226			$t->{mode} = $self->{mode};
227			for my $ind (values %{$t->{indexes}}) {
228	dpavlin	114	$ind->{path} \|\|= $self->{path};
229	dpavlin	108	$ind->{maindbfile} \|\|= $self->{maindbfile};
230			$ind->{mode} = $self->{mode};
231			}
232			for my $inv (values %{$t->{inverted}}) {
233			for my $ind (@$inv) {
234	dpavlin	114	$ind->{path} \|\|= $self->{path};
235	dpavlin	108	$ind->{maindbfile} \|\|= $self->{maindbfile};
236			$ind->{mode} = $self->{mode};
237			}
238			}
239			}
240			}
241	ulpfr	10
242
243	dpavlin	110	=head2 close
244	ulpfr	10
245	dpavlin	110	Close a database saving all meta data after closing all associated tables.
246	dpavlin	108
247	dpavlin	110	$db->close;
248	dpavlin	108
249	ulpfr	10	=cut
250
251			sub close {
252	dpavlin	112	# my $self = shift would increase refcount!
253			my $self = $_[0];
254	ulpfr	19
255	dpavlin	108	for my $table (values %{$self->{tables}}) {
256	ulpfr	10	$table->close if ref($table);
257			}
258			return 1 unless $self->{mode} & (O_RDWR \| O_CREAT);
259
260	dpavlin	110	my $env = $self->{env};
261
262			for my $att (qw(path maindbfile name env)) {
263	dpavlin	108	delete $self->{$att} \|\| confess "can't delete '$att'";
264	ulpfr	10	}
265
266	dpavlin	108	my $db = $self->{_attr};
267			delete $self->{_attr} \|\| confess "can't delete _attr";
268	ulpfr	19
269	dpavlin	108	my $dat = nfreeze $self;
270			$db->db_put(0, $dat);
271
272	dpavlin	112	undef $db;
273
274	dpavlin	108	#warn "DEBUG: Removing env[$env] before closing database";
275			undef $env;
276			#warn "DEBUG: Removed it.";
277
278	ulpfr	10	undef $_[0];
279	dpavlin	108	return 1;
280	ulpfr	10	}
281
282
283	dpavlin	110	=head2 dispose
284
285			Dispose a database. Remove all associated files. This may fail if the
286			database or one of its tables is still open. Failure will be indicated
287			by a false return value.
288
289			$db->dispose;
290
291			WAIT::Database->dispose(name=>'name', directory=>'/dir/to/db/');
292
293			=cut
294
295			sub dispose {
296	dpavlin	112	# my $self = shift would increase refcount!
297	dpavlin	110
298			my $path;
299
300	dpavlin	112	if (ref $_[0]) { # called with instance
301			croak "no mode" unless defined($_[0]->{mode});
302			croak "Database readonly" unless $_[0]->{mode} & (O_CREAT \| O_RDWR);
303			$path = $_[0]->path;
304			$_[0]->close;
305	dpavlin	110	} else {
306	dpavlin	112	shift;
307	dpavlin	110	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	dpavlin	112	#warn "DEBUG: removing $path";
315	dpavlin	110	my $ret = rmtree($path, 0, 1);
316
317			return $ret;
318			}
319
320
321	ulpfr	13	=head2 C<$db-E<gt>create_table(name =E<gt>> I<tname>, ... C<);>
322	ulpfr	10
323	ulpfr	13	Create a new table with name I<tname>. All parameters are passed to
324			C<WAIT::Table-E<gt>new> together with a filename to use. See
325			L<WAIT::Table> for which attributes are required. The method returns a
326			table handle (C<WAIT::Table::Handle>).
327	ulpfr	10
328			=cut
329
330			sub create_table {
331			my $self = shift;
332			my %parm = @_;
333	ulpfr	13	my $name = $parm{name} or croak "create_table: No name specified";
334			my $attr = $parm{attr} or croak "create_table: No attributes specified";
335	dpavlin	108	my $path = $self->path;
336	ulpfr	10
337			croak "Database readonly" unless $self->{mode} & (O_CREAT \| O_RDWR);
338
339			if (defined $self->{tables}->{$name}) {
340			die "Table '$name' already exists";
341			}
342
343			if ($self->{uniqueatt}) {
344	ulpfr	13	for (@$attr) { # attribute names must be uniqe
345	ulpfr	10	if ($self->{attr}->{$_}) {
346	ulpfr	13	croak("Attribute '$_' is not unique")
347	ulpfr	10	}
348			}
349			}
350	dpavlin	113	$self->{tables}->{$name} = WAIT::Table->new(path => "$path/$name",
351	ulpfr	10	database => $self,
352	dpavlin	108	env => $self->{env},
353			maindbfile => $self->maindbfile,
354			tablename => $name,
355	ulpfr	10	%parm);
356			unless (defined $self->{tables}->{$name}) {# fail gracefully
357			delete $self->{tables}->{$name};
358			return undef;
359			}
360
361			if ($self->{uniqueatt}) {
362			# remember table name for each attribute
363	ulpfr	13	map ($self->{attr}->{$_} = $name, @$attr);
364	ulpfr	10	}
365			WAIT::Table::Handle->new($self, $name);
366			}
367
368	dpavlin	108	=head2 maindbfile
369	ulpfr	10
370	dpavlin	108	Name of BerekelyDB database (without path)
371
372			my $bdb = $db->maindbfile;
373
374			=cut
375
376			sub maindbfile {
377			my($self,$path) = @_;
378			return $self->{maindbfile} if $self->{maindbfile};
379			$path \|\|= $self->path;
380	dpavlin	110	confess "no path argument or attribute" unless $path;
381	dpavlin	108	$self->{maindbfile} = "etat";
382			}
383
384			=head2 path
385
386			Path to database
387
388			my $db_path = $db->path;
389
390			=cut
391
392			sub path {
393			my $self = shift;
394			return $self->{path} if $self->{path};
395			confess("no attribut dir?") unless $self->{dir};
396			confess("no attribut name?") unless $self->{name};
397			$self->{path} = "$self->{dir}/$self->{name}";
398			}
399
400	ulpfr	13	=head2 C<$db-E<gt>table(name =E<gt>> I<tname>C<);>
401	ulpfr	10
402	ulpfr	13	Open a new table with name I<tname>. The method
403	ulpfr	19	returns a table handle (C<WAIT::Table::Handle>).
404	ulpfr	10
405			=cut
406
407			sub sync {
408			my $self = shift;
409
410			for (values %{$self->{tables}}) {
411			$_->sync;
412			}
413			}
414
415			sub table {
416			my $self = shift;
417			my %parm = @_;
418			my $name = $parm{name} or croak "No name specified";
419
420			if (defined $self->{tables}->{$name}) {
421			if (exists $parm{mode}) {
422			$self->{tables}->{$name}->{mode} = $parm{mode};
423			} else {
424			$self->{tables}->{$name}->{mode} = $self->{mode};
425			}
426			WAIT::Table::Handle->new($self,$name);
427			} else {
428	dpavlin	108	croak "No such table '$name'";
429	ulpfr	10	}
430			}
431
432
433	dpavlin	115	=head2 drop
434	ulpfr	10
435			Drop the table named I<tname>. The table should be closed before
436			calling B<drop>.
437
438	dpavlin	115	$db->drop(name => 'tname');
439
440	ulpfr	10	=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