# kpathsea.pl -- search a file as Karl Berry likes to do it.
#
# Copyright (C) 1994 Ralph Schleicher ([email protected])
#
# 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;