#
# Version: see $VERSION below
# Author: Charles Bailey bailey@newman.upenn.edu
-# Revised: 08-Mar-1995
+# Revised: 30-Oct-2007
=head1 NAME
$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');
=head1 DESCRIPTION
as possible.) If an error occurs, returns C<undef> and sets C<$!>
and C<$^E>.
+C<rmsexpand> on success will produce a name that fits in a 255 byte buffer,
+which is required for parameters passed to the DCL interpreter.
+
=head2 vmsify
-Converts a file specification to VMS syntax.
+Converts a file specification to VMS syntax. If the file specification
+cannot be converted to or is already in VMS syntax, it will be
+passed through unchanged.
+
+The file specifications of C<.> and C<..> will be converted to
+C<[]> and C<[-]>.
+
+If the file specification is already in a valid VMS syntax, it will
+be passed through unchanged, except that the UTF-8 flag will be cleared
+since VMS format file specifications are never in UTF-8.
+
+When Perl is running on an OpenVMS system, if the C<DECC$EFS_CHARSET>
+feature is not enabled, extra dots in the file specification will
+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
+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
+of being converted to C<$^(abcd^)> independent of the C<DECC$EFS_CHARSET>
+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
+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
+modification of the components.
=head2 unixify
-Converts a file specification to Unix syntax.
+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
+through unchanged.
+
+When Perl is running on an OpenVMS system, the following C<DECC$> feature
+settings will control how the filename is converted:
+
+ C<decc$disable_to_vms_logname_translation:> default = C<ENABLE>
+ C<decc$disable_posix_root:> default = C<ENABLE>
+ C<decc$efs_charset:> default = C<DISABLE>
+ 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
+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.
+
+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
+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
+modification.
=head2 pathify
these restrictions may be removed in the future if the functionality of
C<candelete> becomes part of the Perl core.
+=head2 vms_case_tolerant
+
+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.
+
+=head2 vms_realpath
+
+This exposes the VMS C library C<realpath> function where available.
+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.
+
+This function is intended for use by Cwd.pm for the implementation of
+the abs_path function with support for symbolic links. It is not available
+on non-VMS systems.
+
+head2 vms_realname
+
+This uses the VMS LIB$FID_TO_NAME function to find the name of the primary
+link to a file, and returns the filename in VMS format.
+
+This function is intended for use by Cwd.pm for the implementation of
+the abs_path function with support for symbolic links. It is not available
+on non-VMS systems.
+
+
=head1 REVISION
-This document was last revised 22-Feb-1996, for Perl 5.002.
+This document was last revised 15-Nov-2007, for Perl 5.10.0
=cut
package VMS::Filespec;
require 5.002;
-our $VERSION = '1.11';
+our $VERSION = '1.12';
# If you want to use this package on a non-VMS system,
# uncomment the following line.
@ISA = qw( Exporter );
@EXPORT = qw( &vmsify &unixify &pathify &fileify
- &vmspath &unixpath &candelete &rmsexpand );
+ &vmspath &unixpath &candelete &rmsexpand &vms_case_tolerant );
1;
}
else { return (-w '[-]'); }
}
+
+sub vms_case_tolerant ($) {
+ return 0;
+}
#define do_tovmspath(a,b,c,d) mp_do_tovmspath(aTHX_ a,b,c,d)
#define do_rmsexpand(a,b,c,d,e,f,g) mp_do_rmsexpand(aTHX_ a,b,c,d,e,f,g)
#define do_vms_realpath(a,b,c) mp_do_vms_realpath(aTHX_ a,b,c)
+#define do_vms_realname(a,b,c) mp_do_vms_realname(aTHX_ a,b,c)
#define do_tounixspec(a,b,c,d) mp_do_tounixspec(aTHX_ a,b,c,d)
#define do_tounixpath(a,b,c,d) mp_do_tounixpath(aTHX_ a,b,c,d)
#define do_vms_case_tolerant(a) mp_do_vms_case_tolerant(a)
/* Unless we are forcing to VMS format, a UNIX input means
* UNIX output, and that requires long names to be used
*/
+#if !defined(__VAX) && defined(NAML$C_MAXRSS)
if ((opts & PERL_RMSEXPAND_M_VMS) == 0)
opts |= PERL_RMSEXPAND_M_LONG;
- else {
+ else
+#endif
isunix = 0;
}
}
- }
rms_set_fna(myfab, mynam, (char *)filespec, strlen(filespec)); /* cast ok */
rms_bind_fab_nam(myfab, mynam);
return 0;
}
- esa = PerlMem_malloc(NAM$C_MAXRSS + 1);
+ esa = PerlMem_malloc(VMS_MAXRSS);
if (esa == NULL) _ckvmssts(SS$_INSFMEM);
esal = NULL;
#if !defined(__VAX) && defined(NAML$C_MAXRSS)
rms_bind_fab_nam(fab_in, nam);
fab_in.fab$l_xab = (void *) &xabdat;
- rsa = PerlMem_malloc(NAML$C_MAXRSS);
+ rsa = PerlMem_malloc(VMS_MAXRSS);
if (rsa == NULL) _ckvmssts(SS$_INSFMEM);
rsal = NULL;
#if !defined(__VAX) && defined(NAML$C_MAXRSS)
}
-#ifdef HAS_SYMLINK
static char *
mp_do_vms_realpath(pTHX_ const char *filespec, char * rslt_spec,
int *utf8_fl);
XSRETURN(1);
}
+static char *
+mp_do_vms_realname(pTHX_ const char *filespec, char * rslt_spec,
+ int *utf8_fl);
+
+void
+vms_realname_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)");
+
+ fspec = SvPV(ST(0),n_a);
+ if (!fspec || !*fspec) XSRETURN_UNDEF;
+
+ Newx(rslt_spec, VMS_MAXRSS + 1, char);
+ rslt = do_vms_realname(fspec, rslt_spec, NULL);
+
+ ST(0) = sv_newmortal();
+ if (rslt != NULL)
+ sv_usepvn(ST(0),rslt,strlen(rslt));
+ else
+ Safefree(rslt_spec);
+ XSRETURN(1);
+}
+
+#ifdef HAS_SYMLINK
/*
* A thin wrapper around decc$symlink to make sure we follow the
* standard and do not create a symlink with a zero-length name.
#endif /* HAS_SYMLINK */
-#if __CRTL_VER >= 70301000 && !defined(__VAX)
int do_vms_case_tolerant(void);
void
ST(0) = boolSV(do_vms_case_tolerant());
XSRETURN(1);
}
-#endif
void
Perl_sys_intern_dup(pTHX_ struct interp_intern *src,
newXSproto("DynaLoader::mod2fname", mod2fname, file, "$");
newXS("File::Copy::rmscopy",rmscopy_fromperl,file);
newXSproto("vmsish::hushed",hushexit_fromperl,file,";$");
-#ifdef HAS_SYMLINK
newXSproto("VMS::Filespec::vms_realpath",vms_realpath_fromperl,file,"$;$");
-#endif
-#if __CRTL_VER >= 70301000 && !defined(__VAX)
+ newXSproto("VMS::Filespec::vms_realname",vms_realname_fromperl,file,"$;$");
newXSproto("VMS::Filepec::vms_case_tolerant",
vms_case_tolerant_fromperl, file, "$");
-#endif
store_pipelocs(aTHX); /* will redo any earlier attempts */
return;
}
-#ifdef HAS_SYMLINK
-
#if __CRTL_VER == 80200000
/* This missed getting in to the DECC SDK for 8.2 */
char *realpath(const char *file_name, char * resolved_name, ...);
{
struct statbuf_t {
char * st_dev;
- __ino16_t st_ino[3];
+ unsigned short st_ino[3];
unsigned short padw;
unsigned long padl[30]; /* plenty of room */
} statbuf;
{
char * rslt = NULL;
- if (decc_posix_compliant_pathnames)
+#ifdef HAS_SYMLINK
+ if (decc_posix_compliant_pathnames > 0 ) {
+ /* realpath currently only works if posix compliant pathnames are
+ * enabled. It may start working when they are not, but in that
+ * case we still want the fallback behavior for backwards compatibility
+ */
rslt = realpath(filespec, outbuf);
+ }
+#endif
if (rslt == NULL) {
char * vms_spec;
return rslt;
}
+static char *
+mp_do_vms_realname(pTHX_ const char *filespec, char *outbuf,
+ int *utf8_fl)
+{
+ char * v_spec, * r_spec, * d_spec, * n_spec, * e_spec, * vs_spec;
+ int sts, v_len, r_len, d_len, n_len, e_len, vs_len;
+ int file_len;
+
+ /* Fall back to fid_to_name */
+
+ sts = vms_fid_to_name(outbuf, VMS_MAXRSS + 1, filespec);
+ if (sts == 0) {
+
+
+ /* Now need to trim the version off */
+ sts = vms_split_path
+ (outbuf,
+ &v_spec,
+ &v_len,
+ &r_spec,
+ &r_len,
+ &d_spec,
+ &d_len,
+ &n_spec,
+ &n_len,
+ &e_spec,
+ &e_len,
+ &vs_spec,
+ &vs_len);
+
+
+ if (sts == 0) {
+ int file_len;
+
+ /* Trim off the version */
+ file_len = v_len + r_len + d_len + n_len + e_len;
+ outbuf[file_len] = 0;
+ }
+ }
+ return outbuf;
+}
+
+
/*}}}*/
/* External entry points */
char *Perl_vms_realpath(pTHX_ const char *filespec, char *outbuf, int *utf8_fl)
{ return do_vms_realpath(filespec, outbuf, utf8_fl); }
-#else
-char *Perl_vms_realpath(pTHX_ const char *filespec, char *outbuf, int *utf8_fl)
-{ return NULL; }
-#endif
+char *Perl_vms_realname(pTHX_ const char *filespec, char *outbuf, int *utf8_fl)
+{ return do_vms_realname(filespec, outbuf, utf8_fl); }
-#if __CRTL_VER >= 70301000 && !defined(__VAX)
/* case_tolerant */
/*{{{int do_vms_case_tolerant(void)*/
}
/*}}}*/
/* External entry points */
+#if __CRTL_VER >= 70301000 && !defined(__VAX)
int Perl_vms_case_tolerant(void)
{ return do_vms_case_tolerant(); }
#else
projects / p5sagit/p5-mst-13.2.git / commitdiff