Env-PS1-0.06000755001750001750 011220337155 12212 5ustar00ryan52ryan52000000000000Changes000444001750001750 270111220337155 13563 0ustar00ryan52ryan52000000000000Env-PS1-0.06 Revision history for Env-PS1 - prompt string formatter ======================================================== 0.06 Tue Jun 23 2009 Minor bug fix release - New Maintainer, thanks to Jaap for all the work thus far. - Fix \w and \W when the current directory is $HOME (should show a tilde) - work with the PS1='$(foobar)' style of command substitution - check for existance of the CLICOLOR env var before using it, thanks to Phil Pennock for the patch (RT #13074) 0.05 Mon Nov 22 2004 Maintenance release Thu Nov 18 - Added the interpolation of environment variables - Altered escape removal a little bit Mon Aug 30 - Env::PS1 is now responding "live" to CLICOLOR 0.04 Tue Aug 03 2004 Release due to vital bug fix Wed Jul 28 - Made all autosplit'ed subroutine names case-insensitive unique appeared a case-insensitive filesystem could cause an infinite loop 0.03 Mon Mar 29 2004 - Added support to tie a scalar reference Tue Mar 23 - Fixed bug for platforms not supporting getpwuid() Sat Mar 13 - Introduced $ENV{CLICOLOR} to switch colours on/off 0.02 Wed Mar 10 - Added Makefile.PL - only Build.PL doesn't seem enough :( - Tweaked the example script a bit - Added \P{format} for proc info - Added carl0s' acpi snippets - Fixed customization 0.01 Mon Mar 08 - Finished all initial features Sun Mar 07 2004 - Initialised the module example.pl000444001750001750 302311220337155 14256 0ustar00ryan52ryan52000000000000Env-PS1-0.06#!/usr/bin/perl use Env::PS1 qw/$PS1/; my @demo = ( username => '\u', 'current dir' => '\w', 'basename current dir' => '\W', hostname => '\H', 'short hostname' => '\h', 'basename $0' => '\s', date => '\d', 'terminaldevice basename' => '\l', 'terminal device' => '\L', time => '\t', time => '\T', time => '\@', time => '\A', ); my ($i, $l) = (0, 0); length($_) > $l and $l = length($_) for grep {++$i % 2} @demo; $l += 2; print "Most escapes are one character long, like these:\n"; while (@demo) { my ($k, $v) = ( shift(@demo), shift(@demo) ); $ENV{PS1} = $v; print $k, ' 'x($l - length($k)), "$v = $PS1\n"; } print "\nAlso their are two escapes with arguments:\n"; $ENV{PS1} = '\\D{%a %b %e %H:%M:%S %Y}'; print "strftime format \\D{\%a \%b \%e \%H:\%M:\%S \%Y}\n\t= $PS1\n"; $ENV{PS1} = q(\\C{bold,red}shiny isn't it ?\\C{reset}); print "and ANSI colours \\C{bold,red}shiny isn't it ?\\C{reset}\n\t= $PS1\n"; $ENV{PS1} = '\\P{%u up %w users, loadavg: %L}'; print "and some proc info \\P{\%u up \%w users, loadavg: \%L}\n\t= $PS1\n"; print "\nAnd now for some real prompts:\n\n"; print Env::PS1->sprintf($_), "\n\n" for '\C{bold,blue}\u@\H \A \C{green}\W\$\C{reset} ', '\[\033[01;31m\]\h \[\033[01;34m\]\W \$ \[\033[00m\]', '\C{green}\D{%H:%M:%S} \W\$\C{reset} ', '\C{bold,black}/--( \u@\H )-( \t )-( \w )- * *\n\\\\-- * \$\C{reset} '; __END__ =head1 NAME example.pl - some prompts demonstrated =head1 DESCRIPTION This script demonstrates the module by showing the supported escape sequences and some prompts. META.yml000444001750001750 71711220337155 13526 0ustar00ryan52ryan52000000000000Env-PS1-0.06--- name: Env-PS1 version: 0.06 author: - 'Jaap Karssenberg ' abstract: prompt string formatter license: perl resources: license: http://dev.perl.org/licenses/ requires: AutoLoader: 0 POSIX: 0 Sys::Hostname: 0 build_requires: AutoSplit: 0 provides: Env::PS1: file: lib/Env/PS1.pm version: 0.06 generated_by: Module::Build version 0.33 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 MANIFEST000444001750001750 20011220337155 13371 0ustar00ryan52ryan52000000000000Env-PS1-0.06Build.PL Changes example.pl lib/Env/PS1.pm Makefile.PL MANIFEST This list of files MANIFEST.SKIP META.yml README t/00_usage.t Build.PL000444001750001750 57711220337155 13555 0ustar00ryan52ryan52000000000000Env-PS1-0.06use Module::Build; Module::Build->new( module_name => 'Env::PS1', license => 'perl', dist_author => 'Jaap Karssenberg ', requires => { 'AutoLoader' => 0, 'Sys::Hostname' => 0, 'POSIX' => 0, }, build_requires => { 'AutoSplit' => 0, }, autosplit => 'lib/Env/PS1.pm', create_makefile_pl => 'passthrough', )->create_build_script; MANIFEST.SKIP000444001750001750 110011220337155 14156 0ustar00ryan52ryan52000000000000Env-PS1-0.06 #!start included /usr/share/perl/5.10/ExtUtils/MANIFEST.SKIP # Avoid version control files. \bRCS\b \bCVS\b \bSCCS\b ,v$ \B\.svn\b \b_darcs\b # Avoid Makemaker generated and utility files. \bMANIFEST\.bak \bMakefile$ \bblib/ \bMakeMaker-\d \bpm_to_blib\.ts$ \bpm_to_blib$ \bblibdirs\.ts$ # 6.18 through 6.25 generated this # Avoid Module::Build generated and utility files. \bBuild$ \b_build/ # Avoid temp and backup files. ~$ \.old$ \#$ \b\.# \.bak$ # Avoid Devel::Cover files. \bcover_db\b #!end included /usr/share/perl/5.10/ExtUtils/MANIFEST.SKIP \B\.git\b Makefile.PL000444001750001750 233311220337155 14243 0ustar00ryan52ryan52000000000000Env-PS1-0.06# Note: this file was auto-generated by Module::Build::Compat version 0.33 unless (eval "use Module::Build::Compat 0.02; 1" ) { print "This module requires Module::Build to install itself.\n"; require ExtUtils::MakeMaker; my $yn = ExtUtils::MakeMaker::prompt (' Install Module::Build now from CPAN?', 'y'); unless ($yn =~ /^y/i) { die " *** Cannot install without Module::Build. Exiting ...\n"; } require Cwd; require File::Spec; require CPAN; # Save this 'cause CPAN will chdir all over the place. my $cwd = Cwd::cwd(); CPAN::Shell->install('Module::Build::Compat'); CPAN::Shell->expand("Module", "Module::Build::Compat")->uptodate or die "Couldn't install Module::Build, giving up.\n"; chdir $cwd or die "Cannot chdir() back to $cwd: $!"; } eval "use Module::Build::Compat 0.02; 1" or die $@; Module::Build::Compat->run_build_pl(args => \@ARGV); my $build_script = 'Build'; $build_script .= '.com' if $^O eq 'VMS'; exit(0) unless(-e $build_script); # cpantesters convention require Module::Build; Module::Build::Compat->write_makefile(build_class => 'Module::Build'); README000444001750001750 103411220337155 13146 0ustar00ryan52ryan52000000000000Env-PS1-0.06Env-PS1 0.05 ============ ABOUT This package supplies variables that are "tied" to environment variables like 'PS1' and 'PS2', if read it takes the contents of the variable as a format string like the ones bash(1) uses to format the prompt. DEPENDENCIES You'll need the following modules: POSIX Autoloader Sys::Hostname all of which are core modules INSTALL Try something like: $ perl Build.PL $ ./Build test $ ./Build install See the Module::Build documentation for advanced build options. t000755001750001750 011220337155 12376 5ustar00ryan52ryan52000000000000Env-PS1-0.0600_usage.t000444001750001750 222611220337155 14325 0ustar00ryan52ryan52000000000000Env-PS1-0.06/t use strict; use vars qw/$PS1 $PS2/; use Test::More tests => 11; use_ok('Env::PS1', '$PS1'); my @u_info = eval { getpwuid($>) } ? ( getpwuid($>) ) : ( $ENV{USER} || $ENV{LOGNAME} ); $ENV{PS1} = '\Q \u \\\\ '; print "# PS1: $PS1\n"; ok $PS1 eq 'Q '.$u_info[0].' \\ ', 'simple format'; $ENV{PS1} = '\\a\\n\\r\\007'; ok $PS1 eq "\a\n\r\a", 'perl format'; @ENV{qw/_TEST_ -TEST-/} = ('testing Env::PS1', '!'); $ENV{PS1} = 'what ? $_TEST_ ${-TEST-}'; print "# PS1: $PS1\n"; ok $PS1 eq 'what ? testing Env::PS1 !!', 'format with env variable'; $PS1 = '\$'; ok $PS1 eq ($u_info[2] ? '$' : '#'), 'alias'; my $result = $u_info[0].'@foobar'; $PS1 = '\u@foobar'; ok $PS1 eq $result, 'STORE'; my ($format, $prompt) = ('\u@foobar', ''); tie $prompt, 'Env::PS1', \$format; $format = '\u@foobar'; ok $prompt eq $result, 'SCALAR ref'; $format = '\C{red,on_green}dus\C{reset}'; $ENV{CLICOLOR} = 0; ok $prompt eq 'dus', 'CLICOLOR'; ok Env::PS1->sprintf('\u@foobar') eq $result, 'E:PS1:sprintf'; no warnings; $Env::PS1::map{v} = 3; $PS1 = '\v'; ok $PS1 eq 3, 'map'; my $i = 0; $Env::PS1::map{i} = sub { ++$i }; $PS1 = '\i'; ok( ($PS1 == 1 and $PS1 == 2), 'map with subroutine' ); lib000755001750001750 011220337155 12701 5ustar00ryan52ryan52000000000000Env-PS1-0.06Env000755001750001750 011220337155 13431 5ustar00ryan52ryan52000000000000Env-PS1-0.06/libPS1.pm000444001750001750 2722711220337155 14561 0ustar00ryan52ryan52000000000000Env-PS1-0.06/lib/Envpackage Env::PS1; use strict; use Carp; use AutoLoader 'AUTOLOAD'; our $VERSION = 0.06; our $_getpwuid = eval { getpwuid($>) }; # Not supported on some platforms sub import { my $class = shift; return unless @_; my ($caller) = caller; for (@_) { /^\$(.+)/ or croak qq/$class can't export "$_", try "\$$_"/; no strict 'refs'; tie ${"$caller\::$1"}, $class, $1; } } sub TIESCALAR { my ($class, $var) = @_; my $self = bless { var => $var || 'PS1', format => '', }, $class; $self->cache(); return $self; } sub STORE { my $self = shift; if (ref $$self{var}) { ${$$self{var}} = shift } else { $ENV{$$self{var}} = shift } } sub FETCH { my $self = shift; my $format = ref($$self{var}) ? ${$$self{var}} : $ENV{$$self{var}} ; $format =~ s#(\\\\)|(?cache($format) ]; } my $string = join '', map { ref($_) ? $_->() : $_ } @{$$self{cache}}; $string =~ s#\$\((.+)\)# `$1`; #ge; return $string; } sub sprintf { my $format = pop; $format =~ s#(\\\\)|(?() : $_ } Env::PS1->cache($format); } our @user_info; # ($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$dir,$shell,$expire) our %map; # for custom stuff our %alias = ( '$' => 'dollar', '@' => 'D', t => 'D', T => 'D', A => 'D', ); sub cache { my ($self, $format) = @_; return '' unless defined $format; # get rid of uninitialised warnings @user_info = getpwuid($>) if $_getpwuid; my @parts; #print "# string: $format\n"; while ($format =~ s/^(.*?)(\\\\|\\([aenr]|0\d\d)|\\(.)|!)//s) { push @parts, $1 || ''; if ($2 eq '\\\\') { push @parts, '\\' } # stripped when \! is substitued elsif ($2 eq '!') { push @parts, '!!' } # posix prompt escape :$ elsif ($3) { push @parts, eval qq/"\\$3"/ } elsif (exists $map{$4}) { my $item = $map{$4}; if (ref $item and $format =~ s/^\{(.*?)\}//) { push @parts, $item->($1); # obscure foo } else { push @parts, $item } } elsif (grep {$4 eq $_} qw/C D P/) { # special cases my $sub = $4 ; $format =~ s/^\{(.*?)\}//; push @parts, $self->$sub($sub, $1); } elsif ($4 eq '[' or $4 eq ']') { next } else { my $sub = exists($alias{$4}) ? $alias{$4} : uc($4) ; push @parts, $self->can($sub) ? ($self->$sub($4)) : $4; } } push @parts, $format; my @cache = (''); for (@parts) { # optimise: join strings, push code refs if (ref $_ or ref $cache[-1]) { push @cache, $_ } else { $cache[-1] .= $_ } } return @cache; } ## format subs sub U { $user_info[0] || $ENV{USER} || $ENV{LOGNAME} } sub W { return sub { $ENV{PWD} eq $ENV{HOME} ? "~" : $ENV{PWD} } if $_[1] eq 'w'; return sub { return '/' if $ENV{PWD} eq '/'; if($ENV{PWD} eq $ENV{HOME}) { return "~"; } $ENV{PWD} =~ m#([^/]*)/?$#; return $1; }; } ## others defined below for Autoload 1; __END__ =head1 NAME Env::PS1 - prompt string formatter =head1 SYNOPSIS # use the import function use Env::PS1 qw/$PS1/; $ENV{PS1} = '\u@\h \$ '; print $PS1; $readline = ; # or tie it yourself tie $prompt, 'Env::PS1', 'PS1'; # you can also tie a scalar ref $format = '\u@\h\$ '; tie $prompt, 'Env::PS1', \$format; =head1 DESCRIPTION This package supplies variables that are "tied" to environment variables like 'PS1' and 'PS2', if read it takes the contents of the variable as a format string like the ones B uses to format the prompt. It is intended to be used in combination with the various ReadLine packages. =head1 EXPORT You can request for arbitrary variables to be exported, they will be tied to the environment variables of the same name. =head1 TIE When you C a variable you can supply one argument which can either be the name of an environement variable or a SCALAR reference. This argument defaults to 'PS1'. =head1 METHODS =over 4 =item C Returns the formatted string. Using this method all the time is a lot B efficient then using the tied variable, because the tied variable caches parts of the format that remain the same anyway. =back =head1 FORMAT The format is copied mostly from bash(1) because that's what it is supposed to be compatible with. We made some private extensions which obviously are not portable. Note that this is not the prompt format as specified by the posix specification, that would only know "!" for the history number and "!!" for a literal "!". Apart from the escape sequences you can also use environment variables in the format string; use C<$VAR> or C<${VAR}>. The following escape sequences are recognized: =over 4 =item \a The bell character, identical to "\007" =item \d The date in "Weekday Month Date" format =item \D{format} The date in strftime(3) format, uses L =cut sub D { return sub { my $t = localtime; $t =~ m/^(\w+\s+\w+\s+\d+)/; return $1; } if $_[1] eq 'd'; use POSIX qw(strftime); my $format = ($_[1] eq 't') ? '%H:%M:%S' : ($_[1] eq 'T') ? '%I:%M:%S' : ($_[1] eq '@') ? '%I:%M %p' : ($_[1] eq 'A') ? '%H:%M' : $_[2] ; return sub { strftime $format, localtime }; } =item \e The escape character, identical to "\033" =item \n Newline =item \r Carriage return =item \s The basename of $0 =cut sub S { $0 =~ m#([^/]*)$#; return $1 || ''; } =pod =item \t The current time in 24-hour format, identical to "\D{%H:%M:%S}" =item \T The current time in 12-hour format, identical to "\D{%I:%M:%S}" =item \@ The current time in 12-hour am/pm format, identical to "\D{%I:%M %p}" =item \A The current time in short 24-hour format, identical to "\D{%H:%M}" =item \u The username of the current user =item \w The current working directory =item \W The basename of the current working directory =item \$ "#" for effective uid is 0 (root), else "$" =cut sub dollar { $user_info[2] ? '$' : '#' } =item \0dd The character corresponding to the octal number 0dd =item \\ Literal backslash =item \H Hostname, uses L =item \h First part of the hostname =cut sub H { use Sys::Hostname; no warnings; *H = sub { my $h = &hostname; $h =~ s#\..*$## if $_[1] eq 'h'; return $h; }; return &H; } =item \l The basename of the (output) terminal device name, uses POSIX, but won't be really portable. =cut sub L { # How platform dependent is this ? use POSIX qw/ttyname/; no warnings; *L = sub { my $t = ttyname(*STDOUT); $t =~ s#.*/## if $_[1] eq 'l'; return $t; }; return &L; } =item \[ \] These are used to encapsulate a sequence of non-printing chars. Since we don't need that, they are removed. =back =head2 Extensions The following escapes are extensions not supported by bash, and are not portable: =over 4 =item \L The (output) terminal device name, uses POSIX, but won't be really portable. =item \C{colour} Insert the ANSI sequence for named colour. Known colours are: black, red, green, yellow, blue, magenta, cyan and white; background colours prefixed with "on_". Also known are reset, bold, dark, underline, blink and reverse, although the effect depends on the terminla you use. Unless you want the whole commandline coloured you should end your prompt with "\C{reset}". Of course you can still use the "raw" ansi escape codes for these colours. Note that "bold" is sometimes also known as "bright", so "\C{bold,black}" will on some terminals render dark grey. If the environment variable C is defined but false colours are switched off automaticly. =cut sub C { our %colours = ( # Copied from Term::ANSIScreen 'clear' => 0, 'reset' => 0, 'bold' => 1, 'dark' => 2, 'underline' => 4, 'underscore' => 4, 'blink' => 5, 'reverse' => 7, 'concealed' => 8, 'black' => 30, 'on_black' => 40, 'red' => 31, 'on_red' => 41, 'green' => 32, 'on_green' => 42, 'yellow' => 33, 'on_yellow' => 43, 'blue' => 34, 'on_blue' => 44, 'magenta' => 35, 'on_magenta' => 45, 'cyan' => 36, 'on_cyan' => 46, 'white' => 37, 'on_white' => 47, ); no warnings; *C = sub { return if defined $ENV{CLICOLOR} and ! $ENV{CLICOLOR}; my @attr = split ',', $_[2]; #print "# $_[2] => \\e[" . join(';', map {$colours{lc($_)}} @attr) . "m\n"; return "\e[" . join(';', map {$colours{lc($_)}} @attr) . "m"; }; C(@_); } =item \P{format} Proc information. I =over 4 =item %a Acpi AC status '+' or '-' for connected or not, linux specific =item %b Acpi battery status in mWh, linux specific =item %L Load average =item %l First number of the load average =item %t Acpi temperature, linux specific =item %u Uptime =item %w Number of users logged in =back =cut # $ uptime # 17:38:53 up 3:24, 2 users, load average: 0.04, 0.10, 0.13 sub P { my ($self, undef, $format) = @_; my %code; $format =~ s/\%(.)/$code{$1}++; "'.\$proc{$1}.'"/ge; my @subs = grep exists($code{$_}), qw/a b t/; return sub { my %proc; for my $s (@subs) { my $sub = "P_$s"; $proc{$s} = $self->$sub(); } if (open UP, 'uptime|') { my $up = ; close UP; $up =~ /up\s*(\d+:\d+)/ and $proc{u} = $1; $up =~ /(\d+)\s*user/ and $proc{w} = $1; $up =~ /((\d+\.\d+),\s*\d+\.\d+,\s*\d+\.\d+)/ and @proc{'L', 'l'} = ($1, $2); } #use Data::Dumper; print "'$format'", Dumper \%proc, "\n"; eval "'$format'"; # all in single quote, except for escapes } } sub P_a { open(AC,'/proc/acpi/ac_adapter/AC/state') or return '?'; my $a = ; close AC; return ( ($a =~ /on/) ? '+' : '-' ); } sub P_b { open(BAT,'/proc/acpi/battery/BAT0/state') or return '?'; my ($b) = grep /^remaining capacity:/, (); close BAT; $b =~ /(\d+)/; return $1 || '0'; } sub P_t { open(TH, '/proc/acpi/thermal_zone/THM/temperature') or return '?'; my $t = ; close TH; $t =~ /(\d+)/; return $1 || '0'; } =back =head2 Not implemented escapes The following escapes are not implemented, because they are application specific. =over 4 =item \j The number of jobs currently managed by the application. =item \v The version of the application. =item \V The release number of the application, version + patchelvel =item \! The history number of the next command. This escape gets replaced by literal '!' while a literal '!' gets replaces by '!!'; this makes the string a posix compatible prompt, thus it will work if your readline module expects a posix prompt. =item \# The command number of the next command (like history number, but minus the lines read from the history file). =back =head2 Customizing If you want to overload escapes or want to supply values for the application specific escapes you can put them in C<%Env::PS1::map>, the key is the escape letter, the value either a string or a CODE ref. If you map a CODE ref it normally is called every time the prompt string is read. When the escape is followed by an argument in the format string (like C<\D{argument}>) the CODE ref is called only once when the string is cached, but in that case it may in turn return a CODE ref. =head1 BUGS Please mail the author if you encounter any bugs. =head1 AUTHOR Jaap Karssenberg || Pardus [Larus] Epardus@cpan.orgE This module is currently maintained by Ryan Niebur Ersn@cpan.orgE Copyright (c) 2004 Jaap G Karssenberg. All rights reserved. Copyright (c) 2009 Ryan Niebur. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L, L =cut