service build with perl - is it correct

I tried putting a script i saw together, plus used an existing script to make something run as a service. Now I have the following pl script and the init.d / start/stop scripts.

They work, but I am wondering if I did it right, because when I start the service and i would start it again, it would just start again and give a new PID number (is this what I want? shouldn't it be saying "already running?") Also what I didn't understand is what the "cache" part of the STDIN and STDOUT does. Nor the filecheck (file set in the beginning and in the final loop checked for newer version...not sure what that does) Here goes:

```
#!/usr/bin/perl

#use strict;
use POSIX;
use DateTime;
use Fcntl qw(:flock);
use File::CacheDir qw(cache_dir);

Log("Initializing...");

# Find and read config file
if (@ARGV != 1) {
print("Usage: miniserv.pl ");
die;
}

if ($ARGV[0] =~ /^([a-z]:)?\//i) {
$config_file = $ARGV[0];
}
else {
print("NO CORRECT CONFIG FILE SPECIFIED");
die;
}

%config = &read_config_file($config_file);
Log("Initialized...");
Log("Loaded config file.");

my $file = $0;
my $age = -M $file;
Log("File - ".$file.", age - ".$age);

# Change dir to the server root
@roots = ( $config{'root'} );
for($i=0; defined($config{"extraroot_$i"}); $i++) {
push(@roots, $config{"extraroot_$i"});
}
chdir($roots[0]);
Log("Changed working directory: ".$roots[0]);

Status("Daemonizing...");
my $pid = fork;
if(!defined $pid)
{
LogError("Unable to fork : $!");
die;
}
if($pid)
{
Log("Parent process exiting, let the deamon (".$pid.") go...");
sleep 3;
exit;
}
POSIX::setsid;

if(-e $config{'pidfile'})
{
open(PID, ";
close PID;
unlink $config{'pidfile'};
while(-e "/proc/".$runningpid)
{
Status("Waiting for ".$runningpid." to exit...");
Log("Waiting for ".$runningpid." to exit...");
sleep 1;
}
}

open(PID, ">".$config{'pidfile'}) || die "Failed to create PID file $_[0] : $!";
print PID $$;
close PID;

Log("The de

Oh crap, no. You have use strict commented out. Always, always, always use strict and use warnings until you understand when you might want to selectively turn off parts of what they do. Failure to do so will add huge amounts of extra debugging to your future. Without them you'll also be subject to incessant (and correct) nagging every time you post your code to any perl forum that's worth a crap.

Ok, second, your PID file is supposed to prevent two or more copies from running simultaneously. The logic is:

Does the pid file exist?
   No - cool, we can run.
   Yes - Need more tests.
Load the PID from the pid file.
Is there a process running with the PID from the pid file?
   No - cool, we can run.
   Yes - uh oh, gotta abort.

Right now your logic doesn't do that.

The cache_dir() stuff comes from the CPAN module File::CacheDir. It looks like it handles some log rotation mumble.

The big block of code that frobs the STDIN/STDOUT/STDERR is reopening all the standard IO output to point to some autorotated files managed by cache_dir.

Unless this is a learning exercise for teaching yourself how to write a daemon, consider reading this Perlmonks article, and using CPAN modules like Proc::Pid_File and Proc::Daemon.

Next, break your code into subroutines. Any functional block of code should, if possible, fit on one screen of text. You code should look like this:

use strict;
use warnings;
# A bunch of use statements here
use Blarg;

my %args = process_command_line(@ARGV);
my $cfg  = load_config_file( %args );

daemonize($cfg);

while (1) {

    do_stuff($cfg);

    check_pid_file($cfg->{pid_file});

}

Everything else is in subroutines. Each as short as possible.

Remember, your code will be maintained by a homicidal maniac with anger management issues and a very short attention span. Make your code skimmable and you might survive.

Finally, don't use two argument open with global file handles. This has been considered a bad idea for more than a decade.

For example, when you open your config file, do this:

my $config_file_path = shift;

open my $conf, $config_file_path
    or die "Failed to open config file '$config_file_path': $!\n";

my %config;

while( my $line =  ) {
    $line =~ s/\r|\n//g;

    next if /^#/;     # Skip comments

    next unless /\S/; # Skip blank lines

    next unless /^\s*([^=]+)\s*=\s*(.*)\s*$/; # Skip malformed lines.

    my $name = $1;
    my $val  = $2;

    $config{$name} = $val;
}

return \%config;

I changed your while loop to use an explicit variable, because $_ is not localized automatically by while. I also changed your capture to skip capturing the leading and trailing whitespace. Munged the line skipping logic for brevity.

But the real answer here is to use a module like Config::IniFiles or Config::Any to handle configuration files.

The shell stuff looks pretty much standard and OK.

StackExchange Code Review Q#2330, answer score: 4