Time-Out-0.11/0000755000076400007640000000000011276055237013322 5ustar patricklpatricklTime-Out-0.11/MANIFEST0000644000076400007640000000026511177605613014455 0ustar patricklpatricklChanges Makefile.PL MANIFEST Out.pm Out.pod README t/01_init.t t/02_usage.t t/03_exceptions.t t/pod.t META.yml Module meta-data (added by MakeMaker) Time-Out-0.11/t/0000755000076400007640000000000011276055237013565 5ustar patricklpatricklTime-Out-0.11/t/01_init.t0000644000076400007640000000014111177605613015210 0ustar patricklpatrickluse strict ; use warnings ; use Test ; BEGIN { plan(tests => 1) ; } use Time::Out ; ok(1) ; Time-Out-0.11/t/pod.t0000644000076400007640000000020111177605613014524 0ustar patricklpatrickluse Test::More; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; all_pod_files_ok(); Time-Out-0.11/t/03_exceptions.t0000644000076400007640000000054511177605613016440 0ustar patricklpatrickluse strict ; use warnings ; use Test ; use Time::Out qw(timeout) ; BEGIN { plan(tests => 3) ; } # exception eval { timeout 3 => sub { die("allo\n") ; } ; } ; ok($@, "allo\n") ; # exception eval { timeout 3 => sub { die("allo") ; } ; } ; ok($@, qr/^allo/) ; # exception eval { timeout 3 => sub { die([56]) ; } ; } ; ok($@->[0], 56) ; Time-Out-0.11/t/02_usage.t0000644000076400007640000000304211177605613015355 0ustar patricklpatrickluse strict ; use warnings ; use Test ; use Time::Out qw(timeout) ; BEGIN { plan(tests => 15) ; } print STDERR "\nThe following tests use sleep() so please be patient...\n" ; # catch timeout timeout 2 => sub { sleep(3) ; } ; ok($@ eq 'timeout') ; # no timeout my $rc = timeout 3 => sub { sleep(1) ; 56 ; } ; ok($@, '') ; ok($rc, 56) ; sub test_no_args { timeout 2 => sub { return $_[0] ; } ; } ok(test_no_args(5), undef) ; sub test_args { timeout 2,@_ => sub { $_[0] ; } ; } ok(test_args(5), 5) ; # repeats timeout 2 => sub { sleep(3) ; } ; sleep(3) ; ok(1) ; # 0 { my $ok = 0 ; local $SIG{__WARN__} = sub {$ok = 1} ; timeout 0 => sub { } ; ok($ok) ; } # CPU timeout 1 => sub { while (1) {} ; } ; ok(1) ; # blocking I/O if ($^O eq 'MSWin32'){ skip("alarm() doesn't interrupt blocking I/O on Win32") ; } else { require IO::Handle ; my $r = new IO::Handle() ; my $w = new IO::Handle() ; pipe($r, $w) ; $w->autoflush(1) ; print $w "\n" ; my $nb = 2 ; my $line = <$r> ; timeout $nb => sub { $line = <$r> ; } ; ok($@ eq 'timeout') ; } # Nested timeouts timeout 5 => sub { timeout 2 => sub { sleep(3) ; } ; ok($@ eq 'timeout') ; sleep(4) ; } ; ok($@ eq 'timeout') ; # Nested timeouts (already expired) my $seen = 0 ; timeout 2 => sub { timeout 5 => sub { sleep(6) ; } ; # We should never get here... $seen = 1 ; } ; ok($@ eq 'timeout') ; ok(!$seen) ; # Nested timeouts (passthru) timeout 5 => sub { timeout 2 => sub { sleep(3) ; } ; # We should never get here... ok($@ eq 'timeout') ; } ; ok(!$@) ; Time-Out-0.11/Out.pod0000644000076400007640000000344211177605613014577 0ustar patricklpatrickl=head1 NAME Time::Out - Easily timeout long running operations =head1 SYNOPSIS use Time::Out qw(timeout) ; timeout $nb_secs => sub { # your code goes were and will be interrupted if it runs # for more than $nb_secs seconds. } ; if ($@){ # operation timed-out } =head1 DESCRIPTION C provides an easy interface to I based timeouts. Nested timeouts are supported. =head2 RETURN VALUE 'timeout' returns whatever the code placed inside the block returns: use Time::Out qw(timeout) ; my $rc = timeout 5 => sub { return 7 ; } ; # $rc == 7 =head1 C If C sees that C has been loaded, it will use that 'alarm' function (if available) instead of the default one, allowing float timeout values to be used effectively: use Time::Out ; use Time::HiRes ; timeout 3.1416 => sub { # ... } ; =head1 BUGS =over 4 =item Blocking I/O on MSWin32 I doesn't interrupt blocking I/O on MSWin32, so 'timeout' won't do that either. =item @_ One drawback to using 'timeout' is that it masks @_ in the affected code. This happens because the affected code is actually wrapped inside another subroutine that provides it's own @_. You can get around this by specifically passing your @_ (or whatever you want for that matter) to 'timeout' as such: use Time::Out ; sub test { timeout 5, @_ => sub { print "$_[0]\n" ; } ; } test("hello") ; # will print "hello\n" ; =back =head1 SEE ALSO eval, closures, I, L =head1 AUTHOR Patrick LeBoutillier, Epatl@cpan.orgE =head1 COPYRIGHT AND LICENSE Copyright 2005-2008 by Patrick LeBoutillier This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Time-Out-0.11/README0000644000076400007640000000112311177605613014176 0ustar patricklpatricklTime::Out - Easy timeouts ========================= use Time::Out qw(timeout); # Time out the following code block after 5 seconds timeout 5 => sub { # do something that might take a long time... } ; if ($@){ # timeout occured... } INSTALLATION Note: Your system must support alarm(2). To install this module type the following: perl Makefile.PL make make test make install COPYRIGHT AND LICENCE Copyright (C) 2005-2008 Patrick LeBoutillier This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Time-Out-0.11/Out.pm0000644000076400007640000000327411177605613014434 0ustar patricklpatricklpackage Time::Out ; @ISA = qw(Exporter) ; @EXPORT_OK = qw(timeout) ; use strict ; use Exporter ; use Carp ; BEGIN { if (Time::HiRes->can('alarm')){ Time::HiRes->import('alarm') ; } if (Time::HiRes->can('time')){ Time::HiRes->import('time') ; } } $Time::Out::VERSION = '0.11' ; sub timeout($@){ my $secs = shift ; carp("Timeout value evaluates to 0: no timeout will be set") if ! $secs ; my $code = pop ; usage() unless ((defined($code))&&(UNIVERSAL::isa($code, 'CODE'))) ; my @other_args = @_ ; # Disable any pending alarms. my $prev_alarm = alarm(0) ; my $prev_time = time() ; my $dollar_at = undef ; my @ret = () ; { # Disable alarm to prevent possible race condition between end of eval and execution of alarm(0) after eval. local $SIG{ALRM} = sub {} ; @ret = eval { local $SIG{ALRM} = sub { die $code } ; if (($prev_alarm)&&($prev_alarm < $secs)){ # A shorter alarm was pending, let's use it instead. alarm($prev_alarm) ; } else { alarm($secs) ; } my @ret = $code->(@other_args) ; alarm(0) ; @ret ; } ; alarm(0) ; $dollar_at = $@ ; } my $new_time = time() ; my $new_alarm = $prev_alarm - ($new_time - $prev_time) ; if ($new_alarm > 0){ # Rearm old alarm with remaining time. alarm($new_alarm) ; } elsif ($prev_alarm){ # Old alarm has already expired. kill 'ALRM', $$ ; } if ($dollar_at){ if ((ref($dollar_at))&&($dollar_at eq $code)){ $@ = "timeout" ; } else { if (! ref($dollar_at)){ chomp($dollar_at) ; die("$dollar_at\n") ; } else { croak $dollar_at ; } } } return wantarray ? @ret : $ret[0] ; } sub usage { croak("Usage: timeout \$nb_secs => sub {\n #code\n} ;\n") ; } 1 ; Time-Out-0.11/META.yml0000664000076400007640000000051511276055237014576 0ustar patricklpatrickl--- #YAML:1.0 name: Time-Out version: 0.11 abstract: ~ license: ~ author: ~ generated_by: ExtUtils::MakeMaker version 6.42 distribution_type: module requires: meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.3.html version: 1.3 Time-Out-0.11/Makefile.PL0000644000076400007640000000032411177605613015272 0ustar patricklpatrickluse ExtUtils::MakeMaker ; use Config ; if (! $Config{d_alarm}){ die("Fatal error: alarm(2) is not defined on this system.\n") ; } WriteMakefile( 'NAME' => 'Time::Out', 'VERSION_FROM' => 'Out.pm', ); Time-Out-0.11/Changes0000644000076400007640000000127311276055146014617 0ustar patricklpatricklRevision history for Perl extension Time::Out. 0.11 Tue Jan 15 11:36:27 EST 2008 - Applied patch by Jens Heunemann to fix a race condition as well as some errors related to exception handling 0.10 Thu Sep 13 22:53:28 EDT 2007 - Added support for nested timeouts (thanks to chocolateboy for the patch) - Removed the useless 'affects' syntax - 'timeout' now exported via @EXPORT_OK instead of @EXPORT 0.05 Fri Jan 7 13:33:31 EST 2005 - Updated documentation 0.04 Thu Jan 6 13:33:31 EST 2005 - Added tests for blocking I/O - Added support for Time::HiRes 0.01 Tue Jan 4 10:18:55 2005 - original version; created by h2xs 1.22 with options -AX Time::Out