view release on metacpan or  search on metacpan

wide_xs.h  view on Meta::CPAN

/* Convert wide character string to mortal SV.  Use UTF8 encoding
 * if the string cannot be represented in the ANSI/OEM filepath system
 * codepage. ANSI/OEM change detection triggered by user calling an XSUB. Not
 * automatic polling.
 * Probably not for OLE. Users switching OEM FP CP is very rare. Won't affect
 * most people.
 * If wlen isn't -1 (calculate length), wlen must include the null wchar
 * in its count of wchars, and null wchar must be last wchar.
 * This function has the typical WinOS 65KB limit, and we only uses C stack
 * mem for speed, and therefore must have some hard coded limit
 * Arg "INT_PTR wlenparam" must have a PP visible 2 byte WIDE NULL at the end.
 * Perl's hidden 1 byte C ASCII NULL isn't good enough.
 */
STATIC SV *
S_sv_setwstr(pTHX_ const CV *const cv, SV * sv, WCHAR *wstr, INT_PTR wlenparam) {
    char * dest;
    BOOL use_default = FALSE;
    BOOL * use_default_ptr = &use_default;
    UINT CodePage;
    DWORD dwFlags;
    int len;
    /* note 0xFFFFFFFFFFFFFFFF and 0xFFFFFFFF truncate to the same here on x64*/
    int wlen;// = (int) wlenparam;
    WCHAR * tempwstr = NULL;

#ifdef _WIN64     /* WCTMB only takes 32 bits ints*/
    if(wlenparam > (INT_PTR) INT_MAX && wlenparam != 0xFFFFFFFF)
      //croak("(XS) " MODNAME "::w32sv_setwstr panic: %s", "string overflow\n");
        S_croak_sub_exglr(cv, "sv_setwstr", ERROR_BUFFER_OVERFLOW);
#endif
    wlen = (int) wlenparam;

    /* can't pass -1 to WCTMB, that triggers length counting but WCTMB is slow */
    if(wlen == -1)
        wlen = (int)wcslen(wstr)+1; /* wrap around chk done later*/

    /*a Win32 API might claiming to create null terminated, length counted, string
    but infact is creating non terminated, length counted, strings, catch it*/
    else {
      wlen += 1;
      if(wstr[wlen-1] != L'\0')
      //croak("(XS) " MODNAME "sv_setwstr panic: %s",
      //      "wide string is not null terminated\n");
        S_croak_sub_exglr(cv, "sv_setwstr", ERROR_INVALID_USER_BUFFER);
    }

    if(
/* SvPVX in head, not ANY/body, added in 5.9.3, dont crash */
#if (PERL_VERSION_LE(5, 9, 2))
        SvTYPE(sv) >= SVt_PV &&
#endif
        /* Todo Change to alloca vs mortal */
       ((WCHAR *)SvPVX(sv)) == wstr) {//WCTMB bufs cant overlap
        SV * widecopysv = sv_2mortal(newSV(wlen*sizeof(WCHAR)));
        tempwstr = ((WCHAR *)SvPVX(widecopysv));
        Move(wstr, tempwstr, wlen, sizeof(WCHAR));
    }

    if(SvOOK(sv)) {
        SvCUR_set(sv, 0); /* skip memcpy relocation of old buffer */
        sv_backoff(sv); /* small chance to recover bytes w/o libc trip */
    } /* small "WIDE/2 ASCII" guess, its malloc mem so be conservative */
    dest = SafeSvGROWThink1ST(sv, (STRLEN)wlen);
    CodePage = gBKXSTK_sys_filepath_cp;
    dwFlags = WC_NO_BEST_FIT_CHARS;
    len = WideCharToMultiByte(CodePage, dwFlags, wstr, wlen, dest, wlen, NULL, use_default_ptr);
    if(len)
        goto chk_sub_ascii_chars;

    if(GetLastError() != ERROR_INSUFFICIENT_BUFFER)
        goto set_undef;

    retry: /* try harder to stay in ASCII mode (perl utf8 strings slower than
    perl byte). Do a length-only pass in ASCII with longer SVPV buf before
    trying utf8. WCTMB doesn't return "size needed" integer after an
    overflow/cutoff event, if b4 you passed in a a valid byte Ptr to fill.
    WCTMB only rets "size needed" if you pass NULL ptr for output. */
    len = WideCharToMultiByte(CodePage, dwFlags, wstr, wlen, NULL, 0, NULL, NULL);
    dest = SafeSvGROW(sv, (STRLEN)len); /* SvGROW() segv if SVt_NULL/bodyless */
    len = WideCharToMultiByte(CodePage, dwFlags, wstr, wlen, dest, len, NULL, use_default_ptr);

    chk_sub_ascii_chars:
    if (use_default) {
        SvUTF8_on(sv);
        use_default = FALSE;
        use_default_ptr = NULL;
        /*this branch will never be taken again*/
        CodePage = CP_UTF8;
        dwFlags = 0;
        goto retry;
    }
    /* Shouldn't really ever fail since we ask for the required length first, but who knows... */
    if (len) {
        SvPOK_on(sv);
        SvCUR_set(sv, len-1);
    }
    else {
        set_undef:
        SvOK_off(sv);
        SvCUR_set(sv,0);
    }
    return sv;
}

/* file paths only, uses API.dll's manually updated AreFileApisANSI global var */
static SSize_t
pv_to_wstr_cstk(pTHX_ const CV *const cv, const char * str, int len, WCHAR *wstr, int wlen)
{
    DWORD e;
    UINT cp;
    int wlen_guess;
    if(len > 0xFFFE) {
        SetLastError(ERROR_FILENAME_EXCED_RANGE);
        goto croak_err;
    }
    wlen_guess = ((int)len) + 1;
    if( wlen_guess > wlen) {
      return -((SSize_t)wlen_guess);
    }
    else if (len == 0) { /* output WIDE string is obvious */