File Coverage

blib/lib/String/TtyLength.pm
Criterion Covered Total %
statement 26 26 100.0
branch n/a
condition n/a
subroutine 9 9 100.0
pod 2 2 100.0
total 37 37 100.0


line stmt bran cond sub pod time code
1             package String::TtyLength;
2             $String::TtyLength::VERSION = '0.03';
3 2     2   1071 use 5.006;
  2         13  
4 2     2   10 use strict;
  2         4  
  2         40  
5 2     2   9 use warnings;
  2         3  
  2         49  
6 2     2   952 use parent 'Exporter';
  2         746  
  2         11  
7 2     2   1263 use Unicode::EastAsianWidth 12.0;
  2         2331  
  2         667  
8              
9             our @EXPORT_OK = qw/ tty_length tty_width /;
10              
11             my $cursor_position = qr/\e\[[0-9]+;[0-9]+[Hf]/;
12             my $cursor_movement = qr/\e\[[0-9]+[ABCD]/;
13             my $save_restore_cursor = qr/\e\[[su]/;
14             my $clear_screen = qr/\e\[2J/;
15             my $erase_line = qr/\e\[K/;
16             my $graphics_mode = qr/\e\[[0-9]+(;[0-9]+)*m/;
17             my $ansi_code = qr/
18             (
19             $cursor_position
20             | $cursor_movement
21             | $save_restore_cursor
22             | $clear_screen
23             | $erase_line
24             | $graphics_mode
25             )
26             /x;
27              
28            
29              
30             sub tty_length
31             {
32 13     13 1 11893 my $string = shift;
33 13         33 return length(_remove_ansi_codes($string));
34             }
35              
36             sub tty_width
37             {
38 5     5 1 7954 my $string = _remove_ansi_codes(shift);
39 5         12 my $width = length($string);
40              
41 2     2   1216 $width++ while $string =~ /\p{InFullwidth}/msg;
  2         30  
  2         32  
  5         47  
42              
43 5         1800 return $width;
44             }
45              
46             # might make this an exportable function
47             # as well, but not sure what the right name is :-)
48             sub _remove_ansi_codes
49             {
50 18     18   34 my $string = shift;
51 18         155 $string =~ s/$ansi_code//mosg;
52 18         64 return $string;
53             }
54              
55             1;
56              
57             __END__