/* doio.c
*
- * Copyright (c) 1991-2000, Larry Wall
+ * Copyright (c) 1991-2001, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
Perl_do_open(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
int rawmode, int rawperm, PerlIO *supplied_fp)
{
- return do_open9(gv, name, len, as_raw, rawmode, rawperm,
- supplied_fp, Nullsv, 0);
+ return do_openn(gv, name, len, as_raw, rawmode, rawperm,
+ supplied_fp, (SV **) NULL, 0);
}
bool
int rawmode, int rawperm, PerlIO *supplied_fp, SV *svs,
I32 num_svs)
{
+ return do_openn(gv, name, len, as_raw, rawmode, rawperm,
+ supplied_fp, &svs, 1);
+}
+
+bool
+Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
+ int rawmode, int rawperm, PerlIO *supplied_fp, SV **svp,
+ I32 num_svs)
+{
register IO *io = GvIOn(gv);
PerlIO *saveifp = Nullfp;
PerlIO *saveofp = Nullfp;
char *type = NULL;
char *deftype = NULL;
char mode[4]; /* stdio file mode ("r\0", "rb\0", "r+b\0" etc.) */
+ SV *svs = (num_svs) ? *svp : Nullsv;
Zero(mode,sizeof(mode),char);
PL_forkprocess = 1; /* assume true if no fork */
SV *sv;
PerlLIO_dup2(PerlIO_fileno(fp), fd);
+#ifdef VMS
+ if (fd != PerlIO_fileno(PerlIO_stdin())) {
+ char newname[FILENAME_MAX+1];
+ if (fgetname(fp, newname)) {
+ if (fd == PerlIO_fileno(PerlIO_stdout())) Perl_vmssetuserlnm("SYS$OUTPUT", newname);
+ if (fd == PerlIO_fileno(PerlIO_stderr())) Perl_vmssetuserlnm("SYS$ERROR", newname);
+ }
+ }
+#endif
LOCK_FDPID_MUTEX;
sv = *av_fetch(PL_fdpid,PerlIO_fileno(fp),TRUE);
(void)SvUPGRADE(sv, SVt_IV);
if (type) {
while (isSPACE(*type)) type++;
if (*type) {
+ errno = 0;
if (PerlIO_apply_layers(aTHX_ IoIFP(io),mode,type) != 0) {
goto say_false;
}
/* FALL THROUGH */
default:
if (PerlIO_isutf8(fp)) {
- tmps = SvPVutf8(sv, len);
- }
- else {
- if (DO_UTF8(sv))
- sv_utf8_downgrade(sv, FALSE);
- tmps = SvPV(sv, len);
+ if (!SvUTF8(sv))
+ sv_utf8_upgrade(sv = sv_mortalcopy(sv));
}
+ else if (DO_UTF8(sv))
+ sv_utf8_downgrade((sv = sv_mortalcopy(sv)), FALSE);
+ tmps = SvPV(sv, len);
break;
}
/* To detect whether the process is about to overstep its