Initial commit of OpenSPARC T2 design and verification files.

[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / Psh / Util.pm

package Psh::Util;

use strict;

require Psh::OS;

%Psh::Util::command_hash=();
%Psh::Util::path_hash=();

sub print_warning
{
	print STDERR @_;
}

#
# Print unclassified debug output
#
sub print_debug
{
	print STDERR @_ if $Psh::debugging && $Psh::debugging =~ /o/;
}

#
# Print classified debug output
#
sub print_debug_class
{
	my $class= shift;
	print STDERR @_ if $Psh::debugging and
	  ($Psh::debugging eq '1' or
	   $Psh::debugging =~ /$class/);
}

sub print_error
{
	print STDERR @_;
}

#
# print_i18n( stream, key, args)
# print_out_i18n( key, args)
# print_error_i18n( key, args)
#
# The print..._i18n suite of functions will fetch the
# text from the %text hash, replace %1 with the first arg,
# %2 with the second and so on and then print it out
#

sub _print_i18n
{
	my( $stream, $text, @rest) = @_;
	return unless $stream;
	$text= Psh::Locale::get_text($text);
	for( my $i=1; $i<=@rest; $i++)
	{
		$text=~ s/\%$i/$rest[$i-1]/g;
	}
	print $stream $text;
}


sub print_error_i18n
{
	_print_i18n(*STDERR,@_);
}

sub print_warning_i18n
{
	_print_i18n(*STDERR,@_);
}

sub print_out_i18n
{
	_print_i18n(*STDOUT,@_);
}

sub print_out
{
	print STDOUT @_;
}

# Copied from readline.pl - pretty prints a list in columns
sub print_list
{
	my @list= @_;
    return unless @list;
    my ($lines, $columns, $mark, $index);

    ## find width of widest entry
    my $maxwidth = 0;
	my $screen_width=$ENV{COLUMNS};

	if (ref $list[0] and ref $list[0] eq 'ARRAY') {
		$maxwidth= $list[1];
		@list= @{$list[0]};
	}

	unless ($maxwidth) {
		grep(length > $maxwidth && ($maxwidth = length), @list);
	}
	$maxwidth++;

	$columns = $maxwidth >= $screen_width?1:int($screen_width / $maxwidth);

    ## if there's enough margin to interspurse among the columns, do so.
    $maxwidth += int(($screen_width % $maxwidth) / $columns);

    $lines = int((@list + $columns - 1) / $columns);
    $columns-- while ((($lines * $columns) - @list + 1) > $lines);

    $mark = $#list - $lines;
    for (my $l = 0; $l < $lines; $l++) {
        for ($index = $l; $index <= $mark; $index += $lines) {
			my $tmp= my $item= $list[$index];
			$tmp=~ s/\001(.*?)\002//g;
			$item=~s/\001//g;
			$item=~s/\002//g;
			my $diff= length($item)-length($tmp);
			my $dispsize= $maxwidth+$diff;
            print_out(sprintf("%-${dispsize}s", $item));
        }
		if ($index<=$#list) {
			my $item= $list[$index];
			$item=~s/\001//g; $item=~s/\002//g;
			print_out($item);
		}
        print_out("\n");
    }
}

sub abs_path {
	my $dir= shift;
	return undef unless $dir;
	return $Psh::Util::path_hash{$dir} if $Psh::Util::path_hash{$dir};
	my $result= Psh::OS::abs_path($dir);
	unless ($result) {
		if ($dir eq '~') {
			$result= Psh::OS::get_home_dir();
		} elsif ( substr($dir,0,2) eq '~/') {
			substr($dir,0,1)= Psh::OS::get_home_dir();
		} elsif ( substr($dir,0,1) eq '~' ) {
			my $fs= $Psh::OS::FILE_SEPARATOR;
			my ($user)= $dir=~/^\~(.*?)$fs/;
			if ($user) {
				substr($dir,0,length($user)+1)= Psh::OS::get_home_dir($user);
			}
		}
		unless ($result) {
			my $tmp= Psh::OS::rel2abs($dir,$ENV{PWD});

			my $old= $ENV{PWD};
			if ($tmp and -r $tmp) {
				if (-d $tmp and -x _) {
					if ( CORE::chdir($tmp)) {
						$result = Psh::OS::getcwd_psh();
						if (!CORE::chdir($old)) {
						    print STDERR "Could not change directory back to $old!\n";
						    CORE::chdir(Psh::OS::get_home_dir())
						}
					}
				} else {
					$result= $tmp;
				}
			}
#  			if ($tmp and !$result) {
#  				local $^W=0;
#  				local $SIG{__WARN__}= {};
#  				eval {
#  					$result= Cwd::abs_path($tmp);
#  				};
#  				print_debug_class('e',"(abs_path) Error: $@") if $@;
#  			}
			return undef unless $result;
		}
		if ($result) {
			$result.='/' unless $result=~ m:[/\\]:;  # abs_path strips / from letter: on Win
		}
	}
	$Psh::Util::path_hash{$dir}= $result if Psh::OS::file_name_is_absolute($dir);
	return $result;
}

sub recalc_absed_path {
	@Psh::absed_path    = ();
	%Psh::Util::command_hash    = ();

	my @path = split($Psh::OS::PATH_SEPARATOR, $ENV{PATH});

	eval {
		foreach my $dir (@path) {
			next unless $dir;
			my $dir= Psh::Util::abs_path($dir);
			next unless -r $dir and -x _;
			push @Psh::absed_path, $dir;
		}
	};
	print_debug_class('e',"(recalc_absed_path) Error: $@") if $@;
	# Without the eval Psh might crash if the directory
	# does not exist
}

#
# string which(string FILENAME)
#
# search for an occurrence of FILENAME in the current path as given by 
# $ENV{PATH}. Return the absolute filename if found, or undef if not.
#

{
	#
	# "static variables" for which() :
	#

	my $last_path_cwd = '';
	my $FS=$Psh::OS::FILE_SEPARATOR;
	my $tmp= quotemeta($FS);
	my $re1="$tmp";
	my $re2="^(.*)$tmp([^$tmp]+)\$";

	if ($]>=5.005) {
		eval {
			$re1= qr{$re1}o;
			$re2= qr{$re2}o;
		};
		print_debug_class('e',"(util::before which) Error: $@") if $@;
	}

	sub which
    {
		my $cmd= shift;
		my $all= shift;
		return undef unless $cmd;


		if ($cmd =~ m|$re1|o ) {
			$cmd =~ m|$re2|o;
			my $path_element= $1 || '';
			my $cmd_element=  $2 || '';
			return undef unless $path_element and $cmd_element;
			$path_element=Psh::Util::abs_path($path_element);
			return undef unless $path_element;
			my $try= Psh::OS::catfile($path_element,$cmd_element);
			if ((-x $try) and (! -d _)) { return $try; }
			return undef;
		}

		return $Psh::Util::command_hash{$cmd} if exists $Psh::Util::command_hash{$cmd} and !$all;

		if ($cmd !~ m/$Psh::which_regexp/) { return undef; }

		if ($last_path_cwd ne ($ENV{PATH} . $ENV{PWD})) {
			$last_path_cwd = $ENV{PATH} . $ENV{PWD};

			recalc_absed_path();
		}

		my @path_extension=Psh::OS::get_path_extension();
		my @all=();

		foreach my $dir (@Psh::absed_path) {
			next unless $dir;
			my $try = Psh::OS::catfile($dir,$cmd);
			foreach my $ext (@path_extension) {
				if ((-x $try.$ext) and (!-d _)) {
					$Psh::Util::command_hash{$cmd} = $try.$ext unless $all;
					return $try.$ext unless $all;
					push @all, $try.$ext;
				}
			}
		}
		if ($all and @all) {
			return @all;
		}
		$Psh::Util::command_hash{$cmd} = undef; # no delete by purpose

		return undef;
	}
}

#
# starts_with( text, prefix)
# Returns true if text starts with prefix
#

sub starts_with {
	my ($text, $prefix) = @_;

	return length($text)>=length($prefix) &&
		substr($text,0,length($prefix)) eq $prefix;
}

#
# ends_with( text, suffix)
# Returns true if text ends with suffix
#

sub ends_with {
	my ( $text, $suffix) = @_;

	return length($text)>=length($suffix) &&
		substr($text,-length($suffix)) eq $suffix;
}

#
# list parse_hosts_file( text)
# 
# Gets a standard hosts file as input and returns
# a list of the hostnames mentioned in the file
#
sub parse_hosts_file {
	my $text= shift;
	my @lines= split( /\n|\r|\r\n/, $text);
	my @result= ();
	foreach my $line (@lines) {
		next if $line=~/^\s*$/;   # Skip blank lines
		next if $line=~/^\s*\#/;  # Skip comment lines
		$line=~/^\s*\S+\s(.*)$/;
		my $rest= $1;
		push @result, grep { length($_)>0 } split( /\s/, $rest);
	}
	return @result;
}

#
# char prompt( string allowedchars, string prompt)
# prompts the user until he answers with one of the
# allowed characters
#
sub prompt {
	my $allowed= shift;
	$allowed= "^[$allowed]\$";
	my $text= shift;
	my $line='';

	do {
		print $text;
		$line=<STDIN>;
	} while (!$line || lc($line) !~ $allowed);
	chomp $line;
	return lc($line);
}


1;

__END__