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.01_06'; # TRIAL
3              
4 2     2   991 $String::TtyLength::VERSION = '0.0106';use 5.006;
  2         13  
5 2     2   10 use strict;
  2         4  
  2         39  
6 2     2   8 use warnings;
  2         4  
  2         48  
7 2     2   931 use parent 'Exporter';
  2         642  
  2         11  
8 2     2   1245 use Unicode::EastAsianWidth 12.0;
  2         2326  
  2         620  
9              
10             our @EXPORT_OK = qw/ tty_length tty_width /;
11              
12             my $cursor_position = qr/\e\[[0-9]+;[0-9]+[Hf]/;
13             my $cursor_movement = qr/\e\[[0-9]+[ABCD]/;
14             my $save_restore_cursor = qr/\e\[[su]/;
15             my $clear_screen = qr/\e\[2J/;
16             my $erase_line = qr/\e\[K/;
17             my $graphics_mode = qr/\e\[[0-9]+(;[0-9]+)*m/;
18             my $ansi_code = qr/
19             (
20             $cursor_position
21             | $cursor_movement
22             | $save_restore_cursor
23             | $clear_screen
24             | $erase_line
25             | $graphics_mode
26             )
27             /x;
28              
29            
30              
31             sub tty_length
32             {
33 13     13 1 10611 my $string = shift;
34 13         29 return length(_remove_ansi_codes($string));
35             }
36              
37             sub tty_width
38             {
39 5     5 1 7852 my $string = _remove_ansi_codes(shift);
40 5         11 my $width = length($string);
41              
42 2     2   1163 $width++ while $string =~ /\p{InFullwidth}/msg;
  2         28  
  2         32  
  5         46  
43              
44 5         1844 return $width;
45             }
46              
47             # might make this an exportable function
48             # as well, but not sure what the right name is :-)
49             sub _remove_ansi_codes
50             {
51 18     18   35 my $string = shift;
52 18         157 $string =~ s/$ansi_code//mosg;
53 18         56 return $string;
54             }
55              
56             1;
57              
58             __END__