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