X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_sys.c;h=aa8fb77acc0afce198330b0f81b6377711069706;hb=80a5d8e74b5512d4ab704d0e83466ae41247ce55;hp=6ed8e0a35070e68ca93e8c3f6260235042865e9f;hpb=004283b80f6094bb85aba6f48a74e3c5c34ea24f;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp_sys.c b/pp_sys.c
index 6ed8e0a..aa8fb77 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -3747,17 +3747,39 @@ PP(pp_open_dir)
     dSP;
     STRLEN n_a;
     char *dirname = POPpx;
-    GV *gv = (GV*)POPs;
-    register IO *io = GvIOn(gv);
+    char *dscp = NULL;
+    GV *gv;
+    register IO *io;
+    bool want_utf8 = FALSE;
+
+    if (MAXARG == 3)
+	 dscp = POPpx;
+
+    gv = (GV*)POPs;
+    io = GvIOn(gv);
 
     if (!io)
 	goto nope;
 
+    if (dscp) {
+	 if (*dscp == ':') {
+	      if (strnEQ(dscp + 1, "utf8", 4))
+		  want_utf8 = TRUE;
+	      else
+		   Perl_croak(aTHX_ "Unknown discipline '%s'", dscp);
+	 }
+	 else
+	      Perl_croak(aTHX_ "Unknown discipline '%s'", dscp);
+    }
+
     if (IoDIRP(io))
 	PerlDir_close(IoDIRP(io));
     if (!(IoDIRP(io) = PerlDir_open(dirname)))
 	goto nope;
 
+    if (want_utf8)
+        IoFLAGS(io) |= IOf_DIR_UTF8;
+
     RETPUSHYES;
 nope:
     if (!errno)
@@ -3795,6 +3817,8 @@ PP(pp_readdir)
 	    if (!(IoFLAGS(io) & IOf_UNTAINT))
 		SvTAINTED_on(sv);
 #endif
+	    if (IoFLAGS(io) & IOf_DIR_UTF8 && !IN_BYTES)
+	        SvUTF8_on(sv);
 	    XPUSHs(sv_2mortal(sv));
 	}
     }
@@ -3810,6 +3834,8 @@ PP(pp_readdir)
 	if (!(IoFLAGS(io) & IOf_UNTAINT))
 	    SvTAINTED_on(sv);
 #endif
+	if (IoFLAGS(io) & IOf_DIR_UTF8)
+	    sv_utf8_upgrade(sv);
 	XPUSHs(sv_2mortal(sv));
     }
     RETURN;