lib/WAIT/Database.pm

#                              -*- Mode: Perl -*- 
# 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 Nov 22 18:44:48 1998
# Language        : CPerl
# Update Count    : 249
# 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;
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 C<$db = create WAIT::Database name =>E<gt> I<name> C<directory =E<gt>> I<dir>C<;>

=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 function will return undef and set C<$@> on failure.

=cut

sub create {
  my $type = shift;
  my %parm = @_;
  my $self = {};
  my $dir  = $parm{directory} || '.';
  my $name = $parm{name}      or croak "No name specified";

  croak "Directory '$dir' does not exits: $!" unless -d $dir;
  croak "Directory '$name' already exists"    if -d "$dir/$name";
  mkdir "$dir/$name", 0775 or 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 C<$db = open WAIT::Database name =E<gt>> I<name> C<directory =E<gt>> I<dir>C<;>

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 "\ado '$meta' did not work. Mysterious! Reverting to eval `cat $meta`\n";
      sleep(4);
      $self = eval `cat $meta`;
    }
  }

  return $self 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";

  rmtree($dir, 0, 1);
}


=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: $!";
      return unless $HAVE_STORABLE;
    }
  }

  if ($HAVE_STORABLE) {
    if (!eval {Storable::store($self, "$file/catalog")}) {
      fail ("Could not open '$file/catalog' for writing: $!");
      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 paraeters are passed to
C<WAIT::Table::new> together with a filename to use. The function
returns a table handle (C<WAIT::Table::Handle>).

=cut

sub create_table {
  my $self = shift;
  my %parm = @_;
  my $name = $parm{name} || return fail("No name 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 (@{$parm{attr}}) {      # attribute names must be uniqe
      if ($self->{attr}->{$_}) {
        return fail ("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, @{$parm{attr}});
  }
  WAIT::Table::Handle->new($self, $name);
}


=head2 <$db-E<gt>table name =E<gt>> I<tname>C<;>

Open a new table with name I<tname>. The function
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;
}


package WAIT::Table::Handle;

use Carp;


sub new {
  my ($type, $database, $name) = @_;

  bless [$database, $name], $type;
}


sub AUTOLOAD {
  my $func = $WAIT::Table::Handle::AUTOLOAD; $func =~ s/.*:://;
  my $self = $_[0];
  my ($database, $name) = @{$self};
  if (defined $database->{tables}->{$name}) {
    if ($func eq 'drop') {
      $database->drop_table(name => $name);
      undef $_[0];
      1;
    } elsif ($func ne 'DESTROY') {
      shift @_;
      if ($func eq 'open') {
        $database->{tables}->{$name}->$func(mode => $database->{mode}, @_);
      } else {
        $database->{tables}->{$name}->$func(@_);
      }
    }
  } else {
    return fail("Invalid handle\n");
  }
}


1;


=head1 AUTHOR

Ulrich Pfeifer E<lt>F<pfeifer@ls6.informatik.uni-dortmund.de>E<gt>

=cut


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