12 /* XXX struct tm on some systems (SunOS4/BSD) contains extra (non POSIX)
13 * fields for which we don't have Configure support prior to Perl 5.8.0:
14 * char *tm_zone; -- abbreviation of timezone name
15 * long tm_gmtoff; -- offset from GMT in seconds
16 * To workaround core dumps from the uninitialised tm_zone we get the
17 * system to give us a reasonable struct to copy. This fix means that
18 * strftime uses the tm_zone and tm_gmtoff values returned by
19 * localtime(time()). That should give the desired result most of the
20 * time. But probably not always!
22 * This is a vestigial workaround for Perls prior to 5.8.0. We now
23 * rely on the initialization (still likely a workaround) in util.c.
25 #if !defined(PERL_VERSION) || PERL_VERSION < 8
27 #if defined(HAS_GNULIBC)
28 # ifndef STRUCT_TM_HASZONE
29 # define STRUCT_TM_HASZONE
31 # define USE_TM_GMTOFF
35 #endif /* end of pre-5.8 */
37 #define DAYS_PER_YEAR 365
38 #define DAYS_PER_QYEAR (4*DAYS_PER_YEAR+1)
39 #define DAYS_PER_CENT (25*DAYS_PER_QYEAR-1)
40 #define DAYS_PER_QCENT (4*DAYS_PER_CENT+1)
41 #define SECS_PER_HOUR (60*60)
42 #define SECS_PER_DAY (24*SECS_PER_HOUR)
43 /* parentheses deliberately absent on these two, otherwise they don't work */
44 #define MONTH_TO_DAYS 153/5
45 #define DAYS_TO_MONTH 5/153
46 /* offset to bias by March (month 4) 1st between month/mday & year finding */
47 #define YEAR_ADJUST (4*MONTH_TO_DAYS+1)
48 /* as used here, the algorithm leaves Sunday as day 1 unless we adjust it */
49 #define WEEKDAY_BIAS 6 /* (1+6)%7 makes Sunday 0 again */
51 #if !defined(PERL_VERSION) || PERL_VERSION < 8
53 #ifdef STRUCT_TM_HASZONE
55 my_init_tm(struct tm *ptm) /* see mktime, strftime and asctime */
59 Copy(localtime(&now), ptm, 1, struct tm);
63 # define my_init_tm(ptm)
67 /* use core version from util.c in 5.8.0 and later */
68 # define my_init_tm init_tm
74 * (1) The CRT maintains its own copy of the environment, separate from
77 * (2) CRT getenv() retrieves from this copy. CRT putenv() updates this
78 * copy, and then calls SetEnvironmentVariableA() to update the Win32API
81 * (3) win32_getenv() and win32_putenv() call GetEnvironmentVariableA() and
82 * SetEnvironmentVariableA() directly, bypassing the CRT copy of the
85 * (4) The CRT strftime() "%Z" implementation calls __tzset(). That
86 * calls CRT tzset(), but only the first time it is called, and in turn
87 * that uses CRT getenv("TZ") to retrieve the timezone info from the CRT
88 * local copy of the environment and hence gets the original setting as
89 * perl never updates the CRT copy when assigning to $ENV{TZ}.
91 * Therefore, we need to retrieve the value of $ENV{TZ} and call CRT
92 * putenv() to update the CRT copy of the environment (if it is different)
93 * whenever we're about to call tzset().
95 * In addition to all that, when perl is built with PERL_IMPLICIT_SYS
98 * (a) Each interpreter has its own copy of the environment inside the
99 * perlhost structure. That allows applications that host multiple
100 * independent Perl interpreters to isolate environment changes from
101 * each other. (This is similar to how the perlhost mechanism keeps a
102 * separate working directory for each Perl interpreter, so that calling
103 * chdir() will not affect other interpreters.)
105 * (b) Only the first Perl interpreter instantiated within a process will
106 * "write through" environment changes to the process environment.
108 * (c) Even the primary Perl interpreter won't update the CRT copy of the
109 * the environment, only the Win32API copy (it calls win32_putenv()).
111 * As with CPerlHost::Getenv() and CPerlHost::Putenv() themselves, it makes
112 * sense to only update the process environment when inside the main
113 * interpreter, but we don't have access to CPerlHost's m_bTopLevel member
114 * from here so we'll just have to check PL_curinterp instead.
116 * Therefore, we can simply #undef getenv() and putenv() so that those names
117 * always refer to the CRT functions, and explicitly call win32_getenv() to
118 * access perl's %ENV.
120 * We also #undef malloc() and free() to be sure we are using the CRT
121 * functions otherwise under PERL_IMPLICIT_SYS they are redefined to calls
122 * into VMem::Malloc() and VMem::Free() and all allocations will be freed
123 * when the Perl interpreter is being destroyed so we'd end up with a pointer
124 * into deallocated memory in environ[] if a program embedding a Perl
125 * interpreter continues to operate even after the main Perl interpreter has
128 * Note that we don't free() the malloc()ed memory unless and until we call
129 * malloc() again ourselves because the CRT putenv() function simply puts its
130 * pointer argument into the environ[] arrary (it doesn't make a copy of it)
131 * so this memory must otherwise be leaked.
140 fix_win32_tzenv(void)
142 static char* oldenv = NULL;
144 const char* perl_tz_env = win32_getenv("TZ");
145 const char* crt_tz_env = getenv("TZ");
146 if (perl_tz_env == NULL)
148 if (crt_tz_env == NULL)
150 if (strcmp(perl_tz_env, crt_tz_env) != 0) {
151 newenv = (char*)malloc((strlen(perl_tz_env) + 4) * sizeof(char));
152 if (newenv != NULL) {
153 sprintf(newenv, "TZ=%s", perl_tz_env);
165 * my_tzset - wrapper to tzset() with a fix to make it work (better) on Win32.
166 * This code is duplicated in the POSIX module, so any changes made here
167 * should be made there too.
173 #if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
174 if (PL_curinterp == aTHX)
182 * my_mini_mktime - normalise struct tm values without the localtime()
183 * semantics (and overhead) of mktime(). Stolen shamelessly from Perl's
184 * Perl_mini_mktime() in util.c - for details on the algorithm, see that
188 my_mini_mktime(struct tm *ptm)
192 int month, mday, year, jday;
193 int odd_cent, odd_year;
195 year = 1900 + ptm->tm_year;
198 /* allow given yday with no month & mday to dominate the result */
199 if (ptm->tm_yday >= 0 && mday <= 0 && month <= 0) {
202 jday = 1 + ptm->tm_yday;
212 yearday = DAYS_PER_YEAR * year + year/4 - year/100 + year/400;
213 yearday += month*MONTH_TO_DAYS + mday + jday;
215 * Note that we don't know when leap-seconds were or will be,
216 * so we have to trust the user if we get something which looks
217 * like a sensible leap-second. Wild values for seconds will
218 * be rationalised, however.
220 if ((unsigned) ptm->tm_sec <= 60) {
227 secs += 60 * ptm->tm_min;
228 secs += SECS_PER_HOUR * ptm->tm_hour;
230 if (secs-(secs/SECS_PER_DAY*SECS_PER_DAY) < 0) {
231 /* got negative remainder, but need positive time */
232 /* back off an extra day to compensate */
233 yearday += (secs/SECS_PER_DAY)-1;
234 secs -= SECS_PER_DAY * (secs/SECS_PER_DAY - 1);
237 yearday += (secs/SECS_PER_DAY);
238 secs -= SECS_PER_DAY * (secs/SECS_PER_DAY);
241 else if (secs >= SECS_PER_DAY) {
242 yearday += (secs/SECS_PER_DAY);
243 secs %= SECS_PER_DAY;
245 ptm->tm_hour = secs/SECS_PER_HOUR;
246 secs %= SECS_PER_HOUR;
247 ptm->tm_min = secs/60;
250 /* done with time of day effects */
252 * The algorithm for yearday has (so far) left it high by 428.
253 * To avoid mistaking a legitimate Feb 29 as Mar 1, we need to
254 * bias it by 123 while trying to figure out what year it
255 * really represents. Even with this tweak, the reverse
256 * translation fails for years before A.D. 0001.
257 * It would still fail for Feb 29, but we catch that one below.
259 jday = yearday; /* save for later fixup vis-a-vis Jan 1 */
260 yearday -= YEAR_ADJUST;
261 year = (yearday / DAYS_PER_QCENT) * 400;
262 yearday %= DAYS_PER_QCENT;
263 odd_cent = yearday / DAYS_PER_CENT;
264 year += odd_cent * 100;
265 yearday %= DAYS_PER_CENT;
266 year += (yearday / DAYS_PER_QYEAR) * 4;
267 yearday %= DAYS_PER_QYEAR;
268 odd_year = yearday / DAYS_PER_YEAR;
270 yearday %= DAYS_PER_YEAR;
271 if (!yearday && (odd_cent==4 || odd_year==4)) { /* catch Feb 29 */
276 yearday += YEAR_ADJUST; /* recover March 1st crock */
277 month = yearday*DAYS_TO_MONTH;
278 yearday -= month*MONTH_TO_DAYS;
279 /* recover other leap-year adjustment */
288 ptm->tm_year = year - 1900;
290 ptm->tm_mday = yearday;
295 ptm->tm_mon = month - 1;
297 /* re-build yearday based on Jan 1 to get tm_yday */
299 yearday = year*DAYS_PER_YEAR + year/4 - year/100 + year/400;
300 yearday += 14*MONTH_TO_DAYS + 1;
301 ptm->tm_yday = jday - yearday;
302 /* fix tm_wday if not overridden by caller */
303 ptm->tm_wday = (jday + WEEKDAY_BIAS) % 7;
307 /* Assume everyone has strptime except Win32 and QNX4 */
308 # define HAS_STRPTIME 1
309 # if defined(WIN32) || (defined(__QNX__) && defined(__WATCOMC__))
315 #define strncasecmp(x,y,n) strnicmp(x,y,n)
318 #if defined(__BORLANDC__)
319 void * __cdecl _EXPFUNC alloca(_SIZE_T __size);
321 #define alloca _alloca
325 /* strptime copied from freebsd with the following copyright: */
327 * Copyright (c) 1994 Powerdog Industries. All rights reserved.
329 * Redistribution and use in source and binary forms, with or without
330 * modification, are permitted provided that the following conditions
332 * 1. Redistributions of source code must retain the above copyright
333 * notice, this list of conditions and the following disclaimer.
334 * 2. Redistributions in binary form must reproduce the above copyright
335 * notice, this list of conditions and the following disclaimer
336 * in the documentation and/or other materials provided with the
338 * 3. All advertising materials mentioning features or use of this
339 * software must display the following acknowledgement:
340 * This product includes software developed by Powerdog Industries.
341 * 4. The name of Powerdog Industries may not be used to endorse or
342 * promote products derived from this software without specific prior
343 * written permission.
345 * THIS SOFTWARE IS PROVIDED BY POWERDOG INDUSTRIES ``AS IS'' AND ANY
346 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
347 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
348 * PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE POWERDOG INDUSTRIES BE
349 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
350 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
351 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
352 * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
353 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
354 * OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
355 * EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
360 static char copyright[] =
361 "@(#) Copyright (c) 1994 Powerdog Industries. All rights reserved.";
362 static char sccsid[] = "@(#)strptime.c 0.1 (Powerdog) 94/03/27";
363 #endif /* !defined NOID */
364 #endif /* not lint */
371 #include "pthread_private.h"
372 #endif /* _THREAD_SAFE */
374 static char * _strptime(pTHX_ const char *, const char *, struct tm *);
377 static struct pthread_mutex _gotgmt_mutexd = PTHREAD_MUTEX_STATIC_INITIALIZER;
378 static pthread_mutex_t gotgmt_mutex = &_gotgmt_mutexd;
382 #define asizeof(a) (sizeof (a) / sizeof ((a)[0]))
385 const char * mon[12];
386 const char * month[12];
387 const char * wday[7];
388 const char * weekday[7];
394 const char * date_fmt;
395 const char * alt_month[12];
400 struct lc_time_T _time_localebuf;
401 int _time_using_locale;
403 const struct lc_time_T _C_time_locale = {
405 "Jan", "Feb", "Mar", "Apr", "May", "Jun",
406 "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"
408 "January", "February", "March", "April", "May", "June",
409 "July", "August", "September", "October", "November", "December"
411 "Sun", "Mon", "Tue", "Wed",
414 "Sunday", "Monday", "Tuesday", "Wednesday",
415 "Thursday", "Friday", "Saturday"
423 ** Since the C language standard calls for
424 ** "date, using locale's date format," anything goes.
425 ** Using just numbers (as here) makes Quakers happier;
426 ** it's also compatible with SVR4.
431 ** c_fmt (ctime-compatible)
432 ** Not used, just compatibility placeholder.
446 "January", "February", "March", "April", "May", "June",
447 "July", "August", "September", "October", "November", "December"
451 ** To determine short months / day order
456 ** To determine long months / day order
461 #define Locale (&_C_time_locale)
464 _strptime(pTHX_ const char *buf, const char *fmt, struct tm *tm)
470 int Ealternative, Oalternative;
480 if (isspace((unsigned char)c))
481 while (*buf != 0 && isspace((unsigned char)*buf))
483 else if (c != *buf++)
500 buf = _strptime(aTHX_ buf, Locale->date_fmt, tm);
506 if (!isdigit((unsigned char)*buf))
509 /* XXX This will break for 3-digit centuries. */
511 for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) {
519 tm->tm_year = i * 100 - 1900;
523 /* NOTE: c_fmt is intentionally ignored */
524 buf = _strptime(aTHX_ buf, "%a %Ef %T %Y", tm);
530 buf = _strptime(aTHX_ buf, "%m/%d/%y", tm);
536 if (Ealternative || Oalternative)
542 if (Ealternative || Oalternative)
551 buf = _strptime(aTHX_ buf, (c == 'f') ? Locale->Ef_fmt : Locale->EF_fmt, tm);
557 buf = _strptime(aTHX_ buf, "%H:%M", tm);
563 buf = _strptime(aTHX_ buf, "%I:%M:%S %p", tm);
569 buf = _strptime(aTHX_ buf, "%H:%M:%S", tm);
575 buf = _strptime(aTHX_ buf, Locale->X_fmt, tm);
581 buf = _strptime(aTHX_ buf, Locale->x_fmt, tm);
587 if (!isdigit((unsigned char)*buf))
591 for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) {
596 if (i < 1 || i > 366)
604 if (*buf == 0 || isspace((unsigned char)*buf))
607 if (!isdigit((unsigned char)*buf))
611 for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) {
627 if (*buf != 0 && isspace((unsigned char)*buf))
628 while (*ptr != 0 && !isspace((unsigned char)*ptr))
637 * Of these, %l is the only specifier explicitly
638 * documented as not being zero-padded. However,
639 * there is no harm in allowing zero-padding.
641 * XXX The %l specifier may gobble one too many
642 * digits if used incorrectly.
644 if (!isdigit((unsigned char)*buf))
648 for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) {
653 if (c == 'H' || c == 'k') {
661 if (*buf != 0 && isspace((unsigned char)*buf))
662 while (*ptr != 0 && !isspace((unsigned char)*ptr))
668 * XXX This is bogus if parsed before hour-related
671 len = strlen(Locale->am);
672 if (strncasecmp(buf, Locale->am, len) == 0) {
673 if (tm->tm_hour > 12)
675 if (tm->tm_hour == 12)
681 len = strlen(Locale->pm);
682 if (strncasecmp(buf, Locale->pm, len) == 0) {
683 if (tm->tm_hour > 12)
685 if (tm->tm_hour != 12)
695 for (i = 0; i < asizeof(Locale->weekday); i++) {
697 len = strlen(Locale->weekday[i]);
703 len = strlen(Locale->wday[i]);
710 if (i == asizeof(Locale->weekday))
720 * XXX This is bogus, as we can not assume any valid
721 * information present in the tm structure at this
722 * point to calculate a real value, so just check the
725 if (!isdigit((unsigned char)*buf))
729 for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) {
737 if (*buf != 0 && isspace((unsigned char)*buf))
738 while (*ptr != 0 && !isspace((unsigned char)*ptr))
743 if (!isdigit((unsigned char)*buf))
752 if (*buf != 0 && isspace((unsigned char)*buf))
753 while (*ptr != 0 && !isspace((unsigned char)*ptr))
760 * The %e specifier is explicitly documented as not
761 * being zero-padded but there is no harm in allowing
764 * XXX The %e specifier may gobble one too many
765 * digits if used incorrectly.
767 if (!isdigit((unsigned char)*buf))
771 for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) {
781 if (*buf != 0 && isspace((unsigned char)*buf))
782 while (*ptr != 0 && !isspace((unsigned char)*ptr))
789 for (i = 0; i < asizeof(Locale->month); i++) {
792 len = strlen(Locale->alt_month[i]);
794 Locale->alt_month[i],
800 len = strlen(Locale->month[i]);
806 len = strlen(Locale->mon[i]);
814 if (i == asizeof(Locale->month))
822 if (!isdigit((unsigned char)*buf))
826 for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) {
836 if (*buf != 0 && isspace((unsigned char)*buf))
837 while (*ptr != 0 && !isspace((unsigned char)*ptr))
843 if (*buf == 0 || isspace((unsigned char)*buf))
846 if (!isdigit((unsigned char)*buf))
849 len = (c == 'Y') ? 4 : 2;
850 for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) {
857 if (c == 'y' && i < 69)
864 if (*buf != 0 && isspace((unsigned char)*buf))
865 while (*ptr != 0 && !isspace((unsigned char)*ptr))
874 for (cp = buf; *cp && isupper((unsigned char)*cp); ++cp)
877 zonestr = (char *)alloca(cp - buf + 1);
878 strncpy(zonestr, buf, cp - buf);
879 zonestr[cp - buf] = '\0';
881 if (0 == strcmp(zonestr, "GMT")) {
897 strptime(pTHX_ const char *buf, const char *fmt, struct tm *tm)
902 pthread_mutex_lock(&gotgmt_mutex);
906 ret = _strptime(aTHX_ buf, fmt, tm);
909 pthread_mutex_unlock(&gotgmt_mutex);
915 #endif /* !HAS_STRPTIME */
917 MODULE = Time::Piece PACKAGE = Time::Piece
922 _strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1)
938 memset(&mytm, 0, sizeof(mytm));
939 my_init_tm(&mytm); /* XXX workaround - see my_init_tm() above */
948 mytm.tm_isdst = isdst;
949 my_mini_mktime(&mytm);
950 len = strftime(tmpbuf, sizeof tmpbuf, fmt, &mytm);
952 ** The following is needed to handle to the situation where
953 ** tmpbuf overflows. Basically we want to allocate a buffer
954 ** and try repeatedly. The reason why it is so complicated
955 ** is that getting a return value of 0 from strftime can indicate
956 ** one of the following:
957 ** 1. buffer overflowed,
958 ** 2. illegal conversion specifier, or
959 ** 3. the format string specifies nothing to be returned(not
960 ** an error). This could be because format is an empty string
961 ** or it specifies %p that yields an empty string in some locale.
962 ** If there is a better way to make it portable, go ahead by
965 if ((len > 0 && len < sizeof(tmpbuf)) || (len == 0 && *fmt == '\0'))
966 ST(0) = sv_2mortal(newSVpv(tmpbuf, len));
968 /* Possibly buf overflowed - try again with a bigger buf */
969 int fmtlen = strlen(fmt);
970 int bufsize = fmtlen + sizeof(tmpbuf);
974 New(0, buf, bufsize, char);
976 buflen = strftime(buf, bufsize, fmt, &mytm);
977 if (buflen > 0 && buflen < bufsize)
979 /* heuristic to prevent out-of-memory errors */
980 if (bufsize > 100*fmtlen) {
986 Renew(buf, bufsize, char);
989 ST(0) = sv_2mortal(newSVpv(buf, buflen));
993 ST(0) = sv_2mortal(newSVpv(tmpbuf, len));
1004 _strptime ( string, format )
1015 remainder = (char *)strptime(string, format, &mytm);
1017 remainder = (char *)strptime(aTHX_ string, format, &mytm);
1019 if (remainder == NULL) {
1020 croak("Error parsing time");
1022 if (*remainder != '\0') {
1023 warn("garbage at end of string in strptime: %s", remainder);
1026 my_mini_mktime(&mytm);
1028 /* warn("tm: %d-%d-%d %d:%d:%d\n", mytm.tm_year, mytm.tm_mon, mytm.tm_mday, mytm.tm_hour, mytm.tm_min, mytm.tm_sec); */
1031 PUSHs(sv_2mortal(newSViv(mytm.tm_sec)));
1032 PUSHs(sv_2mortal(newSViv(mytm.tm_min)));
1033 PUSHs(sv_2mortal(newSViv(mytm.tm_hour)));
1034 PUSHs(sv_2mortal(newSViv(mytm.tm_mday)));
1035 PUSHs(sv_2mortal(newSViv(mytm.tm_mon)));
1036 PUSHs(sv_2mortal(newSViv(mytm.tm_year)));
1037 PUSHs(sv_2mortal(newSViv(mytm.tm_wday)));
1038 PUSHs(sv_2mortal(newSViv(mytm.tm_yday)));
1040 PUSHs(sv_2mortal(newSViv(0)));
1042 PUSHs(sv_2mortal(newSViv(0)));
1044 PUSHs(sv_2mortal(newSViv(0)));
1047 _mini_mktime(int sec, int min, int hour, int mday, int mon, int year)
1057 mytm.tm_hour = hour;
1058 mytm.tm_mday = mday;
1060 mytm.tm_year = year;
1062 my_mini_mktime(&mytm);
1065 PUSHs(sv_2mortal(newSViv(mytm.tm_sec)));
1066 PUSHs(sv_2mortal(newSViv(mytm.tm_min)));
1067 PUSHs(sv_2mortal(newSViv(mytm.tm_hour)));
1068 PUSHs(sv_2mortal(newSViv(mytm.tm_mday)));
1069 PUSHs(sv_2mortal(newSViv(mytm.tm_mon)));
1070 PUSHs(sv_2mortal(newSViv(mytm.tm_year)));
1071 PUSHs(sv_2mortal(newSViv(mytm.tm_wday)));
1072 PUSHs(sv_2mortal(newSViv(mytm.tm_yday)));
1074 PUSHs(sv_2mortal(newSViv(0)));
1076 PUSHs(sv_2mortal(newSViv(0)));
1078 PUSHs(sv_2mortal(newSViv(0)));