One more clean-up for new VMS::Filespec functions.

p4raw-id: //depot/perl@32601

2 files changed, 82 insertions, 59 deletions

diff --git a/vms/ext/Filespec.pm b/vms/ext/Filespec.pm
index 7d3e8614d1..4d3e613292 100644
--- a/vms/ext/Filespec.pm
+++ b/vms/ext/Filespec.pm
@@ -3,7 +3,7 @@
 #
 #   Version:  see $VERSION below
 #   Author:   Charles Bailey  bailey@newman.upenn.edu
-#   Revised:  6-DEC-2007
+#   Revised:  8-DEC-2007
 
 =head1 NAME
 
@@ -20,9 +20,9 @@ VMS::Filespec - convert between VMS and Unix file specification syntax
   $vmsdir = vmspath('my/VMS/or/Unix/directory/specification.dir');
   $unixdir = unixpath('my:[VMS.or.Unix.directory]specification.dir');
   candelete('my:[VMS.or.Unix]file.specification');
-  $case_tolerant = vms_case_tolerant;
-  $unixspec = vms_realpath('file_specification');
-  $vmsspec = vms_realname('file_specification');
+  $case_tolerant = case_tolerant_process;
+  $unixspec = unixrealpath('file_specification');
+  $vmsspec = vmsrealpath('file_specification');
 
 =head1 DESCRIPTION
 
@@ -97,29 +97,29 @@ be converted to underscore characters, and the C<?> character will
 be converted to a C<%> character, if a conversion is done.
 
 When Perl is running on an OpenVMS system, if the C<DECC$EFS_CHARSET>
-feature is enabled, this implies that the UNIX pathname can not have
+feature is enabled, this implies that the Unix pathname cannot have
 a version, and that a path consisting of three dots, C<./.../>, will be
 converted to C<[.^.^.^.]>.
 
-UNIX style shell macros like C<$(abcd)> are passed through instead
+Unix style shell macros like C<$(abcd)> are passed through instead
 of being converted to C<$^(abcd^)> independent of the C<DECC$EFS_CHARSET>
-feature setting.  UNIX style shell macros should not use characters
+feature setting.  Unix style shell macros should not use characters
 that are not in the ASCII character set, as the resulting specification
 may or may not be still in UTF8 format.
 
 The feature logical name C<PERL_VMS_VTF7_FILENAMES> controls if UNICODE
-characters in UNIX filenames are encoded in VTF-7 notation in the resulting
+characters in Unix filenames are encoded in VTF-7 notation in the resulting
 OpenVMS file specification.  [Currently under development]
 
 C<unixify> on the resulting file specification may not result in the
-original UNIX file specification, so programs should not plan to convert
-a file specification from UNIX to VMS and then back to UNIX again after
+original Unix file specification, so programs should not plan to convert
+a file specification from Unix to VMS and then back to Unix again after
 modification of the components.
 
 =head2 unixify
 
 Converts a file specification to Unix syntax.  If the file specification
-cannot be converted to or is already in UNIX syntax, it will be passed
+cannot be converted to or is already in Unix syntax, it will be passed
 through unchanged.
 
 When Perl is running on an OpenVMS system, the following C<DECC$> feature
@@ -131,24 +131,22 @@ settings will control how the filename is converted:
  C<decc$filename_unix_no_version:>           default = C<DISABLE>
  C<decc$readdir_dropdotnotype:>              default = C<ENABLE>
 
-When Perl is being run under a UNIX shell on OpenVMS, the defaults at
+When Perl is being run under a Unix shell on OpenVMS, the defaults at
 a future time may be more appropriate for it.
 
-When Perl is running on an OpenVMS system with C<DECC$EFS_CHARSET> enabled,
-a wild card directory name of C<[...]> can not be translated to a valid
-UNIX file specification when a conversion is done.
-
-When Perl is running on an OpenVMS system with C<DECC$EFS_CHARSET> enabled,
-directory file specifications will have their implied ".dir;1" removed,
-and a trailing C<.> character indicating a null extension will be removed.
+When Perl is running on an OpenVMS system with C<DECC$EFS_CHARSET>
+enabled, a wild card directory name of C<[...]> cannot be translated to
+a valid Unix file specification.  Also, directory file specifications
+will have their implied ".dir;1" removed, and a trailing C<.> character
+indicating a null extension will be removed.
 
 Note that C<DECC$EFS_CHARSET> requires C<DECC$FILENAME_UNIX_NO_VERSION> because
-the conversion routine can not differentiate whether the last C<.> of a UNIX
+the conversion routine cannot differentiate whether the last C<.> of a Unix
 specification is delimiting a version, or is just part of a file specification.
 
 C<vmsify> on the resulting file specification may not result in the
 original VMS file specification, so programs should not plan to convert
-a file specification from VMS to UNIX and then back to VMS again after
+a file specification from VMS to Unix and then back to VMS again after
 modification.
 
 =head2 pathify
@@ -190,23 +188,26 @@ it's a list operator, so you need to be careful about parentheses.  Both of
 these restrictions may be removed in the future if the functionality of
 C<candelete> becomes part of the Perl core.
 
-=head2 vms_case_tolerant
+=head2 case_tolerant_process
 
-This reports whether the VMS process has been set to a case tolerant state.
-It is intended for use by the File::Spec::VMS->case_tolerant method only, and
-it is recommended that you only use File::Spec->case_tolerant.
+This reports whether the VMS process has been set to a case tolerant
+state, and returns true when the process is in the traditional case
+tolerant mode and false when case sensitivity has been enabled for the
+process.   It is intended for use by the File::Spec::VMS->case_tolerant
+method only, and it is recommended that you only use
+File::Spec->case_tolerant.
 
-=head2 vms_realpath
+=head2 unixrealpath
 
 This exposes the VMS C library C<realpath> function where available.
-It will always return a UNIX format specification.
+It will always return a Unix format specification.
 
 If the C<realpath> function is not available, or is unable to return the
-real path of the file, C<vms_realpath> will use the C<vms_realfile>
-function and convert the output to a UNIX format specification.  It is
-not available on non-VMS systems.
+real path of the file, C<unixrealpath> will use the same internal
+procedure as the C<vmsrealpath> function and convert the output to a
+Unix format specification.  It is not available on non-VMS systems.
 
-=head2 vms_realname
+=head2 vmsrealpath
 
 This uses the C<LIB$FID_TO_NAME> run-time library call to find the name
 of the primary link to a file, and returns the filename in VMS format. 
@@ -215,7 +216,7 @@ This function is not available on non-VMS systems.
 
 =head1 REVISION
 
-This document was last revised 6-DEC-2007, for Perl 5.10.0
+This document was last revised 8-DEC-2007, for Perl 5.10.0
 
 =cut
 
@@ -231,8 +232,8 @@ require Exporter;
 
 @ISA = qw( Exporter );
 @EXPORT = qw( &vmsify &unixify &pathify &fileify
-              &vmspath &unixpath &candelete &rmsexpand &vms_case_tolerant );
-
+              &vmspath &unixpath &candelete &rmsexpand );
+@EXPORT_OK = qw( &unixrealpath &vmsrealpath &case_tolerant_process );
 1;
 
 
@@ -444,6 +445,6 @@ sub candelete ($) {
   else { return (-w '[-]'); }
 }
 
-sub vms_case_tolerant ($) {
+sub case_tolerant_process () {
     return 0;
 }
diff --git a/vms/vms.c b/vms/vms.c
index e81c0458a3..9d8a836a87 100644
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -12910,14 +12910,14 @@ mp_do_vms_realpath(pTHX_ const char *filespec, char * rslt_spec,
 		   int *utf8_fl);
 
 void
-vms_realpath_fromperl(pTHX_ CV *cv)
+unixrealpath_fromperl(pTHX_ CV *cv)
 {
     dXSARGS;
     char *fspec, *rslt_spec, *rslt;
     STRLEN n_a;
 
     if (!items || items != 1)
-	Perl_croak(aTHX_ "Usage: VMS::Filespec::vms_realpath(spec)");
+	Perl_croak(aTHX_ "Usage: VMS::Filespec::unixrealpath(spec)");
 
     fspec = SvPV(ST(0),n_a);
     if (!fspec || !*fspec) XSRETURN_UNDEF;
@@ -12938,14 +12938,14 @@ mp_do_vms_realname(pTHX_ const char *filespec, char * rslt_spec,
 		   int *utf8_fl);
 
 void
-vms_realname_fromperl(pTHX_ CV *cv)
+vmsrealpath_fromperl(pTHX_ CV *cv)
 {
     dXSARGS;
     char *fspec, *rslt_spec, *rslt;
     STRLEN n_a;
 
     if (!items || items != 1)
-	Perl_croak(aTHX_ "Usage: VMS::Filespec::vms_realname(spec)");
+	Perl_croak(aTHX_ "Usage: VMS::Filespec::vmsrealpath(spec)");
 
     fspec = SvPV(ST(0),n_a);
     if (!fspec || !*fspec) XSRETURN_UNDEF;
@@ -12981,7 +12981,7 @@ int my_symlink(const char *path1, const char *path2) {
 int do_vms_case_tolerant(void);
 
 void
-vms_case_tolerant_fromperl(pTHX_ CV *cv)
+case_tolerant_process_fromperl(pTHX_ CV *cv)
 {
   dXSARGS;
   ST(0) = boolSV(do_vms_case_tolerant());
@@ -13038,10 +13038,10 @@ init_os_extras(void)
   newXSproto("DynaLoader::mod2fname", mod2fname, file, "$");
   newXS("File::Copy::rmscopy",rmscopy_fromperl,file);
   newXSproto("vmsish::hushed",hushexit_fromperl,file,";$");
-  newXSproto("VMS::Filespec::vms_realpath",vms_realpath_fromperl,file,"$;$");
-  newXSproto("VMS::Filespec::vms_realname",vms_realname_fromperl,file,"$;$");
-  newXSproto("VMS::Filepec::vms_case_tolerant",
-             vms_case_tolerant_fromperl, file, "$");
+  newXSproto("VMS::Filespec::unixrealpath",unixrealpath_fromperl,file,"$;$");
+  newXSproto("VMS::Filespec::vmsrealpath",vmsrealpath_fromperl,file,"$;$");
+  newXSproto("VMS::Filespec::case_tolerant_process",
+      case_tolerant_process_fromperl,file,"");
 
   store_pipelocs(aTHX);         /* will redo any earlier attempts */
 
@@ -13130,8 +13130,8 @@ mp_do_vms_realpath(pTHX_ const char *filespec, char *outbuf,
 
         Newx(vms_spec, VMS_MAXRSS + 1, char);
 
-	 sts = vms_fid_to_name(vms_spec, VMS_MAXRSS + 1, filespec);
-	 if (sts == 0) {
+	sts = vms_fid_to_name(vms_spec, VMS_MAXRSS + 1, filespec);
+	if (sts == 0) {
 
 
 	    /* Now need to trim the version off */
@@ -13151,17 +13151,28 @@ mp_do_vms_realpath(pTHX_ const char *filespec, char *outbuf,
 		   &vs_len);
 
 
-	     if (sts == 0) {
-	        int file_len;
+		if (sts == 0) {
+	            int haslower = 0;
+	            const char *cp;
 
-		/* Trim off the version */
-		file_len = v_len + r_len + d_len + n_len + e_len;
-		vms_spec[file_len] = 0;
+	            /* Trim off the version */
+	            int file_len = v_len + r_len + d_len + n_len + e_len;
+	            vms_spec[file_len] = 0;
 
-		/* The result is expected to be in UNIX format */
-		rslt = do_tounixspec(vms_spec, outbuf, 0, utf8_fl);
-	     }
-	 }
+	            /* The result is expected to be in UNIX format */
+		    rslt = do_tounixspec(vms_spec, outbuf, 0, utf8_fl);
+
+                    /* Downcase if input had any lower case letters and 
+	             * case preservation is not in effect. 
+	             */
+	            if (!decc_efs_case_preserve) {
+	                for (cp = filespec; *cp; cp++)
+	                    if (islower(*cp)) { haslower = 1; break; }
+
+	                if (haslower) __mystrtolower(rslt);
+	            }
+	        }
+	}
 
         Safefree(vms_spec);
     }
@@ -13203,11 +13214,22 @@ mp_do_vms_realname(pTHX_ const char *filespec, char *outbuf,
 
 
 	if (sts == 0) {
-	    int file_len;
+	    int haslower = 0;
+	    const char *cp;
+
+	    /* Trim off the version */
+	    int file_len = v_len + r_len + d_len + n_len + e_len;
+	    outbuf[file_len] = 0;
 
-	/* Trim off the version */
-	file_len = v_len + r_len + d_len + n_len + e_len;
-	outbuf[file_len] = 0;
+	    /* Downcase if input had any lower case letters and 
+	     * case preservation is not in effect. 
+	     */
+	    if (!decc_efs_case_preserve) {
+	        for (cp = filespec; *cp; cp++)
+	            if (islower(*cp)) { haslower = 1; break; }
+
+	        if (haslower) __mystrtolower(outbuf);
+	    }
 	}
     }
     return outbuf;