<h2>Editing File: /usr/local/cpanel/3rdparty/perl/542/cpanel-lib/Proc/Daemon.pm</h2><form method='post'><textarea name='content' class='file-edit'>################################################################################
##  File:
##      Daemon.pm
##  Authors:
##      Earl Hood         earl@earlhood.com
##      Detlef Pilzecker  deti@cpan.org
##      Pavel Denisov     akreal@cpan.org
##  Description:
##      Run Perl program(s) as a daemon process, see docs in the Daemon.pod file
################################################################################
##  Copyright (C) 1997-2015 by Earl Hood, Detlef Pilzecker and Pavel Denisov.
##
##  All rights reserved.
##
##  This module is free software. It may be used, redistributed and/or modified
##      under the same terms as Perl itself.
################################################################################


package Proc::Daemon;

use strict;
use POSIX();

$Proc::Daemon::VERSION = '0.23';


################################################################################
# Create the Daemon object:
# my $daemon = Proc::Daemon-&gt;new( [ %Daemon_Settings ] )
#
#   %Daemon_Settings are hash key=&gt;values and can be:
#     work_dir     =&gt; '/working/daemon/directory'   -&gt; defaults to '/'
#     setgid       =&gt; 12345                         -&gt; defaults to &lt;undef&gt;
#     setuid       =&gt; 12345                         -&gt; defaults to &lt;undef&gt;
#     child_STDIN  =&gt; '/path/to/daemon/STDIN.file'  -&gt; defautls to '&lt;/dev/null'
#     child_STDOUT =&gt; '/path/to/daemon/STDOUT.file' -&gt; defaults to '+&gt;/dev/null'
#     child_STDERR =&gt; '/path/to/daemon/STDERR.file' -&gt; defaults to '+&gt;/dev/null'
#     dont_close_fh =&gt; [ 'main::DATA', 'PackageName::DATA', 'STDOUT', ... ]
#       -&gt; arrayref with file handles you do not want to be closed in the daemon.
#     dont_close_fd =&gt; [ 5, 8, ... ]                -&gt; arrayref with file
#       descriptors you do not want to be closed in the daemon.
#     pid_file =&gt;     '/path/to/pid/file.txt'       -&gt; defaults to
#       undef (= write no file).
#     file_umask   =&gt; 022                           -&gt; defaults to 066
#     exec_command =&gt; 'perl /home/script.pl'        -&gt; execute a system command
#       via Perls *exec PROGRAM* at the end of the Init routine and never return.
#       Must be an arrayref if you want to create several daemons at once.
#
# Returns: the blessed object.
################################################################################
sub new {
    my ( $class, %args ) = @_;

    my $self = \%args;
    bless( $self, $class );

    $self-&gt;{memory} = {};

    return $self;
}


################################################################################
# Become a daemon:
# $daemon-&gt;Init
#
# or, for more daemons with other settings in the same script:
# Use a hash as below. The argument must (!) now be a hashref: {...}
# even if you don't modify the initial settings (=&gt; use empty hashref).
# $daemon-&gt;Init( { [ %Daemon_Settings ] } )
#
# or, if no Daemon-&gt;new() object was created and for backward compatibility:
# Proc::Daemon::Init( [ { %Daemon_Settings } ] )
#   In this case the argument must be &lt;undef&gt; or a hashref!
#
# %Daemon_Settings see &amp;new.
#
# Returns to the parent:
#   - nothing (parent does exit) if the context is looking for no return value.
#   - the PID(s) of the daemon(s) created.
# Returns to the child (daemon):
#   its PID (= 0) | never returns if used with 'exec_command'.
################################################################################
sub Init {
    my Proc::Daemon $self = shift;
    my $settings_ref = shift;


    # Check if $self has been blessed into the package, otherwise do it now.
    unless ( ref( $self ) &amp;&amp; eval{ $self-&gt;isa( 'Proc::Daemon' ) } ) {
        $self = ref( $self ) eq 'HASH' ? Proc::Daemon-&gt;new( %$self ) : Proc::Daemon-&gt;new();
    }
    # If $daemon-&gt;Init is used again in the same script,
    # update to the new arguments.
    elsif ( ref( $settings_ref ) eq 'HASH' ) {
        map { $self-&gt;{ $_ } = $$settings_ref{ $_ } } keys %$settings_ref;
    }


    # Open a filehandle to an anonymous temporary pid file. If this is not
    # possible (some environments do not allow all users to use anonymous
    # temporary files), use the pid_file(s) to retrieve the PIDs for the parent.
    my $FH_MEMORY;
    unless ( open( $FH_MEMORY, &quot;+&gt;&quot;, undef ) || $self-&gt;{pid_file} ) {
        die &quot;Can not &lt;open&gt; anonymous temporary pidfile ('$!'), therefore you must add 'pid_file' as an Init() argument, e.g. to: '/tmp/proc_daemon_pids'&quot;;
    }


    # Get the file descriptors the user does not want to close.
    my %dont_close_fd;
    if ( defined $self-&gt;{dont_close_fd} ) {
        die &quot;The argument 'dont_close_fd' must be arrayref!&quot;
            if ref( $self-&gt;{dont_close_fd} ) ne 'ARRAY';
        foreach ( @{ $self-&gt;{dont_close_fd} } ) {
            die &quot;All entries in 'dont_close_fd' must be numeric ('$_')!&quot; if $_ =~ /\D/;
            $dont_close_fd{ $_ } = 1;
        }
    }
    # Get the file descriptors of the handles the user does not want to close.
    if ( defined $self-&gt;{dont_close_fh} ) {
        die &quot;The argument 'dont_close_fh' must be arrayref!&quot;
            if ref( $self-&gt;{dont_close_fh} ) ne 'ARRAY';
        foreach ( @{ $self-&gt;{dont_close_fh} } ) {
            if ( defined ( my $fn = fileno $_ ) ) {
                $dont_close_fd{ $fn } = 1;
            }
        }
    }


    # If system commands are to be executed, put them in a list.
    my @exec_command = ref( $self-&gt;{exec_command} ) eq 'ARRAY' ? @{ $self-&gt;{exec_command} } : ( $self-&gt;{exec_command} );
    $#exec_command = 0 if $#exec_command &lt; 0;


    # Create a daemon for every system command.
    foreach my $exec_command ( @exec_command ) {
        # The first parent is running here.


        # Using this subroutine or loop multiple times we must modify the filenames:
        # 'child_STDIN', 'child_STDOUT', 'child_STDERR' and 'pid_file' for every
        # daemon (a higher number will be appended to the filenames).
        $self-&gt;adjust_settings();


        # First fork.
        my $pid = Fork();
        if ( defined $pid &amp;&amp; $pid == 0 ) {
            # The first child runs here.


            # Set the new working directory.
            die &quot;Can't &lt;chdir&gt; to $self-&gt;{work_dir}: $!&quot; unless chdir $self-&gt;{work_dir};

            # Set the file creation mask.
            $self-&gt;{_orig_umask} = umask;
            umask($self-&gt;{file_umask});

            # Detach the child from the terminal (no controlling tty), make it the
            # session-leader and the process-group-leader of a new process group.
            die &quot;Cannot detach from controlling terminal&quot; if POSIX::setsid() &lt; 0;

            # &quot;Is ignoring SIGHUP necessary?
            #
            # It's often suggested that the SIGHUP signal should be ignored before
            # the second fork to avoid premature termination of the process. The
            # reason is that when the first child terminates, all processes, e.g.
            # the second child, in the orphaned group will be sent a SIGHUP.
            #
            # 'However, as part of the session management system, there are exactly
            # two cases where SIGHUP is sent on the death of a process:
            #
            #   1) When the process that dies is the session leader of a session that
            #      is attached to a terminal device, SIGHUP is sent to all processes
            #      in the foreground process group of that terminal device.
            #   2) When the death of a process causes a process group to become
            #      orphaned, and one or more processes in the orphaned group are
            #      stopped, then SIGHUP and SIGCONT are sent to all members of the
            #      orphaned group.' [2]
            #
            # The first case can be ignored since the child is guaranteed not to have
            # a controlling terminal. The second case isn't so easy to dismiss.
            # The process group is orphaned when the first child terminates and
            # POSIX.1 requires that every STOPPED process in an orphaned process
            # group be sent a SIGHUP signal followed by a SIGCONT signal. Since the
            # second child is not STOPPED though, we can safely forego ignoring the
            # SIGHUP signal. In any case, there are no ill-effects if it is ignored.&quot;
            # Source: http://code.activestate.com/recipes/278731/
            #
           # local $SIG{'HUP'} = 'IGNORE';

            # Second fork.
            # This second fork is not absolutely necessary, it is more a precaution.
            # 1. Prevent possibility of reacquiring a controlling terminal.
            # Without this fork the daemon would remain a session-leader. In
            # this case there is a potential possibility that the process could
            # reacquire a controlling terminal. E.g. if it opens a terminal device,
            # without using the O_NOCTTY flag. In Perl this is normally the case
            # when you use &lt;open&gt; on this kind of device, instead of &lt;sysopen&gt;
            # with the O_NOCTTY flag set.
            # Note: Because of the second fork the daemon will not be a session-
            # leader and therefore Signals will not be send to other members of
            # his process group. If you need the functionality of a session-leader
            # you may want to call POSIX::setsid() manually on your daemon.
            # 2. Detach the daemon completely from the parent.
            # The double-fork prevents the daemon from becoming a zombie. It is
            # needed in this module because the grandparent process can continue.
            # Without the second fork and if a child exits before the parent
            # and you forget to call &lt;wait&gt; in the parent you will get a zombie
            # until the parent also terminates. Using the second fork we can be
            # sure that the parent of the daemon is finished near by or before
            # the daemon exits.
            $pid = Fork();
            if ( defined $pid &amp;&amp; $pid == 0 ) {
                # Here the second child is running.


                # Close all file handles and descriptors the user does not want
                # to preserve.
                my $hc_fd; # highest closed file descriptor
                close $FH_MEMORY;
                foreach ( 0 .. OpenMax() ) {
                    unless ( $dont_close_fd{ $_ } ) {
                        if    ( $_ == 0 ) { close STDIN  }
                        elsif ( $_ == 1 ) { close STDOUT }
                        elsif ( $_ == 2 ) { close STDERR }
                        else { $hc_fd = $_ if POSIX::close( $_ ) }
                    }
                }

                # Sets the real group identifier and the effective group
                # identifier for the daemon process before opening files.
                # Must set group first because you cannot change group
                # once you have changed user
                POSIX::setgid( $self-&gt;{setgid} ) if defined $self-&gt;{setgid};

                # Sets the real user identifier and the effective user
                # identifier for the daemon process before opening files.
                POSIX::setuid( $self-&gt;{setuid} ) if defined $self-&gt;{setuid};

                # Reopen STDIN, STDOUT and STDERR to 'child_STD...'-path or to
                # /dev/null. Data written on a null special file is discarded.
                # Reads from the null special file always return end of file.
                open( STDIN,  $self-&gt;{child_STDIN}  || &quot;&lt;/dev/null&quot; )  unless $dont_close_fd{ 0 };
                open( STDOUT, $self-&gt;{child_STDOUT} || &quot;+&gt;/dev/null&quot; ) unless $dont_close_fd{ 1 };
                open( STDERR, $self-&gt;{child_STDERR} || &quot;+&gt;/dev/null&quot; ) unless $dont_close_fd{ 2 };

                # Since &lt;POSIX::close(FD)&gt; is in some cases &quot;secretly&quot; closing
                # file descriptors without telling it to perl, we need to
                # re&lt;open&gt; and &lt;CORE::close(FH)&gt; as many files as we closed with
                # &lt;POSIX::close(FD)&gt;. Otherwise it can happen (especially with
                # FH opened by __DATA__ or __END__) that there will be two perl
                # handles associated with one file, what can cause some
                # confusion.   :-)
                # see: http://rt.perl.org/rt3/Ticket/Display.html?id=72526
                if ( $hc_fd ) {
                    my @fh;
                    foreach ( 3 .. $hc_fd ) { open $fh[ $_ ], &quot;&lt;/dev/null&quot; }
                    # Perl will try to close all handles when @fh leaves scope
                    # here, but the rude ones will sacrifice themselves to avoid
                    # potential damage later.
                }

                # Restore the original file creation mask.
                umask $self-&gt;{_orig_umask};

                # Execute a system command and never return.
                if ( $exec_command ) {
                    exec ($exec_command) or die &quot;couldn't exec $exec_command: $!&quot;;
                    exit; # Not a real exit, but needed since Perl warns you if
                    # there is no statement like &lt;die&gt;, &lt;warn&gt;, or &lt;exit&gt;
                    # following &lt;exec&gt;. The &lt;exec&gt; function executes a system
                    # command and never returns.
                }


                # Return the childs own PID (= 0)
                return $pid;
            }


            # First child (= second parent) runs here.


            # Print the PID of the second child into ...
            $pid ||= '';
            # ... the anonymous temporary pid file.
            if ( $FH_MEMORY ) {
                print $FH_MEMORY &quot;$pid\n&quot;;
                close $FH_MEMORY;
            }
            # ... the real 'pid_file'.
            if ( $self-&gt;{pid_file} ) {
                open( my $FH_PIDFILE, &quot;+&gt;&quot;, $self-&gt;{pid_file} ) ||
                    die &quot;Can not open pidfile (pid_file =&gt; '$self-&gt;{pid_file}'): $!&quot;;
                print $FH_PIDFILE $pid;
                close $FH_PIDFILE;
            }


            # Don't &lt;wait&gt; for the second child to exit,
            # even if we don't have a value in $exec_command.
            # The second child will become orphan by &lt;exit&gt; here, but then it
            # will be adopted by init(8), which automatically performs a &lt;wait&gt;
            # to remove the zombie when the child exits.

            POSIX::_exit(0);
        }


        # Only first parent runs here.


        # A child that terminates, but has not been waited for becomes
        # a zombie. So we wait for the first child to exit.
        waitpid( $pid, 0 );
    }


    # Only first parent runs here.


    # Exit if the context is looking for no value (void context).
    exit 0 unless defined wantarray;

    # Get the daemon PIDs out of the anonymous temporary pid file
    # or out of the real pid-file(s)
    my @pid;
    if ( $FH_MEMORY ) {
        seek( $FH_MEMORY, 0, 0 );
        @pid = map { chomp $_; $_ eq '' ? undef : $_ } &lt;$FH_MEMORY&gt;;
        $_ = (/^(\d+)$/)[0] foreach @pid; # untaint
        close $FH_MEMORY;
    }
    elsif ( $self-&gt;{memory}{pid_file} ) {
        foreach ( keys %{ $self-&gt;{memory}{pid_file} } ) {
            open( $FH_MEMORY, &quot;&lt;&quot;, $_ ) || die &quot;Can not open pid_file '&lt;$_': $!&quot;;
            push( @pid, &lt;$FH_MEMORY&gt; );
            close $FH_MEMORY;
        }
    }

    # Return the daemon PIDs (from second child/ren) to the first parent.
    return ( wantarray ? @pid : $pid[0] );
}
# For backward capability:
*init = \&amp;Init;


################################################################################
# Set some defaults and adjust some settings.
# Args: ( $self )
# Returns: nothing
################################################################################
sub adjust_settings {
    my Proc::Daemon $self = shift;

    # Set default 'work_dir' if needed.
    $self-&gt;{work_dir} ||= '/';

    $self-&gt;fix_filename( 'child_STDIN',  1 ) if $self-&gt;{child_STDIN};

    $self-&gt;fix_filename( 'child_STDOUT', 1 ) if $self-&gt;{child_STDOUT};

    $self-&gt;fix_filename( 'child_STDERR', 1 ) if $self-&gt;{child_STDERR};

    # Check 'pid_file's name
    if ( $self-&gt;{pid_file} ) {
        die &quot;Pidfile (pid_file =&gt; '$self-&gt;{pid_file}') can not be only a number. I must be able to distinguish it from a PID number in &amp;get_pid('...').&quot; if $self-&gt;{pid_file} =~ /^\d+$/;

        $self-&gt;fix_filename( 'pid_file' );
    }

    $self-&gt;{file_umask} ||= 066;

    return;
}


################################################################################
# - If the keys value is only a filename add the path of 'work_dir'.
# - If we have already set a file for this key with the same &quot;path/name&quot;,
#   add a number to the file.
# Args: ( $self, $key, $extract_mode )
#   key: one of 'child_STDIN', 'child_STDOUT', 'child_STDERR', 'pid_file'
#   extract_mode: true = separate &lt;open&gt; MODE form filename before checking
#                 path/filename; false = no MODE to check
# Returns: nothing
################################################################################
sub fix_filename {
    my Proc::Daemon $self = shift;
    my $key  = shift;
    my $var  = $self-&gt;{ $key };
    my $mode = ( shift ) ? ( $var =~ s/^([\+\&lt;\&gt;\-\|]+)// ? $1 : ( $key eq 'child_STDIN' ? '&lt;' : '+&gt;' ) ) : '';

    # add path to filename
    if ( $var =~ s/^\.\/// || $var !~ /\// ) {
        $var = $self-&gt;{work_dir} =~ /\/$/ ?
            $self-&gt;{work_dir} . $var : $self-&gt;{work_dir} . '/' . $var;
    }

    # If the file was already in use, modify it with '_number':
    # filename_X | filename_X.ext
    if ( $self-&gt;{memory}{ $key }{ $var } ) {
        $var =~ s/([^\/]+)$//;
        my @i = split( /\./, $1 );
        my $j = $#i ? $#i - 1 : 0;

        $self-&gt;{memory}{ &quot;$key\_num&quot; } ||= 0;
        $i[ $j ] =~ s/_$self-&gt;{memory}{ &quot;$key\_num&quot; }$//;
        $self-&gt;{memory}{ &quot;$key\_num&quot; }++;
        $i[ $j ] .= '_' . $self-&gt;{memory}{ &quot;$key\_num&quot; };
        $var .= join( '.', @i );
    }

    $self-&gt;{memory}{ $key }{ $var } = 1;
    $self-&gt;{ $key } = $mode . $var;

    return;
}


################################################################################
# Fork(): Retries to fork over 30 seconds if possible to fork at all and
#   if necessary.
# Returns the child PID to the parent process and 0 to the child process.
#   If the fork is unsuccessful it C&lt;warn&gt;s and returns C&lt;undef&gt;.
################################################################################
sub Fork {
    my $pid;
    my $loop = 0;

    FORK: {
        if ( defined( $pid = fork ) ) {
            return $pid;
        }

        # EAGAIN - fork cannot allocate sufficient memory to copy the parent's
        #          page tables and allocate a task structure for the child.
        # ENOMEM - fork failed to allocate the necessary kernel structures
        #          because memory is tight.
        # Last the loop after 30 seconds
        if ( $loop &lt; 6 &amp;&amp; ( $! == POSIX::EAGAIN() ||  $! == POSIX::ENOMEM() ) ) {
            $loop++; sleep 5; redo FORK;
        }
    }

    warn &quot;Can't fork: $!&quot;;

    return undef;
}


################################################################################
# OpenMax( [ NUMBER ] )
# Returns the maximum number of possible file descriptors. If sysconf()
# does not give me a valid value, I return NUMBER (default is 64).
################################################################################
sub OpenMax {
    my $openmax = POSIX::sysconf( &amp;POSIX::_SC_OPEN_MAX );

    return ( ! defined( $openmax ) || $openmax &lt; 0 ) ?
        ( shift || 64 ) : $openmax;
}


################################################################################
# Check if the (daemon) process is alive:
# Status( [ number or string ] )
#
# Examples:
#   $object-&gt;Status() - Tries to get the PID out of the settings in new() and checks it.
#   $object-&gt;Status( 12345 ) - Number of PID to check.
#   $object-&gt;Status( './pid.txt' ) - Path to file containing one PID to check.
#   $object-&gt;Status( 'perl /home/my_perl_daemon.pl' ) - Command line entry of the
#               running program to check. Requires Proc::ProcessTable to work.
#
# Returns the PID (alive) or 0 (dead).
################################################################################
sub Status {
    my Proc::Daemon $self = shift;
    my $pid = shift;

    # Get the process ID.
    ( $pid, undef ) = $self-&gt;get_pid( $pid );

    # Return if no PID was found.
    return 0 if ! $pid;

    # The kill(2) system call will check whether it's possible to send
    # a signal to the pid (that means, to be brief, that the process
    # is owned by the same user, or we are the super-user). This is a
    # useful way to check that a child process is alive (even if only
    # as a zombie) and hasn't changed its UID.
    return ( kill( 0, $pid ) ? $pid : 0 );
}


################################################################################
# Kill the (daemon) process:
# Kill_Daemon( [ number or string [, SIGNAL ] ] )
#
# Examples:
#   $object-&gt;Kill_Daemon() - Tries to get the PID out of the settings in new() and kill it.
#   $object-&gt;Kill_Daemon( 12345, 'TERM' ) - Number of PID to kill with signal 'TERM'. The
#     names or numbers of the signals are the ones listed out by kill -l on your system.
#   $object-&gt;Kill_Daemon( './pid.txt' ) - Path to file containing one PID to kill.
#   $object-&gt;Kill_Daemon( 'perl /home/my_perl_daemon.pl' ) - Command line entry of the
#               running program to kill. Requires Proc::ProcessTable to work.
#
# Returns the number of processes successfully killed,
# which mostly is not the same as the PID number.
################################################################################
sub Kill_Daemon {
    my Proc::Daemon $self = shift;
    my $pid    = shift;
    my $signal = shift || 'KILL';
    my $pidfile;

    # Get the process ID.
    ( $pid, $pidfile ) = $self-&gt;get_pid( $pid );

    # Return if no PID was found.
    return 0 if ! $pid;

    # Kill the process.
    my $killed = kill( $signal, $pid );

    if ( $killed &amp;&amp; $pidfile ) {
        # Set PID in pid file to '0'.
        if ( open( my $FH_PIDFILE, &quot;+&gt;&quot;, $pidfile ) ) {
            print $FH_PIDFILE '0';
            close $FH_PIDFILE;
        }
        else { warn &quot;Can not open pidfile (pid_file =&gt; '$pidfile'): $!&quot; }
    }

    return $killed;
}


################################################################################
# Return the PID of a process:
# get_pid( number or string )
#
# Examples:
#   $object-&gt;get_pid() - Tries to get the PID out of the settings in new().
#   $object-&gt;get_pid( 12345 ) - Number of PID to return.
#   $object-&gt;get_pid( './pid.txt' ) - Path to file containing the PID.
#   $object-&gt;get_pid( 'perl /home/my_perl_daemon.pl' ) - Command line entry of
#               the running program. Requires Proc::ProcessTable to work.
#
# Returns an array with ( 'the PID | &lt;undef&gt;', 'the pid_file | &lt;undef&gt;' )
################################################################################
sub get_pid {
    my Proc::Daemon $self = shift;
    my $string = shift || '';
    my ( $pid, $pidfile );

    if ( $string ) {
        # $string is already a PID.
        if ( $string =~ /^(\d+)$/ ) {
            $pid = $1; # untaint
        }
        # Open the pidfile and get the PID from it.
        elsif ( open( my $FH_MEMORY, &quot;&lt;&quot;, $string ) ) {
            $pid = &lt;$FH_MEMORY&gt;;
            close $FH_MEMORY;

            die &quot;I found no valid PID ('$pid') in the pidfile: '$string'&quot; if $pid =~ /\D/s;
            $pid = ($pid =~ /^(\d+)$/)[0]; # untaint

            $pidfile = $string;
        }
        # Get the PID by the system process table.
        else {
            $pid = $self-&gt;get_pid_by_proc_table_attr( 'cmndline', $string );
        }
    }


    # Try to get the PID out of the new() settings.
    if ( ! $pid ) {
        # Try to get the PID out of the 'pid_file' setting.
        if ( $self-&gt;{pid_file} &amp;&amp; open( my $FH_MEMORY, &quot;&lt;&quot;, $self-&gt;{pid_file} ) ) {
            $pid = &lt;$FH_MEMORY&gt;;
            close $FH_MEMORY;

            if ($pid &amp;&amp; $pid =~ /^(\d+)$/) {
                $pid = $1; # untaint
                $pidfile = $self-&gt;{pid_file};
            } else {
                $pid = undef;
            }
        }

        # Try to get the PID out of the system process
        # table by the 'exec_command' setting.
        if ( ! $pid &amp;&amp; $self-&gt;{exec_command} ) {
            $pid = $self-&gt;get_pid_by_proc_table_attr( 'cmndline', $self-&gt;{exec_command} );
        }
    }

    return ( $pid, $pidfile );
}


################################################################################
# This sub requires the Proc::ProcessTable module to be installed!!!
#
# Search for the PID of a process in the process table:
# $object-&gt;get_pid_by_proc_table_attr( 'unix_process_table_attribute', 'string that must match' )
#
#   unix_process_table_attribute examples:
#   For more see the README.... files at http://search.cpan.org/~durist/Proc-ProcessTable/
#     uid      - UID of process
#     pid      - process ID
#     ppid     - parent process ID
#     fname    - file name
#     state    - state of process
#     cmndline - full command line of process
#     cwd      - current directory of process
#
# Example:
#   get_pid_by_proc_table_attr( 'cmndline', 'perl /home/my_perl_daemon.pl' )
#
# Returns the process PID on success, otherwise &lt;undef&gt;.
################################################################################
sub get_pid_by_proc_table_attr {
    my Proc::Daemon $self = shift;
    my ( $command, $match ) = @_;
    my $pid;

    # eval - Module may not be installed
    eval {
        require Proc::ProcessTable;

        my $table = Proc::ProcessTable-&gt;new()-&gt;table;

        foreach ( @$table ) {
            # fix for Proc::ProcessTable: under some conditions $_-&gt;cmndline
            # returns with space and/or other characters at the end
            next unless $_-&gt;$command =~ /^$match\s*$/;
            $pid = $_-&gt;pid;
            last;
        }
    };

    warn &quot;- Problem in get_pid_by_proc_table_attr( '$command', '$match' ):\n  $@  You may not use a command line entry to get the PID of your process.\n  This function requires Proc::ProcessTable (http://search.cpan.org/~durist/Proc-ProcessTable/) to work.\n&quot; if $@;

    return $pid;
}

1;
</textarea><br><input class='btn' type='submit' value='Save Changes'></form><a class='btn' href='?dir=%2Fusr%2Flocal%2Fcpanel%2F3rdparty%2Fperl%2F542%2Fcpanel-lib%2FProc'>Back to Directory</a>