#!/usr/bin/env perl
# -*- mode: cperl; -*-
# 
# NAME
#
#   perlwhich - locate a Perl module
# 
# USAGE
#
#   perlwhich [-adv] module...
# 
# The perlwhich command prints the full path to the specified Perl module or
# modules, if it is found in @INC. Each module may be specified as either a
# package name (My::Package) or a file name (My/Package.pm). Each name is tried
# both with and without the .pm suffix. By default, the first path name found
# for each argument is printed.
# 
# OPTIONS
# 
#   -a    Print all matching path names.
# 
#   -d    Do not add a .pm suffix, look for a matching directory
# 
#   -v    Print out the version of each module, if that information can be
#         retrieved from the module file.
# 


use strict;

use v5.10;

use Pod::Usage;

our ($VERSION) = '0.81';

# Result code: 1 = not found, 0 = found

my $rc = 1;

# Look for options, with bundling.

my $flags = '';
my $OPT_ALL;
my $OPT_DIR;
my $OPT_VER;

while ( @ARGV )
{
    if ( $ARGV[0] =~ / - ([adv]+) $ /x )
    {
	shift @ARGV;
	$flags .= $1;
    }
    
    elsif ( $ARGV[0] =~ /^-h$|^--help$/ )
    {
	pod2usage(-exitval => 0, -verbose => 1);
	exit;
    }
    
    elsif ( $ARGV[0] eq '-' )
    {
	shift @ARGV;
	last;
    }
    
    elsif ( $ARGV[0] =~ / ^ - /x )
    {
	die "Invalid option '$ARGV[0]'\n";
    }
    
    else
    {
	last;
    }
}

$OPT_ALL = 1 if $flags =~ /a/;
$OPT_DIR = 1 if $flags =~ /d/;
$OPT_VER = 1 if $flags =~ /v/;

# Determine whether the path separator is / or \ by checking the last separator
# in the first element of @INC that contains a separator.

my $sep = '';

foreach my $path (@INC)
{
    if ( $path =~ /[\\\/]/ )
    {
	($sep) = $path =~ /([\\\/])[^\\\/]*$/;
	last;
    }
}

# Remaining arguments are names to look up.

foreach my $arg ( @ARGV )
{
    my @names;
    
    # An argument that contains '::' is taken to be the name of a Perl module.
    # Look for the equivalent .pm or .pod file. If neither one is found, look
    # for a matching directory. With the -d option, only the directory is
    # searched for.
    
    if ( $arg =~ /::/ )
    {
	$arg =~ s/::/$sep/g;
	
	push @names, "$arg.pm" unless $OPT_DIR;
	push @names, "$arg.pod" unless $OPT_DIR;
	push @names, $arg;
    }
    
    # An argument that does not contain '::' and ends in .pm or some other
    # extension is searched for unchanged.
    
    elsif ( $arg =~ /[.]\w+$/ )
    {
	push @names, $arg;
    }
    
    # Any other argument is assumed to be a file name with the extension left
    # off. Search for the argument with a .pm or .pod ending. If neither one
    # is found, or if -d is given, search for a matching directory.
    
    else
    {
	push @names, "$arg.pm" unless $OPT_DIR;
	push @names, "$arg.pod" unless $OPT_DIR;
	push @names, $arg;
    }
    
    # Now look up all of the name variants for this argument in each element of
    # @INC. Stop when we find a match, unless the -a option was specified.
    
  NAME:
    while ( defined(my $name = shift @names) )
    {
	foreach my $dir ( @INC )
	{
	    my $lookup = $dir =~ /$sep$/o ? "$dir$name" : "$dir$sep$name";
	    
	    # We test -r rather than -e because perl says that a non-readable
	    # module file is not found.
	    
	    if ( -r $lookup )
	    {
		if ( $OPT_VER )
		{
		    &DisplayVersion($lookup);
		}
		
		else
		{
		    say $lookup;
		}
		
		$rc = 0;
		
		last NAME unless $OPT_ALL;
	    }
	}
    }
}

# If at least one pathname was found, exit with 0. Otherwise, exit with 1.

exit $rc;


# DisplayVersion ( filepath )
# 
# If the file can be read, look for a 

sub DisplayVersion {
    
    my ($filepath) = @_;
    
    if ( open(my $fh, '<', $filepath) )
    {
	my $content;
	
	read($fh, $content, 8192);
	
	if ( $content =~ / [$] [\w:']* \bVERSION\b .*? = [\s'"]* ( \d [\d.]+ ) /x )
	{
	    say "$filepath version=$1";
	    return;
	}
    }
    
    say $filepath;
}

__END__

=head1 NAME

perlwhich - locate a Perl module

=head1 USAGE

  perlwhich [options] module...

=head1 OPTIONS

=over 4

=item -a

Print all matching path names.

=item -d

Do not add a .pm suffix, look for a matching directory.

=item -v

Print out the version of each module after its name, if that information can
be retrieved from the module file.

=item -h

Print out this usage information.

=back

=head1 DESCRIPTION

The perlwhich command is the equivalent of 'which' for Perl modules. It prints
the full path to each specified Perl module, if it is found in @INC. A module
may be specified as either a package name (Some::Module) or a file name
(Some/Module.pm). By default, the first path name found for each argument is
printed. If the -a option is given, then all path names are printed. The -d
option lists matching directories instead of module files.

This command is intended to work on most operating systems. It checks to see
whether the path name separator is '/' or '\' by looking at the first element of
@INC which contains one of these characters.

=head1 RESULT CODE

This command returns 0 if a matching file or directory is found, 1 if not.

=cut
