static char *int_tovmsspec
(const char *path, char *buf, int dir_flag, int * utf8_flag);
+static char * int_tounixspec(const char *spec, char *buf, int * utf8_fl);
/* see system service docs for $TRNLNM -- NOT the same as LNM$_MAX_INDEX */
#define PERL_LNM_MAX_ALLOWED_INDEX 127
fclose(fp);
if (decc_filename_unix_only)
- do_tounixspec(file, file, 0, NULL);
+ int_tounixspec(file, file, NULL);
fp = fopen(file,"r","shr=get");
if (!fp) return 0;
fstat(fileno(fp), (struct stat *)&s1);
}
if (!rsl) {
if (isunix) {
- if (do_tounixspec(tbuf, outbuf ,0 , fs_utf8) == NULL) {
+ if (int_tounixspec(tbuf, outbuf, fs_utf8) == NULL) {
if (out) Safefree(out);
if (esal != NULL)
PerlMem_free(esal);
else if (isunix) {
tmpfspec = PerlMem_malloc(VMS_MAXRSS);
if (tmpfspec == NULL) _ckvmssts_noperl(SS$_INSFMEM);
- if (do_tounixspec(tbuf,tmpfspec,0,fs_utf8) == NULL) {
+ if (int_tounixspec(tbuf, tmpfspec, fs_utf8) == NULL) {
if (out) Safefree(out);
PerlMem_free(esa);
if (esal != NULL)
PerlMem_free(vmsdir);
return NULL;
}
- ret_chr = do_tounixspec(trndir,buf,ts,NULL);
+ ret_chr = int_tounixspec(trndir, buf, utf8_fl);
PerlMem_free(trndir);
PerlMem_free(vmsdir);
return ret_chr;
PerlMem_free(vmsdir);
return NULL;
}
- ret_chr = do_tounixspec(trndir,buf,ts,NULL);
+ ret_chr = int_tounixspec(trndir, buf, utf8_fl);
PerlMem_free(trndir);
PerlMem_free(vmsdir);
return ret_chr;
char *Perl_pathify_dirspec_utf8_ts(pTHX_ const char *dir, char *buf, int *utf8_fl)
{ return do_pathify_dirspec(dir,buf,1,utf8_fl); }
-/*{{{ char *tounixspec[_ts](char *spec, char *buf, int *)*/
-static char *mp_do_tounixspec(pTHX_ const char *spec, char *buf, int ts, int * utf8_fl)
+/* Internal tounixspec routine that does not use a thread context */
+/*{{{ char *int_tounixspec[_ts](char *spec, char *buf, int *)*/
+static char *int_tounixspec(const char *spec, char *rslt, int * utf8_fl)
{
- static char __tounixspec_retbuf[VMS_MAXRSS];
- char *dirend, *rslt, *cp1, *cp3, *tmp;
+ char *dirend, *cp1, *cp3, *tmp;
const char *cp2;
int devlen, dirlen, retlen = VMS_MAXRSS;
int expand = 1; /* guarantee room for leading and trailing slashes */
if (utf8_fl != NULL)
*utf8_fl = 0;
- if (spec == NULL) return NULL;
- if (strlen(spec) > (VMS_MAXRSS-1)) return NULL;
- if (buf) rslt = buf;
- else if (ts) {
- Newx(rslt, VMS_MAXRSS, char);
+ if (vms_debug_fileify) {
+ if (spec == NULL)
+ fprintf(stderr, "int_tounixspec: spec = NULL\n");
+ else
+ fprintf(stderr, "int_tounixspec: spec = %s\n", spec);
+ }
+
+
+ if (spec == NULL) {
+ set_errno(EINVAL);
+ set_vaxc_errno(SS$_BADPARAM);
+ return NULL;
+ }
+ if (strlen(spec) > (VMS_MAXRSS-1)) {
+ set_errno(E2BIG);
+ set_vaxc_errno(SS$_BUFFEROVF);
+ return NULL;
}
- else rslt = __tounixspec_retbuf;
/* New VMS specific format needs translation
* glob passes filenames with trailing '\n' and expects this preserved.
/* This is already UNIX or at least nothing VMS understands */
if (cmp_rslt) {
strcpy(rslt,spec);
+ if (vms_debug_fileify) {
+ fprintf(stderr, "int_tounixspec: rslt = %s\n", rslt);
+ }
return rslt;
}
if (dirend == NULL) dirend = strchr(spec,':');
if (dirend == NULL) {
strcpy(rslt,spec);
+ if (vms_debug_fileify) {
+ fprintf(stderr, "int_tounixspec: rslt = %s\n", rslt);
+ }
return rslt;
}
}
else if ( *cp2 != '^' && *cp2 != '.' && *cp2 != '-') { /* add the implied device */
if (getcwd(tmp, VMS_MAXRSS-1 ,1) == NULL) {
- if (ts) Safefree(rslt);
PerlMem_free(tmp);
+ if (vms_debug_fileify) {
+ fprintf(stderr, "int_tounixspec: rslt = NULL\n");
+ }
return NULL;
}
trnlnm_iter_count = 0;
trnlnm_iter_count++;
if (trnlnm_iter_count >= PERL_LNM_MAX_ITER+1) break;
} while (vmstrnenv(tmp,tmp,0,fildev,0));
- if (ts && !buf &&
- ((devlen = strlen(tmp)) + (dirlen = strlen(cp2)) + 1 > retlen)) {
- retlen = devlen + dirlen;
- Renew(rslt,retlen+1+2*expand,char);
- cp1 = rslt;
- }
+ cp1 = rslt;
cp3 = tmp;
*(cp1++) = '/';
while (*cp3) {
*(cp1++) = *(cp3++);
- if (cp1 - rslt > (VMS_MAXRSS - 1) && !ts && !buf) {
+ if (cp1 - rslt > (VMS_MAXRSS - 1)) {
PerlMem_free(tmp);
+ set_errno(ENAMETOOLONG);
+ set_vaxc_errno(SS$_BUFFEROVF);
+ if (vms_debug_fileify) {
+ fprintf(stderr, "int_tounixspec: rslt = NULL\n");
+ }
return NULL; /* No room */
}
}
*(cp1++) = '.'; *(cp1++) = '.'; *(cp1++) = '/';
}
if (*cp2 != '.' && *cp2 != ']' && *cp2 != '>') { /* we don't allow */
- if (ts) Safefree(rslt); /* filespecs like */
+ /* filespecs like */
set_errno(EINVAL); set_vaxc_errno(RMS$_SYN); /* [fred.--foo.bar] */
+ if (vms_debug_fileify) {
+ fprintf(stderr, "int_tounixspec: rslt = NULL\n");
+ }
return NULL;
}
}
}
else *(cp1++) = *cp2;
}
+ /* Translate the rest of the filename. */
while (*cp2) {
- if ((*cp2 == '^') && (*(cp2+1) == '.')) cp2++; /* '^.' --> '.' */
- *(cp1++) = *(cp2++);
+ int dot_seen;
+ dot_seen = 0;
+ switch(*cp2) {
+ /* Fixme - for compatibility with the CRTL we should be removing */
+ /* spaces from the file specifications, but this may show that */
+ /* some tests that were appearing to pass are not really passing */
+ case '%':
+ cp2++;
+ *(cp1++) = '?';
+ break;
+ case '^':
+ /* Fix me hex expansions not implemented */
+ cp2++; /* '^.' --> '.' and other. */
+ if (*cp2) {
+ if (*cp2 == '_') {
+ cp2++;
+ *(cp1++) = ' ';
+ } else {
+ *(cp1++) = *(cp2++);
+ }
+ }
+ break;
+ case ';':
+ if (decc_filename_unix_no_version) {
+ /* Easy, drop the version */
+ while (*cp2)
+ cp2++;
+ break;
+ } else {
+ /* Punt - passing the version as a dot will probably */
+ /* break perl in weird ways, but so did passing */
+ /* through the ; as a version. Follow the CRTL and */
+ /* hope for the best. */
+ cp2++;
+ *(cp1++) = '.';
+ }
+ break;
+ case '.':
+ if (dot_seen) {
+ /* We will need to fix this properly later */
+ /* As Perl may be installed on an ODS-5 volume, but not */
+ /* have the EFS_CHARSET enabled, it still may encounter */
+ /* filenames with extra dots in them, and a precedent got */
+ /* set which allowed them to work, that we will uphold here */
+ /* If extra dots are present in a name and no ^ is on them */
+ /* VMS assumes that the first one is the extension delimiter */
+ /* the rest have an implied ^. */
+
+ /* this is also a conflict as the . is also a version */
+ /* delimiter in VMS, */
+
+ *(cp1++) = *(cp2++);
+ break;
+ }
+ dot_seen = 1;
+ /* This is an extension */
+ if (decc_readdir_dropdotnotype) {
+ cp2++;
+ if ((!*cp2) || (*cp2 == ';') || (*cp2 == '.')) {
+ /* Drop the dot for the extension */
+ break;
+ } else {
+ *(cp1++) = '.';
+ }
+ break;
+ }
+ default:
+ *(cp1++) = *(cp2++);
+ }
}
*cp1 = '\0';
}
}
+ if (vms_debug_fileify) {
+ fprintf(stderr, "int_tounixspec: rslt = %s\n", rslt);
+ }
return rslt;
+} /* end of int_tounixspec() */
+
+
+/*{{{ char *tounixspec[_ts](char *spec, char *buf, int *)*/
+static char *mp_do_tounixspec(pTHX_ const char *spec, char *buf, int ts, int * utf8_fl)
+{
+ static char __tounixspec_retbuf[VMS_MAXRSS];
+ char * unixspec, *ret_spec, *ret_buf;
+
+ unixspec = NULL;
+ ret_buf = buf;
+ if (ret_buf == NULL) {
+ if (ts) {
+ Newx(unixspec, VMS_MAXRSS, char);
+ if (unixspec == NULL)
+ _ckvmssts(SS$_INSFMEM);
+ ret_buf = unixspec;
+ } else {
+ ret_buf = __tounixspec_retbuf;
+ }
+ }
+
+ ret_spec = int_tounixspec(spec, ret_buf, utf8_fl);
+
+ if (ret_spec == NULL) {
+ /* Cleanup on isle 5, if this is thread specific we need to deallocate */
+ if (unixspec)
+ Safefree(unixspec);
+ }
+
+ return ret_spec;
+
} /* end of do_tounixspec() */
/*}}}*/
/* External entry points */
if (unixwild == NULL) _ckvmssts_noperl(SS$_INSFMEM);
template = unixwild;
if (strpbrk(wildspec,"]>:") != NULL) {
- if (do_tounixspec(wildspec,unixwild,0,NULL) == NULL) {
+ if (int_tounixspec(wildspec, unixwild, NULL) == NULL) {
PerlMem_free(unixwild);
return 0;
}
unixified = PerlMem_malloc(VMS_MAXRSS);
if (unixified == NULL) _ckvmssts_noperl(SS$_INSFMEM);
if (strpbrk(fspec,"]>:") != NULL) {
- if (do_tounixspec(fspec,unixified,0,NULL) == NULL) {
+ if (int_tounixspec(fspec, unixified, NULL) == NULL) {
PerlMem_free(unixwild);
PerlMem_free(unixified);
return 0;
/* the conversion in in ODS-2 mode */
Newx(utarget, VMS_MAXRSS + 1, char);
- if (do_tounixspec(contents, utarget, 0, NULL) == NULL) {
+ if (int_tounixspec(contents, utarget, NULL) == NULL) {
/* This should not fail, as an untranslatable filename */
/* should be passed through */
vms_spec[file_len] = 0;
/* The result is expected to be in UNIX format */
- rslt = do_tounixspec(vms_spec, outbuf, 0, utf8_fl);
+ rslt = int_tounixspec(vms_spec, outbuf, utf8_fl);
/* Downcase if input had any lower case letters and
* case preservation is not in effect.
projects / platform / upstream / perl.git / commitdiff