libanyevent-tools-perl 0.12-1 / usr / share / perl5 / AnyEvent / Tools / Pool.pm

This file is indexed.

/usr/share/perl5/AnyEvent/Tools/Pool.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
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
use utf8;
use strict;
use warnings;

package AnyEvent::Tools::Pool;
use Carp;
use AnyEvent::Util;

sub new
{
    my $class = shift;

    my $self = bless {
        pool    => {},
        no      => 0,
        queue   => [],
        free    => [],
        delete  => [],

    } => ref($class) || $class;

    $self->push($_) for @_;

    return $self;
}


sub delete
{
    my ($self, $no, $cb) = @_;
    croak "Can't find object: $no" unless exists $self->{pool}{$no};
    croak "Callback must be CODEREF" if $cb and ref($cb) ne 'CODE';
    push @{ $self->{delete} }, [ $no, $cb ];
    $self->_check_pool;
    return;
}

sub push :method
{
    croak 'usage: $pool->push($object)' unless @_ == 2;
    my ($self, $object) = @_;
    my $no = $self->{no}++;
    push @{ $self->{free} }, $no;
    $self->{pool}{$no} = $object;
    $self->_check_pool;
    return $no;
}


sub get
{
    croak 'usage: $pool->get(sub { ($g, $o) = @_ .. })' unless @_ == 2;
    my ($self, $cb) = @_;
    croak 'Callback must be coderef', unless 'CODE' eq ref $cb;
    push @{ $self->{queue} }, $cb;
    $self->_check_pool;
    return;
}

sub _check_pool
{
    my ($self) = @_;

    return unless @{ $self->{free} };

    # delete  object
    if (@{ $self->{delete} }) {
        CHECK_CYCLE:
            for (my $di = $#{ $self->{delete} }; $di >= 0; $di--) {
                for (my $fi = $#{ $self->{free} }; $fi >= 0; $fi--) {
                    if ($self->{free}[$fi] == $self->{delete}[$di][0]) {
                        my ($no, $cb) = @{ $self->{delete}[$di] };
                        splice @{ $self->{free} }, $fi, 1;
                        splice @{ $self->{delete} }, $di, 1;
                        delete $self->{pool}{$no};
                        if ($cb) {
                            $cb->();
                            goto &_check_pool if $self;
                            return;
                        }
                        next CHECK_CYCLE;
                    }
                }
            }

        return unless @{ $self->{free} };
    }

    return unless @{ $self->{queue} };

    my $ono = shift @{ $self->{free} };
    my $cb = shift @{ $self->{queue} };

    my $guard = guard {
        if ($self) {        # can be destroyed
            push @{ $self->{free} }, $ono;
            $self->_check_pool;
        }
    };

    $cb->($guard, $self->{pool}{$ono});
}
1;

APT Browse - Built by Thomas Orozco.