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.

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	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	use Fcntl ':flock';
12
13	sub new ($) {
14	my $self = bless {
15	'file_name' => 'lock',
16	lock_type => 'Global',
17	}, shift;
18	return $self;
19	} # 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 ($) {
45	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}: $!";
52	flock $file, LOCK_EX;
53	$self->{lock} = $file;
54	} # lock
55
56	sub unlock ($) {
57	my $self = shift;
58
59	$CurrentlyLocking->{$self->lock_type}--;
60
61	close $self->{lock};
62	} # unlock
63
64	sub DESTROY ($) {
65	$_[0]->unlock;
66	} # DESTROY
67
68	1;