X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=doio.c;h=462c8841b84858a8d613cb9a7c4e19861517f187;hb=dd570ea6ed120327ae1b94a6071154a927352720;hp=d0d28b026c1d204234ace041946c8c7c1abc13e5;hpb=248ff010a9f14ea43c69a11c0242d8e9e015163d;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/doio.c b/doio.c
index d0d28b0..462c884 100644
--- a/doio.c
+++ b/doio.c
@@ -158,45 +158,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 	rawmode |= O_LARGEFILE;	/* Transparently largefiley. */
 #endif
 
-#ifndef O_ACCMODE
-#define O_ACCMODE 3		/* Assume traditional implementation */
-#endif
-
-	switch (result = rawmode & O_ACCMODE) {
-	case O_RDONLY:
-	     IoTYPE(io) = IoTYPE_RDONLY;
-	     break;
-	case O_WRONLY:
-	     IoTYPE(io) = IoTYPE_WRONLY;
-	     break;
-	case O_RDWR:
-	default:
-	     IoTYPE(io) = IoTYPE_RDWR;
-	     break;
-	}
-	writing = (result > 0);
-
-	if (result == O_RDONLY) {
-	    mode[ix++] = 'r';
-	}
-#ifdef O_APPEND
-	else if (rawmode & O_APPEND) {
-	    mode[ix++] = 'a';
-	    if (result != O_WRONLY)
-		mode[ix++] = '+';
-	}
-#endif
-	else {
-	    if (result == O_WRONLY)
-		mode[ix++] = 'w';
-	    else {
-		mode[ix++] = 'r';
-		mode[ix++] = '+';
-	    }
-	}
-	if (rawmode & O_BINARY)
-	    mode[ix++] = 'b';
-	mode[ix] = '\0';
+        IoTYPE(io) = PerlIO_intmode2str(rawmode, &mode[ix], &writing);
 
 	namesv = sv_2mortal(newSVpvn(name,strlen(name)));
 	num_svs = 1;
@@ -235,6 +197,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 	if ((*type == IoTYPE_RDWR) && /* scary */
            (*(type+1) == IoTYPE_RDONLY || *(type+1) == IoTYPE_WRONLY) &&
 	    ((!num_svs || (tend > type+1 && tend[-1] != IoTYPE_PIPE)))) {
+        TAINT_PROPER("open");
 	    mode[1] = *type++;
 	    writing = 1;
 	}
@@ -1221,7 +1184,9 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp)
 		sv_utf8_upgrade(sv = sv_mortalcopy(sv));
 	}
 	else if (DO_UTF8(sv)) {
-	    if (!sv_utf8_downgrade((sv = sv_mortalcopy(sv)), TRUE)) {
+	    if (!sv_utf8_downgrade((sv = sv_mortalcopy(sv)), TRUE)
+		&& ckWARN(WARN_UTF8))
+	    {
 		Perl_warner(aTHX_ WARN_UTF8, "Wide character in print");
 	    }
 	}
@@ -1690,7 +1655,7 @@ nothing in the core.
 
            if ( accessed == &PL_sv_undef && modified == &PL_sv_undef )
              utbufp = NULL;
-           
+
 	    Zero(&utbuf, sizeof utbuf, char);
 #ifdef BIG_TIME
            utbuf.actime = (Time_t)SvNVx(accessed);     /* time accessed */
@@ -2192,6 +2157,8 @@ Perl_start_glob (pTHX_ SV *tmpglob, IO *io)
 		ok = ((wilddsc.dsc$a_pointer = tovmspath(SvPVX(tmpglob),vmsspec)) != NULL);
 	    else ok = ((wilddsc.dsc$a_pointer = tovmsspec(SvPVX(tmpglob),vmsspec)) != NULL);
 	    if (ok) wilddsc.dsc$w_length = (unsigned short int) strlen(wilddsc.dsc$a_pointer);
+	    for (cp=wilddsc.dsc$a_pointer; ok && cp && *cp; cp++)
+		if (*cp == '?') *cp = '%';  /* VMS style single-char wildcard */
 	    while (ok && ((sts = lib$find_file(&wilddsc,&rsdsc,&cxt,
 					       &dfltdsc,NULL,NULL,NULL))&1)) {
 		end = rstr + (unsigned long int) *rslt;