Okay, here's a very basic shell implementation…
use v5.16;
package PerlShell {
use Moo;
use constant { RO => 'ro', RW => 'rw', LAZY => 'lazy', RWP => 'rwp
+' };
use Types::Standard -types;
use Types::Path::Tiny -types;
use Term::ANSIColor ();
use Term::ReadLine::Tiny ();
use List::Util qw(uniq);
use namespace::autoclean;
has cwd => (
is => RW,
isa => Dir,
lazy => 1,
builder => sub { Path->class->cwd },
);
has term => (
is => LAZY,
isa => InstanceOf['Term::ReadLine::Tiny'],
builder => sub {
my $self = shift;
my $term = 'Term::ReadLine::Tiny'->new;
# $term->autocomplete(sub { $self->handle_autocomplete(@_)
+ });
$term;
},
);
has util_namespace => (
is => LAZY,
isa => Str, # package name really
builder => sub { 'PerlShell::Functions' },
);
sub prompt {
my $self = shift;
Term::ANSIColor::colored(['bold white'], '> ');
}
sub prepare_environment {
my $self = shift;
my ($ns) = @_;
no strict 'refs';
my @our;
for my $var (keys %ENV) {
${"$ns\::$var"} = $ENV{$var};
push @our, "\$$var";
}
${"$ns\::SHELL"} = $self; push @our, "\$SHELL";
${"$ns\::TERM"} = $self->term; push @our, "\$TERM";
${"$ns\::CWD"} = $self->cwd; push @our, "\$CWD";
sprintf('our (%s);', join q[,], uniq @our);
}
sub format_for_output {
my $self = shift;
"$_[0]";
}
sub run {
my $self = shift;
my $term = $self->term;
my $package = $self->util_namespace;
while (defined(my $line = $term->readline($self->prompt))) {
local $@;
my $prefix = $self->prepare_environment($package);
my @output = eval qq{ package $package; no strict; no warn
+ings; $prefix; $line };
if ($@) {
say {$term->OUT} Term::ANSIColor::colored(['bold red']
+, $@);
}
else {
say {$term->OUT} $self->format_for_output($_) for @out
+put;
}
}
say "";
say {$term->OUT} Term::ANSIColor::colored(['bold green'], 'Bye
+!');
}
}
package PerlShell::Util {
use Ref::Util ();
sub croak {
my $fmt = shift;
die sprintf("$fmt\n", @_);
}
sub parse_arguments {
my %options;
my @arguments;
my $seendashdash = 0;
if (Ref::Util::is_plain_hashref($_[0])) {
%options = %{ +shift };
}
while (@_) {
if (not Ref::Util::is_ref($_[0]) and not $seendashdash and
+ $_[0] =~ /\A-([\w-]+)\z/) {
my $str = $1;
shift;
if ($str eq '-') {
$seendashdash = 1;
}
else {
$options{$str} = 1;
}
next;
}
push @arguments, shift;
}
return (\%options, \@arguments);
}
}
package PerlShell::Functions {
sub args {
require Data::Dumper;
Data::Dumper::Dumper(PerlShell::Util::parse_arguments(@_));
}
sub ls {
my ($options, $args) = PerlShell::Util::parse_arguments(@_);
my @dirs = map Path::Tiny::->new($_), @$args;
@dirs = our $CWD unless @dirs;
map { $_->children } @dirs;
}
sub cd {
my ($options, $args) = PerlShell::Util::parse_arguments(@_);
PerlShell::Util::croak('cd expects 1 argument, not %d', scalar
+(@$args))
unless @$args == 1;
my $new;
our ($CWD, $SHELL);
if ($args->[0] eq '..') {
$new = $CWD->parent;
}
elsif ($args->[0] eq '.') {
$new = $CWD;
}
else {
$new = Path::Tiny::->new($args->[0]);
if ($new->is_relative) {
$new = $CWD->child($new);
}
}
$SHELL->cwd( $CWD = $new );
}
}
PerlShell->new->run;
It only really implements cd and ls. So you can start the shell and type:
> cd('bin')
> ls()
> cd('..')
And things work as you might expect. The eval which evaluates each line has strict and warnings switched off, so you can use things like barewords. Thus the following also works fine and feels slightly more shell-like:
> cd bin
> ls
> cd '..'