Initial commit of OpenSPARC T2 design and verification files.

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

package Psh::Builtins::Which;

require Psh::Util;
require Getopt::Std;

=item * C<which command>

Locates the command in the filesystem.

=item * C<which -m module>

Locates the perl module in the filesystem

=item * C<which -r module>

Locates a command using a Perl regexp

Option C<-a> may be used to see more than one match.
Option C<-v> switches to a more verbose output.

=cut

sub parse_version
{
	my $file= shift;
	open(FILE,"< $file");
	my $inpod=0;
	my $result;
	while (<FILE>) {
		chomp;
		$inpod = /^=(?!cut)/ ? 1: /^=cut/ ? 0 : $inpod;
		next if $inpod;
		next unless /([\$*])(([\w\:\']*)\bVERSION)\b.*\=/;
		my $eval= qq{
package Psh::_version;
no strict;

local $1$2;
\$$2=undef; do {
    $_
}; \$$2
};
		no warnings;
		$result= eval($eval);
		last;
	}
	close(FILE);
	$result = 'undef' unless defined $result;
	return $result;
}

sub bi_which
{
	my $line= shift;
	local @ARGV = @{shift()};
	my $opt={};
	Getopt::Std::getopts('aprmv',$opt);
	my $rest= join(' ',@ARGV);

	if ($opt->{'m'}) { # perl module search
        $rest=~ s/::/$Psh::OS::FILE_SEPARATOR/g;
		my $foundsth=0;
        foreach my $dir (@Psh::origINC) {
			next unless $dir;
            my $file= Psh::OS::catfile($dir,$rest.'.pm');
            if (-r $file) {
				Psh::Util::print_out($file);
                if ($opt->{v}) {
		            my $version= parse_version($file);
					Psh::Util::print_out(" $version");
				}
		        Psh::Util::print_out("\n");
				$foundsth=1;
		        last unless $opt->{a};
            }
        }
		return (1,undef) if $foundsth;
	} else {
		if ($opt->{'r'}) {
			my $foundsth=0;
			Psh::Util::recalc_absed_path();
			foreach my $dir (@Psh::absed_path) {
				next unless $dir;
				opendir(DIR, $dir);
				while (my $tmp= readdir(DIR)) {
					next unless $tmp=~/$rest/;
					$tmp= Psh::OS::catfile($dir,$tmp);
					next unless -f $tmp;
					next unless -x _;
					Psh::Util::print_out("$tmp\n");
					$foundsth=1;
					last unless $opt->{a};
				}
				closedir(DIR);
				last if $foundsth and !$opt->{a};
			}
			return (1,undef) if $foundsth;
		} else {
			if ($rest) {
				my @tmp=();
				push @tmp, Psh::Util::which($rest,$opt->{'a'}?1:0);
				foreach (@tmp) {
					Psh::Util::print_out("$_\n");
				}
				return (1,undef) if @tmp;
			}
		}
	}
	return (0,undef);
}

1;