summaryrefslogtreecommitdiff
path: root/systems/os2/web2c-6.1/source/kpathsea.pl
blob: dd5f5709110367f32374d2612a0a079188742828 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
# 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;