File Coverage

blib/lib/Perinci/Sub/Property/timeout.pm
Criterion Covered Total %
statement 21 21 100.0
branch 1 2 50.0
condition 1 5 20.0
subroutine 5 5 100.0
pod n/a
total 28 33 84.8


line stmt bran cond sub pod time code
1             package Perinci::Sub::Property::timeout;
2              
3 1     1   4066507 use 5.010001;
  1         5  
4 1     1   5 use strict;
  1         3  
  1         19  
5 1     1   5 use warnings;
  1         2  
  1         30  
6              
7 1     1   530 use Perinci::Sub::PropertyUtil qw(declare_property);
  1         1167  
  1         214  
8              
9             our $VERSION = '0.08'; # VERSION
10              
11             declare_property(
12             name => 'timeout',
13             type => 'function',
14             schema => ['int*' => {min=>0}],
15             wrapper => {
16             meta => {
17             v => 2,
18             # highest, we need to disable alarm right after call
19             prio => 1,
20             convert => 1,
21             },
22             handler => sub {
23 4     4   4039809 my ($self, %args) = @_;
24 4   33     28 my $v = int($args{new} // $args{value} // 0);
      0        
25 4         13 my $meta = $args{meta};
26              
27 4 50       17 return unless $v > 0;
28              
29 4         20 $self->select_section('before_call_right_before_call');
30 4         82 $self->push_lines(
31             'local $SIG{ALRM} = sub { die "Timed out\n" };',
32             "alarm($v);");
33              
34 4         150 $self->select_section('after_call_right_after_call');
35 4         64 $self->push_lines('alarm(0);');
36              
37 4         128 $self->select_section('after_eval');
38 4         70 $self->_errif(504, "\"Timed out ($v sec(s))\"",
39             '$_w_eval_err =~ /\ATimed out\b/');
40             },
41             },
42             );
43              
44             1;
45             # ABSTRACT: Specify function execution time limit
46              
47             __END__
48              
49             =pod
50              
51             =encoding UTF-8
52              
53             =head1 NAME
54              
55             Perinci::Sub::Property::timeout - Specify function execution time limit
56              
57             =head1 VERSION
58              
59             This document describes version 0.08 of Perinci::Sub::Property::timeout (from Perl distribution Perinci-Sub-Property-timeout), released on 2016-05-11.
60              
61             =head1 SYNOPSIS
62              
63             # in function metadata
64             timeout => 5,
65              
66             =head1 DESCRIPTION
67              
68             This property specifies function execution time limit, in seconds. The default
69             is 0, which means unlimited.
70              
71             This property's wrapper implementation uses C<alarm()> (C<ualarm()> replacement,
72             for subsecond granularity, will be considered upon demand). If limit is reached,
73             a 504 (timeout) status is returned.
74              
75             =head1 HOMEPAGE
76              
77             Please visit the project's homepage at L<https://metacpan.org/release/Perinci-Sub-Property-timeout>.
78              
79             =head1 SOURCE
80              
81             Source repository is at L<https://github.com/perlancar/perl-Perinci-Sub-Property-timeout>.
82              
83             =head1 BUGS
84              
85             Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Perinci-Sub-Property-timeout>
86              
87             When submitting a bug or request, please include a test-file or a
88             patch to an existing test-file that illustrates the bug or desired
89             feature.
90              
91             =head1 SEE ALSO
92              
93             L<Perinci>
94              
95             =head1 AUTHOR
96              
97             perlancar <perlancar@cpan.org>
98              
99             =head1 COPYRIGHT AND LICENSE
100              
101             This software is copyright (c) 2016 by perlancar@cpan.org.
102              
103             This is free software; you can redistribute it and/or modify it under
104             the same terms as the Perl 5 programming language system itself.
105              
106             =cut