From 5a95cbf8449b35c942aed814d26a6bffd63247d5 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Sat, 2 Jul 2016 16:47:15 +0200 Subject: [PATCH 01/95] import v1.12 --- t/30-maxqueue.t | 77 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 77 insertions(+) create mode 100644 t/30-maxqueue.t diff --git a/t/30-maxqueue.t b/t/30-maxqueue.t new file mode 100644 index 0000000..50836c1 --- /dev/null +++ b/t/30-maxqueue.t @@ -0,0 +1,77 @@ +use strict; +use warnings; + +use FindBin qw/ $Bin /; +use Gearman::Client; +use Storable qw( freeze ); +use Test::More; + +use lib "$Bin/lib"; +use Test::Gearman; + +# NOK tested with gearman v1.0.6 +# OK Gearman::Server +# - ubuntu 14.04 + +# plan skip_all => "MAXQUEUE test is in TODO"; + +# This is testing the MAXQUEUE feature of gearmand. There's no direct +# support for it in Gearman::Worker yet, so we connect directly to +# gearmand to configure it for the test. + +my $tg = Test::Gearman->new( + ip => "127.0.0.1", + daemon => $ENV{GEARMAND_PATH} || undef +); + +$tg->start_servers() || plan skip_all => "Can't find server to test with"; + +foreach (@{ $tg->job_servers }) { + unless ($tg->check_server_connection($_)) { + plan skip_all => "connection check $_ failed"; + last; + } +} ## end foreach (@{ $tg->job_servers...}) + +plan tests => 9; + +ok( + my $sock = IO::Socket::INET->new( + PeerAddr => @{ $tg->job_servers }[0], + ), + "connect to jobserver" +); + +my $cn = "long"; +ok($sock->write("MAXQUEUE $cn 1\n"), "write MAXQUEUE ..."); +ok(my $input = $sock->getline(), "getline"); +ok($input =~ m/^OK\b/i, "match OK"); + +ok(my $pid = $tg->start_worker(), "start worker"); + +my $client = new_ok("Gearman::Client", [job_servers => $tg->job_servers]); + +my $tasks = $client->new_task_set; +isa_ok($tasks, 'Gearman::Taskset'); + +my $failed = 0; +my $completed = 0; + +foreach my $iter (1 .. 5) { + my $handle = $tasks->add_task( + $cn, $iter, + { + on_complete => sub { $completed++ }, + on_fail => sub { $failed++ } + } + ); +} ## end foreach my $iter (1 .. 5) + +$tasks->wait; + +# One in the queue, plus one that may start immediately +ok($completed == 2 || $completed == 1, 'number of success'); + +# All the rest +ok($failed == 3 || $failed == 4, 'number of failure'); + From c0a1fc177747adffb42cb128f275933ebcccfd2b Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Sat, 9 Jul 2016 10:07:35 +0200 Subject: [PATCH 02/95] Gearman::Server::Job requires Gearman::Server::Client --- lib/Gearman/Server/Job.pm | 3 +++ 1 file changed, 3 insertions(+) diff --git a/lib/Gearman/Server/Job.pm b/lib/Gearman/Server/Job.pm index 27124cb..34771b6 100644 --- a/lib/Gearman/Server/Job.pm +++ b/lib/Gearman/Server/Job.pm @@ -1,5 +1,8 @@ package Gearman::Server::Job; + use strict; + +use Gearman::Server::Client; use Scalar::Util; use Sys::Hostname; From 885feb3ebc2c8b2fb04b0f83c5007fcd94f3da04 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Sat, 9 Jul 2016 10:08:46 +0200 Subject: [PATCH 03/95] perltidy Server --- lib/Gearman/Server.pm | 174 +++++++++++++++++++++++------------------- 1 file changed, 95 insertions(+), 79 deletions(-) diff --git a/lib/Gearman/Server.pm b/lib/Gearman/Server.pm index 9f64c65..e594210 100644 --- a/lib/Gearman/Server.pm +++ b/lib/Gearman/Server.pm @@ -30,23 +30,24 @@ use Gearman::Server::Job; use Socket qw(IPPROTO_TCP SOL_SOCKET SOCK_STREAM AF_UNIX SOCK_STREAM PF_UNSPEC); use Carp qw(croak); use Sys::Hostname (); -use IO::Handle (); +use IO::Handle (); use fields ( - 'client_map', # fd -> Client - 'sleepers', # func -> { "Client=HASH(0xdeadbeef)" => Client } - 'sleepers_list', # func -> [ Client, ... ], ... - 'job_queue', # job_name -> [Job, Job*] (key only exists if non-empty) - 'job_of_handle', # handle -> Job - 'max_queue', # func -> configured max jobqueue size - 'job_of_uniq', # func -> uniq -> Job - 'handle_ct', # atomic counter - 'handle_base', # atomic counter - 'listeners', # arrayref of listener objects - 'wakeup', # number of workers to wake - 'wakeup_delay', # seconds to wait before waking more workers - 'wakeup_timers', # func -> timer, timer to be canceled or adjusted when job grab/inject is called - ); + 'client_map', # fd -> Client + 'sleepers', # func -> { "Client=HASH(0xdeadbeef)" => Client } + 'sleepers_list', # func -> [ Client, ... ], ... + 'job_queue', # job_name -> [Job, Job*] (key only exists if non-empty) + 'job_of_handle', # handle -> Job + 'max_queue', # func -> configured max jobqueue size + 'job_of_uniq', # func -> uniq -> Job + 'handle_ct', # atomic counter + 'handle_base', # atomic counter + 'listeners', # arrayref of listener objects + 'wakeup', # number of workers to wake + 'wakeup_delay', # seconds to wait before waking more workers + 'wakeup_timers' + , # func -> timer, timer to be canceled or adjusted when job grab/inject is called +); our $VERSION = "1.12"; @@ -86,7 +87,7 @@ sub new { $self->{wakeup_delay} = .1; $self->{wakeup_timers} = {}; - $self->{handle_ct} = 0; + $self->{handle_ct} = 0; $self->{handle_base} = "H:" . Sys::Hostname::hostname() . ":"; my $port = delete $opts{port}; @@ -111,10 +112,11 @@ sub new { $self->create_listening_sock($port); return $self; -} +} ## end sub new sub debug { my ($self, $msg) = @_; + #warn "$msg\n"; } @@ -131,33 +133,37 @@ sub create_listening_sock { my $accept_per_loop = delete $opts{accept_per_loop}; - warn "Extra options passed into create_listening_sock: " . join(', ', keys %opts) . "\n" + warn "Extra options passed into create_listening_sock: " + . join(', ', keys %opts) . "\n" if keys %opts; - my $ssock = IO::Socket::INET->new(LocalPort => $portnum, - Type => SOCK_STREAM, - Proto => IPPROTO_TCP, - Blocking => 0, - Reuse => 1, - Listen => 1024 ) - or die "Error creating socket: $@\n"; + my $ssock = IO::Socket::INET->new( + LocalPort => $portnum, + Type => SOCK_STREAM, + Proto => IPPROTO_TCP, + Blocking => 0, + Reuse => 1, + Listen => 1024 + ) or die "Error creating socket: $@\n"; my $listeners = $self->{listeners}; - push @$listeners, Gearman::Server::Listener->new($ssock, $self, accept_per_loop => $accept_per_loop); + push @$listeners, + Gearman::Server::Listener->new($ssock, $self, + accept_per_loop => $accept_per_loop); return $ssock; -} +} ## end sub create_listening_sock sub new_client { my ($self, $sock) = @_; my $client = Gearman::Server::Client->new($sock, $self); $client->watch_read(1); - $self->{client_map}{$client->{fd}} = $client; -} + $self->{client_map}{ $client->{fd} } = $client; +} ## end sub new_client sub note_disconnected_client { my ($self, $client) = @_; - delete $self->{client_map}{$client->{fd}}; + delete $self->{client_map}{ $client->{fd} }; } sub clients { @@ -173,7 +179,7 @@ sub to_inprocess_server { my ($psock, $csock); socketpair($csock, $psock, AF_UNIX, SOCK_STREAM, PF_UNSPEC) - or die "socketpair: $!"; + or die "socketpair: $!"; $csock->autoflush(1); $psock->autoflush(1); @@ -184,12 +190,12 @@ sub to_inprocess_server { my $client = Gearman::Server::Client->new($csock, $self); my ($package, $file, $line) = caller; - $client->{peer_ip} = "[$package|$file|$line]"; + $client->{peer_ip} = "[$package|$file|$line]"; $client->watch_read(1); - $self->{client_map}{$client->{fd}} = $client; + $self->{client_map}{ $client->{fd} } = $client; return $psock; -} +} ## end sub to_inprocess_server =head2 start_worker @@ -206,7 +212,7 @@ sub start_worker { my ($psock, $csock); socketpair($csock, $psock, AF_UNIX, SOCK_STREAM, PF_UNSPEC) - or die "socketpair: $!"; + or die "socketpair: $!"; $csock->autoflush(1); $psock->autoflush(1); @@ -222,15 +228,17 @@ sub start_worker { local $ENV{'GEARMAN_WORKER_USE_STDIO'} = 1; close(STDIN); close(STDOUT); - open(STDIN, '<&', $psock) or die "Unable to dup socketpair to STDIN: $!"; - open(STDOUT, '>&', $psock) or die "Unable to dup socketpair to STDOUT: $!"; + open(STDIN, '<&', $psock) + or die "Unable to dup socketpair to STDIN: $!"; + open(STDOUT, '>&', $psock) + or die "Unable to dup socketpair to STDOUT: $!"; if (UNIVERSAL::isa($prog, "CODE")) { $prog->(); - exit 0; # shouldn't get here. subref should exec. + exit 0; # shouldn't get here. subref should exec. } exec $prog; die "Exec failed: $!"; - } + } ## end unless ($pid) close($psock); @@ -239,34 +247,37 @@ sub start_worker { my $client = Gearman::Server::Client->new($sock, $self); - $client->{peer_ip} = "[gearman_child]"; + $client->{peer_ip} = "[gearman_child]"; $client->watch_read(1); - $self->{client_map}{$client->{fd}} = $client; + $self->{client_map}{ $client->{fd} } = $client; return wantarray ? ($pid, $client) : $pid; -} +} ## end sub start_worker sub enqueue_job { my ($self, $job, $highpri) = @_; - my $jq = ($self->{job_queue}{$job->{func}} ||= []); + my $jq = ($self->{job_queue}{ $job->{func} } ||= []); - if (defined (my $max_queue_size = $self->{max_queue}{$job->{func}})) { - $max_queue_size--; # Subtract one, because we're about to add one more below. + if (defined(my $max_queue_size = $self->{max_queue}{ $job->{func} })) { + $max_queue_size + --; # Subtract one, because we're about to add one more below. while (@$jq > $max_queue_size) { my $delete_job = pop @$jq; - my $msg = Gearman::Util::pack_res_command("work_fail", $delete_job->handle); + my $msg = Gearman::Util::pack_res_command("work_fail", + $delete_job->handle); $delete_job->relay_to_listeners($msg); $delete_job->note_finished; - } - } + } ## end while (@$jq > $max_queue_size) + } ## end if (defined(my $max_queue_size...)) if ($highpri) { unshift @$jq, $job; - } else { + } + else { push @$jq, $job; } - $self->{job_of_handle}{$job->{'handle'}} = $job; -} + $self->{job_of_handle}{ $job->{'handle'} } = $job; +} ## end sub enqueue_job sub wake_up_sleepers { my ($self, $func) = @_; @@ -285,21 +296,24 @@ sub wake_up_sleepers { # If we're only going to wakeup 0 workers anyways, don't set up a timer. return if $self->{wakeup} == 0; - my $timer = Danga::Socket->AddTimer($delay, sub { - # Be sure to not wake up more sleepers if we have no jobs in the queue. - # I know the object definition above says I can trust the func element to determine - # if there are items in the list, but I'm just gonna be safe, rather than sorry. - return unless @{$self->{job_queue}{$func} || []}; - $self->wake_up_sleepers($func) - }); + my $timer = Danga::Socket->AddTimer( + $delay, + sub { + # Be sure to not wake up more sleepers if we have no jobs in the queue. + # I know the object definition above says I can trust the func element to determine + # if there are items in the list, but I'm just gonna be safe, rather than sorry. + return unless @{ $self->{job_queue}{$func} || [] }; + $self->wake_up_sleepers($func); + } + ); $self->{wakeup_timers}->{$func} = $timer; -} +} ## end sub wake_up_sleepers # Returns true when there are still more workers to wake up # False if there are no sleepers sub _wake_up_some { my ($self, $func) = @_; - my $sleepmap = $self->{sleepers}{$func} or return; + my $sleepmap = $self->{sleepers}{$func} or return; my $sleeporder = $self->{sleepers_list}{$func} or return; # TODO SYNC UP STATE HERE IN CASE TWO LISTS END UP OUT OF SYNC @@ -308,7 +322,7 @@ sub _wake_up_some { while (@$sleeporder) { my Gearman::Server::Client $c = shift @$sleeporder; - next if $c->{closed} || ! $c->{sleeping}; + next if $c->{closed} || !$c->{sleeping}; if ($max-- <= 0) { unshift @$sleeporder, $c; return 1; @@ -316,18 +330,19 @@ sub _wake_up_some { delete $sleepmap->{"$c"}; $c->res_packet("noop"); $c->{sleeping} = 0; - } + } ## end while (@$sleeporder) delete $self->{sleepers}{$func}; delete $self->{sleepers_list}{$func}; return; -} +} ## end sub _wake_up_some sub on_client_sleep { my $self = shift; my Gearman::Server::Client $cl = shift; - foreach my $cd (@{$cl->{can_do_list}}) { + foreach my $cd (@{ $cl->{can_do_list} }) { + # immediately wake the sleeper up if there are things to be done if ($self->{job_queue}{$cd}) { $cl->res_packet("noop"); @@ -348,14 +363,15 @@ sub on_client_sleep { if ($jobs_done) { unshift @$sleeporder, $cl; - } else { + } + else { push @$sleeporder, $cl; } $cl->{jobs_done_since_sleep} = 0; - } -} + } ## end foreach my $cd (@{ $cl->{can_do_list...}}) +} ## end sub on_client_sleep sub jobs_outstanding { my Gearman::Server $self = shift; @@ -373,7 +389,7 @@ sub job_by_handle { } sub note_job_finished { - my Gearman::Server $self = shift; + my Gearman::Server $self = shift; my Gearman::Server::Job $job = shift; if (my Gearman::Server::Client $worker = $job->worker) { @@ -381,20 +397,21 @@ sub note_job_finished { } if (length($job->{uniq})) { - delete $self->{job_of_uniq}{$job->{func}}{$job->{uniq}}; + delete $self->{job_of_uniq}{ $job->{func} }{ $job->{uniq} }; } - delete $self->{job_of_handle}{$job->{handle}}; -} + delete $self->{job_of_handle}{ $job->{handle} }; +} ## end sub note_job_finished # <0/undef/"" to reset. else integer max depth. sub set_max_queue { my ($self, $func, $max) = @_; if (defined $max && length $max && $max >= 0) { $self->{max_queue}{$func} = int($max); - } else { + } + else { delete $self->{max_queue}{$func}; } -} +} ## end sub set_max_queue sub new_job_handle { my $self = shift; @@ -424,17 +441,16 @@ sub grab_job { my Gearman::Server::Job $job; while (1) { - $job = shift @{$self->{job_queue}{$func}}; + $job = shift @{ $self->{job_queue}{$func} }; return $empty->() unless $job; return $job unless $job->require_listener; - foreach my Gearman::Server::Client $c (@{$job->{listeners}}) { - return $job if $c && ! $c->{closed}; + foreach my Gearman::Server::Client $c (@{ $job->{listeners} }) { + return $job if $c && !$c->{closed}; } $job->note_finished(0); - } -} - + } ## end while (1) +} ## end sub grab_job 1; __END__ From d3d444070a5186f5d8709b10e722ae5142133aaa Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Sat, 9 Jul 2016 10:09:03 +0200 Subject: [PATCH 04/95] perltidy Client --- lib/Gearman/Server/Client.pm | 337 +++++++++++++++++++---------------- 1 file changed, 186 insertions(+), 151 deletions(-) diff --git a/lib/Gearman/Server/Client.pm b/lib/Gearman/Server/Client.pm index 362304f..1f10c42 100644 --- a/lib/Gearman/Server/Client.pm +++ b/lib/Gearman/Server/Client.pm @@ -24,24 +24,36 @@ use strict; use Danga::Socket; use base 'Danga::Socket'; use fields ( - 'can_do', # { $job_name => $timeout } $timeout can be undef indicating no timeout - 'can_do_list', - 'can_do_iter', - 'fast_read', - 'fast_buffer', - 'read_buf', - 'sleeping', # 0/1: they've said they're sleeping and we haven't woken them up - 'timer', # Timer for job cancellation - 'doing', # { $job_handle => Job } - 'client_id', # opaque string, no whitespace. workers give this so checker scripts - # can tell apart the same worker connected to multiple jobservers. - 'server', # pointer up to client's server - 'options', - 'jobs_done_since_sleep', - ); + + # { $job_name => $timeout } $timeout can be undef indicating no timeout + 'can_do', + 'can_do_list', + 'can_do_iter', + 'fast_read', + 'fast_buffer', + 'read_buf', + + # 0/1: they've said they're sleeping and we haven't woken them up + 'sleeping', + + # Timer for job cancellation + 'timer', + + # { $job_handle => Job } + 'doing', + + # opaque string, no whitespace. workers give this so checker scripts + # can tell apart the same worker connected to multiple jobservers. + 'client_id', + + # pointer up to client's server + 'server', + 'options', + 'jobs_done_since_sleep', +); # 60k read buffer default, similar to perlbal's backend read. -use constant READ_SIZE => 60 * 1024; +use constant READ_SIZE => 60 * 1024; use constant MAX_READ_SIZE => 512 * 1024; # Class Method: @@ -51,28 +63,35 @@ sub new { $self = fields::new($self) unless ref $self; $self->SUPER::new($sock); - $self->{fast_read} = undef; # Number of bytes to read as fast as we can (don't try to process them) - $self->{fast_buffer} = []; # Array of buffers used during fast read operation + # Number of bytes to read as fast as we can (don't try to process them) + $self->{fast_read} = undef; + + # Array of buffers used during fast read operation + $self->{fast_buffer} = []; $self->{read_buf} = ''; $self->{sleeping} = 0; $self->{can_do} = {}; - $self->{doing} = {}; # handle -> Job + + # handle -> Job + $self->{doing} = {}; $self->{can_do_list} = []; - $self->{can_do_iter} = 0; # numeric iterator for where we start looking for jobs - $self->{client_id} = "-"; - $self->{server} = $server; - $self->{options} = {}; + + # numeric iterator for where we start looking for jobs + $self->{can_do_iter} = 0; + $self->{client_id} = "-"; + $self->{server} = $server; + $self->{options} = {}; $self->{jobs_done_since_sleep} = 0; return $self; -} +} ## end sub new sub option { my Gearman::Server::Client $self = shift; my $option = shift; return $self->{options}->{$option}; -} +} ## end sub option sub close { my Gearman::Server::Client $self = shift; @@ -91,32 +110,33 @@ sub close { # Remove self from sleepers, otherwise it will be leaked if another worker # for the job never connects. - my $sleepers = $self->{server}{sleepers}; + my $sleepers = $self->{server}{sleepers}; my $sleepers_list = $self->{server}{sleepers_list}; for my $job (@{ $self->{can_do_list} }) { my $sleeping = $sleepers->{$job}; delete $sleeping->{$self}; my $new_sleepers_list; - for my $client (@{$sleepers_list->{$job}}) { + for my $client (@{ $sleepers_list->{$job} }) { next unless $client; push @{$new_sleepers_list}, $client unless $sleeping->{$client}; } if ($new_sleepers_list) { $self->{server}{sleepers_list}->{$job} = $new_sleepers_list; - } else { + } + else { delete $self->{server}{sleepers_list}->{$job}; } delete $sleepers->{$job} unless %$sleeping; - } + } ## end for my $job (@{ $self->...}) $self->{server}->note_disconnected_client($self); $self->CMD_reset_abilities; $self->SUPER::close; -} +} ## end sub close # Client sub event_read { @@ -127,22 +147,23 @@ sub event_read { # Delay close till after buffers are written on EOF. If we are unable # to write 'err' or 'hup' will be thrown and we'll close faster. - return $self->write(sub { $self->close } ) unless defined $bref; + return $self->write(sub { $self->close }) unless defined $bref; if ($self->{fast_read}) { - push @{$self->{fast_buffer}}, $$bref; + push @{ $self->{fast_buffer} }, $$bref; $self->{fast_read} -= length($$bref); # If fast_read is still positive, then we need to read more data return if ($self->{fast_read} > 0); # Append the whole giant read buffer to our main read buffer - $self->{read_buf} .= join('', @{$self->{fast_buffer}}); + $self->{read_buf} .= join('', @{ $self->{fast_buffer} }); # Reset the fast read state for next time. $self->{fast_buffer} = []; - $self->{fast_read} = undef; - } else { + $self->{fast_read} = undef; + } ## end if ($self->{fast_read}) + else { # Exact read size length likely means we have more sitting on the # socket. Buffer up to half a meg in one go. if (length($$bref) == READ_SIZE) { @@ -153,9 +174,9 @@ sub event_read { last if (length($$cref) < READ_SIZE || $limit-- < 1); } $bref = \join('', @crefs); - } + } ## end if (length($$bref) == ...) $self->{read_buf} .= $$bref; - } + } ## end else [ if ($self->{fast_read})] my $found_cmd; do { @@ -165,26 +186,30 @@ sub event_read { if ($self->{read_buf} =~ /^\0REQ(.{8,8})/s) { my ($cmd, $len) = unpack("NN", $1); if ($blen < $len + 12) { + # Start a fast read loop to get all the data we need, less # what we already have in the buffer. $self->{fast_read} = $len + 12 - $blen; return; - } + } ## end if ($blen < $len + 12) $self->process_cmd($cmd, substr($self->{read_buf}, 12, $len)); # and slide down buf: - $self->{read_buf} = substr($self->{read_buf}, 12+$len); + $self->{read_buf} = substr($self->{read_buf}, 12 + $len); + + } ## end if ($self->{read_buf} ...) + elsif ($self->{read_buf} =~ s/^(\w.+?)?\r?\n//) { - } elsif ($self->{read_buf} =~ s/^(\w.+?)?\r?\n//) { # ASCII command case (useful for telnetting in) my $line = $1; $self->process_line($line); - } else { + } ## end elsif ($self->{read_buf} ...) + else { $found_cmd = 0; } } while ($found_cmd); -} +} ## end sub event_read sub event_write { my $self = shift; @@ -205,10 +230,10 @@ sub process_line { $code->($self, $args); return; } - } + } ## end if ($line && $line =~ ...) return $self->err_line('unknown_command'); -} +} ## end sub process_line =head1 Binary Protocol Structure @@ -239,7 +264,7 @@ sub CMD_echo_req { my $blobref = shift; return $self->res_packet("echo_res", $$blobref); -} +} ## end sub CMD_echo_req sub CMD_work_status { my Gearman::Server::Client $self = shift; @@ -247,13 +272,14 @@ sub CMD_work_status { my ($handle, $nu, $de) = split(/\0/, $$ar); my $job = $self->{doing}{$handle}; - return $self->error_packet("not_worker") unless $job && $job->worker == $self; + return $self->error_packet("not_worker") + unless $job && $job->worker == $self; my $msg = Gearman::Util::pack_res_command("work_status", $$ar); $job->relay_to_listeners($msg); $job->status([$nu, $de]); return 1; -} +} ## end sub CMD_work_status sub CMD_work_complete { my Gearman::Server::Client $self = shift; @@ -263,9 +289,11 @@ sub CMD_work_complete { my $handle = $1; my $job = delete $self->{doing}{$handle}; - return $self->error_packet("not_worker") unless $job && $job->worker == $self; + return $self->error_packet("not_worker") + unless $job && $job->worker == $self; - my $msg = Gearman::Util::pack_res_command("work_complete", join("\0", $handle, $$ar)); + my $msg = Gearman::Util::pack_res_command("work_complete", + join("\0", $handle, $$ar)); $job->relay_to_listeners($msg); $job->note_finished(1); if (my $timer = $self->{timer}) { @@ -274,14 +302,15 @@ sub CMD_work_complete { } return 1; -} +} ## end sub CMD_work_complete sub CMD_work_fail { my Gearman::Server::Client $self = shift; - my $ar = shift; - my $handle = $$ar; - my $job = delete $self->{doing}{$handle}; - return $self->error_packet("not_worker") unless $job && $job->worker == $self; + my $ar = shift; + my $handle = $$ar; + my $job = delete $self->{doing}{$handle}; + return $self->error_packet("not_worker") + unless $job && $job->worker == $self; my $msg = Gearman::Util::pack_res_command("work_fail", $handle); $job->relay_to_listeners($msg); @@ -292,7 +321,7 @@ sub CMD_work_fail { } return 1; -} +} ## end sub CMD_work_fail sub CMD_work_exception { my Gearman::Server::Client $self = shift; @@ -300,28 +329,30 @@ sub CMD_work_exception { $$ar =~ s/^(.+?)\0//; my $handle = $1; - my $job = $self->{doing}{$handle}; + my $job = $self->{doing}{$handle}; - return $self->error_packet("not_worker") unless $job && $job->worker == $self; + return $self->error_packet("not_worker") + unless $job && $job->worker == $self; - my $msg = Gearman::Util::pack_res_command("work_exception", join("\0", $handle, $$ar)); + my $msg = Gearman::Util::pack_res_command("work_exception", + join("\0", $handle, $$ar)); $job->relay_to_option_listeners($msg, "exceptions"); return 1; -} +} ## end sub CMD_work_exception sub CMD_pre_sleep { my Gearman::Server::Client $self = shift; $self->{'sleeping'} = 1; $self->{server}->on_client_sleep($self); return 1; -} +} ## end sub CMD_pre_sleep sub CMD_grab_job { my Gearman::Server::Client $self = shift; my $job; - my $can_do_size = scalar @{$self->{can_do_list}}; + my $can_do_size = scalar @{ $self->{can_do_list} }; unless ($can_do_size) { $self->res_packet("no_job"); @@ -341,31 +372,32 @@ sub CMD_grab_job { or next; $job->worker($self); - $self->{doing}{$job->handle} = $job; + $self->{doing}{ $job->handle } = $job; my $timeout = $self->{can_do}->{$job_to_grab}; if (defined $timeout) { - my $timer = Danga::Socket->AddTimer($timeout, sub { - return $self->error_packet("not_worker") unless $job->worker == $self; - - my $msg = Gearman::Util::pack_res_command("work_fail", $job->handle); - $job->relay_to_listeners($msg); - $job->note_finished(1); - $job->clear_listeners; - $self->{timer} = undef; - }); + my $timer = Danga::Socket->AddTimer( + $timeout, + sub { + return $self->error_packet("not_worker") + unless $job->worker == $self; + + my $msg = Gearman::Util::pack_res_command("work_fail", + $job->handle); + $job->relay_to_listeners($msg); + $job->note_finished(1); + $job->clear_listeners; + $self->{timer} = undef; + } + ); $self->{timer} = $timer; - } + } ## end if (defined $timeout) return $self->res_packet("job_assign", - join("\0", - $job->handle, - $job->func, - ${$job->argref}, - )); - } + join("\0", $job->handle, $job->func, ${ $job->argref },)); + } ## end while ($tried < $can_do_size) $self->res_packet("no_job"); -} +} ## end sub CMD_grab_job sub CMD_can_do { my Gearman::Server::Client $self = shift; @@ -373,7 +405,7 @@ sub CMD_can_do { $self->{can_do}->{$$ar} = undef; $self->_setup_can_do_list; -} +} ## end sub CMD_can_do sub CMD_can_do_timeout { my Gearman::Server::Client $self = shift; @@ -383,12 +415,13 @@ sub CMD_can_do_timeout { if (defined $timeout) { $self->{can_do}->{$task} = $timeout; - } else { + } + else { $self->{can_do}->{$task} = undef; } $self->_setup_can_do_list; -} +} ## end sub CMD_can_do_timeout sub CMD_option_req { my Gearman::Server::Client $self = shift; @@ -404,7 +437,7 @@ sub CMD_option_req { } return $self->error_packet("unknown_option"); -} +} ## end sub CMD_option_req sub CMD_set_client_id { my Gearman::Server::Client $self = shift; @@ -413,7 +446,7 @@ sub CMD_set_client_id { $self->{client_id} = $$ar; $self->{client_id} =~ s/\s+//g; $self->{client_id} = "-" unless length $self->{client_id}; -} +} ## end sub CMD_set_client_id sub CMD_cant_do { my Gearman::Server::Client $self = shift; @@ -421,18 +454,18 @@ sub CMD_cant_do { delete $self->{can_do}->{$$ar}; $self->_setup_can_do_list; -} +} ## end sub CMD_cant_do sub CMD_get_status { my Gearman::Server::Client $self = shift; - my $ar = shift; - my $job = $self->{server}->job_by_handle($$ar); + my $ar = shift; + my $job = $self->{server}->job_by_handle($$ar); # handles can't contain nulls return if $$ar =~ /\0/; my ($known, $running, $num, $den); - $known = 0; + $known = 0; $running = 0; if ($job) { $known = 1; @@ -440,87 +473,83 @@ sub CMD_get_status { if (my $stat = $job->status) { ($num, $den) = @$stat; } - } + } ## end if ($job) $num = '' unless defined $num; $den = '' unless defined $den; - $self->res_packet("status_res", join("\0", - $$ar, - $known, - $running, - $num, - $den)); -} + $self->res_packet("status_res", + join("\0", $$ar, $known, $running, $num, $den)); +} ## end sub CMD_get_status sub CMD_reset_abilities { my Gearman::Server::Client $self = shift; $self->{can_do} = {}; $self->_setup_can_do_list; -} +} ## end sub CMD_reset_abilities sub _setup_can_do_list { my Gearman::Server::Client $self = shift; - $self->{can_do_list} = [ keys %{$self->{can_do}} ]; + $self->{can_do_list} = [keys %{ $self->{can_do} }]; $self->{can_do_iter} = 0; } -sub CMD_submit_job { push @_, 1; &_cmd_submit_job; } -sub CMD_submit_job_bg { push @_, 0; &_cmd_submit_job; } -sub CMD_submit_job_high { push @_, 1, 1; &_cmd_submit_job; } +sub CMD_submit_job { push @_, 1; &_cmd_submit_job; } +sub CMD_submit_job_bg { push @_, 0; &_cmd_submit_job; } +sub CMD_submit_job_high { push @_, 1, 1; &_cmd_submit_job; } sub _cmd_submit_job { my Gearman::Server::Client $self = shift; - my $ar = shift; - my $subscribe = shift; - my $high_pri = shift; + my $ar = shift; + my $subscribe = shift; + my $high_pri = shift; return $self->error_packet("invalid_args", "No func/uniq header [$$ar].") unless $$ar =~ s/^(.+?)\0(.*?)\0//; my ($func, $uniq) = ($1, $2); - my $job = Gearman::Server::Job->new($self->{server}, $func, $uniq, $ar, $high_pri); + my $job = Gearman::Server::Job->new($self->{server}, $func, $uniq, $ar, + $high_pri); if ($subscribe) { $job->add_listener($self); - } else { + } + else { # background mode $job->require_listener(0); } $self->res_packet("job_created", $job->handle); $self->{server}->wake_up_sleepers($func); -} +} ## end sub _cmd_submit_job sub res_packet { my Gearman::Server::Client $self = shift; my ($code, $arg) = @_; $self->write(Gearman::Util::pack_res_command($code, $arg)); return 1; -} +} ## end sub res_packet sub error_packet { my Gearman::Server::Client $self = shift; my ($code, $msg) = @_; $self->write(Gearman::Util::pack_res_command("error", "$code\0$msg")); return 0; -} +} ## end sub error_packet sub process_cmd { my Gearman::Server::Client $self = shift; - my $cmd = shift; - my $blob = shift; + my $cmd = shift; + my $blob = shift; my $cmd_name = "CMD_" . Gearman::Util::cmd_name($cmd); - my $ret = eval { - $self->$cmd_name(\$blob); - }; + my $ret = eval { $self->$cmd_name(\$blob); }; return $ret unless $@; warn "Error: $@\n"; return $self->error_packet("server_error", $@); -} +} ## end sub process_cmd sub event_err { my $self = shift; $self->close; } sub event_hup { my $self = shift; $self->close; } @@ -549,11 +578,13 @@ sub TXTCMD_workers { foreach my $cl (sort { $a->{fd} <=> $b->{fd} } $self->{server}->clients) { my $fd = $cl->{fd}; - $self->write("$fd " . $cl->peer_ip_string . " $cl->{client_id} : @{$cl->{can_do_list}}\n"); + $self->write("$fd " + . $cl->peer_ip_string + . " $cl->{client_id} : @{$cl->{can_do_list}}\n"); - } + } ## end foreach my $cl (sort { $a->...}) $self->write(".\n"); -} +} ## end sub TXTCMD_workers =head2 "status" @@ -584,16 +615,16 @@ A positive integer denoting the maximum possible count of workers that could be sub TXTCMD_status { my Gearman::Server::Client $self = shift; - my %funcs; # func -> 1 (set of all funcs to display) + my %funcs; # func -> 1 (set of all funcs to display) # keep track of how many workers can do which functions my %can; foreach my $client ($self->{server}->clients) { - foreach my $func (@{$client->{can_do_list}}) { + foreach my $func (@{ $client->{can_do_list} }) { $can{$func}++; $funcs{$func} = 1; } - } + } ## end foreach my $client ($self->...) my %queued_funcs; my %running_funcs; @@ -604,7 +635,7 @@ sub TXTCMD_status { if ($job->worker) { $running_funcs{$func}++; } - } + } ## end foreach my $job ($self->{server...}) # also include queued functions (even if there aren't workers) # in our list of funcs to show. @@ -614,11 +645,11 @@ sub TXTCMD_status { my $queued = $queued_funcs{$func} || 0; my $running = $running_funcs{$func} || 0; my $can = $can{$func} || 0; - $self->write( "$func\t$queued\t$running\t$can\n" ); - } + $self->write("$func\t$queued\t$running\t$can\n"); + } ## end foreach my $func (sort keys...) - $self->write( ".\n" ); -} + $self->write(".\n"); +} ## end sub TXTCMD_status =head2 "jobs" @@ -639,8 +670,8 @@ sub TXTCMD_jobs { my Gearman::Server::Client $self = shift; foreach my $job ($self->{server}->jobs) { - my $func = $job->func; - my $uniq = $job->uniq; + my $func = $job->func; + my $uniq = $job->uniq; my $worker_addr = "-"; if (my $worker = $job->worker) { @@ -650,10 +681,10 @@ sub TXTCMD_jobs { my $listeners = $job->listeners; $self->write("$func\t$uniq\t$worker_addr\t$listeners\n"); - } + } ## end foreach my $job ($self->{server...}) $self->write(".\n"); -} +} ## end sub TXTCMD_jobs =head2 "clients" @@ -690,7 +721,7 @@ sub TXTCMD_clients { my $ent = $jobs_by_client{$client} ||= []; push @$ent, $job; } - } + } ## end foreach my $job ($self->{server...}) foreach my $client ($self->{server}->clients) { my $client_addr = $client->peer_addr_string; @@ -698,20 +729,20 @@ sub TXTCMD_clients { my $jobs = $jobs_by_client{$client} || []; foreach my $job (@$jobs) { - my $func = $job->func; - my $uniq = $job->uniq; + my $func = $job->func; + my $uniq = $job->uniq; my $worker_addr = "-"; if (my $worker = $job->worker) { $worker_addr = $worker->peer_addr_string; } $self->write("\t$func\t$uniq\t$worker_addr\n"); - } + } ## end foreach my $job (@$jobs) - } + } ## end foreach my $client ($self->...) $self->write(".\n"); -} +} ## end sub TXTCMD_clients sub TXTCMD_gladiator { my Gearman::Server::Client $self = shift; @@ -721,20 +752,20 @@ sub TXTCMD_gladiator { my $all = Devel::Gladiator::walk_arena(); my %ct; foreach my $it (@$all) { - $ct{ref $it}++; + $ct{ ref $it }++; if (ref $it eq "CODE") { my $name = Devel::Peek::CvGV($it); $ct{$name}++ if $name =~ /ANON/; } - } - $all = undef; # required to free memory + } ## end foreach my $it (@$all) + $all = undef; # required to free memory foreach my $n (sort { $ct{$a} <=> $ct{$b} } keys %ct) { next unless $ct{$n} > 1 || $args eq "all"; $self->write(sprintf("%7d $n\n", $ct{$n})); } - } + } ## end if ($has_gladiator) $self->write(".\n"); -} +} ## end sub TXTCMD_gladiator =head2 "maxqueue" function [max_queue_size] @@ -757,7 +788,7 @@ sub TXTCMD_maxqueue { $self->{server}->set_max_queue($func, $max); $self->write("OK\n"); -} +} ## end sub TXTCMD_maxqueue =head2 "shutdown" ["graceful"] @@ -771,13 +802,15 @@ sub TXTCMD_shutdown { if ($args eq "graceful") { $self->write("OK\n"); Gearmand::shutdown_graceful(); - } elsif (! $args) { + } + elsif (!$args) { $self->write("OK\n"); exit 0; - } else { + } + else { $self->err_line('unknown_args'); } -} +} ## end sub TXTCMD_shutdown =head2 "version" @@ -792,22 +825,24 @@ sub TXTCMD_version { sub err_line { my Gearman::Server::Client $self = shift; - my $err_code = shift; - my $err_text = { - 'unknown_command' => "Unknown server command", + my $err_code = shift; + my $err_text = { + 'unknown_command# numeric iterator for where we start looking for jobl' + => "Unknown server command", 'unknown_args' => "Unknown arguments to server command", - 'incomplete_args' => "An incomplete set of arguments was sent to this command", + 'incomplete_args' => + "An incomplete set of arguments was sent to this command", }->{$err_code}; $self->write("ERR $err_code " . eurl($err_text) . "\r\n"); return 0; -} +} ## end sub err_line sub eurl { my $a = $_[0]; $a =~ s/([^a-zA-Z0-9_\,\-.\/\\\: ])/uc sprintf("%%%02x",ord($1))/eg; $a =~ tr/ /+/; return $a; -} +} ## end sub eurl 1; From ca29fc6d8c873f837160d68f08c35cce1170669d Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Sat, 9 Jul 2016 10:09:12 +0200 Subject: [PATCH 05/95] perltidy Listener --- lib/Gearman/Server/Listener.pm | 39 ++++++++++++++++++++++------------ 1 file changed, 26 insertions(+), 13 deletions(-) diff --git a/lib/Gearman/Server/Listener.pm b/lib/Gearman/Server/Listener.pm index d1fa59b..716ebae 100644 --- a/lib/Gearman/Server/Listener.pm +++ b/lib/Gearman/Server/Listener.pm @@ -2,15 +2,23 @@ package Gearman::Server::Listener; use strict; use base 'Danga::Socket'; -use fields qw(server accept_per_loop); +use fields qw/ + server + accept_per_loop + /; use Errno qw(EAGAIN); -use Socket qw(IPPROTO_TCP TCP_NODELAY SOL_SOCKET SO_ERROR); +use Socket qw/ + IPPROTO_TCP + TCP_NODELAY + SOL_SOCKET + SO_ERROR + /; sub new { my Gearman::Server::Listener $self = shift; - my $sock = shift; - my $server = shift; + my $sock = shift; + my $server = shift; my %opts = @_; @@ -19,7 +27,8 @@ sub new { warn "Extra options passed into new: " . join(', ', keys %opts) . "\n" if keys %opts; - $accept_per_loop = 10 unless defined $accept_per_loop and $accept_per_loop >= 1; + $accept_per_loop = 10 + unless defined $accept_per_loop and $accept_per_loop >= 1; $self = fields::new($self) unless ref $self; @@ -28,13 +37,13 @@ sub new { $self->SUPER::new($sock); - $self->{server} = $server; + $self->{server} = $server; $self->{accept_per_loop} = int($accept_per_loop); $self->watch_read(1); return $self; -} +} ## end sub new sub event_read { my Gearman::Server::Listener $self = shift; @@ -52,10 +61,11 @@ sub event_read { my $server = $self->{server}; - $server->debug(sprintf("Listen child making a Client for %d.", fileno($csock))); + $server->debug( + sprintf("Listen child making a Client for %d.", fileno($csock))); $server->new_client($csock); return unless $remaining-- > 0; - } + } ## end while (my $csock = $listen_sock...) return if $! == EAGAIN; @@ -63,9 +73,12 @@ sub event_read { $self->watch_read(0); - Danga::Socket->AddTimer( .1, sub { - $self->watch_read(1); - }); -} + Danga::Socket->AddTimer( + .1, + sub { + $self->watch_read(1); + } + ); +} ## end sub event_read 1; From f46e8f248e0681b0adb2477c050ea64ceae9c3bf Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Sat, 9 Jul 2016 10:16:28 +0200 Subject: [PATCH 06/95] server uses warnings --- lib/Gearman/Server.pm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lib/Gearman/Server.pm b/lib/Gearman/Server.pm index e594210..020782a 100644 --- a/lib/Gearman/Server.pm +++ b/lib/Gearman/Server.pm @@ -1,5 +1,8 @@ package Gearman::Server; +use strict; +use warnings; + =head1 NAME Gearman::Server - function call "router" and load balancer @@ -23,7 +26,6 @@ script, and not use Gearman::Server directly. =cut -use strict; use Gearman::Server::Client; use Gearman::Server::Listener; use Gearman::Server::Job; From b730944fdad319f358e2621186bf617df55cd174 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Sat, 9 Jul 2016 10:16:43 +0200 Subject: [PATCH 07/95] client uses warnings --- lib/Gearman/Server/Client.pm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lib/Gearman/Server/Client.pm b/lib/Gearman/Server/Client.pm index 1f10c42..b294df3 100644 --- a/lib/Gearman/Server/Client.pm +++ b/lib/Gearman/Server/Client.pm @@ -1,5 +1,8 @@ package Gearman::Server::Client; +use strict; +use warnings; + =head1 NAME Gearman::Server::Client @@ -20,7 +23,6 @@ The line-based administrative commands are documented below. =cut -use strict; use Danga::Socket; use base 'Danga::Socket'; use fields ( From aeb2b5fd78f1ebcd0663122cfa5e6cbfa777a99c Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Sat, 9 Jul 2016 10:17:39 +0200 Subject: [PATCH 08/95] listener uses warnings --- lib/Gearman/Server/Listener.pm | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lib/Gearman/Server/Listener.pm b/lib/Gearman/Server/Listener.pm index 716ebae..2ca2702 100644 --- a/lib/Gearman/Server/Listener.pm +++ b/lib/Gearman/Server/Listener.pm @@ -1,6 +1,8 @@ package Gearman::Server::Listener; use strict; +use warnings; + use base 'Danga::Socket'; use fields qw/ server From e49089d897f8bf8bace5734134abda9f9d10cba4 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Sat, 9 Jul 2016 10:19:44 +0200 Subject: [PATCH 09/95] gearmand moved into bin --- Makefile.PL | 22 ++++++++++++---------- 1 file changed, 12 insertions(+), 10 deletions(-) diff --git a/Makefile.PL b/Makefile.PL index d8ce29d..eb8ae62 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -1,14 +1,16 @@ use ExtUtils::MakeMaker; + # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( - NAME => 'Gearman::Server', - VERSION_FROM => 'lib/Gearman/Server.pm', - ABSTRACT_FROM => 'lib/Gearman/Server.pm', - EXE_FILES => ['gearmand'], - PREREQ_PM => { - 'Gearman::Util' => 0, - 'Danga::Socket' => 1.52, - }, - AUTHOR => 'Brad Fitzpatrick (brad@danga.com), Brad Whitaker (whitaker@danga.com)', - ); + NAME => 'Gearman::Server', + VERSION_FROM => 'lib/Gearman/Server.pm', + ABSTRACT_FROM => 'lib/Gearman/Server.pm', + EXE_FILES => ['bin/gearmand'], + PREREQ_PM => { + 'Gearman::Util' => 0, + 'Danga::Socket' => 1.52, + }, + AUTHOR => + 'Brad Fitzpatrick (brad@danga.com), Brad Whitaker (whitaker@danga.com)', +); From 07b71b0b81f86a33782284cea101f71bed8a6203 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Sat, 9 Jul 2016 10:20:09 +0200 Subject: [PATCH 10/95] git mv gearmand bin/ --- gearmand => bin/gearmand | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename gearmand => bin/gearmand (100%) diff --git a/gearmand b/bin/gearmand similarity index 100% rename from gearmand rename to bin/gearmand From bc260ec2810c87261f6af1ee62c071adf0f944d8 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Sat, 9 Jul 2016 10:23:05 +0200 Subject: [PATCH 11/95] job uses warnings --- lib/Gearman/Server/Job.pm | 1 + 1 file changed, 1 insertion(+) diff --git a/lib/Gearman/Server/Job.pm b/lib/Gearman/Server/Job.pm index 34771b6..a9628e2 100644 --- a/lib/Gearman/Server/Job.pm +++ b/lib/Gearman/Server/Job.pm @@ -1,6 +1,7 @@ package Gearman::Server::Job; use strict; +use warnings; use Gearman::Server::Client; use Scalar::Util; From f2b0a3b1e46c75ed694a0156da7bd372822a38aa Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Sat, 9 Jul 2016 10:25:47 +0200 Subject: [PATCH 12/95] replace default port by 4730 --- bin/gearmand | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/bin/gearmand b/bin/gearmand index 106c6bf..964f024 100755 --- a/bin/gearmand +++ b/bin/gearmand @@ -23,9 +23,9 @@ daemonization. Make the daemon run in the background (good for init.d scripts, bad for running under daemontools/supervise). -=item --port=7003 / -p 7003 +=item --port=4730 / -p 4730 -Set the port number, defaults to 7003. +Set the port number, defaults to 4730. =item --pidfile=/some/dir/gearmand.pid @@ -122,7 +122,7 @@ my ( $wakeup, $wakeup_delay, ); -my $conf_port = 7003; +my $conf_port = 4730; Getopt::Long::GetOptions( 'd|daemonize' => \$daemonize, From 187d7dae30ef53433d360c57b877de5c7964680c Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Sat, 9 Jul 2016 10:26:42 +0200 Subject: [PATCH 13/95] gearmand tidied --- bin/gearmand | 49 ++++++++++++++++++++++--------------------------- 1 file changed, 22 insertions(+), 27 deletions(-) diff --git a/bin/gearmand b/bin/gearmand index 964f024..684680f 100755 --- a/bin/gearmand +++ b/bin/gearmand @@ -95,8 +95,9 @@ L package Gearmand; use strict; use warnings; + BEGIN { - $^P = 0x200; # Provide informative names to anonymous subroutines + $^P = 0x200; # Provide informative names to anonymous subroutines } use FindBin; use lib "$FindBin::Bin/lib"; @@ -113,27 +114,20 @@ use Scalar::Util (); $DEBUG = 0; -my ( - $daemonize, - $nokeepalive, - $notify_pid, - $opt_pidfile, - $accept, - $wakeup, - $wakeup_delay, - ); +my ($daemonize, $nokeepalive, $notify_pid, $opt_pidfile, $accept, $wakeup, + $wakeup_delay,); my $conf_port = 4730; Getopt::Long::GetOptions( - 'd|daemonize' => \$daemonize, - 'p|port=i' => \$conf_port, - 'debug=i' => \$DEBUG, - 'pidfile=s' => \$opt_pidfile, - 'accept=i' => \$accept, - 'wakeup=i' => \$wakeup, - 'wakeup-delay=f' => \$wakeup_delay, - 'notifypid|n=i' => \$notify_pid, # for test suite only. - ); + 'd|daemonize' => \$daemonize, + 'p|port=i' => \$conf_port, + 'debug=i' => \$DEBUG, + 'pidfile=s' => \$opt_pidfile, + 'accept=i' => \$accept, + 'wakeup=i' => \$wakeup, + 'wakeup-delay=f' => \$wakeup_delay, + 'notifypid|n=i' => \$notify_pid, # for test suite only. +); daemonize() if $daemonize; @@ -141,13 +135,14 @@ daemonize() if $daemonize; # convenient place to kill the process our $graceful_shutdown = 0; -$SIG{'PIPE'} = "IGNORE"; # handled manually +$SIG{'PIPE'} = "IGNORE"; # handled manually my $server = Gearman::Server->new( - wakeup => $wakeup, - wakeup_delay => $wakeup_delay, - ); -my $ssock = $server->create_listening_sock($conf_port, accept_per_loop => $accept); + wakeup => $wakeup, + wakeup_delay => $wakeup_delay, +); +my $ssock + = $server->create_listening_sock($conf_port, accept_per_loop => $accept); if ($opt_pidfile) { open my $fh, '>', $opt_pidfile or die "Could not open $opt_pidfile: $!"; @@ -159,11 +154,11 @@ sub shutdown_graceful { return if $graceful_shutdown; my $ofds = Danga::Socket->OtherFds; - delete $ofds->{fileno($ssock)}; + delete $ofds->{ fileno($ssock) }; $ssock->close; $graceful_shutdown = 1; shutdown_if_calm(); -} +} ## end sub shutdown_graceful sub shutdown_if_calm { exit 0 unless $server->jobs_outstanding; @@ -198,7 +193,7 @@ sub daemonize { open(STDIN, "+>/dev/null"); open(STDOUT, "+>&STDIN"); open(STDERR, "+>&STDIN"); -} +} ## end sub daemonize kill 'USR1', $notify_pid if $notify_pid; Danga::Socket->EventLoop(); From ed0ab48e36a7b33ba71c899fe4856f73fac608cc Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Sat, 9 Jul 2016 10:28:25 +0200 Subject: [PATCH 14/95] gearmand env perl to be bsd conform --- bin/gearmand | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/bin/gearmand b/bin/gearmand index 684680f..a27f592 100755 --- a/bin/gearmand +++ b/bin/gearmand @@ -1,4 +1,4 @@ -#!/usr/bin/perl +#!/usr/bin/env perl =head1 NAME From cc05a39fd752997c642cc58948e7fe457bc78631 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Sat, 9 Jul 2016 10:33:49 +0200 Subject: [PATCH 15/95] gearmand comments moved from the end of statement to previous line --- bin/gearmand | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/bin/gearmand b/bin/gearmand index a27f592..4f7dcb1 100755 --- a/bin/gearmand +++ b/bin/gearmand @@ -97,7 +97,8 @@ use strict; use warnings; BEGIN { - $^P = 0x200; # Provide informative names to anonymous subroutines + # Provide informative names to anonymous subroutines + $^P = 0x200; } use FindBin; use lib "$FindBin::Bin/lib"; @@ -126,7 +127,9 @@ Getopt::Long::GetOptions( 'accept=i' => \$accept, 'wakeup=i' => \$wakeup, 'wakeup-delay=f' => \$wakeup_delay, - 'notifypid|n=i' => \$notify_pid, # for test suite only. + + # for test suite only. + 'notifypid|n=i' => \$notify_pid, ); daemonize() if $daemonize; @@ -135,8 +138,8 @@ daemonize() if $daemonize; # convenient place to kill the process our $graceful_shutdown = 0; -$SIG{'PIPE'} = "IGNORE"; # handled manually - +# handled manually +$SIG{'PIPE'} = "IGNORE"; my $server = Gearman::Server->new( wakeup => $wakeup, wakeup_delay => $wakeup_delay, From 59a1e50f0199a407ba335b6a6f766f942b86a877 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Sat, 9 Jul 2016 10:38:23 +0200 Subject: [PATCH 16/95] server v1.13.001 --- lib/Gearman/Server.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/Gearman/Server.pm b/lib/Gearman/Server.pm index 020782a..892b017 100644 --- a/lib/Gearman/Server.pm +++ b/lib/Gearman/Server.pm @@ -1,4 +1,5 @@ package Gearman::Server; +$Gearman::Server::VERSION = "1.13.001"; use strict; use warnings; @@ -51,7 +52,6 @@ use fields ( , # func -> timer, timer to be canceled or adjusted when job grab/inject is called ); -our $VERSION = "1.12"; =head1 METHODS From f176fd0e3b9663cc05edbeaa5e2af5afcb1fb675 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Sat, 9 Jul 2016 10:41:55 +0200 Subject: [PATCH 17/95] reorderd moduls in server --- lib/Gearman/Server.pm | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/lib/Gearman/Server.pm b/lib/Gearman/Server.pm index 892b017..fca536f 100644 --- a/lib/Gearman/Server.pm +++ b/lib/Gearman/Server.pm @@ -27,13 +27,20 @@ script, and not use Gearman::Server directly. =cut +use Carp qw(croak); use Gearman::Server::Client; use Gearman::Server::Listener; use Gearman::Server::Job; -use Socket qw(IPPROTO_TCP SOL_SOCKET SOCK_STREAM AF_UNIX SOCK_STREAM PF_UNSPEC); -use Carp qw(croak); -use Sys::Hostname (); use IO::Handle (); +use Socket qw/ + IPPROTO_TCP + SOL_SOCKET + SOCK_STREAM + AF_UNIX + SOCK_STREAM + PF_UNSPEC + /; +use Sys::Hostname (); use fields ( 'client_map', # fd -> Client @@ -52,7 +59,6 @@ use fields ( , # func -> timer, timer to be canceled or adjusted when job grab/inject is called ); - =head1 METHODS =head2 new From 7f999c6a0692b435cfe6ffc5ff0610b674625721 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Sat, 9 Jul 2016 10:44:36 +0200 Subject: [PATCH 18/95] split long comment --- lib/Gearman/Server.pm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lib/Gearman/Server.pm b/lib/Gearman/Server.pm index fca536f..8c6f32b 100644 --- a/lib/Gearman/Server.pm +++ b/lib/Gearman/Server.pm @@ -31,7 +31,7 @@ use Carp qw(croak); use Gearman::Server::Client; use Gearman::Server::Listener; use Gearman::Server::Job; -use IO::Handle (); +use IO::Handle (); use Socket qw/ IPPROTO_TCP SOL_SOCKET @@ -55,8 +55,8 @@ use fields ( 'listeners', # arrayref of listener objects 'wakeup', # number of workers to wake 'wakeup_delay', # seconds to wait before waking more workers - 'wakeup_timers' - , # func -> timer, timer to be canceled or adjusted when job grab/inject is called + 'wakeup_timers', # func -> timer, timer to be canceled or adjusted + # when job grab/inject is called ); =head1 METHODS From 4774a3e80d55d3c39f6e78f8f357b48c540b13cd Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Sat, 9 Jul 2016 10:46:44 +0200 Subject: [PATCH 19/95] client v1.13.001 --- lib/Gearman/Server/Client.pm | 1 + 1 file changed, 1 insertion(+) diff --git a/lib/Gearman/Server/Client.pm b/lib/Gearman/Server/Client.pm index b294df3..1509bb0 100644 --- a/lib/Gearman/Server/Client.pm +++ b/lib/Gearman/Server/Client.pm @@ -1,4 +1,5 @@ package Gearman::Server::Client; +$Gearman::Server::Client::VERSION = "1.13.001"; use strict; use warnings; From 4568eb4264d8e65a1cf0b10dfcc91f3849ea114b Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Sat, 9 Jul 2016 10:46:53 +0200 Subject: [PATCH 20/95] job v1.13.001 --- lib/Gearman/Server/Job.pm | 1 + 1 file changed, 1 insertion(+) diff --git a/lib/Gearman/Server/Job.pm b/lib/Gearman/Server/Job.pm index a9628e2..7bf8f35 100644 --- a/lib/Gearman/Server/Job.pm +++ b/lib/Gearman/Server/Job.pm @@ -1,4 +1,5 @@ package Gearman::Server::Job; +$Gearman::Server::Job::VERSION = "1.13.001"; use strict; use warnings; From fdbb9d304855f8862b64fb9e966ba8df7804a4ee Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Sat, 9 Jul 2016 10:47:03 +0200 Subject: [PATCH 21/95] listener v1.13.001 --- lib/Gearman/Server/Listener.pm | 1 + 1 file changed, 1 insertion(+) diff --git a/lib/Gearman/Server/Listener.pm b/lib/Gearman/Server/Listener.pm index 2ca2702..6e73dc3 100644 --- a/lib/Gearman/Server/Listener.pm +++ b/lib/Gearman/Server/Listener.pm @@ -1,4 +1,5 @@ package Gearman::Server::Listener; +$Gearman::Server::Listener::VERSION = "1.13.001"; use strict; use warnings; From de923f2d42eead6a472cf45b86dcfcfa3364151a Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Sat, 9 Jul 2016 10:47:49 +0200 Subject: [PATCH 22/95] add use test --- t/00-use.t | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) create mode 100644 t/00-use.t diff --git a/t/00-use.t b/t/00-use.t new file mode 100644 index 0000000..bc2e283 --- /dev/null +++ b/t/00-use.t @@ -0,0 +1,22 @@ +use strict; +use warnings; +use Test::More; + +my @mn = qw/ + Gearman::Server + Gearman::Server::Client + Gearman::Server::Listener + Gearman::Server::Job + /; + +my $v = '1.13.001'; + + +foreach my $n (@mn) { + use_ok($n); + my $_v = eval '$' . $n . '::VERSION'; + is($_v, $v, "$n version is $v"); +} ## end foreach my $n (@mn) + +done_testing; + From fb7ec6b2cc358c7f2150c2284a0f572dac30d03d Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Sat, 9 Jul 2016 10:48:52 +0200 Subject: [PATCH 23/95] update MANIFEST --- MANIFEST | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/MANIFEST b/MANIFEST index 499079b..3c372d7 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,9 +1,10 @@ CHANGES -gearmand +bin/gearmand lib/Gearman/Server.pm lib/Gearman/Server/Client.pm lib/Gearman/Server/Job.pm lib/Gearman/Server/Listener.pm +t/00-use.t Makefile.PL MANIFEST This list of files MANIFEST.SKIP From 98db0cf82d79a1db4737e51c79c22a7e967adfe7 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Sun, 10 Jul 2016 09:49:09 +0200 Subject: [PATCH 24/95] gearmand supports version option --- bin/gearmand | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/bin/gearmand b/bin/gearmand index 4f7dcb1..61c3653 100755 --- a/bin/gearmand +++ b/bin/gearmand @@ -62,6 +62,10 @@ is more cooperative in gearmand's multitasking model. Negative One (-1) means that this event won't happe, so only the initial workers will be woken up to handle jobs in the queue. +=item --version + +Display the version and exit. + =back =head1 COPYRIGHT @@ -127,6 +131,10 @@ Getopt::Long::GetOptions( 'accept=i' => \$accept, 'wakeup=i' => \$wakeup, 'wakeup-delay=f' => \$wakeup_delay, + 'version|V' => sub { + print "Gearman::Server $Gearman::Server::VERSION $/"; + exit; + }, # for test suite only. 'notifypid|n=i' => \$notify_pid, From f596b711f22dc13c9d801cb42f7306e6c5adfc4c Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Mon, 11 Jul 2016 10:56:10 +0200 Subject: [PATCH 25/95] Bug #89033 for Gearman-Server: typo fixes --- bin/gearmand | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/bin/gearmand b/bin/gearmand index 61c3653..d2cfb5d 100755 --- a/bin/gearmand +++ b/bin/gearmand @@ -59,7 +59,7 @@ the queue. Zero (0) means go as fast as possible, but not all at the same time. Similar to -1 on --wakeup, but is more cooperative in gearmand's multitasking model. -Negative One (-1) means that this event won't happe, so only the initial workers will be woken up to +Negative One (-1) means that this event won't happen, so only the initial workers will be woken up to handle jobs in the queue. =item --version @@ -185,7 +185,7 @@ sub daemonize { croak "Cannot detach from controlling terminal" unless $sess_id = POSIX::setsid(); - ## Prevent possibility of acquiring a controling terminal + ## Prevent possibility of acquiring a controlling terminal $SIG{'HUP'} = 'IGNORE'; if ($pid = fork) { exit 0; } From 33ad356fb756dae1c8432321886843bff39ef21a Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Mon, 11 Jul 2016 10:59:34 +0200 Subject: [PATCH 26/95] Bug #107045 for Gearman-Server: [PATCH] fix pod whatis --- lib/Gearman/Server/Client.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/Gearman/Server/Client.pm b/lib/Gearman/Server/Client.pm index 1509bb0..469c9e1 100644 --- a/lib/Gearman/Server/Client.pm +++ b/lib/Gearman/Server/Client.pm @@ -6,7 +6,7 @@ use warnings; =head1 NAME -Gearman::Server::Client +Gearman::Server::Client - client for gearmand =head1 NAME From 7a6214460f2f6dde7ad9e9bfbd59ad682602fc29 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Mon, 11 Jul 2016 11:12:42 +0200 Subject: [PATCH 27/95] trim --- bin/gearmand | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/bin/gearmand b/bin/gearmand index d2cfb5d..a647742 100755 --- a/bin/gearmand +++ b/bin/gearmand @@ -132,7 +132,7 @@ Getopt::Long::GetOptions( 'wakeup=i' => \$wakeup, 'wakeup-delay=f' => \$wakeup_delay, 'version|V' => sub { - print "Gearman::Server $Gearman::Server::VERSION $/"; + print "Gearman::Server $Gearman::Server::VERSION$/"; exit; }, From 2b18b3035d355d081556aec2be4434ee3b59b6b5 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Mon, 11 Jul 2016 11:44:38 +0200 Subject: [PATCH 28/95] Bug #115368 for Gearman-Server: Feature Request: Allow bind to specific IP address --- bin/gearmand | 18 ++++++++++++++---- lib/Gearman/Server.pm | 18 +++++++++++++++--- 2 files changed, 29 insertions(+), 7 deletions(-) diff --git a/bin/gearmand b/bin/gearmand index a647742..fde0380 100755 --- a/bin/gearmand +++ b/bin/gearmand @@ -27,6 +27,12 @@ for running under daemontools/supervise). Set the port number, defaults to 4730. +=item --listen hostname / -L hostname + +Address the server should listen on. + +Default is + =item --pidfile=/some/dir/gearmand.pid Write a pidfile when starting up @@ -120,13 +126,14 @@ use Scalar::Util (); $DEBUG = 0; my ($daemonize, $nokeepalive, $notify_pid, $opt_pidfile, $accept, $wakeup, - $wakeup_delay,); + $wakeup_delay, $conf_host,); my $conf_port = 4730; Getopt::Long::GetOptions( 'd|daemonize' => \$daemonize, 'p|port=i' => \$conf_port, - 'debug=i' => \$DEBUG, + 'listen|L=s' => \$conf_host, + 'debug=i' => \$DEBUG, 'pidfile=s' => \$opt_pidfile, 'accept=i' => \$accept, 'wakeup=i' => \$wakeup, @@ -152,8 +159,11 @@ my $server = Gearman::Server->new( wakeup => $wakeup, wakeup_delay => $wakeup_delay, ); -my $ssock - = $server->create_listening_sock($conf_port, accept_per_loop => $accept); +my $ssock = $server->create_listening_sock( + $conf_port, + accept_per_loop => $accept, + local_addr => $conf_host +); if ($opt_pidfile) { open my $fh, '>', $opt_pidfile or die "Could not open $opt_pidfile: $!"; diff --git a/lib/Gearman/Server.pm b/lib/Gearman/Server.pm index 8c6f32b..2fefba5 100644 --- a/lib/Gearman/Server.pm +++ b/lib/Gearman/Server.pm @@ -130,9 +130,19 @@ sub debug { =head2 create_listening_sock - $server_object->create_listening_sock( $portnum ) + $server_object->create_listening_sock( $portnum, \%options ) -Add a TCP port listener for incoming Gearman worker and client connections. +Add a TCP port listener for incoming Gearman worker and client connections. Options: + +=over 4 + +=item accept_per_loop + +=item local_addr + +Bind socket to only this address. + +=back =cut @@ -140,6 +150,7 @@ sub create_listening_sock { my ($self, $portnum, %opts) = @_; my $accept_per_loop = delete $opts{accept_per_loop}; + my $local_addr = delete $opts{local_addr}; warn "Extra options passed into create_listening_sock: " . join(', ', keys %opts) . "\n" @@ -151,7 +162,8 @@ sub create_listening_sock { Proto => IPPROTO_TCP, Blocking => 0, Reuse => 1, - Listen => 1024 + Listen => 1024, + ($local_addr ? (LocalAddr => $local_addr) : ()) ) or die "Error creating socket: $@\n"; my $listeners = $self->{listeners}; From 578b2cefa94c31d51cd9a7fabcf0a23c46e60df7 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Mon, 11 Jul 2016 12:06:19 +0200 Subject: [PATCH 29/95] pod usage --- bin/gearmand | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/bin/gearmand b/bin/gearmand index fde0380..f2abcd8 100755 --- a/bin/gearmand +++ b/bin/gearmand @@ -114,15 +114,17 @@ use FindBin; use lib "$FindBin::Bin/lib"; use Gearman::Server; -use Getopt::Long; use Carp; use Danga::Socket 1.52; +use Gearman::Util; +use Getopt::Long; use IO::Socket::INET; use POSIX (); -use Gearman::Util; -use vars qw($DEBUG); +use Pod::Usage; use Scalar::Util (); +use vars qw($DEBUG); + $DEBUG = 0; my ($daemonize, $nokeepalive, $notify_pid, $opt_pidfile, $accept, $wakeup, @@ -133,7 +135,7 @@ Getopt::Long::GetOptions( 'd|daemonize' => \$daemonize, 'p|port=i' => \$conf_port, 'listen|L=s' => \$conf_host, - 'debug=i' => \$DEBUG, + 'debug=i' => \$DEBUG, 'pidfile=s' => \$opt_pidfile, 'accept=i' => \$accept, 'wakeup=i' => \$wakeup, @@ -142,6 +144,10 @@ Getopt::Long::GetOptions( print "Gearman::Server $Gearman::Server::VERSION$/"; exit; }, + 'help|?' => sub { + pod2usage(-verbose => 1); + exit; + }, # for test suite only. 'notifypid|n=i' => \$notify_pid, From bc87f7dfecea98c0534d722df5c3ad53c8b1a61a Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Mon, 11 Jul 2016 13:56:58 +0200 Subject: [PATCH 30/95] changes update --- CHANGES | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/CHANGES b/CHANGES index 0221b8e..407fb56 100644 --- a/CHANGES +++ b/CHANGES @@ -1,8 +1,17 @@ +1.13.001 2014-12-14 + * Feature Request: #115368 for Gearman-Server: Allow bind to specific IP address + * Fix bug #115458 Distributions contain no tests. + Actually only use ok and version tests + * Fix bug #89033 typo fixes + * Fix bug #107045 [PATCH] fix pod whatis + * Fix bug #115350 Uses old port by default (7003) should use 4730 + * pod usage + 1.12 2014-12-14 * Add HACKING file - * Fix memory leak when clients disconnect (sleeper list isn't pruned). + * Fix bug #70728 memory leak when clients disconnect (sleeper list isn't pruned). Fixes CPAN RT 70728 (Marsh Yamazaki) 1.11 2010-01-17 From b4330ac995b30c43616f87eae697ed87ea886da7 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Mon, 11 Jul 2016 14:00:43 +0200 Subject: [PATCH 31/95] obsolete --- HACKING | 3 --- 1 file changed, 3 deletions(-) delete mode 100644 HACKING diff --git a/HACKING b/HACKING deleted file mode 100644 index d1f7724..0000000 --- a/HACKING +++ /dev/null @@ -1,3 +0,0 @@ -http://contributing.appspot.com/gearman - -Please submit patches to the mailing list From 9e016410a18fa9c2072cc90f1491b66f055344f0 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Mon, 11 Jul 2016 14:04:38 +0200 Subject: [PATCH 32/95] cleanup MANIFEST --- MANIFEST | 3 +++ 1 file changed, 3 insertions(+) diff --git a/MANIFEST b/MANIFEST index 3c372d7..0c4a049 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,4 +1,7 @@ CHANGES +MANIFEST This list of files +MANIFEST.SKIP +Makefile.PL bin/gearmand lib/Gearman/Server.pm lib/Gearman/Server/Client.pm From fc08fd0371fc42032ea7be390777ff73559fd9f5 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Mon, 11 Jul 2016 14:26:25 +0200 Subject: [PATCH 33/95] travis ci --- .travis.yml | 43 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 43 insertions(+) create mode 100644 .travis.yml diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 0000000..25521c3 --- /dev/null +++ b/.travis.yml @@ -0,0 +1,43 @@ +language: perl +perl: + - "5.24" + - "5.22" + - "5.20" + - "5.18" + - "5.16" + - "5.14" + - "5.12" + - "5.10" + +sudo: false + +matrix: + include: + - perl: 5.18 + env: COVERAGE=1 + +before_install: + - git clone git://github.com/travis-perl/helpers ~/travis-perl-helpers + - source ~/travis-perl-helpers/init + - build-perl + - perl -V + - build-dist + - cd $BUILD_DIR + +install: + - cpanm --quiet --notest Devel::Cover::Report::Coveralls + - cpanm --quiet --notest --installdeps . + +script: + - perl Makefile.PL + - make + - PERL5OPT=-MDevel::Cover=-coverage,statement,branch,condition,path,subroutine prove -b -r -s t + - cover -select_re '\/Gearman' + +after_success: + - cover -report coveralls + +branches: + only: + - master + - upstream From f3be8e1e0b0837298d23acacf3443bc0a2ccacfc Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Mon, 11 Jul 2016 14:27:20 +0200 Subject: [PATCH 34/95] add README --- README.md | 14 ++++++++++++++ 1 file changed, 14 insertions(+) create mode 100644 README.md diff --git a/README.md b/README.md new file mode 100644 index 0000000..3d8649b --- /dev/null +++ b/README.md @@ -0,0 +1,14 @@ +Gearman::Server +=================== + +[![CPAN version](https://badge.fury.io/pl/Gearman-Server.png)](https://badge.fury.io/pl/Gearman-Server) +[![Build Status](https://travis-ci.org/p-alik/Gearman-Server.png)](https://travis-ci.org/p-alik/Gearman-Server) +[![Coverage Status](https://coveralls.io/repos/github/p-alik/Gearman-Server/badge.png)](https://coveralls.io/github/p-alik/Gearman-Server) + +This repository contains perl implementation [Gearman](http://gearman.org) daemon + +see also +------------ +* [Gearman::Client](https://metacpan.org/pod/Gearman::Client) - Client for gearman distributed job system +* [Gearman::Worker](https://metacpan.org/pod/Gearman::Worker) - Worker for gearman distributed job system + From 840f9a89dc0bdc9120c0a3a876d4590ed4e52d4a Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Mon, 11 Jul 2016 14:27:28 +0200 Subject: [PATCH 35/95] add README --- MANIFEST | 1 + 1 file changed, 1 insertion(+) diff --git a/MANIFEST b/MANIFEST index 0c4a049..e8863b8 100644 --- a/MANIFEST +++ b/MANIFEST @@ -2,6 +2,7 @@ CHANGES MANIFEST This list of files MANIFEST.SKIP Makefile.PL +README.md bin/gearmand lib/Gearman/Server.pm lib/Gearman/Server/Client.pm From cf4bad1e656752f75f4028761f07ebc287cbd734 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Mon, 11 Jul 2016 14:33:34 +0200 Subject: [PATCH 36/95] typo --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 3d8649b..fc4a44c 100644 --- a/README.md +++ b/README.md @@ -5,7 +5,7 @@ Gearman::Server [![Build Status](https://travis-ci.org/p-alik/Gearman-Server.png)](https://travis-ci.org/p-alik/Gearman-Server) [![Coverage Status](https://coveralls.io/repos/github/p-alik/Gearman-Server/badge.png)](https://coveralls.io/github/p-alik/Gearman-Server) -This repository contains perl implementation [Gearman](http://gearman.org) daemon +This repository contains perl implementation of [Gearman](http://gearman.org) daemon see also ------------ From 4f34bce8b21f4ec86436f0e21d13a89afb73c363 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Mon, 11 Jul 2016 14:43:01 +0200 Subject: [PATCH 37/95] rm matrix; cover test --- .travis.yml | 9 +-------- 1 file changed, 1 insertion(+), 8 deletions(-) diff --git a/.travis.yml b/.travis.yml index 25521c3..2318401 100644 --- a/.travis.yml +++ b/.travis.yml @@ -11,11 +11,6 @@ perl: sudo: false -matrix: - include: - - perl: 5.18 - env: COVERAGE=1 - before_install: - git clone git://github.com/travis-perl/helpers ~/travis-perl-helpers - source ~/travis-perl-helpers/init @@ -30,12 +25,10 @@ install: script: - perl Makefile.PL - - make - PERL5OPT=-MDevel::Cover=-coverage,statement,branch,condition,path,subroutine prove -b -r -s t - - cover -select_re '\/Gearman' after_success: - - cover -report coveralls + - cover -test -report coveralls branches: only: From 47531c6e4879aa9c6f02b424d88f7c03c984eed7 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Mon, 11 Jul 2016 14:48:24 +0200 Subject: [PATCH 38/95] make --- .travis.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.travis.yml b/.travis.yml index 2318401..74a094f 100644 --- a/.travis.yml +++ b/.travis.yml @@ -25,6 +25,7 @@ install: script: - perl Makefile.PL + - make - PERL5OPT=-MDevel::Cover=-coverage,statement,branch,condition,path,subroutine prove -b -r -s t after_success: From 4309065b3e3f46118791947aab1858632878f88b Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Mon, 11 Jul 2016 17:00:37 +0200 Subject: [PATCH 39/95] prereq version --- Makefile.PL | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/Makefile.PL b/Makefile.PL index eb8ae62..7096239 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -3,13 +3,18 @@ use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( - NAME => 'Gearman::Server', - VERSION_FROM => 'lib/Gearman/Server.pm', - ABSTRACT_FROM => 'lib/Gearman/Server.pm', - EXE_FILES => ['bin/gearmand'], - PREREQ_PM => { - 'Gearman::Util' => 0, - 'Danga::Socket' => 1.52, + NAME => 'Gearman::Server', + VERSION_FROM => 'lib/Gearman/Server.pm', + ABSTRACT_FROM => 'lib/Gearman/Server.pm', + EXE_FILES => ['bin/gearmand'], + BUILD_REQUIRES => { + "Test::More" => 0, + "version" => 0, + }, + PREREQ_PM => { + "Gearman::Util" => 0, + "Danga::Socket" => 1.52, + "version" => 0, }, AUTHOR => 'Brad Fitzpatrick (brad@danga.com), Brad Whitaker (whitaker@danga.com)', From 20277b0d66fe9960fde058ce7519c74af933d8a0 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Mon, 11 Jul 2016 17:01:01 +0200 Subject: [PATCH 40/95] up to v1.130.0 --- lib/Gearman/Server.pm | 3 ++- lib/Gearman/Server/Client.pm | 3 ++- lib/Gearman/Server/Job.pm | 3 ++- lib/Gearman/Server/Listener.pm | 3 ++- t/00-use.t | 3 ++- 5 files changed, 10 insertions(+), 5 deletions(-) diff --git a/lib/Gearman/Server.pm b/lib/Gearman/Server.pm index 2fefba5..b9d1fc8 100644 --- a/lib/Gearman/Server.pm +++ b/lib/Gearman/Server.pm @@ -1,5 +1,6 @@ package Gearman::Server; -$Gearman::Server::VERSION = "1.13.001"; +use version; +$Gearman::Server::VERSION = qv("v1.130.0"); use strict; use warnings; diff --git a/lib/Gearman/Server/Client.pm b/lib/Gearman/Server/Client.pm index 469c9e1..1a66040 100644 --- a/lib/Gearman/Server/Client.pm +++ b/lib/Gearman/Server/Client.pm @@ -1,5 +1,6 @@ package Gearman::Server::Client; -$Gearman::Server::Client::VERSION = "1.13.001"; +use version; +$Gearman::Server::Client::VERSION = qv("v1.130.0"); use strict; use warnings; diff --git a/lib/Gearman/Server/Job.pm b/lib/Gearman/Server/Job.pm index 7bf8f35..7925b58 100644 --- a/lib/Gearman/Server/Job.pm +++ b/lib/Gearman/Server/Job.pm @@ -1,5 +1,6 @@ package Gearman::Server::Job; -$Gearman::Server::Job::VERSION = "1.13.001"; +use version; +$Gearman::Server::Job::VERSION = qv("v1.130.0"); use strict; use warnings; diff --git a/lib/Gearman/Server/Listener.pm b/lib/Gearman/Server/Listener.pm index 6e73dc3..8bb012a 100644 --- a/lib/Gearman/Server/Listener.pm +++ b/lib/Gearman/Server/Listener.pm @@ -1,5 +1,6 @@ package Gearman::Server::Listener; -$Gearman::Server::Listener::VERSION = "1.13.001"; +use version; +$Gearman::Server::Listener::VERSION = qv("v1.130.0"); use strict; use warnings; diff --git a/t/00-use.t b/t/00-use.t index bc2e283..10018c5 100644 --- a/t/00-use.t +++ b/t/00-use.t @@ -1,5 +1,6 @@ use strict; use warnings; +use version; use Test::More; my @mn = qw/ @@ -9,7 +10,7 @@ my @mn = qw/ Gearman::Server::Job /; -my $v = '1.13.001'; +my $v = qv("v1.130.0"); foreach my $n (@mn) { From d1862c7be4b9ee40001f705a116b30b8ef7cb5b0 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Mon, 11 Jul 2016 17:19:45 +0200 Subject: [PATCH 41/95] build req Test::Script --- Makefile.PL | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/Makefile.PL b/Makefile.PL index 7096239..b23a453 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -8,8 +8,9 @@ WriteMakefile( ABSTRACT_FROM => 'lib/Gearman/Server.pm', EXE_FILES => ['bin/gearmand'], BUILD_REQUIRES => { - "Test::More" => 0, - "version" => 0, + "Test::More" => 0, + "Test::Script" => 1.12, + "version" => 0, }, PREREQ_PM => { "Gearman::Util" => 0, From 7222f6f42288fefb1ef7f107319858beea4acb11 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Mon, 11 Jul 2016 17:20:31 +0200 Subject: [PATCH 42/95] rm FindBin --- bin/gearmand | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/bin/gearmand b/bin/gearmand index f2abcd8..6046a99 100755 --- a/bin/gearmand +++ b/bin/gearmand @@ -110,8 +110,7 @@ BEGIN { # Provide informative names to anonymous subroutines $^P = 0x200; } -use FindBin; -use lib "$FindBin::Bin/lib"; + use Gearman::Server; use Carp; From 1b139dfe4c9dd22c3127adebd6bc206d18c7ff8c Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Mon, 11 Jul 2016 17:20:46 +0200 Subject: [PATCH 43/95] +script_compiles_ok --- t/00-use.t | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/t/00-use.t b/t/00-use.t index 10018c5..72f5fef 100644 --- a/t/00-use.t +++ b/t/00-use.t @@ -1,7 +1,9 @@ use strict; use warnings; + use version; use Test::More; +use Test::Script; my @mn = qw/ Gearman::Server @@ -12,12 +14,13 @@ my @mn = qw/ my $v = qv("v1.130.0"); - foreach my $n (@mn) { use_ok($n); my $_v = eval '$' . $n . '::VERSION'; is($_v, $v, "$n version is $v"); -} ## end foreach my $n (@mn) +} + +script_compiles_ok("bin/gearmand"); done_testing; From 943fd5c38762ff8c56184f73354b4e4e6d1b2193 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Tue, 12 Jul 2016 09:31:52 +0200 Subject: [PATCH 44/95] repair gearmand link --- lib/Gearman/Server.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/Gearman/Server.pm b/lib/Gearman/Server.pm index b9d1fc8..08eecef 100644 --- a/lib/Gearman/Server.pm +++ b/lib/Gearman/Server.pm @@ -478,6 +478,6 @@ __END__ =head1 SEE ALSO -L +L =cut From 6e36af181861ed818efe003bcc7decbe0cbbc20e Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Tue, 12 Jul 2016 09:36:42 +0200 Subject: [PATCH 45/95] update version to 1.130.1 --- lib/Gearman/Server.pm | 2 +- lib/Gearman/Server/Client.pm | 2 +- lib/Gearman/Server/Job.pm | 2 +- lib/Gearman/Server/Listener.pm | 2 +- t/00-use.t | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/lib/Gearman/Server.pm b/lib/Gearman/Server.pm index 08eecef..d6a78e8 100644 --- a/lib/Gearman/Server.pm +++ b/lib/Gearman/Server.pm @@ -1,6 +1,6 @@ package Gearman::Server; use version; -$Gearman::Server::VERSION = qv("v1.130.0"); +$Gearman::Server::VERSION = qv("v1.130.1"); use strict; use warnings; diff --git a/lib/Gearman/Server/Client.pm b/lib/Gearman/Server/Client.pm index 1a66040..c860295 100644 --- a/lib/Gearman/Server/Client.pm +++ b/lib/Gearman/Server/Client.pm @@ -1,6 +1,6 @@ package Gearman::Server::Client; use version; -$Gearman::Server::Client::VERSION = qv("v1.130.0"); +$Gearman::Server::Client::VERSION = qv("v1.130.1"); use strict; use warnings; diff --git a/lib/Gearman/Server/Job.pm b/lib/Gearman/Server/Job.pm index 7925b58..d0c675d 100644 --- a/lib/Gearman/Server/Job.pm +++ b/lib/Gearman/Server/Job.pm @@ -1,6 +1,6 @@ package Gearman::Server::Job; use version; -$Gearman::Server::Job::VERSION = qv("v1.130.0"); +$Gearman::Server::Job::VERSION = qv("v1.130.1"); use strict; use warnings; diff --git a/lib/Gearman/Server/Listener.pm b/lib/Gearman/Server/Listener.pm index 8bb012a..ea1eb61 100644 --- a/lib/Gearman/Server/Listener.pm +++ b/lib/Gearman/Server/Listener.pm @@ -1,6 +1,6 @@ package Gearman::Server::Listener; use version; -$Gearman::Server::Listener::VERSION = qv("v1.130.0"); +$Gearman::Server::Listener::VERSION = qv("v1.130.1"); use strict; use warnings; diff --git a/t/00-use.t b/t/00-use.t index 72f5fef..af431b9 100644 --- a/t/00-use.t +++ b/t/00-use.t @@ -12,7 +12,7 @@ my @mn = qw/ Gearman::Server::Job /; -my $v = qv("v1.130.0"); +my $v = qv("v1.130.1"); foreach my $n (@mn) { use_ok($n); From d5eb82e54c263710c9b260e668bf75b4ce21ad04 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Tue, 12 Jul 2016 09:40:33 +0200 Subject: [PATCH 46/95] an other gearmand link repaired --- lib/Gearman/Server.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/Gearman/Server.pm b/lib/Gearman/Server.pm index d6a78e8..c9461fb 100644 --- a/lib/Gearman/Server.pm +++ b/lib/Gearman/Server.pm @@ -23,7 +23,7 @@ The servers connect them, routing function call requests to the appropriate workers, multiplexing responses to duplicate requests as requested, etc. -More than likely, you want to use the provided L wrapper +More than likely, you want to use the provided L wrapper script, and not use Gearman::Server directly. =cut From 3048df2f4c4c9bdee375ce013525e1bf12ecd5a4 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Tue, 12 Jul 2016 09:42:00 +0200 Subject: [PATCH 47/95] update changes --- CHANGES | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/CHANGES b/CHANGES index 407fb56..7b93cce 100644 --- a/CHANGES +++ b/CHANGES @@ -1,4 +1,7 @@ -1.13.001 2014-12-14 +1.13.002 2016-07-11 + * pod links to gearmand repaired + +1.13.001 2016-07-11 * Feature Request: #115368 for Gearman-Server: Allow bind to specific IP address * Fix bug #115458 Distributions contain no tests. Actually only use ok and version tests From 73d10f52da05a6268225a75400d153fabb943b79 Mon Sep 17 00:00:00 2001 From: Graham Ollis Date: Tue, 12 Jul 2016 07:25:35 -0400 Subject: [PATCH 48/95] add dist meta to point ot repository --- Makefile.PL | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/Makefile.PL b/Makefile.PL index b23a453..c36bdb2 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -19,4 +19,15 @@ WriteMakefile( }, AUTHOR => 'Brad Fitzpatrick (brad@danga.com), Brad Whitaker (whitaker@danga.com)', + META_MERGE => { + 'meta-spec' => { version => 2 }, + resources => { + repository => { + type => 'git', + url => 'https://github.com/p-alik/Gearman-Server.git', + web => 'https://github.com/p-alik/Gearman-Server', + }, + }, + }, + ); From 94891757e51143c1af970ad0aece56c27e81fcae Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Tue, 12 Jul 2016 16:26:26 +0200 Subject: [PATCH 49/95] Revert "an other gearmand link repaired" This reverts commit f173c515abda5ed194ca3c8fb054001926f5cb94. --- lib/Gearman/Server.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/Gearman/Server.pm b/lib/Gearman/Server.pm index c9461fb..d6a78e8 100644 --- a/lib/Gearman/Server.pm +++ b/lib/Gearman/Server.pm @@ -23,7 +23,7 @@ The servers connect them, routing function call requests to the appropriate workers, multiplexing responses to duplicate requests as requested, etc. -More than likely, you want to use the provided L wrapper +More than likely, you want to use the provided L wrapper script, and not use Gearman::Server directly. =cut From 4aed1466d231d4409f0e4e3384f6afa493d2caea Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Tue, 12 Jul 2016 16:27:14 +0200 Subject: [PATCH 50/95] Revert "repair gearmand link" This reverts commit b986aba54964c144b4b498a412e8aecc7e85ece1. --- lib/Gearman/Server.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/Gearman/Server.pm b/lib/Gearman/Server.pm index d6a78e8..05c8a27 100644 --- a/lib/Gearman/Server.pm +++ b/lib/Gearman/Server.pm @@ -478,6 +478,6 @@ __END__ =head1 SEE ALSO -L +L =cut From 9a49b8d3ae92be7fada8c4ca52967116cc70c793 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Tue, 12 Jul 2016 16:28:32 +0200 Subject: [PATCH 51/95] v 1.130.2 --- lib/Gearman/Server.pm | 2 +- lib/Gearman/Server/Client.pm | 2 +- lib/Gearman/Server/Job.pm | 2 +- lib/Gearman/Server/Listener.pm | 2 +- t/00-use.t | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/lib/Gearman/Server.pm b/lib/Gearman/Server.pm index 05c8a27..cff5884 100644 --- a/lib/Gearman/Server.pm +++ b/lib/Gearman/Server.pm @@ -1,6 +1,6 @@ package Gearman::Server; use version; -$Gearman::Server::VERSION = qv("v1.130.1"); +$Gearman::Server::VERSION = qv("v1.130.2"); use strict; use warnings; diff --git a/lib/Gearman/Server/Client.pm b/lib/Gearman/Server/Client.pm index c860295..285572d 100644 --- a/lib/Gearman/Server/Client.pm +++ b/lib/Gearman/Server/Client.pm @@ -1,6 +1,6 @@ package Gearman::Server::Client; use version; -$Gearman::Server::Client::VERSION = qv("v1.130.1"); +$Gearman::Server::Client::VERSION = qv("v1.130.2"); use strict; use warnings; diff --git a/lib/Gearman/Server/Job.pm b/lib/Gearman/Server/Job.pm index d0c675d..1e141c4 100644 --- a/lib/Gearman/Server/Job.pm +++ b/lib/Gearman/Server/Job.pm @@ -1,6 +1,6 @@ package Gearman::Server::Job; use version; -$Gearman::Server::Job::VERSION = qv("v1.130.1"); +$Gearman::Server::Job::VERSION = qv("v1.130.2"); use strict; use warnings; diff --git a/lib/Gearman/Server/Listener.pm b/lib/Gearman/Server/Listener.pm index ea1eb61..2e5a053 100644 --- a/lib/Gearman/Server/Listener.pm +++ b/lib/Gearman/Server/Listener.pm @@ -1,6 +1,6 @@ package Gearman::Server::Listener; use version; -$Gearman::Server::Listener::VERSION = qv("v1.130.1"); +$Gearman::Server::Listener::VERSION = qv("v1.130.2"); use strict; use warnings; diff --git a/t/00-use.t b/t/00-use.t index af431b9..c432ab8 100644 --- a/t/00-use.t +++ b/t/00-use.t @@ -12,7 +12,7 @@ my @mn = qw/ Gearman::Server::Job /; -my $v = qv("v1.130.1"); +my $v = qv("v1.130.2"); foreach my $n (@mn) { use_ok($n); From 21216024f3a22ab89461bf822fac58b10beb6ac7 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Tue, 12 Jul 2016 16:42:19 +0200 Subject: [PATCH 52/95] use Gearman::Util --- lib/Gearman/Server/Client.pm | 1 + 1 file changed, 1 insertion(+) diff --git a/lib/Gearman/Server/Client.pm b/lib/Gearman/Server/Client.pm index 285572d..f09cc06 100644 --- a/lib/Gearman/Server/Client.pm +++ b/lib/Gearman/Server/Client.pm @@ -25,6 +25,7 @@ The line-based administrative commands are documented below. =cut +use Gearman::Util; use Danga::Socket; use base 'Danga::Socket'; use fields ( From a3a90fddc9d6e6ac57a347af6b70fec159c5e68b Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Tue, 12 Jul 2016 16:42:46 +0200 Subject: [PATCH 53/95] use Gearman::Util && IO::Socket::INET --- lib/Gearman/Server.pm | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lib/Gearman/Server.pm b/lib/Gearman/Server.pm index cff5884..5e14d75 100644 --- a/lib/Gearman/Server.pm +++ b/lib/Gearman/Server.pm @@ -32,6 +32,8 @@ use Carp qw(croak); use Gearman::Server::Client; use Gearman::Server::Listener; use Gearman::Server::Job; +use Gearman::Util; +use IO::Socket::INET; use IO::Handle (); use Socket qw/ IPPROTO_TCP From 94cd9743c51ce977c3c780d6cffe9b1a6a862d7b Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Tue, 12 Jul 2016 16:43:14 +0200 Subject: [PATCH 54/95] rm Gearman::Util && IO::Socket::INET --- bin/gearmand | 2 -- 1 file changed, 2 deletions(-) diff --git a/bin/gearmand b/bin/gearmand index 6046a99..b9ea452 100755 --- a/bin/gearmand +++ b/bin/gearmand @@ -115,9 +115,7 @@ use Gearman::Server; use Carp; use Danga::Socket 1.52; -use Gearman::Util; use Getopt::Long; -use IO::Socket::INET; use POSIX (); use Pod::Usage; use Scalar::Util (); From 622271dc99e25f8c6c4df66e79aa29a01330012f Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Tue, 12 Jul 2016 16:44:11 +0200 Subject: [PATCH 55/95] initial gearman server test script --- t/01-gearman-server.t | 14 ++++++++++++++ 1 file changed, 14 insertions(+) create mode 100644 t/01-gearman-server.t diff --git a/t/01-gearman-server.t b/t/01-gearman-server.t new file mode 100644 index 0000000..b60de16 --- /dev/null +++ b/t/01-gearman-server.t @@ -0,0 +1,14 @@ +use strict; +use warnings; + +use Test::More; + +my $mn = qw/ + Gearman::Server + /; + +use_ok($mn); +my $gs = new_ok($mn); + +done_testing; + From 8f0389eb6f4e27728cdbb05ab32bc26c7e66c633 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Wed, 13 Jul 2016 22:38:50 +0200 Subject: [PATCH 56/95] gearman server can test --- t/01-gearman-server.t | 22 +++++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) diff --git a/t/01-gearman-server.t b/t/01-gearman-server.t index b60de16..1a2c95d 100644 --- a/t/01-gearman-server.t +++ b/t/01-gearman-server.t @@ -10,5 +10,25 @@ my $mn = qw/ use_ok($mn); my $gs = new_ok($mn); +can_ok $gs, qw/ + create_listening_sock + new_client + note_disconnected_client + clients + to_inprocess_server + start_worker + enqueue_job + wake_up_sleepers + _wake_up_some + on_client_sleep + jobs_outstanding + jobs + job_by_handle + note_job_finished + set_max_queue + new_job_handle + job_of_unique + set_unique_job + grab_job + /; done_testing; - From b64106a422420f98de0c3b44513902e4ee5b3273 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Wed, 13 Jul 2016 22:49:47 +0200 Subject: [PATCH 57/95] gearmand options defined in GetOptions --- bin/gearmand | 24 ++++++++---------------- 1 file changed, 8 insertions(+), 16 deletions(-) diff --git a/bin/gearmand b/bin/gearmand index b9ea452..73879e1 100755 --- a/bin/gearmand +++ b/bin/gearmand @@ -123,20 +123,17 @@ use Scalar::Util (); use vars qw($DEBUG); $DEBUG = 0; - -my ($daemonize, $nokeepalive, $notify_pid, $opt_pidfile, $accept, $wakeup, - $wakeup_delay, $conf_host,); my $conf_port = 4730; -Getopt::Long::GetOptions( - 'd|daemonize' => \$daemonize, +GetOptions( + 'd|daemonize' => \my $daemonize, 'p|port=i' => \$conf_port, - 'listen|L=s' => \$conf_host, + 'listen|L=s' => \my $conf_host, 'debug=i' => \$DEBUG, - 'pidfile=s' => \$opt_pidfile, - 'accept=i' => \$accept, - 'wakeup=i' => \$wakeup, - 'wakeup-delay=f' => \$wakeup_delay, + 'pidfile=s' => \my $opt_pidfile, + 'accept=i' => \my $accept, + 'wakeup=i' => \my $wakeup, + 'wakeup-delay=f' => \my $wakeup_delay, 'version|V' => sub { print "Gearman::Server $Gearman::Server::VERSION$/"; exit; @@ -147,7 +144,7 @@ Getopt::Long::GetOptions( }, # for test suite only. - 'notifypid|n=i' => \$notify_pid, + 'notifypid|n=i' => \my $notify_pid, ); daemonize() if $daemonize; @@ -222,8 +219,3 @@ sub daemonize { kill 'USR1', $notify_pid if $notify_pid; Danga::Socket->EventLoop(); -# Local Variables: -# mode: perl -# c-basic-indent: 4 -# indent-tabs-mode: nil -# End: From e838129582021c6d50bae1ea034044e66b8d7d84 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Wed, 13 Jul 2016 23:04:16 +0200 Subject: [PATCH 58/95] create_listening_sock subtest --- t/01-gearman-server.t | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/t/01-gearman-server.t b/t/01-gearman-server.t index 1a2c95d..4d6faf3 100644 --- a/t/01-gearman-server.t +++ b/t/01-gearman-server.t @@ -31,4 +31,17 @@ can_ok $gs, qw/ set_unique_job grab_job /; + +subtest "create_listening_sock", sub { + my $gs = new_ok($mn); + my $port = 12345; + my ($accept, $la); + ok(my $sock = $gs->create_listening_sock( + $port, + accept_per_loop => $accept, + local_addr => $la + )); + isa_ok($sock, "IO::Socket::INET"); +}; + done_testing; From dce6f82ad71e9a22ecc6bc4ab8335b2f16c69715 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Wed, 13 Jul 2016 23:14:00 +0200 Subject: [PATCH 59/95] gearman server cliet test script --- t/02-gearman-server-client.t | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) create mode 100644 t/02-gearman-server-client.t diff --git a/t/02-gearman-server-client.t b/t/02-gearman-server-client.t new file mode 100644 index 0000000..3e5484a --- /dev/null +++ b/t/02-gearman-server-client.t @@ -0,0 +1,17 @@ +use strict; +use warnings; + +use IO::Socket::INET; +use Test::More; + +my $mn = "Gearman::Server::Client"; + +use_ok("Gearman::Server"); +use_ok($mn); + +isa_ok($mn, "Danga::Socket"); + +# new_ok($mn, [IO::Socket::INET->new(), new_ok("Gearman::Server")]); + +done_testing; + From 1f62605f0adc77786abdbb981ac5e7bca36d9192 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Fri, 5 Aug 2016 14:36:48 +0200 Subject: [PATCH 60/95] server.pm new refactoring --- lib/Gearman/Server.pm | 32 +++++++++++++++++--------------- 1 file changed, 17 insertions(+), 15 deletions(-) diff --git a/lib/Gearman/Server.pm b/lib/Gearman/Server.pm index 5e14d75..9d942a2 100644 --- a/lib/Gearman/Server.pm +++ b/lib/Gearman/Server.pm @@ -84,19 +84,22 @@ Specify a port which you would like the Gearman::Server to listen on for TCP con sub new { my ($class, %opts) = @_; - my $self = ref $class ? $class : fields::new($class); - - $self->{client_map} = {}; - $self->{sleepers} = {}; - $self->{sleepers_list} = {}; - $self->{job_queue} = {}; - $self->{job_of_handle} = {}; - $self->{max_queue} = {}; - $self->{job_of_uniq} = {}; - $self->{listeners} = []; - $self->{wakeup} = 3; - $self->{wakeup_delay} = .1; - $self->{wakeup_timers} = {}; + my $self = ref($class) ? $class : fields::new($class); + + $self->{$_} = {} for qw/ + client_map + sleepers + sleepers_list + job_queue + job_of_handle + max_queue + job_of_uniq + wakeup_timers + /; + + $self->{listeners} = []; + $self->{wakeup} = 3; + $self->{wakeup_delay} = .1; $self->{handle_ct} = 0; $self->{handle_base} = "H:" . Sys::Hostname::hostname() . ":"; @@ -104,7 +107,6 @@ sub new { my $port = delete $opts{port}; my $wakeup = delete $opts{wakeup}; - if (defined $wakeup) { die "Invalid value passed in wakeup option" if $wakeup < 0 && $wakeup != -1; @@ -112,7 +114,6 @@ sub new { } my $wakeup_delay = delete $opts{wakeup_delay}; - if (defined $wakeup_delay) { die "Invalid value passed in wakeup_delay option" if $wakeup_delay < 0 && $wakeup_delay != -1; @@ -120,6 +121,7 @@ sub new { } croak("Unknown options") if %opts; + $self->create_listening_sock($port); return $self; From 90d2b228035d1b11fa9ed46f4bcc5dff94c3d1b6 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Fri, 5 Aug 2016 14:38:04 +0200 Subject: [PATCH 61/95] Gearman::Server subtest new --- t/01-gearman-server.t | 68 ++++++++++++++++++++++++++++++++++++------- 1 file changed, 57 insertions(+), 11 deletions(-) diff --git a/t/01-gearman-server.t b/t/01-gearman-server.t index 4d6faf3..fe5d796 100644 --- a/t/01-gearman-server.t +++ b/t/01-gearman-server.t @@ -2,15 +2,16 @@ use strict; use warnings; use Test::More; +use Test::Exception; +use Sys::Hostname (); my $mn = qw/ Gearman::Server /; use_ok($mn); -my $gs = new_ok($mn); -can_ok $gs, qw/ +can_ok $mn, qw/ create_listening_sock new_client note_disconnected_client @@ -32,16 +33,61 @@ can_ok $gs, qw/ grab_job /; +subtest "new", sub { + my $gs = new_ok($mn); + + my @khr = qw/ + client_map + sleepers + sleepers_list + job_queue + job_of_handle + max_queue + job_of_uniq + wakeup_timers + /; + + foreach (@khr) { + is(ref($gs->{$_}), "HASH", join "->", $mn, "{$_} is hash ref") + && is(keys(%{ $gs->{$_} }), 0, join "->", $mn, "{$_} empty"); + } + + is(ref($gs->{listeners}), + "ARRAY", join "->", $mn, "{listeners} is array ref"); + + # && is(@{$gs->{listeners}}, 0, join "->", $mn, "{listeners} empty") + + is($gs->{wakeup}, 3, "wakeup 3"); + is($gs->{wakeup_delay}, .1, "wakeup_delay .1"); + is($gs->{handle_ct}, 0, "handle_ct"); + is($gs->{handle_base}, "H:" . Sys::Hostname::hostname() . ":", + "handle_base"); + + $gs = new_ok($mn, [wakeup => -1, wakeup_delay => -1]); + is($gs->{wakeup}, -1, "wakeup -1"); + is($gs->{wakeup}, -1, "wakeup_delay -1"); + + for (qw/wakeup wakeup_delay/) { + throws_ok { $mn->new($_ => -2) } qr/Invalid value passed in $_ option/, + "Invalid value passed in $_ option"; + } + + throws_ok { $mn->new(foo => 1) } qr/Unknown options/, + "Unknown options"; +}; + subtest "create_listening_sock", sub { - my $gs = new_ok($mn); - my $port = 12345; - my ($accept, $la); - ok(my $sock = $gs->create_listening_sock( - $port, - accept_per_loop => $accept, - local_addr => $la - )); - isa_ok($sock, "IO::Socket::INET"); + my $gs = new_ok($mn); + my $port = 12345; + my ($accept, $la); + ok( + my $sock = $gs->create_listening_sock( + $port, + accept_per_loop => $accept, + local_addr => $la + ) + ); + isa_ok($sock, "IO::Socket::INET"); }; done_testing; From e4503ca1efab6318c19aa0c1cd64fd48c4feb207 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Fri, 5 Aug 2016 14:57:59 +0200 Subject: [PATCH 62/95] build requires Test::Exception, Sys::Hostname --- Makefile.PL | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/Makefile.PL b/Makefile.PL index c36bdb2..a299317 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -8,20 +8,23 @@ WriteMakefile( ABSTRACT_FROM => 'lib/Gearman/Server.pm', EXE_FILES => ['bin/gearmand'], BUILD_REQUIRES => { - "Test::More" => 0, - "Test::Script" => 1.12, - "version" => 0, + "Test::Exception" => 0, + "Test::More" => 0, + "Test::Script" => 1.12, + "Sys::Hostname" => 0, + "version" => 0, }, PREREQ_PM => { "Gearman::Util" => 0, "Danga::Socket" => 1.52, + "Sys::Hostname" => 0, "version" => 0, }, AUTHOR => 'Brad Fitzpatrick (brad@danga.com), Brad Whitaker (whitaker@danga.com)', META_MERGE => { 'meta-spec' => { version => 2 }, - resources => { + resources => { repository => { type => 'git', url => 'https://github.com/p-alik/Gearman-Server.git', @@ -29,5 +32,5 @@ WriteMakefile( }, }, }, - + ); From 6f65245f85046f955a9056361ef96eac08e88e5a Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Sun, 7 Aug 2016 21:27:29 +0200 Subject: [PATCH 63/95] Gearman::Server pod --- lib/Gearman/Server.pm | 70 ++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 66 insertions(+), 4 deletions(-) diff --git a/lib/Gearman/Server.pm b/lib/Gearman/Server.pm index 9d942a2..3c8b019 100644 --- a/lib/Gearman/Server.pm +++ b/lib/Gearman/Server.pm @@ -133,9 +133,7 @@ sub debug { #warn "$msg\n"; } -=head2 create_listening_sock - - $server_object->create_listening_sock( $portnum, \%options ) +=head2 create_listening_sock($portnum, %options) Add a TCP port listener for incoming Gearman worker and client connections. Options: @@ -179,6 +177,10 @@ sub create_listening_sock { return $ssock; } ## end sub create_listening_sock +=head2 new_client($sock) + +=cut + sub new_client { my ($self, $sock) = @_; my $client = Gearman::Server::Client->new($sock, $self); @@ -186,16 +188,28 @@ sub new_client { $self->{client_map}{ $client->{fd} } = $client; } ## end sub new_client +=head2 note_disconnected_client($client) + +=cut + sub note_disconnected_client { my ($self, $client) = @_; delete $self->{client_map}{ $client->{fd} }; } +=head2 clients() + +=cut + sub clients { my $self = shift; return values %{ $self->{client_map} }; } +=head2 to_inprocess_server() + +=cut + # Returns a socket that is connected to the server, we can then use this # socket with a Gearman::Client::Async object to run clients and servers in the # same thread. @@ -222,7 +236,7 @@ sub to_inprocess_server { return $psock; } ## end sub to_inprocess_server -=head2 start_worker +=head2 start_worker($prog) $pid = $server_object->start_worker( $prog ) @@ -278,6 +292,10 @@ sub start_worker { return wantarray ? ($pid, $client) : $pid; } ## end sub start_worker +=head2 enqueue_job() + +=cut + sub enqueue_job { my ($self, $job, $highpri) = @_; my $jq = ($self->{job_queue}{ $job->{func} } ||= []); @@ -304,6 +322,10 @@ sub enqueue_job { $self->{job_of_handle}{ $job->{'handle'} } = $job; } ## end sub enqueue_job +=head2 wake_up_sleepers($func) + +=cut + sub wake_up_sleepers { my ($self, $func) = @_; @@ -362,6 +384,10 @@ sub _wake_up_some { return; } ## end sub _wake_up_some +=head2 on_client_sleep($client) + +=cut + sub on_client_sleep { my $self = shift; my Gearman::Server::Client $cl = shift; @@ -398,21 +424,37 @@ sub on_client_sleep { } ## end foreach my $cd (@{ $cl->{can_do_list...}}) } ## end sub on_client_sleep +=head2 jobs_outstanding() + +=cut + sub jobs_outstanding { my Gearman::Server $self = shift; return scalar keys %{ $self->{job_queue} }; } +=head2 jobs() + +=cut + sub jobs { my Gearman::Server $self = shift; return values %{ $self->{job_of_handle} }; } +=head2 jobs_by_handle($ahndle) + +=cut + sub job_by_handle { my ($self, $handle) = @_; return $self->{job_of_handle}{$handle}; } +=head2 note_job_finished($job) + +=cut + sub note_job_finished { my Gearman::Server $self = shift; my Gearman::Server::Job $job = shift; @@ -427,6 +469,10 @@ sub note_job_finished { delete $self->{job_of_handle}{ $job->{handle} }; } ## end sub note_job_finished +=head2 set_max_queue($func, $max) + +=cut + # <0/undef/"" to reset. else integer max depth. sub set_max_queue { my ($self, $func, $max) = @_; @@ -438,23 +484,39 @@ sub set_max_queue { } } ## end sub set_max_queue +=head2 new_job_handle() + +=cut + sub new_job_handle { my $self = shift; return $self->{handle_base} . (++$self->{handle_ct}); } +=head2 job_of_unique($func, $uniq) + +=cut + sub job_of_unique { my ($self, $func, $uniq) = @_; return undef unless $self->{job_of_uniq}{$func}; return $self->{job_of_uniq}{$func}{$uniq}; } +=head2 set_unique_job($func, $uniq, $job) + +=cut + sub set_unique_job { my ($self, $func, $uniq, $job) = @_; $self->{job_of_uniq}{$func} ||= {}; $self->{job_of_uniq}{$func}{$uniq} = $job; } +=head2 grab_job($func) + +=cut + sub grab_job { my ($self, $func) = @_; return undef unless $self->{job_queue}{$func}; From ac4ade07d5c5b64efa45cd7da1eba7368aa9fdbf Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Sun, 7 Aug 2016 21:41:35 +0200 Subject: [PATCH 64/95] Gearmand::Server::Client pod --- lib/Gearman/Server/Client.pm | 55 +++++++++++++++++++++++++++++------- 1 file changed, 45 insertions(+), 10 deletions(-) diff --git a/lib/Gearman/Server/Client.pm b/lib/Gearman/Server/Client.pm index f09cc06..24314c7 100644 --- a/lib/Gearman/Server/Client.pm +++ b/lib/Gearman/Server/Client.pm @@ -9,7 +9,7 @@ use warnings; Gearman::Server::Client - client for gearmand -=head1 NAME +=head1 DESCRIPTION Used by L to instantiate connections from clients. Clients speak either a binary protocol, for normal operation (calling @@ -23,6 +23,8 @@ and L, if that's any consolation. The line-based administrative commands are documented below. +=head1 METHODS + =cut use Gearman::Util; @@ -91,6 +93,10 @@ sub new { return $self; } ## end sub new +=head2 option($option) + +=cut + sub option { my Gearman::Server::Client $self = shift; my $option = shift; @@ -98,6 +104,10 @@ sub option { return $self->{options}->{$option}; } ## end sub option +=head2 close() + +=cut + sub close { my Gearman::Server::Client $self = shift; @@ -143,6 +153,10 @@ sub close { $self->SUPER::close; } ## end sub close +=head2 event_read() + +=cut + # Client sub event_read { my Gearman::Server::Client $self = shift; @@ -216,12 +230,20 @@ sub event_read { } while ($found_cmd); } ## end sub event_read +=head2 event_write() + +=cut + sub event_write { my $self = shift; my $done = $self->write(undef); $self->watch_write(0) if $done; } +=head2 process_line($line) + +=cut + # Line based command processor sub process_line { my Gearman::Server::Client $self = shift; @@ -563,11 +585,15 @@ sub event_hup { my $self = shift; $self->close; } =head1 Line based commands -These commands are used for administrative or statistic tasks to be done on the gearman server. They can be entered using a line based client (telnet, etc.) by connecting to the listening port (7003) and are also intended to be machine parsable. +These commands are used for administrative or statistic tasks to be done on the +gearman server. They can be entered using a line based client (telnet, etc.) by +connecting to the listening port (4730) and are also intended to be machine +parsable. =head2 "workers" -Emits list of registered workers, their fds, IPs, client ids, and list of registered abilities (function names they can do). Of format: +Emits list of registered workers, their fds, IPs, client ids, and list of +registered abilities (function names they can do). Of format: fd ip.x.y.z client_id : func_a func_b func_c fd ip.x.y.z client_id : func_a func_b func_c @@ -593,7 +619,9 @@ sub TXTCMD_workers { =head2 "status" -The output format of this function is tab separated columns as follows, followed by a line consisting of a fullstop and a newline (".\n") to indicate the end of output. +The output format of this function is tab separated columns as follows, +followed by a line consisting of a fullstop and a newline (".\n") to indicate +the end of output. =over @@ -603,7 +631,8 @@ A string denoting the name of the function of the job =item Number in queue -A positive integer indicating the total number of jobs for this function in the queue. This includes currently running ones as well (next column) +A positive integer indicating the total number of jobs for this function in the +queue. This includes currently running ones as well (next column) =item Number of jobs running @@ -611,7 +640,9 @@ A positive integer showing how many jobs of this function are currently running =item Number of capable workers -A positive integer denoting the maximum possible count of workers that could be doing this job. Though they may not all be working on it due to other tasks holding them busy. +A positive integer denoting the maximum possible count of workers that could be +doing this job. Though they may not all be working on it due to other tasks +holding them busy. =back @@ -774,11 +805,14 @@ sub TXTCMD_gladiator { =head2 "maxqueue" function [max_queue_size] -For a given function of job, the maximum queue size is adjusted to be max_queue_size jobs long. A negative value indicates unlimited queue size. +For a given function of job, the maximum queue size is adjusted to be +max_queue_size jobs long. A negative value indicates unlimited queue size. -If the max_queue_size value is not supplied then it is unset (and the default maximum queue size will apply to this function). +If the max_queue_size value is not supplied then it is unset (and the default +maximum queue size will apply to this function). -This function will return OK upon success, and will return ERR incomplete_args upon an invalid number of arguments. +This function will return OK upon success, and will return ERR incomplete_args +upon an invalid number of arguments. =cut @@ -797,7 +831,8 @@ sub TXTCMD_maxqueue { =head2 "shutdown" ["graceful"] -Close the server. Or "shutdown graceful" to close the listening socket, then close the server when traffic has died away. +Close the server. Or "shutdown graceful" to close the listening socket, then +close the server when traffic has died away. =cut From 0c6aa6dd22a86f649997575be249f26a1317c9a7 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Sun, 7 Aug 2016 22:00:27 +0200 Subject: [PATCH 65/95] Gearman::Server::Job pod --- lib/Gearman/Server/Job.pm | 126 ++++++++++++++++++++++++++++++-------- 1 file changed, 99 insertions(+), 27 deletions(-) diff --git a/lib/Gearman/Server/Job.pm b/lib/Gearman/Server/Job.pm index 1e141c4..39917f0 100644 --- a/lib/Gearman/Server/Job.pm +++ b/lib/Gearman/Server/Job.pm @@ -5,21 +5,37 @@ $Gearman::Server::Job::VERSION = qv("v1.130.2"); use strict; use warnings; +=head1 NAME + +Gearman::Server::Job - job representation of L + +=head1 DESCRIPTION + +=head1 METHODS + +=cut + use Gearman::Server::Client; use Scalar::Util; use Sys::Hostname; use fields ( - 'func', - 'uniq', - 'argref', - 'listeners', # arrayref of interested Clients - 'worker', - 'handle', - 'status', # [1, 100] - 'require_listener', - 'server', # Gearman::Server that owns us - ); + 'func', + 'uniq', + 'argref', + + # arrayref of interested Clients + 'listeners', + 'worker', + 'handle', + + # [1, 100] + 'status', + 'require_listener', + + # Gearman::Server that owns us + 'server', +); sub new { my Gearman::Server::Job $self = shift; @@ -30,70 +46,101 @@ sub new { # if they specified a uniq, see if we have a dup job running already # to merge with if (length($uniq)) { + # a unique value of "-" means "use my args as my unique key" $uniq = $$argref if $uniq eq "-"; if (my $job = $server->job_of_unique($func, $uniq)) { + # found a match return $job; } + # create a new key $server->set_unique_job($func, $uniq => $self); - } + } ## end if (length($uniq)) - $self->{'server'} = $server; - $self->{'func'} = $func; - $self->{'uniq'} = $uniq; - $self->{'argref'} = $argref; + $self->{'server'} = $server; + $self->{'func'} = $func; + $self->{'uniq'} = $uniq; + $self->{'argref'} = $argref; $self->{'require_listener'} = 1; - $self->{'listeners'} = []; - $self->{'handle'} = $server->new_job_handle; + $self->{'listeners'} = []; + $self->{'handle'} = $server->new_job_handle; $server->enqueue_job($self, $highpri); return $self; -} +} ## end sub new + +=head2 add_listener($client) + +=cut sub add_listener { - my Gearman::Server::Job $self = shift; + my Gearman::Server::Job $self = shift; my Gearman::Server::Client $li = shift; - push @{$self->{listeners}}, $li; + push @{ $self->{listeners} }, $li; Scalar::Util::weaken($self->{listeners}->[-1]); -} +} ## end sub add_listener + +=head2 relay_to_listeners($msg) + +=cut sub relay_to_listeners { my Gearman::Server::Job $self = shift; - foreach my Gearman::Server::Client $c (@{$self->{listeners}}) { + foreach my Gearman::Server::Client $c (@{ $self->{listeners} }) { next if !$c || $c->{closed}; $c->write($_[0]); } -} +} ## end sub relay_to_listeners + +=head2 relay_to_option_listeners($msg, [$option]) + +=cut sub relay_to_option_listeners { my Gearman::Server::Job $self = shift; my $option = $_[1]; - foreach my Gearman::Server::Client $c (@{$self->{listeners}}) { + foreach my Gearman::Server::Client $c (@{ $self->{listeners} }) { next if !$c || $c->{closed}; next unless $c->option($option); $c->write($_[0]); } -} +} ## end sub relay_to_option_listeners + +=head2 clear_listeners() + +=cut sub clear_listeners { my Gearman::Server::Job $self = shift; $self->{listeners} = []; } +=head2 listeners() + +=cut + sub listeners { my Gearman::Server::Job $self = shift; - return @{$self->{listeners}}; + return @{ $self->{listeners} }; } +=head2 uniq() + +=cut + sub uniq { my Gearman::Server::Job $self = shift; return $self->{uniq}; } +=head2 note_finished($success) + +=cut + sub note_finished { my Gearman::Server::Job $self = shift; my $success = shift; @@ -103,7 +150,11 @@ sub note_finished { if ($Gearmand::graceful_shutdown) { Gearmand::shutdown_if_calm(); } -} +} ## end sub note_finished + +=head2 worker() + +=cut # accessors: sub worker { @@ -111,12 +162,21 @@ sub worker { return $self->{'worker'} unless @_; return $self->{'worker'} = shift; } + +=head2 require_listener([$require]) + +=cut + sub require_listener { my Gearman::Server::Job $self = shift; return $self->{'require_listener'} unless @_; return $self->{'require_listener'} = shift; } +=head2 status([numerator,denominator]) + +=cut + # takes arrayref of [numerator,denominator] sub status { my Gearman::Server::Job $self = shift; @@ -124,16 +184,28 @@ sub status { return $self->{'status'} = shift; } +=head2 handle() + +=cut + sub handle { my Gearman::Server::Job $self = shift; return $self->{'handle'}; } +=head2 func() + +=cut + sub func { my Gearman::Server::Job $self = shift; return $self->{'func'}; } +=head2 argref() + +=cut + sub argref { my Gearman::Server::Job $self = shift; return $self->{'argref'}; From 4ca34bc5920ad1e8867f1e425ac2c984380d78b5 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Sun, 7 Aug 2016 22:04:00 +0200 Subject: [PATCH 66/95] Gearman::Server::Listener pod --- lib/Gearman/Server/Listener.pm | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/lib/Gearman/Server/Listener.pm b/lib/Gearman/Server/Listener.pm index 2e5a053..ce15841 100644 --- a/lib/Gearman/Server/Listener.pm +++ b/lib/Gearman/Server/Listener.pm @@ -5,6 +5,12 @@ $Gearman::Server::Listener::VERSION = qv("v1.130.2"); use strict; use warnings; +=head1 NAME + +Gearman::Server::Listener - a listener for L + +=cut +# =head1 DESCRIPTION use base 'Danga::Socket'; use fields qw/ server @@ -19,6 +25,9 @@ use Socket qw/ SO_ERROR /; +=head1 METHODS + +=cut sub new { my Gearman::Server::Listener $self = shift; my $sock = shift; @@ -49,6 +58,9 @@ sub new { return $self; } ## end sub new +=head2 event_read() + +=cut sub event_read { my Gearman::Server::Listener $self = shift; From 079331a0cae5212851c490856707fb1dc88afc73 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Sun, 7 Aug 2016 22:45:11 +0200 Subject: [PATCH 67/95] default --- bin/gearmand | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/bin/gearmand b/bin/gearmand index 73879e1..826e5b1 100755 --- a/bin/gearmand +++ b/bin/gearmand @@ -25,7 +25,7 @@ for running under daemontools/supervise). =item --port=4730 / -p 4730 -Set the port number, defaults to 4730. +Set the port number, default to 4730. =item --listen hostname / -L hostname From 5054f70780d92179232affa6bf6e83ea215c9e8e Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Tue, 9 Aug 2016 10:23:31 +0200 Subject: [PATCH 68/95] Gearman::Server more pod --- lib/Gearman/Server.pm | 37 ++++++++++++++++++++++++++++++++++--- 1 file changed, 34 insertions(+), 3 deletions(-) diff --git a/lib/Gearman/Server.pm b/lib/Gearman/Server.pm index 3c8b019..e2a5908 100644 --- a/lib/Gearman/Server.pm +++ b/lib/Gearman/Server.pm @@ -68,15 +68,46 @@ use fields ( $server_object = Gearman::Server->new( %options ) -Creates and returns a new Gearman::Server object, which attaches itself to the Danga::Socket event loop. The server will begin operating when the Danga::Socket runloop is started. This means you need to start up the runloop before anything will happen. +Creates and returns a new Gearman::Server object, which attaches itself to the +L event loop. The server will begin operating when the +L runloop is started. This means you need to start up the +runloop before anything will happen. Options: =over -=item port +=item -Specify a port which you would like the Gearman::Server to listen on for TCP connections (not necessary, but useful) +port + +Specify a port which you would like the B to listen on for TCP connections (not necessary, but useful) + +=item + +wakeup + +Number of workers to wake up per job inserted into the queue. + +Zero (0) is a perfectly acceptable answer, and can be used if you don't care much about job latency. +This would bank on the base idea of a worker checking in with the server every so often. + +Negative One (-1) indicates that all sleeping workers should be woken up. + +All other negative numbers will cause the server to throw exception and not start. + +=item + +wakeup_delay + +Time interval before waking up more workers (the value specified by B) when jobs are still in +the queue. + +Zero (0) means go as fast as possible, but not all at the same time. Similar to -1 on B, but +is more cooperative in gearmand's multitasking model. + +Negative One (-1) means that this event won't happen, so only the initial workers will be woken up to +handle jobs in the queue. =back From 3a521eaf129057c2d1ef4f984bf6eb656b6d6415 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Tue, 9 Aug 2016 10:34:00 +0200 Subject: [PATCH 69/95] rename variables --- bin/gearmand | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/bin/gearmand b/bin/gearmand index 826e5b1..ca53782 100755 --- a/bin/gearmand +++ b/bin/gearmand @@ -123,12 +123,12 @@ use Scalar::Util (); use vars qw($DEBUG); $DEBUG = 0; -my $conf_port = 4730; +my $port = 4730; GetOptions( 'd|daemonize' => \my $daemonize, - 'p|port=i' => \$conf_port, - 'listen|L=s' => \my $conf_host, + 'p|port=i' => \$port, + 'listen|L=s' => \my $listen, 'debug=i' => \$DEBUG, 'pidfile=s' => \my $opt_pidfile, 'accept=i' => \my $accept, @@ -160,9 +160,9 @@ my $server = Gearman::Server->new( wakeup_delay => $wakeup_delay, ); my $ssock = $server->create_listening_sock( - $conf_port, + $port, accept_per_loop => $accept, - local_addr => $conf_host + local_addr => $listen ); if ($opt_pidfile) { From cbd83b71a35ce1a6b9b6a769ca860c3fb4222803 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Tue, 9 Aug 2016 10:50:32 +0200 Subject: [PATCH 70/95] pod agian --- lib/Gearman/Server.pm | 36 ++++++++++++++++++++++++++++-------- 1 file changed, 28 insertions(+), 8 deletions(-) diff --git a/lib/Gearman/Server.pm b/lib/Gearman/Server.pm index e2a5908..9a2ff44 100644 --- a/lib/Gearman/Server.pm +++ b/lib/Gearman/Server.pm @@ -239,11 +239,12 @@ sub clients { =head2 to_inprocess_server() +Returns a socket that is connected to the server, we can then use this +socket with a Gearman::Client::Async object to run clients and servers in the +same thread. + =cut -# Returns a socket that is connected to the server, we can then use this -# socket with a Gearman::Client::Async object to run clients and servers in the -# same thread. sub to_inprocess_server { my $self = shift; @@ -304,8 +305,11 @@ sub start_worker { or die "Unable to dup socketpair to STDOUT: $!"; if (UNIVERSAL::isa($prog, "CODE")) { $prog->(); - exit 0; # shouldn't get here. subref should exec. - } + + # shouldn't get here. subref should exec. + exit 0; + } ## end if (UNIVERSAL::isa($prog...)) + exec $prog; die "Exec failed: $!"; } ## end unless ($pid) @@ -332,8 +336,9 @@ sub enqueue_job { my $jq = ($self->{job_queue}{ $job->{func} } ||= []); if (defined(my $max_queue_size = $self->{max_queue}{ $job->{func} })) { - $max_queue_size - --; # Subtract one, because we're about to add one more below. + + # Subtract one, because we're about to add one more below. + $max_queue_size--; while (@$jq > $max_queue_size) { my $delete_job = pop @$jq; my $msg = Gearman::Util::pack_res_command("work_fail", @@ -502,9 +507,24 @@ sub note_job_finished { =head2 set_max_queue($func, $max) +=over + +=item + +$func + +function name + +=item + +$max + +0/undef/"" to reset. else integer max depth. + +=back + =cut -# <0/undef/"" to reset. else integer max depth. sub set_max_queue { my ($self, $func, $max) = @_; if (defined $max && length $max && $max >= 0) { From 7264ee5741f6e59a9566ed00861185628e0cb035 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Tue, 9 Aug 2016 11:45:04 +0200 Subject: [PATCH 71/95] client pod --- lib/Gearman/Server/Client.pm | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/lib/Gearman/Server/Client.pm b/lib/Gearman/Server/Client.pm index 24314c7..08308fe 100644 --- a/lib/Gearman/Server/Client.pm +++ b/lib/Gearman/Server/Client.pm @@ -7,7 +7,7 @@ use warnings; =head1 NAME -Gearman::Server::Client - client for gearmand +Gearman::Server::Client - client for L based on L =head1 DESCRIPTION @@ -155,9 +155,10 @@ sub close { =head2 event_read() +read from socket + =cut -# Client sub event_read { my Gearman::Server::Client $self = shift; @@ -242,9 +243,10 @@ sub event_write { =head2 process_line($line) +Line based command processor + =cut -# Line based command processor sub process_line { my Gearman::Server::Client $self = shift; my $line = shift; From c0fa567b6859671dd494f3a07ce558e8e5688ebf Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Tue, 9 Aug 2016 21:29:06 +0200 Subject: [PATCH 72/95] server pod --- lib/Gearman/Server.pm | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/lib/Gearman/Server.pm b/lib/Gearman/Server.pm index 9a2ff44..d87a7ea 100644 --- a/lib/Gearman/Server.pm +++ b/lib/Gearman/Server.pm @@ -161,7 +161,7 @@ sub new { sub debug { my ($self, $msg) = @_; - #warn "$msg\n"; + warn "$msg\n"; } =head2 create_listening_sock($portnum, %options) @@ -210,6 +210,8 @@ sub create_listening_sock { =head2 new_client($sock) +init new L object and add it to internal clients map + =cut sub new_client { @@ -221,6 +223,10 @@ sub new_client { =head2 note_disconnected_client($client) +delete the client from internal clients map + +B deleted object + =cut sub note_disconnected_client { @@ -230,6 +236,8 @@ sub note_disconnected_client { =head2 clients() +B internal clients map + =cut sub clients { From 294a81e1aae65c65faa32e4c60abc01424b1906d Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Tue, 9 Aug 2016 21:38:59 +0200 Subject: [PATCH 73/95] listener pod --- lib/Gearman/Server/Listener.pm | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/lib/Gearman/Server/Listener.pm b/lib/Gearman/Server/Listener.pm index ce15841..0d73fac 100644 --- a/lib/Gearman/Server/Listener.pm +++ b/lib/Gearman/Server/Listener.pm @@ -9,8 +9,12 @@ use warnings; Gearman::Server::Listener - a listener for L +=head1 DESCRIPTION + +Based on L + =cut -# =head1 DESCRIPTION + use base 'Danga::Socket'; use fields qw/ server @@ -60,6 +64,8 @@ sub new { =head2 event_read() +wait for connection + =cut sub event_read { my Gearman::Server::Listener $self = shift; From 8fa34a446683822abdde07f34194c72634e19723 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Tue, 9 Aug 2016 22:01:49 +0200 Subject: [PATCH 74/95] bug fixing: set max queue - delete if 0 --- lib/Gearman/Server.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/Gearman/Server.pm b/lib/Gearman/Server.pm index d87a7ea..9b85f05 100644 --- a/lib/Gearman/Server.pm +++ b/lib/Gearman/Server.pm @@ -535,7 +535,7 @@ $max sub set_max_queue { my ($self, $func, $max) = @_; - if (defined $max && length $max && $max >= 0) { + if (defined($max) && length($max) && $max > 0) { $self->{max_queue}{$func} = int($max); } else { From d4db359d7960df7e5ffaa8f8ef90c51882aea5f7 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Tue, 9 Aug 2016 22:06:12 +0200 Subject: [PATCH 75/95] build requirements --- Makefile.PL | 21 ++++++++++++--------- 1 file changed, 12 insertions(+), 9 deletions(-) diff --git a/Makefile.PL b/Makefile.PL index a299317..295081e 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -8,17 +8,20 @@ WriteMakefile( ABSTRACT_FROM => 'lib/Gearman/Server.pm', EXE_FILES => ['bin/gearmand'], BUILD_REQUIRES => { - "Test::Exception" => 0, - "Test::More" => 0, - "Test::Script" => 1.12, - "Sys::Hostname" => 0, - "version" => 0, + "IO::Socket::INET" => 0, + "Socket" => 0, + "Sys::Hostname" => 0, + "Test::Exception" => 0, + "Test::More" => 0, + "Test::Script" => 1.12, + "version" => 0, }, PREREQ_PM => { - "Gearman::Util" => 0, - "Danga::Socket" => 1.52, - "Sys::Hostname" => 0, - "version" => 0, + "Danga::Socket" => 1.52, + "Gearman::Util" => 0, + "IO::Socket::INET" => 0, + "Sys::Hostname" => 0, + "version" => 0, }, AUTHOR => 'Brad Fitzpatrick (brad@danga.com), Brad Whitaker (whitaker@danga.com)', From 357eeeb8c0b28a43ecbef3f60f63f28f2b00c5be Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Tue, 9 Aug 2016 22:11:33 +0200 Subject: [PATCH 76/95] server subtests: maxqueue and clients --- t/01-gearman-server.t | 78 ++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 73 insertions(+), 5 deletions(-) diff --git a/t/01-gearman-server.t b/t/01-gearman-server.t index fe5d796..a0dcb85 100644 --- a/t/01-gearman-server.t +++ b/t/01-gearman-server.t @@ -1,10 +1,20 @@ use strict; use warnings; +use IO::Socket::INET; use Test::More; use Test::Exception; use Sys::Hostname (); +use Socket qw/ + IPPROTO_TCP + SOL_SOCKET + SOCK_STREAM + AF_UNIX + SOCK_STREAM + PF_UNSPEC + /; + my $mn = qw/ Gearman::Server /; @@ -72,13 +82,13 @@ subtest "new", sub { "Invalid value passed in $_ option"; } - throws_ok { $mn->new(foo => 1) } qr/Unknown options/, - "Unknown options"; + throws_ok { $mn->new(foo => 1) } qr/Unknown options/, "Unknown options"; }; -subtest "create_listening_sock", sub { - my $gs = new_ok($mn); - my $port = 12345; +subtest "create listening sock/new client", sub { + my $port = _free_port(); + $port || plan skip_all => "couldn't find free port"; + my $gs = new_ok($mn); my ($accept, $la); ok( my $sock = $gs->create_listening_sock( @@ -90,4 +100,62 @@ subtest "create_listening_sock", sub { isa_ok($sock, "IO::Socket::INET"); }; +subtest "client", sub { + my ($port, $la) = (_free_port()); + $port || plan skip_all => "couldn't find free port"; + + my $sock = new_ok( + "IO::Socket::INET", + [ + LocalPort => $port, + Type => SOCK_STREAM, + Proto => IPPROTO_TCP, + Blocking => 0, + Reuse => 1, + Listen => 1024, + ] + ); + + my $gs = new_ok($mn); + ok(my $nc = $gs->new_client($sock), "new_client"); + isa_ok($nc, "Gearman::Server::Client"); + ok(my @cl = $gs->clients, "clients"); + is(@cl, 1, "clients count"); + is($cl[0], $nc, "same client"); + ok($gs->note_disconnected_client($nc), "note_disocnnected_client"); +}; + +subtest "maxqueue", sub { + my $gs = new_ok($mn); + my ($f, $c) = ("foo", int(rand(5) + 1)); + ok($gs->set_max_queue($f, $c), "set_max_queue($f, $c)"); + is($gs->{max_queue}{$f}, $c, "max_queue $f = $c"); + $c = 0; + ok($gs->set_max_queue($f, $c), "set_max_queue($f, $c)"); + is($gs->{max_queue}{$f}, undef, "max_queue $f = $c"); +}; + done_testing; + +sub _free_port { + my ($la, $port) = shift; + my ($type, $retry, $sock) = ("tcp", 5); + $la ||= "127.0.0.1"; + do { + unless ($port) { + $port = int(rand(10_000)) + int(rand(30_000)); + } + + IO::Socket::INET->new( + LocalAddr => $la, + LocalPort => $port, + Proto => $type, + ReuseAddr => 1 + ) or undef($port); + + } until ($port || --$retry == 0); + + return; + return $port; +} ## end sub _free_port + From d29aa8e96364dd38d5f28b2505c907f4530c8029 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Wed, 10 Aug 2016 12:28:39 +0200 Subject: [PATCH 77/95] Test::Gearman::Server --- t/lib/Test/Gearman/Server.pm | 36 ++++++++++++++++++++++++++++++++++++ 1 file changed, 36 insertions(+) create mode 100644 t/lib/Test/Gearman/Server.pm diff --git a/t/lib/Test/Gearman/Server.pm b/t/lib/Test/Gearman/Server.pm new file mode 100644 index 0000000..eb14078 --- /dev/null +++ b/t/lib/Test/Gearman/Server.pm @@ -0,0 +1,36 @@ +package Test::Gearman::Server; + +@ISA = qw/ + Exporter + /; +@EXPORT_OK = qw/ + free_local_port + /; + +use strict; +use warnings; +use IO::Socket::INET; + +sub free_local_port { + my ($la, $port) = shift; + my ($type, $retry, $sock) = ("tcp", 5); + $la ||= "127.0.0.1"; + do { + unless ($port) { + $port = int(rand(10_000)) + int(rand(30_000)); + } + + IO::Socket::INET->new( + LocalAddr => $la, + LocalPort => $port, + Proto => $type, + ReuseAddr => 1 + ) or undef($port); + + } until ($port || --$retry == 0); + + return $port; +} ## end sub free_local_port + +1; + From 1a33fea55a17bb042beaf4c5e2503b8bd207bd86 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Wed, 10 Aug 2016 12:29:17 +0200 Subject: [PATCH 78/95] free_port sub moved into Test::Gearman::Server --- t/01-gearman-server.t | 38 ++++++++++---------------------------- 1 file changed, 10 insertions(+), 28 deletions(-) diff --git a/t/01-gearman-server.t b/t/01-gearman-server.t index a0dcb85..73102bf 100644 --- a/t/01-gearman-server.t +++ b/t/01-gearman-server.t @@ -1,11 +1,9 @@ use strict; use warnings; +use File::Spec; +use FindBin qw/ $Bin /; use IO::Socket::INET; -use Test::More; -use Test::Exception; -use Sys::Hostname (); - use Socket qw/ IPPROTO_TCP SOL_SOCKET @@ -14,6 +12,12 @@ use Socket qw/ SOCK_STREAM PF_UNSPEC /; +use Sys::Hostname (); +use Test::Exception; +use Test::More; + +use lib File::Spec->catdir($Bin, "lib"); +use Test::Gearman::Server qw/free_local_port/; my $mn = qw/ Gearman::Server @@ -86,7 +90,7 @@ subtest "new", sub { }; subtest "create listening sock/new client", sub { - my $port = _free_port(); + my $port = free_local_port(); $port || plan skip_all => "couldn't find free port"; my $gs = new_ok($mn); my ($accept, $la); @@ -101,7 +105,7 @@ subtest "create listening sock/new client", sub { }; subtest "client", sub { - my ($port, $la) = (_free_port()); + my ($port, $la) = (free_local_port()); $port || plan skip_all => "couldn't find free port"; my $sock = new_ok( @@ -137,25 +141,3 @@ subtest "maxqueue", sub { done_testing; -sub _free_port { - my ($la, $port) = shift; - my ($type, $retry, $sock) = ("tcp", 5); - $la ||= "127.0.0.1"; - do { - unless ($port) { - $port = int(rand(10_000)) + int(rand(30_000)); - } - - IO::Socket::INET->new( - LocalAddr => $la, - LocalPort => $port, - Proto => $type, - ReuseAddr => 1 - ) or undef($port); - - } until ($port || --$retry == 0); - - return; - return $port; -} ## end sub _free_port - From 07286e893767c61afcddce5aa2346bc7670b4529 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Wed, 10 Aug 2016 12:31:58 +0200 Subject: [PATCH 79/95] no need for SOL_SOCKET, AF_UNIX .. --- t/01-gearman-server.t | 4 ---- 1 file changed, 4 deletions(-) diff --git a/t/01-gearman-server.t b/t/01-gearman-server.t index 73102bf..cbe934b 100644 --- a/t/01-gearman-server.t +++ b/t/01-gearman-server.t @@ -6,11 +6,7 @@ use FindBin qw/ $Bin /; use IO::Socket::INET; use Socket qw/ IPPROTO_TCP - SOL_SOCKET SOCK_STREAM - AF_UNIX - SOCK_STREAM - PF_UNSPEC /; use Sys::Hostname (); use Test::Exception; From 8d33f4ef6ae83775ebf9381377e3cb679950e88e Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Wed, 10 Aug 2016 12:45:54 +0200 Subject: [PATCH 80/95] client new subtest --- t/02-gearman-server-client.t | 46 +++++++++++++++++++++++++++++++++++- 1 file changed, 45 insertions(+), 1 deletion(-) diff --git a/t/02-gearman-server-client.t b/t/02-gearman-server-client.t index 3e5484a..f25e4bc 100644 --- a/t/02-gearman-server-client.t +++ b/t/02-gearman-server-client.t @@ -1,8 +1,17 @@ use strict; use warnings; +use File::Spec; +use FindBin qw/ $Bin /; +use lib File::Spec->catdir($Bin, "lib"); + use IO::Socket::INET; +use Socket qw/ + IPPROTO_TCP + SOCK_STREAM + /; use Test::More; +use Test::Gearman::Server qw/free_local_port/; my $mn = "Gearman::Server::Client"; @@ -11,7 +20,42 @@ use_ok($mn); isa_ok($mn, "Danga::Socket"); -# new_ok($mn, [IO::Socket::INET->new(), new_ok("Gearman::Server")]); +subtest "new", sub { + my ($port, $la) = (free_local_port()); + $port || plan skip_all => "couldn't find free port"; + + my $sock = new_ok( + "IO::Socket::INET", + [ + LocalPort => $port, + Type => SOCK_STREAM, + Proto => IPPROTO_TCP, + Blocking => 0, + Reuse => 1, + Listen => 1024, + ] + ); + my $gs = new_ok("Gearman::Server"); + my $gc = new_ok($mn, [$sock, $gs]); + + foreach (qw/fast_buffer can_do_list/) { + isa_ok($gc->{$_}, "ARRAY", $_) && is(@{ $gc->{$_} }, 0, "$_ empty"); + } + + foreach (qw/can_do doing options/) { + isa_ok($gc->{$_}, "HASH", $_) + && is(keys(%{ $gc->{$_} }), 0, "$_ empty"); + } + + foreach (qw/sleeping can_do_iter jobs_done_since_sleep/) { + is($gc->{$_}, 0, "$_ = 0"); + } + + is($gc->{fast_read}, undef, "fast_read"); + is($gc->{read_buf}, '', "read_buf"); + is($gc->{client_id}, '-', "client_id"); + is($gc->{server}, $gs, "server"); +}; done_testing; From 0a91935c34fd5ef9b31defe0df2646a233ad1769 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Wed, 10 Aug 2016 19:52:21 +0200 Subject: [PATCH 81/95] client can tests --- t/02-gearman-server-client.t | 51 ++++++++++++++++++++++++++++++++---- 1 file changed, 46 insertions(+), 5 deletions(-) diff --git a/t/02-gearman-server-client.t b/t/02-gearman-server-client.t index f25e4bc..58f4cad 100644 --- a/t/02-gearman-server-client.t +++ b/t/02-gearman-server-client.t @@ -14,14 +14,56 @@ use Test::More; use Test::Gearman::Server qw/free_local_port/; my $mn = "Gearman::Server::Client"; - use_ok("Gearman::Server"); use_ok($mn); - isa_ok($mn, "Danga::Socket"); +can_ok( + $mn, qw/ + CMD_can_do + CMD_can_do_timeout + CMD_cant_do + CMD_echo_req + CMD_get_status + CMD_grab_job + CMD_option_req + CMD_pre_sleep + CMD_reset_abilities + CMD_set_client_id + CMD_submit_job + CMD_submit_job_bg + CMD_submit_job_high + CMD_work_complete + CMD_work_exception + CMD_work_fail + CMD_work_status + TXTCMD_clients + TXTCMD_gladiator + TXTCMD_jobs + TXTCMD_maxqueue + TXTCMD_shutdown + TXTCMD_status + TXTCMD_version + TXTCMD_workers + _cmd_submit_job + _setup_can_do_list + close + error_packet + eurl + event_err + event_hup + event_read + event_write + option + process_line + process_cmd + res_packet + / +); +my ($gs, $gc) = (new_ok("Gearman::Server")); + subtest "new", sub { - my ($port, $la) = (free_local_port()); + my $port = free_local_port(); $port || plan skip_all => "couldn't find free port"; my $sock = new_ok( @@ -35,8 +77,7 @@ subtest "new", sub { Listen => 1024, ] ); - my $gs = new_ok("Gearman::Server"); - my $gc = new_ok($mn, [$sock, $gs]); + $gc = new_ok($mn, [$sock, $gs]); foreach (qw/fast_buffer can_do_list/) { isa_ok($gc->{$_}, "ARRAY", $_) && is(@{ $gc->{$_} }, 0, "$_ empty"); From 0132b7a981ec049788cdb907384176ef53b94c10 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Thu, 11 Aug 2016 13:26:46 +0200 Subject: [PATCH 82/95] catch open/close errors --- bin/gearmand | 27 +++++++++++++-------------- 1 file changed, 13 insertions(+), 14 deletions(-) diff --git a/bin/gearmand b/bin/gearmand index ca53782..f720ba3 100755 --- a/bin/gearmand +++ b/bin/gearmand @@ -37,7 +37,7 @@ Default is Write a pidfile when starting up -=item --debug=1 +=item --debug Enable debugging (currently the only debug output is when a client or worker connects). @@ -126,14 +126,14 @@ $DEBUG = 0; my $port = 4730; GetOptions( + 'accept=i' => \my $accept, + 'debug' => \$DEBUG, 'd|daemonize' => \my $daemonize, - 'p|port=i' => \$port, 'listen|L=s' => \my $listen, - 'debug=i' => \$DEBUG, 'pidfile=s' => \my $opt_pidfile, - 'accept=i' => \my $accept, - 'wakeup=i' => \my $wakeup, + 'p|port=i' => \$port, 'wakeup-delay=f' => \my $wakeup_delay, + 'wakeup=i' => \my $wakeup, 'version|V' => sub { print "Gearman::Server $Gearman::Server::VERSION$/"; exit; @@ -186,8 +186,7 @@ sub shutdown_if_calm { } sub daemonize { - my ($pid, $sess_id, $i); - + my ($pid, $sess_id); ## Fork and exit parent if ($pid = fork) { exit 0; } @@ -200,20 +199,20 @@ sub daemonize { if ($pid = fork) { exit 0; } ## Change working directory - chdir "/"; + chdir("/") || croak "can't chdir to /: $!"; ## Clear file creation mask umask 0; ## Close open file descriptors - close(STDIN); - close(STDOUT); - close(STDERR); + close(STDIN) || croak "can't close STDIN: $!"; + close(STDOUT) || croak "can't close STDOUT: $!"; + close(STDERR) || croak "can't close STDERR: $!"; ## Reopen stderr, stdout, stdin to /dev/null - open(STDIN, "+>/dev/null"); - open(STDOUT, "+>&STDIN"); - open(STDERR, "+>&STDIN"); + open(STDIN, "+>/dev/null") || croak "can't write to /dev/null: $!"; + open(STDOUT, "+>&STDIN") || croak "can't dup STDOUT to STDIN: $!"; + open(STDERR, "+>&STDIN") || croak "can't dup STDERR to STDIN: $!"; } ## end sub daemonize kill 'USR1', $notify_pid if $notify_pid; From d6f9b259764a4e82bceb76beef7800751dcaef81 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Wed, 17 Aug 2016 22:53:37 +0200 Subject: [PATCH 83/95] new maxqueue test script [ci skip] --- t/03-maxqueue.t | 61 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 61 insertions(+) create mode 100644 t/03-maxqueue.t diff --git a/t/03-maxqueue.t b/t/03-maxqueue.t new file mode 100644 index 0000000..5f60cb5 --- /dev/null +++ b/t/03-maxqueue.t @@ -0,0 +1,61 @@ +use strict; +use warnings; + +use File::Spec; +use FindBin (); +use Gearman::Client; +use Gearman::Worker; +use IO::Socket::INET; +use Net::EmptyPort (); +use Proc::Guard; +use Test::More; +use Test::TCP; + +my $host = "127.0.0.1"; +Net::EmptyPort::can_bind($host) || plan skip_all => "can not bind to $host"; + +my $dir = File::Spec->catdir($FindBin::Bin, File::Spec->updir()); +my $bin = File::Spec->catdir($dir, "bin", "gearmand"); +-e $bin || plan skip_all => "no gearmand"; + +my $gs = Test::TCP->new( + listen => 1, + host => $host, + code => sub { + my ($port) = @_; + exec $^X, join('', "-I", File::Spec->catdir($dir, "lib")), $bin, + join('=', "--port", $port); + } +); + +my ($func, $count) = ("doit", int(rand(3) + 1)); +my $peer_addr = join(':', $host, $gs->port); + +subtest "set maxqueue", sub { + my $sock + = new_ok("IO::Socket::INET", [PeerAddr => $peer_addr, Timeout => 2]); + my $k = "MAXQUEUE"; + my $cmd = join(' ', $k, $func, $count); + ok($sock->write($cmd . $/), "write($cmd)"); + sleep(2); + ok(my $r = $sock->getline(), "getline"); + ok($r =~ m/^OK\b/i, "match OK"); +}; + +subtest "start worker", sub { + my $gw = new_ok("Gearman::Worker", [job_servers => [$peer_addr]]); + $gw->register_function($func); + + Proc::Guard->new( + code => sub { + $gw->work() while 1; + } + ); +}; + +subtest "client", sub { + my $gc + = new_ok("Gearman::Client", [job_servers => [$peer_addr]]); + ok($gc->do_task($func)); +}; +done_testing(); From 14d88c79bc7c2a82262f19d837a8578ec2d3e1c7 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Wed, 17 Aug 2016 23:03:43 +0200 Subject: [PATCH 84/95] add build requirements --- Makefile.PL | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/Makefile.PL b/Makefile.PL index 295081e..0cd7ef8 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -8,12 +8,17 @@ WriteMakefile( ABSTRACT_FROM => 'lib/Gearman/Server.pm', EXE_FILES => ['bin/gearmand'], BUILD_REQUIRES => { + "File::Spec" => 0, + "FindBin" => 0, "IO::Socket::INET" => 0, + "Net::EmptyPort" => 0, + "Proc::Guard" => 0, "Socket" => 0, "Sys::Hostname" => 0, "Test::Exception" => 0, "Test::More" => 0, "Test::Script" => 1.12, + "Test::TCP" => 0, "version" => 0, }, PREREQ_PM => { From 5d28a20744655c600362b25edf463c2d57f39e25 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Tue, 7 Feb 2017 21:42:02 +0100 Subject: [PATCH 85/95] no more support for "shutdown" and "shutdown graceful" commands --- bin/gearmand | 18 ------------------ lib/Gearman/Server/Client.pm | 23 ----------------------- lib/Gearman/Server/Job.pm | 4 ---- t/02-gearman-server-client.t | 1 - 4 files changed, 46 deletions(-) diff --git a/bin/gearmand b/bin/gearmand index f720ba3..4c5192b 100755 --- a/bin/gearmand +++ b/bin/gearmand @@ -149,10 +149,6 @@ GetOptions( daemonize() if $daemonize; -# true if we've closed listening socket, and we're waiting for a -# convenient place to kill the process -our $graceful_shutdown = 0; - # handled manually $SIG{'PIPE'} = "IGNORE"; my $server = Gearman::Server->new( @@ -171,20 +167,6 @@ if ($opt_pidfile) { close $fh; } -sub shutdown_graceful { - return if $graceful_shutdown; - - my $ofds = Danga::Socket->OtherFds; - delete $ofds->{ fileno($ssock) }; - $ssock->close; - $graceful_shutdown = 1; - shutdown_if_calm(); -} ## end sub shutdown_graceful - -sub shutdown_if_calm { - exit 0 unless $server->jobs_outstanding; -} - sub daemonize { my ($pid, $sess_id); ## Fork and exit parent diff --git a/lib/Gearman/Server/Client.pm b/lib/Gearman/Server/Client.pm index 08308fe..416aa18 100644 --- a/lib/Gearman/Server/Client.pm +++ b/lib/Gearman/Server/Client.pm @@ -831,29 +831,6 @@ sub TXTCMD_maxqueue { $self->write("OK\n"); } ## end sub TXTCMD_maxqueue -=head2 "shutdown" ["graceful"] - -Close the server. Or "shutdown graceful" to close the listening socket, then -close the server when traffic has died away. - -=cut - -sub TXTCMD_shutdown { - my Gearman::Server::Client $self = shift; - my $args = shift; - if ($args eq "graceful") { - $self->write("OK\n"); - Gearmand::shutdown_graceful(); - } - elsif (!$args) { - $self->write("OK\n"); - exit 0; - } - else { - $self->err_line('unknown_args'); - } -} ## end sub TXTCMD_shutdown - =head2 "version" Returns server version. diff --git a/lib/Gearman/Server/Job.pm b/lib/Gearman/Server/Job.pm index 39917f0..23bf19c 100644 --- a/lib/Gearman/Server/Job.pm +++ b/lib/Gearman/Server/Job.pm @@ -146,10 +146,6 @@ sub note_finished { my $success = shift; $self->{server}->note_job_finished($self); - - if ($Gearmand::graceful_shutdown) { - Gearmand::shutdown_if_calm(); - } } ## end sub note_finished =head2 worker() diff --git a/t/02-gearman-server-client.t b/t/02-gearman-server-client.t index 58f4cad..2ac8709 100644 --- a/t/02-gearman-server-client.t +++ b/t/02-gearman-server-client.t @@ -41,7 +41,6 @@ can_ok( TXTCMD_gladiator TXTCMD_jobs TXTCMD_maxqueue - TXTCMD_shutdown TXTCMD_status TXTCMD_version TXTCMD_workers From 9692f1ab7f0bc108b86d65b3ed45a832d83ff764 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Tue, 7 Feb 2017 21:57:21 +0100 Subject: [PATCH 86/95] bug fixing Gearman::Server::Client::err_line unknown_command --- lib/Gearman/Server/Client.pm | 20 +++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) diff --git a/lib/Gearman/Server/Client.pm b/lib/Gearman/Server/Client.pm index 416aa18..079cb6b 100644 --- a/lib/Gearman/Server/Client.pm +++ b/lib/Gearman/Server/Client.pm @@ -845,20 +845,26 @@ sub TXTCMD_version { sub err_line { my Gearman::Server::Client $self = shift; my $err_code = shift; - my $err_text = { - 'unknown_command# numeric iterator for where we start looking for jobl' - => "Unknown server command", - 'unknown_args' => "Unknown arguments to server command", - 'incomplete_args' => + my %err_text = ( + + # numeric iterator for where we start looking for jobl + unknown_command => "Unknown server command", + unknown_args => "Unknown arguments to server command", + incomplete_args => "An incomplete set of arguments was sent to this command", - }->{$err_code}; + ); - $self->write("ERR $err_code " . eurl($err_text) . "\r\n"); + $self->write( + join '', + "ERR $err_code ", + eurl($err_text{$err_code}) || '', "\r\n" + ); return 0; } ## end sub err_line sub eurl { my $a = $_[0]; + $a || return; $a =~ s/([^a-zA-Z0-9_\,\-.\/\\\: ])/uc sprintf("%%%02x",ord($1))/eg; $a =~ tr/ /+/; return $a; From 3a4d602f852607ceefaffd3f62f827a62a41239f Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Tue, 7 Feb 2017 21:58:46 +0100 Subject: [PATCH 87/95] do not run travis ci on upstream --- .travis.yml | 1 - 1 file changed, 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index 74a094f..47667cc 100644 --- a/.travis.yml +++ b/.travis.yml @@ -34,4 +34,3 @@ after_success: branches: only: - master - - upstream From 90db6a6c95a6ba117922d1262422c9d5c00d4c38 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Tue, 14 Mar 2017 21:34:42 +0100 Subject: [PATCH 88/95] maxque test without client/worker --- t/03-maxqueue.t | 24 +++--------------------- 1 file changed, 3 insertions(+), 21 deletions(-) diff --git a/t/03-maxqueue.t b/t/03-maxqueue.t index 5f60cb5..ee1e286 100644 --- a/t/03-maxqueue.t +++ b/t/03-maxqueue.t @@ -7,7 +7,6 @@ use Gearman::Client; use Gearman::Worker; use IO::Socket::INET; use Net::EmptyPort (); -use Proc::Guard; use Test::More; use Test::TCP; @@ -19,10 +18,10 @@ my $bin = File::Spec->catdir($dir, "bin", "gearmand"); -e $bin || plan skip_all => "no gearmand"; my $gs = Test::TCP->new( - listen => 1, - host => $host, - code => sub { + host => $host, + code => sub { my ($port) = @_; + warn "port is: $port"; exec $^X, join('', "-I", File::Spec->catdir($dir, "lib")), $bin, join('=', "--port", $port); } @@ -37,25 +36,8 @@ subtest "set maxqueue", sub { my $k = "MAXQUEUE"; my $cmd = join(' ', $k, $func, $count); ok($sock->write($cmd . $/), "write($cmd)"); - sleep(2); ok(my $r = $sock->getline(), "getline"); ok($r =~ m/^OK\b/i, "match OK"); }; -subtest "start worker", sub { - my $gw = new_ok("Gearman::Worker", [job_servers => [$peer_addr]]); - $gw->register_function($func); - - Proc::Guard->new( - code => sub { - $gw->work() while 1; - } - ); -}; - -subtest "client", sub { - my $gc - = new_ok("Gearman::Client", [job_servers => [$peer_addr]]); - ok($gc->do_task($func)); -}; done_testing(); From c409a04504c6ce55143947a81ff9bd562d5b8f2b Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Tue, 14 Mar 2017 21:35:53 +0100 Subject: [PATCH 89/95] rm Gearman::Client specifix test script --- t/30-maxqueue.t | 77 ------------------------------------------------- 1 file changed, 77 deletions(-) delete mode 100644 t/30-maxqueue.t diff --git a/t/30-maxqueue.t b/t/30-maxqueue.t deleted file mode 100644 index 50836c1..0000000 --- a/t/30-maxqueue.t +++ /dev/null @@ -1,77 +0,0 @@ -use strict; -use warnings; - -use FindBin qw/ $Bin /; -use Gearman::Client; -use Storable qw( freeze ); -use Test::More; - -use lib "$Bin/lib"; -use Test::Gearman; - -# NOK tested with gearman v1.0.6 -# OK Gearman::Server -# - ubuntu 14.04 - -# plan skip_all => "MAXQUEUE test is in TODO"; - -# This is testing the MAXQUEUE feature of gearmand. There's no direct -# support for it in Gearman::Worker yet, so we connect directly to -# gearmand to configure it for the test. - -my $tg = Test::Gearman->new( - ip => "127.0.0.1", - daemon => $ENV{GEARMAND_PATH} || undef -); - -$tg->start_servers() || plan skip_all => "Can't find server to test with"; - -foreach (@{ $tg->job_servers }) { - unless ($tg->check_server_connection($_)) { - plan skip_all => "connection check $_ failed"; - last; - } -} ## end foreach (@{ $tg->job_servers...}) - -plan tests => 9; - -ok( - my $sock = IO::Socket::INET->new( - PeerAddr => @{ $tg->job_servers }[0], - ), - "connect to jobserver" -); - -my $cn = "long"; -ok($sock->write("MAXQUEUE $cn 1\n"), "write MAXQUEUE ..."); -ok(my $input = $sock->getline(), "getline"); -ok($input =~ m/^OK\b/i, "match OK"); - -ok(my $pid = $tg->start_worker(), "start worker"); - -my $client = new_ok("Gearman::Client", [job_servers => $tg->job_servers]); - -my $tasks = $client->new_task_set; -isa_ok($tasks, 'Gearman::Taskset'); - -my $failed = 0; -my $completed = 0; - -foreach my $iter (1 .. 5) { - my $handle = $tasks->add_task( - $cn, $iter, - { - on_complete => sub { $completed++ }, - on_fail => sub { $failed++ } - } - ); -} ## end foreach my $iter (1 .. 5) - -$tasks->wait; - -# One in the queue, plus one that may start immediately -ok($completed == 2 || $completed == 1, 'number of success'); - -# All the rest -ok($failed == 3 || $failed == 4, 'number of failure'); - From 78d5a8f886f2d759484c1262c08b8222bbd6680a Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Tue, 14 Mar 2017 21:38:03 +0100 Subject: [PATCH 90/95] v1.140_001 --- lib/Gearman/Server.pm | 4 ++-- lib/Gearman/Server/Client.pm | 4 ++-- lib/Gearman/Server/Job.pm | 4 ++-- lib/Gearman/Server/Listener.pm | 4 ++-- t/00-use.t | 4 ++-- t/03-maxqueue.t | 1 - 6 files changed, 10 insertions(+), 11 deletions(-) diff --git a/lib/Gearman/Server.pm b/lib/Gearman/Server.pm index 9b85f05..d938768 100644 --- a/lib/Gearman/Server.pm +++ b/lib/Gearman/Server.pm @@ -1,6 +1,6 @@ package Gearman::Server; -use version; -$Gearman::Server::VERSION = qv("v1.130.2"); +use version (); +$Gearman::Server::VERSION = version->declare("1.140_001"); use strict; use warnings; diff --git a/lib/Gearman/Server/Client.pm b/lib/Gearman/Server/Client.pm index 079cb6b..61e360b 100644 --- a/lib/Gearman/Server/Client.pm +++ b/lib/Gearman/Server/Client.pm @@ -1,6 +1,6 @@ package Gearman::Server::Client; -use version; -$Gearman::Server::Client::VERSION = qv("v1.130.2"); +use version (); +$Gearman::Server::Client::VERSION = version->declare("1.140_001"); use strict; use warnings; diff --git a/lib/Gearman/Server/Job.pm b/lib/Gearman/Server/Job.pm index 23bf19c..eb2f59e 100644 --- a/lib/Gearman/Server/Job.pm +++ b/lib/Gearman/Server/Job.pm @@ -1,6 +1,6 @@ package Gearman::Server::Job; -use version; -$Gearman::Server::Job::VERSION = qv("v1.130.2"); +use version (); +$Gearman::Server::Job::VERSION = version->declare("1.140_001"); use strict; use warnings; diff --git a/lib/Gearman/Server/Listener.pm b/lib/Gearman/Server/Listener.pm index 0d73fac..076d553 100644 --- a/lib/Gearman/Server/Listener.pm +++ b/lib/Gearman/Server/Listener.pm @@ -1,6 +1,6 @@ package Gearman::Server::Listener; -use version; -$Gearman::Server::Listener::VERSION = qv("v1.130.2"); +use version (); +$Gearman::Server::Listener::VERSION = version->declare("1.140_001"); use strict; use warnings; diff --git a/t/00-use.t b/t/00-use.t index c432ab8..8a92511 100644 --- a/t/00-use.t +++ b/t/00-use.t @@ -1,7 +1,7 @@ use strict; use warnings; -use version; +use version (); use Test::More; use Test::Script; @@ -12,7 +12,7 @@ my @mn = qw/ Gearman::Server::Job /; -my $v = qv("v1.130.2"); +my $v = version->declare("1.140_001"); foreach my $n (@mn) { use_ok($n); diff --git a/t/03-maxqueue.t b/t/03-maxqueue.t index ee1e286..40dc3e9 100644 --- a/t/03-maxqueue.t +++ b/t/03-maxqueue.t @@ -21,7 +21,6 @@ my $gs = Test::TCP->new( host => $host, code => sub { my ($port) = @_; - warn "port is: $port"; exec $^X, join('', "-I", File::Spec->catdir($dir, "lib")), $bin, join('=', "--port", $port); } From 35ae718ae2c86ac600bec8a053dfb87c7f97a420 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Tue, 14 Mar 2017 21:56:05 +0100 Subject: [PATCH 91/95] use Net::EmptyPort --- t/01-gearman-server.t | 15 +++++---------- t/02-gearman-server-client.t | 10 ++-------- 2 files changed, 7 insertions(+), 18 deletions(-) diff --git a/t/01-gearman-server.t b/t/01-gearman-server.t index cbe934b..8dec9bc 100644 --- a/t/01-gearman-server.t +++ b/t/01-gearman-server.t @@ -1,20 +1,17 @@ use strict; use warnings; -use File::Spec; -use FindBin qw/ $Bin /; use IO::Socket::INET; use Socket qw/ IPPROTO_TCP SOCK_STREAM /; + +use Net::EmptyPort qw/ empty_port /; use Sys::Hostname (); use Test::Exception; use Test::More; -use lib File::Spec->catdir($Bin, "lib"); -use Test::Gearman::Server qw/free_local_port/; - my $mn = qw/ Gearman::Server /; @@ -86,10 +83,8 @@ subtest "new", sub { }; subtest "create listening sock/new client", sub { - my $port = free_local_port(); - $port || plan skip_all => "couldn't find free port"; - my $gs = new_ok($mn); - my ($accept, $la); + my $gs = new_ok($mn); + my ($la, $port, $accept) = ("127.0.0.1", empty_port()); ok( my $sock = $gs->create_listening_sock( $port, @@ -101,7 +96,7 @@ subtest "create listening sock/new client", sub { }; subtest "client", sub { - my ($port, $la) = (free_local_port()); + my $port = empty_port(); $port || plan skip_all => "couldn't find free port"; my $sock = new_ok( diff --git a/t/02-gearman-server-client.t b/t/02-gearman-server-client.t index 2ac8709..8703a03 100644 --- a/t/02-gearman-server-client.t +++ b/t/02-gearman-server-client.t @@ -1,17 +1,13 @@ use strict; use warnings; -use File::Spec; -use FindBin qw/ $Bin /; -use lib File::Spec->catdir($Bin, "lib"); - use IO::Socket::INET; +use Net::EmptyPort qw/ empty_port /; use Socket qw/ IPPROTO_TCP SOCK_STREAM /; use Test::More; -use Test::Gearman::Server qw/free_local_port/; my $mn = "Gearman::Server::Client"; use_ok("Gearman::Server"); @@ -62,9 +58,7 @@ can_ok( my ($gs, $gc) = (new_ok("Gearman::Server")); subtest "new", sub { - my $port = free_local_port(); - $port || plan skip_all => "couldn't find free port"; - + my $port = empty_port(); my $sock = new_ok( "IO::Socket::INET", [ From 00e819c8d9c89236250637e856585e1916fda20c Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Tue, 14 Mar 2017 21:56:50 +0100 Subject: [PATCH 92/95] rm unused dependencies --- t/03-maxqueue.t | 2 -- 1 file changed, 2 deletions(-) diff --git a/t/03-maxqueue.t b/t/03-maxqueue.t index 40dc3e9..a6cae4b 100644 --- a/t/03-maxqueue.t +++ b/t/03-maxqueue.t @@ -3,8 +3,6 @@ use warnings; use File::Spec; use FindBin (); -use Gearman::Client; -use Gearman::Worker; use IO::Socket::INET; use Net::EmptyPort (); use Test::More; From 4e0f79ad76515950345f645cb0886010b3da0954 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Tue, 14 Mar 2017 21:57:16 +0100 Subject: [PATCH 93/95] rm useless module --- t/lib/Test/Gearman/Server.pm | 36 ------------------------------------ 1 file changed, 36 deletions(-) delete mode 100644 t/lib/Test/Gearman/Server.pm diff --git a/t/lib/Test/Gearman/Server.pm b/t/lib/Test/Gearman/Server.pm deleted file mode 100644 index eb14078..0000000 --- a/t/lib/Test/Gearman/Server.pm +++ /dev/null @@ -1,36 +0,0 @@ -package Test::Gearman::Server; - -@ISA = qw/ - Exporter - /; -@EXPORT_OK = qw/ - free_local_port - /; - -use strict; -use warnings; -use IO::Socket::INET; - -sub free_local_port { - my ($la, $port) = shift; - my ($type, $retry, $sock) = ("tcp", 5); - $la ||= "127.0.0.1"; - do { - unless ($port) { - $port = int(rand(10_000)) + int(rand(30_000)); - } - - IO::Socket::INET->new( - LocalAddr => $la, - LocalPort => $port, - Proto => $type, - ReuseAddr => 1 - ) or undef($port); - - } until ($port || --$retry == 0); - - return $port; -} ## end sub free_local_port - -1; - From 4482d09e10e4f10bcf7fbb18640693e8af4cb7bb Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Tue, 14 Mar 2017 21:57:46 +0100 Subject: [PATCH 94/95] more tests --- MANIFEST | 3 +++ 1 file changed, 3 insertions(+) diff --git a/MANIFEST b/MANIFEST index e8863b8..6faf67a 100644 --- a/MANIFEST +++ b/MANIFEST @@ -9,6 +9,9 @@ lib/Gearman/Server/Client.pm lib/Gearman/Server/Job.pm lib/Gearman/Server/Listener.pm t/00-use.t +t/01-gearman-server.t +t/02-gearman-server-client.t +t/03-maxqueue.t Makefile.PL MANIFEST This list of files MANIFEST.SKIP From 69db7b0472459d69ca5f9038589fa45f48ad3992 Mon Sep 17 00:00:00 2001 From: Alexei Pastuchov Date: Tue, 14 Mar 2017 22:04:02 +0100 Subject: [PATCH 95/95] changes [skip ci] --- CHANGES | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/CHANGES b/CHANGES index 7b93cce..6eac657 100644 --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,7 @@ +1.14_001 2017-03-14 + * no more support for text command shutdown + * more tests + 1.13.002 2016-07-11 * pod links to gearmand repaired