# kpathsea.pl -- search a file as Karl Berry likes to do it.
#
# Copyright (C) 1994 Ralph Schleicher (rs@purple.in-ulm.de)
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	See the GNU
# Library General Public License for more details.
#
# You should have received a copy of the GNU Library General Public
# License along with this library; if not, write to the Free
# Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
# The comments are borrowed from `kpathsea.info'.  ;-)


package KPathSearch;

# Is `require' local to a package?  I don't know.
#
if (! $find_included)
{
  do 'find.pl' || die "$0:find.pl: $!\n";

  $find_included = 1;
}

sub main'kpathsearch
{
  local ($var, $def, $file) = @_;

  local (@path) = split (':', $ENV{$var} || $def, -1);
  local (@def) = split (':', $def, -1);
  local (@dir) = ();

  local ($[) = 0;

  while (@path)
    {
      $_ = shift @path;

      # Extra colons expand to the compilation default.
      #
      unshift (@path, @def), next if $_ eq '';

      # `~' and `~user' expand to home directories.
      #
      if (/^~/)
	{
	  local ($slash, $name, $n, $p, $u, $g, $q, $c, $o, $home, $s);

	  $slash = index ($_, '/');
	  $slash = length if $slash < 0;

	  $name = substr ($_, 1, $slash - 1);
	  if ($name ne '')
	    { ($n, $p, $u, $g, $q, $c, $o, $home, $s) = getpwnam ($name); }
	  else
	    { ($n, $p, $u, $g, $q, $c, $o, $home, $s) = getpwuid ($<); }

	  $home = '.' if $home eq '';

	  $_ =~ s/^~$name/$home/;
	}

      # `$foo' and `${foo}' expand to environment values.
      #
      while (/\$(\w*|\{.*\})/)
	{
	  $_ = join ('', $`, $ENV{$1} || '.', $');
	}

      # `a//' and `a//b' recursively expand to sub-directories.
      #
      if (/\/\//)
	{
	  local ($base, @sub) = split ('//', $_, -1);
	  local ($term) = pop (@sub);

	  undef @directories;
	  &find ($base);

	  foreach $sub (@sub)
	    {
	      @directories = grep (m|^$base/(.*/)?$sub|, @directories);
	    }
	  @directories = grep (m|$term$|, @directories) if $term ne '';

	  push (@dir, @directories);
	}
      else
	{
	  push (@dir, $_);
	}
    }

  # See what we have to return.
  #
  return @dir if $file eq '';

  if (wantarray)
    {
      return grep (-e ($_ = "$_/$file"), @dir);
    }

  foreach (@dir)
    {
      return $_ if -f ($_ = "$_/$file");
    }

  return undef;
}

sub wanted
{
  push (@directories, $name) if (lstat ($_)) && -d _;
}

1;