Env-PS1

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

	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

lib/Env/PS1.pm  view on Meta::CPAN

package 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;
	}

lib/Env/PS1.pm  view on Meta::CPAN

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/^\{(.*?)\}//) {

t/00_usage.t  view on Meta::CPAN

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-}';