File Coverage

bin/plx
Criterion Covered Total %
statement 208 380 54.7
branch 57 182 31.3
condition 10 50 20.0
subroutine 56 82 68.2
pod 0 55 0.0
total 331 749 44.1


line stmt bran cond sub pod time code
1             #!perl
2              
3             package App::plx;
4              
5             our $VERSION = '0.901001'; # 0.901.1
6              
7             $VERSION = eval $VERSION;
8              
9 1     1   978 use strict;
  1         2  
  1         29  
10 1     1   5 use warnings;
  1         1  
  1         26  
11 1     1   5 use File::Spec;
  1         2  
  1         19  
12 1     1   5 use File::Basename ();
  1         1  
  1         13  
13 1     1   4 use Cwd ();
  1         2  
  1         11  
14 1     1   511 use lib ();
  1         671  
  1         22  
15 1     1   6 use Config;
  1         1  
  1         29  
16 1     1   5 use File::Which ();
  1         1  
  1         13  
17 1     1   4 use List::Util ();
  1         2  
  1         26  
18              
19 1     1   53 BEGIN { our %orig_env = %ENV }
20 1     1   627 use local::lib '--deactivate-all';
  1         6409  
  1         19  
21 1     1   927 BEGIN { delete @ENV{grep /^PERL/, keys %ENV} }
22 1     1   7 no lib @Config{qw(sitearch sitelibexp)};
  1         1  
  1         7  
23              
24             my $fs = 'File::Spec';
25              
26             my $self = do {
27             package Perl::Layout::Executor::_self;
28 295     295   1922 sub self { package DB; () = caller(2); $DB::args[0] }
  295         3860  
29 1     1   366 use overload '%{}' => sub { self }, fallback => 1;
  1     184   2  
  1         48  
  184         334  
30             sub AUTOLOAD {
31 111     111   898 my ($meth) = (our $AUTOLOAD =~ /([^:]+)$/);
32 111         263 self->$meth(@_[1..$#_]);
33             }
34       0     sub DESTROY {}
35             bless([], __PACKAGE__);
36             };
37              
38 0     0   0 sub barf { die "$_[0]\n" }
39              
40 0     0   0 sub stderr { warn "$_[0]\n" }
41              
42 0     0   0 sub say { print "$_[0]\n" }
43              
44             sub new {
45 33     33 0 108702 my $class = shift;
46 33 0 33     278 bless @_ ? @_ > 1 ? {@_} : {%{$_[0]}} : {}, ref $class || $class;
  0 50       0  
47             }
48              
49             sub layout_base_dir {
50 175   66 175 0 627 $self->{layout_base_dir} //= $self->_build_layout_base_dir
51             }
52             sub layout_perl {
53 9   66 9 0 27 $self->{layout_perl} //= $self->_build_layout_perl
54             }
55              
56             sub _build_layout_base_dir {
57 28     28   2139 my @parts = $fs->splitdir(Cwd::realpath(Cwd::getcwd()));
58 28         82 my $cand;
59 28         39 my $reason = '';
60 28         73 while (@parts > 1) { # go back to one step before root at most
61 76         419 $cand = $fs->catdir(@parts);
62 76 100       1420 return $cand if -d $fs->catdir($cand, '.plx');
63 56 50       733 if (-d $fs->catdir($cand, '.git')) { # don't escape current repository
64 0         0 $reason = ' due to .git directory';
65 0         0 last;
66             }
67 56         168 pop @parts;
68             }
69 8         35 barf "Couldn't find .plx directory (stopped searching at ${cand}${reason})";
70             }
71              
72             sub _build_layout_perl {
73 6     6   34 my $perl_bin = $self->read_config_entry('perl');
74 6 50       21 unless ($perl_bin) {
75 0         0 my $perl_spec = $self->read_config_entry('perl.spec');
76 0 0       0 barf "No perl and no perl.spec in config" unless $perl_spec;
77 0         0 $self->run_config_perl_set($perl_spec);
78 0         0 $perl_bin = $self->read_config_entry('perl');
79 0 0       0 barf "Rehydration of perl from perl.spec failed" unless $perl_bin;
80             }
81 6 50       163 barf "perl binary ${perl_bin} not executable" unless -x $perl_bin;
82 6         72 return $perl_bin;
83             }
84              
85             sub layout_libspec_config {
86 4     4 0 34 [ grep $_->[1],
87             map [ $_, $self->read_config_entry([ libspec => $_ ]) ],
88             $self->list_config_names('libspec') ];
89             }
90              
91             sub layout_lib_specs {
92 3     3 0 33 my $base_dir = $self->layout_base_dir;
93 3     9   78 local *_ = sub { Cwd::realpath($fs->rel2abs(shift, $base_dir)) };
  9         1096  
94             [ map [ ($_->[0] =~ /\.([^.]+)$/), _($_->[1]) ],
95 3         13 @{$self->layout_libspec_config} ];
  3         29  
96             }
97              
98             sub layout_file {
99 99     99 0 208 my ($self, @path) = @_;
100 99         176 $fs->catfile($self->layout_base_dir, @path);
101             }
102              
103             sub layout_dir {
104 71     71 0 179 my ($self, @path) = @_;
105 71         151 $fs->catdir($self->layout_base_dir, @path);
106             }
107              
108             sub ensure_layout_config_dir {
109 17 50   17 0 73 barf ".plx directory does not exist"
110             unless -d $self->layout_dir('.plx');
111 10         79 my $format = $self->read_config_entry('format');
112 10 50       43 barf ".plx directory has no format specifier" unless $format;
113 10 50       28 barf ".plx format ${format} unknown" unless $format eq '1';
114             }
115              
116 96     96 0 241 sub layout_config_file { shift->layout_file('.plx', @_) }
117 51     51 0 121 sub layout_config_dir { shift->layout_dir('.plx', @_) }
118              
119             sub write_config_entry {
120 68     68 0 199 my ($self, $path, $value) = @_;
121 68 100       188 my $file = $self->layout_config_file(ref($path) ? @$path : $path);
122 68 50       4239 open my $wfh, '>', $file or die "Couldn't open ${file}: $!";
123 68         2905 print $wfh "${value}\n";
124             }
125              
126             sub clear_config_entry {
127 0     0 0 0 my ($self, $path) = @_;
128 0 0       0 my $file = $self->layout_config_file(ref($path) ? @$path : $path);
129 0 0 0     0 unlink($file) or barf "Failed to unlink ${file}: $!" if -e $file;
130             }
131              
132             sub read_config_entry {
133 28     28 0 72 my ($self, $path) = @_;
134 28 100       94 my $file = $self->layout_config_file(ref($path) ? @$path : $path);
135 28 50       539 return undef unless -f $file;
136 28 50       1030 open my $rfh, '<', $file or die "Couldn't open ${file}: $!";
137 28         413 chomp(my $value = <$rfh>);
138 28         551 return $value;
139             }
140              
141             sub list_config_names {
142 7     7 0 23 my ($self, $path) = @_;
143 7 50       124 my $dir = $self->layout_config_dir(ref($path) ? @$path : $path);
144 7 100       223 return () unless -d $dir;
145 4 50       176 opendir my($dh), $dir or die "Couldn't opendir ${dir}: $!";
146 4         658 return grep -f $fs->catfile($dir, $_), sort readdir($dh);
147             }
148              
149             sub slurp_command {
150 3     3 0 11 my ($self, @cmd) = @_;
151 3 50       6265 open my $slurp_fh, '-|', @cmd
152             or barf "Failed to start command (".join(' ', @cmd)."): $!";
153 3         32020 chomp(my @slurp = <$slurp_fh>);
154 3         395 return @slurp;
155             }
156              
157             sub prepend_env {
158 0     0 0 0 my ($self, $env, @parts) = @_;
159 0   0     0 $ENV{$env} = join(':', @parts, $ENV{$env}||());
160             }
161              
162             sub setup_env_for_ll {
163 0     0 0 0 my ($self, $path) = @_;
164 0         0 local::lib->import($path);
165             }
166              
167             sub setup_env_for_dir {
168 0     0 0 0 my ($self, $path) = @_;
169 0         0 $self->prepend_env(PERL5LIB => $path);
170             }
171              
172             sub setup_env {
173 3     3 0 24 my ($site_libs) = $self->slurp_command(
174             $self->layout_perl, '-MConfig', '-e',
175             'print join(",", @Config{qw(sitearch sitelibexp)})'
176             );
177 3         96 $ENV{PERL5OPT} = '-M-lib='.$site_libs;
178             $ENV{$_} = $self->read_config_entry([ env => $_ ])
179 3         131 for $self->list_config_names('env');
180 3         65 my $perl_dirname = File::Basename::dirname($self->layout_perl);
181 3         15 our %orig_env;
182 3 50       64 unless (grep $_ eq $perl_dirname, split ':', $orig_env{PATH}) {
183 0         0 $self->prepend_env(PATH => $perl_dirname);
184             }
185 3         14 foreach my $lib_spec (@{$self->layout_lib_specs}) {
  3         49  
186 9         27 my ($type, $path) = @$lib_spec;
187 9 50 33     132 next unless $path and -d $path;
188 0         0 $self->${\"setup_env_for_${type}"}($path);
  0         0  
189             }
190 3         25 return;
191             }
192              
193 2     2 0 6 sub cmd_search_path { qw(.plx/cmd dev bin) }
194              
195             sub run_action_commands {
196 2     2 0 4 my ($self, $filter) = @_;
197 2         6 $self->ensure_layout_config_dir;
198 1         3 my @commands;
199             my %seen;
200 1         5 foreach my $dirname ($self->cmd_search_path) {
201 3 50       9 next unless -d (my $dir = $self->layout_dir($dirname));
202 0 0       0 opendir my ($dh), $dir or barf "Couldn't open ${dir}: $!";
203 0         0 foreach my $entry (sort readdir($dh)) {
204 0 0       0 next if $entry =~ /^\.+$/;
205 0         0 my $file = $self->layout_file($dirname, $entry);
206 0 0       0 next unless -f $file;
207 0 0       0 unless ($seen{$entry}++) {
208 0         0 push @commands, [ $entry, "${dirname}/${entry}" ];
209             }
210             }
211             }
212 1         4 my $path = do { local $ENV{PATH} = ''; $self->setup_env; $ENV{PATH} };
  1         10  
  1         4  
  1         14  
213 1         9 foreach my $dir (split ':', $path) {
214 0         0 opendir my ($dh), $dir;
215 0         0 foreach my $entry (sort readdir($dh)) {
216 0 0       0 next if $entry =~ /^\.+$/;
217 0         0 my $file = $fs->catfile($dir, $entry);
218 0 0       0 next unless -x $file;
219 0 0       0 push @commands, [ $entry, $file ] unless $seen{$entry}++;
220             }
221             }
222 1 50       5 if ($filter) {
223 0 0       0 my $match = $filter =~ m{^/(.+)/$} ? $1 : qr/^\Q${filter}/;
224 0         0 @commands = grep { $_->[0] =~ $match } @commands;
  0         0  
225             }
226 1         7 my $max = List::Util::max(map length($_->[0]), @commands);
227 1         3 my $base = $self->layout_base_dir;
228 1         11 my $home = $ENV{HOME};
229 1         98 foreach my $command (@commands) {
230 0         0 my ($name, $path) = @$command;
231 0         0 $path =~ s/^\Q${base}\///;
232 0 0       0 $path =~ s/^\Q${home}/~/ if $home;
233 0         0 say sprintf("%-${max}s %s", $name, $path);
234             }
235             }
236              
237             sub run_action_bareinit {
238 11     11 0 25 my ($self, $perl) = @_;
239 11   33     281 my $dir = $fs->catdir($self->{layout_base_dir}||Cwd::getcwd(), '.plx');
240 11 50       234 if (-d $dir) {
241 0 0       0 if ($perl) {
242 0         0 stderr <
243             .plx already initialised - if you wanted to set the perl to ${perl} run:
244              
245             plx --config perl set ${perl}
246             END
247             }
248 0         0 return;
249             }
250 11 50       471 mkdir($dir) or barf "Couldn't create ${dir}: $!";
251 11   50     99 $self->run_config_perl_set($perl||'perl');
252 11         47 $self->write_config_entry(format => 1);
253             }
254              
255             sub run_action_userinit {
256 0     0 0 0 my ($self, @args) = @_;
257 0 0 0     0 my @perl = (
258             (@args and !ref($args[0]) and $args[0] ne '[')
259             ? shift(@args)
260             : ()
261             );
262 0 0       0 barf "--userinit requires \$HOME to be set" unless $ENV{HOME};
263             $self->run_action_base(
264             $ENV{HOME},
265 0 0       0 '--multi' =>
266             [ '--bareinit', @perl ],
267             [ qw(--config libspec add 25.perl5.ll perl5) ],
268             (@args ? [ '--multi', @args ] : ()),
269             );
270             }
271              
272             sub run_action_userstrap {
273 0     0 0 0 my ($self, @args) = @_;
274 0 0 0     0 my @perl = (
275             (@args and !ref($args[0]) and $args[0] ne '[')
276             ? shift(@args)
277             : ()
278             );
279 0         0 $self->run_action_userinit(
280             @perl,
281             [ '--installself' ],
282             [ '--installenv' ],
283             @args
284             );
285             }
286              
287             sub run_action_installself {
288 0     0 0 0 my $last_ll;
289 0         0 foreach my $lib_spec (@{$self->layout_lib_specs}) {
  0         0  
290 0         0 my ($type, $path) = @$lib_spec;
291 0 0       0 $last_ll = $path if $type eq 'll';
292             }
293 0 0       0 barf "No local::lib in libspec config" unless $last_ll;
294 0         0 $self->run_action_cpanm(
295             "-l${last_ll}", '-n',
296             qw(App::cpanminus App::plx)
297             );
298             }
299              
300             sub run_action_installenv {
301 0     0 0 0 $self->ensure_layout_config_dir;
302             barf "--installenv action currently assumes bash"
303 0 0       0 unless $ENV{SHELL} =~ /bash/;
304             barf "Couldn't find .bashrc"
305 0 0       0 unless -f (my $bashrc = $fs->catfile($ENV{HOME}, ".bashrc"));
306             my $plx_bin = do {
307             local %ENV = our %orig_env;
308             File::Which::which('plx-packed');
309 0   0     0 } || do {
310             local %ENV = %ENV;
311             $self->setup_env;
312             File::Which::which('plx-packed');
313             };
314 0 0       0 barf "Couldn't find plx in PATH" unless $plx_bin;
315             {
316 0 0       0 open my $fh, '<', $bashrc or die "Couldn't open ${bashrc} to read: $!";
  0         0  
317 0 0       0 if (my ($line) = grep /plx --env/, <$fh>) {
318 0         0 chomp($line);
319 0         0 stderr("Found line in .bashrc: $line");
320             }
321             }
322 0         0 my $base = $self->layout_base_dir;
323 0         0 stderr("Appending to .bashrc");
324 0 0       0 open my $fh, '>>', $bashrc or die "Couldn't open ${bashrc} to append: $!";
325 0         0 print $fh "\neval \$(${plx_bin} --base ${base} --env)\n";
326             }
327              
328             sub run_action_init {
329 11     11 0 32 my ($self, $perl) = @_;
330 11         43 $self->run_action_bareinit($perl);
331 11         52 my $libspec_dir = $self->layout_config_dir('libspec');
332 11 50       568 mkdir($libspec_dir) or barf "Couldn't create ${libspec_dir}: $!";
333 11         145 $self->run_config_libspec_add(@$_) for (
334             [ '25-local.ll' => 'local' ],
335             [ '50-devel.ll' => 'devel' ],
336             [ '75-lib.dir' => 'lib' ],
337             );
338             }
339              
340             sub _which {
341 3     3   8 my ($self, $cmd, @args) = @_;
342 3         6 $self->ensure_layout_config_dir;
343 2 50       5 barf "--cmd " unless $cmd;
344              
345 2 50       18 if ($fs->file_name_is_absolute($cmd)) {
346 0         0 return (exec => $cmd => @args);
347             }
348              
349 2 100       6 if ($cmd eq 'perl') {
350 1         5 return (perl => @args);
351             }
352              
353 1 50       4 if ($cmd =~ m{/}) {
354 0         0 return (perl => $cmd, @args);
355             }
356              
357 1 50       3 if ($cmd =~ /^-/) {
358 0         0 my @optargs = ($cmd, @args);
359 0         0 foreach my $optarg (@optargs) {
360 0 0       0 next if $optarg =~ /^-/;
361 0         0 foreach my $dirname ($self->cmd_search_path) {
362 0 0       0 if (-f (my $file = $self->layout_file($dirname => $optarg))) {
363 0         0 $optarg = $file;
364 0         0 last;
365             }
366             }
367 0         0 last;
368             }
369 0         0 return (perl => @optargs);
370             }
371              
372 1         5 foreach my $dirname ($self->cmd_search_path) {
373 3 50       10 if (-f (my $file = $self->layout_file($dirname => $cmd))) {
374 0         0 return (perl => $file, @args);
375             }
376             }
377              
378 1         33 return (exec => $cmd, @args);
379             }
380              
381             sub run_action_which {
382 0     0 0 0 my ($self, @args) = @_;
383 0         0 my ($action, @call) = $self->_which(@args);
384 0         0 say join(' ', 'plx', "--${action}", @call);
385             }
386              
387             sub run_action_cmd {
388 3     3 0 9 my ($self, @args) = @_;
389 3         8 my ($action, @call) = $self->_which(@args);
390 2         4 $self->${\"run_action_${action}"}(@call);
  2         12  
391             }
392              
393             sub run_action_perl {
394 4     4 0 11 my ($self, @call) = @_;
395 4         10 $self->ensure_layout_config_dir;
396 3 100       22 return $self->show_config_perl unless @call;
397 1         3 $self->run_action_exec($self->layout_perl, @call);
398             }
399              
400             sub run_action_exec {
401 0     0   0 my ($self, @exec) = @_;
402 0         0 $self->ensure_layout_config_dir;
403 0         0 $self->setup_env;
404 0 0       0 exec(@exec) or barf "exec of (".join(' ', @exec).") failed: $!";
405             }
406              
407             sub find_cpanm {
408 0     0 0 0 local %ENV = our %orig_env;
409 0 0       0 barf "Couldn't find cpanm in \$PATH"
410             unless my $cpanm = File::Which::which('cpanm');
411 0         0 $cpanm;
412             }
413              
414             sub run_action_cpanm {
415 1     1 0 2 my ($self, @args) = @_;
416 1         2 $self->ensure_layout_config_dir;
417 0         0 my @cpanm = $self->find_cpanm;
418 0 0 0     0 unless (@args and $args[0] =~ /^-[lL]/) {
419 0         0 barf "--cpanm args must start with -l or -L to specify target local::lib";
420             }
421 0         0 $self->setup_env;
422 0         0 system($self->layout_perl, @cpanm, @args);
423             }
424              
425             sub run_action_config {
426 3     3 0 8 my ($self, $config, @args) = @_;
427 3         9 $self->ensure_layout_config_dir;
428 2 50       4 unless ($config) {
429 0         0 say "# perl";
430 0         0 $self->show_config_perl;
431 0         0 say "# libspec";
432 0         0 $self->show_config_libspec;
433 0 0       0 if ($self->list_config_names('env')) {
434 0         0 say "# env";
435 0         0 $self->show_config_env;
436             }
437 0         0 return;
438             }
439 2 50       15 barf "Unknown config key ${config}"
440             unless my $show = $self->can("show_config_${config}");
441 2 100       9 return $self->$show unless @args;
442 1 50       12 if (my $code = $self->can("run_config_${config}")) {
443 0         0 return $self->$code(@args);
444             }
445 1         5 my ($subcmd, @rest) = @args;
446 1 50       8 barf "Invalid subcommand ${subcmd} for config key ${config}"
447             unless my $code = $self->can("run_config_${config}_${subcmd}");
448 1         5 return $self->$code(@rest);
449             }
450              
451 2     2 0 14 sub show_config_perl { say $self->layout_perl }
452              
453             sub resolve_perl_via_perlbrew {
454 0     0 0 0 my ($self, $perl) = @_;
455 0         0 stderr "Resolving perl '${perl}' via perlbrew";
456 0         0 local %ENV = our %orig_env;
457 0 0       0 barf "Couldn't find perlbrew in \$PATH"
458             unless my $perlbrew = File::Which::which('perlbrew');
459 0         0 my @list = $self->slurp_command($perlbrew, 'list');
460 0 0       0 barf join(
461             "\n", "No such perlbrew perl '${perl}', choose from:\n", @list, ''
462             ) unless grep $_ eq $perl, map /(\S+)/, @list;
463 0         0 my ($perl_path) = $self->slurp_command(
464             $perlbrew, qw(exec --with), $perl, qw(perl -e), 'print $^X'
465             );
466 0         0 return $perl_path;
467             }
468              
469             sub run_config_perl_set {
470 12     12 0 29 my ($self, $new_perl) = @_;
471 12 50       23 barf "plx --config perl set " unless $new_perl;
472 12         16 my $perl_spec = $new_perl;
473 12 100       58 unless ($new_perl =~ m{/}) {
474 11 50       26 $new_perl = "perl${new_perl}" if $new_perl =~ /^5/;
475 11         18 $new_perl =~ s/perl-5/perl5/; # perlbrew name to perl binary
476 11         85 require File::Which;
477 11         64 stderr "Resolving perl '${new_perl}' via PATH";
478 11 50       100 if (my $resolved = File::Which::which($new_perl)) {
479 11         1673 $new_perl = $resolved;
480             } else {
481 0         0 $new_perl =~ s/^perl5/perl-5/; # perl binary to perlbrew name
482 0         0 $new_perl = $self->resolve_perl_via_perlbrew($new_perl);
483             }
484             }
485 12 50       173 barf "Not executable: $new_perl" unless -x $new_perl;
486 12         50 $self->write_config_entry('perl.spec' => $perl_spec);
487 12         47 $self->write_config_entry(perl => $new_perl);
488             }
489              
490             sub show_config_libspec {
491 1     1 0 2 my @ent = @{$self->layout_libspec_config};
  1         8  
492 1         9 my $max = List::Util::max(map length($_->[0]), @ent);
493 1         11 say sprintf("%-${max}s %s", @$_) for @ent;
494             }
495              
496             sub run_named_config_add {
497 33     33 0 93 my ($self, $type, $name, $value) = @_;
498 33 50 33     139 barf "plx --config ${type} add " unless $name and $value;
499 33 50       62 unless (-d (my $dir = $self->layout_config_dir($type))) {
500 0 0       0 mkdir($dir) or die "Couldn't make config dir ${dir}: $!";
501             }
502 33         174 $self->write_config_entry([ $type => $name ], $value);
503             }
504              
505             sub run_named_config_del {
506 0     0 0 0 my ($self, $type, $name) = @_;
507 0 0       0 barf "plx --config ${type} dev " unless $name;
508 0         0 $self->clear_config_entry([ $type => $name ]);
509             }
510              
511 33     33 0 103 sub run_config_libspec_add { shift->run_named_config_add(libspec => @_) }
512 0     0 0 0 sub run_config_libspec_del { shift->run_named_config_del(libspec => @_) }
513              
514             sub show_config_env {
515 0     0 0 0 my $max = List::Util::max(
516             map length, my @names = $self->list_config_names('env')
517             );
518             say sprintf("%-${max}s %s", $_, $self->read_config_entry([ env => $_ ]))
519 0         0 for @names;
520             }
521              
522 0     0 0 0 sub run_config_env_add { shift->run_named_config_add(env => @_) }
523 0     0 0 0 sub run_config_env_del { shift->run_named_config_del(env => @_) }
524              
525             sub show_env {
526 4     4 0 15 my ($self, $env) = @_;
527 4         10 $self->ensure_layout_config_dir;
528 2         17 local $ENV{$env} = '';
529 2         9 $self->setup_env;
530 2         230 say $_ for split ':', $ENV{$env};
531             }
532              
533 2     2 0 16 sub run_action_libs { $self->show_env('PERL5LIB') }
534              
535 2     2 0 11 sub run_action_paths { $self->show_env('PATH') }
536              
537             sub run_action_env {
538 0     0 0 0 $self->ensure_layout_config_dir;
539 0         0 $self->setup_env;
540 0         0 my @env_change;
541 0         0 our %orig_env;
542 0         0 foreach my $key (sort(keys %{{ %orig_env, %ENV }})) {
  0         0  
543 0         0 my ($oval, $eval) = ($orig_env{$key}, $ENV{$key});
544 0 0 0     0 if (!defined($eval) or ($oval//'') ne $eval) {
      0        
545 0         0 push @env_change, [ $key, $eval ];
546             }
547             }
548 0         0 my $shelltype = local::lib->guess_shelltype;
549 0         0 my $shellbuild = "build_${shelltype}_env_declaration";
550 0         0 foreach my $change (@env_change) {
551 0         0 print +local::lib->$shellbuild(@$change);
552             }
553             }
554              
555             sub run_action_help {
556 1     1 0 7 require Pod::Usage;
557 1         3 Pod::Usage::pod2usage();
558             }
559              
560             sub run_action_version {
561 1     1 0 25 say sprintf "%f", $VERSION;
562             }
563              
564             sub run_action_base {
565 1     1 0 1 my ($self, $base, @chain) = @_;
566 1 50       3 unless ($base) {
567 1         4 say $self->layout_base_dir;
568 0         0 return;
569             }
570 0 0       0 barf "--base " unless @chain;
571 0         0 $self->new({ layout_base_dir => $base })->run(@chain);
572             }
573              
574             sub _parse_multi {
575 0     0   0 my ($self, @args) = @_;
576 0         0 my @multi;
577 0         0 MULTI: while (@args) {
578 0 0       0 barf "Expected multi arg [, got: $args[0]" unless $args[0] eq '[';
579 0         0 shift @args;
580 0         0 my @action;
581 0         0 while (my $el = shift @args) {
582 0 0 0     0 push @multi, \@action and next MULTI if $el eq ']';
583 0         0 push @action, $el;
584             }
585 0         0 barf "Missing closing ] for multi";
586             }
587 0         0 return @multi;
588             }
589              
590             sub run_action_multi {
591 0     0 0 0 my ($self, @args) = @_;
592 0 0 0     0 return $self->run_multi(@args) if @args and ref($args[0]);
593 0         0 my @multi = $self->_parse_multi(@args);
594 0         0 $self->run_multi(@multi);
595             }
596              
597             sub run_multi {
598 0     0 0 0 my ($self, @multi) = @_;
599 0         0 foreach my $multi (@multi) {
600 0 0       0 my @debug_multi = map +(ref($_) ? ('[', @$_, ']') : $_), @$multi;
601 0         0 stderr '# '.join(' ', plx => @debug_multi);
602 0         0 $self->run(@$multi);
603             }
604             }
605              
606             sub run_action_showmulti {
607 0     0 0 0 my ($self, @args) = @_;
608 0         0 my @multi = $self->_parse_multi(@args);
609 0         0 say join(' ', plx => @$_) for @multi;
610             }
611              
612             sub run {
613 33     33 0 77 my ($self, $cmd, @args) = @_;
614 33   50     62 $cmd ||= '--help';
615 33 50       64 if ($cmd eq '[') {
616 0         0 return $self->run_action_multi($cmd, @args);
617             }
618 33 50       186 if ($cmd =~ s/^--//) {
619 33 50       54 if ($cmd) {
620 33         96 my $method = join('_', 'run_action', split '-', $cmd);
621 33 100       161 if (my $code = $self->can($method)) {
622 32         107 return $self->$code(@args);
623             }
624 1         7 barf "No such action --${cmd}, see 'perldoc plx' for the full list";
625             }
626 0           $cmd = shift @args;
627             }
628 0           $self->ensure_layout_config_dir;
629 0           return $self->run_action_cmd($cmd, @args);
630             }
631              
632             caller() ? 1 : __PACKAGE__->new->run(@ARGV);
633              
634             =head1 NAME
635              
636             App::plx - Perl Layout Executor
637              
638             =head1 SYNOPSIS
639              
640             plx --help # This output
641              
642             plx --init # Initialize layout config
643             plx --perl # Show layout perl binary
644             plx --libs # Show layout $PERL5LIB entries
645             plx --paths # Show layout additional $PATH entries
646             plx --env # Show layout env var changes
647             plx --cpanm -llocal --installdeps . # Run cpanm from outside $PATH
648            
649             plx perl # Run perl within layout
650             plx -E '...' # (ditto)
651             plx script-in-dev # Run dev/ script within layout
652             plx script-in-bin # Run bin/ script within layout
653             plx ./script # Run script within layout
654             plx script/in/cwd # (ditto)
655             plx program # Run program from layout $PATH
656              
657             =head1 WHY PLX
658              
659             While perl has many tools for configuring per-project development
660             environments, using them can still be a little on the lumpy side. With
661             L, you find yourself running one of
662              
663             perl -Ilocal/lib/perl -Ilib bin/myapp
664             carton exec perl -Ilib bin/myapp
665              
666             With L,
667              
668             perlbrew switch perl-5.28.0@libname
669             perl -Ilib bin/myapp
670              
671             With L,
672              
673             plenv exec perl -Ilib bin/myapp
674              
675             and if you have more than one distinct layer of dependencies, while
676             L will happily handle that, integrating it with everything else
677             becomes a pain in the buttocks.
678              
679             As a result of this, your not-so-humble author found himself regularly having
680             a miniature perl executor script at the root of git clones that looked
681             something like:
682              
683             #!/bin/sh
684             eval $(perl -Mlocal::lib=--deactivate-all)
685             export PERL5LIB=$PWD/local/lib/perl5
686             bin=$1
687             shift
688             ~/perl5/perlbrew/perls/perl-5.28.0/bin/$bin "$@"
689              
690             and then running:
691              
692             ./pl perl -Ilib bin/myapp
693              
694             However, much like back in 2007 frustration with explaining to other
695             developers how to set up L to install into C<~/perl5> and how to
696             set up one's environment variables to then find the modules so installed
697             led to the exercise in rage driven development that first created
698             L, walking newbies through the creation and subsequent use of
699             such a script was not the most enjoyable experience for anybody involved.
700              
701             Thus, the creation of this module to reduce the setup process to:
702              
703             cpanm App::plx
704             cd MyProject
705             plx --init 5.28.0
706             plx --cpanm -llocal --notest --installdeps .
707              
708             Follwed by being able to immediately (and even more concisely) run:
709              
710             plx myapp
711              
712             which will execute C with the correct C and the
713             relevant L already in scope.
714              
715             If this seems of use to you, the L is next and the L
716             section of this document lists the full capabilities of plx. Onwards!
717              
718             =head1 QUICKSTART
719              
720             Let's assume we're going to be working on Foo-Bar, so we start with:
721              
722             git clone git@github.com:arthur-nonymous/Foo-Bar.git
723             cd Foo-Bar
724              
725             Assuming the perl we'd get from running just C suffices, then we
726             next run:
727              
728             plx --init
729              
730             If we want a different perl - say, we have a C in our path, or
731             a C built in perlbrew, we'd instead run:
732              
733             plx --init 5.30.1
734              
735             To quickly get our dependencies available, we then run:
736              
737             plx --cpanm -llocal --notest --installdeps .
738              
739             If the project is designed to use L and has a C,
740             instead we would run:
741              
742             plx --cpanm -ldevel --notest Carton
743             plx carton install
744              
745             If the goal is to test this against our current development version of another
746             library, then we'd also want to run:
747              
748             plx --config libspec add 40otherlib.dir ../Other-Lib/lib
749              
750             If we want our ~/perl L available within the plx environment, we
751             can add that as the least significant libspec with:
752              
753             plx --config libspec add 00tilde.ll $HOME/perl5
754              
755             At which point, we're ready to go, and can run:
756              
757             plx myapp # to run bin/myapp
758             plx t/foo.t # to run one test file
759             plx prove # to run all t/*.t test files
760             plx -E 'say for @INC' # to run a one liner within the layout
761              
762             To learn everything else plx is capable of, read on to the L section
763             coming next.
764              
765             Have fun!
766              
767             =head1 BOOTSTRAP
768              
769             Under normal circumstances, one would run something like:
770              
771             cpanm App::plx
772              
773             However, if you want a self-contained plx script without having a cpan
774             installer available, you can run:
775              
776             mkdir bin
777             wget https://raw.githubusercontent.com/shadowcat-mst/plx/master/bin/plx-packed -O bin/plx
778              
779             to get the current latest packed version.
780              
781             The packed version bundled L and L, and also includes
782             a modified C<--cpanm> action that uses an inline C.
783              
784             =head1 ACTIONS
785              
786             plx --help # Print synopsis
787             plx --version # Print plx version
788              
789             plx --init # Initialize layout config for .
790             plx --bareinit # Initialize bare layout config for .
791             plx --base # Show layout base dir
792             plx --base # Run action with specified base dir
793            
794             plx --perl # Show layout perl binary
795             plx --libs # Show layout $PERL5LIB entries
796             plx --paths # Show layout additional $PATH entries
797             plx --env # Show layout env var changes
798             plx --cpanm -llocal --installdeps . # Run cpanm from outside $PATH
799              
800             plx --config perl # Show perl binary
801             plx --config perl set /path/to/perl # Select exact perl binary
802             plx --config perl set perl-5.xx.y # Select perl via $PATH or perlbrew
803              
804             plx --config libspec # Show lib specifications
805             plx --config libspec add # Add lib specification
806             plx --config libspec del # Delete lib specification
807            
808             plx --config env # Show additional env vars
809             plx --config env add # Add env var
810             plx --config env del # Delete env var
811              
812             plx --exec # exec()s with env vars set
813             plx --perl # Run perl with args
814              
815             plx --cmd # DWIM command:
816            
817             cmd = perl -> --perl
818             cmd = - -> --perl -
819             cmd = some/file -> --perl some/file
820             cmd = ./file -> --perl ./file
821             cmd = name ->
822             exists .plx/cmd/ -> --perl .plx/cmd/
823             exists dev/ -> --perl dev/
824             exists bin/ -> --perl bin/
825             else -> --exec
826              
827             plx --which # Expands --cmd without running
828            
829             plx # Shorthand for plx --cmd
830            
831             plx --commands ? # List available commands
832            
833             plx --multi [ ] [ ... ] # Run multiple actions
834             plx --showmulti [ ... ] [ ... ] # Show multiple action running
835             plx [ ... ] [ ... ] # Shorthand for plx --multi
836            
837             plx --userinit # Init ~/.plx with ~/perl5 ll
838             plx --installself # Installs plx and cpanm into layout
839             plx --installenv # Appends plx --env call to .bashrc
840             plx --userstrap # userinit+installself+installenv
841              
842             =head2 --help
843              
844             Prints out the usage information (i.e. the L) for plx.
845              
846             =head2 --init
847              
848             plx --init # resolve 'perl' in $PATH
849             plx --init perl # (ditto)
850             plx --init 5.28.0 # looks for perl5.28.0 in $PATH
851             # or perl-5.28.0 in perlbrew
852             plx --init /path/to/some/perl # uses the absolute path directly
853              
854             Initializes the layout.
855              
856             If a perl name is passed, attempts to resolve it via C<$PATH> and C
857             and sets the result as the layout perl; if not looks for just C.
858              
859             Creates the following libspec config:
860              
861             25-local.ll local
862             50-devel.ll devel
863             75-lib.dir lib
864              
865             =head2 --bareinit
866              
867             Identical to C<--init> but creates no default configs except for C.
868              
869             =head2 --base
870              
871             plx --base
872             plx --base
873              
874             Without arguments, shows the selected base dir - C finds this by
875             checking for a C<.plx> directory in the current directory, and if not tries
876             the parent directory, recursively. The search stops either when C finds
877             a C<.git> directory, to avoid accidentally escaping a project repository, or
878             at the last directory before the root - i.e. C will test C but
879             not C.
880              
881             With arguments, specifies a base dir to use, and then invokes the rest of the
882             arguments with that base dir selected - so for example one can make a default
883             configuration in C<$HOME> available as C by running:
884              
885             plx --init $HOME
886             alias plh='plx --base $HOME'
887              
888             =head2 --libs
889              
890             Prints the directories that will be added to C, one per line.
891              
892             These will include the C subdirectory for each C entry in the
893             libspecs, and the directory for each C entry.
894              
895             =head2 --paths
896              
897             Prints the directories that will be added to C, one per line.
898              
899             These will include the containing directory of the environment's perl binary
900             if not already in C, followed by the C directories of any C
901             entries in the libspecs.
902              
903             =head2 --env
904              
905             Prints the changes that will be made to your environment variables, in a
906             syntax that is (hopefully) correct for your current shell.
907              
908             =head2 --cpanm
909              
910             plx --cpanm -Llocal --installdeps .
911             plx --cpanm -ldevel App::Ack
912              
913             Finds the C binary in the C that C was executed I,
914             and executes it using the layout's perl binary and environment variables.
915              
916             Requires the user to specify a L to install into via C<-l> or
917             C<-L> in order to avoid installing modules into unexpected places.
918              
919             Note that this action exists primarily for bootstrapping, and if you want
920             to use a different installer such as L, you'd install it with:
921              
922             plx --cpanm -ldevel App::cpm
923              
924             and then subsequently run e.g.
925              
926             plx cpm install App::Ack
927              
928             to install modules.
929              
930             =head2 --exec
931              
932             plx --exec
933              
934             Sets up the layout's environment variables and Cs the command.
935              
936             =head2 --perl
937              
938             plx --perl
939             plx --perl