in reply to Re^2: Perl script as windows service
in thread Perl script as windows service

Yes. Looks like. But I think he did not catch the Win32::Daemon idea. For this reason, I paste the following snippet. I tested it. It works fine on a win32 even though it does nothing!. Here, the runService method is the processor, called every five seconds.

#!/usr/bin/perl

$| = 1;

use strict;
use Getopt::Long;

use Win32;
use Win32::Daemon;

my %opt;
GetOptions (
    \%opt,
    "run",
    "install",
    "remove",
    "start",
    "stop",
    "restart",
    "pause",
    "resume|continue",
);

my @currDir = split /\//, $0;
my $script = $0;
my $scriptPath = ".";

if (scalar @currDir > 1)
{
    $script = pop @currDir;
    $scriptPath = join "/", @currDir;
    chdir( $scriptPath );
}

my %serviceConfig = (

    name            => 'mytest',
    display         => 'mytest',
    description     => 'this is my test description',
    machine         => '',
    path            => $^X,
    parameters      => ( sprintf '"e:/dia/temp/service.pl" --run',
                             $scriptPath,
                             $script ),
    start_type => SERVICE_AUTO_START,
);

Win32::Daemon::RegisterCallbacks(
    {
        start    => \&startService,
        stop     => \&stopService,
        pause    => \&pauseService,
        continue => \&continueService,
        running  => \&runService,
    }
);

# ====================================================================
+==========
# main
# ====================================================================
+==========

if( $opt { install } )
{
    &installService();
    exit();
}
elsif( $opt { remove } )
{
    &removeService();
    exit();
}
elsif( $opt { status } )
{
    &serviceStatus();
    exit();
}
elsif( $opt { run } )
{
    my %context = {
        last_state => SERVICE_STOPPED,
        count      => 0,
        start_time => time(),
    };
    Win32::Daemon::StartService( \%context, 5000 );
}
elsif( $opt { start } )
{
    my $cmd = sprintf 'net start %s', $serviceConfig { name };
    system( $cmd );
    exit();
}
elsif( $opt { stop } )
{
    my $cmd = sprintf 'net stop %s', $serviceConfig { name };
    system( $cmd );
    exit();
}
elsif( $opt { pause } )
{
    my $cmd = sprintf 'net pause %s', $serviceConfig { name };
    system( $cmd );
    exit();
}
elsif( $opt { resume } )
{
    my $cmd = sprintf 'net continue %s', $serviceConfig { name };
    system( $cmd );
    exit();
}
elsif( $opt { restart } )
{
    my $cmd = sprintf 'net stop %s', $serviceConfig { name };
    system( $cmd );
    $cmd = sprintf 'net start %s', $serviceConfig { name };
    system( $cmd );
    exit();
}
else
{
    die "Nothing to do\n";
}

# ====================================================================
+==========
# SERVICE SETUP
# ====================================================================
+==========

sub installService
{
    # installs the win32 service daemon
    # ---------------------------------
    if( Win32::Daemon::CreateService( \%serviceConfig ) )
    {
        &debug( 'The service [%s] was successfully installed', $servic
+eConfig { display } );
    }
    else
    {
        &debug( 'Failed to install the service [%s]: %s',
            $serviceConfig { display },
            GetError() );
    }
}

# ====================================================================
+==========

sub removeService
{
    # removes the win32 service daemon
    # --------------------------------
    if( Win32::Daemon::DeleteService( $serviceConfig { name } ) )
    {
        &debug( 'The service [%s] was successfully removed', $serviceC
+onfig { display } );
    }
    else
    {
        &debug( 'Failed to remove the service [%s]: %s',
            $serviceConfig { display },
            GetError() );
    }
}

# ====================================================================
+==========
# CALLBACK ROUTINES
# ====================================================================
+==========

sub startService
{
    # start the win32 service daemon
    # ------------------------------
    my ($event, $context) = @_;

    $context -> { last_state } = SERVICE_RUNNING;
    Win32::Daemon::State( SERVICE_START_PENDING, 30000 );

    &debug( 'Starting the service' );

    # let's go
    Win32::Daemon::State( SERVICE_RUNNING );
}

# ====================================================================
+==========

sub stopService
{
    # stop the win32 service daemon
    # -----------------------------
    my ($event, $context) = @_;
    $context -> { last_state } = SERVICE_STOPPED;
    Win32::Daemon::State( SERVICE_STOP_PENDING, 30000 );

    &debug( 'Stopping the service' );

    Win32::Daemon::State( SERVICE_STOPPED );
    Win32::Daemon::StopService();
}

# ====================================================================
+==========

sub pauseService
{
    # let the win32 service daemon make a pause
    # -----------------------------------------
    my ($event, $context) = @_;
    &debug( 'Pausing the service' );
    $context -> { last_state } = SERVICE_PAUSED;
    Win32::Daemon::State( SERVICE_PAUSED );
}

# ====================================================================
+==========

sub continueService
{
    # let the win32 service daemon exit a pause
    # -----------------------------------------
    my ($event, $context) = @_;
    &debug( 'Resuming the service' );
    $context -> { last_state } = SERVICE_RUNNING;
    Win32::Daemon::State( SERVICE_RUNNING );
}

# ====================================================================
+==========

sub runService
{
    # this is the callback of by the win32 service daemon
    # ---------------------------------------------------
    my ($event, $context) = @_;

    if ( Win32::Daemon::State() == SERVICE_RUNNING )
    {
        # count the number of calls (I do not know why)
        $context -> { count }++;
    }
}

sub debug
{
    my ($fmt, @data) = @_;
    my $message = sprintf $fmt, @data;
    open( FILE, ">>e:/dia/temp/service.log" );
    print FILE "$message\n";
    close( FILE );
    if (-t STDOUT && -t STDIN)
    {
        print "$message\n";
    }

}

# ====================================================================
+==========

sub GetError
{
    # returns win32 daemon errors
    # ---------------------------
    return( Win32::FormatMessage( Win32::Daemon::GetLastError() ) );
}

# ====================================================================
+==========

__END__

[download]

Replies are listed 'Best First'.
Re^4: Perl script as windows service
by rockets12345 (Novice) on Mar 09, 2005 at 20:30 UTC
    Please excuse me as I am new to perl and still struggling to grasp some ideas and need your help. I tried running the above example it doesn't give any error and ran fine but everytime I try to run it from the commandline it executes the following: 
    else
{
    die "Nothing to do\n";
}

    [download]
    and no service is created. Is there any parameter needs to pass while running the script. And what exactly is the following for: 
    my %opt;
GetOptions (
    \%opt,
    "run",
    "install",
    "remove",
    "start",
    "stop",
    "restart",
    "pause",
    "resume|continue",
);

    [download]
    What exactly is GetOptions for. I tried to modify thie above scripty and put the following code in the else part: 
    else
{
    #die "Nothing to do\n";
    &removeService();
    &installService();
    my $cmd = 'net start $serviceConfig{name}';
    my $results = `$cmd`;
    if($!)
    {
    &debug("Net Start returned error: $@\n" . $results);
    die "ERROR";
    }
    #don't know what is this for
    my %context = {
        last_state => SERVICE_STOPPED,
        count      => 0,
        start_time => time(),
    };
    Win32::Daemon::StartService( \%context, 3000 );
    exit();
}

    [download]
    now I run the script and service gets created and can start,stop,resume etc.. the service under services. I don't if it's the right way. Any comments will be really appeciated. Thanks
[reply]
[d/l]
[select]
      Please see my comments below. 
      001 | #!/usr/bin/perl
002 |
003 | $| = 1;
004 |
005 | use strict;
006 | use Getopt::Long;
007 |
008 | use Win32;
009 | use Win32::Daemon;
010 |
011 | my %opt;
012 | GetOptions (
013 |     \%opt,
014 |     "run",
015 |     "install",
016 |     "remove",
017 |     "start",
018 |     "stop",
019 |     "restart",
020 |     "pause",
021 |     "resume|continue",
022 | );

    See Getopt::Long module, start with `perldoc Getopt::Long`
    Use the options with

    `perl service.pl --install`
    `perl service.pl --start`

    Then, be happy with your service.
    Boring, hee? So, stop and remove the service with

    `perl service.pl --stop`
    `perl service.pl --remove`

    That's what this GetOptions thing is about.

023 |
024 | my @currDir = split /\//, $0;
025 | my $script = $0;
026 | my $scriptPath = ".";
027 |
028 | if (scalar @currDir > 1)
029 | {
030 |     $script = pop @currDir;
031 |     $scriptPath = join "/", @currDir;
032 |     chdir( $scriptPath );
033 | }

    The above staff is used to chdir to the script's directory.
    This can be derived from $0 if started with something like

    `perl c:/path/to/my/servce/servce.pl`

    servce.pl is poped away from c:/path/to/my/servce/servce.pl
    and @currDir == ( 'c:', 'path', 'to', 'my', 'servce' )
    is joined with a "/" to $scriptPath.

034 |
035 | my %serviceConfig = (
036 |
037 |     name            => 'mytest',
038 |     display         => 'mytest',
039 |     description     => 'this is my test description',
040 |     machine         => '',
041 |     path            => $^X,
042 |     parameters      => ( sprintf '"e:/dia/temp/service.pl" --run
+',
043 |                              $scriptPath,
044 |                              $script ),
045 |     start_type => SERVICE_AUTO_START,
046 | );
047 |

    We talked about this.

048 | Win32::Daemon::RegisterCallbacks(
049 |     {
050 |         start    => \&startService,
051 |         stop     => \&stopService,
052 |         pause    => \&pauseService,
053 |         continue => \&continueService,
054 |         running  => \&runService,
055 |     }
056 | );
057 |
058 | # ==============================================================
+================
059 | # main
060 | # ==============================================================
+================

    What follows is the processing of the GetOptions results.

061 |
062 | if( $opt { install } )
063 | {
064 |     &installService();
065 |     exit();
066 | }
067 | elsif( $opt { remove } )
068 | {
069 |     &removeService();
070 |     exit();
071 | }
072 | elsif( $opt { status } )
073 | {
074 |     &serviceStatus();
075 |     exit();
076 | }
077 | elsif( $opt { run } )
078 | {
079 |     my %context = {
080 |         last_state => SERVICE_STOPPED,
081 |         count      => 0,
082 |         start_time => time(),
083 |     };
084 |     Win32::Daemon::StartService( \%context, 5000 );
085 | }
086 | elsif( $opt { start } )
087 | {
088 |     my $cmd = sprintf 'net start %s', $serviceConfig { name };
089 |     system( $cmd );
090 |     exit();
091 | }
092 | elsif( $opt { stop } )
093 | {
094 |     my $cmd = sprintf 'net stop %s', $serviceConfig { name };
095 |     system( $cmd );
096 |     exit();
097 | }
098 | elsif( $opt { pause } )
099 | {
100 |     my $cmd = sprintf 'net pause %s', $serviceConfig { name };
101 |     system( $cmd );
102 |     exit();
103 | }
104 | elsif( $opt { resume } )
105 | {
106 |     my $cmd = sprintf 'net continue %s', $serviceConfig { name }
+;
107 |     system( $cmd );
108 |     exit();
109 | }
110 | elsif( $opt { restart } )
111 | {
112 |     my $cmd = sprintf 'net stop %s', $serviceConfig { name };
113 |     system( $cmd );
114 |     $cmd = sprintf 'net start %s', $serviceConfig { name };
115 |     system( $cmd );
116 |     exit();
117 | }
118 | else
119 | {
120 |     die "Nothing to do\n";
121 | }

    What follows are the modularized routines triggered by the
    above GetOptions cases.

122 |
123 | # ==============================================================
+================
124 | # SERVICE SETUP
125 | # ==============================================================
+================
126 |
127 | sub installService
128 | {
129 |     # installs the win32 service daemon
130 |     # ---------------------------------
131 |     if( Win32::Daemon::CreateService( \%serviceConfig ) )
132 |     {
133 |         &debug( 'The service [%s] was successfully installed', $
+serviceConfig { display } );
134 |     }
135 |     else
136 |     {
137 |         &debug( 'Failed to install the service [%s]: %s',
138 |             $serviceConfig { display },
139 |             GetError() );
140 |     }
141 | }
142 |
143 | # ==============================================================
+================
144 |
145 | sub removeService
146 | {
147 |     # removes the win32 service daemon
148 |     # --------------------------------
149 |     if( Win32::Daemon::DeleteService( $serviceConfig { name } ) 
+)
150 |     {
151 |         &debug( 'The service [%s] was successfully removed', $se
+rviceConfig { display } );
152 |     }
153 |     else
154 |     {
155 |         &debug( 'Failed to remove the service [%s]: %s',
156 |             $serviceConfig { display },
157 |             GetError() );
158 |     }
159 | }
160 |
161 | # ==============================================================
+================
162 | # CALLBACK ROUTINES
163 | # ==============================================================
+================
164 |
165 | sub startService
166 | {
167 |     # start the win32 service daemon
168 |     # ------------------------------
169 |     my ($event, $context) = @_;
170 |
171 |     $context -> { last_state } = SERVICE_RUNNING;
172 |     Win32::Daemon::State( SERVICE_START_PENDING, 30000 );
173 |
174 |     &debug( 'Starting the service' );
175 |
176 |     # let's go
177 |     Win32::Daemon::State( SERVICE_RUNNING );
178 | }
179 |
180 | # ==============================================================
+================
181 |
182 | sub stopService
183 | {
184 |     # stop the win32 service daemon
185 |     # -----------------------------
186 |     my ($event, $context) = @_;
187 |     $context -> { last_state } = SERVICE_STOPPED;
188 |     Win32::Daemon::State( SERVICE_STOP_PENDING, 30000 );
189 |
190 |     &debug( 'Stopping the service' );
191 |
192 |     Win32::Daemon::State( SERVICE_STOPPED );
193 |     Win32::Daemon::StopService();
194 | }
195 |
196 | # ==============================================================
+================
197 |
198 | sub pauseService
199 | {
200 |     # let the win32 service daemon make a pause
201 |     # -----------------------------------------
202 |     my ($event, $context) = @_;
203 |     &debug( 'Pausing the service' );
204 |     $context -> { last_state } = SERVICE_PAUSED;
205 |     Win32::Daemon::State( SERVICE_PAUSED );
206 | }
207 |
208 | # ==============================================================
+================
209 |
210 | sub continueService
211 | {
212 |     # let the win32 service daemon exit a pause
213 |     # -----------------------------------------
214 |     my ($event, $context) = @_;
215 |     &debug( 'Resuming the service' );
216 |     $context -> { last_state } = SERVICE_RUNNING;
217 |     Win32::Daemon::State( SERVICE_RUNNING );
218 | }
219 |
220 | # ==============================================================
+================
221 |
222 | sub runService
223 | {
224 |     # this is the callback of by the win32 service daemon
225 |     # ---------------------------------------------------
226 |     my ($event, $context) = @_;
227 |
228 |     if ( Win32::Daemon::State() == SERVICE_RUNNING )
229 |     {
230 |         # count the number of calls (I do not know why)
231 |         $context -> { count }++;
232 |     }
233 | }
234 |
235 | sub debug
236 | {
237 |     my ($fmt, @data) = @_;
238 |     my $message = sprintf $fmt, @data;
239 |     open( FILE, ">>e:/dia/temp/service.log" );
240 |     print FILE "$message\n";
241 |     close( FILE );
242 |     if (-t STDOUT && -t STDIN)
243 |     {
244 |         print "$message\n";
245 |     }
246 |
247 | }
248 |
249 | # ==============================================================
+================
250 |
251 | sub GetError
252 | {
253 |     # returns win32 daemon errors
254 |     # ---------------------------
255 |     return( Win32::FormatMessage( Win32::Daemon::GetLastError() 
+) );
256 | }
257 |
258 | # ==============================================================
+================
259 |
260 | __END__
261 |

      [download]
[reply]
[d/l]
Re^4: Perl script as windows service
by polettix (Vicar) on Oct 11, 2005 at 17:07 UTC
    Thank you for the example. I would propose a little modification.

    The code to make the call directory-independent could be improved using modules File::Basename and Cwd:

    use Cwd;
use File::Basename;
my $scriptPath = File::Basename::dirname($0);
chdir($scriptPath) if $scriptPath;
$scriptPath = Cwd::getcwd();
my $script = File::Basename::basename($0);

my %serviceConfig = (

    name            => 'mytest',
    display         => 'mytest',
    description     => 'this is my test description',
    machine         => '',
    path            => $^X,
    parameters      => qq{"$scriptPath/$script" --run},
    start_type      => SERVICE_AUTO_START,
);

    [download]
    The old code with sprintf did not work because you forgot to put the placeholders :)

    Thank you again,

    Flavio
    perl -ple'$_=reverse' <<<ti.xittelop@oivalf

    Don't fool yourself.
[reply]
[d/l]
[select]
Re^4: Perl script as windows service
by rockets12345 (Novice) on Mar 09, 2005 at 07:58 UTC
    can someone explain the purpose of the following and how is it being utilized in the code:
    parameters => ( sprintf '"e:/dia/temp/service.pl" --run', $scriptPath, $script ),
    start_type => SERVICE_AUTO_START,
[reply]
      Installing a service tells win32 where to find the executable. The executable is actualle Perl. Therefore this $^X. The script that actually implements the service is a parameter to Perl. The code implements service.pl as the service controller: it is capable of installing, removing, starting etc. the script. Furthermore, service.pl is the service itself if it is invoked with the --run parmater. The code 
      parameters => ( sprintf '"e:/dia/temp/service.pl" --run', $scriptPath,
+ $script ),

      [download]
      is actually misleading, because the path and script are hard-coded. Hence, you can write it as 
      parameters => '"e:/dia/temp/service.pl" --run'

      [download]
      The start_type tells the win32 service manager to automatically start-up the script. This means, no user must be logged in. This latter thing is actually one of the main reasons to use services on win32.
[reply]
[d/l]
[select]

In Section Seekers of Perl Wisdom