Gearman-Client-Async-0.94/0000755000175000017500000000000010623132131014333 5ustar ljlj00000000000000Gearman-Client-Async-0.94/t/0000755000175000017500000000000010623132131014576 5ustar ljlj00000000000000Gearman-Client-Async-0.94/t/uniq.t0000644000175000017500000000236610453133054015754 0ustar ljlj00000000000000#!/usr/bin/perl # # uniq merging # use strict; use FindBin qw($Bin); require "$Bin/lib/testlib.pl"; use Test::More; use constant PORT => 9000; my $s1pid; if ($s1pid = start_server(PORT)) { plan tests => 2; } else { plan skip_all => "Can't find server to test with"; exit 0; } my $w1pid = start_worker(PORT, 1) or die; my $client = Gearman::Client::Async->new; $client->set_job_servers('127.0.0.1:9000'); my $completed = 0; my $failed = 0; my $done = 0; my $n_loops = 4; for (1..$n_loops) { $client->add_task( Gearman::Task->new( "sleep_for" => \ "1", { uniq => "foo", retry_count => 1, on_complete => sub { $completed++; # on first success, kill the worker, so it can't do more. if ($completed == 1) { kill 9, $w1pid; } $done = 1 if $completed+$failed == $n_loops; }, on_fail => sub { $failed++; $done = 1 if $completed+$failed == $n_loops; }, })); } Danga::Socket->AddTimer(5.0, sub { $done = 1; }); Danga::Socket->SetPostLoopCallback(sub { return !$done; }); Danga::Socket->EventLoop(); is($completed, $n_loops, "$n_loops tasks done"); is($failed, 0, "none failed"); Gearman-Client-Async-0.94/t/err6.t0000644000175000017500000000252010453132644015652 0ustar ljlj00000000000000#!/usr/bin/perl # # submit a bunch of jobs to one js, two workers, first sleeps, kill worker1, all 4 succeed # use strict; use FindBin qw($Bin); require "$Bin/lib/testlib.pl"; use Test::More; use constant PORT => 9000; my $s1pid; if ($s1pid = start_server(PORT)) { plan tests => 2; } else { plan skip_all => "Can't find server to test with"; exit 0; } my $w1pid = start_worker(PORT, 1) or die; my $w2pid = start_worker(PORT, 1) or die; my $client = Gearman::Client::Async->new; $client->set_job_servers('127.0.0.1:9000'); my $completed = 0; my $failed = 0; my $done = 0; my $n_loops = 4; for (1..$n_loops) { $client->add_task( Gearman::Task->new( "sleep_for" => \ "1", { retry_count => 1, on_complete => sub { $completed++; # on first success, kill the job server if ($completed == 1) { kill 9, $w1pid; } $done = 1 if $completed+$failed == $n_loops; }, on_fail => sub { $failed++; $done = 1 if $completed+$failed == $n_loops; }, })); } Danga::Socket->AddTimer(5.0, sub { $done = 1; }); Danga::Socket->SetPostLoopCallback(sub { return !$done; }); Danga::Socket->EventLoop(); is($completed, $n_loops, "$n_loops completed successfully"); is($failed, 0, "none failed"); Gearman-Client-Async-0.94/t/err5.t0000644000175000017500000000260210453131107015643 0ustar ljlj00000000000000#!/usr/bin/perl # # submit a bunch of jobs to one js, one worker, first sleeps, kill js, get errors, resubmit all to other js # use strict; use FindBin qw($Bin); require "$Bin/lib/testlib.pl"; use Test::More; use constant PORT => 9000; my $s1pid; if ($s1pid = start_server(PORT)) { plan tests => 2; } else { plan skip_all => "Can't find server to test with"; exit 0; } my $s2pid = start_server(PORT+1) or die; start_worker(PORT, 2); my $client = Gearman::Client::Async->new; $client->set_job_servers('127.0.0.1:9000', '127.0.0.1:9001'); $client->t_set_disable_random(1); my $completed = 0; my $failed = 0; my $done = 0; my $n_loops = 4; for (1..$n_loops) { $client->add_task( Gearman::Task->new( "sleep_for" => \ "1", { retry_count => 1, on_complete => sub { $completed++; # on first success, kill the job server if ($completed == 1) { kill 9, $s1pid; } $done = 1 if $completed+$failed == $n_loops; }, on_fail => sub { $failed++; $done = 1 if $completed+$failed == $n_loops; }, })); } Danga::Socket->AddTimer(15.0, sub { $done = 1; }); Danga::Socket->SetPostLoopCallback(sub { return !$done; }); Danga::Socket->EventLoop(); is($completed, $n_loops, "$n_loops completed successfully"); is($failed, 0, "none failed"); Gearman-Client-Async-0.94/t/err2.t0000644000175000017500000000237410453057656015666 0ustar ljlj00000000000000#!/usr/bin/perl # # connect to one js, submit job, no reply in 'timeout' seconds, fail, job then succeeds right after, ignore it # use strict; use FindBin qw($Bin); require "$Bin/lib/testlib.pl"; use Test::More; use constant PORT => 9000; if (start_server(PORT)) { plan tests => 4; } else { plan skip_all => "Can't find server to test with"; exit 0; } # Start 1 worker, telling it we have 2 jobservers when really we only # have one (it starts at 9000 and works up) start_worker(PORT, 2); my $client = Gearman::Client::Async->new; $client->set_job_servers('127.0.0.1:' . PORT); my $complete = 0; my $failed = 0; my $done = 0; my $gotstatus = 0; my $retried = 0; Danga::Socket->AddTimer(3.0, sub { $done = 1; }); $client->add_task( Gearman::Task->new( "sleep_for" => \ "2", { timeout => 1.0, retry_count => 5, on_status => sub { $gotstatus++; }, on_complete => sub { $complete = 1; }, on_fail => sub { $failed = 1; }, on_retry => sub { $retried = 1; }, })); Danga::Socket->SetPostLoopCallback(sub { return !$done; }); Danga::Socket->EventLoop(); ok($failed, "got a failure"); ok(!$retried, "didn't retry"); ok($gotstatus, "got status"); ok(!$complete, "didn't finish"); Gearman-Client-Async-0.94/t/async.t0000755000175000017500000000273210614216116016115 0ustar ljlj00000000000000#!/usr/bin/perl use strict; use FindBin qw($Bin); require "$Bin/lib/testlib.pl"; use Test::More; use constant PORT => 9000; if (start_server(PORT)) { plan tests => 2; } else { plan skip_all => "Can't find server to test with"; exit 0; } start_server(PORT + 1); ## Look for 2 job servers, starting at port number PORT. start_worker(PORT, 2); start_worker(PORT, 2); my $client = Gearman::Client::Async->new; $client->set_job_servers('127.0.0.1:' . (PORT + 1), '127.0.0.1:' . PORT); my $good = 0; my $status; $client->add_task( Gearman::Task->new( "sleep_for" => \ "2", { on_complete => sub { my $res = shift; $good++; }, on_status => sub { $status .= '2'; }, on_retry => sub { print "RETRY: [@_]\n"; }, on_fail => sub { print "FAIL: [@_]\n"; }, retry_count => 5, } ) ); $client->add_task( Gearman::Task->new( "sleep_for" => \ "1", { on_complete => sub { my $res = shift; $good++; }, on_status => sub { $status .= '1'; }, on_retry => sub { print "RETRY: [@_]\n"; }, on_fail => sub { fail(join "/", @_); print "FAIL: [@_]\n"; }, retry_count => 5, } ) ); Danga::Socket->AddTimer(3.0, sub { die "Timeout, test fails"; }); Danga::Socket->SetPostLoopCallback(sub { return $good < 2; }); Danga::Socket->EventLoop(); like($status, qr/1212/, "alternating status"); is(length $status, 14, "12 status messages"); Gearman-Client-Async-0.94/t/allinone.t0000755000175000017500000000311710614274715016610 0ustar ljlj00000000000000#!/usr/bin/perl use strict; use FindBin qw($Bin); use Test::More; $ENV{PERL5LIB} .= ":$Bin/../../Gearman/lib"; use lib "$Bin/../../Gearman/lib"; use lib "$Bin/../../../../server/lib"; use Gearman::Server; use Gearman::Client::Async; my $server = Gearman::Server->new(); $server->start_worker('t/worker.pl'); my $client = Gearman::Client::Async->new(job_servers => [ $server ]); my $good = 0; my $status; plan tests => 2; Danga::Socket->AddTimer(0, sub { $client->add_task( Gearman::Task->new( "sleep_for" => \ "2", { on_complete => sub { my $res = shift; $good++; }, on_status => sub { $status .= '2'; }, on_retry => sub { print "RETRY: [@_]\n"; }, on_fail => sub { print "FAIL: [@_]\n"; }, retry_count => 5, } ) ); $client->add_task( Gearman::Task->new( "sleep_for" => \ "1", { on_complete => sub { my $res = shift; $good++; }, on_status => sub { $status .= '1'; }, on_retry => sub { print "RETRY: [@_]\n"; }, on_fail => sub { fail(join "/", @_); print "FAIL: [@_]\n"; }, retry_count => 5, } ) ); }); Danga::Socket->AddTimer(4.0, sub { die "Timeout, test fails"; }); Danga::Socket->SetPostLoopCallback(sub { if ($good >= 2) { pass("Got both responses"); return 0; } return 1; }); Danga::Socket->EventLoop(); is(length $status, 14, "12 status messages"); # vim: filetype=perl Gearman-Client-Async-0.94/t/lib/0000755000175000017500000000000010623132131015344 5ustar ljlj00000000000000Gearman-Client-Async-0.94/t/lib/testlib.pl0000644000175000017500000000355710614220040017356 0ustar ljlj00000000000000#!/usr/bin/perl use strict; use warnings; our $Bin; use FindBin qw( $Bin ); # for working out of svn: use lib "$Bin/../../Gearman/lib"; $ENV{PERL5LIB} .= ":$Bin/../../Gearman/lib"; # for disttest, which is another layer down. :( use lib "$Bin/../../../Gearman/lib"; $ENV{PERL5LIB} .= ":$Bin/../../../Gearman/lib"; use Gearman::Client::Async; use POSIX qw( :sys_wait_h ); use List::Util qw(first);; use IO::Socket::INET; Danga::Socket->SetLoopTimeout(100); our %Children; END { kill_children() } sub start_server { my($port) = @_; my @loc = ("$Bin/../../../../server/gearmand", # using svn "$Bin/../../../../../server/gearmand", # using svn, with disttest '/usr/bin/gearmand', # where some distros might put it '/usr/sbin/gearmand', # where other distros might put it ); my $server = first { -e $_ } @loc or return 0; my $pid = start_child([ $server, '-p', $port ]); $Children{$pid} = 'S'; wait_for_port($port); return $pid; } sub start_worker { my($port, $num) = @_; my $worker = "$Bin/worker.pl"; my $servers = join ',', map '127.0.0.1:' . (PORT + $_), 0..$num-1; my $pid = start_child([ $worker, '-s', $servers ]); $Children{$pid} = 'W'; return $pid; } sub start_child { my($cmd) = @_; my $pid = fork(); die $! unless defined $pid; unless ($pid) { exec 'perl', '-Iblib/lib', '-Ilib', @$cmd or die $!; } $pid; } sub kill_children { kill INT => keys %Children; } sub wait_for_port { my($port) = @_; my $start = time; while (1) { my $sock = IO::Socket::INET->new(PeerAddr => "127.0.0.1:$port"); return 1 if $sock; select undef, undef, undef, 0.25; die "Timeout waiting for port $port to startup" if time > $start + 5; } } 1; Gearman-Client-Async-0.94/t/err7.t0000644000175000017500000000222410454615274015662 0ustar ljlj00000000000000#!/usr/bin/perl # # memory leaks on timeouts # use strict; use FindBin qw($Bin); require "$Bin/lib/testlib.pl"; use Test::More; use constant PORT => 9000; if (start_server(PORT)) { plan tests => 3; } else { plan skip_all => "Can't find server to test with"; exit 0; } # Start 1 worker, telling it we have 2 jobservers when really we only # have one (it starts at 9000 and works up) start_worker(PORT, 2); my $client = Gearman::Client::Async->new; $client->set_job_servers('127.0.0.1:' . PORT); my $complete = 0; my $failed = 0; my $done = 0; use Scalar::Util qw(weaken); my $taskptr; { my $task = Gearman::Task->new( "sleep_for" => \ "2", { timeout => 1.0, retry_count => 5, on_complete => sub { $complete = 1; }, on_fail => sub { $failed = 1; $done = 1; }, }); $client->add_task($task); $taskptr = $task; weaken($taskptr); } Danga::Socket->SetPostLoopCallback(sub { return !$done; }); Danga::Socket->EventLoop(); ok(!$taskptr, "Gearman::Task object went out of scope"); ok($failed, "got a failure"); ok(!$complete, "didn't finish"); Gearman-Client-Async-0.94/t/err4.t0000644000175000017500000000252010453106412015642 0ustar ljlj00000000000000#!/usr/bin/perl # # connect to one js, it times out, try another, no retry count, it succeeds # use strict; use FindBin qw($Bin); require "$Bin/lib/testlib.pl"; use Test::More; use constant PORT => 9000; if (start_server(PORT)) { plan tests => 3; } else { plan skip_all => "Can't find server to test with"; exit 0; } start_worker(PORT, 1); my $client = Gearman::Client::Async->new; $client->set_job_servers('127.0.0.1:9001', '127.0.0.1:9000'); $client->t_set_offline_host('127.0.0.1:9001'); # treat it as off the net, unplugged. $client->t_set_disable_random(1); my $completed = 0; my $failed = 0; my $done = 0; my $did_timeout = 0; { no warnings; $Gearman::Client::Async::Connection::T_ON_TIMEOUT = sub { $did_timeout++; }; } my $n_loops = 3; for (1..$n_loops) { $client->add_task( Gearman::Task->new( "sleep_for" => \ "0.5", { on_complete => sub { $completed++; $done = 1 if $completed == $n_loops; }, on_fail => sub { $failed = 1; }, })); } Danga::Socket->AddTimer(3.0, sub { $done = 1; }); Danga::Socket->SetPostLoopCallback(sub { return !$done; }); Danga::Socket->EventLoop(); ok(!$failed, "insertion didn't fail"); is($did_timeout, 1, "and connect did timeout, once"); is($completed, $n_loops, "completed $n_loops times"); Gearman-Client-Async-0.94/t/err1.t0000644000175000017500000000163710452525071015654 0ustar ljlj00000000000000#!/usr/bin/perl # # tests inserting a job into a dead jobserver. # use strict; use FindBin qw($Bin); require "$Bin/lib/testlib.pl"; use Test::More; use constant PORT => 9000; if (start_server(PORT)) { plan tests => 2; } else { plan skip_all => "Can't find server to test with"; exit 0; } ## Look for 2 job servers, starting at port number PORT. start_worker(PORT, 2); start_worker(PORT, 2); my $client = Gearman::Client::Async->new; $client->set_job_servers('127.0.0.1:' . (PORT + 1)); my $counter = 0; my $failed = 0; my $done = 0; $client->add_task( Gearman::Task->new( "sleep_for" => \ "1", { on_complete => sub { $counter++; $done = 1; }, on_fail => sub { $failed = 1; $done = 1; }, })); Danga::Socket->SetPostLoopCallback(sub { return !$done; }); Danga::Socket->EventLoop(); ok($failed, "insertion failed"); ok(!$counter, "didn't succeed"); Gearman-Client-Async-0.94/t/err3.t0000644000175000017500000000207110453100161015635 0ustar ljlj00000000000000#!/usr/bin/perl # # connect to one js, it's down immediately, try another, no retry count # use strict; use FindBin qw($Bin); require "$Bin/lib/testlib.pl"; use Test::More; use constant PORT => 9000; if (start_server(PORT)) { plan tests => 2; } else { plan skip_all => "Can't find server to test with"; exit 0; } start_worker(PORT, 1); my $client = Gearman::Client::Async->new; $client->set_job_servers('127.0.0.1:9001', '127.0.0.1:9000'); $client->t_set_disable_random(1); my $completed = 0; my $failed = 0; my $done = 0; my $n_loops = 3; for (1..$n_loops) { $client->add_task( Gearman::Task->new( "sleep_for" => \ "0.5", { on_complete => sub { $completed++; $done = 1 if $completed == $n_loops; }, on_fail => sub { $failed = 1; }, })); } Danga::Socket->AddTimer(3.0, sub { $done = 1; }); Danga::Socket->SetPostLoopCallback(sub { return !$done; }); Danga::Socket->EventLoop(); ok(!$failed, "insertion didn't fail"); is($completed, $n_loops, "completed $n_loops times"); Gearman-Client-Async-0.94/t/err8.t0000644000175000017500000000304010470136652015654 0ustar ljlj00000000000000#!/usr/bin/perl # # memory leaks on timeouts # use strict; use FindBin qw($Bin); require "$Bin/lib/testlib.pl"; use Test::More; use constant PORT => 9000; if (start_server(PORT)) { plan tests => 3; } else { plan skip_all => "Can't find server to test with"; exit 0; } # Start 1 worker, telling it we have 2 jobservers when really we only # have one (it starts at 9000 and works up) start_worker(PORT, 2); my $client = Gearman::Client::Async->new; $client->set_job_servers('127.0.0.1:' . PORT); my $complete = 0; my $failed = 0; my $done = 0; use Scalar::Util qw(weaken); my $taskptr; { my $task = Gearman::Task->new( "sleep_for" => \ "3", { timeout => 1, retry_count => 0, on_complete => sub { $complete = 1; }, on_fail => sub { $failed = 1; $done = 1; }, }); $client->add_task($task); $taskptr = $task; weaken($taskptr); } # don't read so we get a situation # where the job timeouts before the server responds Danga::Socket->SetPostLoopCallback(sub { my $socket = Danga::Socket->DescriptorMap->{3}; $socket->watch_read(0); Danga::Socket->AddTimer(2.0 => sub { $socket->watch_read(1); Danga::Socket->SetPostLoopCallback(sub { return !$done; }); }); Danga::Socket->SetPostLoopCallback(sub { return 1 }); return 1; }); Danga::Socket->EventLoop(); ok(!$taskptr, "Gearman::Task object went out of scope"); ok($failed, "got a failure"); ok(!$complete, "didn't finish"); Gearman-Client-Async-0.94/t/worker.pl0000755000175000017500000000102110452542213016447 0ustar ljlj00000000000000#!/usr/bin/perl use strict; use Gearman::Worker; use Getopt::Long; my $opt_js; GetOptions('s=s' => \$opt_js); my $worker = Gearman::Worker->new; $worker->job_servers(split(/,/, $opt_js)); $worker->register_function("sleep_for" => sub { my $job = shift; my $arg = $job->arg; my $steps = $arg * 4; my $res = rand(); $job->set_status(0, $steps); for my $i (1..$steps) { select(undef, undef, undef, 0.25); $job->set_status($i, $steps); } return $res; }); $worker->work while 1; Gearman-Client-Async-0.94/t/tests-needed.t0000644000175000017500000000144110453133125017354 0ustar ljlj00000000000000#!/usr/bin/perl use strict; use Test::More 'no_plan'; ok('async.t', "normal async client working"); ok('err1.t', "connect to one js, it's down immediately, no other options, fail"); ok('err2.t', "connect to one js, submit job, no reply in 'timeout' seconds, fail, job then succeeds right after, ignore it"); ok('err3.t', "connect to one js, it's down immediately, try another, no retry count, it succeeds"); ok('err4.t', "connect to one js, it times out connecting, try another, it succeeds"); ok('err5.t', "submit a bunch of jobs to one js, one worker, first sleeps, kill js, get errors, resubmit all to other js"); ok('err6.t', "submit a bunch of jobs to one js, two workers, first sleeps, kill worker1, all 4 succeed"); ok('uniq.t', 'merging jobs works: two tasks w/ same internal handle'); Gearman-Client-Async-0.94/lib/0000755000175000017500000000000010623132131015101 5ustar ljlj00000000000000Gearman-Client-Async-0.94/lib/Gearman/0000755000175000017500000000000010623132131016453 5ustar ljlj00000000000000Gearman-Client-Async-0.94/lib/Gearman/Client/0000755000175000017500000000000010623132131017671 5ustar ljlj00000000000000Gearman-Client-Async-0.94/lib/Gearman/Client/Async/0000755000175000017500000000000010623132131020746 5ustar ljlj00000000000000Gearman-Client-Async-0.94/lib/Gearman/Client/Async/Connection.pm0000644000175000017500000002546310617563657023445 0ustar ljlj00000000000000package Gearman::Client::Async::Connection; use strict; use warnings; use Danga::Socket; use base 'Danga::Socket'; use fields ( 'state', # one of 3 state constants below 'waiting', # hashref of $handle -> [ Task+ ] 'need_handle', # arrayref of Gearman::Task objects which # have been submitted but need handles. 'parser', # parser object 'hostspec', # scalar: "host:ip" 'deadtime', # unixtime we're marked dead until. 'task2handle', # hashref of stringified Task -> scalar handle 'on_ready', # arrayref of on_ready callbacks to run on connect success 'on_error', # arrayref of on_error callbacks to run on connect failure 't_offline', # bool: fake being off the net for purposes of connecting, to force timeout ); our $T_ON_TIMEOUT; use constant S_DISCONNECTED => \ "disconnected"; use constant S_CONNECTING => \ "connecting"; use constant S_READY => \ "ready"; use Carp qw(croak); use Gearman::Task; use Gearman::Util; use Scalar::Util qw(weaken); use IO::Handle; use Socket qw(PF_INET IPPROTO_TCP TCP_NODELAY SOL_SOCKET SOCK_STREAM); sub DEBUGGING () { 0 } sub new { my Gearman::Client::Async::Connection $self = shift; my %opts = @_; $self = fields::new( $self ) unless ref $self; my $hostspec = delete( $opts{hostspec} ) or croak("hostspec required"); if (ref $hostspec eq 'GLOB') { # In this case we have been passed a globref, hopefully a socket that has already # been connected to the Gearman server in some way. $self->SUPER::new($hostspec); $self->{state} = S_CONNECTING; $self->{parser} = Gearman::ResponseParser::Async->new( $self ); $self->watch_write(1); } elsif (ref $hostspec && $hostspec->can("to_inprocess_server")) { # In this case we have been passed an object that looks like a Gearman::Server, # which we can just call "to_inprocess_server" on to get a socketpair connecting # to it. my $sock = $hostspec->to_inprocess_server; $self->SUPER::new($sock); $self->{state} = S_CONNECTING; $self->{parser} = Gearman::ResponseParser::Async->new( $self ); $self->watch_write(1); }else { $self->{state} = S_DISCONNECTED; } $self->{hostspec} = $hostspec; $self->{waiting} = {}; $self->{need_handle} = []; $self->{deadtime} = 0; $self->{on_ready} = []; $self->{on_error} = []; $self->{task2handle} = {}; croak "Unknown parameters: " . join(", ", keys %opts) if %opts; return $self; } sub close_when_finished { my Gearman::Client::Async::Connection $self = shift; # FIXME: implement } sub hostspec { my Gearman::Client::Async::Connection $self = shift; return $self->{hostspec}; } sub connect { my Gearman::Client::Async::Connection $self = shift; $self->{state} = S_CONNECTING; my ($host, $port) = split /:/, $self->{hostspec}; $port ||= 7003; warn "Connecting to $self->{hostspec}\n" if DEBUGGING; socket my $sock, PF_INET, SOCK_STREAM, IPPROTO_TCP; IO::Handle::blocking($sock, 0); setsockopt($sock, IPPROTO_TCP, TCP_NODELAY, pack("l", 1)) or die; unless ($sock && defined fileno($sock)) { warn( "Error creating socket: $!\n" ); return undef; } $self->SUPER::new( $sock ); $self->{parser} = Gearman::ResponseParser::Async->new( $self ); eval { connect $sock, Socket::sockaddr_in($port, Socket::inet_aton($host)); }; if ($@) { $self->on_connect_error; return; } Danga::Socket->AddTimer(0.25, sub { return unless $self->{state} == S_CONNECTING; $T_ON_TIMEOUT->() if $T_ON_TIMEOUT; $self->on_connect_error; }); # unless we're faking being offline for the test suite, connect and watch # for writabilty so we know the connect worked... unless ($self->{t_offline}) { $self->watch_write(1); } } sub event_write { my Gearman::Client::Async::Connection $self = shift; if ($self->{state} == S_CONNECTING) { $self->{state} = S_READY; $self->watch_read(1); warn "$self->{hostspec} connected and ready.\n" if DEBUGGING; $_->() foreach @{$self->{on_ready}}; $self->destroy_callbacks; } $self->watch_write(0) if $self->write(undef); } sub destroy_callbacks { my Gearman::Client::Async::Connection $self = shift; $self->{on_ready} = []; $self->{on_error} = []; } sub event_read { my Gearman::Client::Async::Connection $self = shift; my $input = $self->read( 128 * 1024 ); unless (defined $input) { $self->mark_dead if $self->stuff_outstanding; $self->close( "EOF" ); return; } $self->{parser}->parse_data( $input ); } sub event_err { my Gearman::Client::Async::Connection $self = shift; my $was_connecting = ($self->{state} == S_CONNECTING); if ($was_connecting && $self->{t_offline}) { $self->SUPER::close( "error" ); return; } $self->mark_dead; $self->close( "error" ); $self->on_connect_error if $was_connecting; } sub on_connect_error { my Gearman::Client::Async::Connection $self = shift; warn "Jobserver, $self->{hostspec} ($self) has failed to connect properly\n" if DEBUGGING; $self->mark_dead; $self->close( "error" ); $_->() foreach @{$self->{on_error}}; $self->destroy_callbacks; } sub close { my Gearman::Client::Async::Connection $self = shift; my $reason = shift; if ($self->{state} != S_DISCONNECTED) { $self->{state} = S_DISCONNECTED; $self->SUPER::close( $reason ); } $self->_requeue_all; } sub mark_dead { my Gearman::Client::Async::Connection $self = shift; $self->{deadtime} = time + 10; warn "$self->{hostspec} marked dead for a bit." if DEBUGGING; } sub alive { my Gearman::Client::Async::Connection $self = shift; return $self->{deadtime} <= time; } sub add_task { my Gearman::Client::Async::Connection $self = shift; my Gearman::Task $task = shift; Carp::confess("add_task called when in wrong state") unless $self->{state} == S_READY; warn "writing task $task to $self->{hostspec}\n" if DEBUGGING; $self->write( $task->pack_submit_packet ); push @{$self->{need_handle}}, $task; Scalar::Util::weaken($self->{need_handle}->[-1]); } sub stuff_outstanding { my Gearman::Client::Async::Connection $self = shift; return @{$self->{need_handle}} || %{$self->{waiting}}; } sub _requeue_all { my Gearman::Client::Async::Connection $self = shift; my $need_handle = $self->{need_handle}; my $waiting = $self->{waiting}; $self->{need_handle} = []; $self->{waiting} = {}; while (@$need_handle) { my $task = shift @$need_handle; warn "Task $task in need_handle queue during socket error, queueing for redispatch\n" if DEBUGGING; $task->fail if $task; } while (my ($shandle, $tasklist) = each( %$waiting )) { foreach my $task (@$tasklist) { warn "Task $task ($shandle) in waiting queue during socket error, queueing for redispatch\n" if DEBUGGING; $task->fail; } } } sub process_packet { my Gearman::Client::Async::Connection $self = shift; my $res = shift; warn "Got packet '$res->{type}' from $self->{hostspec}\n" if DEBUGGING; if ($res->{type} eq "job_created") { die "Um, got an unexpected job_created notification" unless @{ $self->{need_handle} }; my Gearman::Task $task = shift @{ $self->{need_handle} } or return 1; my $shandle = ${ $res->{'blobref'} }; if ($task) { $self->{task2handle}{"$task"} = $shandle; push @{ $self->{waiting}->{$shandle} ||= [] }, $task; } return 1; } if ($res->{type} eq "work_fail") { my $shandle = ${ $res->{'blobref'} }; $self->_fail_jshandle($shandle); return 1; } if ($res->{type} eq "work_complete") { ${ $res->{'blobref'} } =~ s/^(.+?)\0// or die "Bogus work_complete from server"; my $shandle = $1; my $task_list = $self->{waiting}{$shandle} or return; my Gearman::Task $task = shift @$task_list or return; $task->complete($res->{'blobref'}); unless (@$task_list) { delete $self->{waiting}{$shandle}; delete $self->{task2handle}{"$task"}; } warn "Jobs: " . scalar( keys( %{$self->{waiting}} ) ) . "\n" if DEBUGGING; return 1; } if ($res->{type} eq "work_status") { my ($shandle, $nu, $de) = split(/\0/, ${ $res->{'blobref'} }); my $task_list = $self->{waiting}{$shandle} or return; foreach my Gearman::Task $task (@$task_list) { $task->status($nu, $de); } return 1; } die "Unknown/unimplemented packet type: $res->{type}"; } sub give_up_on { my Gearman::Client::Async::Connection $self = shift; my $task = shift; my $shandle = $self->{task2handle}{"$task"} or return; my $task_list = $self->{waiting}{$shandle} or return; @$task_list = grep { $_ != $task } @$task_list; unless (@$task_list) { delete $self->{waiting}{$shandle}; } } # note the failure of a task given by its jobserver-specific handle sub _fail_jshandle { my Gearman::Client::Async::Connection $self = shift; my $shandle = shift; my $task_list = $self->{waiting}->{$shandle} or return; my Gearman::Task $task = shift @$task_list or return; # cleanup unless (@$task_list) { delete $self->{task2handle}{"$task"}; delete $self->{waiting}{$shandle}; } $task->fail; } sub get_in_ready_state { my ($self, $on_ready, $on_error) = @_; if ($self->{state} == S_READY) { $on_ready->(); return; } push @{$self->{on_ready}}, $on_ready if $on_ready; push @{$self->{on_error}}, $on_error if $on_error; $self->connect if $self->{state} == S_DISCONNECTED; } sub t_set_offline { my ($self, $val) = @_; $val = 1 unless defined $val; $self->{t_offline} = $val; } package Gearman::ResponseParser::Async; use strict; use warnings; use Scalar::Util qw(weaken); use Gearman::ResponseParser; use base 'Gearman::ResponseParser'; sub new { my $class = shift; my $self = $class->SUPER::new; $self->{_conn} = shift; weaken($self->{_conn}); return $self; } sub on_packet { my $self = shift; my $packet = shift; return unless $self->{_conn}; $self->{_conn}->process_packet( $packet ); } sub on_error { my $self = shift; return unless $self->{_conn}; $self->{_conn}->mark_unsafe; $self->{_conn}->close; } 1; Gearman-Client-Async-0.94/lib/Gearman/Client/Async.pm0000644000175000017500000001332110623132126021310 0ustar ljlj00000000000000package Gearman::Client::Async; =head1 NAME Gearman::Client::Async - Asynchronous client module for Gearman for Danga::Socket applications =head1 SYNOPSIS use Gearman::Client::Async; # Instantiate a new Gearman::Client::Async object. $client = Gearman::Client::Async->new( job_servers => [ '127.0.0.1', '192.168.0.1:123' ], ); # Overwrite job server list with a new one. $client->set_job_servers( '10.0.0.1' ); # Read list of job servers out of the client. $arrayref = $client->job_servers; @array = $client->job_servers; # Start a task $task = Gearman::Task->new(...); # with callbacks, etc $client->add_task( $task ); =head1 COPYRIGHT Copyright 2006 Six Apart, Ltd. License granted to use/distribute under the same terms as Perl itself. =head1 WARRANTY This is free software. This comes with no warranty whatsoever. =head1 AUTHORS Brad Fitzpatrick (brad@danga.com) Jonathan Steinert (hachi@cpan.org) =cut use strict; use warnings; use Carp qw(croak); use fields ( 'job_servers', # arrayref of Gearman::Client::Async::Connection objects 't_no_random', # don't randomize job server to use: use first alive one. 't_offline_host', # hashref: hostname -> $bool, if host should act as offline, for testing ); use Danga::Socket 1.52; use Gearman::Objects; use Gearman::Task; use Gearman::JobStatus; use Gearman::Client::Async::Connection; use List::Util qw(first); use vars qw($VERSION); $VERSION = "0.94"; sub DEBUGGING () { 0 } sub new { my ($class, %opts) = @_; my $self = $class; $self = fields::new($class) unless ref $self; $self->{job_servers} = []; $self->{t_offline_host} = {}; my $js = delete $opts{job_servers}; $self->set_job_servers(@$js) if $js; croak "Unknown parameters: " . join(", ", keys %opts) if %opts; return $self; } # for testing. sub t_set_disable_random { my $self = shift; $self->{t_no_random} = shift; } sub t_set_offline_host { my ($self, $host, $val) = @_; $val = 1 unless defined $val; $self->{t_offline_host}{$host} = $val; my $conn = first { $_->hostspec eq $host } @{ $self->{job_servers} } or die "No host found with that spec to mark offline"; $conn->t_set_offline($val); } # set job servers, without shutting down dups, and shutting down old ones gracefully sub set_job_servers { my Gearman::Client::Async $self = shift; my %being_set; # hostspec -> 1 %being_set = map { $_, 1 } @_; my %exist; # hostspec -> existing conn foreach my $econn (@{ $self->{job_servers} }) { my $spec = $econn->hostspec; if ($being_set{$spec}) { $exist{$spec} = $econn; } else { $econn->close_when_finished; } } my @newlist; foreach (@_) { push @newlist, $exist{$_} || Gearman::Client::Async::Connection->new( hostspec => $_ ); } $self->{job_servers} = \@newlist; } # getter sub job_servers { my Gearman::Client::Async $self = shift; croak "Not a setter" if @_; my @list = map { $_->hostspec } @{ $self->{job_servers} }; return wantarray ? @list : \@list; } sub add_task { my Gearman::Client::Async $self = shift; my Gearman::Task $task = shift; my $try_again; $try_again = sub { my @job_servers = grep { $_->alive } @{$self->{job_servers}}; warn "Alive servers: " . @job_servers . " out of " . @{$self->{job_servers}} . "\n" if DEBUGGING; unless (@job_servers) { $task->final_fail; $try_again = undef; return; } my $js; if (defined( my $hash = $task->hash )) { # Task is hashed, use key to fetch job server $js = @job_servers[$hash % @job_servers]; } else { # Task is not hashed, random job server $js = @job_servers[$self->{t_no_random} ? 0 : int( rand( @job_servers ))]; } # TODO Fix this violation of object privacy. $task->{taskset} = $self; $js->get_in_ready_state( # on_ready: sub { my $timer; if (my $timeout = $task->{timeout}) { $timer = Danga::Socket->AddTimer($timeout, sub { $task->final_fail('timeout'); }); } $task->set_on_post_hooks(sub { $timer->cancel if $timer; # ALSO clean up our $js (connection's) waiting stuff: $js->give_up_on($task); }); $js->add_task( $task ); $try_again = undef; }, # on_error: $try_again, ); }; $try_again->(); } # Gearman::Client::Async sometimes fakes itself duck-typing style as a # Gearman::Taskset, since a task"set" makes no sense in an async # world, where there's no need to wait on a set of things... since # everything happens at its own pace. so for duck-typing reasons (or, # er, "implementing an interface", say), we need to implement a the # "taskset client method" but in our case, that's just us. sub client { $_[0] } # as a Gearman::Client-like thing, we'll be asked for our prefix, which this module # currently doesn't support, but the base Gearman libraries expect. sub prefix { "" } 1; Gearman-Client-Async-0.94/MANIFEST0000644000175000017500000000053210623126521015472 0ustar ljlj00000000000000lib/Gearman/Client/Async.pm lib/Gearman/Client/Async/Connection.pm Makefile.PL CHANGES MANIFEST This list of files MANIFEST.SKIP META.yml Module meta-data (added by MakeMaker) README.txt TODO t/async.t t/err1.t t/err2.t t/err3.t t/err4.t t/err5.t t/err6.t t/err7.t t/err8.t t/lib/testlib.pl t/tests-needed.t t/uniq.t t/worker.pl t/allinone.t Gearman-Client-Async-0.94/TODO0000644000175000017500000000006110454610154015030 0ustar ljlj00000000000000work_status callbacks w/ duplicated task handles Gearman-Client-Async-0.94/MANIFEST.SKIP0000644000175000017500000000046310610752556016253 0ustar ljlj00000000000000build.pl # Avoid version control files. \bRCS\b \bCVS\b ,v$ \B\.svn\b # Avoid Makemaker generated and utility files. \bMANIFEST\.bak \bMakefile$ \bblib/ \bMakeMaker-\d \bpm_to_blib$ # Avoid Module::Build generated and utility files. \bBuild$ \b_build/ # Avoid temp and backup files. ~$ \.old$ \#$ \b\.# Gearman-Client-Async-0.94/CHANGES0000644000175000017500000000157610623126410015342 0ustar ljlj000000000000000.94 (2007-05-17) -- Make the job_servers list be able to contain raw sockets, or even Gearman::Server objects, so that we can run in the same thread as a Gearman::Server very easily. 0.93 (2007-04-26) -- don't break with latest Gearman::Client (package 'Gearman') which added prefix support. 0.92 (2007-04-16) -- fix for when a client task timeouts before the server gets a handle back to the client -- fix a memory leak on timeouts. adds a new test for it too. -- fix a bogus calling instead of checking of a test variable on connection timeout 0.91 -- use Danga::Socket's cancellable timers to kill the timeout timers as soon as possible on success or fail. 0.90 -- fix memory leaks 0.80 -- initial release, now that it has a nice big passing test suite, does timeouts, and actually handles error conditions. :) Gearman-Client-Async-0.94/META.yml0000644000175000017500000000067410623132131015613 0ustar ljlj00000000000000# http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: Gearman-Client-Async version: 0.94 version_from: lib/Gearman/Client/Async.pm installdirs: site requires: Danga::Socket: 1.52 Gearman::Client: 1.05 Test::Simple: 0.44 distribution_type: module generated_by: ExtUtils::MakeMaker version 6.17 Gearman-Client-Async-0.94/README.txt0000644000175000017500000000040610451645555016053 0ustar ljlj00000000000000These are the Gearman::Client::* (and eventually Gearman::Worker::*) versions which work within the Danga::Socket event-based framework. They're distributed separately because they have drastically different dependencies than the general synchronous versions. Gearman-Client-Async-0.94/Makefile.PL0000644000175000017500000000121110614217616016314 0ustar ljlj00000000000000use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( NAME => 'Gearman::Client::Async', VERSION_FROM => 'lib/Gearman/Client/Async.pm', # finds $VERSION PREREQ_PM => { 'Test::Simple' => 0.44, 'Danga::Socket' => 1.52, 'Gearman::Client' => 1.05, }, AUTHOR => 'Brad Fitzpatrick (brad@danga.org), Jonathan Steinert (hachi@cpan.org)', ABSTRACT_FROM => 'lib/Gearman/Client/Async.pm', );