New command: make shim

Changes

@@ -1,3 +1,4 @@
+	- New command: make-shim. Github PR #776.
 	- Remove cperl from `available` and `install` command. Github PR: #777. cperl can still be installed by specifying the tarball, just not automatically, just not by their short names.
 
 0.97

lib/App/perlbrew.pm

@@ -2050,10 +2050,9 @@ sub run_command_switch_off {
         "To immediately make it effective, run this line in this terminal:\n\n    exec @{[ $self->env('SHELL') ]}\n\n";
 }
 
-sub run_command_env {
-    my ( $self, $name ) = @_;
-
-    my %env = $self->perlbrew_env($name);
+sub shell_env {
+    my ( $self, $env ) = @_;
+    my %env = %$env;
 
     my @statements;
     for my $k ( sort keys %env ) {
@@ -2067,29 +2066,39 @@ sub run_command_env {
         }
     }
 
+    my $statements = "";
+
     if ( $self->env('SHELL') =~ /(ba|k|z|\/)sh\d?$/ ) {
         for (@statements) {
             my ( $o, $k, $v ) = @$_;
             if ( $o eq 'unset' ) {
-                print "unset $k\n";
+                $statements .= "unset $k\n";
             }
             else {
                 $v =~ s/(\\")/\\$1/g;
-                print "export $k=\"$v\"\n";
+                $statements .= "export $k=\"$v\"\n";
             }
         }
     }
     else {
         for (@statements) {
             my ( $o, $k, $v ) = @$_;
             if ( $o eq 'unset' ) {
-                print "unsetenv $k\n";
+                $statements .= "unsetenv $k\n";
             }
             else {
-                print "setenv $k \"$v\"\n";
+                $statements .= "setenv $k \"$v\"\n";
             }
         }
     }
+
+    return $statements;
+}
+
+sub run_command_env {
+    my ( $self, $name ) = @_;
+
+    print $self->shell_env({ $self->perlbrew_env($name) });
 }
 
 sub run_command_symlink_executables {
@@ -2717,6 +2726,40 @@ sub run_command_info {
     print $self->format_info_output(@_);
 }
 
+sub run_command_make_shim {
+    my ($self, $program) = @_;
+
+    if (-f $program) {
+        die "ERROR: $program already exists under current directory.\n";
+    }
+
+    my $current_env = $self->current_env
+        or die "ERROR: perlbrew is current off. make-shim requires an perlbrew environment to be activated.\nRead the usage by running: perlbrew help make-shim\n";
+
+    my %env = $self->perlbrew_env( $current_env );
+
+    my $shebang = '#!' . $self->env('SHELL');
+    my $preemble = $self->shell_env(\%env);
+    my $path = $self->shell_env({ PATH => $env{"PERLBREW_PATH"} . ":" . $self->env("PATH") });
+    my $shim = join(
+        "\n",
+        $shebang,
+        $preemble,
+        $path,
+        'exec ' . $program . ' "$@"',
+        "\n"
+    );
+
+    open my $fh, ">", "$program" or die $!;
+    print $fh $shim;
+    close $fh;
+    chmod 0755, $program;
+
+    if ( $self->{verbose} ) {
+        print "A shim of $program is made.\n";
+    }
+}
+
 sub BASHRC_CONTENT() {
     return
           "export PERLBREW_SHELLRC_VERSION=$VERSION\n"

script/perlbrew

@@ -651,6 +651,36 @@ The argument "source" is optional and defaults to the currently activated one. H
 
 Note that this does not guarantee that the versions of modules stay the same in the destination.
 
+=head1 COMMAND: MAKE-SHIM
+
+Usage:
+
+    perlbrew make-shim <program>
+
+This commands produce an executable file named C<program> under current directory. The C<program> is a shell-wrapper of the program of the same name inside current perlbrew environment. The output C<program> is prepared in a way that it can be moved to different directories and it can still find the original program and run it as if it is inside the original perlbrew environment.
+
+For example, you may find C<tldr> from L<App::tldr> a handy tool and decide to install it inside your daily working environment:
+
+    perlbrew use perl-5.36.1
+    cpm install -g App::tldr
+
+But when you occasionally have to switch to a different environment, C<PATH> would be tweaked and the command C<tldr> would went missing, as expected:
+
+    perlbrew use perl-5.18.4
+    tldr perl  #=> error: command not found
+
+It would be nice if C<tldr> can be made universonally available. One way to mitigate such needs is to prepare install the C<tldr> program outside of C<PERLBREW_ROOT>, while still utilize perlbrew environment to run it.
+
+For example, prepare a conventional directory C<~/.local/bin> and put that in C<PATH>, then:
+
+    perlbrew use perl-5.36.1
+
+    cd /tmp
+    perlbrew make-shim tldr
+    mv /tmp/tldr ~/.local/bin/tldr
+
+This C<~/.local/bin/tldr> is a shell-wrapper of the actual C<tldr> program, and it internally uses C<perl-5.36.1> environment. No matter what current perlbrew environment is. It will also work even if perlbrew is turned off. The only requirements is that the perlbrew environment C<perl-5.36.1> and the installation of C<App::tldr> has to remain.
+
 =head1 SEE ALSO
 
 L<App::perlbrew>, L<App::cpanminus>, L<Devel::PatchPerl>

t/command-make-shim.t

@@ -0,0 +1,59 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::Spec;
+use Test::Exception;
+use File::Temp qw( tempdir );
+
+
+use FindBin;
+use lib $FindBin::Bin;
+
+use App::perlbrew;
+require "test_helpers.pl";
+
+mock_perlbrew_install("perl-5.36.1");
+
+
+describe "App::perlbrew->make_shim('foo')" => sub {
+    it "should err when perlbrew is off" => sub {
+        mock_perlbrew_off();
+
+        my $dir = tempdir();
+        chdir($dir);
+
+        throws_ok {
+            my $app = App::perlbrew->new("make-shim", "foo");
+            $app->run();
+        } qr(^ERROR:);
+
+        ok ! -f "foo", "foo is not produced";
+    };
+
+    it "should err when 'foo' already exists" => sub {
+        mock_perlbrew_use("perl-5.36.1");
+        my $dir = tempdir();
+        chdir($dir);
+        io("foo")->print("hello");
+
+        throws_ok {
+            my $app = App::perlbrew->new("make-shim", "foo");
+            $app->run();
+        } qr(^ERROR:);
+    };
+
+    it "should produce 'foo' in the current dir" => sub {
+        mock_perlbrew_use("perl-5.36.1");
+        my $dir = tempdir();
+        chdir($dir);
+
+        my $app = App::perlbrew->new("make-shim", "foo");
+        $app->run();
+
+        ok -f "foo", "foo is produced under current directory.";
+        my $shim_content = io("foo")->slurp;
+        diag "\nThe content of shim:\n----\n$shim_content\n----\n";
+    };
+};
+
+runtests unless caller;

t/test_helpers.pl

@@ -30,7 +30,12 @@ sub file {
 $App::perlbrew::PERLBREW_ROOT = tempdir( CLEANUP => 1 );
 $App::perlbrew::PERLBREW_HOME = tempdir( CLEANUP => 1 );
 $ENV{PERLBREW_ROOT} = $App::perlbrew::PERLBREW_ROOT;
+
 delete $ENV{PERLBREW_LIB};
+delete $ENV{PERLBREW_PERL};
+delete $ENV{PERLBREW_PATH};
+delete $ENV{PERLBREW_MANPATH};
+delete $ENV{PERL_LOCAL_LIB_ROOT};
 
 my $root = App::Perlbrew::Path::Root->new ($ENV{PERLBREW_ROOT});
 $root->perls->mkpath;
@@ -72,6 +77,24 @@ sub mock_perlbrew_install {
     App::perlbrew->new(install => $name, @args)->run();
 }
 
+sub mock_perlbrew_off {
+    mock_perlbrew_use("");
+}
+
+sub mock_perlbrew_use {
+    my ($name) = @_;
+
+    my %env = App::perlbrew->new()->perlbrew_env($name);
+
+    for my $k (qw< PERLBREW_PERL PERLBREW_LIB PERLBREW_PATH PERL5LIB >) {
+        if (defined $env{$k}) {
+            $ENV{$k} = $env{$k};
+        } else {
+            delete $ENV{$k}
+        }
+    }
+}
+
 sub mock_perlbrew_lib_create {
     my $name = shift;
     App::Perlbrew::Path->new($App::perlbrew::PERLBREW_HOME, "libs", $name)->mkpath;