#!/usr/bin/env perl
#
# rl - command-line interface to read a line from the standard input
#      (or another fd) using readline.
#
# usage: rl [-p prompt] [-u unit] [-d default] [-n nchars]
#
#   Copyright (C) 2024 Hiroo Hayashi
#
# Derived from: examples/rl.c in the GNU Readline Library
#   Copyright (C) 1987-2023 Free Software Foundation, Inc.

use strict;
use warnings;
use Term::ReadLine;
use File::Basename;
use Getopt::Std;
$Getopt::Std::STANDARD_HELP_VERSION = 1;
my $VERSION = "1.0";

# default values
my $prompt  = 'readline$ ';
my $fd      = 0;
my $deftext = "";
my $nch     = 0;

my $t = new Term::ReadLine 'rl';
my $a = $t->Attribs;

sub event_hook {
    print STDERR "ding!\n";
    sleep(1);
    return 0;
}

sub set_deftext {
    if ($deftext) {
        $t->insert_text($deftext);
        $deftext = "";
        $a->{startup_hook} = undef;
    }
    return 0;
}

my $progname = basename($0);

sub HELP_MESSAGE {
    my ($fh) = @_;
    print $fh <<EOM;
"usage: $progname [-p prompt] [-u unit] [-d default] [-n nchars]
EOM
}

sub VERSION_MESSAGE {
    my ($fh) = @_;
    print $fh "version: $VERSION\n";
}

our ($opt_p, $opt_u, $opt_d, $opt_n);
getopts('p:u:d:n:');

$prompt  = $opt_p if defined($opt_p);
$fd      = $opt_u if defined($opt_u);
$deftext = $opt_d if defined($opt_d);
$nch     = $opt_n if defined($opt_n);

if ($fd < 0) {
    die "bad file descriptor $fd\n";
}
if ($nch < 0) {
    die "bad value for -n: $nch\n";
}
if ($fd != 0) {
    stat($fd)                 or die "$fd: $!\n";
    open(my $ifp, "<&=", $fd) or die "$fd: $!\n";
    $a->{instream} = $ifp;
}

if ($deftext && $deftext ne "") {
    $a->{startup_hook} = \&set_deftext;
}

if ($nch > 0) {
    $a->{num_chars_to_read} = $nch;
}

$a->{event_hook} = \&event_hook;
my $temp = $t->readline($prompt) or exit(1);
print "$temp\n";

exit(0);
