Question

我使用以下代码来了解如何使用Perl创建Windows服务。以下部分起作用：安装，删除，启动，停止，继续，暂停，但是运行部分仅被调用一次。有人可以看一下并告诉我我所缺少的吗？我已经尝试注册计时器，但是根本没有被调用。我已经在几台不同的计算机（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，我什至无法启动该服务。我收到以下错误。

在C：\ source \ perl \ rtNVMService.pl第85行调用的未定义子例程＆Win32 :: Daemon :: SERVICE_STOPPED。

**活动Perl将启动并打印一次，但没有其他内容。另外，我无法使用ActivePerl停止，继续或暂停。

非常沮丧，以至于我用同一段代码可以得到很多不同的行为。

Perl Windows服务-仅运行一次

0 个答案: