У меня есть следующий код, который я использую для понимания создания службы Windows с Perl.Работают следующие части: установить, удалить, запустить, остановить, продолжить, приостановить, но секция запуска вызывается только один раз.Может кто-нибудь взглянуть и сказать мне, что мне не хватает?Я попытался зарегистрироваться для таймера, но это не вызывается вообще.Я пробовал это на нескольких разных машинах (Windows 7 и 10), и я получаю одинаковое поведение.
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";
}
}
** Обновление.Это было использование dwimp Perl.Если я попытаюсь использовать Strawberry Perl, я даже не смогу запустить сервис.Я получаю следующую ошибку.
Неопределенная подпрограмма & Win32 :: Daemon :: SERVICE_STOPPED, вызванная по C: \ source \ perl \ rtNVMService.pl, строка 85.
** Активный Perl запустится и напечатаетодин раз, но больше ничего.Кроме того, я не могу остановиться, продолжить или сделать паузу с ActivePerl.
Настолько расстраивает, что я могу получить так много разных вариантов поведения с одним и тем же фрагментом кода.