I've had a lot of luck using Win32::Daemon from Roth Consulting. You can get a ppm for it, and it plays well with ActivePerl 5.6.1.
Here are some convienence modules and sample code I wrote to make working with it easier
This service watches a file, and when it changes, reads it, and re-writes a batch file. This allows me to have an alias like feature in Win2K.
go2.plAn example service
#!perl
# Go2.pl - a service to create a shortcut batch file
# Includes service installer and remover
BEGIN {
use Win32::EventLog::Carp;
# open(STDERR, '>E:\Commands\Daemons\stderr.log');
}
use lib qw(e:\commands\daemons);
use lib qw(e:\lib\perl);
use Getopt::Long;
use Data::Dumper;
use Win32::Daemon::Simple;
use Win32::Daemon::Go2;
use Win32::EventLog::Carp;
use strict;
use warnings;
my ($install, $remove, $manual);
GetOptions('install' => \$install, 'remove' => \$remove, 'manual' => \
+$manual);
my $daemon = new Win32::Daemon::Go2(
name => 'go2_installer',
display => 'Go2 installer',
description => 'This will create the go2 batch file',
);
if ($install) {
$daemon->install()
} elsif ($remove) {
$daemon->remove()
} elsif ($manual) {
print "Running body\n";
$daemon->body()
} else {
$daemon->run()
};
exit;
Win32::Daemon::SimpleA utility class I wrote that encapsulates the examples provided by Roth Consulting
package Win32::Daemon::Simple;
use Data::Dumper;
use Win32;
use Win32::Daemon;
use Win32::EventLog::Carp;
use Module::Reload;
use strict;
use warnings;
sub new {
my $type = shift;
my $self = bless {}, ref($type) || $type;
$self->_init(@_);
$self;
}
sub _init {
my $self = shift;
my %params = @_;
$self->getServiceInfo(%params);
# Stuff the user can override
$self->{sleepTime} = $params{sleepTime} || 50; # 50 Milliseconds;
# Stuff that we use internally
$self->{prevState} = undef;
}
sub run {
my $self = shift;
my ($state, $message);
#Win32::Daemon::AcceptedControls(SERVICE_ACCEPT_STOP | SERVICE_ACC
+EPT_PAUSE_CONTINUE | SERVICE_ACCEPT_SHUTDOWN);
$self->{prevState} = SERVICE_START_PENDING;
Win32::Daemon::StartService();
while( SERVICE_STOPPED != ( $state = Win32::Daemon::State() ) )
{
croak "Forced Stop" if (-e 'E:\commands\Daemons\stop.dat');
Module::Reload->check();
if ($state == SERVICE_START_PENDING) { $self->_startPending()
+ }
elsif ($state == SERVICE_STOP_PENDING) { $self->_stopPending()
+ }
elsif ($state == SERVICE_PAUSE_PENDING) { $self->_pausePending
+(); next }
elsif ($state == SERVICE_CONTINUE_PENDING) { $self->_continueP
+ending(); next }
elsif ($state == SERVICE_RUNNING) { $self->body }
else {$self->_unhandledMessage()};
if (SERVICE_CONTROL_NONE != ($message = Win32::Daemon::QueryLa
+stMessage( 1 )) ) {
$self->_controlInterrogate() if ($message == SERVICE_CONTR
+OL_INTERROGATE);
$self->_controlShutdown() if ($message == SERVICE_CONTROL_
+SHUTDOWN);
}
Win32::Sleep( $self->{sleepTime} );
}
Win32::Daemon::StopService();
}
sub body {
Win32::EventLog::Carp::click('Abstract Base Class body called');
}
sub _startPending { # Initialization code
Win32::Daemon::State( SERVICE_RUNNING );
$_[0]->{prevState} = SERVICE_RUNNING;
}
sub _stopPending { # "Stopping...";
Win32::Daemon::State( SERVICE_STOPPED );
$_[0]->{prevState} = SERVICE_STOPPED;
}
sub _pausePending { # "Pausing...";
Win32::Daemon::State( SERVICE_PAUSED );
$_[0]->{prevState} = SERVICE_PAUSED;
}
sub _continuePending { # "Resuming...";
Win32::Daemon::State( SERVICE_RUNNING );
$_[0]->{prevState} = SERVICE_RUNNING;
}
sub _controlInterrogate {
# Got here if the Service Control Manager is requesting
# the current state of the service. This can happen for
# a variety of reasons. Report the last state we set.
my $self = shift;
Win32::Daemon::State( $self->{prevState} );
}
sub _controlShutdown {
# Yikes! The system is shutting down. We had better clean up
# and stop.
# Tell the SCM that we are preparing to shutdown and that we expec
+t
# it to take 25 seconds (so don't terminate us for at least 25 sec
+onds)...
Win32::Daemon::State( SERVICE_STOP_PENDING, 25000 );
}
sub _unhandledMessage {
Win32::Daemon::State( $_[0]->{prevState} );
}
sub getServiceInfo {
my $self = shift;
my %params = @_;
my $this = ($self->{serviceInfo} ||= {});
return %$this if (keys(%$this));
for (qw[machine name display path user pwd description parameters]
+) {
$this->{$_} = $params{$_};
}
croak "Service Name required" unless $this->{name};
$this->{machine} ||= '';
$this->{display} ||= $self->{name};
$this->{path} ||= $^X;
$this->{user} ||= '';
$this->{pwd} ||= '';
$this->{description} ||= $0;
$this->{parameters} ||= $0;
%$this;
}
sub install {
my $self = shift;
print Dumper($self->{serviceInfo});
if( Win32::Daemon::CreateService( $self->{serviceInfo} ) ) {
print "Successfully added.\n";
} else {
print "Failed to add service: " . Win32::FormatMessage( Win32:
+:Daemon::GetLastError() ) . "\n";
}
}
sub remove {
my $self = shift;
my $serviceName = $self->{serviceInfo}{name};
if ( Win32::Daemon::DeleteService($serviceName)) {
print "Successfully removed '$serviceName'.\n";
} else {
print "Error: ";
print Win32::Daemon::GetLastError();
}
}
1;
Win32::Daemon::Go2The actual body of the service. This is called by Win32::Daemon::Simple each time through the loop.
package Win32::Daemon::Go2;
use Win32::Daemon::Simple;
@ISA = qw(Win32::Daemon::Simple);
use strict;
use warnings;
use File::stat;
my $datafile = 'e:\\Commands\\go2.dat';
my $outfile = 'e:\\Commands\\go2.bat';
sub body {
my $self = shift;
return unless (-e $datafile);
$self->{last_mod} ||= 0;
my $sb = stat($datafile);
if ($self->{last_mod} != $sb->mtime) {
$self->{last_mod} = $sb->mtime;
my %batch;
open(INPUT, $datafile);
while (my $target = <INPUT>) {
chomp($target);
my ($label, $dest) = split('~', $target, 2);
$label =~ s/\s/_/g;
$dest =~ s{/}{\\}g;
my ($drive, @path) = split(/\\/, $dest);
$batch{$label} = {
drive => lc $drive,
path => \@path,
}
};
open(OUTPUT, ">$outfile") or croak $@;
local $\ = "\n";
print OUTPUT '@echo off';
print OUTPUT 'if "" == "%1" (';
print OUTPUT "\techo \t$_" for sort(grep !/^!/, keys(%batch));
print OUTPUT "\tgoto EOF";
print OUTPUT ')';
for my $label (reverse sort keys(%batch)) {
if ($label =~ /^!/) {
print OUTPUT join('', 'if "', $label, '" == "%1" (');
print OUTPUT "\tpushd ", join('\\', $batch{$label}{dri
+ve}, @{$batch{$label}{path}}, '%2');
print OUTPUT "\tcmd /k";
print OUTPUT "\tpopd";
print OUTPUT "\tcls";
print OUTPUT "\tgoto EOF";
print OUTPUT ')';
} else {
print OUTPUT join('', 'if "', $label, '" == "%1" (');
print OUTPUT "\t", $batch{$label}{drive};
print OUTPUT "\tcd \\", join('\\', @{$batch{$label}{pa
+th}}, '%2');
print OUTPUT "\tgoto EOF";
print OUTPUT ')';
};
};
print OUTPUT 'echo Destination not found: %*';
print OUTPUT 'echo Try editing E:\command\go2.dat';
print OUTPUT ':EOF';
close(OUTPUT);
}
}
1;
| 