App-psst
view release on metacpan or search on metacpan
deal with lack of tty.
we don't use any job control features;
only needed for the few tests that compare
output, most just apply regexps
commit 8d3a41da2d43bae5d0332aa5502f445b368a28df
Author: Matthew Astley <beeep$mca@t8o.org>
Date: Thu Nov 10 00:22:43 2011 +0000
ditch deprompt in favour of setting PS1.
incidentally validate PS1 overriding config;
I don't remember what I was thinking,
but it can't deal with custom prompts seen in some smoketest sandpits
commit 941b5b043d8186935a0fd4a1a934e56a9bb19baf
Author: Matthew Astley <beeep$mca@t8o.org>
Date: Thu Nov 10 00:16:21 2011 +0000
restore Dump, it was in use
commit a4aba58447b1e9d7ebf687ce47b4d4aba2ddff30
Author: Matthew Astley <beeep$mca@t8o.org>
Date: Thu Nov 10 00:00:59 2011 +0000
commit b1619cd269d15b195c94a22037b34d71ad8ba3bb
Author: Matthew Astley <beeep$mca@t8o.org>
Date: Sun Oct 23 23:17:43 2011 +0100
dist.ini: tidy + shove
commit 417f8fddf91fa4fcbed8f579eccf528148b1adbf
Author: Matthew Astley <beeep$mca@t8o.org>
Date: Sun Oct 23 22:53:24 2011 +0100
test L:L path substitution in prompt.
check the configured PS1_substs works;
clarify in pidburn;
more deansi;
extract fn for removal of bash-x.y$
commit bfa37ad1dd51ea910241430fb6a70dc8cf6b8f3d
Author: Matthew Astley <beeep$mca@t8o.org>
Date: Wed Oct 19 17:41:39 2011 +0100
than to
dzil test
commit 1db6d1744ea3d7647d8021712bfebe8950a7bca2
Author: Matthew Astley <beeep$mca@t8o.org>
Date: Mon Oct 17 23:46:41 2011 +0100
pidburn_tt tweaks.
run in own sub / disconnect from prompt_tt;
fix & show threshold for stats
commit 3810cf8cb16136595939ef2064b8bd7efde7acf9
Author: Matthew Astley <beeep$mca@t8o.org>
Date: Sun Oct 16 23:03:38 2011 +0100
switch autogenerated README in source back to POD.
because preformat style was lost (in translation to markdown or rendering?)
some L<> hyperlinks don't work, and retain L-prefix
remove a capture variable to prevent an extra clone(2);
commit b8a97f67c9ef0f4be38a26a6940438d6bb8af6a8
Author: Matthew Astley <beeep$mca@t8o.org>
Date: Mon Sep 12 22:28:42 2011 +0100
some testing.
fails due to esc=$( echo -e "\e" )
test to establish sanity & exercise 'psst prompt';
extra config files during test;
note, psst uses $ENV{HOME} to find config;
note, test REQs;
manifest+=
commit 3e64d3ea71713ec9a31840f70bbc45abc480217c
Author: Matthew Astley <beeep$mca@t8o.org>
Date: Thu Sep 8 23:51:17 2011 +0100
update MANIFEST & ignorance
Makefile.PL
README
bin/psst
dist.ini
lib/App/psst.pm
t/00-sane.t
t/author-critic.t
t/bashrc
t/home-ps1/.psst.yaml
t/home-substing/.psst.yaml
t/prompt.t
t/release-has-version.t
t/release-pod-syntax.t
t/tlib/BashRunner.pm
---
abstract: 'prompt string setting tool'
author:
- 'Matthew Astley <mca1001@users.sourceforge.net>'
build_requires:
Test::More: 0
Time::HiRes: 1.9724
YAML: 0
configure_requires:
ExtUtils::MakeMaker: 6.30
dynamic_config: 0
generated_by: 'Dist::Zilla version 4.300002, CPAN::Meta::Converter version 2.112150'
Makefile.PL view on Meta::CPAN
use strict;
use warnings;
use 5.008;
use ExtUtils::MakeMaker 6.30;
my %WriteMakefileArgs = (
"ABSTRACT" => "prompt string setting tool",
"AUTHOR" => "Matthew Astley <mca1001\@users.sourceforge.net>",
"BUILD_REQUIRES" => {
"Test::More" => 0,
"Time::HiRes" => "1.9724",
"YAML" => 0
},
"CONFIGURE_REQUIRES" => {
"ExtUtils::MakeMaker" => "6.30"
},
"DISTNAME" => "App-psst",
NAME
App::psst - prompt string setting tool
VERSION
version 0.09
DESCRIPTION
Set-once configuration for ~/.bashrc to show presence of
$PERL_LOCAL_LIB_ROOT.
Origin
I wrote a local::lib-based installer for a small project.
#! /usr/bin/perl
use strict;
use warnings;
=head1 NAME
psst - prompt string setting tool
=head1 VERSION
version 0.09
=head1 SYNOPSIS
In F<~/.bashrc> add
# XXX: set up PATH and PERL5LIB as necessary
# Set shell and environment variables and create a function for
# prompt updating
eval "$( psst prompt "$PS1" )"
Then use L<local::lib> as normal, by whatever means.
=head1 GOALS
This script is intended to run during the login profile. It ought to
be reliable and failsafe, lightweight and require minimal early
configuration.
=head1 CONFIGURATION
Configuration goes in F<~/.psst.yaml> and should consist of key/value
pairs for one hash (dictionary). It is entirely optional, but can
only be read if L<YAML> is installed.
=over 4
=item PS1_old
Write the base value for $PS1 here to avoid the need to pass it to
each call to C<psst prompt>.
=item PS1_substs
If present, should be a list of C<< [ $text, $replacement ] >> pairs.
These are applied in order to the C<$PERL_LOCAL_LIB_ROOT> by Bash,
after being munged into a set of Bash Variable Substitutions.
=back
=head1 CAVEATS
Support Tool by adding other subcommands. A symlink-farm in F<~/bin/>
is a likely next target.
=cut
sub main {
syntax() if "@ARGV" =~ /^(--help|-h)\b/ || !@ARGV;
my $subcmd = shift @ARGV;
if ($subcmd eq 'prompt') {
die "$0 prompt: takes one optional parameter, got ".@ARGV if @ARGV > 1;
my $old_ps1 = prompt_base(PS1 => @ARGV);
print prompt_set(PS1 => $old_ps1);
} elsif ($subcmd =~ /^((--)?version|-v)$/) {
require App::psst;
print "psst $App::psst::VERSION\n";
} else {
die "Unknown subcommand '$subcmd'\n";
}
}
sub syntax {
die <<"MSG";
Syntax: $0 prompt [ "old prompt string" ]
Emits to STDOUT a text munging function and a new definition for \$PS1
The old prompt string is not required if it can be recovered by other
means,
- from the environment, by export of some other variable made by psst
- from the configuration file
- from the environment, by export PS1; trimming off what we added before
These are taken in priority order.
MSG
}
sub prompt_base {
my ($key, $arg_var) = @_;
my $out;
# 4. shell variable, if exported
$out = prompt_strip($key, $ENV{$key}) if defined $ENV{$key};
# 3. config file
$out = config("${key}_old" => undef) if !defined $out;
# 2. environment we exported. YAGNI.
# 1. given parameter
$out = $arg_var if defined $arg_var;
die "Cannot recover old prompt string $key, please supply it\n"
unless defined $out;
return $out;
}
sub prompt_strip {
my ($key, $val) = @_;
if ($val =~ /PERL_LOCAL_LIB_ROOT/) {
return (); # XXX: removing our extra stuff is not implemented
} else {
return $val;
}
}
sub prompt_set {
my ($key, $base) = @_;
my @out;
push @out, <<'TXT';
_psst_format() {
local out esc
# Homedir replacement
out="${PERL_LOCAL_LIB_ROOT//~/~}"
TXT
printf "%s" "$out"
}
# Calling this from PS1 is done by pipes & clone(2) i.e. subshell in
# its own process. It seems to be the only way to nest substitutions.
# We don't call it unless PERL_LOCAL_LIB_ROOT is set.
TXT
$base =~ s{'}{'"'"'}g;
push @out, <<"TXT";
### Prefix the prompt with local::lib indicator
#
# First, reset to default prompt
PS1='$base'
TXT
push @out, <<'TXT';
#
# Then prefix with indicator pokery
PS1='${PERL_LOCAL_LIB_ROOT:+\[\e7\r\e[3B\e[2K\e[B\e[2Kl:l=\e[32m$( _psst_format )\e8\e[32m\]LL)\[\e[0m\] }'"$PS1"
TXT
lib/App/psst.pm view on Meta::CPAN
use warnings;
package App::psst;
{
$App::psst::VERSION = '0.09';
}
=head1 NAME
App::psst - prompt string setting tool
=head1 VERSION
version 0.09
=head1 DESCRIPTION
Set-once configuration for F<~/.bashrc> to show presence of
C<$PERL_LOCAL_LIB_ROOT>.
t/00-sane.t view on Meta::CPAN
# Need PATH during PATH-munge in later tests
foreach my $k (qw( PATH )) {
ok(defined $ENV{$k} && $ENV{$k} ne '', "\$$k is set");
}
foreach my $k (qw( POSIXLY_CORRECT PROMPT_COMMAND PROMPT_DIRTRIM )) {
ok(!defined $ENV{$k}, "Bash with \$$k is untested, YMMV");
}
# can we find ourself with both hands?
foreach my $fn (qw( blib/script/psst t/prompt.t )) {
ok(-f $fn, "$fn is a file");
}
is(devino($0), devino('t/00-sane.t'), 'running in there');
# need our built copy on PATH, PERL5LIB
my $sep = $Config{path_sep}; # per perlrun(1)
# like($ENV{PATH}, qr{^[^:]*blib/script/?(:|$)}, 'our blib on $ENV{PATH}');
# hardwired above
like((join $sep, map { __un8xify($_) } @INC),
qr{^(t/tlib$sep)([^$sep]+/)?blib/lib/?($sep|$)},
BASHRC_FOR_TESTING=seen
eval "$( psst prompt $PS1_FROM_TEST )"
use BashRunner 'bash_interactive';
sub main {
$ENV{PATH} = "blib/script$Config{path_sep}$ENV{PATH}"; # not set by prove or Makefile.PL
# prevent influence from real local::lib
my @LLvars = qw{PERL_LOCAL_LIB_ROOT PERL_MB_OPT PERL_MM_OPT MODULEBUILDRC};
delete @ENV{@LLvars};
prompt_tt(); # 7
pidburn_tt(); # 3
}
sub prompt_tt {
local $ENV{HOME} = 't/home-ps1';
local $ENV{PS1_FROM_TEST} = 'here> '; # nb. trailing space is lost
# in t/bashrc because we allow absence of that arg
### See that we get initialised
#
# --rcfile t/bashrc doesn't?
# but sourcing our config at the prompt works
my $run = qq{. t/bashrc\necho showvar::\$BASHRC_FOR_TESTING::\n};
like(bash_interactive($run),
qr{^here>echo.*\nshowvar::seen::\nhere>exit\n\z}m,
'see our bashrc, use our prompt');
# See that the config in fake $HOME is used
# With no local::lib, no other prompt marks
my @ll_marks = (qr{^LL\) }m, qr{^l:l=}m);
delete $ENV{PS1_FROM_TEST};
my $out2 = bash_interactive($run);
like($out2, qr{\ncfgd> echo}m, 'take PS1_old from home-ps1');
does_qrs($out2, \@ll_marks, 0, 'out2 (non-LL)');
$ENV{HOME} = 't/home-substing';
local $ENV{TERM} = 'ansi'; # else Bash may try to compensate
$run = qq{. t/bashrc\nPERL_LOCAL_LIB_ROOT=/twang/fump\n};
my $out3 = bash_interactive($run, PS1 => '>>');
does_qrs(deansi($out3), \@ll_marks, 2, 'out3 (+LL deansi)');
# Hardcoding the output from the ANSI code generator is sure to be a
# maintenance burden... change it Later.
is(Dump($out3), Dump(<<"LITERAL"), 'out3 (+LL literal)');
>>. t/bashrc
>>PERL_LOCAL_LIB_ROOT=/twang/fump
\e7\r\e[3B\e[2K\e[B\e[2Kl:l=\e[32m/twang/fump\e8\e[32mLL)\e[0m >>exit
LITERAL
# Did supply PS1 because we test the whole string, and don't want to
# have to strip off local prompt strings. That PS1 overrides the
# config.
# Takes env & does substitution
local $ENV{PERL_LOCAL_LIB_ROOT} = "/twang/fump$Config{path_sep}/path/to/stuff";
$run = qq{. t/bashrc\n\n};
my $out4 = bash_interactive($run);
does_qrs(deansi($out4), \@ll_marks, 2, 'out4 (+LL deansi)');
like(deansi($out4), qr{^l:l=/twang/fump : PT/stuff$}m, 'out4 (substituted, deansi)');
}
skip $skip, 3 if $skip;
like($pidseq, qr{^sequential=1 }, 'Unconfigured, Bash does not burn PIDs');
local $ENV{PERL_LOCAL_LIB_ROOT} = "/path/to/foo$Config{path_sep}/path/to/bar";
TODO: {
local $TODO = 'not implemented in psst(1)';
like(pidseq_subtest(), qr{^sequential=1 },
"don't burn pids unless PS1_substs");
}
local $ENV{HOME} = 't/home-substing';
like(pidseq_subtest(), qr{^promptburn=2 },
'it seems we must burn pids to do PS1_substs');
}
}
# Attempt to determine whether the shell is forking per prompt.
# Likely to be flaky.
#
# Likely outcomes,
# broken: can't see pids
# sequential=1 <n>: Perl eats one per line
# promptburn=2 <n>: Bash & Perl each eat one per line
# random: no discernable pattern (e.g. on OpenBSD)
#
# PID wrap should not cause problems. Fast PID churn from other
# sources might require larger $N to get non-weird results.
sub pidseq_subtest {
my ($N) = @_;
my $retrying = defined $N;
$N ||= 50;
# print many prompts, examine pid issued to the process requested
my $run = ". t/bashrc\n".("perl -e 'print qq{pid:\$\$\\n}'\n" x $N);
my $txt = bash_interactive($run, maxt => $N / 5);
my @pid = ($txt =~ m{^pid:(\d+)$}mg);
if ($N != @pid) {
return sprintf('broken: see %d/%d pid: lines', scalar @pid, $N);
}
# Very basic stats. Output elements are
#
push @hist, $ele;
}
my $raw = join ', ', @hist;
$raw .= sprintf('; thres=%.2f', $thres);
# Summarise
if (0 == @diff_sig) {
return "random: $raw";
} elsif (1 == @diff_sig) {
my $diff = $diff_sig[0];
my $type = { 1 => 'sequential', 2 => 'promptburn' }->{$diff} || 'weird';
return "$type=$raw";
} else {
if ($retrying) {
return "weird (not unimodal.. not enough trials? system busy?): $raw";
} else {
diag("weird pidseq ($raw) - going to try harder");
return pidseq_subtest($N * 10);
}
}
}
( run in 1.351 second using v1.01-cache-2.11-cpan-6aa56a78535 )