File: Sig.pm

package info (click to toggle)
perl 5.42.0-2
  • links: PTS, VCS
  • area: main
  • in suites: experimental
  • size: 128,392 kB
  • sloc: perl: 534,963; ansic: 240,563; sh: 72,042; pascal: 6,934; xml: 2,428; yacc: 1,360; makefile: 1,197; cpp: 208; lisp: 1
file content (123 lines) | stat: -rw-r--r-- 2,203 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
package Test2::Util::Sig;
use strict;
use warnings;

our $VERSION = '1.302210';

use POSIX();
use Test2::Util qw/try IS_WIN32/;

our @EXPORT_OK = qw{
    try_sig_mask
};
BEGIN { require Exporter; our @ISA = qw(Exporter) }

sub try_sig_mask(&) {
    my $code = shift;

    my ($old, $blocked);
    unless(IS_WIN32) {
        my $to_block = POSIX::SigSet->new(
            POSIX::SIGINT(),
            POSIX::SIGALRM(),
            POSIX::SIGHUP(),
            POSIX::SIGTERM(),
            POSIX::SIGUSR1(),
            POSIX::SIGUSR2(),
        );
        $old = POSIX::SigSet->new;
        $blocked = POSIX::sigprocmask(POSIX::SIG_BLOCK(), $to_block, $old);
        # Silently go on if we failed to log signals, not much we can do.
    }

    my ($ok, $err) = &try($code);

    # If our block was successful we want to restore the old mask.
    POSIX::sigprocmask(POSIX::SIG_SETMASK(), $old, POSIX::SigSet->new()) if defined $blocked;

    return ($ok, $err);
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Test2::Util::Sig - Signal tools used by Test2 and friends.

=head1 DESCRIPTION

Collection of signal tools used by L<Test2> and friends.

=head1 EXPORTS

All exports are optional. You must specify subs to import.

=over 4

=item ($ok, $err) = try_sig_mask { ... }

Complete an action with several signals masked, they will be unmasked at the
end allowing any signals that were intercepted to get handled.

This is primarily used when you need to make several actions atomic (against
some signals anyway).

Signals that are intercepted:

=over 4

=item SIGINT

=item SIGALRM

=item SIGHUP

=item SIGTERM

=item SIGUSR1

=item SIGUSR2

=back

=back

=head1 SOURCE

The source code repository for Test2 can be found at
L<https://github.com/Test-More/test-more/>.

=head1 MAINTAINERS

=over 4

=item Chad Granum E<lt>exodist@cpan.orgE<gt>

=back

=head1 AUTHORS

=over 4

=item Chad Granum E<lt>exodist@cpan.orgE<gt>

=item Kent Fredric E<lt>kentnl@cpan.orgE<gt>

=back

=head1 COPYRIGHT

Copyright Chad Granum E<lt>exodist@cpan.orgE<gt>.

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

See L<https://dev.perl.org/licenses/>

=cut