/[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 18 by ulpfr, Fri Apr 28 15:42:44 2000 UTC revision 19 by ulpfr, Tue May 9 11:29:45 2000 UTC
# Line 1  Line 1 
1  #                              -*- Mode: Cperl -*-  #                              -*- Mode: Perl -*-
2  # Database --  # $Basename: Database.pm $
3  # ITIID           : $ITI$ $Header $__Header$  # $Revision: 1.14 $
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 May 30 18:34:08 1999  # Last Modified On: Sat Apr 15 16:15:29 2000
8  # Language        : CPerl  # Language        : CPerl
9  # Update Count    : 250  #
10  # Status          : Unknown, Use with caution!  # (C) Copyright 1996-2000, Ulrich Pfeifer
11  #  #
 # Copyright (c) 1996-1997, Ulrich Pfeifer  
 #  
12    
13  =head1 NAME  =head1 NAME
14    
# Line 35  use File::Path qw(rmtree); Line 33  use File::Path qw(rmtree);
33  use WAIT::Table ();  use WAIT::Table ();
34  use Fcntl;  use Fcntl;
35  use Carp; # will use autouse later  use Carp; # will use autouse later
36    use LockFile::Simple ();
37    
38  # use autouse Carp => qw( croak($) );  # use autouse Carp => qw( croak($) );
39  my ($HAVE_DATA_DUMPER, $HAVE_STORABLE);  my ($HAVE_DATA_DUMPER, $HAVE_STORABLE);
40    
# Line 106  sub create { Line 106  sub create {
106    $self->{file}      = "$dir/$name";    $self->{file}      = "$dir/$name";
107    $self->{uniqueatt} = $parm{uniqueatt};    $self->{uniqueatt} = $parm{uniqueatt};
108    $self->{mode}      = O_CREAT;    $self->{mode}      = O_CREAT;
109      my $lockmgr = LockFile::Simple->make(-autoclean => 1);
110      # aquire a write lock
111      $self->{write_lock} = $lockmgr->lock("$dir/$name/write")
112        or die "Can't lock '$dir/$name/write'";
113    bless $self => ref($type) || $type;    bless $self => ref($type) || $type;
114  }  }
115    
# Line 146  sub open { Line 150  sub open {
150    
151    return unless defined $self;    return unless defined $self;
152    $self->{mode} = (exists $parm{mode})?$parm{mode}:(O_CREAT | O_RDWR);    $self->{mode} = (exists $parm{mode})?$parm{mode}:(O_CREAT | O_RDWR);
153    
154      if ($self->{mode} & O_RDWR) {
155        # Locking: We do not care about read access since write is atomic.
156        my $lockmgr = LockFile::Simple->make(-autoclean => 1);
157        
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    $self;    $self;
164  }  }
165    
# Line 192  sub close { Line 206  sub close {
206    my $file = $self->{file};    my $file = $self->{file};
207    my $table;    my $table;
208    my $did_save;    my $did_save;
209      
210    for $table (values %{$self->{tables}}) {    for $table (values %{$self->{tables}}) {
211      $table->close if ref($table);      $table->close if ref($table);
212    }    }
213    return 1 unless $self->{mode} & (O_RDWR | O_CREAT);    return 1 unless $self->{mode} & (O_RDWR | O_CREAT);
214    
215      my $lock = delete $self->{write_lock}; # Do not store lock objects
216    
217    if ($HAVE_DATA_DUMPER) {    if ($HAVE_DATA_DUMPER) {
218      my $fh   = new FileHandle "> $file/meta";      my $fh   = new FileHandle "> $file/meta.$$";
219      if ($fh) {      if ($fh) {
220        my $dumper = new Data::Dumper [$self],['self'];        my $dumper = new Data::Dumper [$self],['self'];
221        $fh->print('my ');        $fh->print('my ');
222        $fh->print($dumper->Dumpxs);        $fh->print($dumper->Dumpxs);
223        $fh->close;        $fh->close;
224        $did_save = 1;        $did_save = rename "$file/meta.$$", "$file/meta";
225      } else {      } else {
226        croak "Could not open '$file/meta' for writing: $!";        croak "Could not open '$file/meta' for writing: $!";
227        # never reached: return unless $HAVE_STORABLE;        # never reached: return unless $HAVE_STORABLE;
# Line 213  sub close { Line 229  sub close {
229    }    }
230    
231    if ($HAVE_STORABLE) {    if ($HAVE_STORABLE) {
232      if (!eval {Storable::store($self, "$file/catalog")}) {      if (!eval {Storable::store($self, "$file/catalog.$$")}) {
233        croak "Could not open '$file/catalog' for writing: $!";        unlink "$file/catalog.$$";
234          croak "Could not open '$file/catalog.$$' for writing: $!";
235        # never reached: return unless $did_save;        # never reached: return unless $did_save;
236      } else {      } else {
237        $did_save++;        $did_save = rename "$file/catalog.$$", "$file/catalog";
238      }      }
239    }    }
240    
241      $lock->release;
242      
243    undef $_[0];    undef $_[0];
244    $did_save;    $did_save;
245  }  }
# Line 273  sub create_table { Line 293  sub create_table {
293  =head2 C<$db-E<gt>table(name =E<gt>> I<tname>C<);>  =head2 C<$db-E<gt>table(name =E<gt>> I<tname>C<);>
294    
295  Open a new table with name I<tname>. The method  Open a new table with name I<tname>. The method
296  returns a table handle (C<WAIT::Table::Handle).  returns a table handle (C<WAIT::Table::Handle>).
297    
298  =cut  =cut
299    
Legend:
Removed from v.18  
changed lines
  Added in v.19
  ViewVC Help
Powered by ViewVC 1.1.26