#!perl

package App::plx;

our $VERSION = '0.000001'; # 0.0.1

$VERSION = eval $VERSION;

use strict;
use warnings;
use File::Spec;
use File::Basename ();
use Cwd ();
use lib ();
use Config;
use File::Which ();
use List::Util ();

BEGIN { our %orig_env = %ENV }
use local::lib '--deactivate-all';
BEGIN { delete @ENV{grep /^PERL/, keys %ENV} }
no lib @Config{qw(sitearch sitelibexp)};

my $self = do {
  package Perl::Layout::Executor::_self;
  sub self { package DB; () = caller(2); $DB::args[0] }
  use overload '%{}' => sub { self }, fallback => 1;
  sub AUTOLOAD {
    my ($meth) = (our $AUTOLOAD =~ /([^:]+)$/);
    self->$meth(@_[1..$#_]);
  }
  bless([], __PACKAGE__);
};

sub barf { die "$_[0]\n" }

sub stderr { warn "$_[0]\n" }

sub say { print "$_[0]\n" }

sub new {
  my $class = shift;
  bless @_ ? @_ > 1 ? {@_} : {%{$_[0]}} : {}, ref $class || $class;
}

sub layout_base_dir {
  $self->{layout_base_dir} //= $self->_build_layout_base_dir
}
sub layout_perl {
  $self->{layout_perl} //= $self->_build_layout_perl
}

sub _build_layout_base_dir {
  # we will walk upwards later (we don't check if the directory exists
  # because setup actions may use this path)
  return Cwd::getcwd();
}

sub _build_layout_perl {
  my $perl_bin = $self->read_config_entry('perl');
  unless ($perl_bin) {
    my $perl_spec = $self->read_config_entry('perl.spec');
    barf "No perl and no perl.spec in config" unless $perl_spec;
    $self->run_config_perl_set($perl_spec);
    $perl_bin = $self->read_config_entry('perl');
    barf "Rehydration of perl from perl.spec failed" unless $perl_bin;
  }
  barf "perl binary ${perl_bin} not executable" unless -x $perl_bin;
  return $perl_bin;
}

sub layout_libspec_config {
  opendir my($dh), $self->layout_config_dir('libs');
  [ grep $_->[1],
      map [ $_, $self->read_config_entry([ libs => $_ ]) ],
        sort readdir($dh) ];
}

sub layout_lib_specs {
  my $base_dir = $self->layout_base_dir;
  local *_ = sub { Cwd::realpath(File::Spec->rel2abs(shift, $base_dir)) };
  [ map [ ($_->[0] =~ /\.([^.]+)$/), _($_->[1]) ],
      @{$self->layout_libspec_config} ];
}

sub layout_file {
  my ($self, @path) = @_;
  File::Spec->catfile($self->layout_base_dir, @path);
}

sub layout_dir {
  my ($self, @path) = @_;
  File::Spec->catdir($self->layout_base_dir, @path);
}

sub ensure_layout_config_dir {
  barf ".plx directory does not exist"
    unless -d $self->layout_dir('.plx');
}

sub layout_config_file { shift->layout_file('.plx', @_) }
sub layout_config_dir { shift->layout_dir('.plx', @_) }

sub write_config_entry {
  my ($self, $path, $value) = @_;
  my $file = $self->layout_config_file(ref($path) ? @$path : $path);
  open my $wfh, '>', $file or die "Couldn't open ${file}: $!";
  print $wfh "${value}\n";
}

sub clear_config_entry {
  my ($self, $path) = @_;
  my $file = $self->layout_config_file(ref($path) ? @$path : $path);
  unlink($file) or barf "Failed to unlink ${file}: $!" if -e $file;
}

sub read_config_entry {
  my ($self, $path) = @_;
  my $file = $self->layout_config_file(ref($path) ? @$path : $path);
  return undef unless -f $file;
  open my $rfh, '<', $file or die "Couldn't open ${file}: $!";
  chomp(my $value = <$rfh>);
  return $value;
}

sub slurp_command {
  my ($self, @cmd) = @_;
  open my $slurp_fh, '-|', @cmd
    or barf "Failed to start command (".join(' ', @cmd)."): $!";
  chomp(my @slurp = <$slurp_fh>);
  return @slurp;
}

sub prepend_env {
  my ($self, $env, @parts) = @_;
  $ENV{$env} = join(':', @parts, $ENV{$env}||());
}

sub setup_env_for_ll {
  my ($self, $path) = @_;
  local::lib->import($path);
}

sub setup_env_for_dir {
  my ($self, $path) = @_;
  $self->prepend_env(PERL5LIB => $path);
}

sub setup_env {
  my $perl_dirname = File::Basename::dirname($self->layout_perl);
  unless (grep $_ eq $perl_dirname, split ':', $ENV{PATH}) {
    $self->prepend_env(PATH => $perl_dirname);
  }
  foreach my $lib_spec (@{$self->layout_lib_specs}) {
    my ($type, $path) = @$lib_spec;
    next unless $path and -d $path;
    $self->${\"setup_env_for_${type}"}($path);
  }
  my ($site_libs) = $self->slurp_command(
    $self->layout_perl, '-MConfig', '-e',
      'print join(",", @Config{qw(sitearch sitelibexp)})'
  );
  $ENV{PERL5OPT} = '-M-lib='.$site_libs;
  return;
}

sub run_action_init {
  my ($self, $perl) = @_;
  unless (-d (my $dir = $self->layout_dir('.plx'))) {
    mkdir($dir) or barf "Couldn't create ${dir}: $!";
  }
  $self->run_config_perl_set($perl||'perl');
  $self->write_config_entry(format => 1);
  my $libspec_dir = $self->layout_config_dir('libs');
  mkdir($libspec_dir) unless -d $libspec_dir;
  $self->run_config_libspec_add(@$_) for (
    [ '25local.ll' => 'local' ],
    [ '50devel.ll' => 'devel' ],
    [ '75lib.dir' => 'lib' ],
  );
}

sub run_action_cmd {
  my ($self, $cmd, @args) = @_;

  if ($cmd eq 'perl') {
    return $self->run_action_perl(@args);
  }

  if ($cmd =~ m{/} or $cmd =~ m{^-}) {
    return $self->run_action_perl($cmd, @args);
  }

  if (-f $self->layout_file(dev => $cmd)) {
    return $self->run_action_dev($cmd, @args);
  }

  if (-f $self->layout_file(bin => $cmd)) {
    return $self->run_action_bin($cmd, @args);
  }

  $self->run_action_exec($cmd, @args);
}

sub run_action_perl {
  my ($self, @call) = @_;
  return $self->run_config_perl_show unless @call;
  $self->run_action_exec($self->layout_perl, @call);
}

sub run_action_dev {
  my ($self, $cmd, @args) = @_;
  $self->run_action_perl($self->layout_file(dev => $cmd), @args);
}

sub run_action_bin {
  my ($self, $cmd, @args) = @_;
  $self->run_action_perl($self->layout_file(bin => $cmd), @args);
}

sub run_action_exec {
  my ($self, @exec) = @_;
  $self->setup_env;
  no warnings 'exec';
  exec(@exec) or barf "exec of (".join(' ', @exec).") failed: $!";
}

sub run_action_cpanm {
  my ($self, @args) = @_;
  my $cpanm = do {
    local %ENV = our %orig_env;
    barf "Couldn't find cpanm in \$PATH"
      unless my $cpanm = File::Which::which('cpanm');
    $cpanm;
  };
  unless (@args and $args[0] =~ /^-[lL]/) {
    barf "--cpanm args must start with -l or -L to specify target local::lib";
  }
  $self->setup_env;
  $self->run_action_perl($cpanm, @args);
}

sub run_action_config {
  my ($self, $config, @args) = @_;
  unless ($config) {
    say "# perl";
    $self->run_config_perl_show;
    say "# libspec";
    $self->run_config_libspec_show;
    return;
  }
  barf "Unknown config key ${config}"
    unless my $show = $self->can("run_config_${config}_show");
  return $self->$show unless @args;
  my ($subcmd, @rest) = @args;
  barf "Invalid subcommand ${subcmd} for config key ${config}"
    unless my $code = $self->can("run_config_${config}_${subcmd}");
  return $self->$code(@rest);
}

sub run_config_perl_show { say $self->layout_perl }

sub resolve_perl_via_perlbrew {
  my ($self, $perl) = @_;
  stderr "Resolving perl '${perl}' via perlbrew";
  local %ENV = our %orig_env;
  barf "Couldn't find perlbrew in \$PATH"
    unless my $perlbrew = File::Which::which('perlbrew');
  my @list = $self->slurp_command($perlbrew, 'list');
  barf join(
    "\n", "No such perlbrew perl '${perl}', choose from:\n", @list, ''
  ) unless grep $_ eq $perl, map /(\S+)/, @list;
  my ($perl_path) = $self->slurp_command(
    $perlbrew, qw(exec --with), $perl, qw(perl -e), 'print $^X'
  );
  return $perl_path;
}

sub run_config_perl_set {
  my ($self, $new_perl) = @_;
  barf "plx --config perl set <perl>" unless $new_perl;
  my $perl_spec = $new_perl;
  unless ($new_perl =~ m{/}) {
    $new_perl = "perl${new_perl}" if $new_perl =~ /^5/;
    $new_perl =~ s/perl-5/perl5/; # perlbrew name to perl binary
    require File::Which;
    stderr "Resolving perl '${new_perl}' via PATH";
    if (my $resolved = File::Which::which($new_perl)) {
      $new_perl = $resolved;
    } else {
      $new_perl =~ s/^perl5/perl-5/; # perl binary to perlbrew name
      $new_perl = $self->resolve_perl_via_perlbrew($new_perl);
    }
  }
  barf "Not executable: $new_perl" unless -x $new_perl;
  $self->write_config_entry('perl.spec' => $perl_spec);
  $self->write_config_entry(perl => $new_perl);
}

sub run_config_libspec_show {
  my @ent = @{$self->layout_libspec_config};
  my $max = List::Util::max(map length($_->[0]), @ent);
  say sprintf("%-${max}s  %s", @$_) for @ent;
}

sub run_config_libspec_add {
  my ($self, $name, $path) = @_;
  barf "plx --config libspec add <name> <path>" unless $name and $path;
  $self->write_config_entry([ libs => $name ], $path);
}

sub run_config_libspec_del {
  my ($self, $name) = @_;
  barf "plx --config libspec add <name>" unless $name;
  $self->clear_config_entry([ libs => $name ]);
}

sub show_env {
  my ($self, $env) = @_;
  local $ENV{$env} = '';
  $self->setup_env;
  say $_ for split ':', $ENV{$env};
}

sub run_action_libs { $self->show_env('PERL5LIB') }

sub run_action_paths { $self->show_env('PATH') }

sub run_action_help {
  require Pod::Usage;
  Pod::Usage::pod2usage();
}

sub run {
  my ($self, $cmd, @args) = @_;
  $self->run_action_help if !$cmd or $cmd eq '--help';
  $self->ensure_layout_config_dir unless $cmd eq '--init';
  if ($cmd =~ s/^--//) {
    my $method = join('_', 'run_action', split '-', $cmd);
    if (my $code = $self->can($method)) {
      return $self->$code(@args);
    }
    barf "No command for ${cmd}";
  }
  return $self->run_action_cmd($cmd, @args);
}

caller() ? 1 : __PACKAGE__->new->run(@ARGV);

=head1 NAME

App::plx - Perl Layout Executor

=head1 SYNOPSIS

  plx --help                             # This output

  plx --init <perl>                      # Initialize layout config
  plx --perl                             # Show layout perl binary
  plx --libs                             # Show layout $PERL5LIB entries
  plx --paths                            # Show layout additional $PATH entries
  plx --cpanm -llocal --installdeps .    # Run cpanm from outside $PATH
 
  plx perl <args>                        # Run perl within layout
  plx -E '...'                           # (ditto)
  plx script-in-dev <args>               # Run dev/ script within layout
  plx script-in-bin <args>               # Run bin/ script within layout
  plx script/in/cwd <args>               # Run script within layout
  plx program <args>                     # Run program from layout $PATH

=head1 WHY PLX

While perl has many tools for configuring per-project development
environments, using them can still be a little on the lumpy side. With
L<Carton>, you find yourself running one of

  perl -Ilocal/lib/perl -Ilib bin/myapp
  carton exec perl -Ilib bin/myapp

With L<App::perlbrew>,

  perlbrew switch perl-5.28.0@libname
  perl -Ilib bin/myapp

With L<https://github.com/tokuhirom/plenv>,

  plenv exec perl -Ilib bin/myapp

and if you have more than one distinct layer of dependencies, while
L<local::lib> will happily handle that, integrating it with everything else
becomes a pain in the buttocks.

As a result of this, your not-so-humble author found himself regularly having
a miniature perl executor script at the root of git clones that looked
something like:

  #!/bin/sh
  eval $(perl -Mlocal::lib=--deactivate-all)
  export PERL5LIB=$PWD/local/lib/perl5
  bin=$1
  shift
  ~/perl5/perlbrew/perls/perl-5.28.0/bin/$bin "$@"

and then running:

  ./pl perl -Ilib bin/myapp

However, much like back in 2007 frustration with explaining to other
developers how to set up L<CPAN> to install into C<~/perl5> and how to
set up one's environment variables to then find the modules so installed
led to the exercise in rage driven development that first created
L<local::lib>, walking newbies through the creation and subsequent use of
such a script was not the most enjoyable experience for anybody involved.

Thus, the creation of this module to reduce the setup process to:

  cpanm App::plx
  cd MyProject
  plx --init 5.28.0
  plx --cpanm -llocal --notest --installdeps .

Follwed by being able to immediately (and even more concisely) run:

  plx myapp

which will execute C<perl -Ilib bin/myapp> with the correct C<perl> and the
relevant L<local::lib> already in scope.

If this seems of use to you, the L<QUICKSTART> is next and the L<ACTIONS>
section of this document lists the full capabilities of plx. Onwards!

=head1 QUICKSTART

Let's assume we're going to be working on Foo-Bar, so we start with:

  git clone git@github.com:arthur-nonymous/Foo-Bar.git
  cd Foo-Bar

Assuming the perl we'd get from running just C<perl> suffices, then we
next run:

  plx --init

If we want a different perl - say, we have a C<perl5.30.1> in our path, or
a C<perl-5.30.1> built in perlbrew, we'd instead run:

  plx --init 5.30.1

To quickly get our dependencies available, we then run:

  plx --cpanm -llocal --notest --installdeps .

If the project is designed to use L<Carton> and has a C<cpanfile.snapshot>,
instead we would run:

  plx --cpanm -ldevel --notest Carton
  plx carton install

If the goal is to test this against our current development version of another
library, then we'd also want to run:

  plx --config libspec add 40otherlib.dir ../Other-Lib/lib

If we want our ~/perl L<local::lib> available within the plx environment, we
can add that as the least significant libspec with:

  plx --config libspec add 00tilde.ll $HOME/perl5

At which point, we're ready to go, and can run:

  plx myapp              # to run bin/myapp
  plx t/foo.t            # to run one test file
  plx prove              # to run all t/*.t test files
  plx -E 'say for @INC'  # to run a one liner within the layout

To learn everything else plx is capable of, read on to the L<ACTIONS> section
coming next.

Have fun!

=head1 ACTIONS

  plx --help                             # Print synopsis

  plx --init <perl>                      # Initialize layout config
  plx --perl                             # Show layout perl binary
  plx --libs                             # Show layout $PERL5LIB entries
  plx --paths                            # Show layout additional $PATH entries
  plx --cpanm -llocal --installdeps .    # Run cpanm from outside $PATH

  plx --config perl                      # Show perl binary
  plx --config perl show                 # Show perl binary
  plx --config perl set /path/to/perl    # Select exact perl binary
  plx --config perl set perl-5.xx.y      # Select perl via $PATH or perlbrew

  plx --config libspec                   # Show lib specifications
  plx --config libspec show              # Show lib specifications
  plx --config libspec add <name> <path> # Add lib specification
  plx --config libspec del <name> <path> # Delete lib specification

  plx --exec <cmd> <args>                # exec()s with env vars set
  plx --perl <args>                      # Run perl with args
  plx --bin <script> <args>              # Run script from bin/
  plx --dev <script> <args>              # Run script from dev/

  plx --cmd <cmd> <args>                 # DWIM command:
  
    cmd = perl           -> --perl <args>
    cmd = -<flag>        -> --perl -<flag> <args>
    cmd = some/file      -> --perl some/file <args>
    cmd = ./file         -> --perl ./file <args>
    cmd = name ->
      exists dev/<name>  -> --dev <name> <args>
      exists bin/<name>  -> --bin <name> <args>
      else               -> --exec <name> <args>
  
  plx <something> <args>                 # Shorthand for plx --cmd

=head2 --help

Prints out the usage information (i.e. the L</SYNOPSIS>) for plx.

=head2 --init

  plx --init                     # resolve 'perl' in $PATH
  plx --init perl                # (ditto)
  plx --init 5.28.0              # looks for perl5.28.0 in $PATH
                                 # or perl-5.28.0 in perlbrew
  plx --init /path/to/some/perl  # uses the absolute path directly

Initializes the layout.

If a perl name is passed, attempts to resolve it via C<$PATH> and C<perlbrew>
and sets the result as the layout perl; if not looks for just C<perl>.

Creates the following libspec config:

  25local.ll  local
  50devel.ll  devel
  75lib.dir   lib

=head2 --libs

Prints the directories that will be added to C<PERL5LIB>, one per line.

These will include the C<lib/perl5> subdirectory for each C<ll> entry in the
libspecs, and the directory for each C<dir> entry.

=head2 --paths

Prints the directories that will be added to C<PATH>, one per line.

These will include the containing directory of the environment's perl binary
if not already in C<PATH>, followed by the C<bin> directories of any C<ll>
entries in the libspecs.

=head2 --cpanm

  plx --cpanm -Llocal --installdeps .
  plx --cpanm -ldevel App::Ack

Finds the C<cpanm> binary in the C<PATH> that C<plx> was executed I<from>,
and executes it using the layout's perl binary and environment variables.

Requires the user to specify a L<local::lib> to install into via C<-l> or
C<-L> in order to avoid installing modules into unexpected places.

Note that this action exists primarily for bootstrapping, and if you want
to use a different installer such as L<App::cpm>, you'd install it with:

  plx --cpanm -ldevel App::cpm

and then subsequently run e.g.

  plx cpm install App::Ack

to install modules.

=head2 --exec

  plx --exec <command> <args>

Sets up the layout's environment variables and C<exec>s the command.

=head2 --perl

  plx --perl
  plx --perl <options> <script> <args>

Without arguments, sugar for C<--config perl show>.

Otherwise, sets up the layout's environment variables and C<exec>s the
layout's perl with the given options and arguments.

=head2 --dev

  plx --dev <script> <args>

Runs C<dev/script> ala L<--perl>.

Much like the C<devel> L<local::lib> is created to allow for the installation
of out-of-band dependencies that aren't going to be needed in production, the
C<dev> directory is supported to allow for the easy addition of development
time only sugar commands. Note that since C<perl> will re-exec anything with
a non-perl shebang, one can add wrappers here ala:

  $ cat dev/prove
  #!/bin/sh
  exec prove -j8 "$@"

=head2 --bin

  plx --bin <script> <args>

Runs C<bin/script> ala L<--perl>.

=head2 --cmd

  plx --cmd <cmd> <args>                 # DWIM command:
  
    cmd = perl           -> --perl <args>
    cmd = -<flag>        -> --perl -<flag> <args>
    cmd = some/file      -> --perl some/file <args>
    cmd = ./file         -> --perl ./file <args>
    cmd = name ->
      exists dev/<name>  -> --dev <name> <args>
      exists bin/<name>  -> --bin <name> <args>
      else               -> --exec <name> <args>

=head2 --config

  plx --config                     # Show current config
  plx --config <name>              # Alias for --config <name> show
  plx --config <name> <operation>  # Invoke config operation

=head3 perl

  plx --config perl show
  plx --config perl set <spec>

If the spec passed to C<set> contains a C</> character, plx assumes that it's
an absolute bath and records it as-is.

If not, we go a-hunting.

First, if the spec begins with a C<5>, we replace it with C<perl5>.

Second, we search C<$PATH> for a binary of that name, and record it if so.

Third, if the (current) spec begins C<perl5>, we replace it with C<perl-5>.

Fourth, we search C<$PATH> for a C<perlbrew> binary, and ask it if it has a
perl named after the spec, and record that if so.

Fifth, we shrug and hope the user can come up with an absolute path next time.

B<Note:> The original spec passed to C<set> is recorded in C<.plx/perl.spec>,
so if you intend to share the C<.plx> directory across multiple machines via
version control or otherwise, remove/exclude the C<.plx/perl> file and plx
will automatically attempt to re-locate the perl on first invocation.

=head3 libspec

  plx --config libspec show
  plx --config libspec add <name> <spec>
  plx --config libspec del <name> <spec>

A libspec config entry consists of a name and a spec, and the show output
prints them space separated one per line, with enough spaces to make the
specs align:

  25local.ll  local
  50devel.ll  devel
  75lib.dir   lib

The part of the name before the last C<.> is not semantically significant to
plx, but is used for asciibetical sorting of the libspec entries to determine
in which order to apply them.

The part after must be either C<ll> for a L<local::lib>, or C<dir> for a bare
L<lib> directory.

When loaded, the spec is (if relative) resolved to an absolute path relative
to the layout root, then all C<..> entries and symlinks resolved to give a
final path used to set up the layout environment.

=head1 AUTHOR

 mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>

=head1 CONTRIBUTORS

None yet - maybe this software is perfect! (ahahahahahahahahaha)

=head1 COPYRIGHT

Copyright (c) 2020 the App::plx L</AUTHOR> and L</CONTRIBUTORS>
as listed above.

=head1 LICENSE

This library is free software and may be distributed under the same terms
as perl itself.
