diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml new file mode 100644 index 0000000..d6e805c --- /dev/null +++ b/.github/workflows/ci.yml @@ -0,0 +1,40 @@ +name: CI + +on: + push: + branches: [ master ] + pull_request: + branches: [ master ] + +jobs: + test: + name: Perl ${{ matrix.perl }} on ${{ matrix.os }} + runs-on: ${{ matrix.os }} + + strategy: + matrix: + os: [ ubuntu-latest ] + perl: [ '5.32', '5.36', '5.38' ] + + steps: + - name: Checkout code + uses: actions/checkout@v4 + + - name: Set up Perl + uses: shogo82148/actions-setup-perl@v1 + with: + perl-version: ${{ matrix.perl }} + + - name: Install cpanm + run: cpanm --notest App::cpanminus + + - name: Install dependencies + run: cpanm --notest --installdeps . + + - name: Build + run: | + perl Build.PL + ./Build + + - name: Run tests + run: ./Build test diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..709caee --- /dev/null +++ b/.gitignore @@ -0,0 +1,9 @@ +Build +_build/ +blib/ +MYMETA.* +*.bak +*.swp +**/#*# +**/*~ +*.tar.gz diff --git a/Build.PL b/Build.PL new file mode 100644 index 0000000..4ba1980 --- /dev/null +++ b/Build.PL @@ -0,0 +1,23 @@ +use strict; +use warnings; +use Module::Build; + +my $build = Module::Build->new( + module_name => 'Term::ReadLine::Repl', + license => 'perl', + dist_author => 'John R. ', + requires => { + 'perl' => '5.010', + 'Data::Dumper' => 0, + 'JSON' => 0, + 'Term::ANSIColor' => 0, + 'Term::ReadLine' => 0, + 'Carp' => 0, + }, + build_requires => { + 'Module::Build' => 0, + 'Test::Exception' => 0, + }, +); + +$build->create_build_script(); diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 index 0000000..d5e8e37 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,29 @@ +# Changelog + +All notable changes to this project will be documented in this file. + +The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.1.0/), +and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). + +## [Unreleased] + +## [0.0.1] - 2026-03-13 + +### Added + +- Initial release of `Term::ReadLine::Repl`. +- Basic REPL loop with prompt, welcome message, and `help`/`quit` built-in commands. +- Tab auto-completion for command names and their defined arguments. +- Argument validation in `validate_args()` with descriptive croak messages for + missing or malformed constructor args. +- `get_opts` support for integrating a `Getopt::Long` parsing function into the loop. +- `custom_logic` hook allowing callers to inject mid-loop logic, control flow + (`next`/`last`), and dynamic `cmd_schema` changes. +- `passthrough` option to forward `!command` input directly to the system shell. +- Persistent command history via `hist_file`. +- `Build.PL` for distribution build and dependency management. +- `META.yml` and `MANIFEST` for CPAN packaging. +- Full POD documentation including constructor args, methods, built-in commands, + and tab completion behaviour. +- Test suite covering `validate_args` croak paths, construction sanity checks, + and `_tab_complete` behaviour. diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..54a3441 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,8 @@ +Build.PL +example.pl +lib/Term/ReadLine/Repl.pm +MANIFEST This list of files +META.json +META.yml +Readme.md +t/01_basic.t diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP new file mode 100755 index 0000000..c864074 --- /dev/null +++ b/MANIFEST.SKIP @@ -0,0 +1,15 @@ +#!include_default +# Avoid configuration metadata file +^MYMETA\. + +# Avoid Module::Build generated and utility files. +\bBuild$ +\bBuild.bat$ +\b_build +\bBuild.COM$ +\bBUILD.COM$ +\bbuild.com$ +^MANIFEST\.SKIP + +# Avoid archives of this distribution +\bTerm-ReadLine-Repl-[\d\.\_]+ diff --git a/META.json b/META.json new file mode 100644 index 0000000..bbaf3fd --- /dev/null +++ b/META.json @@ -0,0 +1,53 @@ +{ + "abstract" : "A batteries included interactive Term::ReadLine REPL module", + "author" : [ + "John R. " + ], + "dynamic_config" : 1, + "generated_by" : "Module::Build version 0.4231", + "license" : [ + "perl_5" + ], + "meta-spec" : { + "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", + "version" : 2 + }, + "name" : "Term-ReadLine-Repl", + "prereqs" : { + "build" : { + "requires" : { + "Module::Build" : "0", + "Test::Exception" : "0" + } + }, + "configure" : { + "requires" : { + "Module::Build" : "0.42" + } + }, + "runtime" : { + "requires" : { + "Carp" : "0", + "Data::Dumper" : "0", + "JSON" : "0", + "Term::ANSIColor" : "0", + "Term::ReadLine" : "0", + "perl" : "5.010" + } + } + }, + "provides" : { + "Term::ReadLine::Repl" : { + "file" : "lib/Term/ReadLine/Repl.pm", + "version" : "v0.0.1" + } + }, + "release_status" : "stable", + "resources" : { + "license" : [ + "http://dev.perl.org/licenses/" + ] + }, + "version" : "v0.0.1", + "x_serialization_backend" : "JSON::PP version 4.06" +} diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..4c54ccd --- /dev/null +++ b/META.yml @@ -0,0 +1,31 @@ +--- +abstract: 'A batteries included interactive Term::ReadLine REPL module' +author: + - 'John R. ' +build_requires: + Module::Build: '0' + Test::Exception: '0' +configure_requires: + Module::Build: '0.42' +dynamic_config: 1 +generated_by: 'Module::Build version 0.4231, CPAN::Meta::Converter version 2.150010' +license: perl +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: '1.4' +name: Term-ReadLine-Repl +provides: + Term::ReadLine::Repl: + file: lib/Term/ReadLine/Repl.pm + version: v0.0.1 +requires: + Carp: '0' + Data::Dumper: '0' + JSON: '0' + Term::ANSIColor: '0' + Term::ReadLine: '0' + perl: '5.010' +resources: + license: http://dev.perl.org/licenses/ +version: v0.0.1 +x_serialization_backend: 'CPAN::Meta::YAML version 0.018' diff --git a/Readme.md b/Readme.md new file mode 100644 index 0000000..27b2953 --- /dev/null +++ b/Readme.md @@ -0,0 +1,188 @@ +![CI](https://github.com/BlueSquare23/Term-ReadLine-Repl/actions/workflows/ci.yml/badge.svg) + +# NAME + +Term::ReadLine::Repl - A batteries included interactive Term::ReadLine REPL module + +# SYNOPSIS + + use Term::ReadLine::Repl; + + # A simple repl + my $repl = Term::ReadLine::Repl->new( + { + name => 'myrepl', + cmd_schema => { + ls => { + exec => sub { my @list = qw(a b c); print for @list }, + }, + }, + } + ); + + # A complete repl + $repl = Term::ReadLine::Repl->new( + { + name => 'myrepl', + prompt => '(%s)>', + cmd_schema => { + stats => { + exec => \&get_stats, + args => [ + { + refresh => undef, + host => 'hostname', + guest => 'guestname', + list => 'host|guest', + cluster => undef, + } + ], + }, + }, + passthrough => 1, + hist_file => '/path/to/.hist_file', + get_opts => \&arg_parse, + custom_logic => \&my_custom_loop_ctrl, + } + ); + + $repl->run(); + +# DESCRIPTION + +`Term::ReadLine::Repl` provides a simple framework for building interactive +command-line REPLs (Read-Eval-Print Loops) on top of [Term::ReadLine](https://metacpan.org/pod/Term%3A%3AReadLine). It +handles tab completion, command history, a built-in help system, and optional +passthrough to shell commands, so you can focus on defining your commands +rather than plumbing the terminal interaction. + +## Overview + +You define your commands and their arguments via the `cmd_schema` hashref +passed to `new()`. Each command maps to an `exec` coderef that is called +when the user types that command, and an optional `args` structure that drives +tab completion. Once constructed, calling `run()` drops the user into an +interactive prompt. + +The module handles the following automatically: + +- **Tab completion** - command names and their arguments are completed from the +`cmd_schema` definition. Passthrough commands (prefixed with `!`) are +excluded. +- **Command history** - input history is maintained in-session via +[Term::ReadLine](https://metacpan.org/pod/Term%3A%3AReadLine), and can be persisted across sessions by supplying a +`hist_file` path. +- **Built-in commands** - `help` and `quit`/`exit` are injected automatically +into every REPL. +- **Shell passthrough** - when `passthrough` is enabled, any input prefixed with +`!` is forwarded directly to the system shell, making it easy to run one-off +shell commands without leaving the REPL. +- **Custom loop hooks** - the `get_opts` and `custom_logic` callbacks let you +plug [Getopt::Long](https://metacpan.org/pod/Getopt%3A%3ALong) parsing and arbitrary mid-loop logic into the REPL without +having to subclass or modify the module. + +# CONSTRUCTOR + +- `new(\%args)` + + Creates and returns a new `Term::ReadLine::Repl` object. Accepts a hashref + with the following keys: + + - `name` (required) + + A string used as the name of the REPL, displayed in the welcome message and + optionally interpolated into the prompt via `%s`. + + - `cmd_schema` (required) + + A hashref defining the available commands. Each key is a command name, and + its value is a hashref with the following keys: + + - `exec` (required) + + A coderef that is called when the command is invoked. Any arguments supplied + on the command line (after the command name) are passed to the coderef. + + - `args` (optional) + + An arrayref of hashrefs describing the command's arguments for tab completion. + Each hashref maps an argument name to either `undef` (flag, no value expected) + or a string describing the expected value (used as a completion hint). + + - `prompt` (optional) + + A `sprintf`-style format string for the prompt. `%s` is replaced with the + REPL name. Defaults to `(repl)`>. + + - `passthrough` (optional) + + When set to a true value, any input beginning with `!` is passed directly to + the system shell. For example, `!ls -la` would run `ls -la`. Defaults to `0`. + + - `hist_file` (optional) + + Path to a file used for persistent command history. History is loaded on + startup and saved on exit. If not specified, history is not persisted. + + - `get_opts` (optional) + + A coderef to a [Getopt::Long](https://metacpan.org/pod/Getopt%3A%3ALong) parsing function. When provided, it is called + before each command dispatch with `@ARGV` populated from the current input line. + + - `custom_logic` (optional) + + A coderef invoked on each loop iteration before command dispatch. Receives an + arrayref of the parsed input tokens. May return a hashref with the following + optional keys: + + - `action` + + Set to `'next'` to skip to the next loop iteration, or `'last'` to exit + the REPL loop. + + - `schema` + + A replacement `cmd_schema` hashref to swap in for subsequent iterations. + +# METHODS + +- `run()` + + Launches the interactive REPL session. Prints a welcome message, then enters + the read-eval-print loop until the user types `quit`, `exit`, or `EOF`. + Saves history on exit if `hist_file` was configured. + +- `validate_args(\%args)` + + Validates the constructor argument hashref. Croaks with a descriptive message + if any required arguments are missing or if any values have an unexpected type. + Called automatically by `new()`. + +# BUILT-IN COMMANDS + +The following commands are automatically added to every REPL: + +- `help` + + Prints all available commands and their arguments. + +- `quit` / `exit` + + Exits the REPL session. + +# TAB COMPLETION + +Tab completion is provided automatically for command names and their defined +arguments. Completions are driven by the `args` key in each command's schema. +Passthrough commands (those beginning with `!`) are excluded from completion. + +# AUTHORS + +Written by John R. Copyright (c) 2026 + +# LICENSE + +This library is free software; you can redistribute it and/or modify it under +the same terms as Perl itself. + +See [http://dev.perl.org/licenses/](http://dev.perl.org/licenses/) for more information. diff --git a/test.pl b/example.pl similarity index 88% rename from test.pl rename to example.pl index 18f36c9..50eb68b 100755 --- a/test.pl +++ b/example.pl @@ -108,7 +108,19 @@ sub get_stats { } ); -print Dumper $term; +## A simple repl +#my $term = Term::ReadLine::Repl->new( +# { +# name => 'myrepl', +# cmd_schema => { +# ls => { +# exec => sub {my @list = qw(a b c); print for @list}, # Coderef to custom function for cmd +# } +# } +# } +#); + +#print Dumper $term; $term->run(); diff --git a/lib/Term/ReadLine/Repl.pm b/lib/Term/ReadLine/Repl.pm index 69f802c..283e0b8 100755 --- a/lib/Term/ReadLine/Repl.pm +++ b/lib/Term/ReadLine/Repl.pm @@ -3,10 +3,12 @@ use warnings; package Term::ReadLine::Repl; +our $VERSION = '0.0.1'; + =head1 NAME -Term::ReadLine::Repl - A batteries included interactive Term::ReadLine Repl module - +Term::ReadLine::Repl - A batteries included interactive Term::ReadLine REPL module + =head1 SYNOPSIS use Term::ReadLine::Repl; @@ -14,36 +16,38 @@ Term::ReadLine::Repl - A batteries included interactive Term::ReadLine Repl modu # A simple repl my $repl = Term::ReadLine::Repl->new( { - name => 'myrepl', + name => 'myrepl', cmd_schema => { - ls => { - exec => sub {my @list = qw(a b c); print for @list}, # Coderef to custom function for cmd - } - } + ls => { + exec => sub { my @list = qw(a b c); print for @list }, + }, + }, } ); # A complete repl $repl = Term::ReadLine::Repl->new( { - name => 'myrepl', - prompt => '(%s)>', + name => 'myrepl', + prompt => '(%s)>', cmd_schema => { - stats => { - exec => \&get_stats, # Coderef to function - args => [{ - refresh => undef, - host => 'hostname', - guest => 'guestname', - list => 'host|guest', - cluster => undef, - }], + stats => { + exec => \&get_stats, + args => [ + { + refresh => undef, + host => 'hostname', + guest => 'guestname', + list => 'host|guest', + cluster => undef, + } + ], }, }, - passthrough => 1, # Enable !command system passthrough - hist_file => '/path/to/.hist_file', - get_opts => \&arg_parse # Coderef to Getopt::Long parse function - custom_logic => \&my_custom_loop_ctrl # Coderef to custom logic run mid repl loop + passthrough => 1, + hist_file => '/path/to/.hist_file', + get_opts => \&arg_parse, + custom_logic => \&my_custom_loop_ctrl, } ); @@ -51,27 +55,197 @@ Term::ReadLine::Repl - A batteries included interactive Term::ReadLine Repl modu =head1 DESCRIPTION +C provides a simple framework for building interactive +command-line REPLs (Read-Eval-Print Loops) on top of L. It +handles tab completion, command history, a built-in help system, and optional +passthrough to shell commands, so you can focus on defining your commands +rather than plumbing the terminal interaction. + =head2 Overview +You define your commands and their arguments via the C hashref +passed to C. Each command maps to an C coderef that is called +when the user types that command, and an optional C structure that drives +tab completion. Once constructed, calling C drops the user into an +interactive prompt. -=head2 Methods +The module handles the following automatically: -=cut +=over 4 -use Data::Dumper; -use JSON qw(encode_json decode_json); -use Term::ANSIColor; -use Term::ReadLine; +=item * + +B - command names and their arguments are completed from the +C definition. Passthrough commands (prefixed with C) are +excluded. + +=item * + +B - input history is maintained in-session via +L, and can be persisted across sessions by supplying a +C path. + +=item * + +B - C and C/C are injected automatically +into every REPL. + +=item * + +B - when C is enabled, any input prefixed with +C is forwarded directly to the system shell, making it easy to run one-off +shell commands without leaving the REPL. + +=item * + +B - the C and C callbacks let you +plug L parsing and arbitrary mid-loop logic into the REPL without +having to subclass or modify the module. + +=back + +=head1 CONSTRUCTOR + +=over 4 + +=item C + +Creates and returns a new C object. Accepts a hashref +with the following keys: + +=over 4 + +=item C (required) + +A string used as the name of the REPL, displayed in the welcome message and +optionally interpolated into the prompt via C<%s>. + +=item C (required) + +A hashref defining the available commands. Each key is a command name, and +its value is a hashref with the following keys: + +=over 4 + +=item C (required) + +A coderef that is called when the command is invoked. Any arguments supplied +on the command line (after the command name) are passed to the coderef. + +=item C (optional) + +An arrayref of hashrefs describing the command's arguments for tab completion. +Each hashref maps an argument name to either C (flag, no value expected) +or a string describing the expected value (used as a completion hint). + +=back -=item C +=item C (optional) -Returns built term object based on user supplied args hashref. +A C-style format string for the prompt. C<%s> is replaced with the +REPL name. Defaults to C<(repl)>>. + +=item C (optional) + +When set to a true value, any input beginning with C is passed directly to +the system shell. For example, C would run C. Defaults to C<0>. + +=item C (optional) + +Path to a file used for persistent command history. History is loaded on +startup and saved on exit. If not specified, history is not persisted. + +=item C (optional) + +A coderef to a L parsing function. When provided, it is called +before each command dispatch with C<@ARGV> populated from the current input line. + +=item C (optional) + +A coderef invoked on each loop iteration before command dispatch. Receives an +arrayref of the parsed input tokens. May return a hashref with the following +optional keys: + +=over 4 + +=item C + +Set to C<'next'> to skip to the next loop iteration, or C<'last'> to exit +the REPL loop. + +=item C + +A replacement C hashref to swap in for subsequent iterations. + +=back + +=back + +=back + +=head1 METHODS + +=over 4 + +=item C + +Launches the interactive REPL session. Prints a welcome message, then enters +the read-eval-print loop until the user types C, C, or C. +Saves history on exit if C was configured. + +=item C + +Validates the constructor argument hashref. Croaks with a descriptive message +if any required arguments are missing or if any values have an unexpected type. +Called automatically by C. + +=back + +=head1 BUILT-IN COMMANDS + +The following commands are automatically added to every REPL: + +=over 4 + +=item C + +Prints all available commands and their arguments. + +=item C / C + +Exits the REPL session. + +=back + +=head1 TAB COMPLETION + +Tab completion is provided automatically for command names and their defined +arguments. Completions are driven by the C key in each command's schema. +Passthrough commands (those beginning with C) are excluded from completion. + +=head1 AUTHORS + +Written by John R. Copyright (c) 2026 + +=head1 LICENSE + +This library is free software; you can redistribute it and/or modify it under +the same terms as Perl itself. + +See L for more information. =cut +use Data::Dumper; +use Term::ANSIColor; +use Term::ReadLine; +use Carp qw(croak); + sub new { my ($class, $args) = @_; + $class->validate_args($args); + my $self = { name => $args->{name} // 'repl', prompt => defined $args->{prompt} ? sprintf $args->{prompt}, $args->{name} : '(repl)>', @@ -88,17 +262,44 @@ sub new { bless $self, $class; -# TODO: Write this! -# validate_args($args); - return $self; } -=item C +sub validate_args { + my ($self, $args) = @_; -Launches interactive session for custom defined repl. + # Ensure name and cmd_schema exist (required args) + croak "name is a required arg!" unless exists $args->{name} && defined $args->{name}; + croak "cmd_schema is a required arg!" unless exists $args->{cmd_schema} && defined $args->{cmd_schema}; -=cut + # Ensure cmd_schema is a hashref + croak "cmd_schema is NOT a hashref!" unless ref $args->{cmd_schema} eq 'HASH'; + + # Ensure each cmd has an exec key and is a coderef + for my $cmd (keys %{$args->{cmd_schema}}) { + my $schema = $args->{cmd_schema}{$cmd}; + + croak "'$cmd' missing exec key!" unless defined $schema->{exec}; + + croak "'$cmd' exec is NOT a coderef!" unless ref $schema->{exec} eq 'CODE'; + + # Ensure that args is an array + if (exists $schema->{args} && defined $schema->{args}) { + croak "'$cmd' args is NOT a arrayref!" unless ref $schema->{args}; + + croak "'$cmd' args array is empty!" if scalar @{$schema->{args}} < 1; + + for my $arg (@{$schema->{args}}) { + croak "'$cmd' non-hashref found in args arrayref!" unless ref $arg eq 'HASH'; + } + } + } + + # Ensure get_ops is a coderef if present + if (exists $args->{get_opts} && defined $args->{get_opts}) { + croak "get_opts is NOT a coderef!" unless ref $args->{get_opts} eq 'CODE'; + } +} sub run { my ($self) = @_; @@ -111,70 +312,8 @@ sub run { print colored(sprintf("Welcome to $self->{name} shell!"), 'green underline italic bold'), "\n"; print colored(sprintf("Type 'help' for more options, to auto complete."), 'green bold'), "\n"; - # TODO: Put in its own method(s) # Tab completion. - $attribs->{completion_function} = sub { - my ($text, $line) = @_; - - # Don't auto complete on passthroughs. - return () if $line =~ /^\!/; - - # Split the current line into words. - my @words = split(/\s+/, $line); - my @complete_words = @words; - pop @complete_words unless $line =~ /\s$/; - - if (@words >= 1) { - my $cmd = $words[0]; - my $arg_index = (scalar(@complete_words) - 1); # -1 because first word is always $cmd - - if ($self->{cmd_schema}{$cmd}) { - - # None of the below make sense unless we have args. - return () unless $self->{cmd_schema}{$cmd}{args}; - - my $opt_arg_index = $arg_index -1; - - # If next word matches args key, go into optargs - if (exists $self->{cmd_schema}{$cmd}{args}[$opt_arg_index]{$complete_words[-1]}) { - my $opt_arg = $self->{cmd_schema}{$cmd}{args}[$opt_arg_index]{$complete_words[-1]}; - return "<$opt_arg>"; - } - - # Count number of opt args in command to subtract from $arg_index. - my $num_opt_args=0; - my @all_opt_args; - for my $arg (@{$self->{cmd_schema}{$cmd}{args}}) { - for my $key (keys %{$arg}) { - my $value = $arg->{$key}; - push @all_opt_args, $key if defined $value; - } - } - for my $word (@complete_words) { - for my $opt_arg (@all_opt_args) { - $num_opt_args++ if ($word eq $opt_arg); - } - } - $arg_index = $arg_index - $num_opt_args; - - my $args = @{$self->{cmd_schema}{$cmd}{args}}[$arg_index]; - my @keys = keys %{$args}; - return () unless @keys; - return grep { /^\Q$text/ } @keys; - } - } - - # If we're completing the first word - if (@words <= 1) { - my $cmd = $words[0]; - my @cmds = keys %{$self->{cmd_schema}}; - return grep { /^\Q$text/ } @cmds; - } - - # No completion For anything beyond second word. - return (); - }; - + $attribs->{completion_function} = sub { return $self->_tab_complete(@_) }; my $prompt = colored(sprintf("$self->{prompt} "), 'green'); $|++; @@ -182,7 +321,7 @@ sub run { # Simple REPL loop. while (defined (my $input = $term->readline($prompt))) { chomp $input; - last if ($input =~ 'exit|quit'); + last if ($input =~ /^(exit|quit)$/); next unless $input; @@ -201,8 +340,6 @@ sub run { } if (defined $self->{get_opts}) { - # TODO: Add validation to assert get_opts is a coderef or raise exception or croak. - # Clobber ARGV for getopts parsing, doesn't matter because client # code parser will slurp args outta @ARGV again right away. @ARGV = @args; @@ -243,6 +380,70 @@ sub run { $self->_save_history($term) if defined $self->{hist_file}; } +sub _tab_complete { + my ($self, $text, $line) = @_; + + # Don't auto complete on passthroughs. + return () if $line =~ /^\!/; + + # Split the current line into words. + my @words = split(/\s+/, $line); + my @complete_words = @words; + pop @complete_words unless $line =~ /\s$/; + + if (@words >= 1) { + my $cmd = $words[0]; + my $arg_index = (scalar(@complete_words) - 1); # -1 because first word is always $cmd + + if ($self->{cmd_schema}{$cmd}) { + my $schema = $self->{cmd_schema}{$cmd}; + + # None of the below make sense unless we have args. + return () unless $schema->{args}; + + my $opt_arg_index = $arg_index -1; + + # If next word matches args key, go into optargs + if (scalar @complete_words && exists $schema->{args}[$opt_arg_index]{$complete_words[-1]}) { + my $opt_arg = $schema->{args}[$opt_arg_index]{$complete_words[-1]}; + return "<$opt_arg>" if defined $opt_arg; + } + + # Count number of opt args in command to subtract from $arg_index. + my $num_opt_args=0; + my @all_opt_args; + for my $arg (@{$schema->{args}}) { + for my $key (keys %{$arg}) { + my $value = $arg->{$key}; + push @all_opt_args, $key if defined $value; + } + } + for my $word (@complete_words) { + for my $opt_arg (@all_opt_args) { + $num_opt_args++ if ($word eq $opt_arg); + } + } + $arg_index = $arg_index - $num_opt_args; + + my $args = @{$schema->{args}}[$arg_index]; + my @keys = keys %{$args}; + return () unless @keys; + return grep { /^\Q$text/ } @keys; + } + } + + # If we're completing the first word + if (@words <= 1) { + my $cmd = $words[0]; + my @cmds = keys %{$self->{cmd_schema}}; + return grep { /^\Q$text/ } @cmds; + } + + # No completion For anything beyond second word. + return (); +} + + sub _help { my ($self) = @_; @@ -292,11 +493,4 @@ sub _save_history { close $fh; } - -=head1 AUTHORS - - Written by John R. Copyright (c) 2026 -=cut - 1; - diff --git a/t/01_basic.t b/t/01_basic.t new file mode 100644 index 0000000..edf3e1f --- /dev/null +++ b/t/01_basic.t @@ -0,0 +1,172 @@ +use strict; +use warnings; + +use Test::More; +use Test::Exception; + +use Term::ReadLine::Repl; + +# --------------------------------------------------------------------------- +# Helpers +# --------------------------------------------------------------------------- + +my $dummy_exec = sub { 1 }; + +sub make_repl { + my (%overrides) = @_; + my %defaults = ( + name => 'test', + cmd_schema => { foo => { exec => $dummy_exec } }, + ); + return Term::ReadLine::Repl->new({ %defaults, %overrides }); +} + +# --------------------------------------------------------------------------- +# validate_args - required fields +# --------------------------------------------------------------------------- + +subtest 'missing name croaks' => sub { + throws_ok { Term::ReadLine::Repl->new({ cmd_schema => { foo => { exec => $dummy_exec } } }) } + qr/name is a required arg/, 'croaks when name is missing'; +}; + +subtest 'missing cmd_schema croaks' => sub { + throws_ok { Term::ReadLine::Repl->new({ name => 'test' }) } + qr/cmd_schema is a required arg/, 'croaks when cmd_schema is missing'; +}; + +subtest 'cmd_schema not a hashref croaks' => sub { + throws_ok { Term::ReadLine::Repl->new({ name => 'test', cmd_schema => 'bad' }) } + qr/cmd_schema is NOT a hashref/, 'croaks when cmd_schema is not a hashref'; +}; + +# --------------------------------------------------------------------------- +# validate_args - cmd_schema contents +# --------------------------------------------------------------------------- + +subtest 'cmd missing exec croaks' => sub { + throws_ok { Term::ReadLine::Repl->new({ name => 'test', cmd_schema => { foo => {} } }) } + qr/missing exec key/, 'croaks when exec key is absent'; +}; + +subtest 'cmd exec not a coderef croaks' => sub { + throws_ok { Term::ReadLine::Repl->new({ name => 'test', cmd_schema => { foo => { exec => 'not_a_coderef' } } }) } + qr/exec is NOT a coderef/, 'croaks when exec is not a coderef'; +}; + +subtest 'cmd args not an arrayref croaks' => sub { + throws_ok { + Term::ReadLine::Repl->new({ + name => 'test', + cmd_schema => { foo => { exec => $dummy_exec, args => 'bad' } }, + }) + } qr/args is NOT a arrayref/, 'croaks when args is not an arrayref'; +}; + +subtest 'cmd args empty arrayref croaks' => sub { + throws_ok { + Term::ReadLine::Repl->new({ + name => 'test', + cmd_schema => { foo => { exec => $dummy_exec, args => [] } }, + }) + } qr/args array is empty/, 'croaks when args arrayref is empty'; +}; + +subtest 'cmd args contains non-hashref croaks' => sub { + throws_ok { + Term::ReadLine::Repl->new({ + name => 'test', + cmd_schema => { foo => { exec => $dummy_exec, args => ['not_a_hash'] } }, + }) + } qr/non-hashref found in args arrayref/, 'croaks when args entry is not a hashref'; +}; + +# --------------------------------------------------------------------------- +# validate_args - get_opts +# --------------------------------------------------------------------------- + +subtest 'get_opts not a coderef croaks' => sub { + throws_ok { make_repl( get_opts => 'not_a_coderef' ) } + qr/get_opts is NOT a coderef/, 'croaks when get_opts is not a coderef'; +}; + +subtest 'get_opts as coderef is accepted' => sub { + lives_ok { make_repl( get_opts => sub { 1 } ) } + 'does not croak when get_opts is a coderef'; +}; + +# --------------------------------------------------------------------------- +# new() - valid construction +# --------------------------------------------------------------------------- + +subtest 'basic construction succeeds' => sub { + my $repl; + lives_ok { $repl = make_repl() } 'constructs without error'; + isa_ok $repl, 'Term::ReadLine::Repl'; +}; + +subtest 'builtin commands are added' => sub { + my $repl = make_repl(); + ok exists $repl->{cmd_schema}{help}, 'help command added'; + ok exists $repl->{cmd_schema}{quit}, 'quit command added'; +}; + +subtest 'default prompt is set' => sub { + my $repl = make_repl(); + like $repl->{prompt}, qr/repl/, 'default prompt contains repl name'; +}; + +subtest 'custom prompt is interpolated' => sub { + my $repl = make_repl( name => 'mything', prompt => '(%s)>' ); + like $repl->{prompt}, qr/mything/, 'custom prompt contains name'; +}; + +subtest 'passthrough defaults to 0' => sub { + my $repl = make_repl(); + is $repl->{passthrough}, 0, 'passthrough defaults to 0'; +}; + +# --------------------------------------------------------------------------- +# _tab_complete +# --------------------------------------------------------------------------- + +my $repl = Term::ReadLine::Repl->new({ + name => 'test', + cmd_schema => { + stats => { + exec => $dummy_exec, + args => [{ host => 'hostname', guest => 'guestname', refresh => undef }], + }, + show => { exec => $dummy_exec }, + }, +}); + +subtest 'tab completes command names' => sub { + my @got = $repl->_tab_complete('st', 'st'); + ok grep { $_ eq 'stats' } @got, 'completes "st" to "stats"'; +}; + +subtest 'tab does not complete non-matching commands' => sub { + my @got = $repl->_tab_complete('xyz', 'xyz'); + is scalar @got, 0, 'no completions for unknown prefix'; +}; + +subtest 'tab completes args for a known command' => sub { + my @got = $repl->_tab_complete('', 'stats '); + ok grep { $_ eq 'host' } @got, 'host arg present'; + ok grep { $_ eq 'guest' } @got, 'guest arg present'; + ok grep { $_ eq 'refresh' } @got, 'refresh arg present'; +}; + +subtest 'tab completes partial arg name' => sub { + my @got = $repl->_tab_complete('ho', 'stats ho'); + ok grep { $_ eq 'host' } @got, 'completes "ho" to "host"'; + ok !grep { $_ eq 'guest' } @got, 'does not include "guest"'; +}; + +subtest 'passthrough lines are not tab completed' => sub { + my @got = $repl->_tab_complete('st', '!st'); + is scalar @got, 0, 'no completions for passthrough input'; +}; + +done_testing();