Skip Menu |
 

This queue is for tickets about the Unix-PID-Tiny CPAN distribution.

Report information
The Basics
Id: 86817
Status: resolved
Priority: 0/
Queue: Unix-PID-Tiny

People
Owner: Nobody in particular
Requestors: dmuey [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: (no value)
Broken in: (no value)
Fixed in: (no value)



Subject: minor fixes
Download (untitled) / with headers
text/plain 1.9k
* init minimum_pid * quiet some uninit warnings when given wonky args * change CORE::kill so tests can mock kill @@ -17,12 +17,12 @@ sub new { $args_hr->{'ps_path'} = ''; } - return bless { 'ps_path' => $args_hr->{'ps_path'} }, $self; + return bless { 'ps_path' => $args_hr->{'ps_path'}, 'minimum_pid' => $args_hr->{'minimum_pid'} }, $self; } sub kill { my ( $self, $pid, $give_kill_a_chance) = @_; - $give_kill_a_chance = int $give_kill_a_chance; + $give_kill_a_chance = int $give_kill_a_chance if defined $give_kill_a_chance; $pid = int $pid; my $min = int $self->{'minimum_pid'}; if ( $pid < $min ) { @@ -38,10 +38,10 @@ sub kill { # RC from CORE::kill is not a boolean of if the PID was killed or not, only that it was signaled # so it is not an indicator of "success" in killing $pid - CORE::kill( 15, $pid ); # TERM - CORE::kill( 2, $pid ); # INT - CORE::kill( 1, $pid ); # HUP - CORE::kill( 9, $pid ); # KILL + kill( 15, $pid ); # TERM + kill( 2, $pid ); # INT + kill( 1, $pid ); # HUP + kill( 9, $pid ); # KILL # give kill() some time to take effect? if ($give_kill_a_chance) { @@ -55,7 +55,10 @@ sub kill { sub is_pid_running { my ( $self, $check_pid ) = @_; - return 1 if $> == 0 && CORE::kill(0, $check_pid); # if we are superuser we can avoid the the system call. For details see `perldoc -f kill` + $check_pid = int $check_pid; + return if !$check_pid || $check_pid < 0; + + return 1 if $> == 0 && kill(0, $check_pid); # if we are superuser we can avoid the the system call. For details see `perldoc -f kill` # If the proc filesystem is available, it's a good test. If not, continue on to system call return 1 if -e "/proc/$$" && -r "/proc/$$" && -r "/proc/$check_pid"; @@ -69,6 +72,9 @@ sub is_pid_running {
Download (untitled) / with headers
text/plain 1.2k
sub pid_info_hash { my ( $self, $pid ) = @_; + $pid = int $pid; + return if !$pid || $pid < 0; + my @outp = $self->_raw_ps( 'u', '-p', $pid ); chomp @outp; my %info; @@ -133,7 +141,7 @@ sub pid_file { } } - return 1 if $rc == 1; + return 1 if defined $rc && $rc == 1; return 0 if defined $rc && $rc == 0; return; } @@ -173,7 +181,8 @@ sub pid_file_no_unlink { } # write only if it does not exist: - sysopen( my $pid_fh, $pid_file, Fcntl::O_WRONLY() | Fcntl::O_EXCL() | Fcntl::O_CREAT() ) || do { + my $pid_fh = _sysopen($pid_file); + if ( !$pid_fh ) { return 0 if $passes >= $retry_conf->[0]; if ( ref( $retry_conf->[$passes] ) eq 'CODE' ) { $retry_conf->[$passes]->( $self, $pid_file, $passes ); @@ -182,7 +191,7 @@ sub pid_file_no_unlink { sleep( $retry_conf->[$passes] ) if $retry_conf->[$passes]; } goto EXISTS; - }; + } print {$pid_fh} int( abs($newpid) ); close $pid_fh; @@ -190,6 +199,12 @@ sub pid_file_no_unlink { return 1; } +sub _sysopen { + my ($pid_file) = @_; + sysopen( my $pid_fh, $pid_file, Fcntl::O_WRONLY() | Fcntl::O_EXCL() | Fcntl::O_CREAT() ) || return; + return $pid_fh; +} +
* moved sysopen call to an internal functions to make it easier to test
Done in v0.91, just uploaded to CPAN


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.