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;
|