/[suikacvs]/webroot/swe/lib/SWE/DB/Lock.pm
Suika

Diff of /webroot/swe/lib/SWE/DB/Lock.pm

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

revision 1.1 by wakaba, Sun Nov 9 06:46:47 2008 UTC revision 1.5 by wakaba, Mon Sep 21 09:10:40 2009 UTC
# Line 1  Line 1 
1  package SWE::DB::Lock;  package SWE::DB::Lock;
2  use strict;  use strict;
3    
4    my $CurrentlyLocking = {};
5    my $LockTypes = [qw/
6      ID Name Index IDs Names Graph Weight Global
7    /];
8      ## If you are locking for Graph, then you cannot lock for Global, but
9      ## still you can lock for ID.
10      ##
11      ## In addition, if you are locking for an ID, then you can't lock
12      ## for another ID.
13      ##
14      ## XXX Maybe we should get rid of IDs and Name locks because they
15      ## conflict with ID and Names locks respectively.  Additionally,
16      ## maybe we should remove Global lock as well.
17    
18      ## idgen is currently controled by Names lock.
19    
20  use Fcntl ':flock';  use Fcntl ':flock';
21    
22  sub new ($) {  sub new ($) {
23    my $self = bless {    my $self = bless {
24      'file_name' => 'lock',      'file_name' => 'lock',
25        lock_type => 'Global',
26    }, shift;    }, shift;
27    return $self;    return $self;
28  } # new  } # new
29    
30    sub lock_type ($;$) {
31      my $self = shift;
32      if (@_) {
33        $self->{lock_type} = shift;
34      }
35      return $self->{lock_type};
36    } # lock_type
37    
38    sub check_lockability ($) {
39      my $self = shift;
40      
41      my $self_lt = $self->lock_type;
42      for my $lt (@$LockTypes) {
43        if ($CurrentlyLocking->{$lt}) {
44          die qq[$0: It is currently locking for "$lt" so that it cannot be locked for the "$self_lt"];
45        } elsif ($self_lt eq $lt) {
46          last;
47        }
48      }
49    
50      return 1;
51    } # check_lockability
52                          
53  sub lock ($) {  sub lock ($) {
54    my $self = shift;    my $self = shift;
55    
56      $self->check_lockability;
57      $CurrentlyLocking->{$self->lock_type}++;
58    
59    warn "XXX @{[$self->lock_type]} $CurrentlyLocking->{$self->lock_type} $self->{file_name}";
60        
61    open my $file, '>', $self->{file_name} or die "$0: $self->{file_name}: $!";    open my $file, '>', $self->{file_name} or die "$0: $self->{file_name}: $!";
62    flock $file, LOCK_EX;    flock $file, LOCK_EX;
# Line 19  sub lock ($) { Line 64  sub lock ($) {
64  } # lock  } # lock
65    
66  sub unlock ($) {  sub unlock ($) {
67    close $_[0]->{lock};    my $self = shift;
68    
69      $CurrentlyLocking->{$self->lock_type}--;
70    
71      close $self->{lock};
72  } # unlock  } # unlock
73    
74  sub DESTROY ($) {  sub DESTROY ($) {
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.5
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24