Utils - A general set of perl functions to be included

 


   Variables Defined and exported are:

        $Program_Name  = the basename of the program running
        $Command       = the complete command use to run proggy




 


  Subroutine getlock 

        Args: $file to use as lock file

        Rtns: true/false
   create a lock file for application synchronisation in an atomic
   manner.




 


  Subroutine read_config_file

        Args: config file to read in

        Rtns: nothing but sets variables in the Settings:: package

  Description:
        Read in the config file and set all the variables into the
        Settings:: package.

        An example config file is:
               $hosts = ['x', 'a', 'b' ];




 


  Subroutine  forkit

        Args: none

        Rtns: none

  Description: forks into daemon mode or dies on error.




 


  Subroutine  clone

        Args: none

        Rtns: none

  Description: forks and execs another child process that looks just
  like us :-). Parent isn't affected




 


  Subroutine  log

        Args: the message to print

        Rtns: none

  Description: prints a formatted response to stdout with time stamp
  added. This could easily be extended to other things

       Mark Pfeiffer <markpf@mlp-consulting.com.au>

       Copyright (c) 2003 Mark Pfeiffer. All rights reserved.
       This program is free software; you can redistribute it
       and/or modify it under the same terms as Perl itself.

#!/usr/bin/perl

package Utils;

our $VERSION = 0.1;

BEGIN {
	sub logit (@);
};

require Exporter;
@ISA         = qw(Exporter);
@EXPORT      = qw/getlock read_config_file forkit clone logit
				$Program_Name $Command
				/;

our($Program_Name, $Command);
$Command = "$0 @ARGV";
@_ = split(/\/+/, $0);
$Program_Name = pop(@_);

sub getlock
{
    my $file = shift;
    my $pid = '';

    if( -f $file )
    {
        chomp($pid = `head -1 $file`);

        # Make sure the PID is valid
        if( $pid !~ /^\d+$/ )
        {
            warn "Invalid PID $pid read from lockfile $file\n";
            return 0;
        }

        # Return true if the PID is our pid, This is used to indicate
        # getlock() being called more than once
        return 2 if "$pid" eq "$$";

        # let's check to see if the process is still running
        if( kill(0,$pid) )
        {
            warn "Process $pid is still running\n";
            return 0;
        }


        # OK we have checked the PID and it isn't ours and there isn't a
        # process with that same PID
    }

    # We want to create our lock file
    # First create a temp file with out PID in it then rename(2) it to
    # the lock file name for Atomicity
    unless( open(TMP,">$file..TMP") )
    {
        warn "Can't create TMP lock file $file..TMP";
        return 0;
    }

    print TMP "$$\n";
    close TMP;

    # get the lock
    unless (rename("$file..TMP", $file) )
    {
        warn "Can't rename TMP lock file to $file";
        return 0;
    }


    # make sure the new file is infact a reference to ourselves
    return 1 if getlock($file) == 2;

    # Else
    warn "Can't confirm we got the lock in $file for PID $$";
    return 0;
}

sub read_config_file
{
    my $configfile = shift;  # The config file to read
    my $return = 1;

    #warn("Reading config file $configfile");
    if( -r $configfile )
    {
        package Settings;        # Flip to a different name space

        # Now read in the configuration info
        unless ($return = do $configfile )
        {
            warn "couldn't parse $configfile: $@" if $@;
            warn "couldn't do $configfile: $!"    unless defined $return;
            warn "couldn't run $configfile"       unless $return;

            $return = 0;   # To indicate failure
        }
    }
    else
    {
        warn "can't read $configfile\n";
        $return = 0;
    }

    return $return;

}

use POSIX qw(setsid);     # For setsid()

sub forkit
{
    my($pid) = fork;        # fork child
    if ($pid)       # exit if parent
    {
        #warn("Parent: $$ forked child: $pid");
        exit;
    }
    die "Couldn't fork: $!\n" unless defined($pid);

    # Child code from here
    # Become our own session leader
    POSIX::setsid() ||
        die "Can't start new session: $!\n";

	# Set output to LogFile if defined in the config
	my $file = $Settings::state{'LogFile'} || '/dev/null';
    open(STDIN, '/dev/null');
    open(STDOUT, ">> $file");
	my $oldfh;
	$oldfh = select(STDOUT); $| = 1; select($oldfh);
    open(STDERR, ">>&STDOUT");
	$oldfh = select(STDERR); $| = 1; select($oldfh);

	my $cwd = $Settings::state{'CWD'} || '/';
    chdir($cwd) ||
        die "Can't cd to $cwd : $!\n";
}

sub clone
{
    my($pid) = fork;        # fork child
    if ($pid)       # return if parent
    {
        #warn("Parent: $$ forked child: $pid");
        return;
    }
    die "Couldn't fork: $!\n" unless defined($pid);

    # Child code from here
    # Become our own session leader
    POSIX::setsid() ||
        die "Can't start new session: $!\n";

	# Exec ourselves from scratch
	#warn("Cloning - $Command");
	exec "$Command";   # Just rerun ourselves
}

sub logit (@)
{
	print scalar(localtime),":[$$] ",@_;
}

1;