With a future VMS version, a new type of file specification is valid for
most places that will only take a traditional VMS file specification.
This is one of "^UP^posix/pathname/file", where there is a real "/"
designated on VMS with mount points and symbolic links that are
processed according to POSIX rules.
As the parsing issues with it are different, that format can not be used
on routines that also accept related and default specifications.
So to make sure that the DL_VMS routine works as expected even if
receives one of these file specifications, file name argument is forced
into a traditional VMS specification for the same file.
I also fixed known caller of this routine to only pass it a traditional
VMS file specification, so this patch is more of belt and suspenders,
both to make it more robust, and an example of something that other VMS
specific extensions may need to do.
-John
[EMAIL PROTECTED]
Personal Opinion Only
--- ext/Dynaloader/dl_vms.xs_5_8_6 Mon Mar 28 14:45:58 2005
+++ ext/Dynaloader/dl_vms.xs Mon Mar 28 14:46:22 2005
@@ -257,6 +257,7 @@
SV *reqSV, **reqSVhndl;
STRLEN deflen;
struct dsc$descriptor_s
+ dvidsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0},
specdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0},
symdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
struct fscnlst {
@@ -272,6 +273,28 @@
DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n",
filespec,flags));
specdsc.dsc$a_pointer = tovmsspec(filespec,vmsspec);
specdsc.dsc$w_length = strlen(specdsc.dsc$a_pointer);
+ dl_fab.fab$l_fna = specdsc.dsc$a_pointer;
+ dl_fab.fab$b_fns = specdsc.dsc$w_length;
+ dl_fab.fab$l_dna = 0;
+ dl_fab.fab$b_dns = 0;
+
+ /* Convert a POSIX file specification to a normal VMS specification */
+ sts = sys$parse(&dl_fab);
+ if (!(sts & 1)) {
+ failed = 1;
+ dl_set_error(sts,0);
+ }
+ sts = sys$search(&dl_fab);
+ if (!(sts & 1)) {
+ failed = 1;
+ dl_set_error(sts,0);
+ }
+ dvidsc.dsc$a_pointer = &dl_nam.nam$t_dvi[1];
+ dvidsc.dsc$w_length = dl_nam.nam$t_dvi[0];
+ specdsc.dsc$w_length = NAM$C_MAXRSS;
+ sts = lib$fid_to_name
+ (&dvidsc, dl_nam.nam$w_fid, &specdsc, &specdsc.dsc$w_length);
+
DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tVMS-ified filespec is %s\n",
specdsc.dsc$a_pointer));
New(1399,dlptr,1,struct libref);
