The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/env perl

use strict;
use warnings;

use lib 'lib';
use Gearman::Worker;
use Storable qw(thaw nfreeze);
use Getopt::Long qw( GetOptions );

GetOptions(
    's|servers=s' => \(my $servers),
    'n=i'         => \(my $notifypid),
    'p=s'         => \(my $prefix),
);

die "usage: $0 -s <servers>" unless $servers;
my @servers = split /,/, $servers;

my $worker = Gearman::Worker->new($prefix ? (prefix => $prefix) : ());
$worker->job_servers(@servers);

$worker->register_function(
    sum => sub {
        my $sum = 0;
        $sum += $_ for @{ thaw($_[0]->arg) };
        $sum;
    }
);

$worker->register_function(fail      => sub {undef});
$worker->register_function(fail_die  => sub { die 'test reason' });
$worker->register_function(fail_exit => sub { exit 255 });

$worker->register_function(sleep => sub { sleep $_[0]->arg });
$worker->register_function(
    sleep_three => 3 => sub {
        my ($sleep, $return) = $_[0]->arg =~ m/^(\d+)(?::(.+))?$/;
        sleep $sleep;
        return $return;
    }
);

$worker->register_function(
    echo_ws => sub {
        select undef, undef, undef, 0.25;
        $_[0]->arg eq 'x' ? undef : $_[0]->arg;
    }
);

$worker->register_function(
    echo_prefix => sub {
        join " from ", $_[0]->arg, $prefix;
    }
);

$worker->register_function(
    echo_sleep => sub {
        my ($job) = @_;
        $job->set_status(1, 1);
        sleep 2;    ## allow some time to read the status
        join " from ", $_[0]->arg, $prefix;
    }
);

$worker->register_function(
    long => sub {
        my ($job) = @_;
        $job->set_status(50, 100);
        sleep 2;
        $job->set_status(100, 100);
        sleep 2;
        return $job->arg;
    }
);

my $nsig;
$nsig = kill 'USR1', $notifypid if $notifypid;

my $work_exit = 0;

$worker->register_function(
    work_exit => sub {
        $work_exit = 1;
    }
);

my ($is_idle, $last_job_time);

$worker->register_function(
    check_stop_if => sub {
        return nfreeze([$is_idle, $last_job_time]);
    }
);

my $stop_if = sub {
    ($is_idle, $last_job_time) = @_;

    if ($work_exit) {
        $work_exit = 0;
        return 1;
    }

    return 0;
};

$worker->work(stop_if => $stop_if) while (1);