line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Term::TablePrint; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
68664
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
31
|
|
4
|
1
|
|
|
1
|
|
5
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
16
|
|
5
|
1
|
|
|
1
|
|
12
|
use 5.10.0; |
|
1
|
|
|
|
|
4
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
our $VERSION = '0.159'; |
8
|
1
|
|
|
1
|
|
6
|
use Exporter 'import'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
51
|
|
9
|
|
|
|
|
|
|
our @EXPORT_OK = qw( print_table ); |
10
|
|
|
|
|
|
|
|
11
|
1
|
|
|
1
|
|
6
|
use Carp qw( croak ); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
53
|
|
12
|
|
|
|
|
|
|
|
13
|
1
|
|
|
1
|
|
6
|
use List::Util qw( sum max ); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
124
|
|
14
|
1
|
|
|
1
|
|
7
|
use Scalar::Util qw( looks_like_number ); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
43
|
|
15
|
|
|
|
|
|
|
|
16
|
1
|
|
|
1
|
|
708
|
use Term::Choose qw( choose ); |
|
1
|
|
|
|
|
93319
|
|
|
1
|
|
|
|
|
126
|
|
17
|
1
|
|
|
1
|
|
20
|
use Term::Choose::Constants qw( WIDTH_CURSOR ); |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
54
|
|
18
|
1
|
|
|
1
|
|
29
|
use Term::Choose::LineFold qw( line_fold cut_to_printwidth print_columns ); |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
69
|
|
19
|
1
|
|
|
1
|
|
7
|
use Term::Choose::Screen qw( hide_cursor show_cursor ); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
97
|
|
20
|
1
|
|
|
1
|
|
8
|
use Term::Choose::ValidateOptions qw( validate_options ); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
47
|
|
21
|
1
|
|
|
1
|
|
619
|
use Term::Choose::Util qw( get_term_width insert_sep ); |
|
1
|
|
|
|
|
29684
|
|
|
1
|
|
|
|
|
68
|
|
22
|
1
|
|
|
1
|
|
554
|
use Term::TablePrint::ProgressBar qw(); |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
76
|
|
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
BEGIN { |
26
|
1
|
50
|
|
1
|
|
1985
|
if ( $^O eq 'MSWin32' ) { |
27
|
0
|
|
|
|
|
0
|
require Win32::Console::ANSI; |
28
|
|
|
|
|
|
|
} |
29
|
|
|
|
|
|
|
} |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
my $save_memory = 0; |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
sub new { |
34
|
0
|
|
|
0
|
1
|
|
my $class = shift; |
35
|
0
|
0
|
|
|
|
|
croak "new: called with " . @_ . " arguments - 0 or 1 arguments expected." if @_ > 1; |
36
|
0
|
|
|
|
|
|
my ( $opt ) = @_; |
37
|
0
|
|
|
|
|
|
my $instance_defaults = _defaults(); |
38
|
0
|
0
|
|
|
|
|
if ( defined $opt ) { |
39
|
0
|
0
|
|
|
|
|
croak "new: The (optional) argument is not a HASH reference." if ref $opt ne 'HASH'; |
40
|
0
|
|
|
|
|
|
validate_options( _valid_options(), $opt, 'new' ); |
41
|
0
|
|
|
|
|
|
for my $key ( keys %$opt ) { |
42
|
0
|
0
|
|
|
|
|
$instance_defaults->{$key} = $opt->{$key} if defined $opt->{$key}; |
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
} |
45
|
0
|
|
|
|
|
|
my $self = bless $instance_defaults, $class; |
46
|
0
|
|
|
|
|
|
$self->{backup_instance_defaults} = { %$instance_defaults }; |
47
|
0
|
|
|
|
|
|
return $self; |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
sub _valid_options { |
52
|
|
|
|
|
|
|
return { |
53
|
0
|
|
|
0
|
|
|
codepage_mapping => '[ 0 1 ]', |
54
|
|
|
|
|
|
|
hide_cursor => '[ 0 1 ]', # documentation |
55
|
|
|
|
|
|
|
mouse => '[ 0 1 ]', |
56
|
|
|
|
|
|
|
squash_spaces => '[ 0 1 ]', |
57
|
|
|
|
|
|
|
table_expand => '[ 0 1 ]', |
58
|
|
|
|
|
|
|
trunc_fract_first => '[ 0 1 ]', |
59
|
|
|
|
|
|
|
binary_filter => '[ 0 1 2 ]', |
60
|
|
|
|
|
|
|
color => '[ 0 1 2 ]', |
61
|
|
|
|
|
|
|
page => '[ 0 1 2 ]', # undocumented |
62
|
|
|
|
|
|
|
search => '[ 0 1 2 ]', # |
63
|
|
|
|
|
|
|
keep => '[ 1-9 ][ 0-9 ]*', # undocumented |
64
|
|
|
|
|
|
|
max_rows => '[ 0-9 ]+', |
65
|
|
|
|
|
|
|
min_col_width => '[ 0-9 ]+', ## |
66
|
|
|
|
|
|
|
progress_bar => '[ 0-9 ]+', |
67
|
|
|
|
|
|
|
tab_width => '[ 0-9 ]+', |
68
|
|
|
|
|
|
|
binary_string => 'Str', ## |
69
|
|
|
|
|
|
|
decimal_separator => 'Str', |
70
|
|
|
|
|
|
|
footer => 'Str', |
71
|
|
|
|
|
|
|
info => 'Str', |
72
|
|
|
|
|
|
|
prompt => 'Str', |
73
|
|
|
|
|
|
|
undef => 'Str', |
74
|
|
|
|
|
|
|
#thsd_sep => 'Str', |
75
|
|
|
|
|
|
|
}; |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
sub _defaults { |
80
|
|
|
|
|
|
|
return { |
81
|
0
|
|
|
0
|
|
|
binary_filter => 0, |
82
|
|
|
|
|
|
|
binary_string => 'BNRY', |
83
|
|
|
|
|
|
|
codepage_mapping => 0, |
84
|
|
|
|
|
|
|
color => 0, |
85
|
|
|
|
|
|
|
decimal_separator => '.', |
86
|
|
|
|
|
|
|
footer => undef, |
87
|
|
|
|
|
|
|
hide_cursor => 1, |
88
|
|
|
|
|
|
|
info => undef, |
89
|
|
|
|
|
|
|
keep => undef, |
90
|
|
|
|
|
|
|
max_rows => 0, |
91
|
|
|
|
|
|
|
min_col_width => 30, |
92
|
|
|
|
|
|
|
mouse => 0, |
93
|
|
|
|
|
|
|
page => 2, ## |
94
|
|
|
|
|
|
|
progress_bar => 40000, |
95
|
|
|
|
|
|
|
prompt => '', |
96
|
|
|
|
|
|
|
search => 1, |
97
|
|
|
|
|
|
|
squash_spaces => 0, |
98
|
|
|
|
|
|
|
tab_width => 2, |
99
|
|
|
|
|
|
|
table_expand => 1, |
100
|
|
|
|
|
|
|
trunc_fract_first => 1, |
101
|
|
|
|
|
|
|
undef => '', |
102
|
|
|
|
|
|
|
thsd_sep => ',', # |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
sub __reset { |
108
|
0
|
|
|
0
|
|
|
my ( $self ) = @_; |
109
|
0
|
0
|
|
|
|
|
if ( $self->{hide_cursor} ) { |
110
|
0
|
|
|
|
|
|
print show_cursor(); |
111
|
|
|
|
|
|
|
} |
112
|
0
|
0
|
|
|
|
|
if ( exists $self->{backup_instance_defaults} ) { |
113
|
0
|
|
|
|
|
|
my $instance_defaults = $self->{backup_instance_defaults}; |
114
|
0
|
|
|
|
|
|
for my $key ( keys %$self ) { |
115
|
0
|
0
|
0
|
|
|
|
if ( $key eq 'plugin' || $key eq 'backup_instance_defaults' ) { |
|
|
0
|
|
|
|
|
|
116
|
0
|
|
|
|
|
|
next; |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
elsif ( exists $instance_defaults->{$key} ) { |
119
|
0
|
|
|
|
|
|
$self->{$key} = $instance_defaults->{$key}; |
120
|
|
|
|
|
|
|
} |
121
|
|
|
|
|
|
|
else { |
122
|
0
|
|
|
|
|
|
delete $self->{$key}; |
123
|
|
|
|
|
|
|
} |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
sub print_table { |
130
|
0
|
0
|
|
0
|
1
|
|
if ( ref $_[0] ne __PACKAGE__ ) { |
131
|
0
|
|
|
|
|
|
my $ob = __PACKAGE__->new(); |
132
|
0
|
|
|
|
|
|
delete $ob->{backup_instance_defaults}; |
133
|
0
|
|
|
|
|
|
return $ob->print_table( @_ ); |
134
|
|
|
|
|
|
|
} |
135
|
0
|
|
|
|
|
|
my $self = shift; |
136
|
0
|
|
|
|
|
|
my ( $tbl_orig, $opt ) = @_; |
137
|
0
|
0
|
0
|
|
|
|
croak "print_table: called with " . @_ . " arguments - 1 or 2 arguments expected." if @_ < 1 || @_ > 2; |
138
|
0
|
0
|
|
|
|
|
croak "print_table: requires an ARRAY reference as its first argument." if ref $tbl_orig ne 'ARRAY'; |
139
|
0
|
0
|
|
|
|
|
if ( defined $opt ) { |
140
|
0
|
0
|
|
|
|
|
croak "print_table: the (optional) second argument is not a HASH reference." if ref $opt ne 'HASH'; |
141
|
0
|
|
|
|
|
|
validate_options( _valid_options(), $opt, 'print_table' ); |
142
|
0
|
|
|
|
|
|
for my $key ( keys %$opt ) { |
143
|
0
|
0
|
|
|
|
|
$self->{$key} = $opt->{$key} if defined $opt->{$key}; |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
} |
146
|
0
|
|
|
|
|
|
$self->{tab_w} = $self->{tab_width}; |
147
|
0
|
0
|
|
|
|
|
if ( ! ( $self->{tab_width} % 2 ) ) { |
148
|
0
|
|
|
|
|
|
++$self->{tab_w}; |
149
|
|
|
|
|
|
|
} |
150
|
0
|
|
|
|
|
|
local $| = 1; |
151
|
|
|
|
|
|
|
local $SIG{INT} = sub { |
152
|
0
|
|
|
0
|
|
|
$self->__reset(); |
153
|
0
|
|
|
|
|
|
print "\n"; |
154
|
0
|
|
|
|
|
|
exit; |
155
|
0
|
|
|
|
|
|
}; |
156
|
0
|
0
|
|
|
|
|
if ( print_columns( $self->{decimal_separator} ) != 1 ) { |
157
|
0
|
|
|
|
|
|
$self->{decimal_separator} = '.'; |
158
|
|
|
|
|
|
|
} |
159
|
0
|
0
|
|
|
|
|
if ( $self->{decimal_separator} ne '.' ) { |
160
|
0
|
|
|
|
|
|
$self->{thsd_sep} = '_'; |
161
|
|
|
|
|
|
|
} |
162
|
0
|
0
|
|
|
|
|
if ( $self->{hide_cursor} ) { |
163
|
0
|
|
|
|
|
|
print hide_cursor(); |
164
|
|
|
|
|
|
|
} |
165
|
0
|
0
|
|
|
|
|
if ( ! @$tbl_orig ) { |
166
|
|
|
|
|
|
|
# Choose |
167
|
0
|
|
|
|
|
|
choose( |
168
|
|
|
|
|
|
|
[ 'Close with ENTER' ], |
169
|
|
|
|
|
|
|
{ prompt => "'print_table': empty table without header row!", hide_cursor => 0 } |
170
|
|
|
|
|
|
|
); |
171
|
0
|
|
|
|
|
|
$self->__reset(); |
172
|
0
|
|
|
|
|
|
return; |
173
|
|
|
|
|
|
|
} |
174
|
0
|
|
|
|
|
|
my $data_row_count = @$tbl_orig - 1; |
175
|
0
|
|
|
|
|
|
my $info_row = ''; |
176
|
0
|
0
|
0
|
|
|
|
if ( $self->{max_rows} && $data_row_count > $self->{max_rows} ) { |
177
|
0
|
|
|
|
|
|
$info_row = sprintf( 'Limited to %s rows', insert_sep( $self->{max_rows}, $self->{thsd_sep} ) ); |
178
|
0
|
|
|
|
|
|
$info_row .= sprintf( ' (total %s)', insert_sep( $data_row_count, $self->{thsd_sep} ) ); |
179
|
0
|
|
|
|
|
|
$data_row_count = $self->{max_rows}; |
180
|
|
|
|
|
|
|
} |
181
|
0
|
0
|
0
|
|
|
|
my $const = { |
182
|
|
|
|
|
|
|
extra_w => $^O eq 'MSWin32' || $^O eq 'cygwin' ? 0 : WIDTH_CURSOR, |
183
|
|
|
|
|
|
|
data_row_count => $data_row_count, |
184
|
|
|
|
|
|
|
info_row => $info_row, |
185
|
|
|
|
|
|
|
regex_number => "^([^.EeNn]*)(\Q$self->{decimal_separator}\E[0-9]+)?\\z", |
186
|
|
|
|
|
|
|
}; |
187
|
0
|
|
|
|
|
|
my $search = { |
188
|
|
|
|
|
|
|
filter => '', |
189
|
|
|
|
|
|
|
map_indexes => [], |
190
|
|
|
|
|
|
|
}; |
191
|
0
|
|
|
|
|
|
my $mr = { |
192
|
|
|
|
|
|
|
last => 0, |
193
|
|
|
|
|
|
|
window_width_changed => 1, |
194
|
|
|
|
|
|
|
enter_search_string => 2, |
195
|
|
|
|
|
|
|
returned_from_filtered_table => 3, |
196
|
|
|
|
|
|
|
}; |
197
|
|
|
|
|
|
|
|
198
|
0
|
|
|
|
|
|
my ( $term_w, $tbl_print, $tbl_w, $header_rows, $w_col_names ) = $self->__get_data( $tbl_orig, $const ); |
199
|
0
|
0
|
|
|
|
|
if ( ! defined $term_w ) { |
200
|
0
|
|
|
|
|
|
$self->__reset(); |
201
|
0
|
|
|
|
|
|
return; |
202
|
|
|
|
|
|
|
} |
203
|
|
|
|
|
|
|
|
204
|
0
|
|
|
|
|
|
WRITE_TABLE: while ( 1 ) { |
205
|
0
|
|
|
|
|
|
my $next = $self->__write_table( |
206
|
|
|
|
|
|
|
$term_w, $tbl_orig, $tbl_print, $tbl_w, $header_rows, $w_col_names, $const, $search, $mr |
207
|
|
|
|
|
|
|
); |
208
|
0
|
0
|
|
|
|
|
if ( ! defined $next ) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
209
|
0
|
|
|
|
|
|
die; |
210
|
|
|
|
|
|
|
} |
211
|
|
|
|
|
|
|
elsif ( $next == $mr->{last} ) { |
212
|
0
|
|
|
|
|
|
last WRITE_TABLE; |
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
elsif ( $next == $mr->{window_width_changed} ) { |
215
|
0
|
|
|
|
|
|
( $term_w, $tbl_print, $tbl_w, $header_rows, $w_col_names ) = $self->__get_data( $tbl_orig, $const ); |
216
|
0
|
0
|
|
|
|
|
if ( ! defined $term_w ) { |
217
|
0
|
|
|
|
|
|
last WRITE_TABLE; |
218
|
|
|
|
|
|
|
} |
219
|
0
|
|
|
|
|
|
next WRITE_TABLE; |
220
|
|
|
|
|
|
|
} |
221
|
|
|
|
|
|
|
elsif ( $next == $mr->{enter_search_string} ) { |
222
|
0
|
|
|
|
|
|
$self->__search( $tbl_orig, $const, $search ); |
223
|
0
|
|
|
|
|
|
next WRITE_TABLE; |
224
|
|
|
|
|
|
|
} |
225
|
|
|
|
|
|
|
elsif ( $next == $mr->{returned_from_filtered_table} ) { |
226
|
0
|
|
|
|
|
|
$self->__reset_search( $search ); |
227
|
0
|
|
|
|
|
|
next WRITE_TABLE; |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
} |
230
|
0
|
|
|
|
|
|
$self->__reset(); |
231
|
0
|
|
|
|
|
|
return; |
232
|
|
|
|
|
|
|
} |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
sub __get_data { |
236
|
0
|
|
|
0
|
|
|
my ( $self, $tbl_orig, $const ) = @_; |
237
|
0
|
|
|
|
|
|
my $term_w = get_term_width() + $const->{extra_w}; |
238
|
|
|
|
|
|
|
my $progress = Term::TablePrint::ProgressBar->new( { |
239
|
|
|
|
|
|
|
data_row_count => $const->{data_row_count}, |
240
|
0
|
|
|
|
|
|
col_count => scalar @{$tbl_orig->[0]}, |
241
|
|
|
|
|
|
|
threshold => $self->{progress_bar}, |
242
|
0
|
|
|
|
|
|
count_progress_bars => 3, |
243
|
|
|
|
|
|
|
} ); |
244
|
0
|
|
|
|
|
|
my $tbl_copy = $self->__copy_table( $tbl_orig, $progress ); |
245
|
0
|
|
|
|
|
|
my ( $w_col_names, $w_cols, $w_int, $w_fract ) = $self->__calc_col_width( $tbl_copy, $const, $progress ); |
246
|
0
|
|
|
|
|
|
my $w_cols_calc = $self->__calc_avail_col_width( $term_w, $tbl_copy, $w_col_names, $w_cols, $w_int, $w_fract ); |
247
|
0
|
0
|
|
|
|
|
if ( ! defined $w_cols_calc ) { |
248
|
0
|
|
|
|
|
|
return; |
249
|
|
|
|
|
|
|
} |
250
|
0
|
|
|
|
|
|
my $tbl_w = sum( @{$w_cols_calc}, $self->{tab_w} * $#{$w_cols_calc} ); |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
251
|
0
|
|
|
|
|
|
my $tbl_print = $self->__cols_to_string( $tbl_orig, $tbl_copy, $w_cols_calc, $w_fract, $const, $progress ); |
252
|
0
|
|
|
|
|
|
my @tmp_header_rows; |
253
|
0
|
0
|
|
|
|
|
if ( length $self->{prompt} ) { |
254
|
0
|
|
|
|
|
|
push @tmp_header_rows, $self->{prompt}; |
255
|
|
|
|
|
|
|
} |
256
|
0
|
0
|
0
|
|
|
|
if ( length $self->{info} || length $self->{prompt} ) { |
257
|
0
|
|
|
|
|
|
push @tmp_header_rows, $self->__header_sep( $w_cols_calc ); |
258
|
|
|
|
|
|
|
} |
259
|
0
|
|
|
|
|
|
my $col_names = shift @{$tbl_print}; |
|
0
|
|
|
|
|
|
|
260
|
0
|
|
|
|
|
|
push @tmp_header_rows, $col_names, $self->__header_sep( $w_cols_calc ); |
261
|
0
|
|
|
|
|
|
my $header_rows = join "\n", @tmp_header_rows; |
262
|
0
|
0
|
|
|
|
|
if ( $const->{info_row} ) { |
263
|
0
|
0
|
|
|
|
|
if ( print_columns( $const->{info_row} ) > $tbl_w ) { |
264
|
0
|
|
|
|
|
|
push @{$tbl_print}, cut_to_printwidth( $const->{info_row}, $tbl_w - 3 ) . '...'; |
|
0
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
} |
266
|
|
|
|
|
|
|
else { |
267
|
0
|
|
|
|
|
|
push @{$tbl_print}, $const->{info_row}; |
|
0
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
} |
269
|
|
|
|
|
|
|
} |
270
|
0
|
|
|
|
|
|
return $term_w, $tbl_print, $tbl_w, $header_rows, $w_col_names; |
271
|
|
|
|
|
|
|
} |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
sub __write_table { |
275
|
0
|
|
|
0
|
|
|
my ( $self, $term_w, $tbl_orig, $tbl_print, $tbl_w, $header_rows, $w_col_names, $const, $search, $mr ) = @_; |
276
|
0
|
|
|
|
|
|
my @idxs_tbl_print; |
277
|
0
|
|
|
|
|
|
my $return = $mr->{last}; |
278
|
0
|
0
|
|
|
|
|
if ( $search->{filter} ) { |
279
|
0
|
|
|
|
|
|
@idxs_tbl_print = map { $_ - 1 } @{$search->{map_indexes}}; # because of the removed tbl_print header row |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
280
|
0
|
|
|
|
|
|
$return = $mr->{returned_from_filtered_table}; |
281
|
|
|
|
|
|
|
} |
282
|
0
|
|
|
|
|
|
my $footer; |
283
|
0
|
0
|
|
|
|
|
if ( $self->{footer} ) { |
284
|
0
|
|
|
|
|
|
$footer = $self->{footer}; |
285
|
0
|
0
|
|
|
|
|
if ( $search->{filter} ) { |
286
|
0
|
|
|
|
|
|
$footer .= $search->{filter}; |
287
|
|
|
|
|
|
|
} |
288
|
|
|
|
|
|
|
} |
289
|
0
|
0
|
0
|
|
|
|
my $old_row = exists $ENV{TC_POS_AT_SEARCH} && ! $search->{filter} ? delete( $ENV{TC_POS_AT_SEARCH} ) : 0; |
290
|
0
|
|
|
|
|
|
my $auto_jumped_to_first_row = 2; |
291
|
0
|
|
|
|
|
|
my $row_is_expanded = 0; |
292
|
|
|
|
|
|
|
|
293
|
0
|
|
|
|
|
|
while ( 1 ) { |
294
|
0
|
0
|
|
|
|
|
if ( $term_w != get_term_width() + $const->{extra_w} ) { |
295
|
0
|
|
|
|
|
|
return $mr->{window_width_changed}; |
296
|
|
|
|
|
|
|
} |
297
|
0
|
0
|
|
|
|
|
if ( ! @{$tbl_print} ) { |
|
0
|
|
|
|
|
|
|
298
|
0
|
|
|
|
|
|
push @{$tbl_print}, ''; # so that going back requires always the same amount of keystrokes |
|
0
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
} |
300
|
0
|
|
|
|
|
|
$ENV{TC_RESET_AUTO_UP} = 0; |
301
|
|
|
|
|
|
|
# Choose |
302
|
|
|
|
|
|
|
my $row = choose( |
303
|
0
|
|
|
|
|
|
@idxs_tbl_print ? [ @{$tbl_print}[@idxs_tbl_print] ] |
304
|
|
|
|
|
|
|
: $tbl_print, |
305
|
|
|
|
|
|
|
{ info => $self->{info}, prompt => $header_rows, index => 1, default => $old_row, ll => $tbl_w, layout => 2, |
306
|
|
|
|
|
|
|
clear_screen => 1, mouse => $self->{mouse}, hide_cursor => 0, footer => $footer, color => $self->{color}, |
307
|
|
|
|
|
|
|
codepage_mapping => $self->{codepage_mapping}, search => $self->{search}, keep => $self->{keep}, |
308
|
|
|
|
|
|
|
page => $self->{page} } |
309
|
0
|
0
|
|
|
|
|
); |
310
|
0
|
0
|
|
|
|
|
if ( ! defined $row ) { |
|
|
0
|
|
|
|
|
|
311
|
0
|
|
|
|
|
|
return $return; |
312
|
|
|
|
|
|
|
} |
313
|
|
|
|
|
|
|
elsif ( $row < 0 ) { |
314
|
0
|
0
|
|
|
|
|
if ( $row == -1 ) { # with option `ll` set and changed window width `choose` returns -1; |
|
|
0
|
|
|
|
|
|
315
|
0
|
|
|
|
|
|
return $mr->{window_width_changed}; |
316
|
|
|
|
|
|
|
} |
317
|
|
|
|
|
|
|
elsif ( $row == -13 ) { # with option `ll` set `choose` returns -13 if `Ctrl-F` was pressed |
318
|
0
|
0
|
|
|
|
|
if ( $search->{filter} ) { |
319
|
0
|
|
|
|
|
|
$self->__reset_search( $search ); |
320
|
|
|
|
|
|
|
} |
321
|
0
|
|
|
|
|
|
return $mr->{enter_search_string}; |
322
|
|
|
|
|
|
|
} |
323
|
|
|
|
|
|
|
else { |
324
|
0
|
|
|
|
|
|
return $mr->{last}; |
325
|
|
|
|
|
|
|
} |
326
|
|
|
|
|
|
|
} |
327
|
0
|
0
|
|
|
|
|
if ( ! $self->{table_expand} ) { |
328
|
0
|
0
|
|
|
|
|
if ( $row == 0 ) { |
329
|
0
|
|
|
|
|
|
return $return; |
330
|
|
|
|
|
|
|
} |
331
|
0
|
|
|
|
|
|
next; |
332
|
|
|
|
|
|
|
} |
333
|
|
|
|
|
|
|
else { |
334
|
0
|
0
|
|
|
|
|
if ( $old_row == $row ) { |
335
|
0
|
0
|
|
|
|
|
if ( $row == 0 ) { |
|
|
0
|
|
|
|
|
|
336
|
0
|
0
|
|
|
|
|
if ( $self->{table_expand} ) { |
337
|
0
|
0
|
|
|
|
|
if ( $row_is_expanded ) { |
338
|
0
|
|
|
|
|
|
return $return; |
339
|
|
|
|
|
|
|
} |
340
|
0
|
0
|
|
|
|
|
if ( $auto_jumped_to_first_row == 1 ) { |
341
|
0
|
|
|
|
|
|
return $return; |
342
|
|
|
|
|
|
|
} |
343
|
|
|
|
|
|
|
} |
344
|
0
|
|
|
|
|
|
$auto_jumped_to_first_row = 0; |
345
|
|
|
|
|
|
|
} |
346
|
|
|
|
|
|
|
elsif ( $ENV{TC_RESET_AUTO_UP} ) { |
347
|
0
|
|
|
|
|
|
$auto_jumped_to_first_row = 0; |
348
|
|
|
|
|
|
|
} |
349
|
|
|
|
|
|
|
else { |
350
|
0
|
|
|
|
|
|
$old_row = 0; |
351
|
0
|
|
|
|
|
|
$auto_jumped_to_first_row = 1; |
352
|
0
|
|
|
|
|
|
$row_is_expanded = 0; |
353
|
0
|
|
|
|
|
|
next; |
354
|
|
|
|
|
|
|
} |
355
|
|
|
|
|
|
|
} |
356
|
0
|
|
|
|
|
|
$old_row = $row; |
357
|
0
|
|
|
|
|
|
$row_is_expanded = 1; |
358
|
0
|
0
|
0
|
|
|
|
if ( $const->{info_row} && $row == $#{$tbl_print} ) { |
|
0
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
# Choose |
360
|
|
|
|
|
|
|
choose( |
361
|
|
|
|
|
|
|
[ 'Close' ], |
362
|
0
|
|
|
|
|
|
{ prompt => $const->{info_row}, clear_screen => 1, mouse => $self->{mouse}, hide_cursor => 0 } |
363
|
|
|
|
|
|
|
); |
364
|
0
|
|
|
|
|
|
next; |
365
|
|
|
|
|
|
|
} |
366
|
0
|
|
|
|
|
|
my $orig_row; |
367
|
0
|
0
|
|
|
|
|
if ( @{$search->{map_indexes}} ) { |
|
0
|
|
|
|
|
|
|
368
|
0
|
|
|
|
|
|
$orig_row = $search->{map_indexes}[$row]; |
369
|
|
|
|
|
|
|
} |
370
|
|
|
|
|
|
|
else { |
371
|
0
|
|
|
|
|
|
$orig_row = $row + 1; # because $tbl_print has no header row while $tbl_orig has a header row |
372
|
|
|
|
|
|
|
} |
373
|
0
|
|
|
|
|
|
$self->__print_single_row( $tbl_orig, $orig_row, $w_col_names, $footer ); |
374
|
|
|
|
|
|
|
} |
375
|
0
|
|
|
|
|
|
delete $ENV{TC_RESET_AUTO_UP}; |
376
|
|
|
|
|
|
|
} |
377
|
|
|
|
|
|
|
} |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
sub __copy_table { |
381
|
0
|
|
|
0
|
|
|
my ( $self, $tbl_orig, $progress ) = @_; |
382
|
0
|
|
|
|
|
|
my $tbl_copy = []; |
383
|
0
|
|
|
|
|
|
my $count = $progress->set_progress_bar(); # |
384
|
0
|
|
|
|
|
|
ROW: for my $row ( @$tbl_orig ) { |
385
|
0
|
|
|
|
|
|
my $tmp_row = []; |
386
|
0
|
|
|
|
|
|
COL: for ( @$row ) { |
387
|
0
|
|
|
|
|
|
my $str = $_; # this is where the copying happens |
388
|
0
|
0
|
|
|
|
|
$str = $self->{undef} if ! defined $str; |
389
|
0
|
0
|
|
|
|
|
$str = _handle_reference( $str ) if ref $str; |
390
|
0
|
0
|
|
|
|
|
if ( $self->{squash_spaces} ) { |
391
|
0
|
|
|
|
|
|
$str =~ s/^\p{Space}+//; |
392
|
0
|
|
|
|
|
|
$str =~ s/\p{Space}+\z//; |
393
|
0
|
|
|
|
|
|
$str =~ s/\p{Space}+/ /g; |
394
|
|
|
|
|
|
|
} |
395
|
0
|
0
|
|
|
|
|
if ( $self->{color} ) { |
396
|
0
|
|
|
|
|
|
$str =~ s/\x{feff}//g; |
397
|
0
|
|
|
|
|
|
$str =~ s/\e\[[\d;]*m/\x{feff}/g; |
398
|
|
|
|
|
|
|
} |
399
|
0
|
0
|
0
|
|
|
|
if ( $self->{binary_filter} && substr( $str, 0, 100 ) =~ /[\x00-\x08\x0B-\x0C\x0E-\x1F]/ ) { |
400
|
|
|
|
|
|
|
#$str = $self->{binary_filter} == 2 ? sprintf("%v02X", $str) =~ tr/./ /r : $self->{binary_string}; # perl 5.14 |
401
|
0
|
0
|
|
|
|
|
if ( $self->{binary_filter} == 2 ) { |
402
|
0
|
|
|
|
|
|
( $str = sprintf("%v02X", $str) ) =~ tr/./ /; |
403
|
|
|
|
|
|
|
} |
404
|
|
|
|
|
|
|
else { |
405
|
0
|
|
|
|
|
|
$str = $self->{binary_string}; |
406
|
|
|
|
|
|
|
} |
407
|
|
|
|
|
|
|
} |
408
|
0
|
|
|
|
|
|
$str =~ s/\t/ /g; |
409
|
0
|
|
|
|
|
|
$str =~ s/\v+/\ \ /g; |
410
|
0
|
|
|
|
|
|
$str =~ s/[\p{Cc}\p{Noncharacter_Code_Point}\p{Cs}]//g; |
411
|
0
|
|
|
|
|
|
push @$tmp_row, $str; |
412
|
|
|
|
|
|
|
} |
413
|
0
|
|
|
|
|
|
push @$tbl_copy, $tmp_row; |
414
|
0
|
0
|
|
|
|
|
if ( @$tbl_copy == $self->{max_rows} ) { |
415
|
0
|
|
|
|
|
|
last; |
416
|
|
|
|
|
|
|
} |
417
|
0
|
0
|
|
|
|
|
if ( $progress->{count_progress_bars} ) { # |
418
|
0
|
0
|
|
|
|
|
if ( $count >= $progress->{next_update} ) { # |
419
|
0
|
|
|
|
|
|
$progress->update_progress_bar( $count ); # |
420
|
|
|
|
|
|
|
} # |
421
|
0
|
|
|
|
|
|
++$count; # |
422
|
|
|
|
|
|
|
} # |
423
|
|
|
|
|
|
|
} |
424
|
0
|
0
|
|
|
|
|
if ( $progress->{count_progress_bars} ) { # |
425
|
0
|
|
|
|
|
|
$progress->last_update_progress_bar( $count ); # |
426
|
|
|
|
|
|
|
} # |
427
|
0
|
|
|
|
|
|
return $tbl_copy |
428
|
|
|
|
|
|
|
} |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
sub __calc_col_width { |
432
|
0
|
|
|
0
|
|
|
my ( $self, $tbl_copy, $const, $progress ) = @_; |
433
|
0
|
|
|
|
|
|
my $count = $progress->set_progress_bar(); # |
434
|
0
|
|
|
|
|
|
my @col_idx = ( 0 .. $#{$tbl_copy->[0]} ); |
|
0
|
|
|
|
|
|
|
435
|
0
|
|
|
|
|
|
my $col_count = @col_idx; |
436
|
0
|
|
|
|
|
|
my $w_col_names = []; |
437
|
0
|
|
|
|
|
|
my $w_cols = [ ( 1 ) x $col_count ]; |
438
|
0
|
|
|
|
|
|
my $w_int = [ ( 0 ) x $col_count ]; |
439
|
0
|
|
|
|
|
|
my $w_fract = [ ( 0 ) x $col_count ]; |
440
|
0
|
|
|
|
|
|
my $regex_number = $const->{regex_number}; |
441
|
0
|
|
|
|
|
|
my $col_names = shift @$tbl_copy; |
442
|
0
|
|
|
|
|
|
for my $col ( @col_idx ) { |
443
|
0
|
|
|
|
|
|
$w_col_names->[$col] = print_columns( $col_names->[$col] ); |
444
|
|
|
|
|
|
|
} |
445
|
|
|
|
|
|
|
|
446
|
0
|
|
|
|
|
|
for my $row ( 0 .. $#$tbl_copy ) { |
447
|
0
|
|
|
|
|
|
for my $col ( @col_idx ) { |
448
|
0
|
0
|
|
|
|
|
if ( ! length $tbl_copy->[$row][$col] ) { |
|
|
0
|
|
|
|
|
|
449
|
|
|
|
|
|
|
# nothing to do |
450
|
|
|
|
|
|
|
} |
451
|
|
|
|
|
|
|
elsif ( looks_like_number $tbl_copy->[$row][$col] ) { |
452
|
0
|
0
|
|
|
|
|
if ( $tbl_copy->[$row][$col] =~ /$regex_number/ ) { |
453
|
0
|
0
|
0
|
|
|
|
if ( ( length $1 // 0 ) > $w_int->[$col] ) { |
454
|
0
|
|
|
|
|
|
$w_int->[$col] = length $1; |
455
|
|
|
|
|
|
|
} |
456
|
0
|
0
|
0
|
|
|
|
if ( ( length $2 // 0 ) > $w_fract->[$col] ) { |
457
|
0
|
|
|
|
|
|
$w_fract->[$col] = length $2; |
458
|
|
|
|
|
|
|
} |
459
|
|
|
|
|
|
|
} |
460
|
|
|
|
|
|
|
else { |
461
|
|
|
|
|
|
|
# scientific notation, NaN, Inf, Infinity |
462
|
0
|
0
|
|
|
|
|
if ( length $tbl_copy->[$row][$col] > $w_cols->[$col] ) { |
463
|
0
|
|
|
|
|
|
$w_cols->[$col] = length $tbl_copy->[$row][$col]; |
464
|
|
|
|
|
|
|
} |
465
|
|
|
|
|
|
|
} |
466
|
|
|
|
|
|
|
} |
467
|
|
|
|
|
|
|
else { |
468
|
0
|
|
|
|
|
|
my $str_w = print_columns( $tbl_copy->[$row][$col] ); |
469
|
0
|
0
|
|
|
|
|
if ( $str_w > $w_cols->[$col] ) { |
470
|
0
|
|
|
|
|
|
$w_cols->[$col] = $str_w; |
471
|
|
|
|
|
|
|
} |
472
|
|
|
|
|
|
|
} |
473
|
|
|
|
|
|
|
} |
474
|
0
|
0
|
|
|
|
|
if ( $progress->{count_progress_bars} ) { # |
475
|
0
|
0
|
|
|
|
|
if ( $count >= $progress->{next_update} ) { # |
476
|
0
|
|
|
|
|
|
$progress->update_progress_bar( $count ); # |
477
|
|
|
|
|
|
|
} # |
478
|
0
|
|
|
|
|
|
++$count; # |
479
|
|
|
|
|
|
|
} # |
480
|
|
|
|
|
|
|
} |
481
|
0
|
|
|
|
|
|
for my $col ( @col_idx ) { |
482
|
0
|
0
|
|
|
|
|
if ( $w_int->[$col] + $w_fract->[$col] > $w_cols->[$col] ) { |
483
|
0
|
|
|
|
|
|
$w_cols->[$col] = $w_int->[$col] + $w_fract->[$col]; |
484
|
|
|
|
|
|
|
} |
485
|
|
|
|
|
|
|
} |
486
|
0
|
|
|
|
|
|
unshift @$tbl_copy, $col_names; |
487
|
0
|
0
|
|
|
|
|
if ( $progress->{count_progress_bars} ) { # |
488
|
0
|
|
|
|
|
|
$progress->last_update_progress_bar( $count ); # |
489
|
|
|
|
|
|
|
} # |
490
|
0
|
|
|
|
|
|
return $w_col_names, $w_cols, $w_int, $w_fract; |
491
|
|
|
|
|
|
|
} |
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
sub __calc_avail_col_width { |
495
|
0
|
|
|
0
|
|
|
my ( $self, $term_w, $tbl_copy, $w_col_names, $w_cols, $w_int, $w_fract ) = @_; |
496
|
0
|
|
|
|
|
|
my $w_cols_calc = [ @{$w_cols} ]; |
|
0
|
|
|
|
|
|
|
497
|
0
|
|
|
|
|
|
my $avail_w = $term_w - $self->{tab_w} * $#$w_cols_calc; |
498
|
0
|
|
|
|
|
|
my $sum = sum( @$w_cols_calc ); |
499
|
0
|
0
|
|
|
|
|
if ( $sum < $avail_w ) { |
|
|
0
|
|
|
|
|
|
500
|
|
|
|
|
|
|
|
501
|
0
|
|
|
|
|
|
HEAD: while ( 1 ) { |
502
|
0
|
|
|
|
|
|
my $prev_sum = $sum; |
503
|
0
|
|
|
|
|
|
for my $col ( 0 .. $#$w_col_names ) { |
504
|
0
|
0
|
|
|
|
|
if ( $w_col_names->[$col] > $w_cols_calc->[$col] ) { |
505
|
0
|
|
|
|
|
|
++$w_cols_calc->[$col]; |
506
|
0
|
|
|
|
|
|
++$sum; |
507
|
0
|
0
|
|
|
|
|
if ( $sum == $avail_w ) { |
508
|
0
|
|
|
|
|
|
last HEAD; |
509
|
|
|
|
|
|
|
} |
510
|
|
|
|
|
|
|
} |
511
|
|
|
|
|
|
|
} |
512
|
0
|
0
|
|
|
|
|
if ( $sum == $prev_sum ) { |
513
|
0
|
|
|
|
|
|
last HEAD; |
514
|
|
|
|
|
|
|
} |
515
|
|
|
|
|
|
|
} |
516
|
|
|
|
|
|
|
} |
517
|
|
|
|
|
|
|
elsif ( $sum > $avail_w ) { |
518
|
0
|
0
|
|
|
|
|
if ( $self->{trunc_fract_first} ) { |
519
|
|
|
|
|
|
|
|
520
|
0
|
|
|
|
|
|
TRUNC_FRACT: while ( $sum > $avail_w ) { |
521
|
0
|
|
|
|
|
|
my $prev_sum = $sum; |
522
|
0
|
|
|
|
|
|
for my $col ( 0 .. $#$w_cols_calc ) { |
523
|
0
|
0
|
0
|
|
|
|
if ( $w_fract->[$col] && $w_fract->[$col] > 3 # 3 == 1 decimal separator + 2 decimal places |
524
|
|
|
|
|
|
|
#&& $w_int->[$col] + $w_fract->[$col] == $w_cols_calc->[$col] # |
525
|
|
|
|
|
|
|
## the column width could be larger than w_int + w_fract, if the column contains non-digit strings |
526
|
|
|
|
|
|
|
) { |
527
|
0
|
|
|
|
|
|
--$w_fract->[$col]; |
528
|
0
|
|
|
|
|
|
--$w_cols_calc->[$col]; |
529
|
0
|
|
|
|
|
|
--$sum; |
530
|
0
|
0
|
|
|
|
|
if ( $sum == $avail_w ) { |
531
|
0
|
|
|
|
|
|
last TRUNC_FRACT; |
532
|
|
|
|
|
|
|
} |
533
|
|
|
|
|
|
|
} |
534
|
|
|
|
|
|
|
} |
535
|
0
|
0
|
|
|
|
|
if ( $sum == $prev_sum ) { |
536
|
0
|
|
|
|
|
|
last TRUNC_FRACT; |
537
|
|
|
|
|
|
|
} |
538
|
|
|
|
|
|
|
} |
539
|
|
|
|
|
|
|
} |
540
|
0
|
0
|
|
|
|
|
my $min_col_width = $self->{min_col_width} < 2 ? 2 : $self->{min_col_width}; # n |
541
|
0
|
|
|
|
|
|
my $percent = 4; |
542
|
|
|
|
|
|
|
|
543
|
0
|
|
|
|
|
|
TRUNC_COLS: while ( $sum > $avail_w ) { |
544
|
0
|
|
|
|
|
|
++$percent; |
545
|
0
|
|
|
|
|
|
for my $col ( 0 .. $#$w_cols_calc ) { |
546
|
0
|
0
|
|
|
|
|
if ( $w_cols_calc->[$col] > $min_col_width ) { |
547
|
0
|
|
|
|
|
|
my $reduced_col_w = _minus_x_percent( $w_cols_calc->[$col], $percent ); |
548
|
0
|
0
|
|
|
|
|
if ( $reduced_col_w < $min_col_width ) { |
549
|
0
|
|
|
|
|
|
$reduced_col_w = $min_col_width; |
550
|
|
|
|
|
|
|
} |
551
|
0
|
0
|
|
|
|
|
if ( $w_fract->[$col] > 2 ) { |
552
|
0
|
|
|
|
|
|
$w_fract->[$col] -= $w_cols_calc->[$col] - $reduced_col_w; |
553
|
0
|
0
|
|
|
|
|
if ( $w_fract->[$col] < 2 ) { |
554
|
0
|
|
|
|
|
|
$w_fract->[$col] = 2; |
555
|
|
|
|
|
|
|
} |
556
|
|
|
|
|
|
|
} |
557
|
|
|
|
|
|
|
#if ( $w_fract->[$col] > 0 ) { |
558
|
|
|
|
|
|
|
# $w_fract->[$col] -= $w_cols_calc->[$col] - $reduced_col_w; |
559
|
|
|
|
|
|
|
# if ( $w_fract->[$col] < 1 ) { |
560
|
|
|
|
|
|
|
# $w_fract->[$col] = "0 but true"; |
561
|
|
|
|
|
|
|
# # keep it true eaven if it is 0 for __cols_to_string to work properly. |
562
|
|
|
|
|
|
|
# } |
563
|
|
|
|
|
|
|
#} |
564
|
0
|
|
|
|
|
|
$w_cols_calc->[$col] = $reduced_col_w; |
565
|
|
|
|
|
|
|
} |
566
|
|
|
|
|
|
|
} |
567
|
0
|
|
|
|
|
|
my $prev_sum = $sum; |
568
|
0
|
|
|
|
|
|
$sum = sum( @$w_cols_calc ); |
569
|
0
|
0
|
|
|
|
|
if ( $sum == $prev_sum ) { |
570
|
0
|
|
|
|
|
|
--$min_col_width; |
571
|
0
|
0
|
|
|
|
|
if ( $min_col_width == 2 ) { # a character could have a print width of 2 |
572
|
0
|
|
|
|
|
|
$self->__print_term_not_wide_enough_message( $tbl_copy ); |
573
|
0
|
|
|
|
|
|
return; |
574
|
|
|
|
|
|
|
} |
575
|
|
|
|
|
|
|
} |
576
|
|
|
|
|
|
|
} |
577
|
0
|
|
|
|
|
|
my $remainder_w = $avail_w - $sum; |
578
|
0
|
0
|
|
|
|
|
if ( $remainder_w ) { |
579
|
|
|
|
|
|
|
|
580
|
0
|
|
|
|
|
|
REMAINDER_W: while ( 1 ) { |
581
|
0
|
|
|
|
|
|
my $prev_remainder_w = $remainder_w; |
582
|
0
|
|
|
|
|
|
for my $col ( 0 .. $#$w_cols_calc ) { |
583
|
0
|
0
|
|
|
|
|
if ( $w_cols_calc->[$col] < $w_cols->[$col] ) { |
584
|
0
|
|
|
|
|
|
++$w_cols_calc->[$col]; |
585
|
0
|
|
|
|
|
|
--$remainder_w; |
586
|
0
|
0
|
|
|
|
|
if ( $remainder_w == 0 ) { |
587
|
0
|
|
|
|
|
|
last REMAINDER_W; |
588
|
|
|
|
|
|
|
} |
589
|
|
|
|
|
|
|
} |
590
|
|
|
|
|
|
|
} |
591
|
0
|
0
|
|
|
|
|
if ( $remainder_w == $prev_remainder_w ) { |
592
|
0
|
|
|
|
|
|
last REMAINDER_W; |
593
|
|
|
|
|
|
|
} |
594
|
|
|
|
|
|
|
} |
595
|
|
|
|
|
|
|
} |
596
|
|
|
|
|
|
|
} |
597
|
|
|
|
|
|
|
#else { |
598
|
|
|
|
|
|
|
# #$sum == $avail_w, nothing to do |
599
|
|
|
|
|
|
|
#} |
600
|
0
|
|
|
|
|
|
return $w_cols_calc; |
601
|
|
|
|
|
|
|
} |
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
sub __cols_to_string { |
604
|
0
|
|
|
0
|
|
|
my ( $self, $tbl_orig, $tbl_copy, $w_cols_calc, $w_fract, $const, $progress ) = @_; |
605
|
0
|
|
|
|
|
|
my $count = $progress->set_progress_bar(); # |
606
|
0
|
|
|
|
|
|
my $tab = ( ' ' x int( $self->{tab_w} / 2 ) ) . '|' . ( ' ' x int( $self->{tab_w} / 2 ) ); |
607
|
0
|
|
|
|
|
|
my $regex_number = $const->{regex_number}; |
608
|
0
|
|
|
|
|
|
my $one_precision_w = length sprintf "%.1e", 123; |
609
|
|
|
|
|
|
|
|
610
|
0
|
|
|
|
|
|
ROW: for my $row ( 0 .. $#{$tbl_copy} ) { |
|
0
|
|
|
|
|
|
|
611
|
0
|
|
|
|
|
|
my $str = ''; |
612
|
0
|
|
|
|
|
|
COL: for my $col ( 0 .. $#{$w_cols_calc} ) { |
|
0
|
|
|
|
|
|
|
613
|
0
|
0
|
|
|
|
|
if ( ! length $tbl_copy->[$row][$col] ) { |
|
|
0
|
|
|
|
|
|
614
|
0
|
|
|
|
|
|
$str = $str . ' ' x $w_cols_calc->[$col]; |
615
|
|
|
|
|
|
|
} |
616
|
|
|
|
|
|
|
elsif ( looks_like_number $tbl_copy->[$row][$col] ) { |
617
|
0
|
|
|
|
|
|
my $number = ''; |
618
|
0
|
0
|
|
|
|
|
if ( $w_fract->[$col] ) { |
619
|
0
|
|
|
|
|
|
my $fract = ''; |
620
|
0
|
0
|
|
|
|
|
if ( $tbl_copy->[$row][$col] =~ /$regex_number/ ) { |
621
|
0
|
0
|
|
|
|
|
if ( length $2 ) { |
622
|
0
|
0
|
|
|
|
|
if ( length $2 > $w_fract->[$col] ) { |
|
|
0
|
|
|
|
|
|
623
|
0
|
|
|
|
|
|
$fract = substr( $2, 0, $w_fract->[$col] ); |
624
|
|
|
|
|
|
|
} |
625
|
|
|
|
|
|
|
elsif ( length $2 < $w_fract->[$col] ) { |
626
|
0
|
|
|
|
|
|
$fract = $2 . ' ' x ( $w_fract->[$col] - length $2 ); |
627
|
|
|
|
|
|
|
} |
628
|
|
|
|
|
|
|
else { |
629
|
0
|
|
|
|
|
|
$fract = $2; |
630
|
|
|
|
|
|
|
} |
631
|
|
|
|
|
|
|
} |
632
|
|
|
|
|
|
|
else { |
633
|
0
|
|
|
|
|
|
$fract = ' ' x $w_fract->[$col]; |
634
|
|
|
|
|
|
|
} |
635
|
0
|
0
|
|
|
|
|
$number = ( length $1 ? $1 : '' ) . $fract; |
636
|
|
|
|
|
|
|
} |
637
|
|
|
|
|
|
|
else { |
638
|
|
|
|
|
|
|
# scientific notation, NaN, Inf, Infinity, '0 but true' |
639
|
0
|
|
|
|
|
|
$number = $tbl_copy->[$row][$col]; |
640
|
|
|
|
|
|
|
} |
641
|
|
|
|
|
|
|
} |
642
|
|
|
|
|
|
|
else { |
643
|
0
|
|
|
|
|
|
$number = $tbl_copy->[$row][$col]; |
644
|
|
|
|
|
|
|
} |
645
|
0
|
0
|
|
|
|
|
if ( length $number > $w_cols_calc->[$col] ) { |
|
|
0
|
|
|
|
|
|
646
|
0
|
0
|
|
|
|
|
my $signed_1_precision_w = $one_precision_w + ( $number =~ /^-/ ? 1 : 0 ); |
647
|
0
|
|
|
|
|
|
my $precision; |
648
|
0
|
0
|
|
|
|
|
if ( $w_cols_calc->[$col] < $signed_1_precision_w ) { |
649
|
|
|
|
|
|
|
# special treatment because zero precision has no dot |
650
|
0
|
|
|
|
|
|
$precision = 0; |
651
|
|
|
|
|
|
|
} |
652
|
|
|
|
|
|
|
else { |
653
|
0
|
|
|
|
|
|
$precision = $w_cols_calc->[$col] - ( $signed_1_precision_w - 1 ); |
654
|
|
|
|
|
|
|
} |
655
|
0
|
|
|
|
|
|
$number = sprintf "%.*e", $precision, $number; |
656
|
|
|
|
|
|
|
# if $number is a scientific-notation-string which is to big for a conversation to a number |
657
|
|
|
|
|
|
|
# 'sprintf' returns 'Inf' instead of reducing the precision. |
658
|
0
|
0
|
|
|
|
|
if ( length( $number ) > $w_cols_calc->[$col] ) { |
|
|
0
|
|
|
|
|
|
659
|
0
|
|
|
|
|
|
$str = $str . ( '-' x $w_cols_calc->[$col] ); |
660
|
|
|
|
|
|
|
} |
661
|
|
|
|
|
|
|
elsif ( length $number < $w_cols_calc->[$col] ) { |
662
|
|
|
|
|
|
|
# if $w_cols_calc->[$col] == zero_precision_w + 1 or if $number == Inf |
663
|
0
|
|
|
|
|
|
$str = $str . ' ' x ( $w_cols_calc->[$col] - length $number ) . $number; |
664
|
|
|
|
|
|
|
} |
665
|
|
|
|
|
|
|
else { |
666
|
0
|
|
|
|
|
|
$str = $str . $number; |
667
|
|
|
|
|
|
|
} |
668
|
|
|
|
|
|
|
} |
669
|
|
|
|
|
|
|
elsif ( length $number < $w_cols_calc->[$col] ) { |
670
|
0
|
|
|
|
|
|
$str = $str . ' ' x ( $w_cols_calc->[$col] - length $number ) . $number; |
671
|
|
|
|
|
|
|
} |
672
|
|
|
|
|
|
|
else { |
673
|
0
|
|
|
|
|
|
$str = $str . $number; |
674
|
|
|
|
|
|
|
} |
675
|
|
|
|
|
|
|
} |
676
|
|
|
|
|
|
|
else { |
677
|
0
|
|
|
|
|
|
my $str_w = print_columns( $tbl_copy->[$row][$col] ); |
678
|
0
|
0
|
|
|
|
|
if ( $str_w > $w_cols_calc->[$col] ) { |
|
|
0
|
|
|
|
|
|
679
|
0
|
|
|
|
|
|
$str = $str . cut_to_printwidth( $tbl_copy->[$row][$col], $w_cols_calc->[$col] ); |
680
|
|
|
|
|
|
|
} |
681
|
|
|
|
|
|
|
elsif ( $str_w < $w_cols_calc->[$col] ) { |
682
|
0
|
|
|
|
|
|
$str = $str . $tbl_copy->[$row][$col] . ' ' x ( $w_cols_calc->[$col] - $str_w ); |
683
|
|
|
|
|
|
|
} |
684
|
|
|
|
|
|
|
else { |
685
|
0
|
|
|
|
|
|
$str = $str . $tbl_copy->[$row][$col]; |
686
|
|
|
|
|
|
|
} |
687
|
|
|
|
|
|
|
} |
688
|
0
|
0
|
|
|
|
|
if ( $self->{color} ) { |
689
|
0
|
0
|
|
|
|
|
if ( defined $tbl_orig->[$row][$col] ) { |
690
|
0
|
|
|
|
|
|
my @color = $tbl_orig->[$row][$col] =~ /(\e\[[\d;]*m)/g; |
691
|
0
|
|
|
|
|
|
$str =~ s/\x{feff}/shift @color/ge; |
|
0
|
|
|
|
|
|
|
692
|
0
|
0
|
|
|
|
|
if ( @color ) { |
693
|
0
|
|
|
|
|
|
$str = $str . $color[-1]; |
694
|
|
|
|
|
|
|
} |
695
|
|
|
|
|
|
|
} |
696
|
|
|
|
|
|
|
} |
697
|
0
|
0
|
|
|
|
|
if ( $col != $#$w_cols_calc ) { |
698
|
0
|
|
|
|
|
|
$str = $str . $tab; |
699
|
|
|
|
|
|
|
} |
700
|
|
|
|
|
|
|
} |
701
|
0
|
|
|
|
|
|
$tbl_copy->[$row] = $str; # overwrite $tbl_copy to save memory |
702
|
0
|
0
|
|
|
|
|
if ( $progress->{count_progress_bars} ) { # |
703
|
0
|
0
|
|
|
|
|
if ( $count >= $progress->{next_update} ) { # |
704
|
0
|
|
|
|
|
|
$progress->update_progress_bar( $count ); # |
705
|
|
|
|
|
|
|
} # |
706
|
0
|
|
|
|
|
|
++$count; # |
707
|
|
|
|
|
|
|
} # |
708
|
|
|
|
|
|
|
} |
709
|
0
|
0
|
|
|
|
|
if ( $progress->{count_progress_bars} ) { # |
710
|
0
|
|
|
|
|
|
$progress->last_update_progress_bar( $count ); # |
711
|
|
|
|
|
|
|
} # |
712
|
0
|
|
|
|
|
|
return $tbl_copy; # $tbl_copy is now $tbl_print |
713
|
|
|
|
|
|
|
} |
714
|
|
|
|
|
|
|
|
715
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
sub __print_single_row { |
717
|
0
|
|
|
0
|
|
|
my ( $self, $tbl_orig, $row, $w_col_names, $footer ) = @_; |
718
|
0
|
|
|
|
|
|
my $term_w = get_term_width(); |
719
|
0
|
|
|
|
|
|
my $max_key_w = max( @{$w_col_names} ) + 1; |
|
0
|
|
|
|
|
|
|
720
|
0
|
0
|
|
|
|
|
if ( $max_key_w > int( $term_w / 3 ) ) { |
721
|
0
|
|
|
|
|
|
$max_key_w = int( $term_w / 3 ); |
722
|
|
|
|
|
|
|
} |
723
|
0
|
|
|
|
|
|
my $separator = ' : '; |
724
|
0
|
|
|
|
|
|
my $sep_w = length( $separator ); |
725
|
0
|
|
|
|
|
|
my $max_value_w = $term_w - ( $max_key_w + $sep_w + 1 ); |
726
|
0
|
|
|
|
|
|
my $separator_row = ' '; |
727
|
0
|
|
|
|
|
|
my $row_data = [ ' Close with ENTER' ]; |
728
|
0
|
|
|
|
|
|
my $last_color_prev_value; |
729
|
|
|
|
|
|
|
|
730
|
0
|
|
|
|
|
|
for my $col ( 0 .. $#{$tbl_orig->[0]} ) { |
|
0
|
|
|
|
|
|
|
731
|
0
|
|
|
|
|
|
push @$row_data, $separator_row; |
732
|
0
|
|
0
|
|
|
|
my $key = $tbl_orig->[0][$col] // $self->{undef}; |
733
|
0
|
|
|
|
|
|
my @key_color; |
734
|
0
|
0
|
|
|
|
|
if ( $self->{color} ) { |
735
|
0
|
|
|
|
|
|
$key =~ s/\x{feff}//g; |
736
|
0
|
0
|
|
|
|
|
$key =~ s/(\e\[[\d;]*m)/push( @key_color, $1 ) && "\x{feff}"/ge; |
|
0
|
|
|
|
|
|
|
737
|
|
|
|
|
|
|
} |
738
|
0
|
0
|
0
|
|
|
|
if ( $self->{binary_filter} && substr( $key, 0, 100 ) =~ /[\x00-\x08\x0B-\x0C\x0E-\x1F]/ ) { |
739
|
|
|
|
|
|
|
#$key = $self->{binary_filter} == 2 ? sprintf("%v02X", $key) =~ tr/./ /r : $self->{binary_string}; # perl 5.14 |
740
|
0
|
0
|
|
|
|
|
if ( $self->{binary_filter} == 2 ) { |
741
|
0
|
|
|
|
|
|
( $key = sprintf("%v02X", $key) ) =~ tr/./ /; |
742
|
|
|
|
|
|
|
} |
743
|
|
|
|
|
|
|
else { |
744
|
0
|
|
|
|
|
|
$key = $self->{binary_string}; |
745
|
|
|
|
|
|
|
} |
746
|
|
|
|
|
|
|
} |
747
|
0
|
|
|
|
|
|
$key =~ s/\t/ /g; |
748
|
0
|
|
|
|
|
|
$key =~ s/\v+/\ \ /g; |
749
|
0
|
|
|
|
|
|
$key =~ s/[\p{Cc}\p{Noncharacter_Code_Point}\p{Cs}]//g; |
750
|
0
|
|
|
|
|
|
my $key_w = print_columns( $key ); |
751
|
0
|
0
|
|
|
|
|
if ( $key_w > $max_key_w ) { |
|
|
0
|
|
|
|
|
|
752
|
0
|
|
|
|
|
|
$key = cut_to_printwidth( $key, $max_key_w ); |
753
|
|
|
|
|
|
|
} |
754
|
|
|
|
|
|
|
elsif ( $key_w < $max_key_w ) { |
755
|
0
|
|
|
|
|
|
$key = ( ' ' x ( $max_key_w - $key_w ) ) . $key; |
756
|
|
|
|
|
|
|
} |
757
|
0
|
0
|
|
|
|
|
if ( @key_color ) { |
758
|
0
|
|
|
|
|
|
$key =~ s/\x{feff}/shift @key_color/ge; |
|
0
|
|
|
|
|
|
|
759
|
0
|
|
|
|
|
|
$key = $key . "\e[0m"; |
760
|
|
|
|
|
|
|
} |
761
|
0
|
|
|
|
|
|
my $value = $tbl_orig->[$row][$col]; |
762
|
|
|
|
|
|
|
# $value: color and invalid char handling in `line_fold` |
763
|
0
|
0
|
|
|
|
|
if ( ! length $value ) { |
764
|
0
|
|
|
|
|
|
$value = ' '; # to show also keys/columns with no values |
765
|
|
|
|
|
|
|
} |
766
|
0
|
0
|
|
|
|
|
if ( ref $value ) { |
767
|
0
|
|
|
|
|
|
$value = _handle_reference( $value ); |
768
|
|
|
|
|
|
|
} |
769
|
0
|
0
|
|
|
|
|
if ( $self->{color} ) { |
770
|
|
|
|
|
|
|
# color is reset only at the end of a table row |
771
|
0
|
0
|
0
|
|
|
|
if ( $col && length $tbl_orig->[$row][$col-1] ) { |
772
|
0
|
|
0
|
|
|
|
$last_color_prev_value = ( $tbl_orig->[$row][$col-1] =~ /(\e\[[\d;]*m)/g )[-1] // $last_color_prev_value; |
773
|
|
|
|
|
|
|
} |
774
|
0
|
0
|
|
|
|
|
if ( $last_color_prev_value ) { |
775
|
0
|
|
|
|
|
|
$value = $last_color_prev_value . $value; |
776
|
|
|
|
|
|
|
} |
777
|
|
|
|
|
|
|
} |
778
|
0
|
|
|
|
|
|
my $subseq_tab = ' ' x ( $max_key_w + $sep_w ); |
779
|
0
|
|
|
|
|
|
my $count; |
780
|
|
|
|
|
|
|
|
781
|
0
|
|
|
|
|
|
for my $line ( line_fold( $value, $max_value_w, { join => 0, color => $self->{color}, binary_filter => $self->{binary_filter} } ) ) { |
782
|
0
|
0
|
|
|
|
|
if ( ! $count++ ) { |
783
|
0
|
|
|
|
|
|
push @$row_data, $key . $separator . $line; |
784
|
|
|
|
|
|
|
} |
785
|
|
|
|
|
|
|
else { |
786
|
0
|
|
|
|
|
|
push @$row_data, $subseq_tab . $line; |
787
|
|
|
|
|
|
|
} |
788
|
|
|
|
|
|
|
} |
789
|
|
|
|
|
|
|
} |
790
|
0
|
|
|
|
|
|
my $regex = qr/^\Q$separator_row\E\z/; |
791
|
|
|
|
|
|
|
# Choose |
792
|
|
|
|
|
|
|
choose( |
793
|
|
|
|
|
|
|
$row_data, |
794
|
|
|
|
|
|
|
{ prompt => '', layout => 2, clear_screen => 1, mouse => $self->{mouse}, hide_cursor => 0, empty => ' ', |
795
|
|
|
|
|
|
|
search => $self->{search}, skip_items => $regex, footer => $footer, page => $self->{page}, |
796
|
|
|
|
|
|
|
color => $self->{color} } |
797
|
0
|
|
|
|
|
|
); |
798
|
|
|
|
|
|
|
} |
799
|
|
|
|
|
|
|
|
800
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
sub __search { |
802
|
0
|
|
|
0
|
|
|
my ( $self, $tbl_orig, $const, $search ) = @_; |
803
|
0
|
0
|
|
|
|
|
if ( ! $self->{search} ) { |
804
|
0
|
|
|
|
|
|
return; |
805
|
|
|
|
|
|
|
} |
806
|
0
|
|
|
|
|
|
require Term::Form::ReadLine; |
807
|
0
|
|
|
|
|
|
Term::Form::ReadLine->VERSION(0.544); |
808
|
0
|
|
|
|
|
|
my $term = Term::Form::ReadLine->new(); |
809
|
0
|
|
|
|
|
|
my $error_message; |
810
|
0
|
|
|
|
|
|
my $prompt = '> search-pattern: '; |
811
|
0
|
|
|
|
|
|
my $default = ''; |
812
|
|
|
|
|
|
|
|
813
|
0
|
|
|
|
|
|
READ: while ( 1 ) { |
814
|
0
|
0
|
|
|
|
|
my $string = $term->readline( |
815
|
|
|
|
|
|
|
$prompt, |
816
|
|
|
|
|
|
|
{ info => $error_message, hide_cursor => 2, clear_screen => defined $error_message ? 1 : 2, |
817
|
|
|
|
|
|
|
default => $default } |
818
|
|
|
|
|
|
|
); |
819
|
0
|
0
|
|
|
|
|
if ( ! length $string ) { |
820
|
0
|
|
|
|
|
|
return; |
821
|
|
|
|
|
|
|
} |
822
|
0
|
|
|
|
|
|
print "\r${prompt}${string}"; |
823
|
0
|
0
|
|
|
|
|
if ( ! eval { |
824
|
0
|
0
|
|
|
|
|
$search->{filter} = $self->{search} == 1 ? qr/$string/i : qr/$string/; |
825
|
0
|
|
|
|
|
|
'Teststring' =~ $search->{filter}; |
826
|
0
|
|
|
|
|
|
1 |
827
|
|
|
|
|
|
|
} ) { |
828
|
0
|
0
|
|
|
|
|
$default = $default eq $string ? '' : $string; |
829
|
0
|
|
|
|
|
|
$error_message = "$@"; |
830
|
0
|
|
|
|
|
|
next READ; |
831
|
|
|
|
|
|
|
} |
832
|
0
|
|
|
|
|
|
last READ; |
833
|
|
|
|
|
|
|
} |
834
|
1
|
|
|
1
|
|
5230
|
no warnings 'uninitialized'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
644
|
|
835
|
0
|
|
|
|
|
|
my @col_idx = ( 0 .. $#{$tbl_orig->[0]} ); |
|
0
|
|
|
|
|
|
|
836
|
|
|
|
|
|
|
# begin: "1" to skipp the header row |
837
|
|
|
|
|
|
|
# end: "data_row_count" as it its because +1 for the header row and -1 to get the 0-based index |
838
|
0
|
|
|
|
|
|
for my $idx_row ( 1 .. $const->{data_row_count} ) { |
839
|
0
|
|
|
|
|
|
for ( @col_idx ) { |
840
|
0
|
0
|
|
|
|
|
if ( $tbl_orig->[$idx_row][$_] =~ /$search->{filter}/ ) { |
841
|
0
|
|
|
|
|
|
push @{$search->{map_indexes}}, $idx_row; |
|
0
|
|
|
|
|
|
|
842
|
0
|
|
|
|
|
|
last; |
843
|
|
|
|
|
|
|
} |
844
|
|
|
|
|
|
|
} |
845
|
|
|
|
|
|
|
} |
846
|
0
|
0
|
|
|
|
|
if ( ! @{$search->{map_indexes}} ) { |
|
0
|
|
|
|
|
|
|
847
|
0
|
|
|
|
|
|
my $message = '/' . $search->{filter} . '/: No matches found.'; |
848
|
|
|
|
|
|
|
# Choose |
849
|
0
|
|
|
|
|
|
choose( |
850
|
|
|
|
|
|
|
[ 'Continue with ENTER' ], |
851
|
|
|
|
|
|
|
{ prompt => $message, layout => 0, clear_screen => 1 } |
852
|
|
|
|
|
|
|
); |
853
|
0
|
|
|
|
|
|
$search->{filter} = ''; |
854
|
0
|
|
|
|
|
|
return; |
855
|
|
|
|
|
|
|
} |
856
|
0
|
|
|
|
|
|
return; |
857
|
|
|
|
|
|
|
} |
858
|
|
|
|
|
|
|
|
859
|
|
|
|
|
|
|
|
860
|
|
|
|
|
|
|
sub __reset_search { |
861
|
0
|
|
|
0
|
|
|
my ( $self, $search ) = @_; |
862
|
0
|
|
|
|
|
|
$search->{map_indexes} = []; |
863
|
0
|
|
|
|
|
|
$search->{filter} = ''; |
864
|
|
|
|
|
|
|
} |
865
|
|
|
|
|
|
|
|
866
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
sub __header_sep { |
868
|
0
|
|
|
0
|
|
|
my ( $self, $w_cols_calc ) = @_; |
869
|
0
|
|
|
|
|
|
my $tab = ( '-' x int( $self->{tab_w} / 2 ) ) . '|' . ( '-' x int( $self->{tab_w} / 2 ) ); |
870
|
0
|
|
|
|
|
|
my $header_sep = ''; |
871
|
0
|
|
|
|
|
|
for my $col ( 0 .. $#$w_cols_calc ) { |
872
|
0
|
|
|
|
|
|
$header_sep .= '-' x $w_cols_calc->[$col]; |
873
|
0
|
0
|
|
|
|
|
if ( $col != $#$w_cols_calc ) { |
874
|
0
|
|
|
|
|
|
$header_sep .= $tab; |
875
|
|
|
|
|
|
|
} |
876
|
|
|
|
|
|
|
} |
877
|
0
|
|
|
|
|
|
return $header_sep; |
878
|
|
|
|
|
|
|
} |
879
|
|
|
|
|
|
|
|
880
|
|
|
|
|
|
|
|
881
|
|
|
|
|
|
|
sub _handle_reference { |
882
|
0
|
|
|
0
|
|
|
require Data::Dumper; |
883
|
0
|
|
|
|
|
|
local $Data::Dumper::Useqq = 1; |
884
|
0
|
|
|
|
|
|
local $Data::Dumper::Indent = 0; |
885
|
0
|
|
|
|
|
|
local $Data::Dumper::Terse = 1; |
886
|
0
|
|
|
|
|
|
local $Data::Dumper::Maxdepth = 2; |
887
|
0
|
|
|
|
|
|
return 'ref: ' . Data::Dumper::Dumper( $_[0] ); |
888
|
|
|
|
|
|
|
} |
889
|
|
|
|
|
|
|
|
890
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
sub __print_term_not_wide_enough_message { |
892
|
0
|
|
|
0
|
|
|
my ( $self, $tbl_copy ) = @_; |
893
|
0
|
|
|
|
|
|
my $prompt_1 = 'To many columns - terminal window is not wide enough.'; |
894
|
|
|
|
|
|
|
# Choose |
895
|
|
|
|
|
|
|
choose( |
896
|
|
|
|
|
|
|
[ 'Press ENTER to show the column names.' ], |
897
|
0
|
|
|
|
|
|
{ prompt => $prompt_1, clear_screen => 1, mouse => $self->{mouse}, hide_cursor => 0 } |
898
|
|
|
|
|
|
|
); |
899
|
0
|
|
|
|
|
|
my $prompt_2 = 'Column names (close with ENTER).'; |
900
|
|
|
|
|
|
|
# Choose |
901
|
|
|
|
|
|
|
choose( |
902
|
|
|
|
|
|
|
$tbl_copy->[0], |
903
|
|
|
|
|
|
|
{ prompt => $prompt_2, clear_screen => 1, mouse => $self->{mouse}, hide_cursor => 0, search => $self->{search} } |
904
|
0
|
|
|
|
|
|
); |
905
|
|
|
|
|
|
|
} |
906
|
|
|
|
|
|
|
|
907
|
|
|
|
|
|
|
|
908
|
|
|
|
|
|
|
sub _minus_x_percent { |
909
|
|
|
|
|
|
|
#my ( $value, $percent ) = @_; |
910
|
0
|
|
0
|
0
|
|
|
return int( $_[0] - ( $_[0] / 100 * $_[1] ) ) || 1; |
911
|
|
|
|
|
|
|
} |
912
|
|
|
|
|
|
|
|
913
|
|
|
|
|
|
|
|
914
|
|
|
|
|
|
|
|
915
|
|
|
|
|
|
|
|
916
|
|
|
|
|
|
|
|
917
|
|
|
|
|
|
|
|
918
|
|
|
|
|
|
|
|
919
|
|
|
|
|
|
|
|
920
|
|
|
|
|
|
|
1; |
921
|
|
|
|
|
|
|
|
922
|
|
|
|
|
|
|
__END__ |