#!/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] [-e]
#
#   Copyright (C) 2024 Hiroo Hayashi
#
# Derived from: examples/rl.c and examples/rlevent.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] [-e]
  -p prompt:    specify the prompt string
  -u unit:      specify the file descriptor to read from
  -d default:   specify the default text
  -n nchars:    specify the number of characters to read
  -e:           enable event hook
EOM

}

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

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

$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);

die "bad file descriptor $fd\n" if $fd < 0;
die "bad value for -n: $nch\n"  if $nch < 0;

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

$a->{startup_hook}      = \&set_deftext if ($deftext && $deftext ne "");
$a->{num_chars_to_read} = $nch          if $nch > 0;
$a->{event_hook}        = \&event_hook  if $opt_e;

my $temp = $t->readline($prompt) or exit(1);
print "$temp\n";

exit(0);
