File Coverage

blib/lib/Term/Choose/Util.pm

Criterion	Covered	Total	%
statement	47	584	8.0
branch	0	292	0.0
condition	0	60	0.0
subroutine	16	40	40.0
pod	7	13	53.8
total	70	989	7.0

package Term::Choose::Util;

use warnings;
use strict;
use 5.10.1;

our $VERSION = '0.149';
use Exporter 'import';
our @EXPORT_OK = qw( choose_a_directory choose_a_file choose_directories choose_a_number choose_a_subset settings_menu
                     insert_sep get_term_size get_term_width get_term_height unicode_sprintf );

use Carp                  qw( croak );
use Cwd                   qw( realpath );
use Encode                qw( decode encode );
use File::Basename        qw( basename dirname );
use File::Spec::Functions qw( catdir catfile );
use List::Util            qw( sum any );

use Encode::Locale qw();
use File::HomeDir  qw();

use Term::Choose                  qw( choose );
use Term::Choose::Constants       qw( SGR_ES PH );
use Term::Choose::LineFold        qw( cut_to_printwidth print_columns );
use Term::Choose::ValidateOptions qw( validate_options );


sub new {
    my $class = shift;
    my ( $opt ) = @_;
    my $instance_defaults = _defaults();
    if ( defined $opt ) {
        croak "Options have to be passed as a HASH reference." if ref $opt ne 'HASH';
        my $caller = 'new';
        validate_options( _valid_options( $caller ), $opt, $caller );
        for my $key ( keys %$opt ) {
            $instance_defaults->{$key} = $opt->{$key} if defined $opt->{$key};
        }
    }
    my $self = bless $instance_defaults, $class;
    $self->{backup_instance_defaults} = { %$instance_defaults };
    return $self;
}


sub __restore_defaults {
    my ( $self ) = @_;
    if ( exists $self->{backup_instance_defaults} ) {
        my $instance_defaults = $self->{backup_instance_defaults};
        for my $key ( keys %$self ) {
            if ( $key eq 'backup_instance_defaults' ) {
                next;
            }
            elsif ( exists $instance_defaults->{$key} ) {
                $self->{$key} = $instance_defaults->{$key};
            }
            else {
                delete $self->{$key};
            }
        }
    }
}


sub __prepare_opt {
    my ( $self, $opt, $subseq_tab ) = @_;
    if ( ! defined $opt ) {
        $opt = {};
    }
    croak "Options have to be passed as a HASH reference." if ref $opt ne 'HASH';
    if ( %$opt ) {
        my $caller = ( caller( 1 ) )[3];
        $caller =~ s/^.+::(?:__)?([^:]+)\z/$1/;
        validate_options( _valid_options( $caller ), $opt, $caller );
        my $defaults = _defaults();
        for my $key ( keys %$opt ) {
            if ( ! defined $opt->{$key} && defined $defaults->{$key} ) {
                $self->{$key} = $defaults->{$key};
            }
            else {
                $self->{$key} = $opt->{$key};
            }
        }
    }
    if ( ! defined $self->{tabs_prompt} ) {
        if ( defined $self->{margin} ) {
            $self->{tabs_prompt} = [ 0, $subseq_tab, $self->{margin}[3], $self->{margin}[1], $self->{max_width} ];
        }
        elsif ( $subseq_tab ) {
            $self->{tabs_prompt} = [ 0, $subseq_tab, 0, 0, $self->{max_width} ];
        }
    }
}


sub _valid_options {
    my ( $caller ) = @_;
    my %valid = (
        all_by_default      => '[ 0 1 ]',
        clear_screen        => '[ 0 1 ]',
        decoded             => '[ 0 1 ]',
        hide_cursor         => '[ 0 1 ]',
        index               => '[ 0 1 ]',
        keep_chosen         => '[ 0 1 ]',
        mouse               => '[ 0 1 ]',
        order               => '[ 0 1 ]',
        show_hidden         => '[ 0 1 ]',
        small_first         => '[ 0 1 ]',
        alignment           => '[ 0 1 2 ]',
        color               => '[ 0 1 2 ]',
        layout              => '[ 0 1 2 ]',
        page                => '[ 0 1 2 ]',       # undocumented
        keep                => '[ 1-9 ][ 0-9 ]*', # undocumented
        max_width           => '(?:[2-9]|[ 1-9 ][ 0-9 ]+)',
        default_number      => '[ 0-9 ]+',
        margin              => 'Array_Int',
        mark                => 'Array_Int_Idx',
        tabs_bottom_text    => 'Array_Int',
        tabs_info           => 'Array_Int',
        tabs_prompt         => 'Array_Int',
        bottom_text         => 'Str',
        busy_string         => 'Str',
        info                => 'Str',
        init_dir            => 'Str',
        back                => 'Str',
        filter              => 'Str',
        footer              => 'Str',           # undocumented
        confirm             => 'Str',
        prefix              => 'Str',
        prompt              => 'Str',
        prompt2             => 'Str',
        cs_begin            => 'Str',
        cs_end              => 'Str',
        cs_label            => 'Str',
        cs_separator        => 'Str',
        thousands_separator => 'Str',
    );
    my $options;
    if ( $caller eq 'new' ) {
        $options = [ keys %valid ];
    }
    else {
        $options = _routine_options( $caller );
    }
    return { map { $_ => $valid{$_} } @$options };
};


sub _defaults {
    return {
        alignment           => 0,
        all_by_default      => 0,
        back                => 'BACK',
        #bottom_text        => undef,
        #busy_string        => undef,
        clear_screen        => 0,
        color               => 0,
        confirm             => 'CONFIRM',
        cs_begin            => '',
        cs_end              => '',
        #cs_label           => undef,
        cs_separator        => ', ',
        decoded             => 1,
        #default_number     => undef,
        #filter             => undef,
        #footer             => undef,
        hide_cursor         => 1,
        index               => 0,
        #info               => undef,
        #init_dir           => undef,
        keep_chosen         => 0,
        #keep               => undef,
        layout              => 1,
        #margin             => undef,
        #mark               => undef,
        #max_width          => undef,
        mouse               => 0,
        order               => 1,
        #page               => undef,
        parent_dir          => '..',
        prefix              => '',
        #prompt             => undef,
        #prompt2            => undef,
        show_hidden         => 1,
        small_first         => 0,
        #tabs_bottom_text   => undef,
        #tabs_info          => undef,
        #tabs_prompt        => undef,
        thousands_separator => ',',

        ## intern:
        reset      => 'reset',
    };
};


sub _routine_options {
    my ( $caller ) = @_;
    my @every = ( qw( back bottom_text clear_screen color confirm cs_label footer hide_cursor info keep margin max_width mouse page prompt tabs_bottom_text tabs_info tabs_prompt ) );
    my $options;
    if ( $caller eq 'choose_directories' ) {
        $options = [ @every, qw( init_dir layout order alignment show_hidden decoded prompt2 ) ];
    }
    elsif ( $caller eq 'choose_a_directory' ) {
        $options = [ @every, qw( init_dir layout order alignment show_hidden decoded ) ];
    }
    elsif ( $caller eq 'choose_a_file' ) {
        $options = [ @every, qw( init_dir layout order alignment show_hidden decoded filter prompt2 ) ];
    }
    elsif ( $caller eq 'choose_a_number' ) {
        $options = [ @every, qw( small_first reset thousands_separator default_number ) ];
    }
    elsif ( $caller eq 'choose_a_subset' ) {
        $options = [ @every, qw( layout order alignment keep_chosen index prefix all_by_default cs_begin cs_end cs_separator mark busy_string ) ];
    }
    elsif ( $caller eq 'settings_menu' ) {
        $options = [ @every, qw( cs_begin cs_end cs_separator ) ];
    }
    return $options;
}


sub __error_message {
    my ( $self, $message ) = @_;
    $message =~ s/\n\z//;
    # Choose
    choose(
        [ 'Press ENTER to continue' ],
        { footer => $self->{footer}, hide_cursor => $self->{hide_cursor}, margin => $self->{margin},
          mouse => $self->{mouse}, page => $self->{page}, prompt => $message }
    );
}


sub __prepare_path {
    my ( $self ) = @_;
    my $init_dir_fs;
    if ( defined $self->{init_dir} ) {
        $init_dir_fs = encode( 'locale_fs', $self->{init_dir} );
        if ( ! -d $init_dir_fs ) {
            my $message = 'Directory "';
            $message .= decode 'locale_fs', $init_dir_fs;
            $message .= '" not found. Falling back to home directory.';
            $self->__error_message( $message );
            $init_dir_fs = File::HomeDir->my_home();
        }
    }
    else {
        $init_dir_fs = File::HomeDir->my_home();
    }
    if ( ! -d $init_dir_fs ) {
        croak "Could not find the home directory.";
    }
    my $dir_fs = realpath( $init_dir_fs ) or die "$init_dir_fs: $!";
    my $dir = decode( 'locale_fs', $dir_fs );
    return $dir;
}


sub __available_dirs {
    my ( $self, $dir ) = @_;
    my $dir_fs = encode( 'locale_fs', $dir );
    my $dh;
    if ( ! eval {
        opendir( $dh, $dir_fs ) or croak "$dir_fs: $!";
        1 }
    ) {

        $self->__error_message( $@ );
        return;
    }
    my @dirs;
    while ( my $file_fs = readdir $dh ) {
        next if $file_fs =~ /^\.\.?\z/;
        next if $file_fs =~ /^\./ && ! $self->{show_hidden};
        if ( -d catdir $dir_fs, $file_fs ) {
            push @dirs, decode( 'locale_fs', $file_fs );
        }
    }
    closedir $dh;
    return [ sort @dirs ];
}


sub choose_directories {
    if ( ref $_[0] ne __PACKAGE__ ) {
        my $ob = __PACKAGE__->new();
        delete $ob->{backup_instance_defaults};
        return $ob->choose_directories( @_ );
    }
    my ( $self, $opt ) = @_;
    my $subseq_tab = 2;
    $self->__prepare_opt( $opt, $subseq_tab );
    my $dir = $self->__prepare_path();
    my $chosen_dirs = [];
    my ( $confirm, $change_path, $add_dirs ) = ( $self->{confirm}, '- Change Location', '- Add Directories' );
    my @bu;

    CHOOSE_MODE: while ( 1 ) {
        my $key_dirs = $self->{cs_label} // 'Chosen Dirs: ';
        my $dirs_chosen = $key_dirs . ( @$chosen_dirs ? join( ', ', @$chosen_dirs ) : '---' );
        my $key_path = 'Location: ';
        my $path = $key_path . $dir;
        my $prompt = $dirs_chosen . "\n" . $path;
        # Choose
        my $choice = choose(
            [ undef, $confirm, $change_path, $add_dirs ],
            { bottom_text => $self->{bottom_text}, clear_screen => $self->{clear_screen}, color => $self->{color},
              footer => $self->{footer}, hide_cursor => $self->{hide_cursor}, info => $self->{info},
              keep => $self->{keep}, layout => 2, margin => $self->{margin}, max_width => $self->{max_width},
              mouse => $self->{mouse}, page => $self->{page}, prompt => $prompt,
              tabs_bottom_text => $self->{tabs_bottom_text}, tabs_info => $self->{tabs_info},
              tabs_prompt => $self->{tabs_prompt}, undef => $self->{back} }
        );
        if ( ! defined $choice ) {
            if ( @bu ) {
                ( $dir, $chosen_dirs ) = @{pop @bu};
                next CHOOSE_MODE;
            }
            $self->__restore_defaults(); #
            return;
        }
        elsif ( $choice eq $confirm ) {
            my $decoded = $self->{decoded};
            $self->__restore_defaults();
            return $decoded ? $chosen_dirs : [ map { encode 'locale_fs', $_ } @$chosen_dirs ];
        }
        elsif ( $choice eq $change_path ) {
            my $prompt_fmt = $key_path . "%s";
            my $prompt = $self->{prompt} // 'Change Location:';
            if ( length $prompt ) {
                $prompt_fmt .= "\n" . $prompt;
            }
            my $tmp_dir = $self->__choose_a_path( $dir, $prompt_fmt, '<<', 'OK' );
            if ( defined $tmp_dir ) {
               $dir = $tmp_dir;
            }
        }
        elsif ( $choice eq $add_dirs ) {
            my $avail_dirs = $self->__available_dirs( $dir );
            if ( ! defined $avail_dirs ) {
                next CHOOSE_MODE;
            }
            my %bu_opt;
            my $options = _routine_options( 'choose_directories' );
            for my $o ( @$options ) {
                $bu_opt{$o} = $self->{$o};
            }
            my $cs_label = $dirs_chosen . "\n" . $path . "\n" . '+ ';
            my $prompt = $self->{prompt2} // 'Add Directories:';
            # choose_a_subset
            my $idxs = $self->choose_a_subset(
                [ sort @$avail_dirs ],
                { back => '<<', confirm => 'OK', cs_begin => undef, cs_label => $cs_label, index => 1, keep_chosen => 1,
                  prompt => $prompt }  # plus all the options already in $self

            );
            for my $o ( keys %bu_opt ) {
                $self->{$o} = $bu_opt{$o};
            }
            if ( defined $idxs && @$idxs ) {
                push @bu, [ $dir, [ @$chosen_dirs ] ];
                push @$chosen_dirs, map { catdir $dir, $_ } @{$avail_dirs}[@$idxs];
            }
        }
    }
}


sub choose_a_file {
    if ( ref $_[0] ne __PACKAGE__ ) {
        my $ob = __PACKAGE__->new();
        delete $ob->{backup_instance_defaults};
        return $ob->choose_a_file( @_ );
    }
    my ( $self, $opt ) = @_;
    $self->__prepare_opt( $opt );
    my $init_dir = $self->__prepare_path();
    my $prompt_fmt = "Source directory: %s";
    my $prompt = $self->{prompt} // 'Choose the source directory:';
    if ( length $prompt ) {
        $prompt_fmt .= "\n" . $prompt;
    }

    CHOOSE_DIR: while ( 1 ) {
        my $chosen_dir = $self->__choose_a_path( $init_dir, $prompt_fmt, '<<', 'OK' );
        if ( ! defined $chosen_dir ) {
            $self->__restore_defaults(); #
            return;
        }
        my $chosen_file = $self->__a_file( $chosen_dir );
        if ( ! defined $chosen_file ) {
            next CHOOSE_DIR;
        }
        my $decoded = $self->{decoded};
        $self->__restore_defaults();
        return $decoded ? $chosen_file : encode( 'locale_fs', $chosen_file );
    }
}


sub choose_a_directory {
    if ( ref $_[0] ne __PACKAGE__ ) {
        my $ob = __PACKAGE__->new();
        delete $ob->{backup_instance_defaults};
        return $ob->choose_a_directory( @_ );
    }
    my ( $self, $opt ) = @_;
    $self->__prepare_opt( $opt );
    my $init_dir = $self->__prepare_path();
    my $prompt_fmt = ( $self->{cs_label} // 'Directory: ' ) . "%s";
    my $prompt = $self->{prompt} // 'Choose a Directory:';
    if ( length $prompt ) {
        $prompt_fmt .= "\n" . $prompt;
    }
    my $chosen_dir = $self->__choose_a_path( $init_dir, $prompt_fmt, $self->{back}, $self->{confirm} );
    my $decoded = $self->{decoded};
    $self->__restore_defaults();
    if ( ! defined $chosen_dir ) {
        return;
    }
    return $decoded ? $chosen_dir : encode( 'locale_fs', $chosen_dir );
}


sub __choose_a_path {
    my ( $self, $dir, $prompt_fmt, $back, $confirm ) = @_;
    my $prev_dir = $dir;

    while ( 1 ) {
        my ( $dh, @dirs );
        my $dir_fs = encode( 'locale_fs', $dir );
        if ( ! eval {
            opendir( $dh, $dir_fs ) or croak "$dir_fs: $!";
            1 }
        ) {
            $self->__error_message( $@ );
            $dir = dirname $dir;
            next;
        }
        while ( my $file_fs = readdir $dh ) {
            next if $file_fs =~ /^\.\.?\z/;
            next if $file_fs =~ /^\./ && ! $self->{show_hidden};
            if ( -d catdir $dir_fs, $file_fs ) {
                push @dirs, decode( 'locale_fs', $file_fs );
            }
        }
        closedir $dh;
        my $parent_dir = $self->{parent_dir};
        my @pre = ( undef, $confirm, $parent_dir );
        my $prompt = sprintf $prompt_fmt, $prev_dir;
        # Choose
        my $choice = choose(
            [ @pre, sort( @dirs ) ],
            { alignment => $self->{alignment}, bottom_text => $self->{bottom_text},
              clear_screen => $self->{clear_screen}, color => $self->{color}, footer => $self->{footer},
              hide_cursor => $self->{hide_cursor}, info => $self->{info}, keep => $self->{keep},
              layout => $self->{layout}, margin => $self->{margin}, max_width => $self->{max_width},
              mouse => $self->{mouse}, order => $self->{order}, page => $self->{page}, prompt => $prompt,
              tabs_bottom_text => $self->{tabs_bottom_text}, tabs_info => $self->{tabs_info},
              tabs_prompt => $self->{tabs_prompt}, undef => $back }
        );
        if ( ! defined $choice ) {
            return;
        }
        elsif ( $choice eq $confirm ) {
            return $prev_dir;
        }
        elsif ( $choice eq $parent_dir ) {
            $dir = dirname $dir;
        }
        else {
            $dir = catdir $dir, $choice;
        }
        $prev_dir = $dir;
    }
}


sub __a_file {
    my ( $self, $dir ) = @_;
    my $prev_dir = '';
    my $chosen_file;

    while ( 1 ) {
        my @files_fs;
        my $dir_fs = encode( 'locale_fs', $dir );
        if ( ! eval {
            if ( $self->{filter} ) {
                @files_fs = map { basename $_} grep { -e $_ } glob( encode( 'locale_fs', catfile $dir, $self->{filter} ) );
            }
            else {
                opendir( my $dh, $dir_fs ) or croak "$dir_fs: $!";
                @files_fs = readdir $dh;
                closedir $dh;
            }
        1 }
        ) {
            $self->__error_message( $@ );
            return;
        }
        my @files;
        for my $file_fs ( @files_fs ) {
            next if $file_fs =~ /^\.\.?\z/;
            next if $file_fs =~ /^\./ && ! $self->{show_hidden};
            next if -d catdir $dir_fs, $file_fs;
            push @files, decode( 'locale_fs', $file_fs );
        }
        my $chosen_dir = "Source directory: $dir";
        my @tmp_prompt;
        push @tmp_prompt, $chosen_dir;
        push @tmp_prompt, ( $self->{cs_label} // 'File: ' ) . ( length $prev_dir ? $prev_dir : '' );
        my $prompt2 = $self->{prompt2} // 'Choose a File:';
        if ( length $prompt2 ) {
            push @tmp_prompt, $prompt2;
        }
        my $prompt = join( "\n", @tmp_prompt );
        if ( ! @files ) {
            $prompt .= "\n";
            if ( $self->{filter} ) {
                $prompt .= 'No matches for filter "' .  $self->{filter} . '".';
            }
            else {
                $prompt .= "No files in $dir.";
            }
            # Choose
            choose(
                [ ' < ' ],
                { bottom_text => $self->{bottom_text}, color => $self->{color}, footer => $self->{footer},
                  hide_cursor => $self->{hide_cursor}, info => $self->{info}, margin => $self->{margin},
                  max_width => $self->{max_width}, mouse => $self->{mouse}, page => $self->{page}, prompt => $prompt,
                  tabs_bottom_text => $self->{tabs_bottom_text}, tabs_info => $self->{tabs_info} }
            );
            return;
        }
        my @pre = ( undef );
        if ( $chosen_file ) {
            push @pre, $self->{confirm}; ##
        }
        # Choose
        $chosen_file = choose(
            [ @pre, sort( @files ) ],
            { alignment => $self->{alignment}, bottom_text => $self->{bottom_text},
              clear_screen => $self->{clear_screen}, color => $self->{color}, footer => $self->{footer},
              hide_cursor => $self->{hide_cursor}, info => $self->{info}, keep => $self->{keep},
              layout => $self->{layout}, margin => $self->{margin}, max_width => $self->{max_width},
              mouse => $self->{mouse}, order => $self->{order}, page => $self->{page}, prompt => $prompt,
              tabs_bottom_text => $self->{tabs_bottom_text}, tabs_info => $self->{tabs_info},
              tabs_prompt => $self->{tabs_prompt}, undef => $self->{back} }
        );
        if ( ! length $chosen_file ) {
            if ( length $prev_dir ) {
                $prev_dir = '';
                next;
            }
            return;
        }
        elsif ( $chosen_file eq $self->{confirm} ) {
            return if ! length $prev_dir;
            return catfile $dir, $prev_dir;
        }
        else {
            $prev_dir = $chosen_file;
        }
    }
}


sub choose_a_number {
    if ( ref $_[0] ne __PACKAGE__ ) {
        my $ob = __PACKAGE__->new();
        delete $ob->{backup_instance_defaults};
        return $ob->choose_a_number( @_ );
    }
    my ( $self, $digits, $opt ) = @_;
    my $default_digits = 7;
    if ( ref $digits ) {
        $opt = $digits;
        $digits = $default_digits;
    }
    elsif ( ! $digits ) {
        $digits = $default_digits;
    }
    $self->__prepare_opt( $opt );
    my $tab   = '  -  ';
    my $tab_w = print_columns( $tab );
    my $sep_w = print_columns_ext( $self->{thousands_separator}, $self->{color} );
    my $longest = $digits + int( ( $digits - 1 ) / 3 ) * $sep_w;
    my @ranges = ();
    for my $di ( 0 .. $digits - 1 ) {
        my $begin = 1 . '0' x $di;
        $begin = 0 if $di == 0;
        $begin = insert_sep( $begin, $self->{thousands_separator} );
        ( my $end = $begin ) =~ s/^[01]/9/;
        unshift @ranges, unicode_sprintf( $begin, $longest, { right_justify => 1, color => $self->{color} } )
                               . $tab
                               . unicode_sprintf( $end, $longest, { right_justify => 1, color => $self->{color} } );
    }
    my $back_tmp    = unicode_sprintf( $self->{back},    $longest * 2 + $tab_w + 1, { color => $self->{color} } );
    my $confirm_tmp = unicode_sprintf( $self->{confirm}, $longest * 2 + $tab_w + 1, { color => $self->{color} } );
    if ( print_columns_ext( $ranges[0], $self->{color} ) > get_term_width() ) {
        @ranges = ();
        for my $di ( 0 .. $digits - 1 ) {
            my $begin = 1 . '0' x $di;
            $begin = 0 if $di == 0;
            $begin = insert_sep( $begin, $self->{thousands_separator} );
            unshift @ranges, unicode_sprintf( $begin, $longest, { color => $self->{color} } );
        }
        $confirm_tmp = $self->{confirm};
        $back_tmp = $self->{back};
    }
    my %numbers;
    my $result;
    if ( defined $self->{default_number} && length $self->{default_number} <= $digits ) {
        my $count_zeros = 0;
        for my $d ( reverse split '', $self->{default_number} ) {
            $numbers{$count_zeros} = $d * 10 ** $count_zeros;
            $count_zeros++;
        }
        $result = sum( @numbers{keys %numbers} );
        $result = insert_sep( $result, $self->{thousands_separator} );
    }

    NUMBER: while ( 1 ) {
        my $cs_row;
        if ( defined $self->{cs_label} || length $result ) {
            my $tmp_result = length $result ? $result : '';
            my $tmp_cs_label = $self->{cs_label} // '';
            $cs_row = sprintf(  "%s%*s", $tmp_cs_label, $longest, $tmp_result );
            if ( print_columns( $cs_row ) > get_term_width() ) {
                $cs_row = $tmp_result;
            }
        }
        my @tmp_prompt;
        if ( defined $cs_row ) {
            push @tmp_prompt, $cs_row;
        }
        if ( ! defined $self->{prompt} ) {
            push @tmp_prompt, 'Your choice:';
        }
        elsif ( length $self->{prompt} ) {
            push @tmp_prompt, $self->{prompt};
        }
        my $prompt = join "\n", @tmp_prompt;
        my @pre = ( undef, $confirm_tmp ); # confirm if $result ?
        # Choose
        my $range = choose(
            $self->{small_first} ? [ @pre, reverse @ranges ] : [ @pre, @ranges ],
            { alignment => 1, bottom_text => $self->{bottom_text}, clear_screen => $self->{clear_screen},
              color => $self->{color}, footer => $self->{footer}, hide_cursor => $self->{hide_cursor},
              info => $self->{info}, keep => $self->{keep}, layout => 2, margin => $self->{margin},
              max_width => $self->{max_width}, mouse => $self->{mouse}, page => $self->{page}, prompt => $prompt,
              tabs_bottom_text => $self->{tabs_bottom_text}, tabs_info => $self->{tabs_info},
              tabs_prompt => $self->{tabs_prompt}, undef => $back_tmp }
        );
        if ( ! defined $range ) {
            if ( defined $result ) {
                $result = undef;
                %numbers = ();
                next NUMBER;
            }
            else {
                $self->__restore_defaults();
                return;
            }
        }
        if ( $range eq $confirm_tmp ) {
            $result = _remove_thousands_separators( $result, $self->{thousands_separator} );
            $self->__restore_defaults();
            return $result;
        }
        my $zeros = ( split /\s*-\s*/, $range )[0];
        $zeros =~ s/^\s*\d//;
        my $zeros_no_sep = _remove_thousands_separators( $zeros, $self->{thousands_separator} );
        my $count_zeros = length $zeros_no_sep;
        my @choices = $count_zeros ? map( $_ . $zeros, 1 .. 9 ) : ( 0 .. 9 );
        # Choose
        my $number = choose(
            [ undef, @choices, $self->{reset} ],
            { alignment => 2, bottom_text => $self->{bottom_text}, clear_screen => $self->{clear_screen},
              color => $self->{color}, footer => $self->{footer}, hide_cursor => $self->{hide_cursor},
              info => $self->{info}, keep => $self->{keep}, layout => 1, margin => $self->{margin},
              max_width => $self->{max_width}, mouse => $self->{mouse}, order => 0, page => $self->{page},
              prompt => $prompt, tabs_bottom_text => $self->{tabs_bottom_text}, tabs_info => $self->{tabs_info},
              tabs_prompt => $self->{tabs_prompt}, undef => '<<' }

        );
        next if ! defined $number;
        if ( $number eq $self->{reset} ) {
            delete $numbers{$count_zeros};
        }
        else {
            $numbers{$count_zeros} = _remove_thousands_separators( $number, $self->{thousands_separator} );
        }
        $result = sum( @numbers{keys %numbers} );
        $result = insert_sep( $result, $self->{thousands_separator} );
    }
}


sub _remove_thousands_separators {
    my ( $str, $sep ) = @_;
    # https://stackoverflow.com/questions/13119241/substitution-with-empty-string-unexpected-result
    if ( defined $str && $sep ne '' ) {
        $str =~ s/\Q$sep\E//g;
    }
    return $str;
}


sub choose_a_subset {
    if ( ref $_[0] ne __PACKAGE__ ) {
        my $ob = __PACKAGE__->new();
        delete $ob->{backup_instance_defaults};
        return $ob->choose_a_subset( @_ );
    }
    my ( $self, $available, $opt ) = @_;
    my $subseq_tab = length $opt->{cs_label} && $opt->{cs_label} !~ /\R\z/ ? 2 : 0; ##
    $self->__prepare_opt( $opt, $subseq_tab );
    my $new_idx = [];
    my $curr_avail = [ @$available ];
    my $bu = [];
    my @pre = ( undef, $self->{confirm} );
    my $mark;
    if ( defined $self->{mark} && @{$self->{mark}} ) {
        $mark = [ map { $_ + @pre } @{$self->{mark}} ];
    }

    while ( 1 ) {
        my @tmp_prompt;
        my $cs;
        if ( defined $self->{cs_label} ) {
            $cs .= $self->{cs_label};
        }
        if ( @$new_idx ) {
            $cs .= $self->{cs_begin} . join( $self->{cs_separator}, map { defined $_ ? $_ : '' } @{$available}[@$new_idx] ) . $self->{cs_end};
        }
        elsif ( $self->{all_by_default} ) {
            $cs .= $self->{cs_begin} . '*' . $self->{cs_end};
        }
        if ( defined $cs ) {
            @tmp_prompt = ( $cs );
        }
        if ( ! defined $self->{prompt} ) {
            push @tmp_prompt, 'Your choice:';
        }
        elsif ( length $self->{prompt} ) {
            push @tmp_prompt, $self->{prompt};
        }
        my $meta_items = [ 0 .. $#pre ];
        my $prompt = join "\n", @tmp_prompt;
        # Choose
        my @idx = choose(
            [ @pre, length( $self->{prefix} ) ? map { $self->{prefix} . ( defined $_ ? $_ : '' ) } @$curr_avail : @$curr_avail ],
            { alignment => $self->{alignment}, bottom_text => $self->{bottom_text}, busy_string => $self->{busy_string},
              clear_screen => $self->{clear_screen}, color => $self->{color}, footer => $self->{footer},
              hide_cursor => $self->{hide_cursor}, include_highlighted => 2, index => 1, info => $self->{info},
              keep => $self->{keep}, layout => $self->{layout}, margin => $self->{margin}, mark => $mark,
              max_width => $self->{max_width}, meta_items => $meta_items, mouse => $self->{mouse},
              order => $self->{order}, page => $self->{page}, prompt => $prompt,
              tabs_bottom_text => $self->{tabs_bottom_text}, tabs_info => $self->{tabs_info},
              tabs_prompt => $self->{tabs_prompt}, undef => $self->{back} }
        );
        $mark = undef;
        if ( ! defined $idx[0] || $idx[0] == 0 ) {
            if ( @$bu ) {
                ( $curr_avail, $new_idx ) = @{pop @$bu};
                next;
            }
            $self->__restore_defaults();
            return;
        }
        push @$bu, [ [ @$curr_avail ], [ @$new_idx ] ];
        my $ok;
        if ( $idx[0] == $#pre ) {
            $ok = shift @idx;
        }
        my @tmp_idx;
        for my $i ( reverse @idx ) {
            $i -= @pre;
            if ( ! $self->{keep_chosen} ) {
                splice( @$curr_avail, $i, 1 );
                for my $used_i ( sort { $a <=> $b } @$new_idx ) {
                    last if $used_i > $i;
                    ++$i;
                }
            }
            push @tmp_idx, $i;
        }
        push @$new_idx, reverse @tmp_idx;
        if ( $ok ) {
            if ( ! @$new_idx && $self->{all_by_default} ) {
                $new_idx = [ 0 .. $#{$available} ];
            }
            my $return_indexes = $self->{index}; # because __restore_defaults resets $self->{index}
            $self->__restore_defaults();
            return $return_indexes ? $new_idx : [ @{$available}[@$new_idx] ];
        }
    }
}


sub settings_menu {
    if ( ref $_[0] ne __PACKAGE__ ) {
        my $ob = __PACKAGE__->new();
        delete $ob->{backup_instance_defaults};
        return $ob->settings_menu( @_ );
    }
    my ( $self, $menu, $curr, $opt ) = @_;
    $self->__prepare_opt( $opt );
    my $longest = 0;
    my $new = {};
    my $name_w = {};
    for my $sub ( @$menu ) {
        my ( $key, $name, $values ) = @$sub;
        $name_w->{$key} = print_columns_ext( $name, $self->{color} );
        if ( $name_w->{$key} > $longest ) {
            $longest = $name_w->{$key};
        }
        $curr->{$key} = 0 if ! defined $curr->{$key};
        $curr->{$key} = 0 if $curr->{$key} > $#$values;
        $curr->{$key} = 0 if ! defined $values->[$curr->{$key}];

        while ( ! defined $values->[$curr->{$key}] ) {
            ++$curr->{$key};
            if ( $curr->{$key} > $#$values ) {
                $curr->{$key} = 0;
                last;
            }
        }
        $new->{$key} = $curr->{$key};
    }
    my @print_keys;
    for my $sub ( @$menu ) {
        my ( $key, $name, $values ) = @$sub;
        my $current = $values->[$new->{$key}] // '';
        push @print_keys, $name . ( ' '  x ( $longest - $name_w->{$key} ) ) . " [$current]";
    }
    my @pre = ( undef, $self->{confirm} );
    $ENV{TC_RESET_AUTO_UP} = 0;
    my $default = 0;
    my $count = 0;

    while ( 1 ) {
        my @tmp_prompt;
        if ( defined $self->{cs_label} ) {
            push @tmp_prompt, $self->{cs_label} . $self->{cs_begin} . join( $self->{cs_separator}, map { "$_=$new->{$_}" } keys %$new ) . $self->{cs_end};
        }
        if ( ! defined $self->{prompt} ) {
            push @tmp_prompt, 'Your choice:';
        }
        elsif ( length $self->{prompt} ) {
            push @tmp_prompt, $self->{prompt};
        }
        my $prompt = join( "\n", @tmp_prompt );
        # Choose
        my $idx = choose(
            [ @pre, @print_keys ],
            { alignment => 0, bottom_text => $self->{bottom_text}, clear_screen => $self->{clear_screen},
              color => $self->{color}, default => $default, footer => $self->{footer},
              hide_cursor => $self->{hide_cursor}, index => 1, info => $self->{info}, keep => $self->{keep},
              layout => 2, margin => $self->{margin}, max_width => $self->{max_width}, mouse => $self->{mouse},
              page => $self->{page}, prompt => $prompt, tabs_bottom_text => $self->{tabs_bottom_text},
              tabs_info => $self->{tabs_info}, tabs_prompt => $self->{tabs_prompt}, undef => $self->{back} }

        );
        if ( ! $idx ) {
            $self->__restore_defaults();
            return;
        }
        elsif ( $idx == $#pre ) {
            my $change = 0;
            for my $sub ( @$menu ) {
                my $key = $sub->[0];
                if ( $curr->{$key} == $new->{$key} ) {
                    next;
                }
                $curr->{$key} = $new->{$key};
                $change++;
            }
            $self->__restore_defaults();
            return $change; #
        }
        my $i = $idx - @pre;
        my $key    = $menu->[$i][0];
        my $values = $menu->[$i][2];
        if ( $default == $idx ) {
            if ( $ENV{TC_RESET_AUTO_UP} ) {
                $count = 0;
            }
            elsif ( $count == @$values ) {
                $default = 0;
                $count = 0;
                next;
            }
        }
        else {
            $count = 0;
            $default = $idx;
        }
        my $curr_value = $values->[$new->{$key}] // '';
        my $new_value;

        while ( 1 ) {
            ++$count;
            if ( ++$new->{$key} > $#$values ) {
                $new->{$key} = 0;
            }
            $new_value = $values->[$new->{$key}];
            if ( defined $new_value ) {
                last;
            }
            if ( $count == @$values ) {
                $new_value = '';
                last;
            }
        }
        $print_keys[$i] =~ s/  \[ \Q$curr_value\E \] \z /[$new_value]/x;
    }
}



sub insert_sep {
    my ( $number, $separator ) = @_;
    return $number   if ! length $number;
    $separator = ',' if ! defined $separator;
    return $number   if $separator eq '';
    return $number   if $number =~ /\Q$separator\E/;
    $number =~ s/(^[-+]?\d+?(?=(?>(?:\d{3})+)(?!\d))|\G\d{3}(?=\d))/$1$separator/g;
    # http://perldoc.perl.org/perlfaq5.html#How-can-I-output-my-numbers-with-commas-added?
    return $number;
}


sub get_term_size {
    require Term::Choose::Screen;
    return Term::Choose::Screen::get_term_size();
}


sub get_term_width {
    require Term::Choose::Screen;
    my $term_width = ( Term::Choose::Screen::get_term_size() )[0];
    return $term_width;
}

sub get_term_height {
    require Term::Choose::Screen;
    my $term_height = ( Term::Choose::Screen::get_term_size() )[1];
    return $term_height;
}


sub unicode_sprintf {
    my ( $str, $avail_w, $opt ) = @_;
    $opt ||= {};
    my @color;
    if ( $opt->{color} ) {
        $str =~ s/${\PH}//g;
        $str =~ s/(${\SGR_ES})/push( @color, $1 ) && ${\PH}/ge;
    }
    my $str_w = print_columns( $str );
    if ( $str_w > $avail_w ) {
        if ( @{$opt->{suffix_on_truncate}||[]} ) {
            $str = cut_to_printwidth( $str, $avail_w - $opt->{suffix_on_truncate}[1] ) . $opt->{suffix_on_truncate}[0];
        }
        $str = cut_to_printwidth( $str, $avail_w );
    }
    if ( @color ) {
        $str =~ s/${\PH}/shift @color/ge;
        if ( @color ) {
            $str .= join '', @color;
        }
    }
    if ( $str_w < $avail_w ) {
        if ( $opt->{right_justify} ) {
            return " " x ( $avail_w - $str_w ) . $str;
        }
        else {
            return $str . " " x ( $avail_w - $str_w );
        }
    }
    else {
        return $str;
    }
}


sub print_columns_ext {
    my ( $str, $color ) = @_;
    if ( $color ) {
        $str =~ s/${\SGR_ES}//g;
    }
    return print_columns( $str );
}




1;

__END__