Skip to content

Commit

Permalink
Time::Piece: Use core function to implement strftime_
Browse files Browse the repository at this point in the history 
This functionality is thread-safe and takes care of all worries about
UTF-8.

To use it, the charmap is changed to pass this an SV* instead of a char*
  • Loading branch information
@khwilliamson
khwilliamson committed May 7, 2023
1 parent 4e21256 commit 7e4014f
Show file tree
Hide file tree
Showing 10 changed files with 453 additions and 160 deletions.
2 changes: 1 addition & 1 deletion cpan/Time-Piece/Piece.pm
View file
Expand Up @@ -19,7 +19,7 @@ our %EXPORT_TAGS = (
':override' => 'internal',
);

our $VERSION = '1.3401';
our $VERSION = '1.3402';

XSLoader::load( 'Time::Piece', $VERSION );

Expand Down
143 changes: 113 additions & 30 deletions cpan/Time-Piece/Piece.xs
View file
Expand Up @@ -27,6 +27,35 @@ extern "C" {
#define WEEKDAY_BIAS 6 /* (1+6)%7 makes Sunday 0 again */
#define TP_BUF_SIZE 160

#ifndef ENV_LOCK
# define ENV_LOCK
# define ENV_UNLOCK
#endif
#ifndef GMTIME_LOCK
# define GMTIME_LOCK ENV_LOCK
# define GMTIME_UNLOCK ENV_UNLOCK
#endif
#ifndef LOCALTIME_LOCK
# define LOCALTIME_LOCK ENV_LOCK
# define LOCALTIME_UNLOCK ENV_UNLOCK
#endif
#ifndef STRFTIME_LOCK
# define STRFTIME_LOCK ENV_LOCK
# define STRFTIME_UNLOCK ENV_UNLOCK
#endif
#ifndef TZSET_LOCK
# define TZSET_LOCK ENV_LOCK
# define TZSET_UNLOCK ENV_UNLOCK
#endif

/* If the perl is too old for this macro, it is too old for any of the
* enhancements available in modern perls */
#ifndef PERL_VERSION_GE
# define PERL_VERSION_GE(j,n,p) 0
#endif

/* XXX bunch of other locks need, tzset putenv, getenv; haven't looked */

#ifdef WIN32

/*
Expand Down Expand Up @@ -99,6 +128,7 @@ extern "C" {
#undef malloc
#undef free

/* Should call the one in Posix:: */
static void
fix_win32_tzenv(void)
{
Expand Down Expand Up @@ -152,7 +182,9 @@ my_tzset(pTHX)
#endif
fix_win32_tzenv();
#endif
TZSET_LOCK;
tzset();
TZSET_UNLOCK;
}

/*
Expand Down Expand Up @@ -765,10 +797,14 @@ label:
buf = cp;
memset(&mytm, 0, sizeof(mytm));

if(*got_GMT == 1)
if(*got_GMT == 1) {
LOCALTIME_LOCK;
mytm = *localtime(&t);
else
}
else {
GMTIME_LOCK;
mytm = *gmtime(&t);
}

tm->tm_sec = mytm.tm_sec;
tm->tm_min = mytm.tm_min;
Expand All @@ -779,6 +815,13 @@ label:
tm->tm_wday = mytm.tm_wday;
tm->tm_yday = mytm.tm_yday;
tm->tm_isdst = mytm.tm_isdst;

if(*got_GMT == 1) {
LOCALTIME_UNLOCK;
}
else {
GMTIME_UNLOCK;
}
}
break;

Expand All @@ -791,6 +834,7 @@ label:
return 0;

len = (c == 'Y') ? 4 : 2;
/* XXX note this is a bug is isdigit, subtracting '0' because could be another set of 10. */
for (i = 0; len && *buf != 0 && isDIGIT_LC((unsigned char)*buf); buf++) {
i *= 10;
i += *buf - '0';
Expand Down Expand Up @@ -955,27 +999,60 @@ static void _populate_C_time_locale(pTHX_ HV* locales )
return;
}

#ifdef sv_strftime_tm
# define TP_strftime(format, tm) \
sv_strftime_tm(sv_2mortal(newSVpv(format, 0)), tm)
#else
# define TP_strftime(format, tm) \
my_strftime_tm(aTHX_ sv_2mortal(newSVpv(format, 0)), tm)

static SV* my_strftime_tm(pTHX_ const char * format, const struct tm * mytm)
{
size_t len;
char buf[TP_BUF_SIZE];

STRFTIME_LOCK;
len = strftime(buf, TP_BUF_SIZE, "%a", mytm);
STRFTIME_UNLOCK;
return newSVpvn(buf, len);
}
#endif

MODULE = Time::Piece PACKAGE = Time::Piece

PROTOTYPES: ENABLE

void
_strftime(fmt, epoch, islocal = 1)
char * fmt
SV * fmt
time_t epoch
int islocal
CODE:
{
#ifndef sv_strftime_tm
char tmpbuf[TP_BUF_SIZE];
struct tm mytm;
size_t len;
#endif
struct tm mytm;

if(islocal == 1)
if(islocal == 1) {
LOCALTIME_LOCK;
mytm = *localtime(&epoch);
else
LOCALTIME_UNLOCK;
}
else {
GMTIME_LOCK;
mytm = *gmtime(&epoch);

len = strftime(tmpbuf, TP_BUF_SIZE, fmt, &mytm);
GMTIME_UNLOCK;
}
#ifdef sv_strftime_tm
ST(0) = sv_strftime_tm(fmt, &mytm);
#else
size_t fmtlen;
char * fmt_pv = SvPV(fmt, fmtlen);
STRFTIME_LOCK;
len = strftime(tmpbuf, TP_BUF_SIZE, fmt_pv, &mytm);
STRFTIME_UNLOCK;
/*
** The following is needed to handle to the situation where
** tmpbuf overflows. Basically we want to allocate a buffer
Expand All @@ -990,18 +1067,19 @@ _strftime(fmt, epoch, islocal = 1)
** If there is a better way to make it portable, go ahead by
** all means.
*/
if ((len > 0 && len < TP_BUF_SIZE) || (len == 0 && *fmt == '\0'))
if ((len > 0 && len < TP_BUF_SIZE) || (len == 0 && *fmt_pv == '\0'))
ST(0) = sv_2mortal(newSVpv(tmpbuf, len));
else {
/* Possibly buf overflowed - try again with a bigger buf */
size_t fmtlen = strlen(fmt);
size_t bufsize = fmtlen + TP_BUF_SIZE;
char* buf;
size_t buflen;

New(0, buf, bufsize, char);
while (buf) {
buflen = strftime(buf, bufsize, fmt, &mytm);
STRFTIME_LOCK;
buflen = strftime(buf, bufsize, fmt_pv, &mytm);
STRFTIME_UNLOCK;
if (buflen > 0 && buflen < bufsize)
break;
/* heuristic to prevent out-of-memory errors */
Expand All @@ -1020,6 +1098,8 @@ _strftime(fmt, epoch, islocal = 1)
else
ST(0) = sv_2mortal(newSVpv(tmpbuf, len));
}
#endif

}

void
Expand Down Expand Up @@ -1076,7 +1156,9 @@ _mini_mktime(int sec, int min, int hour, int mday, int mon, int year)
time_t t;
PPCODE:
t = 0;
GMTIME_LOCK;
mytm = *gmtime(&t);
GMTIME_UNLOCK;

mytm.tm_sec = sec;
mytm.tm_min = min;
Expand All @@ -1095,8 +1177,16 @@ _crt_localtime(time_t sec)
PREINIT:
struct tm mytm;
PPCODE:
if(ix) mytm = *gmtime(&sec);
else mytm = *localtime(&sec);
if(ix) {
GMTIME_LOCK;
mytm = *gmtime(&sec);
GMTIME_UNLOCK;
}
else {
LOCALTIME_LOCK;
mytm = *localtime(&sec);
LOCALTIME_UNLOCK;
}
/* Need to get: $s,$n,$h,$d,$m,$y */

EXTEND(SP, 10);
Expand All @@ -1123,31 +1213,26 @@ _get_localization()
AV* mons = newAV();
AV* months = newAV();
SV** tmp;
size_t len;
char buf[TP_BUF_SIZE];
size_t i;
time_t t = 1325386800; /*1325386800 = Sun, 01 Jan 2012 03:00:00 GMT*/
struct tm mytm = *gmtime(&t);
struct tm mytm;
CODE:
GMTIME_LOCK;
mytm = *gmtime(&t);
GMTIME_UNLOCK;

for(i = 0; i < 7; ++i){

len = strftime(buf, TP_BUF_SIZE, "%a", &mytm);
av_push(wdays, (SV *) newSVpvn(buf, len));

len = strftime(buf, TP_BUF_SIZE, "%A", &mytm);
av_push(weekdays, (SV *) newSVpvn(buf, len));
av_push(wdays, TP_strftime("%a", &mytm));
av_push(weekdays, TP_strftime("%A", &mytm));

++mytm.tm_wday;
}

for(i = 0; i < 12; ++i){

len = strftime(buf, TP_BUF_SIZE, "%b", &mytm);
av_push(mons, (SV *) newSVpvn(buf, len));

len = strftime(buf, TP_BUF_SIZE, "%B", &mytm);
av_push(months, (SV *) newSVpvn(buf, len));
av_push(mons, TP_strftime("%b", &mytm));
av_push(months, TP_strftime("%B", &mytm));

++mytm.tm_mon;
}
Expand All @@ -1158,11 +1243,9 @@ _get_localization()
tmp = hv_store(locales, "month", 5, newRV_noinc((SV *) months), 0);
tmp = hv_store(locales, "alt_month", 9, newRV((SV *) months), 0);

len = strftime(buf, TP_BUF_SIZE, "%p", &mytm);
tmp = hv_store(locales, "AM", 2, newSVpvn(buf,len), 0);
tmp = hv_store(locales, "AM", 2, TP_strftime("%p", &mytm), 0);
mytm.tm_hour = 18;
len = strftime(buf, TP_BUF_SIZE, "%p", &mytm);
tmp = hv_store(locales, "PM", 2, newSVpvn(buf,len), 0);
tmp = hv_store(locales, "PM", 2, TP_strftime("%p", &mytm), 0);

if(tmp == NULL || !SvOK( (SV *) *tmp)){
croak("Failed to get localization.");
Expand Down
2 changes: 1 addition & 1 deletion cpan/Time-Piece/Seconds.pm
View file
@@ -1,7 +1,7 @@
package Time::Seconds;
use strict;

our $VERSION = '1.3401';
our $VERSION = '1.3402';

use Exporter 5.57 'import';

Expand Down
4 changes: 2 additions & 2 deletions dist/Module-CoreList/lib/Module/CoreList.pm
View file
Expand Up @@ -17488,8 +17488,8 @@ for my $version ( sort { $a <=> $b } keys %released ) {
'Test::Tester::CaptureRunner'=> '1.302175',
'Test::Tester::Delegate'=> '1.302175',
'Test::use::ok' => '1.302175',
'Time::Piece' => '1.3401',
'Time::Seconds' => '1.3401',
'Time::Piece' => '1.3402',
'Time::Seconds' => '1.3402',
'Unicode::UCD' => '0.75',
'XS::APItest' => '1.09',
'_charnames' => '1.47',
Expand Down
41 changes: 29 additions & 12 deletions embed.fnc
View file
Expand Up @@ -2079,18 +2079,6 @@ Adfp |char * |my_strftime |NN const char *fmt \
|int wday \
|int yday \
|int isdst
EXfp |char * |my_strftime8_temp \
|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
ARTdp |NV |my_strtod |NN const char * const s \
|NULLOK char **e
: Used in pp_ctl.c
Expand Down Expand Up @@ -3330,6 +3318,19 @@ Adm |bool |sv_streq |NULLOK SV *sv1 \
Adp |bool |sv_streq_flags |NULLOK SV *sv1 \
|NULLOK SV *sv2 \
|const U32 flags
Adp |SV * |sv_strftime_ints \
|NN SV *fmt \
|int sec \
|int min \
|int hour \
|int mday \
|int mon \
|int year \
|int wday \
|int yday \
|int isdst
Adp |SV * |sv_strftime_tm |NN SV *fmt \
|NN struct tm *mytm
Adp |SV * |sv_string_from_errnum \
|int errnum \
|NULLOK SV *tgtsv
Expand Down Expand Up @@ -4326,6 +4327,22 @@ op |SV * |hfree_next_entry \
|NN STRLEN *indexp
#endif
#if defined(PERL_IN_LOCALE_C)
S |struct tm *|ints_to_tm |int sec \
|int min \
|int hour \
|int mday \
|int mon \
|int year \
|int wday \
|int yday \
|int isdst
Sf |char * |strftime8 |NN const char *fmt \
|NN struct tm *mytm \
|const utf8ness_t fmt_utf8ness \
|NN utf8ness_t *result_utf8ness \
|const bool came_from_sv
Sf |char * |strftime_tm |NN const char *fmt \
|NN const struct tm *mytm
# if defined(HAS_LOCALECONV)
S |HV * |my_localeconv |const int item
S |void |populate_hash_from_localeconv \
Expand Down
6 changes: 5 additions & 1 deletion embed.h
View file
Expand Up @@ -711,6 +711,8 @@
# 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_streq_flags(a,b,c) Perl_sv_streq_flags(aTHX_ a,b,c)
# define sv_strftime_ints(a,b,c,d,e,f,g,h,i,j) Perl_sv_strftime_ints(aTHX_ a,b,c,d,e,f,g,h,i,j)
# define sv_strftime_tm(a,b) Perl_sv_strftime_tm(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)
Expand Down Expand Up @@ -1268,6 +1270,9 @@
# endif
# endif /* defined(PERL_IN_HV_C) */
# if defined(PERL_IN_LOCALE_C)
# define ints_to_tm(a,b,c,d,e,f,g,h,i) S_ints_to_tm(aTHX_ a,b,c,d,e,f,g,h,i)
# define strftime8(a,b,c,d,e) S_strftime8(aTHX_ a,b,c,d,e)
# define strftime_tm(a,b) S_strftime_tm(aTHX_ a,b)
# if defined(HAS_LOCALECONV)
# define my_localeconv(a) S_my_localeconv(aTHX_ a)
# define populate_hash_from_localeconv(a,b,c,d,e) S_populate_hash_from_localeconv(aTHX_ a,b,c,d,e)
Expand Down Expand Up @@ -1694,7 +1699,6 @@
# define mg_find_mglob(a) Perl_mg_find_mglob(aTHX_ a)
# define multiconcat_stringify(a) Perl_multiconcat_stringify(aTHX_ a)
# define multideref_stringify(a,b) Perl_multideref_stringify(aTHX_ a,b)
# define my_strftime8_temp(a,b,c,d,e,f,g,h,i,j,k) Perl_my_strftime8_temp(aTHX_ a,b,c,d,e,f,g,h,i,j,k)
# define op_clear(a) Perl_op_clear(aTHX_ a)
# define qerror(a) Perl_qerror(aTHX_ a)
# define reg_named_buff(a,b,c,d) Perl_reg_named_buff(aTHX_ a,b,c,d)
Expand Down

0 comments on commit 7e4014f

Please sign in to comment.