File Coverage

blib/lib/Proc/PidChange.pm

Criterion	Covered	Total	%
statement	24	24	100.0
branch	2	2	100.0
condition			n/a
subroutine	8	8	100.0
pod	3	3	100.0
total	37	37	100.0

package Proc::PidChange;

# ABSTRACT: execute callbacks when PID changes
our $VERSION = '0.002'; # VERSION
our $AUTHORITY = 'cpan:MELO'; # AUTHORITY

use strict;
use warnings;
use parent 'Exporter';

### Export setup
our @EXPORT      = 'check_current_pid';
our @EXPORT_OK   = qw( check_current_pid register_pid_change_callback unregister_pid_change_callback );
our %EXPORT_TAGS = (
  all      => \@EXPORT_OK,
  registry => [qw(register_pid_change_callback unregister_pid_change_callback)],
);

## Flag: if true, no need to pool for changes
our $RT = 0;
unless ($ENV{PROC_PIDCHANGE_NO_RT}) {
  eval {
    require POSIX::AtFork;
    POSIX::AtFork->import();
    POSIX::AtFork->add_to_child(\&check_current_pid);
    $RT++;
  };
}


### Our implementation
{
  ### Our state
  our $last_checked_pid;
  BEGIN { $last_checked_pid = $$ }

  our @callbacks;

  ### Check for pid changes
  sub check_current_pid {
    return if $last_checked_pid == $$;
    $last_checked_pid = $$;
    return _call_all_callbacks();
  }

  sub _call_all_callbacks {
    $_->() for @callbacks;
    return;
  }

  ### Callback registry API
  sub register_pid_change_callback {
    push @callbacks, grep { ref($_) eq 'CODE' } @_;
    return;
  }

  sub unregister_pid_change_callback {
    my %targets = map { $_ => 1 } grep { ref($_) eq 'CODE' } @_;
    @callbacks = grep { !$targets{$_} } @callbacks;

    return;
  }
}


1;


__END__