SWE/DB/Lock.pm

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

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.
  ##
  ## In addition, if you are locking for an ID, then you can't lock
  ## for another ID.
  ##
  ## XXX Maybe we should get rid of IDs and Name locks because they
  ## conflict with ID and Names locks respectively.  Additionally,
  ## maybe we should remove Global lock as well.

  ## idgen is currently controled by Names lock.

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 ($CurrentlyLocking->{$lt}) {
      die qq[$0: It is currently locking for "$lt" so that it cannot be locked for the "$self_lt"];
    } elsif ($self_lt eq $lt) {
      last;
    }
  }

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

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

warn "XXX @{[$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	package SWE::DB::Lock;
2	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';
21
22	sub new ($) {
23	my $self = bless {
24	'file_name' => 'lock',
25	lock_type => 'Global',
26	}, shift;
27	return $self;
28	} # 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 ($) {
54	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}: $!";
62	flock $file, LOCK_EX;
63	$self->{lock} = $file;
64	} # lock
65
66	sub unlock ($) {
67	my $self = shift;
68
69	$CurrentlyLocking->{$self->lock_type}--;
70
71	close $self->{lock};
72	} # unlock
73
74	sub DESTROY ($) {
75	$_[0]->unlock;
76	} # DESTROY
77
78	1;