File Coverage

blib/lib/Net/CLI/Interact/Transport/Role/StripControlChars.pm
Criterion Covered Total %
statement 9 9 100.0
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 12 12 100.0


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;