Add new function utf8_from_bytes_loc()
authorKarl Williamson <khw@cpan.org>
Wed, 14 Jun 2017 03:37:22 +0000 (21:37 -0600)
committerKarl Williamson <khw@cpan.org>
Wed, 14 Jun 2017 17:08:24 +0000 (11:08 -0600)
This is currently undocumented externally, so we can change the API if
needed.

This is like utf8_from_bytes(), but in the case of not being able to
convert the whole string, it converts the initial substring that is
convertible, and tells you where it had to stop.

embed.fnc
embed.h
proto.h
utf8.c
utf8.h

index fd59c72..c8576af 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1798,7 +1798,11 @@ AipdRn   |U8*    |utf8_hop_safe  |NN const U8 *s|SSize_t off|NN const U8 *start|NN con
 ApMd   |U8*    |utf8_to_bytes  |NN U8 *s|NN STRLEN *lenp
 Apd    |int    |bytes_cmp_utf8 |NN const U8 *b|STRLEN blen|NN const U8 *u \
                                |STRLEN ulen
-ApMd   |U8*    |bytes_from_utf8|NN const U8 *s|NN STRLEN *lenp|NN bool *is_utf8p
+AModp  |U8*    |bytes_from_utf8|NN const U8 *s|NN STRLEN *lenp|NN bool *is_utf8p
+AMnp   |U8*    |bytes_from_utf8_loc|NN const U8 *s                         \
+                                   |NN STRLEN *lenp                        \
+                                   |NN bool *is_utf8p                      \
+                                   |NULLOK const U8 ** first_unconverted
 ApMd   |U8*    |bytes_to_utf8  |NN const U8 *s|NN STRLEN *lenp
 ApdD   |UV     |utf8_to_uvchr  |NN const U8 *s|NULLOK STRLEN *retlen
 ApdD   |UV     |utf8_to_uvuni  |NN const U8 *s|NULLOK STRLEN *retlen
diff --git a/embed.h b/embed.h
index aeec637..7cc3bbe 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -71,7 +71,7 @@
 #define block_gimme()          Perl_block_gimme(aTHX)
 #define block_start(a)         Perl_block_start(aTHX_ a)
 #define bytes_cmp_utf8(a,b,c,d)        Perl_bytes_cmp_utf8(aTHX_ a,b,c,d)
-#define bytes_from_utf8(a,b,c) Perl_bytes_from_utf8(aTHX_ a,b,c)
+#define bytes_from_utf8_loc    Perl_bytes_from_utf8_loc
 #define bytes_to_utf8(a,b)     Perl_bytes_to_utf8(aTHX_ a,b)
 #define call_argv(a,b,c)       Perl_call_argv(aTHX_ a,b,c)
 #define call_atexit(a,b)       Perl_call_atexit(aTHX_ a,b)
diff --git a/proto.h b/proto.h
index 6738544..d9c8798 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -259,6 +259,9 @@ PERL_CALLCONV int   Perl_bytes_cmp_utf8(pTHX_ const U8 *b, STRLEN blen, const U8 *
 PERL_CALLCONV U8*      Perl_bytes_from_utf8(pTHX_ const U8 *s, STRLEN *lenp, bool *is_utf8p);
 #define PERL_ARGS_ASSERT_BYTES_FROM_UTF8       \
        assert(s); assert(lenp); assert(is_utf8p)
+PERL_CALLCONV U8*      Perl_bytes_from_utf8_loc(const U8 *s, STRLEN *lenp, bool *is_utf8p, const U8 ** first_unconverted);
+#define PERL_ARGS_ASSERT_BYTES_FROM_UTF8_LOC   \
+       assert(s); assert(lenp); assert(is_utf8p)
 PERL_CALLCONV U8*      Perl_bytes_to_utf8(pTHX_ const U8 *s, STRLEN *lenp);
 #define PERL_ARGS_ASSERT_BYTES_TO_UTF8 \
        assert(s); assert(lenp)
diff --git a/utf8.c b/utf8.c
index d9ceef0..ebc4ad7 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -1994,58 +1994,121 @@ having saved the value of C<*lenp> before the call, and subtracting the
 after-call value of C<*lenp> from it.
 
 =cut
-*/
+
+There is a macro that avoids this function call, but this is retained for
+anyone who calls it with the Perl_ prefix */
 
 U8 *
 Perl_bytes_from_utf8(pTHX_ const U8 *s, STRLEN *lenp, bool *is_utf8p)
 {
-    U8 *d;
-    const U8 *start = s;
-    const U8 *send;
-    Size_t count = 0;
-
     PERL_ARGS_ASSERT_BYTES_FROM_UTF8;
     PERL_UNUSED_CONTEXT;
-    if (!*is_utf8p)
-        return (U8 *)start;
-
-    /* ensure valid UTF-8 and chars < 256 before converting string */
-    for (send = s + *lenp; s < send;) {
-        if (! UTF8_IS_INVARIANT(*s)) {
-            if (! UTF8_IS_NEXT_CHAR_DOWNGRADEABLE(s, send)) {
-                return (U8 *)start;
-            }
-            count++;
-            s++;
-       }
-        s++;
-    }
 
-    *is_utf8p = FALSE;
+    return bytes_from_utf8_loc(s, lenp, is_utf8p, NULL);
+}
+
+/*
+No = here because currently externally undocumented
+for apidoc bytes_from_utf8_loc
+
+Like C<L</bytes_from_utf8>()>, but takes an extra parameter, a pointer to where
+to store the location of the first character in C<"s"> that cannot be
+converted to non-UTF8.
+
+If that parameter is C<NULL>, this function behaves identically to
+C<bytes_from_utf8>.
+
+Otherwise if C<*is_utf8p> is 0 on input, the function behaves identically to
+C<bytes_from_utf8>, except it also sets C<*first_non_downgradable> to C<NULL>.
+
+Otherwise, the function returns a newly created C<NUL>-terminated string
+containing the non-UTF8 equivalent of the convertible first portion of
+C<"s">.  C<*lenp> is set to its length, not including the terminating C<NUL>.
+If the entire input string was converted, C<*is_utf8p> is set to a FALSE value,
+and C<*first_non_downgradable> is set to C<NULL>.
+
+Otherwise, C<*first_non_downgradable> set to point to the first byte of the
+first character in the original string that wasn't converted.  C<*is_utf8p> is
+unchanged.  Note that the new string may have length 0.
+
+Another way to look at it is, if C<*first_non_downgradable> is non-C<NULL> and
+C<*is_utf8p> is TRUE, this function starts at the beginning of C<"s"> and
+converts as many characters in it as possible stopping at the first one it
+finds one that can't be converted to non-UTF-8.  C<*first_non_downgradable> is
+set to point to that.  The function returns the portion that could be converted
+in a newly created C<NUL>-terminated string, and C<*lenp> is set to its length,
+not including the terminating C<NUL>.  If the very first character in the
+original could not be converted, C<*lenp> will be 0, and the new string will
+contain just a single C<NUL>.  If the entire input string was converted,
+C<*is_utf8p> is set to FALSE and C<*first_non_downgradable> is set to C<NULL>.
+
+Upon successful return, the number of variants in the converted portion of the
+string can be computed by having saved the value of C<*lenp> before the call,
+and subtracting the after-call value of C<*lenp> from it.
+
+=cut
+
+
+*/
+
+U8 *
+Perl_bytes_from_utf8_loc(const U8 *s, STRLEN *lenp, bool *is_utf8p, const U8** first_unconverted)
+{
+    U8 *d;
+    const U8 *original = s;
+    U8 *converted_start;
+    const U8 *send = s + *lenp;
+
+    PERL_ARGS_ASSERT_BYTES_FROM_UTF8_LOC;
+
+    if (! *is_utf8p) {
+        if (first_unconverted) {
+            *first_unconverted = NULL;
+        }
+
+        return (U8 *) original;
+    }
 
-    Newx(d, (*lenp) - count + 1, U8);
+    Newx(d, (*lenp) + 1, U8);
 
-    if (LIKELY(count)) {
-        s = start; start = d;
+    converted_start = d;
         while (s < send) {
             U8 c = *s++;
             if (! UTF8_IS_INVARIANT(c)) {
-                /* Then it is two-byte encoded */
+
+            /* Then it is multi-byte encoded.  If the code point is above 0xFF,
+             * have to stop now */
+            if (UNLIKELY (! UTF8_IS_NEXT_CHAR_DOWNGRADEABLE(s - 1, send))) {
+                if (first_unconverted) {
+                    *first_unconverted = s - 1;
+                    goto finish_and_return;
+                }
+                else {
+                    Safefree(converted_start);
+                    return (U8 *) original;
+                }
+            }
+
                 c = EIGHT_BIT_UTF8_TO_NATIVE(c, *s);
                 s++;
             }
             *d++ = c;
         }
-        *d = '\0';
-        *lenp = d - start;
 
-        return (U8 *)start;
-    }
-    else {
-        Copy(start, d, *lenp, U8);
-        *(d + *lenp) = '\0';
-        return (U8 *)d;
+    /* Here, converted the whole of the input */
+    *is_utf8p = FALSE;
+    if (first_unconverted) {
+        *first_unconverted = NULL;
     }
+
+  finish_and_return:
+        *d = '\0';
+        *lenp = d - converted_start;
+
+    /* Trim unused space */
+    Renew(converted_start, *lenp + 1, U8);
+
+    return converted_start;
 }
 
 /*
diff --git a/utf8.h b/utf8.h
index 41db2f4..276fa29 100644 (file)
--- a/utf8.h
+++ b/utf8.h
@@ -1049,6 +1049,8 @@ is a valid UTF-8 character.
           : _is_utf8_char_helper(s, e, 0))
 
 #define is_utf8_char_buf(buf, buf_end) isUTF8_CHAR(buf, buf_end)
+#define bytes_from_utf8(s, lenp, is_utf8p)                                  \
+                            bytes_from_utf8_loc(s, lenp, is_utf8p, 0)
 
 /*