# define RTL_USES_UTC 1
#endif
+#if !defined(__VAX) && __CRTL_VER >= 80200000
+#ifdef lstat
+#undef lstat
+#endif
+#else
+#ifdef lstat
+#undef lstat
+#endif
+#define lstat(_x, _y) stat(_x, _y)
+#endif
+
/* Routine to create a decterm for use with the Perl debugger */
/* No headers, this information was found in the Programming Concepts Manual */
#if defined(PERL_IMPLICIT_CONTEXT)
if (aTHX == NULL) {
fprintf(stderr,
- "%%PERL-W-VMS_INIT Can't read CRTL environ\n");
+ "Can't read CRTL environ\n");
} else
#endif
Perl_warn(aTHX_ "Can't read CRTL environ\n");
#if defined(PERL_IMPLICIT_CONTEXT)
if (aTHX == NULL) {
fprintf(stderr,
- "%Perl-VMS-Init, Value of CLI symbol \"%s\" too long",lnm);
+ "Value of CLI symbol \"%s\" too long",lnm);
} else
#endif
if (ckWARN(WARN_MISC)) {
/* default piping mailbox size */
-#define PERL_BUFSIZ 512
+#ifdef __VAX
+# define PERL_BUFSIZ 512
+#else
+# define PERL_BUFSIZ 8192
+#endif
static void
#if defined(USE_ITHREADS)
&& my_perl
#endif
- && PL_perlio_fd_refcnt)
+#ifdef USE_PERLIO
+ && PL_perlio_fd_refcnt
+#endif
+ )
PerlIO_flush(info->fp);
else
fflush((FILE *)info->fp);
#if defined(USE_ITHREADS)
&& my_perl
#endif
- && PL_perlio_fd_refcnt)
+#ifdef USE_PERLIO
+ && PL_perlio_fd_refcnt
+#endif
+ )
PerlIO_flush(info->fp);
else
fflush((FILE *)info->fp);
#if defined(USE_ITHREADS)
&& my_perl
#endif
- && PL_perlio_fd_refcnt)
+#ifdef USE_PERLIO
+ && PL_perlio_fd_refcnt
+#endif
+ )
PerlIO_close(info->fp);
else
fclose((FILE *)info->fp);
if ((opts & PERL_RMSEXPAND_M_VMS) == 0)
#if !defined(__VAX) && defined(NAML$C_MAXRSS)
opts |= PERL_RMSEXPAND_M_LONG;
+#else
+ NOOP;
#endif
else
isunix = 0;
/* Is a long or a short name expected */
/*------------------------------------*/
spec_buf = NULL;
+#if !defined(__VAX) && defined(NAML$C_MAXRSS)
if ((opts & PERL_RMSEXPAND_M_LONG) != 0) {
if (rms_nam_rsll(mynam)) {
spec_buf = outbufl;
}
}
else {
+#endif
if (rms_nam_rsl(mynam)) {
spec_buf = outbuf;
speclen = rms_nam_rsl(mynam);
spec_buf = esa; /* Not esal */
speclen = rms_nam_esl(mynam);
}
+#if !defined(__VAX) && defined(NAML$C_MAXRSS)
}
+#endif
spec_buf[speclen] = '\0';
/* Trim off null fields added by $PARSE
}
/* Make sure we are using the right buffer */
+#if !defined(__VAX) && defined(NAML$C_MAXRSS)
if (esal != NULL) {
my_esa = esal;
my_esa_len = rms_nam_esll(dirnam);
} else {
+#endif
my_esa = esa;
my_esa_len = rms_nam_esl(dirnam);
+#if !defined(__VAX) && defined(NAML$C_MAXRSS)
}
+#endif
my_esa[my_esa_len] = '\0';
if (!rms_is_nam_fnb(dirnam, (NAM$M_EXP_DEV | NAM$M_EXP_DIR))) {
cp1 = strchr(my_esa,']');
}
if (*cp2 == ':') {
*(cp1++) = '/';
- if (*(cp2+1) == '[') cp2++;
+ if (*(cp2+1) == '[' || *(cp2+1) == '<') cp2++;
}
else if (*cp2 == ']' || *cp2 == '>') {
if (*(cp1-1) != '/') *(cp1++) = '/'; /* Don't double after ellipsis */
* special device files.
*/
- if ((add_6zero == 0) && (*nextslash == '/') &&
+ if (!islnm && (add_6zero == 0) && (*nextslash == '/') &&
(&nextslash[1] == unixend)) {
/* No real directory present */
add_6zero = 1;
vmsptr2 = vmsptr - 1;
if ((vmslen > 1) &&
(*vmsptr2 != ']') && (*vmsptr2 != '*') && (*vmsptr2 != '%') &&
- (*vmsptr2 != ')') && (*lastdot != '.')) {
+ (*vmsptr2 != ')') && (*lastdot != '.') && (*vmsptr2 != ':')) {
*vmsptr++ = '.';
vmslen++;
}
}
}
-/* If POSIX mode active, handle the conversion */
+/* If EFS charset mode active, handle the conversion */
#if __CRTL_VER >= 80200000 && !defined(__VAX)
if (decc_efs_charset) {
posix_to_vmsspec_hardway(rslt, rslt_len, path, dir_flag, utf8_flag);
/* Input from a pipe, reopen it in binary mode to disable */
/* carriage control processing. */
- fgetname(stdin, mbxname);
+ fgetname(stdin, mbxname, 1);
mbxnam.dsc$a_pointer = mbxname;
mbxnam.dsc$w_length = strlen(mbxnam.dsc$a_pointer);
lib$getdvi(&dvi_item, 0, &mbxnam, &bufsize, 0, 0);
Perl_csighandler_init();
#endif
+#if __CRTL_VER >= 70300000 && !defined(__VAX)
/* This was moved from the pre-image init handler because on threaded */
/* Perl it was always returning 0 for the default value. */
status = simple_trnlnm("SYS$POSIX_ROOT", eqv, LNM$C_NAMLENGTH);
}
}
}
-
+#endif
_ckvmssts_noperl(sys$getjpiw(0,NULL,NULL,jpilist,iosb,NULL,NULL));
_ckvmssts_noperl(iosb[0]);
/* In Unix report mode, remove the ".dir;1" from the name */
/* if it is a real directory. */
if (decc_filename_unix_report || decc_efs_charset) {
- if ((e_len == 4) && (vs_len == 2) && (vs_spec[1] == '1')) {
- if ((toupper(e_spec[1]) == 'D') &&
- (toupper(e_spec[2]) == 'I') &&
- (toupper(e_spec[3]) == 'R')) {
- Stat_t statbuf;
- int ret_sts;
-
- ret_sts = stat(buff, &statbuf.crtl_stat);
- if ((ret_sts == 0) && S_ISDIR(statbuf.st_mode)) {
- e_len = 0;
- e_spec[0] = 0;
- }
+ if (is_dir_ext(e_spec, e_len, vs_spec, vs_len)) {
+ Stat_t statbuf;
+ int ret_sts;
+
+ ret_sts = flex_lstat(buff, &statbuf);
+ if ((ret_sts == 0) && S_ISDIR(statbuf.st_mode)) {
+ e_len = 0;
+ e_spec[0] = 0;
}
}
}
int
my_fwrite(const void *src, size_t itmsz, size_t nitm, FILE *dest)
{
- register char *cp, *end, *cpd, *data;
+ register char *cp, *end, *cpd;
+ char *data;
register unsigned int fd = fileno(dest);
register unsigned int fdoff = fd / sizeof(unsigned int);
int retval;
}
/*}}}*/
+/* fgetname() is not returning the correct file specifications when
+ * decc_filename_unix_report mode is active. So we have to have it
+ * aways return filenames in VMS mode and convert it ourselves.
+ */
+
+/*{{{ char * my_fgetname(FILE *fp, buf)*/
+char *
+Perl_my_fgetname(FILE *fp, char * buf) {
+ char * retname;
+ char * vms_name;
+
+ retname = fgetname(fp, buf, 1);
+
+ /* If we are in VMS mode, then we are done */
+ if (!decc_filename_unix_report || (retname == NULL)) {
+ return retname;
+ }
+
+ /* Convert this to Unix format */
+ vms_name = PerlMem_malloc(VMS_MAXRSS + 1);
+ strcpy(vms_name, retname);
+ retname = int_tounixspec(vms_name, buf, NULL);
+ PerlMem_free(vms_name);
+
+ return retname;
+}
+/*}}}*/
+
/*
* Here are replacements for the following Unix routines in the VMS environment:
* getpwuid Get information for a particular UIC or UID
} /* end of flex_fstat() */
/*}}}*/
-#if !defined(__VAX) && __CRTL_VER >= 80200000
-#ifdef lstat
-#undef lstat
-#endif
-#else
-#ifdef lstat
-#undef lstat
-#endif
-#define lstat(_x, _y) stat(_x, _y)
-#endif
-
static int
Perl_flex_stat_int(pTHX_ const char *fspec, Stat_t *statbufp, int lstat_flag)
{
if (SvTYPE(mysv) == SVt_PVGV) {
if (!(io = GvIOp(mysv)) || !PerlIO_getname(IoIFP(io),inspec)) {
set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
- ST(0) = &PL_sv_no;
+ ST(0) = sv_2mortal(newSViv(0));
Safefree(inspec);
XSRETURN(1);
}
else {
if (mysv != ST(0) || !(inp = SvPV(mysv,n_a)) || !*inp) {
set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
- ST(0) = &PL_sv_no;
+ ST(0) = sv_2mortal(newSViv(0));
Safefree(inspec);
XSRETURN(1);
}
if (SvTYPE(mysv) == SVt_PVGV) {
if (!(io = GvIOp(mysv)) || !PerlIO_getname(IoIFP(io),outspec)) {
set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
- ST(0) = &PL_sv_no;
+ ST(0) = sv_2mortal(newSViv(0));
Safefree(inspec);
Safefree(outspec);
XSRETURN(1);
else {
if (mysv != ST(1) || !(outp = SvPV(mysv,n_a)) || !*outp) {
set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
- ST(0) = &PL_sv_no;
+ ST(0) = sv_2mortal(newSViv(0));
Safefree(inspec);
Safefree(outspec);
XSRETURN(1);
}
date_flag = (items == 3) ? SvIV(ST(2)) : 0;
- ST(0) = boolSV(rmscopy(inp,outp,date_flag));
+ ST(0) = sv_2mortal(newSViv(rmscopy(inp,outp,date_flag)));
Safefree(inspec);
Safefree(outspec);
XSRETURN(1);
int file_len = v_len + r_len + d_len + n_len + e_len;
vms_spec[file_len] = 0;
+ /* Trim off the .DIR if this is a directory */
+ if (is_dir_ext(e_spec, e_len, vs_spec, vs_len)) {
+ if (S_ISDIR(my_mode)) {
+ e_len = 0;
+ e_spec[0] = 0;
+ }
+ }
+
+ /* Drop NULL extensions on UNIX file specification */
+ if ((e_len == 1) && decc_readdir_dropdotnotype) {
+ e_len = 0;
+ e_spec[0] = '\0';
+ }
+
/* The result is expected to be in UNIX format */
rslt = int_tounixspec(vms_spec, outbuf, utf8_fl);
projects / p5sagit/p5-mst-13.2.git / blobdiff