/[wait]/branches/CPAN/lib/WAIT/Database.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /branches/CPAN/lib/WAIT/Database.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 12 by unknown, Fri Apr 28 15:41:10 2000 UTC revision 13 by ulpfr, Fri Apr 28 15:42:44 2000 UTC
# Line 1  Line 1 
1  #                              -*- Mode: Perl -*-  #                              -*- Mode: Cperl -*-
2  # Database --  # Database --
3  # ITIID           : $ITI$ $Header $__Header$  # ITIID           : $ITI$ $Header $__Header$
4  # Author          : Ulrich Pfeifer  # Author          : Ulrich Pfeifer
5  # Created On      : Thu Aug  8 09:44:13 1996  # Created On      : Thu Aug  8 09:44:13 1996
6  # Last Modified By: Ulrich Pfeifer  # Last Modified By: Ulrich Pfeifer
7  # Last Modified On: Sun Nov 22 18:44:48 1998  # Last Modified On: Sun May 30 18:34:08 1999
8  # Language        : CPerl  # Language        : CPerl
9  # Update Count    : 249  # Update Count    : 250
10  # Status          : Unknown, Use with caution!  # Status          : Unknown, Use with caution!
11  #  #
12  # Copyright (c) 1996-1997, Ulrich Pfeifer  # Copyright (c) 1996-1997, Ulrich Pfeifer
13  #  #
14    
15  =head1 NAME  =head1 NAME
16    
# Line 34  use FileHandle (); Line 34  use FileHandle ();
34  use File::Path qw(rmtree);  use File::Path qw(rmtree);
35  use WAIT::Table ();  use WAIT::Table ();
36  use Fcntl;  use Fcntl;
37  use Carp;  use Carp; # will use autouse later
38    # use autouse Carp => qw( croak($) );
39  my ($HAVE_DATA_DUMPER, $HAVE_STORABLE);  my ($HAVE_DATA_DUMPER, $HAVE_STORABLE);
40    
41  BEGIN {  BEGIN {
# Line 48  BEGIN { Line 49  BEGIN {
49  }  }
50    
51    
52  =head2 C<$db = create WAIT::Database name =>E<gt> I<name> C<directory =E<gt>> I<dir>C<;>  =head2 Constructor create
53    
54      $db = WAIT::Database->create(
55                                   name      => <name>,
56                                   directory => <dir>
57                                  );
58    
59    Create a new database.
60    
61  =over 10  =over 10
62    
# Line 65  directory). Line 73  directory).
73    
74  If given, the database will require unique attributes over all tables.  If given, the database will require unique attributes over all tables.
75    
76  The function will return undef and set C<$@> on failure.  The method will croak on failure.
77    
78    =back
79    
80  =cut  =cut
81    
# Line 74  sub create { Line 84  sub create {
84    my %parm = @_;    my %parm = @_;
85    my $self = {};    my $self = {};
86    my $dir  = $parm{directory} || '.';    my $dir  = $parm{directory} || '.';
87    my $name = $parm{name}      or croak "No name specified";    my $name = $parm{name};
88    
89      unless ($name) {
90        croak("No name specified");
91      }
92    
93      unless (-d $dir){
94        croak("Directory '$dir' does not exits: $!");
95      }
96    
97    croak "Directory '$dir' does not exits: $!" unless -d $dir;    if (-d "$dir/$name") {
98    croak "Directory '$name' already exists"    if -d "$dir/$name";      warn "Warning: Directory '$dir/$name' already exists";
99    mkdir "$dir/$name", 0775 or croak "Could not mkdir '$dir/$name': $!";    } else {
100        unless (mkdir "$dir/$name", 0775) {
101          croak("Could not mkdir '$dir/$name': $!");
102        }
103      }
104    
105    $self->{name}      = $name;    $self->{name}      = $name;
106    $self->{file}      = "$dir/$name";    $self->{file}      = "$dir/$name";
# Line 88  sub create { Line 110  sub create {
110  }  }
111    
112    
113  =head2 C<$db = open WAIT::Database name =E<gt>> I<name> C<directory =E<gt>> I<dir>C<;>  =head2 Constructor open
114    
115      $db = WAIT::Database->open(
116                                 name => "foo",
117                                 directory => "bar"
118                                );
119    
120  Open an existing database I<foo> in directory I<bar>.  Open an existing database I<foo> in directory I<bar>.
121    
# Line 102  sub open { Line 129  sub open {
129    my $catalog = "$dir/$name/catalog";    my $catalog = "$dir/$name/catalog";
130    my $meta    = "$dir/$name/meta";    my $meta    = "$dir/$name/meta";
131    my $self;    my $self;
132      
133    if ($HAVE_STORABLE and -e $catalog    if ($HAVE_STORABLE and -e $catalog
134        and (!-e $meta or -M $meta >= -M $catalog)) {        and (!-e $meta or -M $meta >= -M $catalog)) {
135      $self = Storable::retrieve($catalog);      $self = Storable::retrieve($catalog);
# Line 111  sub open { Line 138  sub open {
138    
139      $self = do $meta;      $self = do $meta;
140      unless (defined $self) {      unless (defined $self) {
141        warn "\ado '$meta' did not work. Mysterious! Reverting to eval `cat $meta`\n";        warn "do '$meta' did not work. Mysterious! Reverting to eval `cat $meta`";
142        sleep(4);        sleep(4);
143        $self = eval `cat $meta`;        $self = eval `cat $meta`;
144      }      }
145    }    }
146    
147    return $self unless defined $self;    return unless defined $self;
148    $self->{mode} = (exists $parm{mode})?$parm{mode}:(O_CREAT | O_RDWR);    $self->{mode} = (exists $parm{mode})?$parm{mode}:(O_CREAT | O_RDWR);
149    $self;    $self;
150  }  }
# Line 147  sub dispose { Line 174  sub dispose {
174    }    }
175    croak "No such database '$dir'" unless -e "$dir/meta";    croak "No such database '$dir'" unless -e "$dir/meta";
176    
177    rmtree($dir, 0, 1);    #warn "Running rmtree on dir[$dir]";
178      my $ret = rmtree($dir, 0, 1);
179      #warn "rmtree returned[$ret]";
180      $ret;
181  }  }
182    
183    
# Line 178  sub close { Line 208  sub close {
208        $did_save = 1;        $did_save = 1;
209      } else {      } else {
210        croak "Could not open '$file/meta' for writing: $!";        croak "Could not open '$file/meta' for writing: $!";
211        return unless $HAVE_STORABLE;        # never reached: return unless $HAVE_STORABLE;
212      }      }
213    }    }
214    
215    if ($HAVE_STORABLE) {    if ($HAVE_STORABLE) {
216      if (!eval {Storable::store($self, "$file/catalog")}) {      if (!eval {Storable::store($self, "$file/catalog")}) {
217        fail ("Could not open '$file/catalog' for writing: $!");        croak "Could not open '$file/catalog' for writing: $!";
218        return unless $did_save;        # never reached: return unless $did_save;
219      } else {      } else {
220        $did_save++;        $did_save++;
221      }      }
# Line 195  sub close { Line 225  sub close {
225  }  }
226    
227    
228  =head2 C<$db-E<gt>create_table name =E<gt>> I<tname> ... C<;>  =head2 C<$db-E<gt>create_table(name =E<gt>> I<tname>, ... C<);>
229    
230  Create a new table with name I<tname>. All paraeters are passed to  Create a new table with name I<tname>. All parameters are passed to
231  C<WAIT::Table::new> together with a filename to use. The function  C<WAIT::Table-E<gt>new> together with a filename to use. See
232  returns a table handle (C<WAIT::Table::Handle>).  L<WAIT::Table> for which attributes are required. The method returns a
233    table handle (C<WAIT::Table::Handle>).
234    
235  =cut  =cut
236    
237  sub create_table {  sub create_table {
238    my $self = shift;    my $self = shift;
239    my %parm = @_;    my %parm = @_;
240    my $name = $parm{name} || return fail("No name specified");    my $name = $parm{name} or croak "create_table: No name specified";
241      my $attr = $parm{attr} or croak "create_table: No attributes specified";
242    my $file = $self->{file};    my $file = $self->{file};
243    
244    croak "Database readonly" unless $self->{mode} & (O_CREAT | O_RDWR);    croak "Database readonly" unless $self->{mode} & (O_CREAT | O_RDWR);
# Line 216  sub create_table { Line 248  sub create_table {
248    }    }
249    
250    if ($self->{uniqueatt}) {    if ($self->{uniqueatt}) {
251      for (@{$parm{attr}}) {      # attribute names must be uniqe      for (@$attr) {      # attribute names must be uniqe
252        if ($self->{attr}->{$_}) {        if ($self->{attr}->{$_}) {
253          return fail ("Attribute '$_' is not unique")          croak("Attribute '$_' is not unique")
254        }        }
255      }      }
256    }    }
# Line 232  sub create_table { Line 264  sub create_table {
264    
265    if ($self->{uniqueatt}) {    if ($self->{uniqueatt}) {
266      # remember table name for each attribute      # remember table name for each attribute
267      map ($self->{attr}->{$_} = $name, @{$parm{attr}});      map ($self->{attr}->{$_} = $name, @$attr);
268    }    }
269    WAIT::Table::Handle->new($self, $name);    WAIT::Table::Handle->new($self, $name);
270  }  }
271    
272    
273  =head2 <$db-E<gt>table name =E<gt>> I<tname>C<;>  =head2 C<$db-E<gt>table(name =E<gt>> I<tname>C<);>
274    
275  Open a new table with name I<tname>. The function  Open a new table with name I<tname>. The method
276  returns a table handle (C<WAIT::Table::Handle).  returns a table handle (C<WAIT::Table::Handle).
277    
278  =cut  =cut
# Line 271  sub table { Line 303  sub table {
303  }  }
304    
305    
306  =head2 C<$db-E<gt>drop  name =E<gt>> I<tname>C<;>  =head2 C<$db-E<gt>drop(name =E<gt>> I<tname>C<);>
307    
308  Drop the table named I<tname>. The table should be closed before  Drop the table named I<tname>. The table should be closed before
309  calling B<drop>.  calling B<drop>.
# Line 300  sub drop_table { Line 332  sub drop_table {
332  }  }
333    
334    
 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");  
   }  
 }  
   
   
335  1;  1;
336    
337    
Legend:
Removed from v.12  
changed lines
  Added in v.13
  ViewVC Help
Powered by ViewVC 1.1.26