File Coverage

blib/lib/Term/Form.pm
Criterion Covered Total %
statement 45 758 5.9
branch 3 314 0.9
condition 0 83 0.0
subroutine 14 63 22.2
pod 2 2 100.0
total 64 1220 5.2


line stmt bran cond sub pod time code
1             package Term::Form;
2              
3 3     3   167173 use warnings;
  3         34  
  3         82  
4 3     3   13 use strict;
  3         6  
  3         44  
5 3     3   32 use 5.10.0;
  3         6  
6              
7             our $VERSION = '0.552';
8 3     3   16 use Exporter 'import';
  3         5  
  3         124  
9             our @EXPORT_OK = qw( fill_form );
10              
11 3     3   19 use Carp qw( croak );
  3         4  
  3         123  
12 3     3   14 use List::Util qw( any );
  3         4  
  3         313  
13              
14 3     3   1180 use Term::Choose::LineFold qw( line_fold print_columns cut_to_printwidth );
  3         193566  
  3         348  
15 3     3   35 use Term::Choose::Constants qw( :all );
  3         7  
  3         912  
16 3     3   24 use Term::Choose::Screen qw( :all );
  3         6  
  3         387  
17 3     3   1473 use Term::Choose::Util qw( unicode_sprintf get_term_size );
  3         102138  
  3         198  
18 3     3   26 use Term::Choose::ValidateOptions qw( validate_options );
  3         7  
  3         204  
19              
20             my $Plugin;
21              
22             BEGIN {
23 3 50   3   17 if ( $^O eq 'MSWin32' ) {
24 0         0 require Term::Choose::Win32;
25 0         0 require Win32::Console::ANSI;
26 0         0 $Plugin = 'Term::Choose::Win32';
27             }
28             else {
29 3         14 require Term::Choose::Linux;
30 3         2602 $Plugin = 'Term::Choose::Linux';
31             }
32             }
33              
34              
35             sub new {
36 1     1 1 77 my $class = shift;
37 1 50       6 croak "new: called with " . @_ . " arguments - 0 or 1 arguments expected." if @_ > 1;
38 1         2 my ( $opt ) = @_;
39 1         4 my $instance_defaults = _defaults();
40 1 50       4 if ( defined $opt ) {
41 0 0       0 croak "new: The (optional) argument is not a HASH reference." if ref $opt ne 'HASH';
42 0         0 my $caller = 'new';
43 0         0 validate_options( _valid_options( $caller ), $opt, $caller );
44 0         0 for my $key ( keys %$opt ) {
45 0 0       0 $instance_defaults->{$key} = $opt->{$key} if defined $opt->{$key};
46             }
47             }
48 1         2 my $self = bless $instance_defaults, $class;
49 1         10 $self->{backup_instance_defaults} = { %$instance_defaults };
50 1         9 $self->{plugin} = $Plugin->new();
51 1         17 return $self;
52             }
53              
54              
55             sub _valid_options {
56             return {
57 0     0   0 codepage_mapping => '[ 0 1 ]',
58             auto_up => '[ 0 1 2 ]',
59             clear_screen => '[ 0 1 2 ]',
60             color => '[ 0 1 2 ]', # hide_cursor == 2 # documentation
61             hide_cursor => '[ 0 1 2 ]',
62             page => '[ 0 1 2 ]', # undocumented
63             keep => '[ 1-9 ][ 0-9 ]*', # undocumented
64             read_only => 'Array_Int',
65             skip_items => 'Regexp', # undocumented
66             # only keys are checked, passed values are ignored
67             # it's up to the user to remove the skipped items from the returned array
68             back => 'Str',
69             confirm => 'Str',
70             footer => 'Str', # undocumented
71             info => 'Str',
72             prompt => 'Str',
73             };
74             }
75              
76              
77             sub _defaults {
78             return {
79 1     1   13 auto_up => 0,
80             back => ' BACK',
81             clear_screen => 0,
82             codepage_mapping => 0,
83             color => 0,
84             confirm => 'CONFIRM',
85             footer => '',
86             hide_cursor => 1,
87             info => '',
88             keep => 5,
89             page => 1,
90             prompt => '',
91             read_only => [],
92             skip_items => undef,
93             };
94             }
95              
96              
97             sub __init_term {
98 0     0     my ( $self ) = @_;
99 0           $self->{plugin}->__set_mode( { mode => 'cbreak', hide_cursor => 0 } );
100             }
101              
102              
103             sub __reset_term {
104 0     0     my ( $self, $up ) = @_;
105 0 0         if ( defined $self->{plugin} ) {
106 0           $self->{plugin}->__reset_mode( { hide_cursor => 0 } );
107             }
108 0 0         if ( $up ) {
109 0           print up( $up );
110             }
111 0 0         if ( $self->{clear_screen} == 2 ) { # readline
112 0           print "\r" . clear_to_end_of_line();
113             }
114             else {
115 0           print "\r" . clear_to_end_of_screen();
116             }
117 0 0         if ( $self->{hide_cursor} == 1 ) {
    0          
118 0           print show_cursor();
119             }
120             elsif ( $self->{hide_cursor} == 2 ) {
121 0           print hide_cursor();
122             }
123             }
124              
125              
126             sub __reset {
127 0     0     my ( $self, $up ) = @_;
128 0           $self->__reset_term( $up );
129 0 0         if ( exists $self->{backup_instance_defaults} ) {
130 0           my $instance_defaults = $self->{backup_instance_defaults};
131 0           for my $key ( keys %$self ) {
132 0 0 0       if ( $key eq 'plugin' || $key eq 'backup_instance_defaults' ) {
    0          
133 0           next;
134             }
135             elsif ( exists $instance_defaults->{$key} ) {
136 0           $self->{$key} = $instance_defaults->{$key};
137             }
138             else {
139 0           delete $self->{$key};
140             }
141             }
142             }
143             }
144              
145              
146             sub __get_list {
147 0     0     my ( $self, $orig_list ) = @_;
148 0           my $list;
149 0 0         if ( $self->{color} ) {
150 0           $list = [ @{$self->{i}{pre}} ];
  0            
151 0           my $count = @{$self->{i}{pre}};
  0            
152 0           for my $entry ( @$orig_list ) {
153 0           my ( $key, $value ) = @$entry;
154 0           my @color;
155 0           $key =~ s/\x{feff}//g;
156 0 0         $key =~ s/(\e\[[\d;]*m)/push( @color, $1 ) && "\x{feff}"/ge;
  0            
157 0           $self->{i}{key_colors}[$count++] = [ @color ];
158 0           push @$list, [ $self->__sanitized_string( $key ), $value ];
159             }
160             }
161             else {
162 0           $list = [ @{$self->{i}{pre}}, map { [ $self->__sanitized_string( $_->[0] ), $_->[1] ] } @$orig_list ];
  0            
  0            
163             }
164 0           return $list;
165             }
166              
167              
168             sub __limit_key_w {
169 0     0     my ( $self, $term_w ) = @_;
170 0 0         if ( $self->{i}{max_key_w} > $term_w / 3 ) {
171 0           $self->{i}{max_key_w} = int( $term_w / 3 );
172             }
173             }
174              
175              
176             sub __available_width {
177 0     0     my ( $self, $term_w ) = @_;
178 0           $self->{i}{avail_w} = $term_w - ( $self->{i}{max_key_w} + length( $self->{i}{sep} ) + $self->{i}{arrow_w} );
179             # Subtract $self->{i}{arrow_w} for the '<' before the string.
180             # In each case where no '<'-prefix is required (diff==0) $self->{i}{arrow_w} is added again.
181             # Routins where $self->{i}{arrow_w} is added: __left, __bspace, __home, __ctrl_u, __delete
182             # The required space (1) for the cursor (or the '>') behind the string is already subtracted in get_term_size
183             }
184              
185              
186             sub __threshold_width {
187 0     0     my ( $self ) = @_;
188 0           $self->{i}{th} = int( $self->{i}{avail_w} / 5 );
189 0 0         $self->{i}{th} = 40 if $self->{i}{th} > 40; ##
190             }
191              
192              
193             sub __sanitized_string {
194 0     0     my ( $self, $str ) = @_;
195 0 0         if ( defined $str ) {
196 0           $str =~ s/\t/ /g;
197 0           $str =~ s/\v+/\ \ /g;
198 0           $str =~ s/[\p{Cc}\p{Noncharacter_Code_Point}\p{Cs}]//g;
199             }
200             else {
201 0           $str = '';
202             }
203 0           return $str;
204             }
205              
206              
207             sub __threshold_char_count {
208 0     0     my ( $self, $m ) = @_;
209 0           $m->{th_l} = 0;
210 0           $m->{th_r} = 0;
211 0           my ( $tmp_w, $count ) = ( 0, 0 );
212 0           for ( @{$m->{p_str}} ) {
  0            
213 0           $tmp_w += $_->[1];
214 0           ++$count;
215 0 0         if ( $tmp_w > $self->{i}{th} ) {
216 0           $m->{th_l} = $count;
217 0           last;
218             }
219             }
220 0           ( $tmp_w, $count ) = ( 0, 0 );
221 0           for ( reverse @{$m->{p_str}} ) {
  0            
222 0           $tmp_w += $_->[1];
223 0           ++$count;
224 0 0         if ( $tmp_w > $self->{i}{th} ) {
225 0           $m->{th_r} = $count;
226 0           last;
227             }
228             }
229             }
230              
231              
232             sub __string_and_pos {
233 0     0     my ( $self, $list ) = @_;
234 0           my $default = $list->[$self->{i}{curr_row}][1];
235 0 0         if ( ! defined $default ) {
236 0           $default = '';
237             }
238             my $m = {
239             avail_w => $self->{i}{avail_w},
240 0           th_l => 0,
241             th_r => 0,
242             str => [],
243             str_w => 0,
244             pos => 0,
245             p_str => [],
246             p_str_w => 0,
247             p_pos => 0,
248             diff => 0,
249             };
250 0           for ( $default =~ /\X/g ) {
251 0           my $char_w = print_columns( $_ );
252 0           push @{$m->{str}}, [ $_, $char_w ];
  0            
253 0           $m->{str_w} += $char_w;
254             }
255 0           $m->{pos} = @{$m->{str}};
  0            
256 0           $m->{diff} = $m->{pos};
257 0           _unshift_till_avail_w( $m, [ 0 .. $#{$m->{str}} ] );
  0            
258 0           return $m;
259             }
260              
261              
262             sub __left {
263 0     0     my ( $self, $m ) = @_;
264 0 0         if ( $m->{pos} ) {
265 0           $m->{pos}--;
266             # '<=' and not '==' because th_l could change and fall behind p_pos
267 0   0       while ( $m->{p_pos} <= $m->{th_l} && $m->{diff} ) {
268 0           _unshift_element( $m, $m->{pos} - $m->{p_pos} );
269             }
270 0 0         if ( ! $m->{diff} ) { # no '<'
271 0           $m->{avail_w} = $self->{i}{avail_w} + $self->{i}{arrow_w};
272 0           _push_till_avail_w( $m, [ $#{$m->{p_str}} + 1 .. $#{$m->{str}} ] );
  0            
  0            
273             }
274 0           $m->{p_pos}--;
275             }
276             else {
277 0           $self->{i}{beep} = 1;
278             }
279             }
280              
281              
282             sub __right {
283 0     0     my ( $self, $m ) = @_;
284 0 0         if ( $m->{pos} < $#{$m->{str}} ) {
  0 0          
285 0           $m->{pos}++;
286             # '>=' and not '==' because th_r could change and fall in front of p_pos
287 0   0       while ( $m->{p_pos} >= $#{$m->{p_str}} - $m->{th_r} && $#{$m->{p_str}} + $m->{diff} != $#{$m->{str}} ) {
  0            
  0            
  0            
288 0           _push_element( $m );
289             }
290 0           $m->{p_pos}++;
291             }
292 0           elsif ( $m->{pos} == $#{$m->{str}} ) {
293             #rec w if vw
294 0           $m->{pos}++;
295 0           $m->{p_pos}++;
296             # cursor now behind the string at the end position
297             }
298             else {
299 0           $self->{i}{beep} = 1;
300             }
301             }
302              
303             sub __bspace {
304 0     0     my ( $self, $m ) = @_;
305 0 0         if ( $m->{pos} ) {
306 0           $m->{pos}--;
307             # '<=' and not '==' because th_l could change and fall behind p_pos
308 0   0       while ( $m->{p_pos} <= $m->{th_l} && $m->{diff} ) {
309 0           _unshift_element( $m, $m->{pos} - $m->{p_pos} );
310             }
311 0           $m->{p_pos}--;
312 0 0         if ( ! $m->{diff} ) { # no '<'
313 0           $m->{avail_w} = $self->{i}{avail_w} + $self->{i}{arrow_w};
314             }
315 0           _remove_pos( $m );
316             }
317             else {
318 0           $self->{i}{beep} = 1;
319             }
320             }
321              
322             sub __delete {
323 0     0     my ( $self, $m ) = @_;
324 0 0         if ( $m->{pos} < @{$m->{str}} ) {
  0            
325 0 0         if ( ! $m->{diff} ) { # no '<'
326 0           $m->{avail_w} = $self->{i}{avail_w} + $self->{i}{arrow_w};
327             }
328 0           _remove_pos( $m );
329             }
330             else {
331 0           return;
332             }
333             }
334              
335             sub __ctrl_u {
336 0     0     my ( $self, $m ) = @_;
337 0 0         if ( $m->{pos} ) {
338 0           for my $removed ( splice ( @{$m->{str}}, 0, $m->{pos} ) ) {
  0            
339 0           $m->{str_w} -= $removed->[1];
340             }
341             # diff always 0 # never '<'
342 0           $m->{avail_w} = $self->{i}{avail_w} + $self->{i}{arrow_w};
343 0           _fill_from_begin( $m );
344             }
345             else {
346 0           $self->{i}{beep} = 1;
347             }
348             }
349              
350             sub __ctrl_k {
351 0     0     my ( $self, $m ) = @_;
352 0 0         if ( $m->{pos} < @{$m->{str}} ) {
  0            
353 0           for my $removed ( splice ( @{$m->{str}}, $m->{pos}, @{$m->{str}} - $m->{pos} ) ) {
  0            
  0            
354 0           $m->{str_w} -= $removed->[1];
355             }
356 0           _fill_from_end( $m );
357             }
358             else {
359 0           $self->{i}{beep} = 1;
360             }
361             }
362              
363             sub __home {
364 0     0     my ( $self, $m ) = @_;
365 0 0         if ( $m->{pos} > 0 ) {
366             # diff always 0 # never '<'
367 0           $m->{avail_w} = $self->{i}{avail_w} + $self->{i}{arrow_w};
368 0           _fill_from_begin( $m );
369             }
370             else {
371 0           $self->{i}{beep} = 1;
372             }
373             }
374              
375             sub __end {
376 0     0     my ( $self, $m ) = @_;
377 0 0         if ( $m->{pos} < @{$m->{str}} ) {
  0            
378 0           _fill_from_end( $m );
379             }
380             else {
381 0           $self->{i}{beep} = 1;
382             }
383             }
384              
385             sub __add_char {
386 0     0     my ( $self, $m, $char ) = @_;
387 0           my $char_w = print_columns( $char );
388 0           splice( @{$m->{str}}, $m->{pos}, 0, [ $char, $char_w ] );
  0            
389 0           $m->{pos}++;
390 0           splice( @{$m->{p_str}}, $m->{p_pos}, 0, [ $char, $char_w ] );
  0            
391 0           $m->{p_pos}++;
392 0           $m->{p_str_w} += $char_w;
393 0           $m->{str_w} += $char_w;
394             # no '<' if:
395 0 0 0       if ( ! $m->{diff} && $m->{p_pos} < $self->{i}{avail_w} + $self->{i}{arrow_w} ) {
396 0           $m->{avail_w} = $self->{i}{avail_w} + $self->{i}{arrow_w};
397             }
398 0           while ( $m->{p_pos} < $#{$m->{p_str}} ) {
  0            
399 0 0         if ( $m->{p_str_w} <= $m->{avail_w} ) {
400 0           last;
401             }
402 0           my $tmp = pop @{$m->{p_str}};
  0            
403 0           $m->{p_str_w} -= $tmp->[1];
404             }
405 0           while ( $m->{p_str_w} > $m->{avail_w} ) {
406 0           my $tmp = shift @{$m->{p_str}};
  0            
407 0           $m->{p_str_w} -= $tmp->[1];
408 0           $m->{p_pos}--;
409 0           $m->{diff}++;
410             }
411             }
412              
413             sub _unshift_element {
414 0     0     my ( $m, $pos ) = @_;
415 0           my $tmp = $m->{str}[$pos];
416 0           unshift @{$m->{p_str}}, $tmp;
  0            
417 0           $m->{p_str_w} += $tmp->[1];
418 0           $m->{diff}--;
419 0           $m->{p_pos}++;
420 0           while ( $m->{p_str_w} > $m->{avail_w} ) {
421 0           my $tmp = pop @{$m->{p_str}};
  0            
422 0           $m->{p_str_w} -= $tmp->[1];
423             }
424             }
425              
426             sub _push_element {
427 0     0     my ( $m ) = @_;
428 0           my $tmp = $m->{str}[$#{$m->{p_str}} + $m->{diff} + 1];
  0            
429 0           push @{$m->{p_str}}, $tmp;
  0            
430 0 0         if ( defined $tmp->[1] ) {
431 0           $m->{p_str_w} += $tmp->[1];
432             }
433 0           while ( $m->{p_str_w} > $m->{avail_w} ) {
434 0           my $tmp = shift @{$m->{p_str}};
  0            
435 0           $m->{p_str_w} -= $tmp->[1];
436 0           $m->{diff}++;
437 0           $m->{p_pos}--;
438             }
439             }
440              
441             sub _unshift_till_avail_w {
442 0     0     my ( $m, $idx ) = @_;
443 0           for ( @{$m->{str}}[reverse @$idx] ) {
  0            
444 0 0         if ( $m->{p_str_w} + $_->[1] > $m->{avail_w} ) {
445 0           last;
446             }
447 0           unshift @{$m->{p_str}}, $_;
  0            
448 0           $m->{p_str_w} += $_->[1];
449 0           $m->{p_pos}++; # p_pos stays on the last element of the p_str
450 0           $m->{diff}--; # diff: difference between p_pos and pos; pos is always bigger or equal p_pos
451             }
452             }
453              
454             sub _push_till_avail_w {
455 0     0     my ( $m, $idx ) = @_;
456 0           for ( @{$m->{str}}[@$idx] ) {
  0            
457 0 0         if ( $m->{p_str_w} + $_->[1] > $m->{avail_w} ) {
458 0           last;
459             }
460 0           push @{$m->{p_str}}, $_;
  0            
461 0           $m->{p_str_w} += $_->[1];
462             }
463             }
464              
465             sub _remove_pos {
466 0     0     my ( $m ) = @_;
467 0           splice( @{$m->{str}}, $m->{pos}, 1 );
  0            
468 0           my $tmp = splice( @{$m->{p_str}}, $m->{p_pos}, 1 );
  0            
469 0           $m->{p_str_w} -= $tmp->[1];
470 0           $m->{str_w} -= $tmp->[1];
471 0           _push_till_avail_w( $m, [ ( $#{$m->{p_str}} + $m->{diff} + 1 ) .. $#{$m->{str}} ] );
  0            
  0            
472             }
473              
474             sub _fill_from_end {
475 0     0     my ( $m ) = @_;
476 0           $m->{pos} = @{$m->{str}};
  0            
477 0           $m->{p_str} = [];
478 0           $m->{p_str_w} = 0;
479 0           $m->{diff} = @{$m->{str}};
  0            
480 0           $m->{p_pos} = 0;
481 0           _unshift_till_avail_w( $m, [ 0 .. $#{$m->{str}} ] );
  0            
482             }
483              
484             sub _fill_from_begin {
485 0     0     my ( $m ) = @_;
486 0           $m->{pos} = 0;
487 0           $m->{p_pos} = 0;
488 0           $m->{diff} = 0;
489 0           $m->{p_str} = [];
490 0           $m->{p_str_w} = 0;
491 0           _push_till_avail_w( $m, [ 0 .. $#{$m->{str}} ] );
  0            
492             }
493              
494              
495             sub __print_readline {
496 0     0     my ( $self, $m ) = @_;
497 0           my $i = $self->{i}{curr_row};
498 0           print "\r" . clear_to_end_of_line();
499 0           print $self->{i}{keys}[$i] . $self->{i}{seps}[$i];
500 0 0 0       if ( $self->{no_echo} && $self->{no_echo} == 2 ) {
501 0           return;
502             }
503 0           my $print_str = '';
504             # left arrow:
505 0 0         if ( $m->{diff} ) {
506 0           $print_str .= $self->{i}{arrow_left};
507             }
508             # input text:
509 0 0         if ( $self->{no_echo} ) {
510 0           $print_str .= ( '*' x @{$m->{p_str}} );
  0            
511             }
512             else {
513 0           $print_str .= join( '', map { $_->[0] } @{$m->{p_str}} );
  0            
  0            
514             }
515             # right arrow:
516 0 0         if ( @{$m->{p_str}} + $m->{diff} != @{$m->{str}} ) {
  0            
  0            
517 0           $print_str .= $self->{i}{arrow_right};
518             }
519 0           my $back_to_pos = 0;
520 0           for ( @{$m->{p_str}}[$m->{p_pos} .. $#{$m->{p_str}}] ) {
  0            
  0            
521 0           $back_to_pos += $_->[1];
522             }
523 0 0         if ( $self->{hide_cursor} ) {
524 0           print show_cursor();
525             }
526 0           print $print_str;
527 0 0         if ( $back_to_pos ) {
528 0           print left( $back_to_pos );
529             }
530             }
531              
532              
533             sub __unicode_trim {
534 0     0     my ( $self, $str, $len ) = @_;
535 0 0         return $str if print_columns( $str ) <= $len;
536 0           return cut_to_printwidth( $str, $len - 3, 0 ) . '...';
537             }
538              
539              
540             sub __length_longest_key {
541 0     0     my ( $self, $list ) = @_;
542 0           my $longest = 0;
543 0           for my $i ( 0 .. $#$list ) {
544 0 0         if ( $i < @{$self->{i}{pre}} ) {
  0            
545 0           next;
546             }
547 0 0   0     if ( any { $_ == $i } @{$self->{i}{keys_to_skip}} ) {
  0            
  0            
548 0           next;
549             }
550 0           my $len = print_columns( $list->[$i][0] );
551 0 0         $longest = $len if $len > $longest;
552             }
553 0           $self->{i}{max_key_w} = $longest;
554             }
555              
556              
557             sub __prepare_hight {
558 0     0     my ( $self, $list, $term_w, $term_h ) = @_;
559 0           $self->{i}{avail_h} = $term_h;
560 0 0         if ( length $self->{i}{info_prompt} ) {
561 0           my $info_w = $term_w;
562 0 0 0       if ( $^O ne 'MSWin32' && $^O ne 'cygwin' ) {
563 0           $info_w += WIDTH_CURSOR;
564             }
565 0           my @info_prompt = line_fold( $self->{i}{info_prompt}, $info_w, { color => $self->{color}, join => 0 } );
566 0           $self->{i}{info_prompt_row_count} = @info_prompt;
567 0           $self->{i}{info_prompt} = join "\n", @info_prompt;
568 0           $self->{i}{avail_h} -= $self->{i}{info_prompt_row_count};
569 0           my $min_avail_h = $self->{keep};
570 0 0         if ( $term_h < $min_avail_h ) {
571 0           $min_avail_h = $term_h;
572             }
573 0 0         if ( $self->{i}{avail_h} < $min_avail_h ) {
574 0           $self->{i}{avail_h} = $min_avail_h;
575             }
576             }
577             else {
578 0           $self->{i}{info_prompt_row_count} = 0;
579             }
580 0 0         if ( @$list > $self->{i}{avail_h} ) {
581 0           $self->{i}{page_count} = int @$list / ( $self->{i}{avail_h} - 1 );
582 0 0         if ( @$list % ( $self->{i}{avail_h} - 1 ) ) {
583 0           $self->{i}{page_count}++;
584             }
585             }
586             else {
587 0           $self->{i}{page_count} = 1;
588             }
589 0 0 0       if ( $self->{page} == 2 || ( $self->{page} == 1 && $self->{i}{page_count} > 1) ) {
      0        
590 0           $self->{i}{print_footer} = 1;
591 0           $self->{i}{avail_h}--;
592             }
593             else {
594 0           $self->{i}{print_footer} = 0;
595             }
596 0           return;
597             }
598              
599              
600             sub __print_current_row {
601 0     0     my ( $self, $list, $m ) = @_;
602 0           print "\r" . clear_to_end_of_line();
603 0 0         if ( $self->{i}{curr_row} < @{$self->{i}{pre}} ) {
  0            
604 0           print reverse_video();
605 0           print $list->[$self->{i}{curr_row}][0];
606 0           print normal();
607             }
608             else {
609 0           $self->__print_readline( $m );
610 0 0         $list->[$self->{i}{curr_row}][1] = join( '', map { defined $_->[0] ? $_->[0] : '' } @{$m->{str}} );
  0            
  0            
611             }
612             }
613              
614              
615             sub __get_row_section_separator {
616 0     0     my ( $self, $list, $idx ) = @_;
617 0           my $remainder = '';
618 0           my $val = '';
619 0           ( $self->{i}{keys}[$idx], $remainder ) = cut_to_printwidth( $list->[$idx][0], $self->{i}{max_key_w}, 1 );
620 0 0         if ( length $remainder ) {
621 0           ( $self->{i}{seps}[$idx], $remainder ) = cut_to_printwidth( $remainder, 2, 1 );
622 0 0         if ( length $remainder ) {
623 0           $val = cut_to_printwidth( $remainder, $self->{i}{avail_w}, 0 );
624             }
625             }
626 0 0         if ( ! length $self->{i}{seps}[$idx] ) {
    0          
627 0           $self->{i}{seps}[$idx] = ' ';
628             }
629             elsif ( length $self->{i}{seps}[$idx] == 1 ) {
630 0           $self->{i}{seps}[$idx] .= ' ';
631             }
632 0           my $row = $self->{i}{keys}[$idx] . $self->{i}{seps}[$idx] . $val;
633 0 0 0       if ( exists $self->{i}{key_colors} && @{$self->{i}{key_colors}[$idx]} ) {
  0            
634 0           my @key_colors = @{$self->{i}{key_colors}[$idx]};
  0            
635 0           $row =~ s/\x{feff}/shift @key_colors/ge;
  0            
636 0           $row .= normal();
637             }
638 0           return $row;
639             }
640              
641              
642             sub __get_row {
643 0     0     my ( $self, $list, $idx ) = @_;
644 0 0         if ( $idx < @{$self->{i}{pre}} ) {
  0            
645 0           return $list->[$idx][0];
646             }
647 0 0   0     if ( any { $_ == $idx } @{$self->{i}{keys_to_skip}} ) {
  0            
  0            
648 0           return $self->__get_row_section_separator( $list, $idx ); ## name
649             }
650 0 0         if ( ! defined $self->{i}{keys}[$idx] ) {
651 0           my $key = $list->[$idx][0];
652 0           $self->{i}{keys}[$idx] = unicode_sprintf( $key, $self->{i}{max_key_w} );
653             }
654 0 0         if ( ! defined $self->{i}{seps}[$idx] ) {
655 0 0   0     if ( any { $_ == $idx } @{$self->{i}{read_only}} ) {
  0            
  0            
656 0           $self->{i}{seps}[$idx] = $self->{i}{sep_ro};
657             }
658             else {
659 0           $self->{i}{seps}[$idx] = $self->{i}{sep};
660             }
661             }
662 0 0 0       if ( exists $self->{i}{key_colors} && @{$self->{i}{key_colors}[$idx]} ) {
  0            
663 0           my @key_colors = @{$self->{i}{key_colors}[$idx]};
  0            
664 0           $self->{i}{keys}[$idx] =~ s/\x{feff}/shift @key_colors/ge;
  0            
665 0           $self->{i}{keys}[$idx] .= normal();
666             }
667 0 0         if ( defined $list->[$idx][1] ) {
668 0           my $val = $self->__unicode_trim( $list->[$idx][1], $self->{i}{avail_w} );
669 0           return $self->{i}{keys}[$idx] . $self->{i}{seps}[$idx] . $val;
670             }
671             else {
672 0           return $self->{i}{keys}[$idx] . $self->{i}{seps}[$idx];
673             }
674             }
675              
676              
677             sub __write_screen {
678 0     0     my ( $self, $list ) = @_;
679 0           my @rows;
680 0           for my $idx ( $self->{i}{begin_row} .. $self->{i}{end_row} ) {
681 0           push @rows, $self->__get_row( $list, $idx );
682             }
683 0           print join "\n", @rows;
684 0           $self->{i}{curr_page} = int( $self->{i}{end_row} / $self->{i}{avail_h} ) + 1;
685 0           my $up = 0;
686 0 0         if ( $self->{i}{print_footer} ) {
687 0           my $trailing_empty_page_rows = $self->{i}{avail_h} - ( $self->{i}{end_row} - $self->{i}{begin_row} );
688 0 0         if ( $trailing_empty_page_rows > 1 ) {
689 0           print "\n" x ( $trailing_empty_page_rows - 1 );
690             }
691 0           print "\n", sprintf $self->{i}{footer_fmt}, $self->{i}{curr_page};
692 0           $up += $trailing_empty_page_rows;
693             }
694 0           $up += $self->{i}{end_row} - $self->{i}{curr_row};
695 0 0         if ( $up ) {
696 0           print up( $up );
697             }
698             }
699              
700              
701             sub __prepare_footer_fmt {
702 0     0     my ( $self, $term_w ) = @_;
703 0 0         if ( ! $self->{i}{print_footer} ) {
704 0           return;
705             }
706 0           my $width_p_count = length $self->{i}{page_count};
707 0           my $p_count = $self->{i}{page_count};
708 0           my $footer_fmt = '--- %0' . $width_p_count . 'd/' . $p_count . ' ---';
709 0 0         if ( $self->{footer} ) {
710 0           $footer_fmt .= $self->{footer};
711             }
712 0 0         if ( print_columns( sprintf $footer_fmt, $p_count ) > $term_w ) { # color
713 0           $footer_fmt = '%0' . $width_p_count . 'd/' . $p_count;
714 0 0         if ( length( sprintf $footer_fmt, $p_count ) > $term_w ) {
715 0 0         if ( $width_p_count > $term_w ) {
716 0           $width_p_count = $term_w;
717             }
718 0           $footer_fmt = '%0' . $width_p_count . '.' . $width_p_count . 's';
719             }
720             }
721 0           $self->{i}{footer_fmt} = $footer_fmt;
722             }
723              
724              
725             sub __write_first_screen {
726 0     0     my ( $self, $list ) = @_;
727 0 0         $self->{i}{curr_row} = $self->{auto_up} ? 0 : @{$self->{i}{pre}};
  0            
728 0           $self->{i}{begin_row} = 0;
729 0           $self->{i}{end_row} = ( $self->{i}{avail_h} - 1 );
730 0 0         if ( $self->{i}{end_row} > $#$list ) {
731 0           $self->{i}{end_row} = $#$list;
732             }
733 0           $self->{i}{seps} = [];
734 0           $self->{i}{keys} = [];
735 0 0         if ( $self->{clear_screen} == 1 ) {
736 0           print clear_screen();
737             }
738             else {
739 0           print "\r" . clear_to_end_of_screen();
740             }
741 0 0         if ( $self->{hide_cursor} ) {
742 0           print hide_cursor();
743             }
744 0 0         if ( length $self->{i}{info_prompt} ) {
745 0           print $self->{i}{info_prompt} . "\n"; #
746             }
747 0           $self->__write_screen( $list );
748             }
749              
750              
751             sub __prepare_meta_menu_elements {
752 0     0     my ( $self, $term_w ) = @_;
753 0           my @meta_menu_elements = ( 'back', 'confirm' );
754 0           $self->{i}{pre} = [];
755 0           for my $meta_menu_element ( @meta_menu_elements ) {
756 0           my @color;
757 0           my $tmp = $self->{i}{$meta_menu_element . '_orig'};
758 0 0         if ( $self->{color} ) {
759 0           $tmp =~ s/\x{feff}//g;
760 0 0         $tmp =~ s/(\e\[[\d;]*m)/push( @color, $1 ) && "\x{feff}"/ge;
  0            
761             }
762 0           $tmp = $self->__sanitized_string( $tmp );
763 0 0         if ( print_columns( $tmp ) > $term_w ) {
764 0           $tmp = cut_to_printwidth( $tmp, $term_w, 0 );
765             }
766 0 0         if ( @color ) {
767 0           $tmp =~ s/\x{feff}/shift @color/ge;
  0            
768 0           $tmp .= normal();
769             }
770 0           $self->{$meta_menu_element} = $tmp;
771 0           push @{$self->{i}{pre}}, [ $self->{$meta_menu_element}, ];
  0            
772             }
773             }
774              
775              
776             sub __modify_fill_form_options {
777 0     0     my ( $self ) = @_;
778 0 0         if ( $self->{clear_screen} == 2 ) {
779 0           $self->{clear_screen} = 0;
780             }
781 0 0 0       if ( length $self->{footer} && $self->{page} != 2 ) {
782 0           $self->{page} = 2;
783             }
784 0 0 0       if ( $self->{page} == 2 && ! $self->{clear_screen} ) {
785 0           $self->{clear_screen} = 1;
786             }
787             }
788              
789              
790             sub fill_form {
791 0 0   0 1   if ( ref $_[0] ne __PACKAGE__ ) {
792 0           my $ob = __PACKAGE__->new();
793 0           delete $ob->{backup_instance_defaults};
794 0           return $ob->fill_form( @_ );
795             }
796 0           my ( $self, $orig_list, $opt ) = @_;
797 0 0         croak "'fill_form' called with no argument." if ! defined $orig_list;
798 0 0         croak "'fill_form' requires an ARRAY reference as its argument." if ref $orig_list ne 'ARRAY';
799 0 0         $opt = {} if ! defined $opt;
800 0 0         croak "'fill_form': the (optional) second argument must be a HASH reference" if ref $opt ne 'HASH';
801 0 0         return [] if ! @$orig_list; ##
802 0 0         if ( %$opt ) {
803 0           my $caller = 'fill_form';
804 0           validate_options( _valid_options( $caller ), $opt, $caller );
805 0           for my $key ( keys %$opt ) {
806 0 0         $self->{$key} = $opt->{$key} if defined $opt->{$key};
807             }
808             }
809 0           $self->__modify_fill_form_options();
810 0 0         if ( $^O eq "MSWin32" ) {
811 0 0         print $self->{codepage_mapping} ? "\e(K" : "\e(U";
812             }
813 0           my @tmp;
814 0 0         if ( length $self->{info} ) {
815 0           push @tmp, $self->{info};
816             }
817 0 0         if ( length $self->{prompt} ) {
818 0           push @tmp, $self->{prompt};
819             }
820 0           $self->{i}{info_prompt} = join "\n", @tmp;
821 0           $self->{i}{sep} = ': ';
822 0           $self->{i}{sep_ro} = '| ';
823 0 0         die if length $self->{i}{sep} != length $self->{i}{sep_ro};
824 0           $self->{i}{arrow_left} = '<';
825 0           $self->{i}{arrow_right} = '>';
826 0           $self->{i}{arrow_w} = 1;
827 0           local $| = 1;
828             local $SIG{INT} = sub {
829 0     0     $self->__reset(); #
830 0           print "^C\n";
831 0           exit;
832 0           };
833 0           $self->__init_term();
834 0           my ( $term_w, $term_h ) = get_term_size();
835 0           $self->{i}{back_orig} = $self->{back};
836 0           $self->{i}{confirm_orig} = $self->{confirm};
837 0           $self->__prepare_meta_menu_elements( $term_w );
838 0           $self->{i}{read_only} = [];
839 0 0         if ( @{$self->{read_only}} ) {
  0            
840 0           $self->{i}{read_only} = [ map { $_ + @{$self->{i}{pre}} } @{$self->{read_only}} ];
  0            
  0            
  0            
841             }
842              
843 0           $self->{i}{keys_to_skip} = [];
844 0 0         if ( defined $self->{skip_items} ) {
845 0           for my $i ( 0 .. $#$orig_list ) {
846 0 0         if ( $orig_list->[$i][0] =~ $self->{skip_items} ) {
847 0           push @{$self->{i}{keys_to_skip}}, $i + @{$self->{i}{pre}};
  0            
  0            
848             }
849             else {
850 0           $self->{i}{end_down} = $i;
851             }
852             }
853 0           $self->{i}{end_down} += @{$self->{i}{pre}};
  0            
854             }
855             else {
856 0           $self->{i}{end_down} = $#$orig_list + @{$self->{i}{pre}};
  0            
857             }
858 0           my $list = $self->__get_list( $orig_list );
859 0           $self->__length_longest_key( $list );
860 0           $self->__limit_key_w( $term_w );
861 0           $self->__available_width( $term_w );
862 0           $self->__threshold_width();
863 0           $self->__prepare_hight( $list, $term_w, $term_h );
864 0           $self->__prepare_footer_fmt( $term_w );
865 0           $self->__write_first_screen( $list );
866 0           my $m = $self->__string_and_pos( $list );
867 0           my $k = 0;
868              
869 0           CHAR: while ( 1 ) {
870 0           my $locked = 0;
871 0 0   0     if ( any { $_ == $self->{i}{curr_row} } @{$self->{i}{read_only}} ) {
  0            
  0            
872 0           $locked = 1;
873             }
874 0 0         if ( $self->{i}{beep} ) {
875 0           print bell();
876 0           $self->{i}{beep} = 0;
877             }
878             else {
879 0 0         if ( $self->{hide_cursor} ) {
880 0           print hide_cursor();
881             }
882 0           $self->__print_current_row( $list, $m );
883             }
884 0           my $char;
885 0 0   0     if ( any { $_ == $self->{i}{curr_row} } @{$self->{i}{keys_to_skip}} ) {
  0            
  0            
886 0 0 0       if ( $self->{i}{direction} eq 'up' || $self->{i}{curr_row} >= $self->{i}{end_down} ) {
887 0           $char = VK_UP;
888             }
889             else {
890 0           $char = VK_DOWN;
891             }
892             }
893             else {
894 0           $char = $self->{plugin}->__get_key_OS();
895             }
896 0           $self->{i}{direction} = 'down';
897 0 0         if ( ! defined $char ) {
898 0           $self->__reset();
899 0           warn "EOT: $!";
900 0           return;
901             }
902 0 0         next CHAR if $char == NEXT_get_key;
903 0 0         next CHAR if $char == KEY_TAB;
904 0           my ( $tmp_term_w, $tmp_term_h ) = get_term_size();
905 0 0 0       if ( $tmp_term_w != $term_w || $tmp_term_h != $term_h && $tmp_term_h < ( @$list + 1 ) ) {
      0        
906 0           my $up = $self->{i}{curr_row} + $self->{i}{info_prompt_row_count};
907 0 0         print up( $up ) if $up;
908 0           ( $term_w, $term_h ) = ( $tmp_term_w, $tmp_term_h );
909 0           $self->__prepare_meta_menu_elements( $term_w );
910 0           $self->__length_longest_key( $list );
911 0           $self->__limit_key_w( $term_w );
912 0           $self->__available_width( $term_w );
913 0           $self->__threshold_width();
914 0           $self->__prepare_hight( $list, $term_w, $term_h );
915 0           $self->__prepare_footer_fmt( $term_w );
916 0           $self->__write_first_screen( $list );
917 0           $m = $self->__string_and_pos( $list );
918             }
919             # reset $m->{avail_w} to default:
920 0           $m->{avail_w} = $self->{i}{avail_w};
921 0           $self->__threshold_char_count( $m );
922 0 0 0       if ( $char == KEY_BSPACE || $char == CONTROL_H ) {
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
    0          
    0          
    0          
    0          
923 0           $k = 1;
924 0 0         if ( $locked ) { # read_only
925 0           $self->{i}{beep} = 1;
926             }
927             else {
928 0           $self->__bspace( $m );
929             }
930             }
931             elsif ( $char == CONTROL_U ) {
932 0           $k = 1;
933 0 0         if ( $locked ) {
934 0           $self->{i}{beep} = 1;
935             }
936             else {
937 0           $self->__ctrl_u( $m );
938             }
939             }
940             elsif ( $char == CONTROL_K ) {
941 0           $k = 1;
942 0 0         if ( $locked ) {
943 0           $self->{i}{beep} = 1;
944             }
945             else {
946 0           $self->__ctrl_k( $m );
947             }
948             }
949             elsif ( $char == VK_DELETE || $char == CONTROL_D ) {
950 0           $k = 1;
951 0           $self->__delete( $m );
952             }
953             elsif ( $char == VK_RIGHT || $char == CONTROL_F ) {
954 0           $k = 1;
955 0           $self->__right( $m );
956             }
957             elsif ( $char == VK_LEFT || $char == CONTROL_B ) {
958 0           $k = 1;
959 0           $self->__left( $m );
960             }
961             elsif ( $char == VK_END || $char == CONTROL_E ) {
962 0           $k = 1;
963 0           $self->__end( $m );
964             }
965             elsif ( $char == VK_HOME || $char == CONTROL_A ) {
966 0           $k = 1;
967 0           $self->__home( $m );
968             }
969             elsif ( $char == VK_UP || $char == CONTROL_S ) {
970 0           $k = 1;
971 0 0         if ( $self->{i}{curr_row} == 0 ) {
972 0           $self->{i}{beep} = 1;
973             }
974             else {
975 0           $self->{i}{curr_row}--;
976 0           $m = $self->__string_and_pos( $list );
977 0 0         if ( $self->{i}{curr_row} >= $self->{i}{begin_row} ) {
978 0           $self->__reset_previous_row( $list, $self->{i}{curr_row} + 1 );
979 0           print up( 1 );
980             }
981             else {
982 0           $self->__print_previous_page( $list );
983             }
984             }
985             }
986             elsif ( $char == VK_DOWN || $char == CONTROL_T ) {
987 0           $k = 1;
988 0 0         if ( $self->{i}{curr_row} == $#$list ) {
989 0           $self->{i}{beep} = 1;
990             }
991             else {
992 0           $self->{i}{curr_row}++;
993 0           $m = $self->__string_and_pos( $list );
994 0 0         if ( $self->{i}{curr_row} <= $self->{i}{end_row} ) {
995 0           $self->__reset_previous_row( $list, $self->{i}{curr_row} - 1 );
996 0           print down( 1 );
997             }
998             else {
999 0           print up( $self->{i}{end_row} - $self->{i}{begin_row} );
1000 0           $self->__print_next_page( $list );
1001             }
1002             }
1003             }
1004             elsif ( $char == VK_PAGE_UP || $char == CONTROL_P ) {
1005 0           $k = 1;
1006 0 0         if ( $self->{i}{curr_page} == 1 ) {
1007 0 0         if ( $self->{i}{curr_row} == 0 ) {
1008 0           $self->{i}{beep} = 1;
1009             }
1010             else {
1011 0           $self->__reset_previous_row( $list, $self->{i}{curr_row} );
1012 0           print up( $self->{i}{curr_row} );
1013 0           $self->{i}{curr_row} = 0;
1014 0           $m = $self->__string_and_pos( $list );
1015             }
1016             }
1017             else {
1018 0           my $up = $self->{i}{curr_row} - $self->{i}{begin_row};
1019 0 0         print up( $up ) if $up;
1020 0           $self->{i}{curr_row} = $self->{i}{begin_row} - $self->{i}{avail_h};
1021 0           $m = $self->__string_and_pos( $list );
1022 0           $self->__print_previous_page( $list );
1023             }
1024             }
1025             elsif ( $char == VK_PAGE_DOWN || $char == CONTROL_N ) {
1026 0           $k = 1;
1027 0 0         if ( $self->{i}{curr_page} == $self->{i}{page_count} ) {
1028 0 0         if ( $self->{i}{curr_row} == $#$list ) {
1029 0           $self->{i}{beep} = 1;
1030             }
1031             else {
1032 0           $self->__reset_previous_row( $list, $self->{i}{curr_row} );
1033 0           my $rows = $self->{i}{end_row} - $self->{i}{curr_row};
1034 0           print down( $rows );
1035 0           $self->{i}{curr_row} = $self->{i}{end_row};
1036 0           $m = $self->__string_and_pos( $list );
1037             }
1038             }
1039             else {
1040 0           my $up = $self->{i}{curr_row} - $self->{i}{begin_row};
1041 0 0         print up( $up ) if $up;
1042 0           $self->{i}{curr_row} = $self->{i}{end_row} + 1;
1043 0           $m = $self->__string_and_pos( $list );
1044 0           $self->__print_next_page( $list );
1045             }
1046             }
1047             elsif ( $char == CONTROL_X ) {
1048 0 0         if ( @{$m->{str}} ) {
  0            
1049 0           $list->[$self->{i}{curr_row}][1] = '';
1050 0           $m = $self->__string_and_pos( $list );
1051             }
1052             else {
1053 0           $self->{i}{beep} = 1;
1054             }
1055             }
1056             elsif ( $char == VK_INSERT ) {
1057 0           $self->{i}{beep} = 1;
1058             }
1059             elsif ( $char == LINE_FEED || $char == CARRIAGE_RETURN ) {
1060             # LINE_FEED == CONTROL_J, CARRIAGE_RETURN == CONTROL_M
1061 0           my $up = $self->{i}{curr_row} - $self->{i}{begin_row};
1062 0 0         $up += $self->{i}{info_prompt_row_count} if $self->{i}{info_prompt_row_count};
1063 0 0         if ( $list->[$self->{i}{curr_row}][0] eq $self->{back} ) {
    0          
1064 0           $self->__reset( $up );
1065 0           return;
1066             }
1067             elsif ( $list->[$self->{i}{curr_row}][0] eq $self->{confirm} ) {
1068 0           splice @$list, 0, @{$self->{i}{pre}};
  0            
1069 0           $self->__reset( $up );
1070 0   0       return [ map { [ $orig_list->[$_][0], $list->[$_][1] // '' ] } 0 .. $#{$list} ];
  0            
  0            
1071             #return [ map { [ $orig_list->[$_][0], $list->[$_][1] ] } 0 .. $#{$list} ];
1072             }
1073 0 0         if ( $self->{auto_up} == 2 ) {
    0          
1074 0           print up( $up );
1075 0           print "\r" . clear_to_end_of_screen();
1076 0           $self->__write_first_screen( $list );
1077 0           $m = $self->__string_and_pos( $list );
1078             }
1079             elsif ( $self->{i}{curr_row} == $#$list ) {
1080 0           print up( $up );
1081 0           print "\r" . clear_to_end_of_screen();
1082 0 0         if ( $self->{auto_up} == 1 ) {
1083 0           $self->__write_first_screen( $list );
1084             }
1085             else {
1086 0           $self->__write_first_screen( $list );
1087             }
1088 0           $m = $self->__string_and_pos( $list );
1089             }
1090             else {
1091 0           $self->{i}{curr_row}++;
1092 0           $m = $self->__string_and_pos( $list );
1093 0 0         if ( $self->{i}{curr_row} <= $self->{i}{end_row} ) {
1094 0           $self->__reset_previous_row( $list, $self->{i}{curr_row} - 1 );
1095 0           print down( 1 );
1096             }
1097             else {
1098 0           print up( $up );
1099 0           $self->__print_next_page( $list );
1100             }
1101             }
1102             }
1103             else {
1104 0           $k = 1;
1105 0 0         if ( $locked ) {
1106 0           $self->{i}{beep} = 1;
1107             }
1108             else {
1109 0           $char = chr $char;
1110 0           utf8::upgrade $char;
1111 0           $self->__add_char( $m, $char );
1112             }
1113             }
1114             }
1115             }
1116              
1117              
1118             sub __reset_previous_row {
1119 0     0     my ( $self, $list, $idx ) = @_;
1120 0           print "\r" . clear_to_end_of_line();
1121 0           print $self->__get_row( $list, $idx );
1122 0 0         if ( $self->{i}{curr_row} < $idx ) {
1123 0           $self->{i}{direction} = 'up';
1124             }
1125             }
1126              
1127              
1128             sub __print_next_page {
1129 0     0     my ( $self, $list ) = @_;
1130 0           $self->{i}{begin_row} = $self->{i}{end_row} + 1;
1131 0           $self->{i}{end_row} = $self->{i}{end_row} + $self->{i}{avail_h};
1132 0 0         $self->{i}{end_row} = $#$list if $self->{i}{end_row} > $#$list;
1133 0           print "\r" . clear_to_end_of_screen();
1134 0           $self->__write_screen( $list );
1135 0 0         if ( $self->{i}{curr_row} == $self->{i}{end_row} ) {
1136 0           $self->{i}{direction} = 'up';
1137             }
1138             }
1139              
1140              
1141             sub __print_previous_page {
1142 0     0     my ( $self, $list ) = @_;
1143 0           $self->{i}{end_row} = $self->{i}{begin_row} - 1;
1144 0           $self->{i}{begin_row} = $self->{i}{begin_row} - $self->{i}{avail_h};
1145 0 0         $self->{i}{begin_row} = 0 if $self->{i}{begin_row} < 0;
1146 0           print "\r" . clear_to_end_of_screen();
1147 0           $self->__write_screen( $list );
1148 0 0         if ( $self->{i}{curr_row} > $self->{i}{begin_row} ) {
1149 0           $self->{i}{direction} = 'up';
1150             }
1151             }
1152              
1153              
1154             1;
1155              
1156              
1157             __END__