diff options
Diffstat (limited to 'vms/ext/Stdio/Stdio.xs')
| -rw-r--r-- | vms/ext/Stdio/Stdio.xs | 69 |
1 files changed, 61 insertions, 8 deletions
diff --git a/vms/ext/Stdio/Stdio.xs b/vms/ext/Stdio/Stdio.xs index 6fa1b29bbe..22d9a7262c 100644 --- a/vms/ext/Stdio/Stdio.xs +++ b/vms/ext/Stdio/Stdio.xs @@ -1,8 +1,8 @@ /* VMS::Stdio - VMS extensions to stdio routines * - * Version: 2.1 - * Author: Charles Bailey bailey@genetics.upenn.edu - * Revised: 24-Mar-1998 + * Version: 2.2 + * Author: Charles Bailey bailey@newman.upenn.edu + * Revised: 18-Jul-1998 * */ @@ -125,6 +125,57 @@ constant(name) ST(0) = &PL_sv_undef; void +binmode(fh) + SV * fh + PROTOTYPE: $ + CODE: + IO *io = sv_2io(fh); + FILE *fp = io ? IoOFP(io) : NULL; + char iotype = io ? IoTYPE(io) : '\0'; + char filespec[NAM$C_MAXRSS], *acmode, *s, *colon, *dirend = Nullch; + int ret = 0, saverrno = errno, savevmserrno = vaxc$errno; + fpos_t pos; + if (fp == NULL || strchr(">was+-|",iotype) == Nullch) { + set_errno(EBADF); set_vaxc_errno(SS$_IVCHAN); XSRETURN_UNDEF; + } + if (!fgetname(fp,filespec)) XSRETURN_UNDEF; + for (s = filespec; *s; s++) { + if (*s == ':') colon = s; + else if (*s == ']' || *s == '>') dirend = s; + } + /* Looks like a tmpfile, which will go away if reopened */ + if (s == dirend + 3) { + set_errno(EBADF); set_vaxc_errno(RMS$_IOP); XSRETURN_UNDEF; + } + /* If we've got a non-file-structured device, clip off the trailing + * junk, and don't lose sleep if we can't get a stream position. */ + if (dirend == Nullch) *(colon+1) = '\0'; + if (iotype != '-' && (ret = fgetpos(fp, &pos)) == -1 && dirend) + XSRETURN_UNDEF; + switch (iotype) { + case '<': case 'r': acmode = "rb"; break; + case '>': case 'w': case '|': + /* use 'a' instead of 'w' to avoid creating new file; + fsetpos below will take care of restoring file position */ + case 'a': acmode = "ab"; break; + case '+': case 's': acmode = "rb+"; break; + case '-': acmode = fileno(fp) ? "ab" : "rb"; break; + /* iotype'll be null for the SYS$INPUT:/SYS$OUTPUT:/SYS$ERROR: files */ + /* since we didn't really open them and can't really */ + /* reopen them */ + case 0: XSRETURN_UNDEF; + default: + if (PL_dowarn) warn("Unrecognized iotype %c for %s in binmode", + iotype, filespec); + acmode = "rb+"; + } + if (freopen(filespec,acmode,fp) == NULL) XSRETURN_UNDEF; + if (iotype != '-' && ret != -1 && fsetpos(fp,&pos) == -1) XSRETURN_UNDEF; + if (ret == -1) { set_errno(saverrno); set_vaxc_errno(savevmserrno); } + XSRETURN_YES; + + +void flush(fp) FILE * fp PROTOTYPE: $ @@ -164,11 +215,12 @@ setdef(...) struct FAB deffab = cc$rms_fab; struct NAM defnam = cc$rms_nam; struct dsc$descriptor_s dirdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0}; + STRLEN n_a; if (items) { SV *defsv = ST(items-1); /* mimic chdir() */ ST(0) = &PL_sv_undef; if (!SvPOK(defsv)) { SETERRNO(EINVAL,LIB$_INVARG); XSRETURN(1); } - if (tovmsspec(SvPV(defsv,PL_na),vmsdef) == NULL) { XSRETURN(1); } + if (tovmsspec(SvPV(defsv,n_a),vmsdef) == NULL) { XSRETURN(1); } deffab.fab$l_fna = vmsdef; deffab.fab$b_fns = strlen(vmsdef); } else { @@ -232,6 +284,7 @@ vmsopen(spec,...) char *args[8],mode[3] = {'r','\0','\0'}, type = '<'; register int i, myargc; FILE *fp; + STRLEN n_a; if (!spec || !*spec) { SETERRNO(EINVAL,LIB$_INVARG); @@ -250,7 +303,7 @@ vmsopen(spec,...) } else if (*spec == '<') spec++; myargc = items - 1; - for (i = 0; i < myargc; i++) args[i] = SvPV(ST(i+1),PL_na); + for (i = 0; i < myargc; i++) args[i] = SvPV(ST(i+1),n_a); /* This hack brought to you by C's opaque arglist management */ switch (myargc) { case 0: @@ -298,13 +351,14 @@ vmssysopen(spec,mode,perm,...) int i, myargc, fd; FILE *fp; SV *fh; + STRLEN n_a; if (!spec || !*spec) { SETERRNO(EINVAL,LIB$_INVARG); XSRETURN_UNDEF; } if (items > 11) croak("too many args"); myargc = items - 3; - for (i = 0; i < myargc; i++) args[i] = SvPV(ST(i+3),PL_na); + for (i = 0; i < myargc; i++) args[i] = SvPV(ST(i+3),n_a); /* More fun with C calls; can't combine with above because args 2,3 of different types in fopen() and open() */ switch (myargc) { @@ -362,8 +416,7 @@ writeof(mysv) IO *io = sv_2io(mysv); FILE *fp = io ? IoOFP(io) : NULL; if (fp == NULL || strchr(">was+-|",IoTYPE(io)) == Nullch) { - set_errno(EBADF); set_vaxc_errno(SS$_IVCHAN); - ST(0) = &PL_sv_undef; XSRETURN(1); + set_errno(EBADF); set_vaxc_errno(SS$_IVCHAN); XSRETURN_UNDEF; } if (fgetname(fp,devnam) == Nullch) { ST(0) = &PL_sv_undef; XSRETURN(1); } if ((cp = strrchr(devnam,':')) != NULL) *(cp+1) = '\0'; |