package IO::Prompt::I18N;

our $DATE = '2015-01-03'; # DATE
our $VERSION = '0.80'; # VERSION

use 5.010001;
use strict;
use warnings;

require Exporter;
our @ISA = qw(Exporter);
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 = <STDIN>;
        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,
    });
    use experimental 'smartmatch';
    $answer ~~ @{$opts->{yes_words}} ? 1:0;
}

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

__END__

=pod

=encoding UTF-8

=head1 NAME

IO::Prompt::I18N - Prompt user question, with some options (including I18N)

=head1 VERSION

This document describes version 0.80 of IO::Prompt::I18N (from Perl distribution IO-Prompt-I18N), released on 2015-01-03.

=head1 SYNOPSIS

 use IO::Prompt::I18N qw(prompt confirm);
 use Text::LocaleDomain 'My-App';

 my $file = prompt(__"Enter filename");

 if (confirm(__"Really delete filename", {lang=>"id", default=>0})) {
     unlink $file;
 }

=head1 DESCRIPTION

This module provides the C<prompt> function to ask for a value from STDIN. It
features prompt text, default value, validation (using regex),
optional/required. It also provides C<confirm> wrapper to ask yes/no, with
localizable text.

=head1 FUNCTIONS

=head2 prompt([ $text[, \%opts] ]) => val

Display C<$text> and ask value from STDIN. Will re-ask if value is not valid.
Return the chomp-ed value.

Options:

=over

=item * var => \$var

=item * required => bool

If set to true then will require that value is not empty (zero-length).

=item * default => VALUE

Set default value.

=item * show_default => bool (default: 1)

Whether to show default value if defined.

=item * regex => REGEX

Validate using regex.

=back

=head2 confirm([ $text, [\%opts] ]) => bool

Display C<$text> (defaults to C<Confirm> in English) and ask for yes or no. Will
return bool. Basically a convenient wrapper around C<prompt>.

Options:

=over

=item * lang => str

Support several languages (C<id>, C<en>, C<fr>). Default to using LANG/LANGUAGE
or English. Will preset C<yes_words> and C<no_words> and adds the choice of
words to C<$text>. Will die if language is not supported. Here are the supported
languages:

  lang  yes_words     no_regex   default text
  ----  ---------     --------   ------------
  en    y, yes        n, no      Confirm
  fr    o, oui        n, non     Confirmer
  id    y, ya         t, tidak   Konfirmasi

=item * yes_words => array

Overrides preset from C<lang>.

=item * no_words => array

Overrides preset from C<lang>.

=item * default => bool

Set default value.

=back

=head1 SEE ALSO

L<IO::Prompt>, L<IO::Prompt::Tiny>, L<Term::Prompt>, L<Prompt::Timeout>

=head1 HOMEPAGE

Please visit the project's homepage at L<https://metacpan.org/release/IO-Prompt-I18N>.

=head1 SOURCE

Source repository is at L<https://github.com/perlancar/perl-IO-Prompt-I18N>.

=head1 BUGS

Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=IO-Prompt-I18N>

When submitting a bug or request, please include a test-file or a
patch to an existing test-file that illustrates the bug or desired
feature.

=head1 AUTHOR

perlancar <perlancar@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2015 by perlancar@cpan.org.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut