Devel-PPPort

 view release on metacpan or  search on metacpan

parts/inc/utf8  view on Meta::CPAN

                    len = Perl_sv_len_utf8(aTHX_                            \
                                           sv_mortalcopy_flags(sv2,         \
                                                               SV_NOSTEAL));\
                else                                                        \
                    len = Perl_sv_len_utf8(aTHX_ sv2);                      \
             }                                                              \
             else SvPV_nomg(sv2, len);                                      \
             len;                                                           \
       })
#      define sv_len_utf8(sv) ({ SV *_sv1 = (sv);                           \
                                 SvGETMAGIC(_sv1);                          \
                                 sv_len_utf8_nomg(_sv1);                    \
                              })
#    else   /* Below is no brace groups */
       PERL_STATIC_INLINE STRLEN D_PPP_sv_len_utf8_nomg(SV * sv)
       {
          dTHX;
          STRLEN len;
          if (SvUTF8(sv)) {
              if (SvGMAGICAL(sv))
                  len = Perl_sv_len_utf8(aTHX_
                                         sv_mortalcopy_flags(sv,
                                                             SV_NOSTEAL));
              else
                  len = Perl_sv_len_utf8(aTHX_ sv);
          }
          else SvPV_nomg(sv, len);
          return len;
       }
#      define sv_len_utf8_nomg(sv) D_PPP_sv_len_utf8_nomg(sv)

       PERL_STATIC_INLINE STRLEN D_PPP_sv_len_utf8(SV * sv)
       {
          dTHX;
          SvGETMAGIC(sv);
          return sv_len_utf8_nomg(sv);
       }
#      define sv_len_utf8(sv) D_PPP_sv_len_utf8(sv)
#    endif
#  endif    /* End of < 5.17.5 */
#endif

=xsinit

#define NEED_utf8_to_uvchr_buf

=xsubs

#if defined(UTF8f) && defined(newSVpvf)

void
UTF8f(x)
        SV *x
        PREINIT:
                U32 u;
                STRLEN len;
                char *ptr;
        INIT:
                ptr = SvPV(x, len);
                u = SvUTF8(x);
        PPCODE:
                x = sv_2mortal(newSVpvf("[%" UTF8f "]", UTF8fARG(u, len, ptr)));
                XPUSHs(x);
                XSRETURN(1);

#endif

#if { VERSION >= 5.006 } /* This is just a helper fcn, not publicized */  \
                         /* as being available and params not what the  */  \
                         /* API function has; works on EBCDIC too */

SV *
uvchr_to_utf8(native)

    UV native
    PREINIT:
        int len;
        U8 string[UTF8_MAXBYTES+1];
        int i;
        UV uni;

    CODE:
	len = UVCHR_SKIP(native);

        for (i = 0; i < len; i++) {
            string[i] = '\0';
        }

        if (len <= 1) {
            string[0] = native;
        }
        else {
            i = len;
            uni = NATIVE_TO_UNI(native);
            while (i-- > 1) {
                string[i] = I8_TO_NATIVE_UTF8((uni & UTF_CONTINUATION_MASK) | UTF_CONTINUATION_MARK);
                uni >>= UTF_ACCUMULATION_SHIFT;
            }
            string[0] = I8_TO_NATIVE_UTF8((uni & UTF_START_MASK(len)) | UTF_START_MARK(len));
        }

        RETVAL = newSVpvn((char *) string, len);
        SvUTF8_on(RETVAL);
    OUTPUT:
        RETVAL

#endif
#if defined(UTF8_SAFE_SKIP) && defined(UTF8SKIP)

STRLEN
UTF8_SAFE_SKIP(s, adjustment)
        char * s
        int adjustment
        PREINIT:
            const char *const_s;
        CODE:
            const_s = s;
            /* Instead of passing in an 'e' ptr, use the real end, adjusted */
            RETVAL = UTF8_SAFE_SKIP(const_s, s + UTF8SKIP(s) + adjustment);
        OUTPUT:
            RETVAL



( run in 0.468 second using v1.01-cache-2.11-cpan-5511b514fd6 )