xref: /openbsd-src/gnu/usr.bin/perl/ext/VMS-Filespec/lib/VMS/Filespec.pm (revision 256a93a44f36679bee503f12e49566c2183f6181)
16fb12b70Safresh1#   Perl hooks into the routines in vms.c for interconversion
26fb12b70Safresh1#   of VMS and Unix file specification syntax.
36fb12b70Safresh1#
46fb12b70Safresh1#   Version:  see $VERSION below
56fb12b70Safresh1#   Author:   Charles Bailey  bailey@newman.upenn.edu
66fb12b70Safresh1#   Revised:  8-DEC-2007
76fb12b70Safresh1
86fb12b70Safresh1=head1 NAME
96fb12b70Safresh1
106fb12b70Safresh1VMS::Filespec - convert between VMS and Unix file specification syntax
116fb12b70Safresh1
126fb12b70Safresh1=head1 SYNOPSIS
136fb12b70Safresh1
146fb12b70Safresh1  use VMS::Filespec;
156fb12b70Safresh1  $fullspec = rmsexpand('[.VMS]file.specification'[, 'default:[file.spec]']);
166fb12b70Safresh1  $vmsspec = vmsify('/my/Unix/file/specification');
176fb12b70Safresh1  $unixspec = unixify('my:[VMS]file.specification');
186fb12b70Safresh1  $path = pathify('my:[VMS.or.Unix.directory]specification.dir');
196fb12b70Safresh1  $dirfile = fileify('my:[VMS.or.Unix.directory.specification]');
206fb12b70Safresh1  $vmsdir = vmspath('my/VMS/or/Unix/directory/specification.dir');
216fb12b70Safresh1  $unixdir = unixpath('my:[VMS.or.Unix.directory]specification.dir');
226fb12b70Safresh1  candelete('my:[VMS.or.Unix]file.specification');
236fb12b70Safresh1  $case_tolerant = case_tolerant_process;
246fb12b70Safresh1  $unixspec = unixrealpath('file_specification');
256fb12b70Safresh1  $vmsspec = vmsrealpath('file_specification');
266fb12b70Safresh1
276fb12b70Safresh1=head1 DESCRIPTION
286fb12b70Safresh1
296fb12b70Safresh1This package provides routines to simplify conversion between VMS and
306fb12b70Safresh1Unix syntax when processing file specifications.  This is useful when
316fb12b70Safresh1porting scripts designed to run under either OS, and also allows you
326fb12b70Safresh1to take advantage of conveniences provided by either syntax (I<e.g.>
336fb12b70Safresh1ability to easily concatenate Unix-style specifications).  In
346fb12b70Safresh1addition, it provides an additional file test routine, C<candelete>,
356fb12b70Safresh1which determines whether you have delete access to a file.
366fb12b70Safresh1
376fb12b70Safresh1If you're running under VMS, the routines in this package are special,
386fb12b70Safresh1in that they're automatically made available to any Perl script,
396fb12b70Safresh1whether you're running F<miniperl> or the full F<perl>.  The C<use
406fb12b70Safresh1VMS::Filespec> or C<require VMS::Filespec; import VMS::Filespec ...>
416fb12b70Safresh1statement can be used to import the function names into the current
426fb12b70Safresh1package, but they're always available if you use the fully qualified
436fb12b70Safresh1name, whether or not you've mentioned the F<.pm> file in your script.
446fb12b70Safresh1If you're running under another OS and have installed this package, it
456fb12b70Safresh1behaves like a normal Perl extension (in fact, you're using Perl
466fb12b70Safresh1substitutes to emulate the necessary VMS system calls).
476fb12b70Safresh1
486fb12b70Safresh1Each of these routines accepts a file specification in either VMS or
496fb12b70Safresh1Unix syntax, and returns the converted file specification, or C<undef>
506fb12b70Safresh1if an error occurs.  The conversions are, for the most part, simply
516fb12b70Safresh1string manipulations; the routines do not check the details of syntax
526fb12b70Safresh1(e.g. that only legal characters are used).  There is one exception:
536fb12b70Safresh1when running under VMS, conversions from VMS syntax use the $PARSE
546fb12b70Safresh1service to expand specifications, so illegal syntax, or a relative
556fb12b70Safresh1directory specification which extends above the tope of the current
566fb12b70Safresh1directory path (e.g [---.foo] when in dev:[dir.sub]) will cause
576fb12b70Safresh1errors.  In general, any legal file specification will be converted
586fb12b70Safresh1properly, but garbage input tends to produce garbage output.
596fb12b70Safresh1
606fb12b70Safresh1Each of these routines is prototyped as taking a single scalar
616fb12b70Safresh1argument, so you can use them as unary operators in complex
626fb12b70Safresh1expressions (as long as you don't use the C<&> form of
636fb12b70Safresh1subroutine call, which bypasses prototype checking).
646fb12b70Safresh1
656fb12b70Safresh1
666fb12b70Safresh1The routines provided are:
676fb12b70Safresh1
686fb12b70Safresh1=head2 rmsexpand
696fb12b70Safresh1
706fb12b70Safresh1Uses the RMS $PARSE and $SEARCH services to expand the input
716fb12b70Safresh1specification to its fully qualified form, except that a null type
726fb12b70Safresh1or version is not added unless it was present in either the original
736fb12b70Safresh1file specification or the default specification passed to C<rmsexpand>.
746fb12b70Safresh1(If the file does not exist, the input specification is expanded as much
756fb12b70Safresh1as possible.)  If an error occurs, returns C<undef> and sets C<$!>
766fb12b70Safresh1and C<$^E>.
776fb12b70Safresh1
786fb12b70Safresh1C<rmsexpand> on success will produce a name that fits in a 255 byte buffer,
796fb12b70Safresh1which is required for parameters passed to the DCL interpreter.
806fb12b70Safresh1
816fb12b70Safresh1=head2 vmsify
826fb12b70Safresh1
836fb12b70Safresh1Converts a file specification to VMS syntax.  If the file specification
846fb12b70Safresh1cannot be converted to or is already in VMS syntax, it will be
856fb12b70Safresh1passed through unchanged.
866fb12b70Safresh1
876fb12b70Safresh1The file specifications of C<.> and C<..> will be converted to
886fb12b70Safresh1C<[]> and C<[-]>.
896fb12b70Safresh1
906fb12b70Safresh1If the file specification is already in a valid VMS syntax, it will
916fb12b70Safresh1be passed through unchanged, except that the UTF-8 flag will be cleared
926fb12b70Safresh1since VMS format file specifications are never in UTF-8.
936fb12b70Safresh1
946fb12b70Safresh1When Perl is running on an OpenVMS system, if the C<DECC$EFS_CHARSET>
956fb12b70Safresh1feature is not enabled, extra dots in the file specification will
966fb12b70Safresh1be converted to underscore characters, and the C<?> character will
976fb12b70Safresh1be converted to a C<%> character, if a conversion is done.
986fb12b70Safresh1
996fb12b70Safresh1When Perl is running on an OpenVMS system, if the C<DECC$EFS_CHARSET>
1006fb12b70Safresh1feature is enabled, this implies that the Unix pathname cannot have
1016fb12b70Safresh1a version, and that a path consisting of three dots, C<./.../>, will be
1026fb12b70Safresh1converted to C<[.^.^.^.]>.
1036fb12b70Safresh1
1046fb12b70Safresh1Unix style shell macros like C<$(abcd)> are passed through instead
1056fb12b70Safresh1of being converted to C<$^(abcd^)> independent of the C<DECC$EFS_CHARSET>
1066fb12b70Safresh1feature setting.  Unix style shell macros should not use characters
1076fb12b70Safresh1that are not in the ASCII character set, as the resulting specification
1086fb12b70Safresh1may or may not be still in UTF8 format.
1096fb12b70Safresh1
1106fb12b70Safresh1The feature logical name C<PERL_VMS_VTF7_FILENAMES> controls if UNICODE
1116fb12b70Safresh1characters in Unix filenames are encoded in VTF-7 notation in the resulting
1126fb12b70Safresh1OpenVMS file specification.  [Currently under development]
1136fb12b70Safresh1
1146fb12b70Safresh1C<unixify> on the resulting file specification may not result in the
1156fb12b70Safresh1original Unix file specification, so programs should not plan to convert
1166fb12b70Safresh1a file specification from Unix to VMS and then back to Unix again after
1176fb12b70Safresh1modification of the components.
1186fb12b70Safresh1
1196fb12b70Safresh1=head2 unixify
1206fb12b70Safresh1
1216fb12b70Safresh1Converts a file specification to Unix syntax.  If the file specification
1226fb12b70Safresh1cannot be converted to or is already in Unix syntax, it will be passed
1236fb12b70Safresh1through unchanged.
1246fb12b70Safresh1
1256fb12b70Safresh1When Perl is running on an OpenVMS system, the following C<DECC$> feature
1266fb12b70Safresh1settings will control how the filename is converted:
1276fb12b70Safresh1
1286fb12b70Safresh1 C<decc$disable_to_vms_logname_translation:> default = C<ENABLE>
1296fb12b70Safresh1 C<decc$disable_posix_root:>                 default = C<ENABLE>
1306fb12b70Safresh1 C<decc$efs_charset:>                        default = C<DISABLE>
1316fb12b70Safresh1 C<decc$filename_unix_no_version:>           default = C<DISABLE>
1326fb12b70Safresh1 C<decc$readdir_dropdotnotype:>              default = C<ENABLE>
1336fb12b70Safresh1
1346fb12b70Safresh1When Perl is being run under a Unix shell on OpenVMS, the defaults at
1356fb12b70Safresh1a future time may be more appropriate for it.
1366fb12b70Safresh1
1376fb12b70Safresh1When Perl is running on an OpenVMS system with C<DECC$EFS_CHARSET>
1386fb12b70Safresh1enabled, a wild card directory name of C<[...]> cannot be translated to
1396fb12b70Safresh1a valid Unix file specification.  Also, directory file specifications
1406fb12b70Safresh1will have their implied ".dir;1" removed, and a trailing C<.> character
1416fb12b70Safresh1indicating a null extension will be removed.
1426fb12b70Safresh1
1436fb12b70Safresh1Note that C<DECC$EFS_CHARSET> requires C<DECC$FILENAME_UNIX_NO_VERSION> because
1446fb12b70Safresh1the conversion routine cannot differentiate whether the last C<.> of a Unix
1456fb12b70Safresh1specification is delimiting a version, or is just part of a file specification.
1466fb12b70Safresh1
1476fb12b70Safresh1C<vmsify> on the resulting file specification may not result in the
1486fb12b70Safresh1original VMS file specification, so programs should not plan to convert
1496fb12b70Safresh1a file specification from VMS to Unix and then back to VMS again after
1506fb12b70Safresh1modification.
1516fb12b70Safresh1
1526fb12b70Safresh1=head2 pathify
1536fb12b70Safresh1
1546fb12b70Safresh1Converts a directory specification to a path - that is, a string you
1556fb12b70Safresh1can prepend to a file name to form a valid file specification.  If the
1566fb12b70Safresh1input file specification uses VMS syntax, the returned path does, too;
1576fb12b70Safresh1likewise for Unix syntax (Unix paths are guaranteed to end with '/').
1586fb12b70Safresh1Note that this routine will insist that the input be a legal directory
1596fb12b70Safresh1file specification; the file type and version, if specified, must be
1606fb12b70Safresh1F<.DIR;1>.  For compatibility with Unix usage, the type and version
1616fb12b70Safresh1may also be omitted.
1626fb12b70Safresh1
1636fb12b70Safresh1=head2 fileify
1646fb12b70Safresh1
1656fb12b70Safresh1Converts a directory specification to the file specification of the
1666fb12b70Safresh1directory file - that is, a string you can pass to functions like
1676fb12b70Safresh1C<stat> or C<rmdir> to manipulate the directory file.  If the
1686fb12b70Safresh1input directory specification uses VMS syntax, the returned file
1696fb12b70Safresh1specification does, too; likewise for Unix syntax.  As with
1706fb12b70Safresh1C<pathify>, the input file specification must have a type and
1716fb12b70Safresh1version of F<.DIR;1>, or the type and version must be omitted.
1726fb12b70Safresh1
1736fb12b70Safresh1=head2 vmspath
1746fb12b70Safresh1
1756fb12b70Safresh1Acts like C<pathify>, but insures the returned path uses VMS syntax.
1766fb12b70Safresh1
1776fb12b70Safresh1=head2 unixpath
1786fb12b70Safresh1
1796fb12b70Safresh1Acts like C<pathify>, but insures the returned path uses Unix syntax.
1806fb12b70Safresh1
1816fb12b70Safresh1=head2 candelete
1826fb12b70Safresh1
1836fb12b70Safresh1Determines whether you have delete access to a file.  If you do, C<candelete>
1846fb12b70Safresh1returns true.  If you don't, or its argument isn't a legal file specification,
1856fb12b70Safresh1C<candelete> returns FALSE.  Unlike other file tests, the argument to
1866fb12b70Safresh1C<candelete> must be a file name (not a FileHandle), and, since it's an XSUB,
1876fb12b70Safresh1it's a list operator, so you need to be careful about parentheses.  Both of
1886fb12b70Safresh1these restrictions may be removed in the future if the functionality of
1896fb12b70Safresh1C<candelete> becomes part of the Perl core.
1906fb12b70Safresh1
1916fb12b70Safresh1=head2 case_tolerant_process
1926fb12b70Safresh1
1936fb12b70Safresh1This reports whether the VMS process has been set to a case tolerant
1946fb12b70Safresh1state, and returns true when the process is in the traditional case
1956fb12b70Safresh1tolerant mode and false when case sensitivity has been enabled for the
1966fb12b70Safresh1process.   It is intended for use by the File::Spec::VMS->case_tolerant
1976fb12b70Safresh1method only, and it is recommended that you only use
1986fb12b70Safresh1File::Spec->case_tolerant.
1996fb12b70Safresh1
2006fb12b70Safresh1=head2 unixrealpath
2016fb12b70Safresh1
2026fb12b70Safresh1This exposes the VMS C library C<realpath> function where available.
2036fb12b70Safresh1It will always return a Unix format specification.
2046fb12b70Safresh1
2056fb12b70Safresh1If the C<realpath> function is not available, or is unable to return the
2066fb12b70Safresh1real path of the file, C<unixrealpath> will use the same internal
2076fb12b70Safresh1procedure as the C<vmsrealpath> function and convert the output to a
2086fb12b70Safresh1Unix format specification.  It is not available on non-VMS systems.
2096fb12b70Safresh1
2106fb12b70Safresh1=head2 vmsrealpath
2116fb12b70Safresh1
2126fb12b70Safresh1This uses the C<LIB$FID_TO_NAME> run-time library call to find the name
2136fb12b70Safresh1of the primary link to a file, and returns the filename in VMS format.
2146fb12b70Safresh1This function is not available on non-VMS systems.
2156fb12b70Safresh1
2166fb12b70Safresh1
2176fb12b70Safresh1=head1 REVISION
2186fb12b70Safresh1
2196fb12b70Safresh1This document was last revised 8-DEC-2007, for Perl 5.10.0
2206fb12b70Safresh1
2216fb12b70Safresh1=cut
2226fb12b70Safresh1
2236fb12b70Safresh1package VMS::Filespec;
224*256a93a4Safresh1require 5.006;
2256fb12b70Safresh1
226*256a93a4Safresh1our $VERSION = '1.13';
2276fb12b70Safresh1
2286fb12b70Safresh1# If you want to use this package on a non-VMS system,
2296fb12b70Safresh1# uncomment the following line.
2306fb12b70Safresh1# use AutoLoader;
231*256a93a4Safresh1use Exporter 'import';
2326fb12b70Safresh1
233*256a93a4Safresh1our @EXPORT = qw( &vmsify &unixify &pathify &fileify
2346fb12b70Safresh1              &vmspath &unixpath &candelete &rmsexpand );
235*256a93a4Safresh1our @EXPORT_OK = qw( &unixrealpath &vmsrealpath &case_tolerant_process );
2366fb12b70Safresh11;
2376fb12b70Safresh1
2386fb12b70Safresh1
2396fb12b70Safresh1__END__
2406fb12b70Safresh1
2416fb12b70Safresh1
2426fb12b70Safresh1# The autosplit routines here are provided for use by non-VMS systems
2436fb12b70Safresh1# They are not guaranteed to function identically to the XSUBs of the
2446fb12b70Safresh1# same name, since they do not have access to the RMS system routine
2456fb12b70Safresh1# sys$parse() (in particular, no real provision is made for handling
2466fb12b70Safresh1# of complex DECnet node specifications).  However, these routines
2476fb12b70Safresh1# should be adequate for most purposes.
2486fb12b70Safresh1
2496fb12b70Safresh1# A sort-of sys$parse() replacement
2506fb12b70Safresh1sub rmsexpand ($;$) {
2516fb12b70Safresh1  my($fspec,$defaults) = @_;
2526fb12b70Safresh1  if (!$fspec) { return undef }
2536fb12b70Safresh1  my($node,$dev,$dir,$name,$type,$ver,$dnode,$ddev,$ddir,$dname,$dtype,$dver);
2546fb12b70Safresh1
2556fb12b70Safresh1  $fspec =~ s/:$//;
2566fb12b70Safresh1  $defaults = [] unless $defaults;
2576fb12b70Safresh1  $defaults = [ $defaults ] unless ref($defaults) && ref($defaults) eq 'ARRAY';
2586fb12b70Safresh1
2596fb12b70Safresh1  while ($fspec !~ m#[:>\]]# && $ENV{$fspec}) { $fspec = $ENV{$fspec} }
2606fb12b70Safresh1
2616fb12b70Safresh1  if ($fspec =~ /:/) {
2626fb12b70Safresh1    my($dev,$devtrn,$base);
2636fb12b70Safresh1    ($dev,$base) = split(/:/,$fspec);
2646fb12b70Safresh1    $devtrn = $dev;
2656fb12b70Safresh1    while ($devtrn = $ENV{$devtrn}) {
2666fb12b70Safresh1      if ($devtrn =~ /(.)([:>\]])$/) {
2676fb12b70Safresh1        $dev .= ':', last if $1 eq '.';
2686fb12b70Safresh1        $dev = $devtrn, last;
2696fb12b70Safresh1      }
2706fb12b70Safresh1    }
2716fb12b70Safresh1    $fspec = $dev . $base;
2726fb12b70Safresh1  }
2736fb12b70Safresh1
2746fb12b70Safresh1  ($node,$dev,$dir,$name,$type,$ver) = $fspec =~
2756fb12b70Safresh1     /([^:]*::)?([^:]*:)?([^>\]]*[>\]])?([^.;]*)(\.?[^.;]*)([.;]?\d*)/;
2766fb12b70Safresh1  foreach ((@$defaults,$ENV{'DEFAULT'})) {
2776fb12b70Safresh1    next unless defined;
2786fb12b70Safresh1    last if $node && $ver && $type && $dev && $dir && $name;
2796fb12b70Safresh1    ($dnode,$ddev,$ddir,$dname,$dtype,$dver) =
2806fb12b70Safresh1       /([^:]*::)?([^:]*:)?([^>\]]*[>\]])?([^.;]*)(\.?[^.;]*)([.;]?\d*)/;
2816fb12b70Safresh1    $node = $dnode if $dnode && !$node;
2826fb12b70Safresh1    $dev = $ddev if $ddev && !$dev;
2836fb12b70Safresh1    $dir = $ddir if $ddir && !$dir;
2846fb12b70Safresh1    $name = $dname if $dname && !$name;
2856fb12b70Safresh1    $type = $dtype if $dtype && !$type;
2866fb12b70Safresh1    $ver = $dver if $dver && !$ver;
2876fb12b70Safresh1  }
2886fb12b70Safresh1  # do this the long way to keep -w happy
2896fb12b70Safresh1  $fspec = '';
2906fb12b70Safresh1  $fspec .= $node if $node;
2916fb12b70Safresh1  $fspec .= $dev if $dev;
2926fb12b70Safresh1  $fspec .= $dir if $dir;
2936fb12b70Safresh1  $fspec .= $name if $name;
2946fb12b70Safresh1  $fspec .= $type if $type;
2956fb12b70Safresh1  $fspec .= $ver if $ver;
2966fb12b70Safresh1  $fspec;
2976fb12b70Safresh1}
2986fb12b70Safresh1
2996fb12b70Safresh1sub vmsify ($) {
3006fb12b70Safresh1  my($fspec) = @_;
3016fb12b70Safresh1  my($hasdev,$dev,$defdirs,$dir,$base,@dirs,@realdirs);
3026fb12b70Safresh1
3036fb12b70Safresh1  if ($fspec =~ m#^\.(\.?)/?$#) { return $1 ? '[-]' : '[]'; }
3046fb12b70Safresh1  return $fspec if $fspec !~ m#/#;
3056fb12b70Safresh1  ($hasdev,$dir,$base) = $fspec =~ m#(/?)(.*)/(.*)#;
3066fb12b70Safresh1  @dirs = split(m#/#,$dir);
3076fb12b70Safresh1  if ($base eq '.') { $base = ''; }
3086fb12b70Safresh1  elsif ($base eq '..') {
3096fb12b70Safresh1    push @dirs,$base;
3106fb12b70Safresh1    $base = '';
3116fb12b70Safresh1  }
3126fb12b70Safresh1  foreach (@dirs) {
3136fb12b70Safresh1    next unless $_;  # protect against // in input
3146fb12b70Safresh1    next if $_ eq '.';
3156fb12b70Safresh1    if ($_ eq '..') {
3166fb12b70Safresh1      if (@realdirs && $realdirs[$#realdirs] ne '-') { pop @realdirs }
3176fb12b70Safresh1      else                                           { push @realdirs, '-' }
3186fb12b70Safresh1    }
3196fb12b70Safresh1    else { push @realdirs, $_; }
3206fb12b70Safresh1  }
3216fb12b70Safresh1  if ($hasdev) {
3226fb12b70Safresh1    $dev = shift @realdirs;
3236fb12b70Safresh1    @realdirs = ('000000') unless @realdirs;
3246fb12b70Safresh1    $base = '' unless $base;  # keep -w happy
3256fb12b70Safresh1    $dev . ':[' . join('.',@realdirs) . "]$base";
3266fb12b70Safresh1  }
3276fb12b70Safresh1  else {
3286fb12b70Safresh1    '[' . join('',map($_ eq '-' ? $_ : ".$_",@realdirs)) . "]$base";
3296fb12b70Safresh1  }
3306fb12b70Safresh1}
3316fb12b70Safresh1
3326fb12b70Safresh1sub unixify ($) {
3336fb12b70Safresh1  my($fspec) = @_;
3346fb12b70Safresh1
3356fb12b70Safresh1  return $fspec if $fspec !~ m#[:>\]]#;
3366fb12b70Safresh1  return '.' if ($fspec eq '[]' || $fspec eq '<>');
3376fb12b70Safresh1  if ($fspec =~ m#^[<\[](\.|-+)(.*)# ) {
3386fb12b70Safresh1    $fspec = ($1 eq '.' ? '' : "$1.") . $2;
3396fb12b70Safresh1    my($dir,$base) = split(/[\]>]/,$fspec);
3406fb12b70Safresh1    my(@dirs) = grep($_,split(m#\.#,$dir));
3416fb12b70Safresh1    if ($dirs[0] =~ /^-/) {
3426fb12b70Safresh1      my($steps) = shift @dirs;
3436fb12b70Safresh1      for (1..length($steps)) { unshift @dirs, '..'; }
3446fb12b70Safresh1    }
3456fb12b70Safresh1    join('/',@dirs) . "/$base";
3466fb12b70Safresh1  }
3476fb12b70Safresh1  else {
3486fb12b70Safresh1    $fspec = rmsexpand($fspec,'_N_O_T_:[_R_E_A_L_]');
3496fb12b70Safresh1    $fspec =~ s/.*_N_O_T_:(?:\[_R_E_A_L_\])?//;
3506fb12b70Safresh1    my($dev,$dir,$base) = $fspec =~ m#([^:<\[]*):?[<\[](.*)[>\]](.*)#;
3516fb12b70Safresh1    my(@dirs) = split(m#\.#,$dir);
3526fb12b70Safresh1    if ($dirs[0] && $dirs[0] =~ /^-/) {
3536fb12b70Safresh1      my($steps) = shift @dirs;
3546fb12b70Safresh1      for (1..length($steps)) { unshift @dirs, '..'; }
3556fb12b70Safresh1    }
3566fb12b70Safresh1    "/$dev/" . join('/',@dirs) . "/$base";
3576fb12b70Safresh1  }
3586fb12b70Safresh1}
3596fb12b70Safresh1
3606fb12b70Safresh1
3616fb12b70Safresh1sub fileify ($) {
3626fb12b70Safresh1  my($path) = @_;
3636fb12b70Safresh1
3646fb12b70Safresh1  if (!$path) { return undef }
3656fb12b70Safresh1  if ($path eq '/') { return 'sys$disk:[000000]'; }
3666fb12b70Safresh1  if ($path =~ /(.+)\.([^:>\]]*)$/) {
3676fb12b70Safresh1    $path = $1;
3686fb12b70Safresh1    if ($2 !~ /^dir(?:;1)?$/i) { return undef }
3696fb12b70Safresh1  }
3706fb12b70Safresh1
3716fb12b70Safresh1  if ($path !~ m#[/>\]]#) {
3726fb12b70Safresh1    $path =~ s/:$//;
3736fb12b70Safresh1    while ($ENV{$path}) {
3746fb12b70Safresh1      ($path = $ENV{$path}) =~ s/:$//;
3756fb12b70Safresh1      last if $path =~ m#[/>\]]#;
3766fb12b70Safresh1    }
3776fb12b70Safresh1  }
3786fb12b70Safresh1  if ($path =~ m#[>\]]#) {
3796fb12b70Safresh1    my($dir,$sep,$base) = $path =~ /(.*)([>\]])(.*)/;
3806fb12b70Safresh1    $sep =~ tr/<[/>]/;
3816fb12b70Safresh1    if ($base) {
3826fb12b70Safresh1      "$dir$sep$base.dir;1";
3836fb12b70Safresh1    }
3846fb12b70Safresh1    else {
3856fb12b70Safresh1      if ($dir !~ /\./) { $dir =~ s/([<\[])/${1}000000./; }
3866fb12b70Safresh1      $dir =~ s#\.(\w+)$#$sep$1#;
3876fb12b70Safresh1      $dir =~ s/^.$sep//;
3886fb12b70Safresh1      "$dir.dir;1";
3896fb12b70Safresh1    }
3906fb12b70Safresh1  }
3916fb12b70Safresh1  else {
3926fb12b70Safresh1    $path =~ s#/$##;
3936fb12b70Safresh1    "$path.dir;1";
3946fb12b70Safresh1  }
3956fb12b70Safresh1}
3966fb12b70Safresh1
3976fb12b70Safresh1sub pathify ($) {
3986fb12b70Safresh1  my($fspec) = @_;
3996fb12b70Safresh1
4006fb12b70Safresh1  if (!$fspec) { return undef }
4016fb12b70Safresh1  if ($fspec =~ m#[/>\]]$#) { return $fspec; }
4026fb12b70Safresh1  if ($fspec =~ m#(.+)\.([^/>\]]*)$# && $2 && $2 ne '.') {
4036fb12b70Safresh1    $fspec = $1;
4046fb12b70Safresh1    if ($2 !~ /^dir(?:;1)?$/i) { return undef }
4056fb12b70Safresh1  }
4066fb12b70Safresh1
4076fb12b70Safresh1  if ($fspec !~ m#[/>\]]#) {
4086fb12b70Safresh1    $fspec =~ s/:$//;
4096fb12b70Safresh1    while ($ENV{$fspec}) {
4106fb12b70Safresh1      if ($ENV{$fspec} =~ m#[>\]]$#) { return $ENV{$fspec} }
4116fb12b70Safresh1      else { $fspec = $ENV{$fspec} =~ s/:$// }
4126fb12b70Safresh1    }
4136fb12b70Safresh1  }
4146fb12b70Safresh1
4156fb12b70Safresh1  if ($fspec !~ m#[>\]]#) { "$fspec/"; }
4166fb12b70Safresh1  else {
4176fb12b70Safresh1    if ($fspec =~ /([^>\]]+)([>\]])(.+)/) { "$1.$3$2"; }
4186fb12b70Safresh1    else { $fspec; }
4196fb12b70Safresh1  }
4206fb12b70Safresh1}
4216fb12b70Safresh1
4226fb12b70Safresh1sub vmspath ($) {
4236fb12b70Safresh1  pathify(vmsify($_[0]));
4246fb12b70Safresh1}
4256fb12b70Safresh1
4266fb12b70Safresh1sub unixpath ($) {
4276fb12b70Safresh1  pathify(unixify($_[0]));
4286fb12b70Safresh1}
4296fb12b70Safresh1
4306fb12b70Safresh1sub candelete ($) {
4316fb12b70Safresh1  my($fspec) = @_;
4326fb12b70Safresh1  my($parent);
4336fb12b70Safresh1
4346fb12b70Safresh1  return '' unless -w $fspec;
4356fb12b70Safresh1  $fspec =~ s#/$##;
4366fb12b70Safresh1  if ($fspec =~ m#/#) {
4376fb12b70Safresh1    ($parent = $fspec) =~ s#/[^/]+$##;
4386fb12b70Safresh1    return (-w $parent);
4396fb12b70Safresh1  }
4406fb12b70Safresh1  elsif ($parent = fileify($fspec)) { # fileify() here to expand lnms
4416fb12b70Safresh1    $parent =~ s/[>\]][^>\]]+//;
4426fb12b70Safresh1    return (-w fileify($parent));
4436fb12b70Safresh1  }
4446fb12b70Safresh1  else { return (-w '[-]'); }
4456fb12b70Safresh1}
4466fb12b70Safresh1
4476fb12b70Safresh1sub case_tolerant_process () {
4486fb12b70Safresh1    return 0;
4496fb12b70Safresh1}
450