File Coverage

blib/lib/IO/Prompt/I18N.pm

Criterion	Covered	Total	%
statement	11	74	14.8
branch	0	44	0.0
condition	0	38	0.0
subroutine	4	6	66.6
pod	2	2	100.0
total	17	164	10.3

package IO::Prompt::I18N;

use 5.010001;
use strict;
use warnings;

use Exporter qw(import);

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2023-11-20'; # DATE
our $DIST = 'IO-Prompt-I18N'; # DIST
our $VERSION = '0.81'; # VERSION

our @EXPORT_OK = qw(prompt confirm);

sub prompt {
    my ($text, $opts) = @_;

    $text //= "Enter value";
    $opts //= {};

    my $answer;

    my $default;
    $default = ${$opts->{var}} if $opts->{var};
    $default = $opts->{default} if defined($opts->{default});

    while (1) {
        # prompt
        print $text;
        print " ($default)" if defined($default) && $opts->{show_default}//1;
        print ":" unless $text =~ /[:?]\s*$/;
        print " ";

        # get input
        $answer = ;
        if (!defined($answer)) {
            print "\n";
            $answer = "";
        }
        chomp($answer);

        # check+process answer
        if (defined($default)) {
            $answer = $default if !length($answer);
        }
        my $success = 1;
        if ($opts->{required}) {
            $success = 0 if !length($answer);
        }
        if ($opts->{regex}) {
            $success = 0 if $answer !~ /$opts->{regex}/;
        }
        last if $success;
    }
    ${$opts->{var}} = $answer if $opts->{var};
    $answer;
}

sub confirm {
    my ($text, $opts) = @_;

    $opts //= {};

    state $supported_langs = {
        en => {yes_words=>[qw/y yes/], no_words=>[qw/n no/]   , text=>'Confirm'},
        fr => {yes_words=>[qw/o oui/], no_words=>[qw/n non/]  , text=>'Confirmer'},
        id => {yes_words=>[qw/y ya/] , no_words=>[qw/t tidak/], text=>'Konfirmasi'},
    };

    $opts->{lang} //= do {
        if ($ENV{LANG} && $ENV{LANG} =~ /^([a-z]{2})/ &&
                $supported_langs->{$1}) {
            $1;
        } elsif ($ENV{LANGUAGE} && $ENV{LANGUAGE} =~ /^([a-z]{2})/ &&
                $supported_langs->{$1}) {
            $1;
        } else {
            'en';
        }
    };

    my $lang = $supported_langs->{$opts->{lang}}
        or die "Unknown language '$opts->{lang}'";
    $text //= $lang->{text};
    $opts->{yes_words} //= $lang->{yes_words};
    $opts->{no_words}  //= $lang->{no_words};

    my $default;
    if (defined $opts->{default}) {
        if ($opts->{default}) {
            $default = $opts->{yes_words}[0];
        } else {
            $default = $opts->{no_words}[0];
        }
    }

    my $suffix;
    my $show_default = 1;
    unless ($text =~ /[?]/) {
        $text .=
            join("",
                 " (",
                 join("/",
                      (map {$opts->{default} ? uc($_) : lc($_)}
                           @{ $opts->{yes_words} }),
                      (map {defined($opts->{default}) && !$opts->{default} ?
                                        uc($_) : lc($_)}
                           @{ $opts->{no_words} }),
                  ),
                 ")?",
             );
        $show_default = 0; # because we already indicate which using uppercase
    }

    my $re = join("|", map {quotemeta}
                      (@{$opts->{yes_words}}, @{$opts->{no_words}}));
    $re = qr/\A($re)\z/i;

    my $answer = prompt($text, {
        required     => 1,
        regex        => $re,
        show_default => $show_default,
        default      => $default,
    });
    (grep {$_ eq $answer} @{$opts->{yes_words}}) ? 1:0;
}

1;
# ABSTRACT: Prompt user question, with some options (including I18N)

__END__