File Coverage

blib/lib/POE/Component/DBIAgent/Queue.pm

Criterion	Covered	Total	%
statement	9	53	16.9
branch	0	6	0.0
condition	0	2	0.0
subroutine	3	20	15.0
pod	11	11	100.0
total	23	92	25.0

package POE::Component::DBIAgent::Queue;

=head1 NAME

POE::Component::DBIAgent::Queue -- Helper class for managing a
round-robin queue of Po:Co:DBIAgent:Helper's.

=cut

####  originally by Fletch
####  originally by Fletch
####  originally by Fletch
####  See the credits in the AUTHOR section of the POD.

=head1 SYNOPSIS



=head1 DESCRIPTION


=cut

$VERSION = sprintf("%d.%02d", q$Revision: 0.02 $ =~ /(\d+)\.(\d+)/);

use strict;

use Carp qw/ croak carp /;

use Class::MethodMaker
  new_with_init => 'new',
  new_hash_init => 'hash_init',
  list          => [ qw( _queue ) ],
  ;


=head2 Methods

This are the methods we recognize:

=over 4

=item init

init the queue (currently noop)

=cut

sub init {
    my $self = shift;

    return $self;
}


=item add

append argument to the queue

=cut

sub add { $_[0]->_queue_push( $_[1] ) }

=item clear

Clear the queue

=cut

sub clear { $_[0]->_queue_clear }

## Internal use only
## _find_by -- Return indicies in queue for which supplied predicate
##             returns true
##
sub _find_by {
    my( $self, $predicate ) = @_;
    my $queue = $self->_queue;
    my @ret = grep $predicate->( $queue->[ $_ ] ), 0..$#{$queue};
    return wantarray ? @ret : $ret[0];
}

=item find_by_pid

Find the index of helper with specified pid

=cut

sub find_by_pid {
    my( $self, $pid ) = @_;
    return $self->_find_by( sub { $_[0]->PID == $pid } );
}

=item find_by_wheelid

Find the index of helper with specified wheel id

=cut

sub find_by_wheelid {
    my( $self, $wheel_id ) = @_;
    return $self->_find_by( sub { $_[0]->ID == $wheel_id } );
}

## Internal use only
## _remove_by -- Remove first item from the queue for which supplied
##               predicate returns true
##
sub _remove_by {
    my( $self, $predicate ) = @_;
    my $index = ( $self->_find_by( $predicate ) )[0];

    return splice( @{scalar $self->_queue}, $index, 1 ) if defined $index;

    return
}

=item remove_by_pid

Remove helper with specified pid

=cut

sub remove_by_pid {
    my( $self, $pid ) = @_;
    $self->_remove_by( sub { $_[0]->PID == $pid } );
}

=item remove_by_wheelid

Remove helper with specified wheel id

=cut

sub remove_by_wheelid {
    my( $self, $wheel_id ) = @_;
    $self->_remove_by( sub { $_[0]->ID == $wheel_id } );
}

=item next

Get next helper off the head of the queue (and put it back on the end
(round robin))

=cut

sub next {
    my $self = shift;
    my $ret = $self->_queue_shift;
    $self->_queue_push( $ret );
    return $ret
}

=item make_next

Force the helper with the specified wheel id to the head of the queue.

=cut

sub make_next {
    my $self = shift;
    my $id = shift;
    my $ret = $self->remove_by_wheelid( $id );
    $self->_queue_unshift( $ret );
}

=item exit_all

Tell all our helpers to exit gracefully.

=cut

sub exit_all {
    my $self = shift;
    #++ modified command to stop POE::Filter::Reference moaning
    $_->put({query => "EXIT"}) foreach $self->_queue;
}


=item kill_all

Send the specified signal (default SIGTERM) to all helper processes

=cut

sub kill_all {
    my $self = shift;
    my $sig = shift || 'TERM';

    my @helpers = map { $_->PID } $self->_queue;
    if (@helpers) {
	kill $sig => @helpers;
    }

    # Causes @helpers to be empty on subsequent kill_all() calls.  This
    # was here already; I'm just commenting it.
    $self->_queue_clear;

    return
}

=back

=cut

1;

__END__