lib/WAIT/Database.pm

#                              -*- Mode: Cperl -*-
# Database --
# ITIID           : $ITI$ $Header $__Header$
# Author          : Ulrich Pfeifer
# Created On      : Thu Aug  8 09:44:13 1996
# Last Modified By: Ulrich Pfeifer
# Last Modified On: Sun May 30 18:34:08 1999
# Language        : CPerl
# Update Count    : 250
# Status          : Unknown, Use with caution!
#
# Copyright (c) 1996-1997, 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 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;
  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);
  $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);

  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 = 1;
    } 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")}) {
      croak "Could not open '$file/catalog' for writing: $!";
      # never reached: return unless $did_save;
    } else {
      $did_save++;
    }
  }
  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 {
    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	ulpfr	13	# -- Mode: Cperl --
2			# Database --
3	ulpfr	10	# ITIID : $ITI$ $Header $__Header$
4			# Author : Ulrich Pfeifer
5			# Created On : Thu Aug 8 09:44:13 1996
6			# Last Modified By: Ulrich Pfeifer
7	ulpfr	13	# Last Modified On: Sun May 30 18:34:08 1999
8	ulpfr	10	# Language : CPerl
9	ulpfr	13	# Update Count : 250
10	ulpfr	10	# Status : Unknown, Use with caution!
11	ulpfr	13	#
12	ulpfr	10	# Copyright (c) 1996-1997, Ulrich Pfeifer
13	ulpfr	13	#
14	ulpfr	10
15			=head1 NAME
16
17			WAIT::Database - Module fo maintaining WAIT databases
18
19			=head1 SYNOPSIS
20
21			require WAIT::Database;
22
23			=head1 DESCRIPTION
24
25			The modules handles creating, opening, and deleting of databases and
26			tables.
27
28			=cut
29
30			package WAIT::Database;
31
32			use strict;
33			use FileHandle ();
34			use File::Path qw(rmtree);
35			use WAIT::Table ();
36			use Fcntl;
37	ulpfr	13	use Carp; # will use autouse later
38			# 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			bless $self => ref($type) \|\| $type;
110			}
111
112
113	ulpfr	13	=head2 Constructor open
114	ulpfr	10
115	ulpfr	13	$db = WAIT::Database->open(
116			name => "foo",
117			directory => "bar"
118			);
119
120	ulpfr	10	Open an existing database I<foo> in directory I<bar>.
121
122			=cut
123
124			sub open {
125			my $type = shift;
126			my %parm = @_;
127			my $dir = $parm{directory} \|\| '.';
128			my $name = $parm{name} or croak "No name specified";
129			my $catalog = "$dir/$name/catalog";
130			my $meta = "$dir/$name/meta";
131			my $self;
132	ulpfr	13
133	ulpfr	10	if ($HAVE_STORABLE and -e $catalog
134			and (!-e $meta or -M $meta >= -M $catalog)) {
135			$self = Storable::retrieve($catalog);
136			} else {
137			return undef unless -f $meta;
138
139			$self = do $meta;
140			unless (defined $self) {
141	ulpfr	13	warn "do '$meta' did not work. Mysterious! Reverting to eval `cat $meta`";
142	ulpfr	10	sleep(4);
143			$self = eval `cat $meta`;
144			}
145			}
146
147	ulpfr	13	return unless defined $self;
148	ulpfr	10	$self->{mode} = (exists $parm{mode})?$parm{mode}:(O_CREAT \| O_RDWR);
149			$self;
150			}
151
152
153			=head2 C<$db-E<gt>dispose;>
154
155			Dispose a database. Remove all associated files. This may fail if the
156			database or one of its tables is still open. Failure will be indicated
157			by a false return value.
158
159			=cut
160
161			sub dispose {
162			my $dir;
163
164			if (ref $_[0]) { # called with instance
165			croak "Database readonly" unless $_[0]->{mode} & (O_CREAT \| O_RDWR);
166			$dir = $_[0]->{file};
167			$_[0]->close;
168			} else {
169			my $type = shift;
170			my %parm = @_;
171			my $base = $parm{directory} \|\| '.';
172			my $name = $parm{name} \|\| croak "No name specified";
173			$dir = "$base/$name";
174			}
175			croak "No such database '$dir'" unless -e "$dir/meta";
176
177	ulpfr	13	#warn "Running rmtree on dir[$dir]";
178			my $ret = rmtree($dir, 0, 1);
179			#warn "rmtree returned[$ret]";
180			$ret;
181	ulpfr	10	}
182
183
184			=head2 C<$db-E<gt>close;>
185
186			Close a database saving all meta data after closing all associated tables.
187
188			=cut
189
190			sub close {
191			my $self = $_[0];
192			my $file = $self->{file};
193			my $table;
194			my $did_save;
195
196			for $table (values %{$self->{tables}}) {
197			$table->close if ref($table);
198			}
199			return 1 unless $self->{mode} & (O_RDWR \| O_CREAT);
200
201			if ($HAVE_DATA_DUMPER) {
202			my $fh = new FileHandle "> $file/meta";
203			if ($fh) {
204			my $dumper = new Data::Dumper [$self],['self'];
205			$fh->print('my ');
206			$fh->print($dumper->Dumpxs);
207			$fh->close;
208			$did_save = 1;
209			} else {
210			croak "Could not open '$file/meta' for writing: $!";
211	ulpfr	13	# never reached: return unless $HAVE_STORABLE;
212	ulpfr	10	}
213			}
214
215			if ($HAVE_STORABLE) {
216			if (!eval {Storable::store($self, "$file/catalog")}) {
217	ulpfr	13	croak "Could not open '$file/catalog' for writing: $!";
218			# never reached: return unless $did_save;
219	ulpfr	10	} else {
220			$did_save++;
221			}
222			}
223			undef $_[0];
224			$did_save;
225			}
226
227
228	ulpfr	13	=head2 C<$db-E<gt>create_table(name =E<gt>> I<tname>, ... C<);>
229	ulpfr	10
230	ulpfr	13	Create a new table with name I<tname>. All parameters are passed to
231			C<WAIT::Table-E<gt>new> together with a filename to use. See
232			L<WAIT::Table> for which attributes are required. The method returns a
233			table handle (C<WAIT::Table::Handle>).
234	ulpfr	10
235			=cut
236
237			sub create_table {
238			my $self = shift;
239			my %parm = @_;
240	ulpfr	13	my $name = $parm{name} or croak "create_table: No name specified";
241			my $attr = $parm{attr} or croak "create_table: No attributes specified";
242	ulpfr	10	my $file = $self->{file};
243
244			croak "Database readonly" unless $self->{mode} & (O_CREAT \| O_RDWR);
245
246			if (defined $self->{tables}->{$name}) {
247			die "Table '$name' already exists";
248			}
249
250			if ($self->{uniqueatt}) {
251	ulpfr	13	for (@$attr) { # attribute names must be uniqe
252	ulpfr	10	if ($self->{attr}->{$_}) {
253	ulpfr	13	croak("Attribute '$_' is not unique")
254	ulpfr	10	}
255			}
256			}
257			$self->{tables}->{$name} = WAIT::Table->new(file => "$file/$name",
258			database => $self,
259			%parm);
260			unless (defined $self->{tables}->{$name}) {# fail gracefully
261			delete $self->{tables}->{$name};
262			return undef;
263			}
264
265			if ($self->{uniqueatt}) {
266			# remember table name for each attribute
267	ulpfr	13	map ($self->{attr}->{$_} = $name, @$attr);
268	ulpfr	10	}
269			WAIT::Table::Handle->new($self, $name);
270			}
271
272
273	ulpfr	13	=head2 C<$db-E<gt>table(name =E<gt>> I<tname>C<);>
274	ulpfr	10
275	ulpfr	13	Open a new table with name I<tname>. The method
276	ulpfr	10	returns a table handle (C<WAIT::Table::Handle).
277
278			=cut
279
280			sub sync {
281			my $self = shift;
282
283			for (values %{$self->{tables}}) {
284			$_->sync;
285			}
286			}
287
288			sub table {
289			my $self = shift;
290			my %parm = @_;
291			my $name = $parm{name} or croak "No name specified";
292
293			if (defined $self->{tables}->{$name}) {
294			if (exists $parm{mode}) {
295			$self->{tables}->{$name}->{mode} = $parm{mode};
296			} else {
297			$self->{tables}->{$name}->{mode} = $self->{mode};
298			}
299			WAIT::Table::Handle->new($self,$name);
300			} else {
301			croak "No such table '$name'";
302			}
303			}
304
305
306	ulpfr	13	=head2 C<$db-E<gt>drop(name =E<gt>> I<tname>C<);>
307	ulpfr	10
308			Drop the table named I<tname>. The table should be closed before
309			calling B<drop>.
310
311			=cut
312
313			sub drop_table {
314			my $self = shift;
315			my %parm = @_;
316			my $name = $parm{name} or croak "No name specified";
317
318			croak "Database readonly" unless $self->{mode} & (O_CREAT \| O_RDWR);
319			if (!defined $self->{tables}->{$name}) {
320			croak "Table '$name' does not exist";
321			}
322			$self->{tables}->{$name}->drop;
323
324			if ($self->{uniqueatt}) {
325			# recycle attribute names
326			for (keys %{$self->{attr}}) {
327			delete $self->{attr}->{$_} if $self->{attr}->{$_} eq $name;
328			}
329			}
330			undef $self->{tables}->{$name}; # Call WAIT::Table::DESTROY here;
331			1;
332			}
333
334
335			1;
336
337
338			=head1 AUTHOR
339
340			Ulrich Pfeifer E<lt>F<pfeifer@ls6.informatik.uni-dortmund.de>E<gt>
341
342			=cut
343
344