File Coverage

blib/lib/Time/Out.pm

Criterion	Covered	Total	%
statement	56	56	100.0
branch	22	22	100.0
condition	6	6	100.0
subroutine	12	12	100.0
pod	1	1	100.0
total	97	97	100.0

use strict;
use warnings;

package Time::Out;

# keeping the following $VERSION declaration on a single line is important
#<<<
use version 0.9915; our $VERSION = version->declare( '1.0.0' );
#>>>

use Exporter                    qw( import );
use Scalar::Util                qw( blessed reftype );
use Time::Out::Exception        qw();
use Time::Out::ParamConstraints qw( assert_NonNegativeNumber assert_CodeRef );
use Try::Tiny                   qw( finally try );

BEGIN {
  # if possible use Time::HiRes drop-in replacements
  for ( qw( alarm time ) ) {
    Time::HiRes->import( $_ ) if Time::HiRes->can( $_ );
  }
}

our @EXPORT_OK = qw( timeout );

sub timeout( $@ ) {
  my $context = wantarray;
  # wallclock seconds
  my $timeout   = assert_NonNegativeNumber shift;
  my $code      = assert_CodeRef pop;
  my @code_args = @_;

  my $exception;
  # in scalar context store the result in the first array element
  my @result;

  # disable previous timer and save the amount of time remaining on it
  my $remaining_time_on_previous_timer = alarm 0;
  my $start_time                       = time;

  {
# https://stackoverflow.com/questions/1194113/whats-the-difference-between-ignoring-a-signal-and-telling-it-to-do-nothing-in
# disable ALRM handling to prevent possible race condition between the end of the
# try block and the execution of alarm(0) in the finally block
    local $SIG{ ALRM } = 'IGNORE';
    try {
      local $SIG{ ALRM } = sub { die Time::Out::Exception->new( previous_exception => $@, timeout => $timeout ) }; ## no critic (RequireCarping)
      if ( $remaining_time_on_previous_timer and $remaining_time_on_previous_timer < $timeout ) {
        # a shorter timer was pending, let's use it instead
        alarm $remaining_time_on_previous_timer;
      } else {
        alarm $timeout;
      }
      defined $context
        ? $context
          ? @result = $code->( @code_args )         # list context
          : $result[ 0 ] = $code->( @code_args )    # scalar context
        : $code->( @code_args );                    # void context
      alarm 0;
    } finally {
      alarm 0;
      $exception = $_[ 0 ] if @_;
    }
  }

  my $elapsed_time = time - $start_time;
  my $new_timeout  = $remaining_time_on_previous_timer - $elapsed_time;

  if ( $new_timeout > 0 ) {
    # rearm previous timer with new timeout
    alarm $new_timeout;
  } elsif ( $remaining_time_on_previous_timer ) {
    # previous timer has already expired; send ALRM
    kill 'ALRM', $$;
  }

  # handle exceptions
  if ( defined $exception ) {
    if ( defined blessed( $exception ) and $exception->isa( 'Time::Out::Exception' ) ) {
      $@ = $exception; ## no  critic (RequireLocalizedPunctuationVars)
      return;
    }
    die $exception; ## no  critic (RequireCarping)
  }

  return
      defined $context
    ? $context
      ? return @result    # list context
      : $result[ 0 ]      # scalar context
    : ();                 # void context
}

1;