Re: Trying to exit an HTTP::Daemon based on JSON::RPC::Server::Daemon

[sundialsvc4]

First of all, please edit any code that you copy so that it includes only the minimal amount of material necessary to illustrate your point.   (If you copied it from another, well-known source such as a CPAN module, please cite the module ... we can find it ourselves if we need to).

You can see from the referenced code that the receipt of a signal ought to merely cause a flag (e.g. $exit_now) to become true, and to wake up the process or thread to wake up if it is sleeping.   This causes it to promptly exit from the while loop that it is parked in.   The thread should then clean up its own affairs neatly, and exit normally.   (If necessary, it can issue some signal or send some message to its parent before it dies.)

Also notice that “it is best to wake somebody up using an alarm clock, not a loaded pistol.”   Certain signals, such as KILL, have specific meaning to the operating system.   You do not want the OS to be the one who’s reacting to the signal that you give.   You want the recipient to kill itself, not to “be killed.”

Finally, you want to be certain that the termination signal is handled “gracefully and cleanly,” and always at an appropriate point in the recipient’s normal business day.   (If you shoot somebody in the head, you’re going to leave blood-n-guts on the floor ... and that is, y’know, very hard to clean.)

If you are, say, already using message-queues to talk between a set of processes or threads, simply design one of those messages to be “the mark of death.”   Upon receipt of this special message, the thread breaks out of its message-handling loop, closes its side of the message-queue etc., and dies quietly.   The sender of the message knows that any messages that might have been in the queue ahead of the “mark of death” message, will have been processed normally, as well.   The “mark of death” message is an upleasant surprise, but like all other messages it is processed synchronously.

As a final matter of principle, you really want this sort of thing to only be happening when the program is closing down ... not as a regular part of the program’s daily routine.   If the number of threads is kept sensibly small, any one of them can wait, even for many hours, with almost no overhead at all.   A single thread might handle thousands of units-of-work during the course of its lifetime.

[carcus88]

Thanks for the advise. So I took the signal code from XML::RPC::Server and adapted it to JSON::RPC::Server::Daemon but the only way I could see this to work was to create a class called JSON::RPC::Server::AltDaemon which is based on JSON::RPC::Server::Daemon. This works perfect and the signal is sent and handled when this code is running in a thread using $thread->kill('INT'). But is there a better way to do this. Obviously this could break if a future update to JSON::RPC::Server implements things differently.

=begin nd
Provided an alternate version of JSON::RPC::Server::Daemon that can be
+ inturpted
using signals.
=cut
package JSON::RPC::Server::AltDaemon;
use strict;

use JSON::RPC::Server; # for old Perl 5.005
use base qw(JSON::RPC::Server);

$JSON::RPC::Server::AltDaemon::VERSION = '0.03';

use Data::Dumper;


=begin nd
Create a new instance of JSON::RPC::Server::Daemon::Alt

@param  $class      ref     Object reference/static class
@param  %args       hash    Arguments (timeout => '10')
@return undef
=cut
sub new {
    my $class = shift;
    my %args  = @_;
    my $self  = $class->SUPER::new();
    my $pkg;

    if(  grep { $_ =~ /^SSL_/ } @_ ){
        $self->{_daemon_pkg} = $pkg = 'HTTP::Daemon::SSL';
    }
    else{
        $self->{_daemon_pkg} = $pkg = 'HTTP::Daemon';
    }
    eval qq| require $pkg; |;
    if($@){ die $@ }

    $self->{_daemon} ||= $pkg->new(@_) or die;
    $self->{__timeout} = delete $args{timeout} || 10;
    return $self;
}

=begin nd
Starts the server

@param  $self       ref     Object reference/static class
@param  %args       hash    Arguments (signal => 'INT')
@return undef
=cut
sub handle {
    my $self = shift;
    my %args  = @_;
    my $d    = $self->{_daemon} ||= $self->{_daemon_pkg}->new(@_) or d
+ie;

    # Localize and set the signal handler as an exit route
    my @exit_signals;

    if (exists $args{signal} and $args{signal} ne 'NONE')
    {
        @exit_signals =
            (ref $args{signal}) ? @{$args{signal}} : $args{signal}
    }
    else
    {
        push @exit_signals, 'INT';
    }
    my $exit_now;
    local @SIG{@exit_signals} = (sub { $exit_now++;});

    my $timeout = $d->timeout(1);
    while (! $exit_now) {
        my $c = $d->accept;

        if ($exit_now) {
            last;
        }
        if (! $c) {
            next;
        }
        $c->timeout($self->timeout);

        $self->{con} = $c;
        while (my $r = $c->get_request) {
            $self->request($r);
            $self->path_info($r->url->path);
            $self->SUPER::handle();
            last;
        }
        $c->close;
        undef $c;
    }
    return;
}

sub retrieve_json_from_post {
    return $_[0]->request->content;
}


sub retrieve_json_from_get {
}


sub response {
    my ($self, $response) = @_;
    $self->{con}->send_response($response);
}

=begin nd
This sets the timeout for processing connections after a new connectio
+n has been accepted.
It returns the old timeout value.  If you pass in no value, it returns
+ the current timeout.

@param  $self       ref     Object reference/static class
@param  $timeout    int     New timeout value
@return integer     Current timeout value
=cut
sub timeout {
    my ($self, $timeout) = @_;
    my $old_timeout = $self->{__timeout};
    if ($timeout) {
        $self->{__timeout} = $timeout;
    }
    return $old_timeout;
}

1;