summaryrefslogtreecommitdiff
path: root/fonts/utilities/vplutils/paths.pl
blob: 8ba65a901802392748b6631e1a09cac972d4f554 (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
# -*-perl-*-
# paths.pl
# (C) A. J. C. Duggan 22/9/93
# Path expansion and file searching package
#
# public routines are:
#	pathexpand(path, default, initial)	Expands colon-separated path
#	pathopen(name, suffixes, path)		Opens file by searching path

###############################################################################
# Path manipulation routines
###############################################################################

package paths;			# start package

# pathexpand(path, defaultpath, extra...)
# expands a colon-separated path and default path to an array, inserting the
# default path instead of null components in the path. An optional third
# argument has extra elements to put at the start of the path.
sub main'pathexpand {
   local($path, $defaultpath, @path) = @_;
   grep($_ eq '' ? 
	grep($_ ne '' ? push(@path, $_) : 0, split(/:/, $defaultpath)) :
	push(@path, $_),
	split(/:/, $path, -1));
   @path;
}

# pathopen(file, suffixes, path...)
# searches the path for file name and opens it for reading.
# suffixes is a comma-separated list of suffixes to be applied to file.
# returns non-zero on success, the undefined value otherwise.
sub main'pathopen {
   local($name, $suffixes, @path) = @_;
   local($package) = caller;
   print STDERR "Searching ", join(':', @path), " for $name\n",
                "Suffixes ", join(', ', split(',', $suffixes, -1)), "\n"
      if $main'debug;
   foreach $dir (@path) {
      foreach $suffix (split(',', $suffixes, -1)) {
	 $suffix = ".$suffix" if $suffix ne '';
	 print STDERR "Trying $dir/$name$suffix ...\n" if $main'debug;
	 return $value if $value = open("${package}'$name",
					"$dir/$name$suffix");
      }
   }
   print STDERR "$name not found\n" if $main'debug;
   undef;
}

1;