File Coverage

blib/lib/Devel/REPL/Plugin/Interrupt.pm
Criterion Covered Total %
statement 15 15 100.0
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 20 20 100.0


line stmt bran cond sub pod time code
1 2     2   13692 use strict;
  2         4  
  2         72  
2 2     2   14 use warnings;
  2         3  
  2         115  
3             package Devel::REPL::Plugin::Interrupt;
4             # ABSTRACT: Traps SIGINT to kill long-running lines
5              
6             our $VERSION = '1.003027';
7              
8 2     2   8 use Devel::REPL::Plugin;
  2         4  
  2         16  
9 2     2   9421 use Sys::SigAction qw(set_sig_handler);
  2         11505  
  2         180  
10 2     2   18 use namespace::autoclean;
  2         4  
  2         25  
11              
12             around 'run' => sub {
13             my ($orig, $self) = (shift, shift);
14              
15             local $SIG{INT} = 'IGNORE';
16              
17             return $self->$orig(@_);
18             };
19              
20             around 'run_once' => sub {
21             my ($orig, $self) = (shift, shift);
22              
23             # We have to use Sys::SigAction: Perl 5.8+ has safe signal handling by
24             # default, and Term::ReadLine::Gnu restarts the interrupted system calls.
25             # The result is that the signal handler is not fired until you hit Enter.
26             my $sig_action = set_sig_handler INT => sub {
27             die "Interrupted.\n";
28             };
29              
30             return $self->$orig(@_);
31             };
32              
33             around 'read' => sub {
34             my ($orig, $self) = (shift, shift);
35              
36             # here SIGINT is caught and only kills the line being edited
37             while (1) {
38             my $line = eval { $self->$orig(@_) };
39             return $line unless $@;
40              
41             die unless $@ =~ /^Interrupted\./;
42              
43             # (Term::ReadLine::Gnu kills the line by default, but needs a LF -
44             # maybe I missed something?)
45             print "\n";
46             }
47             };
48              
49             1;
50              
51             __END__
52              
53             =pod
54              
55             =encoding UTF-8
56              
57             =head1 NAME
58              
59             Devel::REPL::Plugin::Interrupt - Traps SIGINT to kill long-running lines
60              
61             =head1 VERSION
62              
63             version 1.003027
64              
65             =head1 DESCRIPTION
66              
67             By default L<Devel::REPL> exits on SIGINT (usually Ctrl-C). If you load this
68             module, SIGINT will be trapped and used to kill long-running commands
69             (statements) and also to kill the line being edited (like eg. BASH do). (You
70             can still use Ctrl-D to exit.)
71              
72             =head1 AUTHOR
73              
74             Shawn M Moore, C<< <sartak at gmail dot com> >>
75              
76             =head1 COPYRIGHT AND LICENSE
77              
78             This software is copyright (c) 2007 by Matt S Trout - mst (at) shadowcatsystems.co.uk (L<http://www.shadowcatsystems.co.uk/>).
79              
80             This is free software; you can redistribute it and/or modify it under
81             the same terms as the Perl 5 programming language system itself.
82              
83             =cut