/usr/share/perl5/AnyEvent/Tools/Mutex.pm is in libanyevent-tools-perl 0.12-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 | package AnyEvent::Tools::Mutex;
use Carp;
use AnyEvent::Util;
sub new
{
my ($class) = @_;
return bless {
queue => [],
cache => {},
hno => 0,
process => 0,
} => ref($class) || $class;
}
sub lock
{
my ($self, $cb) = @_;
croak 'Usage: $mutex->lock(sub { something })' unless 'CODE' eq ref $cb;
my $name = $self->_add_client($cb);
$self->_check_mutex;
return unless defined wantarray;
return unless keys %{ $self->{cache} };
return guard {
$self->_check_mutex if $self and $self->_delete_client($name)
};
}
sub is_locked
{
my ($self) = @_;
return $self->{process};
}
sub _add_client
{
my ($self, $cb) = @_;
my $name = ++$self->{hno};
$self->{cache}{$name} = @{ $self->{queue} };
push @{ $self->{queue} }, [ $name, $cb ];
return $name;
}
sub _delete_client
{
my ($self, $name) = @_;
return 0 unless exists $self->{cache}{$name};
my $idx = delete $self->{cache}{$name};
if ($idx == $#{ $self->{queue} }) {
pop @{ $self->{queue} };
return 1;
}
splice @{ $self->{queue} }, $idx, 1;
for (values %{ $self->{cache} }) {
next unless $_ > $idx;
$_--;
}
return 1;
}
sub _check_mutex
{
my ($self) = @_;
return if $self->is_locked;
return unless @{ $self->{queue} };
$self->{process}++;
my $info = $self->{queue}[0];
$self->_delete_client($info->[0]);
my $guard = guard {
if ($self) { # it can be aleady destroyed
$self->{process}--;
$self->_check_mutex;
}
};
$info->[1]->($guard);
}
1;
|