File: Manager.pm

package info (click to toggle)
liblockfile-simple-perl 0.2.5-7
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k, sarge
  • size: 100 kB
  • ctags: 57
  • sloc: perl: 507; makefile: 35; ansic: 1
file content (116 lines) | stat: -rw-r--r-- 2,077 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
;# $Id
;#
;#  Copyright (c) 1998-1999, Raphael Manfredi
;#  
;#  You may redistribute only under the terms of the Artistic License,
;#  as specified in the README file that comes with the distribution.
;#
;# $Log: Manager.pm,v $
;# Revision 0.2  1999/12/07 20:51:05  ram
;# Baseline for 0.2 release.
;#

use strict;

########################################################################
package LockFile::Manager;

#
# A pool of all created locks.
#

my $MANAGER = undef;		# The main manager

#
# ->make
#
# Creates a new LockFile::Manager to hold the locks.
#
# Attributes:
#
#	pool		hash of LockFile::Lock objects
#	wfunc		warning function to be called
#	efunc		error function to be called
#
sub make {
	my $self = bless {}, shift;
	my ($wfunc, $efunc) = @_;
	$self->{'pool'} = {};
	$self->{'wfunc'} = $wfunc;
	$self->{'efunc'} = $efunc;
	return $self;
}

#
# Attribute access
#

sub pool	{ $_[0]->{'pool'} }
sub wfunc	{ $_[0]->{'wfunc'} }
sub efunc	{ $_[0]->{'efunc'} }

#
# ->manager		-- "once" function
#
# Returns the main manager.
#
sub manager {
	my ($class, $wfunc, $efunc) = @_;
	return $MANAGER || ($MANAGER = $class->make($wfunc, $efunc));
}

#
# ->remember
#
# Remember created locks.
#
sub remember {
	my $self = shift;
	my ($lock) = @_;				# A LockFile::Lock object
	my $pool = $self->pool;
	if (exists $pool->{$lock}) {
		&{$self->efunc}("lock $lock already remembered");
		return;
	}
	$pool->{$lock} = $lock;
}

#
# ->forget
#
# Forget about a lock.
#
sub forget {
	my $self = shift;
	my ($lock) = @_;				# A LockFile::Lock object
	my $pool = $self->pool;
	unless (exists $pool->{$lock}) {
		&{$self->efunc}("lock $lock not remembered yet");
		return;
	}
	delete $pool->{$lock};
}

#
# ->release_all
#
# Release all the locks.
#
sub release_all {
	my $self = shift;
	my $pool = $self->pool;
	my $locks = scalar keys %$pool;
	return unless $locks;

	my $s = $locks == 1 ? '' : 's';
	&{$self->wfunc}("releasing $locks pending lock$s...");

	foreach my $lock (values %$pool) {
		$lock->release;
	}
}

sub END { $MANAGER->release_all if defined $MANAGER }

1;