lib/WAIT/Database.pm

#                              -*- Mode: Perl -*- 
# $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 27 16:48:24 2002
# 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 Fcntl;
use Carp; # will use autouse later
use LockFile::Simple ();

# use autouse Carp => qw( croak($) );
my ($HAVE_DATA_DUMPER, $HAVE_STORABLE);

BEGIN {
  eval { require Data::Dumper };
  $HAVE_DATA_DUMPER = 1 if $@ eq '';
  eval { require Storable };
  $HAVE_STORABLE    = 1 if $@ eq ''; 
  $HAVE_DATA_DUMPER || $HAVE_STORABLE ||
    die "Could not find Data::Dumper nor Storable";
  $Storable::forgive_me = 1;
}


=head2 Constructor create

  $db = WAIT::Database->create(
                               name      => <name>,
                               directory => <dir>
                              );

Create a new database.

=over 10

=item B<name> I<name>

mandatory

=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 = {};
  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->{name}      = $name;
  $self->{file}      = "$dir/$name";
  $self->{uniqueatt} = $parm{uniqueatt};
  $self->{mode}      = O_CREAT;
  my $lockmgr = LockFile::Simple->make(-autoclean => 1, -stale => 1);
  # aquire a write lock
  $self->{write_lock} = $lockmgr->lock("$dir/$name/write")
    or die "Can't lock '$dir/$name/write'";
  bless $self => ref($type) || $type;
}


=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 $catalog = "$dir/$name/catalog";
  my $meta    = "$dir/$name/meta";
  my $self;

  if ($HAVE_STORABLE and -e $catalog
      and (!-e $meta or -M $meta >= -M $catalog)) {
    $self = Storable::retrieve($catalog);
  } else {
    return undef unless -f $meta;

    $self = do $meta;
    unless (defined $self) {
      warn "do '$meta' did not work. Mysterious! Reverting to eval `cat $meta`";
      sleep(4);
      $self = eval `cat $meta`;
    }
  }

  return unless defined $self;
  $self->{mode} = (exists $parm{mode})?$parm{mode}:(O_CREAT | O_RDWR);

  if ($self->{mode} & O_RDWR) {
    # Locking: We do not care about read access since write is atomic.
    my $lockmgr = LockFile::Simple->make(-autoclean => 1, -stale => 1);
    
    # aquire a write lock
    $self->{write_lock} = $lockmgr->lock("$dir/$name/write")
      or die "Can't lock '$dir/$name/write'";
  }

  $self;
}


=head2 C<$db-E<gt>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.

=cut

sub dispose {
  my $dir;

  if (ref $_[0]) {               # called with instance
    croak "Database readonly" unless $_[0]->{mode} & (O_CREAT | O_RDWR);
    $dir = $_[0]->{file};
    $_[0]->close;
  } else {
    my $type = shift;
    my %parm = @_;
    my $base = $parm{directory} || '.';
    my $name = $parm{name}       || croak "No name specified";
    $dir = "$base/$name";
  }
  croak "No such database '$dir'" unless -e "$dir/meta";

  #warn "Running rmtree on dir[$dir]";
  my $ret = rmtree($dir, 0, 1);
  #warn "rmtree returned[$ret]";
  $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];
  my $file = $self->{file};
  my $table;
  my $did_save;
  
  for $table (values %{$self->{tables}}) {
    $table->close if ref($table);
  }
  return 1 unless $self->{mode} & (O_RDWR | O_CREAT);

  my $lock = delete $self->{write_lock}; # Do not store lock objects

  if ($HAVE_DATA_DUMPER) {
    my $fh   = new FileHandle "> $file/meta.$$";
    if ($fh) {
      my $dumper = new Data::Dumper [$self],['self'];
      $fh->print('my ');
      $fh->print($dumper->Dumpxs);
      $fh->close;
      $did_save = rename "$file/meta.$$", "$file/meta";
    } else {
      croak "Could not open '$file/meta' for writing: $!";
      # never reached: return unless $HAVE_STORABLE;
    }
  }

  if ($HAVE_STORABLE) {
    if (!eval {Storable::store($self, "$file/catalog.$$")}) {
      unlink "$file/catalog.$$";
      croak "Could not open '$file/catalog.$$' for writing: $!";
      # never reached: return unless $did_save;
    } else {
      $did_save = rename "$file/catalog.$$", "$file/catalog";
    }
  }

  $lock->release;
  
  undef $_[0];
  $did_save;
}


=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 $file = $self->{file};

  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     => "$file/$name",
                                              database => $self,
                                              %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 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 {
    print STDERR "No such table '$name'\n";
    return;
  }
}


=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	ulpfr	19	# -- Mode: Perl --
2			# $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	ulpfr	85	# Last Modified On: Sat Apr 27 16:48:24 2002
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			use Fcntl;
35	ulpfr	13	use Carp; # will use autouse later
36	ulpfr	19	use LockFile::Simple ();
37
38	ulpfr	13	# use autouse Carp => qw( croak($) );
39	ulpfr	10	my ($HAVE_DATA_DUMPER, $HAVE_STORABLE);
40
41			BEGIN {
42			eval { require Data::Dumper };
43			$HAVE_DATA_DUMPER = 1 if $@ eq '';
44			eval { require Storable };
45			$HAVE_STORABLE = 1 if $@ eq '';
46			$HAVE_DATA_DUMPER \|\| $HAVE_STORABLE \|\|
47			die "Could not find Data::Dumper nor Storable";
48			$Storable::forgive_me = 1;
49			}
50
51
52	ulpfr	13	=head2 Constructor create
53	ulpfr	10
54	ulpfr	13	$db = WAIT::Database->create(
55			name => <name>,
56			directory => <dir>
57			);
58
59			Create a new database.
60
61	ulpfr	10	=over 10
62
63			=item B<name> I<name>
64
65			mandatory
66
67			=item B<directory> I<directory>
68
69			Directory which should contain the database (defaults to the current
70			directory).
71
72			=item B<uniqueatt> I<true>
73
74			If given, the database will require unique attributes over all tables.
75
76	ulpfr	13	The method will croak on failure.
77	ulpfr	10
78	ulpfr	13	=back
79
80	ulpfr	10	=cut
81
82			sub create {
83			my $type = shift;
84			my %parm = @_;
85			my $self = {};
86			my $dir = $parm{directory} \|\| '.';
87	ulpfr	13	my $name = $parm{name};
88	ulpfr	10
89	ulpfr	13	unless ($name) {
90			croak("No name specified");
91			}
92	ulpfr	10
93	ulpfr	13	unless (-d $dir){
94			croak("Directory '$dir' does not exits: $!");
95			}
96
97			if (-d "$dir/$name") {
98			warn "Warning: Directory '$dir/$name' already exists";
99			} else {
100			unless (mkdir "$dir/$name", 0775) {
101			croak("Could not mkdir '$dir/$name': $!");
102			}
103			}
104
105	ulpfr	10	$self->{name} = $name;
106			$self->{file} = "$dir/$name";
107			$self->{uniqueatt} = $parm{uniqueatt};
108			$self->{mode} = O_CREAT;
109	dpavlin	86	my $lockmgr = LockFile::Simple->make(-autoclean => 1, -stale => 1);
110	ulpfr	19	# aquire a write lock
111			$self->{write_lock} = $lockmgr->lock("$dir/$name/write")
112			or die "Can't lock '$dir/$name/write'";
113	ulpfr	10	bless $self => ref($type) \|\| $type;
114			}
115
116
117	ulpfr	13	=head2 Constructor open
118	ulpfr	10
119	ulpfr	13	$db = WAIT::Database->open(
120			name => "foo",
121			directory => "bar"
122			);
123
124	ulpfr	10	Open an existing database I<foo> in directory I<bar>.
125
126			=cut
127
128			sub open {
129			my $type = shift;
130			my %parm = @_;
131			my $dir = $parm{directory} \|\| '.';
132			my $name = $parm{name} or croak "No name specified";
133			my $catalog = "$dir/$name/catalog";
134			my $meta = "$dir/$name/meta";
135			my $self;
136	ulpfr	13
137	ulpfr	10	if ($HAVE_STORABLE and -e $catalog
138			and (!-e $meta or -M $meta >= -M $catalog)) {
139			$self = Storable::retrieve($catalog);
140			} else {
141			return undef unless -f $meta;
142
143			$self = do $meta;
144			unless (defined $self) {
145	ulpfr	13	warn "do '$meta' did not work. Mysterious! Reverting to eval `cat $meta`";
146	ulpfr	10	sleep(4);
147			$self = eval `cat $meta`;
148			}
149			}
150
151	ulpfr	13	return unless defined $self;
152	ulpfr	10	$self->{mode} = (exists $parm{mode})?$parm{mode}:(O_CREAT \| O_RDWR);
153	ulpfr	19
154			if ($self->{mode} & O_RDWR) {
155			# Locking: We do not care about read access since write is atomic.
156	dpavlin	86	my $lockmgr = LockFile::Simple->make(-autoclean => 1, -stale => 1);
157	ulpfr	19
158			# aquire a write lock
159			$self->{write_lock} = $lockmgr->lock("$dir/$name/write")
160			or die "Can't lock '$dir/$name/write'";
161			}
162
163	ulpfr	10	$self;
164			}
165
166
167			=head2 C<$db-E<gt>dispose;>
168
169			Dispose a database. Remove all associated files. This may fail if the
170			database or one of its tables is still open. Failure will be indicated
171			by a false return value.
172
173			=cut
174
175			sub dispose {
176			my $dir;
177
178			if (ref $_[0]) { # called with instance
179			croak "Database readonly" unless $_[0]->{mode} & (O_CREAT \| O_RDWR);
180			$dir = $_[0]->{file};
181			$_[0]->close;
182			} else {
183			my $type = shift;
184			my %parm = @_;
185			my $base = $parm{directory} \|\| '.';
186			my $name = $parm{name} \|\| croak "No name specified";
187			$dir = "$base/$name";
188			}
189			croak "No such database '$dir'" unless -e "$dir/meta";
190
191	ulpfr	13	#warn "Running rmtree on dir[$dir]";
192			my $ret = rmtree($dir, 0, 1);
193			#warn "rmtree returned[$ret]";
194			$ret;
195	ulpfr	10	}
196
197
198			=head2 C<$db-E<gt>close;>
199
200			Close a database saving all meta data after closing all associated tables.
201
202			=cut
203
204			sub close {
205			my $self = $_[0];
206			my $file = $self->{file};
207			my $table;
208			my $did_save;
209	ulpfr	19
210	ulpfr	10	for $table (values %{$self->{tables}}) {
211			$table->close if ref($table);
212			}
213			return 1 unless $self->{mode} & (O_RDWR \| O_CREAT);
214
215	ulpfr	19	my $lock = delete $self->{write_lock}; # Do not store lock objects
216
217	ulpfr	10	if ($HAVE_DATA_DUMPER) {
218	ulpfr	19	my $fh = new FileHandle "> $file/meta.$$";
219	ulpfr	10	if ($fh) {
220			my $dumper = new Data::Dumper [$self],['self'];
221			$fh->print('my ');
222			$fh->print($dumper->Dumpxs);
223			$fh->close;
224	ulpfr	19	$did_save = rename "$file/meta.$$", "$file/meta";
225	ulpfr	10	} else {
226			croak "Could not open '$file/meta' for writing: $!";
227	ulpfr	13	# never reached: return unless $HAVE_STORABLE;
228	ulpfr	10	}
229			}
230
231			if ($HAVE_STORABLE) {
232	ulpfr	19	if (!eval {Storable::store($self, "$file/catalog.$$")}) {
233			unlink "$file/catalog.$$";
234			croak "Could not open '$file/catalog.$$' for writing: $!";
235	ulpfr	13	# never reached: return unless $did_save;
236	ulpfr	10	} else {
237	ulpfr	19	$did_save = rename "$file/catalog.$$", "$file/catalog";
238	ulpfr	10	}
239			}
240	ulpfr	19
241			$lock->release;
242
243	ulpfr	10	undef $_[0];
244			$did_save;
245			}
246
247
248	ulpfr	13	=head2 C<$db-E<gt>create_table(name =E<gt>> I<tname>, ... C<);>
249	ulpfr	10
250	ulpfr	13	Create a new table with name I<tname>. All parameters are passed to
251			C<WAIT::Table-E<gt>new> together with a filename to use. See
252			L<WAIT::Table> for which attributes are required. The method returns a
253			table handle (C<WAIT::Table::Handle>).
254	ulpfr	10
255			=cut
256
257			sub create_table {
258			my $self = shift;
259			my %parm = @_;
260	ulpfr	13	my $name = $parm{name} or croak "create_table: No name specified";
261			my $attr = $parm{attr} or croak "create_table: No attributes specified";
262	ulpfr	10	my $file = $self->{file};
263
264			croak "Database readonly" unless $self->{mode} & (O_CREAT \| O_RDWR);
265
266			if (defined $self->{tables}->{$name}) {
267			die "Table '$name' already exists";
268			}
269
270			if ($self->{uniqueatt}) {
271	ulpfr	13	for (@$attr) { # attribute names must be uniqe
272	ulpfr	10	if ($self->{attr}->{$_}) {
273	ulpfr	13	croak("Attribute '$_' is not unique")
274	ulpfr	10	}
275			}
276			}
277			$self->{tables}->{$name} = WAIT::Table->new(file => "$file/$name",
278			database => $self,
279			%parm);
280			unless (defined $self->{tables}->{$name}) {# fail gracefully
281			delete $self->{tables}->{$name};
282			return undef;
283			}
284
285			if ($self->{uniqueatt}) {
286			# remember table name for each attribute
287	ulpfr	13	map ($self->{attr}->{$_} = $name, @$attr);
288	ulpfr	10	}
289			WAIT::Table::Handle->new($self, $name);
290			}
291
292
293	ulpfr	13	=head2 C<$db-E<gt>table(name =E<gt>> I<tname>C<);>
294	ulpfr	10
295	ulpfr	13	Open a new table with name I<tname>. The method
296	ulpfr	19	returns a table handle (C<WAIT::Table::Handle>).
297	ulpfr	10
298			=cut
299
300			sub sync {
301			my $self = shift;
302
303			for (values %{$self->{tables}}) {
304			$_->sync;
305			}
306			}
307
308			sub table {
309			my $self = shift;
310			my %parm = @_;
311			my $name = $parm{name} or croak "No name specified";
312
313			if (defined $self->{tables}->{$name}) {
314			if (exists $parm{mode}) {
315			$self->{tables}->{$name}->{mode} = $parm{mode};
316			} else {
317			$self->{tables}->{$name}->{mode} = $self->{mode};
318			}
319			WAIT::Table::Handle->new($self,$name);
320			} else {
321	dpavlin	86	print STDERR "No such table '$name'\n";
322			return;
323	ulpfr	10	}
324			}
325
326
327	ulpfr	13	=head2 C<$db-E<gt>drop(name =E<gt>> I<tname>C<);>
328	ulpfr	10
329			Drop the table named I<tname>. The table should be closed before
330			calling B<drop>.
331
332			=cut
333
334			sub drop_table {
335			my $self = shift;
336			my %parm = @_;
337			my $name = $parm{name} or croak "No name specified";
338
339			croak "Database readonly" unless $self->{mode} & (O_CREAT \| O_RDWR);
340			if (!defined $self->{tables}->{$name}) {
341			croak "Table '$name' does not exist";
342			}
343			$self->{tables}->{$name}->drop;
344
345			if ($self->{uniqueatt}) {
346			# recycle attribute names
347			for (keys %{$self->{attr}}) {
348			delete $self->{attr}->{$_} if $self->{attr}->{$_} eq $name;
349			}
350			}
351			undef $self->{tables}->{$name}; # Call WAIT::Table::DESTROY here;
352			1;
353			}
354
355
356			1;
357
358
359			=head1 AUTHOR
360
361			Ulrich Pfeifer E<lt>F<pfeifer@ls6.informatik.uni-dortmund.de>E<gt>
362
363			=cut
364
365