SWE/DB/Lock.pm

package SWE::DB::Lock;
use strict;
use warnings;

my $CurrentlyLocking = {};
my $LockTypes = [qw/
  ID Name Index IDs Names Graph Weight Global
/];
  # If you are locking for Graph, then you cannot lock for Global, but
  # still you can lock for ID.

use Fcntl ':flock';

sub new ($) {
  my $self = bless {
    'file_name' => 'lock',
    lock_type => 'Global',
  }, shift;
  return $self;
} # new

sub lock_type ($;$) {
  my $self = shift;
  if (@_) {
    $self->{lock_type} = shift;
  }
  return $self->{lock_type};
} # lock_type

sub check_lockability ($) {
  my $self = shift;
  
  my $self_lt = $self->lock_type;
  for my $lt (@$LockTypes) {
    if ($self_lt eq $lt) {
      last;
    } elsif ($CurrentlyLocking->{$lt}) {
      die qq[$0: It is currently locking for "$lt" so that it cannot be locked for the "$self_lt"];
    }
  }

  return 1;
} # check_lockability
                       
sub lock ($) {
  my $self = shift;

  $self->check_lockability;
  $CurrentlyLocking->{$self->lock_type}++;
warn "@{[$self->lock_type]} $CurrentlyLocking->{$self->lock_type} $self->{file_name}";
  
  open my $file, '>', $self->{file_name} or die "$0: $self->{file_name}: $!";
  flock $file, LOCK_EX;
  $self->{lock} = $file;
} # lock

sub unlock ($) {
  my $self = shift;

  $CurrentlyLocking->{$self->lock_type}--;

  close $self->{lock};
} # unlock

sub DESTROY ($) {
  $_[0]->unlock;
} # DESTROY

1;
1	wakaba	1.1	package SWE::DB::Lock;
2			use strict;
3	wakaba	1.2	use warnings;
4
5			my $CurrentlyLocking = {};
6			my $LockTypes = [qw/
7			ID Name Index IDs Names Graph Weight Global
8			/];
9			# If you are locking for Graph, then you cannot lock for Global, but
10			# still you can lock for ID.
11	wakaba	1.1
12			use Fcntl ':flock';
13
14			sub new ($) {
15			my $self = bless {
16			'file_name' => 'lock',
17	wakaba	1.2	lock_type => 'Global',
18	wakaba	1.1	}, shift;
19			return $self;
20			} # new
21
22	wakaba	1.2	sub lock_type ($;$) {
23			my $self = shift;
24			if (@_) {
25			$self->{lock_type} = shift;
26			}
27			return $self->{lock_type};
28			} # lock_type
29
30			sub check_lockability ($) {
31			my $self = shift;
32
33			my $self_lt = $self->lock_type;
34			for my $lt (@$LockTypes) {
35			if ($self_lt eq $lt) {
36			last;
37			} elsif ($CurrentlyLocking->{$lt}) {
38			die qq[$0: It is currently locking for "$lt" so that it cannot be locked for the "$self_lt"];
39			}
40			}
41
42			return 1;
43			} # check_lockability
44
45	wakaba	1.1	sub lock ($) {
46			my $self = shift;
47	wakaba	1.2
48			$self->check_lockability;
49			$CurrentlyLocking->{$self->lock_type}++;
50			warn "@{[$self->lock_type]} $CurrentlyLocking->{$self->lock_type} $self->{file_name}";
51	wakaba	1.1
52			open my $file, '>', $self->{file_name} or die "$0: $self->{file_name}: $!";
53			flock $file, LOCK_EX;
54			$self->{lock} = $file;
55			} # lock
56
57			sub unlock ($) {
58	wakaba	1.2	my $self = shift;
59
60			$CurrentlyLocking->{$self->lock_type}--;
61
62			close $self->{lock};
63	wakaba	1.1	} # unlock
64
65			sub DESTROY ($) {
66			$_[0]->unlock;
67			} # DESTROY
68
69			1;