File Coverage

blib/lib/Term/Choose/Screen.pm
Criterion Covered Total %
statement 29 76 38.1
branch 1 20 5.0
condition 2 18 11.1
subroutine 6 20 30.0
pod 0 14 0.0
total 38 148 25.6


line stmt bran cond sub pod time code
1             package Term::Choose::Screen;
2              
3 3     3   23 use warnings;
  3         40  
  3         122  
4 3     3   17 use strict;
  3         13  
  3         75  
5 3     3   36 use 5.10.0;
  3         11  
6              
7             our $VERSION = '1.762';
8              
9 3     3   16 use Exporter qw( import );
  3         6  
  3         195  
10              
11             our @EXPORT_OK = qw(
12             down up left right clear_screen clear_to_end_of_screen clear_to_end_of_line reverse_video bold underline
13             bold_underline normal show_cursor hide_cursor bell get_term_size
14             );
15              
16             our %EXPORT_TAGS = ( all => [ @EXPORT_OK ] );
17              
18 3     3   17 use Term::Choose::Constants qw( WIDTH_CURSOR TERM_READKEY );
  3         6  
  3         1003  
19              
20              
21             my (
22             @up, @down, @right, @left,
23             $reverse, $bold, $underline, $bold_underline, $normal,
24             $bell,
25             $clear_screen, $clr_to_bot, $clr_to_eol,
26             $show_cursor, $hide_cursor,
27             );
28              
29              
30             BEGIN {
31 3 50 33 3   19623 if ( $^O eq 'MSWin32' || $ENV{TC_ANSI_ESCAPES} || ! qx(tput cuu 2>/dev/null) ) {
      33        
32 0         0 @up = ( "\e[", "A" );
33 0         0 @down = ( "\e[", "B" );
34 0         0 @right = ( "\e[", "C" );
35 0         0 @left = ( "\e[", "D" );
36              
37 0         0 $reverse = "\e[7m";
38 0         0 $bold = "\e[1m";
39 0         0 $underline = "\e[4m";
40 0         0 $normal = "\e[0m";
41              
42 0         0 $bell = "\a";
43              
44 0         0 $clear_screen = "\e[H\e[J";
45 0         0 $clr_to_bot = "\e[0J";
46 0         0 $clr_to_eol = "\e[K";
47              
48 0         0 $show_cursor = "\e[?25h";
49 0         0 $hide_cursor = "\e[?25l";
50             }
51             else {
52 3         9283 @up = split( '107', qx(tput cuu 107) );
53 3         11687 @down = split( '107', qx(tput cud 107) );
54 3         10603 @right = split( '107', qx(tput cuf 107) );
55 3         9750 @left = split( '107', qx(tput cub 107) );
56              
57 3         13321 $reverse = qx(tput rev);
58 3         9888 $bold = qx(tput bold);
59 3         9264 $underline = qx(tput smul);
60 3         8033 $normal = qx(tput sgr0);
61              
62 3         8054 $bell = qx(tput bel);
63              
64 3         10516 $clear_screen = qx(tput clear);
65 3         8515 $clr_to_bot = qx(tput ed);
66 3         8691 $clr_to_eol = qx(tput el);
67              
68 3         12111 $show_cursor = qx(tput cnorm);
69 3         15603 $hide_cursor = qx(tput civis);
70             }
71             }
72              
73              
74 0     0 0   sub down { return $down[0] . $_[0] . $down[1] }
75 0     0 0   sub up { return $up[0] . $_[0] . $up[1] }
76 0     0 0   sub left { return $left[0] . $_[0] . $left[1] }
77 0     0 0   sub right { return $right[0] . $_[0] . $right[1] }
78              
79 0     0 0   sub clear_screen { return $clear_screen }
80 0     0 0   sub clear_to_end_of_screen { return $clr_to_bot }
81 0     0 0   sub clear_to_end_of_line { return $clr_to_eol }
82              
83 0     0 0   sub reverse_video { return $reverse }
84             #sub bold { return $bold }
85             #sub underline { return $underline }
86 0     0 0   sub bold_underline { return $bold . $underline }
87 0     0 0   sub normal { return $normal }
88              
89 0     0 0   sub show_cursor { return $show_cursor }
90 0     0 0   sub hide_cursor { return $hide_cursor }
91              
92 0     0 0   sub bell { return $bell }
93              
94              
95             sub get_term_size {
96 0     0 0   my ( $width, $height, $error );
97 0 0         if ( TERM_READKEY ) {
    0          
98 0           ( $width, $height ) = ( Term::ReadKey::GetTerminalSize() )[ 0, 1 ];
99 0 0 0       if ( ! $width || ! $height ) {
100 0           $error = "get_term_size - Term::ReadKey::GetTerminalSize:";
101             }
102             }
103             elsif( $^O eq 'MSWin32' ) {
104 0           require Win32::Console;
105 0           ( $width, $height ) = Win32::Console->new()->Size();
106 0 0 0       if ( ! $width || ! $height ) {
107 0           $error = "get_term_size - Win32::Console Size:";
108             }
109             }
110             else {
111 0           my $size = qx(stty size);
112 0 0 0       if ( defined $size && $size =~ /(\d+)\s(\d+)/ ) {
113 0           $width = $2;
114 0           $height = $1;
115             }
116 0 0 0       if ( ! $width || ! $height ) {
117 0           $error = "get_term_size - stty size:";
118             }
119             }
120 0 0         if ( $error ) {
121 0 0         $error .= " No term width!" if ! $width;
122 0 0         $error .= " No term height!" if ! $height;
123 0           die $error;
124             }
125 0           return $width - WIDTH_CURSOR, $height;
126             }
127              
128              
129              
130              
131              
132             1;