line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Net::CLI::Interact::Transport::Role::StripControlChars; |
2
|
|
|
|
|
|
|
{ $Net::CLI::Interact::Transport::Role::StripControlChars::VERSION = '2.400000' } |
3
|
|
|
|
|
|
|
|
4
|
1
|
|
|
1
|
|
614
|
use strict; |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
67
|
|
5
|
1
|
|
|
1
|
|
8
|
use warnings FATAL => 'all'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
51
|
|
6
|
|
|
|
|
|
|
|
7
|
1
|
|
|
1
|
|
6
|
use Moo::Role; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
18
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
my %ansi_codes = ( |
10
|
|
|
|
|
|
|
1 => q/\x1b\[\d+;\d+H/, # code_position_cursor |
11
|
|
|
|
|
|
|
3 => q/\x1b\[\?25h/, #code_show_cursor |
12
|
|
|
|
|
|
|
4 => q/\x1b\x45/, #code_next_line |
13
|
|
|
|
|
|
|
5 => q/\x1b\[2K/, #code_erase_line |
14
|
|
|
|
|
|
|
6 => q/\x1b\[K/, #code_erase_start_line |
15
|
|
|
|
|
|
|
7 => q/\x1b\[\d+;\d+r/, #code_enable_scroll |
16
|
|
|
|
|
|
|
68 => q/\e\[\??\d+(;\d+)*[A-Za-z]/, #VLZ addon from ytti/oxidized |
17
|
|
|
|
|
|
|
); |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
# https://github.com/ollyg/Net-CLI-Interact/issues/22 |
20
|
|
|
|
|
|
|
around 'buffer' => sub { |
21
|
|
|
|
|
|
|
my $orig = shift; |
22
|
|
|
|
|
|
|
my $buffer = ($orig->(@_) || ''); |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
# remove control characters |
25
|
|
|
|
|
|
|
$buffer =~ s/[\000-\010\013\014\016-\032\034-\037]//g; |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
# strip ANSI terminal codes |
28
|
|
|
|
|
|
|
foreach my $code (sort keys %ansi_codes) { |
29
|
|
|
|
|
|
|
my $to = ''; |
30
|
|
|
|
|
|
|
$to = "\n" if ($code == 4); # CODE_NEXT_LINE must substitute with '\n' |
31
|
|
|
|
|
|
|
$buffer =~ s/$ansi_codes{$code}/$to/g; |
32
|
|
|
|
|
|
|
} |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
return $buffer; |
35
|
|
|
|
|
|
|
}; |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
1; |