File Coverage

blib/lib/Net/Gearman.pm

Criterion	Covered	Total	%
statement	52	52	100.0
branch	1	2	50.0
condition	4	6	66.6
subroutine	12	12	100.0
pod	1	4	25.0
total	70	76	92.1

#  You may distribute under the terms of either the GNU General Public License
#  or the Artistic License (the same terms as Perl itself)
#
#  (C) Paul Evans, 2014,2026 -- [e-mail]

package Net::Gearman 0.05;

use v5.20;
use warnings;

use feature qw( postderef signatures );
no warnings qw( experimental::postderef experimental::signatures );

use base qw( IO::Socket::IP );

=head1 NAME

C - provide a synchronous concrete Gearman implementation

=head1 DESCRIPTION

=for highlighter language=perl

This module provides a simple synchronous concrete implementation to run a
L or L on top of. It
shouldn't be used directly; see instead

=over 2

=item *

L

=item *

L

=back

=head1 CONSTRUCTOR

=cut

=head2 new

   $gearman = Net::Gearman->new( %args );

Returns a new C object. Takes the same arguments as
C. Sets a default value for C if not provided of
4730.

=cut

sub new ( $class, @args )
{
   my %args = @args == 1 ? ( PeerHost => shift @args ) : @args;

   $args{PeerService} //= 4730;

   return $class->SUPER::new( %args );
}

sub gearman_state ( $self )
{
   ${*$self}{gearman} ||= {};
}

sub new_future ( $self )
{
   return Net::Gearman::Future->new( $self );
}

sub do_read ( $self )
{
   my $buffer = $self->gearman_state->{gearman_buffer} // "";

   # TODO: consider an on_recv_packet to make this more efficient
   $self->sysread( $buffer, 8192, length $buffer );
   $self->on_recv( $buffer );

   $self->gearman_state->{gearman_buffer} = $buffer;
}

package # hide
   Net::Gearman::Future;
use base qw( Future );

sub new ( $class, $gearman )
{
   my $self = $class->SUPER::new;
   $self->set_udata( gearman => $gearman );
   return $self;
}

sub await ( $self )
{
   while( !$self->is_ready ) {
      $self->udata( 'gearman' )->do_read;
   }
}

=head1 AUTHOR

Paul Evans

=cut

0x55AA;