package POE::Component::Daemon::Win32;
use strict;
use Carp;
use Exporter;
use Win32::Daemon;
use POE;
use vars qw( $VERSION @ISA @EXPORT %SERVICE_STATES );
use constant DEFAULT_ALIAS => 'win32daemon';
use constant DEFAULT_POLL_INTERVAL => 1;
use constant DEFAULT_SHUTDOWN_DELAY => 30 * 1000;
@ISA = qw( Exporter );
@EXPORT = @Win32::Daemon::EXPORT;
$VERSION = '0.01';
%SERVICE_STATES = (
not_ready => SERVICE_NOT_READY,
stopped => SERVICE_STOPPED,
running => SERVICE_RUNNING,
paused => SERVICE_PAUSED,
start_pending => SERVICE_START_PENDING,
stop_pending => SERVICE_STOP_PENDING,
continue_pending => SERVICE_CONTINUE_PENDING,
pause_pending => SERVICE_PAUSE_PENDING
);
sub spawn {
my ($class, %args) = @_;
$args{'Alias'} ||= DEFAULT_ALIAS;
$args{'PollInterval'} ||= DEFAULT_POLL_INTERVAL;
my %callback;
unless (defined $args{'Callback'}) {
croak 'POE::Component::Daemon::Win32 "Callback" parameter missing';
}
if (ref $args{'Callback'} eq 'HASH') {
%callback = %{$args{'Callback'}};
} elsif (ref $args{'Callback'} eq 'CODE') {
%callback = map { $_ => $args{'Callback'} } ('shutdown', keys %SERVICE_STATES);
} else {
croak 'POE::Component::Daemon::Win32 "Callback" parameter must be a HASHREF or CODEREF';
}
POE::Session->create (
inline_states => {
_start => \&_start,
_stop => \&_stop,
shutdown => \&shutdown,
poll => \&poll,
state => \&state,
next_state => \&next_state,
service_not_ready => \&service_not_ready,
service_running => \&service_running,
service_paused => \&service_paused,
service_start_pending => \&service_start_pending,
service_stop_pending => \&service_stop_pending,
service_pause_pending => \&service_pause_pending,
service_continue_pending => \&service_continue_pending,
service_stopped => \&service_stopped,
service_unhandled => \&service_unhandled,
service_shutdown => \&service_shutdown
}, args => [ @args{qw( Alias PollInterval )}, \%callback ]
);
$args{'Alias'};
}
sub _start {
my ($kernel, $heap, $session, $alias, $poll_interval, $callback)
= @_[KERNEL, HEAP, SESSION, ARG0..ARG2]
;
$heap->{'Alias'} = $alias;
$heap->{'PollInterval'} = $poll_interval;
$heap->{'Callback'} = $callback;
$kernel->alias_set ($alias);
$heap->{'last_state'} = SERVICE_START_PENDING;
Win32::Daemon::StartService();
$kernel->delay (poll => $heap->{'PollInterval'});
}
sub _stop {}
sub poll {
my ($kernel, $heap) = @_[KERNEL, HEAP];
my $state = Win32::Daemon::State();
if (SERVICE_RUNNING == $state) {
$kernel->yield ('service_running', $state);
} elsif (SERVICE_NOT_READY) {
$kernel->yield ('service_not_ready', $state);
} elsif (SERVICE_START_PENDING == $state) {
$kernel->yield ('service_start_pending', $state);
} elsif (SERVICE_STOP_PENDING == $state) {
$kernel->yield ('service_stop_pending', $state);
} elsif (SERVICE_PAUSE_PENDING == $state) {
$kernel->yield ('service_pause_pending', $state);
} elsif (SERVICE_CONTINUE_PENDING == $state) {
$kernel->yield ('service_continue_pending', $state);
} elsif (SERVICE_PAUSED == $state) {
$kernel->yield ('service_paused', $state);
} elsif (SERVICE_STOPPED == $state) {
$kernel->yield ('service_stopped', $state);
} else {
$kernel->yield ('service_unhandled', $state);
}
if (SERVICE_CONTROL_NONE != (
my $message = Win32::Daemon::QueryLastMessage (1)
)) {
if (SERVICE_CONTROL_INTERROGATE == $message) {
$kernel->yield ('state', $heap->{'last_state'});
} elsif (SERVICE_CONTROL_SHUTDOWN == $message) {
$kernel->yield ('service_shutdown', $state, $message);
}
}
$kernel->delay (poll => $heap->{'PollInterval'});
}
sub shutdown {
my ($kernel, $heap) = @_[KERNEL, HEAP];
$kernel->alias_remove ($heap->{'Alias'});
$kernel->alarm_remove_all;
}
sub state {
my ($kernel, $heap, $state) = @_[KERNEL, HEAP, ARG0];
if (scalar @_ > ARG0) {
my $href;
if (ref $state eq 'HASH') {
$href = $state;
$state = $href->{'state'};
}
$state = $SERVICE_STATES{$state} unless $state =~ /^\d+$/;
Win32::Daemon::State ($href || $state);
$heap->{'last_state'} = $state
if $state == SERVICE_RUNNING
|| $state == SERVICE_PAUSED
|| $state == SERVICE_STOPPED
;
} else {
$state = Win32::Daemon::State();
}
$state;
}
sub next_state {
my ($kernel, $heap, $delay) = @_[KERNEL, HEAP, ARG0];
my $state = Win32::Daemon::State();
my $message = Win32::Daemon::QueryLastMessage (1);
my $next_state;
return if $state == SERVICE_RUNNING
|| $state == SERVICE_NOT_READY
|| $state == SERVICE_PAUSED
|| $state == SERVICE_STOPPED
;
if ($state == SERVICE_START_PENDING) {
$next_state = SERVICE_RUNNING;
} elsif ($state == SERVICE_PAUSE_PENDING) {
$next_state = SERVICE_PAUSED;
} elsif ($state == SERVICE_CONTINUE_PENDING) {
$next_state = SERVICE_RUNNING;
} elsif ($state == SERVICE_STOP_PENDING) {
$next_state = SERVICE_STOPPED;
} elsif ($message == SERVICE_CONTROL_SHUTDOWN) {
$next_state = SERVICE_STOP_PENDING;
$kernel->yield (state => {
state => $next_state,
waithint => $delay || DEFAULT_SHUTDOWN_DELAY
});
return;
} else {
return unless defined $heap->{'last_state'};
$next_state = $heap->{'last_state'};
}
$kernel->yield (state => $next_state);
}
# callbacks
sub service_not_ready {
my ($kernel, $heap) = @_[KERNEL, HEAP];
if (my $callback = $heap->{'Callback'}->{'not_ready'}) {
$callback->(@_);
}
}
sub service_start_pending {
my ($kernel, $heap) = @_[KERNEL, HEAP];
if (my $callback = $heap->{'Callback'}->{'start_pending'}) {
$callback->(@_);
} else {
$kernel->yield ('next_state');
}
}
sub service_stop_pending {
my ($kernel, $heap) = @_[KERNEL, HEAP];
if (my $callback = $heap->{'Callback'}->{'stop_pending'}) {
$callback->(@_);
} else {
$kernel->yield ('next_state');
}
}
sub service_pause_pending {
my ($kernel, $heap) = @_[KERNEL, HEAP];
if (my $callback = $heap->{'Callback'}->{'pause_pending'}) {
$callback->(@_);
} else {
$kernel->yield ('next_state');
}
}
sub service_continue_pending {
my ($kernel, $heap) = @_[KERNEL, HEAP];
if (my $callback = $heap->{'Callback'}->{'continue_pending'}) {
$callback->(@_);
} else {
$kernel->yield ('next_state');
}
}
sub service_running {
my ($kernel, $heap) = @_[KERNEL, HEAP];
if (my $callback = $heap->{'Callback'}->{'running'}) {
$callback->(@_);
}
}
sub service_stopped {
my ($kernel, $heap) = @_[KERNEL, HEAP];
if (my $callback = $heap->{'Callback'}->{'stopped'}) {
$callback->(@_);
}
Win32::Daemon::StopService();
$kernel->yield ('shutdown');
}
sub service_paused {
my ($kernel, $heap) = @_[KERNEL, HEAP];
if (my $callback = $heap->{'Callback'}->{'paused'}) {
$callback->(@_);
}
}
sub service_unhandled {
my ($kernel, $heap) = @_[KERNEL, HEAP];
if (my $callback = $heap->{'Callback'}->{'unhandled'}) {
$callback->(@_);
} else {
$kernel->yield ('next_state');
}
}
sub service_shutdown {
my ($kernel, $heap) = @_[KERNEL, HEAP];
if (my $callback = $heap->{'Callback'}->{'shutdown'}) {
$callback->(@_);
} else {
$kernel->yield ('next_state');
}
}
1;
__END__
=head1 NAME
POE::Component::Daemon::Win32 - Run POE as a Windows NT/2000/XP service
=head1 SYNOPSIS
use POE qw( Component::Daemon::Win32 );
# generic callback - all events call the same subroutine
POE::Component::Daemon::Win32->spawn (
Callback => \&sub
);
# state-specific callback
POE::Component::Daemon::Win32->spawn (
Callback => {
start_pending => \&sub1,
stop_pending => \&sub2,
stopped => \&sub3,
...
}
);
=head1 DESCRIPTION
POE::Component::Daemon::Win32 enables POE scripts to run as services via the
Win32::Daemon module by Dave Roth. Full event-based callbacks are available
on service state changes.
=head1 PARAMETERS
The following parameters may be passed to the spawn() constructor:
=over
=item Callback
Specifies which subroutines should be called for any given states. If a
coderef is passed, all events will call that subroutine.
Alternately, a hashref may be specified. In this case, the hashref should
contain state names for keys and coderefs for values. See below for a
list of valid state names.
=item Alias
This optional parameter specifies the alias by which the underlying session
will be known. If omitted, the alias will be set to a default of
'win32daemon'.
=item PollInterval
This optional parameter sets the frequency (in seconds) of service polls. If
omitted, polls will occur approximately once every second.
=back
=head1 CALLBACKS
Whenever the Win32 service state changes, events are fired off to the
user-defined callbacks. Valid callback names are specified below in the STATES
section.
Callbacks can either be defined per-state or can be delegated en masse to a
single subroutine.
# per-state callback
sub service_start_pending {
my $kernel = $_[KERNEL];
# do some sort of initialization here
$kernel->yield ('next_state');
}
# generic callback
sub service_state {
my ($kernel, $state, $message) = @_[KERNEL, ARG0, ARG1];
# service start pending
if ($state == SERVICE_START_PENDING) {
# do some sort of initialization here
}
$kernel->yield ('next_state');
}
The second argument C<$state> contains a number corresponding to the current
service state. The parameter C<$message> contains any service messages such
as a pending system shutdown.
If you choose the latter, non-state specific approach, you only need to create
one subroutine. Within the callback just compare the provided state with a
list of service state constants. Please see the CONSTANTS section below for
a list of valid state constants.
When your script is ready to move on to the next service state, simply notify
the kernel of your intent like so:
$kernel->yield ('next_state');
If you do not pass on a C<next_state> message, your callback will be invoked
every cycle until you are ready for the next state. This allows you to take
care of potentially long-running operations safely.
Note, however, that one should not take too long to acknowledge a state change
or the Service Control Manager (SCM) may deem your service unresponsive. If
this happens it will be impossible to interact with the service short of
forcefully terminating its process.
=head1 STATES
The following states are recognized for use in C<Callback>:
=over
=item not_ready
The Service Control Manager (SCM) is not ready.
Next state: C<start_pending>.
=item start_pending
The SCM expects us to run our startup procedure at this point.
Next state: C<running>.
=item running
Normal operation. The service should spend the vast majority of its time in
this state.
=item pause_pending
The SCM has informed the service it should pause operation. This is not to be
confused with the stopped state.
Next state: C<paused>.
=item paused
The service should not perform anything above and beyond SCM interaction
during this state.
=item continue_pending
The service is coming out of the paused state and should resume normal
operation.
Next state: C<running>.
=item stop_pending
The service should start winding down. Typically one would start closing open
filehandles/connections/etc. and generally cleaning up at this point.
Next state: C<stopped>
=item stopped
The service has stopped. After any callback has returned, no further
service communications will take place. The component will then be destroyed.
=item shutdown
The system on which the service is running has been instructed to shut down.
This isn't really a state per se, but rather a message from the SCM.
If the service takes too long to stop, it runs the risk of being forcefully
terminated by the SCM. By default, approximately 30 seconds are allowed for
graceful service shutdown. If your service needs more time it should pass a
delay, in milliseconds, with its C<next_state> call.
# allow 45 seconds for service shutdown
$kernel->yield ('next_state', 45 * 1000);
=item unhandled
This state is provided to handle any states not specificially supported at this
time.
=back
=head1 CONSTANTS
The following service state constants are supported:
SERVICE_NOT_READY
SERVICE_STOPPED
SERVICE_RUNNING
SERVICE_PAUSED
SERVICE_START_PENDING
SERVICE_STOP_PENDING
SERVICE_CONTINUE_PENDING
SERVICE_PAUSE_PENDING
The following service message constant is supported:
SERVICE_CONTROL_SHUTDOWN
For more information about each state and its purpose, please see
L<Win32::Daemon>.
=head1 AUTHOR
Peter Guzis E<lt>pguzis@cpan.orgE<gt>
=head1 SEE ALSO
L<Win32::Daemon>
=cut