add sv_string_from_errnum()

This is a new API function, partly substituting for the my_strerror()
that was recently removed from the public API, but also incorporating
the decoding work that's done for $!.

4 files changed, 54 insertions, 7 deletions

diff --git a/embed.fnc b/embed.fnc
index b68484b1c6..aa3a623ab5 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1029,6 +1029,7 @@ Apd	|int	|mg_copy	|NN SV *sv|NN SV *nsv|NULLOK const char *key \
 				|I32 klen
 : Defined in mg.c, used only in scope.c
 pd	|void	|mg_localize	|NN SV* sv|NN SV* nsv|bool setmagic
+Apd	|SV*	|sv_string_from_errnum|int errnum|NULLOK SV* tgtsv
 ApdRn	|MAGIC*	|mg_find	|NULLOK const SV* sv|int type
 ApdRn	|MAGIC*	|mg_findext	|NULLOK const SV* sv|int type|NULLOK const MGVTBL *vtbl
 : exported for re.pm
diff --git a/embed.h b/embed.h
index 9d2d1b2ca9..31a9852e16 100644
--- a/embed.h
+++ b/embed.h
@@ -693,6 +693,7 @@
 #define sv_setsv_mg(a,b)	Perl_sv_setsv_mg(aTHX_ a,b)
 #define sv_setuv(a,b)		Perl_sv_setuv(aTHX_ a,b)
 #define sv_setuv_mg(a,b)	Perl_sv_setuv_mg(aTHX_ a,b)
+#define sv_string_from_errnum(a,b)	Perl_sv_string_from_errnum(aTHX_ a,b)
 #define sv_tainted(a)		Perl_sv_tainted(aTHX_ a)
 #define sv_true(a)		Perl_sv_true(aTHX_ a)
 #define sv_uni_display(a,b,c,d)	Perl_sv_uni_display(aTHX_ a,b,c,d)
diff --git a/mg.c b/mg.c
index 3d08df680e..e0d1215281 100644
--- a/mg.c
+++ b/mg.c
@@ -810,6 +810,52 @@ S_fixup_errno_string(pTHX_ SV* sv)
     }
 }
 
+/*
+=for apidoc Am|SV *|sv_string_from_errnum|int errnum|SV *tgtsv
+
+Generates the message string describing an OS error and returns it as
+an SV.  C<errnum> must be a value that C<errno> could take, identifying
+the type of error.
+
+If C<tgtsv> is non-null then the string will be written into that SV
+(overwriting existing content) and it will be returned.  If C<tgtsv>
+is a null pointer then the string will be written into a new mortal SV
+which will be returned.
+
+The message will be taken from whatever locale would be used by C<$!>,
+and will be encoded in the SV in whatever manner would be used by C<$!>.
+The details of this process are subject to future change.  Currently,
+the message is taken from the C locale by default (usually producing an
+English message), and from the currently selected locale when in the scope
+of the C<use locale> pragma.  A heuristic attempt is made to decode the
+message from the locale's character encoding, but it will only be decoded
+as either UTF-8 or ISO-8859-1.  It is always correctly decoded in a UTF-8
+locale, usually in an ISO-8859-1 locale, and never in any other locale.
+
+The SV is always returned containing an actual string, and with no other
+OK bits set.  Unlike C<$!>, a message is even yielded for C<errnum> zero
+(meaning success), and if no useful message is available then a useless
+string (currently empty) is returned.
+
+=cut
+*/
+
+SV *
+Perl_sv_string_from_errnum(pTHX_ int errnum, SV *tgtsv)
+{
+    char const *errstr;
+    if(!tgtsv)
+	tgtsv = sv_newmortal();
+    errstr = my_strerror(errnum);
+    if(errstr) {
+	sv_setpv(tgtsv, errstr);
+	fixup_errno_string(tgtsv);
+    } else {
+	SvPVCLEAR(tgtsv);
+    }
+    return tgtsv;
+}
+
 #ifdef VMS
 #include <descrip.h>
 #include <starlet.h>
@@ -930,14 +976,12 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
                 SvPVCLEAR(sv);
             }
             else {
-
-                /* Strerror can return NULL on some platforms, which will
-                 * result in 'sv' not being considered SvOK.  The SvNOK_on()
+                sv_string_from_errnum(errno, sv);
+                /* If no useful string is available, don't
+                 * claim to have a string part.  The SvNOK_on()
                  * below will cause just the number part to be valid */
-                sv_setpv(sv, my_strerror(errno));
-                if (SvOK(sv)) {
-                    fixup_errno_string(sv);
-                }
+                if (!SvCUR(sv))
+                    SvPOK_off(sv);
             }
             RESTORE_ERRNO;
 	}
diff --git a/proto.h b/proto.h
index b8a09df5d7..a7bd967bab 100644
--- a/proto.h
+++ b/proto.h
@@ -3385,6 +3385,7 @@ PERL_CALLCONV void	Perl_sv_setuv(pTHX_ SV *const sv, const UV num);
 PERL_CALLCONV void	Perl_sv_setuv_mg(pTHX_ SV *const sv, const UV u);
 #define PERL_ARGS_ASSERT_SV_SETUV_MG	\
 	assert(sv)
+PERL_CALLCONV SV*	Perl_sv_string_from_errnum(pTHX_ int errnum, SV* tgtsv);
 #ifndef NO_MATHOMS
 PERL_CALLCONV void	Perl_sv_taint(pTHX_ SV* sv);
 #define PERL_ARGS_ASSERT_SV_TAINT	\