[rt.cpan.org #91296] Win32::Daemon not handling shutdown

[Lewis Tsao via RT]

Tue Dec 10 07:18:45 2013: Request 91296 was acted upon.
Transaction: Ticket created by lewis.t...@gmail.com
       Queue: Win32-Daemon
     Subject: Win32::Daemon not handling shutdown
   Broken in: (no value)
    Severity: (no value)
       Owner: Nobody
  Requestors: lewis.t...@gmail.com
      Status: new
 Ticket <URL: https://rt.cpan.org/Ticket/Display.html?id=91296 >


Hi

I am using Win2k8R2 Ent SP1 64bit
Using Strawberry Perl (64-bit) 5.18.1.1-64bit and Win32::Daemon 20131206.

I have a program that needs to tidy things up on system shutdown. I have
tried all sorts but system shutdown does not seem to trigger anything - not
stop nor shutdown.

Below is my snippet of code, please advise if it is a bug or something i
need to do.

use strict;

use Win32::Daemon;

my $accepted_controls = Win32::Daemon::AcceptedControls();

$accepted_controls &= ~SERVICE_ACCEPT_PAUSE_CONTINUE;    # can't handle
pause/resume
$accepted_controls |= SERVICE_ACCEPT_SHUTDOWN;        # make sure we catch
OS shutdowns

Win32::Daemon::AcceptedControls($accepted_controls);


Win32::Daemon::RegisterCallbacks( {
    start       =>  \&Callback_Start,
    running     =>  \&Callback_Running,
    stop        =>  \&Callback_Stop,
    #pause       =>  \&Callback_Pause,
    #continue    =>  \&Callback_Continue,
    shutdown    => \&Callback_Shutdown,
} );

my %Context = (
    last_state => SERVICE_STOPPED,
    start_time => time(),
);

# Start the service passing in a context and
# indicating to callback using the "Running" event
# every 2000 milliseconds (2 seconds).
Win32::Daemon::StartService( \%Context, 2000 );

sub Callback_Running
{
    my( $Event, $Context ) = @_;

    # Note that here you want to check that the state
    # is indeed SERVICE_RUNNING. Even though the Running
    # callback is called it could have done so before
    # calling the "Start" callback.
    if( SERVICE_RUNNING == Win32::Daemon::State() )
    {
        # ... process your main stuff here...
        # ... note that here there is no need to
        #     change the state
    }
}

sub Callback_Start
{
    my( $Event, $Context ) = @_;
    # Initialization code
    # ...do whatever you need to do to start...

    system("cmd/c echo starting >>c:/temp/abc.txt");

    $Context->{last_state} = SERVICE_RUNNING;
    Win32::Daemon::State( SERVICE_RUNNING );
}

sub Callback_Pause
{
    my( $Event, $Context ) = @_;
    $Context->{last_state} = SERVICE_PAUSED;
    Win32::Daemon::State( SERVICE_PAUSED );
}

sub Callback_Continue
{
    my( $Event, $Context ) = @_;
    $Context->{last_state} = SERVICE_RUNNING;
    Win32::Daemon::State( SERVICE_RUNNING );
}

sub Callback_Stop
{
    my( $Event, $Context ) = @_;

    system("cmd/c echo stopping >>c:/temp/abc.txt");
    $Context->{last_state} = SERVICE_STOPPED;
    Win32::Daemon::State( SERVICE_STOPPED );

    # We need to notify the Daemon that we want to stop callbacks and the
service.
    Win32::Daemon::StopService();
}

sub Callback_Shutdown
{
    my( $Event, $Context ) = @_;

    # don't know how lont it takes to shutdown RDS
    # tell Service Control Manager to wait
    $Context->{last_state} = SERVICE_STOP_PENDING;
    Win32::Daemon::State( SERVICE_STOP_PENDING, 30000 );

    system("cmd/c shutting down >>c:/temp/abc.txt");
    $Context->{last_state} = SERVICE_STOPPED;
    Win32::Daemon::State( SERVICE_STOPPED );
}