File Coverage

blib/lib/POE/Component/Daemon/Win32.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

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__