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

Win32::Daemon problems

by Anonymous Monk
on Oct 18, 2012 at 15:36 UTC ( #999758=perlquestion: print w/replies, xml ) Need Help??
Anonymous Monk has asked for the wisdom of the Perl Monks concerning the following question:

I am humbly searching for an answer to a Win32::Daemon problem that has been filling my System Logs with errors. I created a service using the CPAN different callback routines framework. After super searching the monastery I found one thread that covered the topic, but did not provide a solution - "Win32::Daemon::State returns a 0 or 1" from 2009. I appreciate any wisdom that can be given in this matter.

use strict; use Fcntl qw(:DEFAULT :flock); use File::Copy; use Net::FTP; use Win32; use Win32::Daemon; use IniInstall; use CopyFiles; use ftpsend; open (STDERR, ">>c:/error.err") or die "invisible error"; warn "$0 started ".localtime().$/; my $ServicePath = 'c:\Foo\FooBar.exe'; 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(), ); # Start the service passing in a context Win32::Daemon::StartService( \%CONTEXT); sub Callback_Running { my ( $Event, $CONTEXT ) = @_; if( SERVICE_RUNNING == Win32::Daemon::State() ) { my @ltime=localtime; $main::MINUTE = sprintf("%02d",$ltime[1]); $main::HOUR = sprintf("%02d",$ltime[2]); $main::DAY = sprintf("%02d",$ltime[3]); $main::MONTH = sprintf("%02d",($ltime[4]+1)); $main::YEAR = sprintf("%02d",(($ltime[5])+1900)); my %HOURARR; my $HHARR=$ltime[2]; foreach ("06","12","18") { $HOURARR{$_}=1; }; if (( exists $HOURARR{$HHARR}) and ($main::MINUTE == 00)) { CopyFiles::transfer; } if (( $main::HOUR == 23 ) and ($main::MINUTE == 59)) { sleep (90); CopyFiles::transfer; } if (( $main::HOUR == $main::hh ) and ($main::MINUTE == $main::mm)) { ftpsend::send; }#endif } 1; } sub Callback_Start { my ( $Event, $CONTEXT ) = @_; # Initialization code $CONTEXT->{last_state} = SERVICE_RUNNING; Win32::Daemon::State( SERVICE_RUNNING ); IniInstall::Initiate; } 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 ); IniInstall::Initiate; } sub Callback_Stop { my ( $Event, $CONTEXT ) = @_; $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(); } # Check for any outstanding commands. Pass in a non zero value # and it resets the Last Message to SERVICE_CONTROL_NONE. if( SERVICE_CONTROL_NONE != ( my $Message = Win32::Daemon::Las +tControlMessage(1) ) ) { if( SERVICE_CONTROL_INTERROGATE == $Message ) { Win32::Daemon::State(my $CONTEXT->{last_state} ); } elsif( SERVICE_CONTROL_SHUTDOWN == $Message ) { Win32::Daemon::State( SERVICE_STOP_PENDING, 25000 ); } }

Replies are listed 'Best First'.
Re: Win32::Daemon problems
by Anonymous Monk on Oct 18, 2012 at 16:08 UTC
    Is there any other logging that you might be able to add to the system or error logs in order to help you diagnose the problem? What messages exactly are given? Does the service in fact show up as "started?"

      I apologize for the original posting being as an Anonymous Monk, I did not realize I was not logged into the Monastery. The error output is from the Windows System Event Log: "The FooBar service has reported an invalid current state 0" Event ID 7016. STDERR shows no errors reported, only that the service started: c:\FOO\FooBar.exe started Thu Oct 18 15:00:00 2012. The error shows up every time the system does a callback to FooBar to see if it is running. So my System Event Log fills up rather quickly. Humbly, Mike O

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://999758]
Front-paged by Arunbear
and all is calm...

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (5)
As of 2017-11-21 20:03 GMT
Find Nodes?
    Voting Booth?
    In order to be able to say "I know Perl", you must have:

    Results (310 votes). Check out past polls.