Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling
 
PerlMonks  

Re^7: Win32::Daemon service doesn't reach RUNNING state

by SwaJime (Scribe)
on Jun 03, 2019 at 14:11 UTC ( [id://11100874]=note: print w/replies, xml ) Need Help??


in reply to Re^6: Win32::Daemon service doesn't reach RUNNING state
in thread Win32::Daemon service doesn't reach RUNNING state

Trying to implement the 2018 version of Daemon into my code.

Basing on https://metacpan.org/pod/release/JDB/Win32-Daemon-20181025/lib/Win32/Daemon.pm

However it seems SERVICE_STOPPED and SERVICE_RUNNING ate not defined ???

Undefined subroutine &Win32::Daemon::SERVICE_STOPPED called at test-sv +c.pl line xxx.

Replies are listed 'Best First'.
Re^8: Win32::Daemon service doesn't reach RUNNING state
by SwaJime (Scribe) on Jun 03, 2019 at 16:09 UTC

    All issues resolved.

    Code now runs on 2013 and 2018 versions of Daemon.pm.

    I also got pause and resume to work! :-D

    #!/usr/bin/env perl use strict; use warnings; use File::Basename; use Cwd qw(abs_path getcwd); use Win32::Daemon; if ($Win32::Daemon::VERSION == 20181025) { # Constants were not properly exported in this version package Win32::Daemon; sub SERVICE_NOT_READY { return 0 }; sub SERVICE_STOPPED { return 1 }; sub SERVICE_START_PENDING { return 2 }; sub SERVICE_STOP_PENDING { return 3 }; sub SERVICE_RUNNING { return 4 }; sub SERVICE_CONTINUE_PENDING { return 5 }; sub SERVICE_PAUSE_PENDING { return 6 }; sub SERVICE_PAUSED { return 7 }; } package main; our $iSleep = 2; open(my $fh, ">>", "C:\\Users\\ru601501\\test\\test.log"); select($fh); $|=1; print "V: " . $Win32::Daemon::VERSION . "\n"; use Cwd qw(abs_path getcwd); use File::Spec::Functions; # Get command line argument - if none passed, use empty string my $opt = $ARGV[0] || ""; my $path = $ARGV[1]; print $fh "Running Test Service.\n"; print $fh "opt: $opt\n"; print $fh "path: $path\n" if $path; # Check command line argument if ($opt =~ /^(-i|--install)$/i) { install_service(); } elsif ($opt =~ /^(-r|--remove)$/i) { remove_service(); } else { if (!$path) { print $fh "This program is intended to be run as a service.\n" +; exit 1; } chdir $path; 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(), ); if ($Win32::Daemon::VERSION < 20180000) { Win32::Daemon::AcceptedControls(SERVICE_ACCEPT_STOP | SERVICE_ACCEPT_PAUSE_CONTINUE | SERVICE_ACCEPT_SHUTDOWN | SERVICE_ACCEPT_PARAMCHANGE | SERVICE_ACCEPT_NETBINDCHANGE); } # Setting more than 5 seconds causes some systems to never trigger + Callback_Running(). Win32::Daemon::StartService( \%Context, 5 * 1000); # 5 seconds if ($Win32::Daemon::VERSION < 20180000) { close STDERR; close STDOUT; } } { my $counter = 0; sub Callback_Running { my ($Event, $Context) = @_; if (SERVICE_RUNNING == Win32::Daemon::State()) { $counter += 5; # print $fh $counter . "\n"; if ($counter >= $iSleep * 60) { print $fh "Checking in.\n"; $counter = 0; } # These two lines are needed for both versions $Context->{last_state} = SERVICE_RUNNING; Win32::Daemon::State( SERVICE_RUNNING ); } elsif (SERVICE_PAUSED == Win32::Daemon::State()) { # Without this, pause/continue fails $Context->{last_state} = SERVICE_PAUSED; Win32::Daemon::State( SERVICE_PAUSED ); } } } sub Callback_Start { my($Event, $Context) = @_; print $fh "Starting\n"; $Context->{last_state} = SERVICE_RUNNING; Win32::Daemon::State( SERVICE_RUNNING ); } sub Callback_Pause { my($Event, $Context) = @_; print $fh "Paused.\n"; $Context->{last_state} = SERVICE_PAUSED; Win32::Daemon::State( SERVICE_PAUSED ); } sub Callback_Continue { my( $Event, $Context ) = @_; print $fh "Resumed running."; $Context->{last_state} = SERVICE_RUNNING; Win32::Daemon::State( SERVICE_RUNNING ); } sub Callback_Stop { my($Event, $Context) = @_; print $fh "Stopped.\n"; $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 install_service { my ($path, $parameters); my $dir = getcwd; # Get the program's full filename, break it down into constituent +parts my $fn = Win32::GetFullPathName($0); my ($cwd,$bn,$ext) = ( $fn =~ /^(.*\\)(.*)\.(.*)$/ ) [0..2] ; # Determine service's path to executable based on file extension if ($ext eq "pl") { # Source perl script - invoke perl interpreter $path = "\"$^X\""; # Parameters include extra @INC directories and perl script # @INC directories must not end in \ otherwise perl hangs my $inc = ($cwd =~ /^(.*?)[\\]?$/) [0]; $parameters = "-I " . "\"$inc\"" . " \"$fn\" \"myflag\" \"$dir +\""; } else { # Invalid file type? die "Can not install service for $fn, file extension $ext not supported."; } my $sServiceName = "TestService"; # Populate the service configuration hash # The hash is required by Win32::Daemon::CreateService my %srv_config = ( name => $sServiceName, display => "Test Service ($sServiceName)", path => $path, description => "For debugging.", parameters => $parameters, # service_type => SERVICE_WIN32_OWN_PROCESS, # start_type => SERVICE_AUTO_START, ); if ($Win32::Daemon::VERSION < 20180000) { $srv_config{service_type} = SERVICE_WIN32_OWN_PROCESS; $srv_config{start_type} = SERVICE_AUTO_START; } # Install the service if (Win32::Daemon::CreateService(\%srv_config)) { print $fh "Test Service has been installed.\n"; print $fh "Setting agent service to delayed start.\n"; print $fh "sc config $sServiceName start= delayed-auto\n"; print $fh `sc config $sServiceName start= delayed-auto` . "\n +"; } else { print $fh "Failed to install Test Service: " . Win32::FormatMe +ssage(Win32::Daemon::GetLastError()) . "\n"; } } sub remove_service { print $fh "Test Service is being removed.\n"; my $sServiceName = "TestService"; my $hostname = Win32::NodeName(); if (Win32::Daemon::DeleteService($sServiceName)) { print $fh "Test Service uninstalled successfully.\n"; } else { print $fh "Failed to uninstall Test Service.\n"; } }

    Hopefully I won't run into more issues.

      Thank you for keeping us updated and providing the code that works for you!

        No problem!

        Received an update from Tomasz with a better way. Per Tomasz: "non-anonymous subroutine definitions in perl are being executed in compile time, which means the subs will be created even when the condition in your if is false. That means they can conflict with the future versions of Win32::Daemon."

        Better solution provided by Tomasz, which works for me:

        use Win32::Daemon; # restore AUTOLOAD sub which was erroneiously removed in 20181025 vers +ion of Win32::Daemon # note that newer versions of Win32::Daemon don't use AUTOLOAD at all if ($Win32::Daemon::VERSION == 20181025) { package Win32::Daemon; *Win32::Daemon::AUTOLOAD = sub { no strict; no warnings; # This AUTOLOAD is used to 'autoload' constants from the const +ant() # XS function. If a constant is not found then control is pas +sed # to the AUTOLOAD in AutoLoader. my( $Constant ) = $AUTOLOAD; my( $Result, $Value ); $Constant =~ s/.*:://; $Result = Constant( $Constant, $Value ); if( 0 == $Result ) { # The extension could not resolve the constant... $AutoLoader::AUTOLOAD = $AUTOLOAD; goto &AutoLoader::AUTOLOAD; return; } elsif( 1 == $Result ) { # $Result == 1 if the constant is valid but not defined # that is, the extension knows that the constant exists bu +t for # some wild reason it was not compiled with it. $pack = 0; ($pack,$file,$line) = caller; print "Your vendor has not defined 'Win32::Daemon' macro $ +constname, used in $file at line $line."; } elsif( 2 == $Result ) { # If $Result == 2 then we have a string value $Value = "'$Value'"; } # If $Result == 3 then we have a numeric value eval "sub $AUTOLOAD { return( $Value ); }"; goto &$AUTOLOAD; } }

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://11100874]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others perusing the Monastery: (6)
As of 2024-03-29 01:19 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found