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