AnyEvent-Tools

 view release on metacpan or  search on metacpan

lib/AnyEvent/Tools.pm  view on Meta::CPAN

In spite of event machine is started as one process, You may want to
share one resource between a lot of subprocesses.
Sometimes You also want to do  something with a  lot of data placed
in hashes/arrays.


=head1 FUNCTIONS

=head2 mutex

returns unlocked mutex.

This object provides the following methods:

=head3 lock(CODEREF)

You declare that You want to lock mutex. When it is possible the mutex will
be locked and Your callback will be called.

If the method is called in non-void context it returns guard object which can
be destroyed. So if You want You can cancel Your lockrequest.

Example:

    $mutex->lock(sub {
        my $guard = shift;
        ... # do something

        undef $guard;       # unlock mutex
    });

The callback receives a guard (see L<AnyEvent::Util#guard>) which unlocks the
mutex. Hold the guard while You need locked resourse.

=head3 is_locked

Returns B<TRUE> if mutex is locked now. Usually You shoudn't
use the function.


=head2 rw_mutex

returns unlocked read-write mutex.

This object provides the following methods:

=head3 rlock(CODEREF)

You declare that You want to lock mutex for reading. When it is
possible the mutex will be locked and Your callback will be called.

There may be a lot of read processes running simultaneously
that catch the lock.

=head3 wlock(CODEREF).

You declare that You want to lock mutex for writing. When it is
possible the mutex will be locked and Your callback will be called.

There may be only one write process that catches the lock.

Both callbacks receive a guard to hold the mutex locked.


=head3 rlock_limit(NUMBER)

Get/Set count limit for rlock. If an rlock request is come and this limit
is reached the request will be queued.


=head3 is_locked

Returns B<TRUE> if the mutex has 'read' or 'write' lock status.

=head3 is_rlocked

Returns B<TRUE> if the mutex has 'read' lock status.

B<Important>: this method returns B<FALSE> if the mutex is
wlocked (L<is_wlocked>), so if You want to know if any lock
is set, use the function L<is_locked>.

=head3 is_wlocked

Returns B<TRUE> if the mutex has 'write' lock status.

Usually You shoudn't use is_[rw]?locked functions.


=head2 async_repeat(COUNT, CALLBACK [, DONE_CALLBACK ])

Repeats calling Your callback(s).

    async_repeat 10, sub { $count++ };
    async_repeat 20, sub { $count++ }, sub { $done = 1 };

The function async_repeat returns the guard if it is called in non-void

lib/AnyEvent/Tools/Mutex.pm  view on Meta::CPAN

    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} };

lib/AnyEvent/Tools/Mutex.pm  view on Meta::CPAN

    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;
        }
    };

lib/AnyEvent/Tools/RWMutex.pm  view on Meta::CPAN

    }
}

sub rlock_limit
{
    my ($self, $value) = @_;
    return $self->{rlock_limit} if @_ == 1;
    return $self->{rlock_limit} = $value || 0;
}

sub is_wlocked
{
    my ($self) = @_;
    return $self->{wprocess};
}

sub is_rlocked
{
    my ($self) = @_;
    return $self->{rprocess};
}

sub is_locked
{
    my ($self) = @_;
    return $self->is_wlocked || $self->is_rlocked;
}

sub _add_client
{
    my ($self, $queue, $cb) = @_;
    my $name = ++$self->{hno};
    $self->{cache}{$name} = [ $queue, scalar @{ $self->{$queue} } ];
    push @{ $self->{$queue} }, [ $name, $cb ];
    return $name;
}

lib/AnyEvent/Tools/RWMutex.pm  view on Meta::CPAN

        next unless $_->[1] > $idx;
        next unless $_->[0] eq $queue;
        $_->[1]--;
    }
    return 1;
}

sub _check_mutex
{
    my ($self) = @_;
    return if $self->is_wlocked;

    my $info;

    if ($self->is_rlocked) {
        return if @{ $self->{wlock} };
        return unless @{ $self->{rlock} };
        goto LOCK_RMUTEX;
    }

    if (@{ $self->{wlock} }) {
        $info = $self->{wlock}[0];
        $self->_delete_client($info->[0]);
        $self->{wprocess}++;
        my $guard = guard {

t/01_mutex.t  view on Meta::CPAN

{
    my $mutex = mutex;

    my ($counter, $total) = (0, 0);

    my $cv = condvar AnyEvent;

    my ($timer1, $timer2, $timer3);
    $timer1 = AE::timer 0, 0.2 => sub {
        $total++;
        if ($mutex->is_locked) {
            $counter++;
        }
    };

    $timer2 = AE::timer 1, 0 => sub {
        $mutex->lock(sub {
            my ($g) = @_;
            undef $timer2;
            my $timer;
            $timer = AE::timer 2, 0 => sub {

t/01_mutex.t  view on Meta::CPAN

        return;
    };

    $timer3 = AE::timer 5, 0 => sub {
        $cv->send;
    };

    $cv->recv;

    ok $counter < 13 && $counter > 8,
        "Mutex was locked correct time ($counter/$total)";
}

{
    my $cv = condvar AnyEvent;
    my $mutex = mutex;
    my $idle;
    my %res;

    $mutex->lock(sub {
        my $start_time = time;