/[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.3 by wakaba, Sun Jul 12 07:06:53 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  use Fcntl ':flock';  use Fcntl ':flock';
12    
13  sub new ($) {  sub new ($) {
14    my $self = bless {    my $self = bless {
15      'file_name' => 'lock',      'file_name' => 'lock',
16        lock_type => 'Global',
17    }, shift;    }, shift;
18    return $self;    return $self;
19  } # new  } # new
20    
21    sub lock_type ($;$) {
22      my $self = shift;
23      if (@_) {
24        $self->{lock_type} = shift;
25      }
26      return $self->{lock_type};
27    } # lock_type
28    
29    sub check_lockability ($) {
30      my $self = shift;
31      
32      my $self_lt = $self->lock_type;
33      for my $lt (@$LockTypes) {
34        if ($self_lt eq $lt) {
35          last;
36        } elsif ($CurrentlyLocking->{$lt}) {
37          die qq[$0: It is currently locking for "$lt" so that it cannot be locked for the "$self_lt"];
38        }
39      }
40    
41      return 1;
42    } # check_lockability
43                          
44  sub lock ($) {  sub lock ($) {
45    my $self = shift;    my $self = shift;
46    
47      $self->check_lockability;
48      $CurrentlyLocking->{$self->lock_type}++;
49    warn "@{[$self->lock_type]} $CurrentlyLocking->{$self->lock_type} $self->{file_name}";
50        
51    open my $file, '>', $self->{file_name} or die "$0: $self->{file_name}: $!";    open my $file, '>', $self->{file_name} or die "$0: $self->{file_name}: $!";
52    flock $file, LOCK_EX;    flock $file, LOCK_EX;
# Line 19  sub lock ($) { Line 54  sub lock ($) {
54  } # lock  } # lock
55    
56  sub unlock ($) {  sub unlock ($) {
57    close $_[0]->{lock};    my $self = shift;
58    
59      $CurrentlyLocking->{$self->lock_type}--;
60    
61      close $self->{lock};
62  } # unlock  } # unlock
63    
64  sub DESTROY ($) {  sub DESTROY ($) {

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.3

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24