diff options
-rw-r--r-- | embed.fnc | 7 | ||||
-rw-r--r-- | embed.h | 1 | ||||
-rw-r--r-- | ext/POSIX/POSIX.xs | 16 | ||||
-rw-r--r-- | locale.c | 33 | ||||
-rw-r--r-- | pod/perldelta.pod | 7 | ||||
-rw-r--r-- | proto.h | 5 | ||||
-rw-r--r-- | util.c | 15 |
7 files changed, 66 insertions, 18 deletions
@@ -1449,7 +1449,12 @@ Cpd |PerlIO*|my_popen_list |NN const char* mode|int n|NN SV ** args Apd |void |my_setenv |NULLOK const char* nam|NULLOK const char* val m |I32 |my_stat pX |I32 |my_stat_flags |NULLOK const U32 flags -Adfp |char * |my_strftime |NN const char *fmt|int sec|int min|int hour|int mday|int mon|int year|int wday|int yday|int isdst +Adfp |char * |my_strftime |NN const char *fmt|int sec|int min|int hour \ + |int mday|int mon|int year|int wday|int yday \ + |int isdst +Adfp |char * |my_strftime8 |NN const char *fmt|int sec|int min|int hour \ + |int mday|int mon|int year|int wday|int yday \ + |int isdst|NULLOK utf8ness_t * utf8ness : Used in pp_ctl.c p |void |my_unexec ApR |OP* |newANONLIST |NULLOK OP* o @@ -327,6 +327,7 @@ #define my_setenv(a,b) Perl_my_setenv(aTHX_ a,b) #define my_socketpair Perl_my_socketpair #define my_strftime(a,b,c,d,e,f,g,h,i,j) Perl_my_strftime(aTHX_ a,b,c,d,e,f,g,h,i,j) +#define my_strftime8(a,b,c,d,e,f,g,h,i,j,k) Perl_my_strftime8(aTHX_ a,b,c,d,e,f,g,h,i,j,k) #define my_strtod Perl_my_strtod #define newANONATTRSUB(a,b,c,d) Perl_newANONATTRSUB(aTHX_ a,b,c,d) #define newANONHASH(a) Perl_newANONHASH(aTHX_ a) diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index 062fa309b4..69250a8408 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -3577,29 +3577,19 @@ strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1) { char *buf; SV *sv; + utf8ness_t is_utf8; /* allowing user-supplied (rather than literal) formats * is normally frowned upon as a potential security risk; * but this is part of the API so we have to allow it */ GCC_DIAG_IGNORE_STMT(-Wformat-nonliteral); - buf = my_strftime(SvPV_nolen(fmt), sec, min, hour, mday, mon, year, wday, yday, isdst); + buf = my_strftime8(SvPV_nolen(fmt), sec, min, hour, mday, mon, year, wday, yday, isdst, &is_utf8); GCC_DIAG_RESTORE_STMT; sv = sv_newmortal(); if (buf) { STRLEN len = strlen(buf); sv_usepvn_flags(sv, buf, len, SV_HAS_TRAILING_NUL); - if ( SvUTF8(fmt) - || ( is_utf8_non_invariant_string((U8*) buf, len) -#ifdef USE_LOCALE_TIME - && _is_cur_LC_category_utf8(LC_TIME) -#else /* If can't check directly, at least can see if script is consistent, - under UTF-8, which gives us an extra measure of confidence. */ - - && isSCRIPT_RUN((const U8 *) buf, - (const U8 *) buf + len, - TRUE) /* Means assume UTF-8 */ -#endif - )) { + if (SvUTF8(fmt) || is_utf8 == UTF8NESS_YES) { SvUTF8_on(sv); } } @@ -4240,6 +4240,39 @@ S_my_langinfo_i(pTHX_ #endif /* USE_LOCALE */ +char * +Perl_my_strftime8(pTHX_ const char *fmt, int sec, int min, int hour, int mday, + int mon, int year, int wday, int yday, int isdst, + utf8ness_t * utf8ness) +{ /* Documented in util.c */ + char * retval = my_strftime(fmt, sec, min, hour, mday, mon, year, wday, + yday, isdst); + + PERL_ARGS_ASSERT_MY_STRFTIME8; + + if (utf8ness) { + +#ifdef USE_LOCALE_TIME + *utf8ness = get_locale_string_utf8ness_i(NULL, LC_TIME_INDEX_, + retval, LOCALE_UTF8NESS_UNKNOWN); +#else + *utf8ness = UTF8NESS_IMMATERIAL; +#endif + + } + + DEBUG_Lv(PerlIO_printf(Perl_debug_log, "fmt=%s, retval=%s", fmt, + ((is_utf8_string((U8 *) retval, 0)) + ? retval + :_byte_dump_string((U8 *) retval, strlen(retval), 0))); + if (utf8ness) PerlIO_printf(Perl_debug_log, "; utf8ness=%d", + (int) *utf8ness); + PerlIO_printf(Perl_debug_log, "\n"); + ); + + return retval; +} + /* * Initialize locale awareness. */ diff --git a/pod/perldelta.pod b/pod/perldelta.pod index ceadb9f66e..82db679dd9 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -352,6 +352,13 @@ A new API function L<perlapi/C<Perl_localeconv>> is added. This is the same as L<C<POSIX::localeconv>|POSIX/localeconv> (returning a hash of the C<localeconv()>> fields), but directly callable from XS code. +=item * + +A new API function L<perlapi/C<my_strftime8>> is added. This is the +same as plain L<perlapi/C<my_strftime>>, but with an extra parameter +that allows the caller to simply and reliably know if the returned +string is UTF-8. + =back =head1 Selected Bug Fixes @@ -2554,6 +2554,11 @@ PERL_CALLCONV char * Perl_my_strftime(pTHX_ const char *fmt, int sec, int min, i #define PERL_ARGS_ASSERT_MY_STRFTIME \ assert(fmt) +PERL_CALLCONV char * Perl_my_strftime8(pTHX_ const char *fmt, int sec, int min, int hour, int mday, int mon, int year, int wday, int yday, int isdst, utf8ness_t * utf8ness) + __attribute__format__(__strftime__,pTHX_1,0); +#define PERL_ARGS_ASSERT_MY_STRFTIME8 \ + assert(fmt) + PERL_CALLCONV NV Perl_my_strtod(const char * const s, char ** e) __attribute__warn_unused_result__; #define PERL_ARGS_ASSERT_MY_STRTOD \ @@ -4189,16 +4189,23 @@ Perl_my_strftime(pTHX_ const char *fmt, int sec, int min, int hour, int mday, in /* =for apidoc_section $time -=for apidoc my_strftime +=for apidoc my_strftime +=for apidoc_item my_strftime8 + strftime(), but with a different API so that the return value is a pointer to the formatted result (which MUST be arranged to be FREED BY THE -CALLER). This allows this function to increase the buffer size as needed, +CALLER). This allows these functions to increase the buffer size as needed, so that the caller doesn't have to worry about that. -Note that yday and wday effectively are ignored by this function, as +C<my_strftime8> is the same as plain C<my_strftime>, but has an extra +parameter, a pointer to a variable declared as L</C<utf8ness_t>>. +Upon return, its variable will be set to indicate how the resultant string +should be treated with regards to its UTF-8ness. + +Note that yday and wday effectively are ignored by these functions, as mini_mktime() overwrites them -Also note that this is always executed in the underlying locale of the program, +Also note that they are always executed in the underlying locale of the program, giving localized results. =cut |