Perl Windows Service- Only runs once

问题

I have the following code I am using to understand creating a windows service with Perl. The following parts work: install, remove, start, stop, continue, pause, but the run section is only called once. Can someone take a look and tell me what I am missing? I have tried registering for timer but that doesn't get called at all. I have tried this on several different machines (windows 7 and 10) and I get the same behavior.

use Win32::Daemon;
use Getopt::Long;

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

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

my %opt;
GetOptions (
    \%opt,   
    "install",
    "remove",
);

my @currDir = split /\//, $0;
my $script = $0;
my $scriptPath = ".";

if (scalar @currDir > 1)
{
    $script = pop @currDir;
    $scriptPath = join "/", @currDir;
    chdir( $scriptPath );
}

my %serviceConfig = (

    name            => 'steveg',
    display         => 'Steve Service',
    description     => 'Debugging',
    machine         => '',
    path            => $^X,
    parameters      => '"C:\source\perl\steveService.pl"',
);

if( $opt { install } )
{
    &installService();
    exit();
}
elsif( $opt { remove } )
{
    &removeService();
    exit();
}

sub installService
{
    # installs the win32 service daemon
    # ---------------------------------
    if( Win32::Daemon::CreateService( \%serviceConfig ) )
    {
        debug( 'The service [%s] was successfully installed', $serviceConfig { display } );
    }
    else
    {
        debug( 'Failed to install the service [%s]: %s',
            $serviceConfig { display },
            GetError() );
    }
}

# ====================================================================
sub removeService
{
    # removes the win32 service daemon
    # --------------------------------
    if( Win32::Daemon::DeleteService( $serviceConfig { name } ) )
    {
        debug( 'The service [%s] was successfully removed', $serviceConfig { display } );
    }
    else
    {
        debug( 'Failed to remove the service [%s]: %s',
            $serviceConfig { display },
            GetError() );
    }
}


Win32::Daemon::StartService( \%Context, 2000 );

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

    if( SERVICE_RUNNING == Win32::Daemon::State() )
    {        
        $Context -> { count }++; 
        debug ($Context->{count});  
    }
}

sub Callback_Start
{
    my( $Event, $Context ) = @_;
    # Initialization code
    debug ("Starting");

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

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

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

sub Callback_Stop
{
    my( $Event, $Context ) = @_;
    $Context->{last_state} = SERVICE_STOPPED;
    Win32::Daemon::State( SERVICE_STOPPED );
    debug ("Stopping");
    # We need to notify the Daemon that we want to stop callbacks and the service.
    Win32::Daemon::StopService();
}

sub debug
{
    my ($fmt, @data) = @_;
    my $message = sprintf $fmt, @data;
    open( FILE, ">>c:/temp/perlService.log" );
    print FILE "[" .localtime . "]: 2.1: $message\n";
    close( FILE );
    if (-t STDOUT && -t STDIN)
    {
        print "$message\n";
    }

}

**Update. This was using dwimp perl. If I try to use Strawberry Perl, I can't even get the service started. I get the following error.

Undefined subroutine &Win32::Daemon::SERVICE_STOPPED called at C:\source\perl\rtNVMService.pl line 85.

**Active Perl will start and print once, but nothing further. Also I am not able to stop,continue,or pause with ActivePerl.

So frustrating that I can get so many different behaviors with the same piece of code.

来源：https://stackoverflow.com/questions/53934637/perl-windows-service-only-runs-once

标签

windows

perl

service