16fb12b70Safresh1 #define PERL_NO_GET_CONTEXT
2b39c5158Smillert #include "EXTERN.h"
3b39c5158Smillert #include "perl.h"
4b39c5158Smillert #include "XSUB.h"
5b39c5158Smillert #include <time.h>
6b39c5158Smillert
7b39c5158Smillert #define DAYS_PER_YEAR 365
8b39c5158Smillert #define DAYS_PER_QYEAR (4*DAYS_PER_YEAR+1)
9b39c5158Smillert #define DAYS_PER_CENT (25*DAYS_PER_QYEAR-1)
10b39c5158Smillert #define DAYS_PER_QCENT (4*DAYS_PER_CENT+1)
11b39c5158Smillert #define SECS_PER_HOUR (60*60)
12b39c5158Smillert #define SECS_PER_DAY (24*SECS_PER_HOUR)
13b39c5158Smillert /* parentheses deliberately absent on these two, otherwise they don't work */
14b39c5158Smillert #define MONTH_TO_DAYS 153/5
15b39c5158Smillert #define DAYS_TO_MONTH 5/153
16b39c5158Smillert /* offset to bias by March (month 4) 1st between month/mday & year finding */
17b39c5158Smillert #define YEAR_ADJUST (4*MONTH_TO_DAYS+1)
18b39c5158Smillert /* as used here, the algorithm leaves Sunday as day 1 unless we adjust it */
19b39c5158Smillert #define WEEKDAY_BIAS 6 /* (1+6)%7 makes Sunday 0 again */
20*9f11ffb7Safresh1 #define TP_BUF_SIZE 160
21b39c5158Smillert
22b39c5158Smillert #ifdef WIN32
23b39c5158Smillert
24b39c5158Smillert /*
25b39c5158Smillert * (1) The CRT maintains its own copy of the environment, separate from
26b39c5158Smillert * the Win32API copy.
27b39c5158Smillert *
28b39c5158Smillert * (2) CRT getenv() retrieves from this copy. CRT putenv() updates this
29b39c5158Smillert * copy, and then calls SetEnvironmentVariableA() to update the Win32API
30b39c5158Smillert * copy.
31b39c5158Smillert *
32b39c5158Smillert * (3) win32_getenv() and win32_putenv() call GetEnvironmentVariableA() and
33b39c5158Smillert * SetEnvironmentVariableA() directly, bypassing the CRT copy of the
34b39c5158Smillert * environment.
35b39c5158Smillert *
36b39c5158Smillert * (4) The CRT strftime() "%Z" implementation calls __tzset(). That
37b39c5158Smillert * calls CRT tzset(), but only the first time it is called, and in turn
38b39c5158Smillert * that uses CRT getenv("TZ") to retrieve the timezone info from the CRT
39b39c5158Smillert * local copy of the environment and hence gets the original setting as
40b39c5158Smillert * perl never updates the CRT copy when assigning to $ENV{TZ}.
41b39c5158Smillert *
42b39c5158Smillert * Therefore, we need to retrieve the value of $ENV{TZ} and call CRT
43b39c5158Smillert * putenv() to update the CRT copy of the environment (if it is different)
44b39c5158Smillert * whenever we're about to call tzset().
45b39c5158Smillert *
46b39c5158Smillert * In addition to all that, when perl is built with PERL_IMPLICIT_SYS
47b39c5158Smillert * defined:
48b39c5158Smillert *
49b39c5158Smillert * (a) Each interpreter has its own copy of the environment inside the
50b39c5158Smillert * perlhost structure. That allows applications that host multiple
51b39c5158Smillert * independent Perl interpreters to isolate environment changes from
52b39c5158Smillert * each other. (This is similar to how the perlhost mechanism keeps a
53b39c5158Smillert * separate working directory for each Perl interpreter, so that calling
54b39c5158Smillert * chdir() will not affect other interpreters.)
55b39c5158Smillert *
56b39c5158Smillert * (b) Only the first Perl interpreter instantiated within a process will
57b39c5158Smillert * "write through" environment changes to the process environment.
58b39c5158Smillert *
59b39c5158Smillert * (c) Even the primary Perl interpreter won't update the CRT copy of the
60b39c5158Smillert * the environment, only the Win32API copy (it calls win32_putenv()).
61b39c5158Smillert *
62b39c5158Smillert * As with CPerlHost::Getenv() and CPerlHost::Putenv() themselves, it makes
63b39c5158Smillert * sense to only update the process environment when inside the main
64b39c5158Smillert * interpreter, but we don't have access to CPerlHost's m_bTopLevel member
65b39c5158Smillert * from here so we'll just have to check PL_curinterp instead.
66b39c5158Smillert *
67b39c5158Smillert * Therefore, we can simply #undef getenv() and putenv() so that those names
68b39c5158Smillert * always refer to the CRT functions, and explicitly call win32_getenv() to
69b39c5158Smillert * access perl's %ENV.
70b39c5158Smillert *
71b39c5158Smillert * We also #undef malloc() and free() to be sure we are using the CRT
72b39c5158Smillert * functions otherwise under PERL_IMPLICIT_SYS they are redefined to calls
73b39c5158Smillert * into VMem::Malloc() and VMem::Free() and all allocations will be freed
74b39c5158Smillert * when the Perl interpreter is being destroyed so we'd end up with a pointer
75b39c5158Smillert * into deallocated memory in environ[] if a program embedding a Perl
76b39c5158Smillert * interpreter continues to operate even after the main Perl interpreter has
77b39c5158Smillert * been destroyed.
78b39c5158Smillert *
79b39c5158Smillert * Note that we don't free() the malloc()ed memory unless and until we call
80b39c5158Smillert * malloc() again ourselves because the CRT putenv() function simply puts its
81b39c5158Smillert * pointer argument into the environ[] arrary (it doesn't make a copy of it)
82b39c5158Smillert * so this memory must otherwise be leaked.
83b39c5158Smillert */
84b39c5158Smillert
85b39c5158Smillert #undef getenv
86b39c5158Smillert #undef putenv
876fb12b70Safresh1 # ifdef UNDER_CE
886fb12b70Safresh1 # define getenv xcegetenv
896fb12b70Safresh1 # define putenv xceputenv
906fb12b70Safresh1 # endif
91b39c5158Smillert #undef malloc
92b39c5158Smillert #undef free
93b39c5158Smillert
94b39c5158Smillert static void
fix_win32_tzenv(void)95b39c5158Smillert fix_win32_tzenv(void)
96b39c5158Smillert {
97b39c5158Smillert static char* oldenv = NULL;
98b39c5158Smillert char* newenv;
99b39c5158Smillert const char* perl_tz_env = win32_getenv("TZ");
100b39c5158Smillert const char* crt_tz_env = getenv("TZ");
101b39c5158Smillert if (perl_tz_env == NULL)
102b39c5158Smillert perl_tz_env = "";
103b39c5158Smillert if (crt_tz_env == NULL)
104b39c5158Smillert crt_tz_env = "";
105b39c5158Smillert if (strcmp(perl_tz_env, crt_tz_env) != 0) {
106b8851fccSafresh1 STRLEN perl_tz_env_len = strlen(perl_tz_env);
107*9f11ffb7Safresh1 newenv = (char*)malloc(perl_tz_env_len + 4);
108b39c5158Smillert if (newenv != NULL) {
109b8851fccSafresh1 /* putenv with old MS CRTs will cause a double free internally if you delete
110b8851fccSafresh1 an env var with the CRT env that doesn't exist in Win32 env (perl %ENV only
111b8851fccSafresh1 modifies the Win32 env, not CRT env), so always create the env var in Win32
112b8851fccSafresh1 env before deleting it with CRT env api, so the error branch never executes
113b8851fccSafresh1 in __crtsetenv after SetEnvironmentVariableA executes inside __crtsetenv.
114b8851fccSafresh1
115b8851fccSafresh1 VC 9/2008 and up dont have this bug, older VC (msvcrt80.dll and older) and
116b8851fccSafresh1 mingw (msvcrt.dll) have it see [perl #125529]
117b8851fccSafresh1 */
118b8851fccSafresh1 #if !(_MSC_VER >= 1500)
119b8851fccSafresh1 if(!perl_tz_env_len)
120b8851fccSafresh1 SetEnvironmentVariableA("TZ", "");
121b8851fccSafresh1 #endif
122b39c5158Smillert sprintf(newenv, "TZ=%s", perl_tz_env);
123b39c5158Smillert putenv(newenv);
124b39c5158Smillert if (oldenv != NULL)
125b39c5158Smillert free(oldenv);
126b39c5158Smillert oldenv = newenv;
127b39c5158Smillert }
128b39c5158Smillert }
129b39c5158Smillert }
130b39c5158Smillert
131b39c5158Smillert #endif
132b39c5158Smillert
133b39c5158Smillert /*
134b39c5158Smillert * my_tzset - wrapper to tzset() with a fix to make it work (better) on Win32.
135b39c5158Smillert * This code is duplicated in the POSIX module, so any changes made here
136b39c5158Smillert * should be made there too.
137b39c5158Smillert */
138b39c5158Smillert static void
my_tzset(pTHX)139b39c5158Smillert my_tzset(pTHX)
140b39c5158Smillert {
141b39c5158Smillert #ifdef WIN32
142b39c5158Smillert #if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
143b39c5158Smillert if (PL_curinterp == aTHX)
144b39c5158Smillert #endif
145b39c5158Smillert fix_win32_tzenv();
146b39c5158Smillert #endif
147b39c5158Smillert tzset();
148b39c5158Smillert }
149b39c5158Smillert
150b39c5158Smillert /*
151b39c5158Smillert * my_mini_mktime - normalise struct tm values without the localtime()
152b39c5158Smillert * semantics (and overhead) of mktime(). Stolen shamelessly from Perl's
153b39c5158Smillert * Perl_mini_mktime() in util.c - for details on the algorithm, see that
154b39c5158Smillert * file.
155b39c5158Smillert */
156b39c5158Smillert static void
my_mini_mktime(struct tm * ptm)157b39c5158Smillert my_mini_mktime(struct tm *ptm)
158b39c5158Smillert {
159b39c5158Smillert int yearday;
160b39c5158Smillert int secs;
161b39c5158Smillert int month, mday, year, jday;
162b39c5158Smillert int odd_cent, odd_year;
163b39c5158Smillert
164b39c5158Smillert year = 1900 + ptm->tm_year;
165b39c5158Smillert month = ptm->tm_mon;
166b39c5158Smillert mday = ptm->tm_mday;
167b39c5158Smillert /* allow given yday with no month & mday to dominate the result */
168b39c5158Smillert if (ptm->tm_yday >= 0 && mday <= 0 && month <= 0) {
169b39c5158Smillert month = 0;
170b39c5158Smillert mday = 0;
171b39c5158Smillert jday = 1 + ptm->tm_yday;
172b39c5158Smillert }
173b39c5158Smillert else {
174b39c5158Smillert jday = 0;
175b39c5158Smillert }
176b39c5158Smillert if (month >= 2)
177b39c5158Smillert month+=2;
178b39c5158Smillert else
179b39c5158Smillert month+=14, year--;
180b39c5158Smillert
181b39c5158Smillert yearday = DAYS_PER_YEAR * year + year/4 - year/100 + year/400;
182b39c5158Smillert yearday += month*MONTH_TO_DAYS + mday + jday;
183b39c5158Smillert /*
184b39c5158Smillert * Note that we don't know when leap-seconds were or will be,
185b39c5158Smillert * so we have to trust the user if we get something which looks
186b39c5158Smillert * like a sensible leap-second. Wild values for seconds will
187b39c5158Smillert * be rationalised, however.
188b39c5158Smillert */
189b39c5158Smillert if ((unsigned) ptm->tm_sec <= 60) {
190b39c5158Smillert secs = 0;
191b39c5158Smillert }
192b39c5158Smillert else {
193b39c5158Smillert secs = ptm->tm_sec;
194b39c5158Smillert ptm->tm_sec = 0;
195b39c5158Smillert }
196b39c5158Smillert secs += 60 * ptm->tm_min;
197b39c5158Smillert secs += SECS_PER_HOUR * ptm->tm_hour;
198b39c5158Smillert if (secs < 0) {
199b39c5158Smillert if (secs-(secs/SECS_PER_DAY*SECS_PER_DAY) < 0) {
200b39c5158Smillert /* got negative remainder, but need positive time */
201b39c5158Smillert /* back off an extra day to compensate */
202b39c5158Smillert yearday += (secs/SECS_PER_DAY)-1;
203b39c5158Smillert secs -= SECS_PER_DAY * (secs/SECS_PER_DAY - 1);
204b39c5158Smillert }
205b39c5158Smillert else {
206b39c5158Smillert yearday += (secs/SECS_PER_DAY);
207b39c5158Smillert secs -= SECS_PER_DAY * (secs/SECS_PER_DAY);
208b39c5158Smillert }
209b39c5158Smillert }
210b39c5158Smillert else if (secs >= SECS_PER_DAY) {
211b39c5158Smillert yearday += (secs/SECS_PER_DAY);
212b39c5158Smillert secs %= SECS_PER_DAY;
213b39c5158Smillert }
214b39c5158Smillert ptm->tm_hour = secs/SECS_PER_HOUR;
215b39c5158Smillert secs %= SECS_PER_HOUR;
216b39c5158Smillert ptm->tm_min = secs/60;
217b39c5158Smillert secs %= 60;
218b39c5158Smillert ptm->tm_sec += secs;
219b39c5158Smillert /* done with time of day effects */
220b39c5158Smillert /*
221b39c5158Smillert * The algorithm for yearday has (so far) left it high by 428.
222b39c5158Smillert * To avoid mistaking a legitimate Feb 29 as Mar 1, we need to
223b39c5158Smillert * bias it by 123 while trying to figure out what year it
224b39c5158Smillert * really represents. Even with this tweak, the reverse
225b39c5158Smillert * translation fails for years before A.D. 0001.
226b39c5158Smillert * It would still fail for Feb 29, but we catch that one below.
227b39c5158Smillert */
228b39c5158Smillert jday = yearday; /* save for later fixup vis-a-vis Jan 1 */
229b39c5158Smillert yearday -= YEAR_ADJUST;
230b39c5158Smillert year = (yearday / DAYS_PER_QCENT) * 400;
231b39c5158Smillert yearday %= DAYS_PER_QCENT;
232b39c5158Smillert odd_cent = yearday / DAYS_PER_CENT;
233b39c5158Smillert year += odd_cent * 100;
234b39c5158Smillert yearday %= DAYS_PER_CENT;
235b39c5158Smillert year += (yearday / DAYS_PER_QYEAR) * 4;
236b39c5158Smillert yearday %= DAYS_PER_QYEAR;
237b39c5158Smillert odd_year = yearday / DAYS_PER_YEAR;
238b39c5158Smillert year += odd_year;
239b39c5158Smillert yearday %= DAYS_PER_YEAR;
240b39c5158Smillert if (!yearday && (odd_cent==4 || odd_year==4)) { /* catch Feb 29 */
241b39c5158Smillert month = 1;
242b39c5158Smillert yearday = 29;
243b39c5158Smillert }
244b39c5158Smillert else {
245b39c5158Smillert yearday += YEAR_ADJUST; /* recover March 1st crock */
246b39c5158Smillert month = yearday*DAYS_TO_MONTH;
247b39c5158Smillert yearday -= month*MONTH_TO_DAYS;
248b39c5158Smillert /* recover other leap-year adjustment */
249b39c5158Smillert if (month > 13) {
250b39c5158Smillert month-=14;
251b39c5158Smillert year++;
252b39c5158Smillert }
253b39c5158Smillert else {
254b39c5158Smillert month-=2;
255b39c5158Smillert }
256b39c5158Smillert }
257b39c5158Smillert ptm->tm_year = year - 1900;
258b39c5158Smillert if (yearday) {
259b39c5158Smillert ptm->tm_mday = yearday;
260b39c5158Smillert ptm->tm_mon = month;
261b39c5158Smillert }
262b39c5158Smillert else {
263b39c5158Smillert ptm->tm_mday = 31;
264b39c5158Smillert ptm->tm_mon = month - 1;
265b39c5158Smillert }
266b39c5158Smillert /* re-build yearday based on Jan 1 to get tm_yday */
267b39c5158Smillert year--;
268b39c5158Smillert yearday = year*DAYS_PER_YEAR + year/4 - year/100 + year/400;
269b39c5158Smillert yearday += 14*MONTH_TO_DAYS + 1;
270b39c5158Smillert ptm->tm_yday = jday - yearday;
271b39c5158Smillert /* fix tm_wday if not overridden by caller */
272b39c5158Smillert ptm->tm_wday = (jday + WEEKDAY_BIAS) % 7;
273b39c5158Smillert }
274b39c5158Smillert
275b39c5158Smillert # if defined(WIN32) || (defined(__QNX__) && defined(__WATCOMC__))
276b39c5158Smillert # define strncasecmp(x,y,n) strnicmp(x,y,n)
277b39c5158Smillert # endif
278b39c5158Smillert
279b8851fccSafresh1 /* strptime.c 0.1 (Powerdog) 94/03/27 */
280b39c5158Smillert /* strptime copied from freebsd with the following copyright: */
281b39c5158Smillert /*
282b39c5158Smillert * Copyright (c) 1994 Powerdog Industries. All rights reserved.
283b39c5158Smillert *
284b39c5158Smillert * Redistribution and use in source and binary forms, with or without
285b39c5158Smillert * modification, are permitted provided that the following conditions
286b39c5158Smillert * are met:
287b8851fccSafresh1 *
288b39c5158Smillert * 1. Redistributions of source code must retain the above copyright
289b39c5158Smillert * notice, this list of conditions and the following disclaimer.
290b8851fccSafresh1 *
291b39c5158Smillert * 2. Redistributions in binary form must reproduce the above copyright
292b39c5158Smillert * notice, this list of conditions and the following disclaimer
293b39c5158Smillert * in the documentation and/or other materials provided with the
294b39c5158Smillert * distribution.
295b39c5158Smillert *
296b39c5158Smillert * THIS SOFTWARE IS PROVIDED BY POWERDOG INDUSTRIES ``AS IS'' AND ANY
297b39c5158Smillert * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
298b39c5158Smillert * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
299b39c5158Smillert * PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE POWERDOG INDUSTRIES BE
300b39c5158Smillert * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
301b39c5158Smillert * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
302b39c5158Smillert * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
303b39c5158Smillert * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
304b39c5158Smillert * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
305b39c5158Smillert * OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
306b39c5158Smillert * EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
307b8851fccSafresh1 *
308b8851fccSafresh1 * The views and conclusions contained in the software and documentation
309b8851fccSafresh1 * are those of the authors and should not be interpreted as representing
310b8851fccSafresh1 * official policies, either expressed or implied, of Powerdog Industries.
311b39c5158Smillert */
312b39c5158Smillert
313b39c5158Smillert #include <time.h>
314b39c5158Smillert #include <ctype.h>
315b39c5158Smillert #include <string.h>
316898184e3Ssthen static char * _strptime(pTHX_ const char *, const char *, struct tm *,
317898184e3Ssthen int *got_GMT);
318b39c5158Smillert
319b39c5158Smillert #define asizeof(a) (sizeof (a) / sizeof ((a)[0]))
320b39c5158Smillert
321b39c5158Smillert struct lc_time_T {
322*9f11ffb7Safresh1 char * mon[12];
323*9f11ffb7Safresh1 char * month[12];
324*9f11ffb7Safresh1 char * wday[7];
325*9f11ffb7Safresh1 char * weekday[7];
326*9f11ffb7Safresh1 char * am;
327*9f11ffb7Safresh1 char * pm;
328*9f11ffb7Safresh1 char * AM;
329*9f11ffb7Safresh1 char * PM;
330*9f11ffb7Safresh1 char * alt_month[12];
331b39c5158Smillert };
332b39c5158Smillert
333b39c5158Smillert
334*9f11ffb7Safresh1 static struct lc_time_T _C_time_locale;
335b39c5158Smillert
336b39c5158Smillert #define Locale (&_C_time_locale)
337b39c5158Smillert
338b39c5158Smillert static char *
_strptime(pTHX_ const char * buf,const char * fmt,struct tm * tm,int * got_GMT)339898184e3Ssthen _strptime(pTHX_ const char *buf, const char *fmt, struct tm *tm, int *got_GMT)
340b39c5158Smillert {
341b39c5158Smillert char c;
342b39c5158Smillert const char *ptr;
343*9f11ffb7Safresh1 int i;
344*9f11ffb7Safresh1 size_t len;
345b39c5158Smillert int Ealternative, Oalternative;
346b39c5158Smillert
347898184e3Ssthen /* There seems to be a slightly improved version at
348898184e3Ssthen * http://www.opensource.apple.com/source/Libc/Libc-583/stdtime/strptime-fbsd.c
349898184e3Ssthen * which we may end up borrowing more from
350898184e3Ssthen */
351b39c5158Smillert ptr = fmt;
352b39c5158Smillert while (*ptr != 0) {
353b39c5158Smillert if (*buf == 0)
354b39c5158Smillert break;
355b39c5158Smillert
356b39c5158Smillert c = *ptr++;
357b39c5158Smillert
358b39c5158Smillert if (c != '%') {
359b39c5158Smillert if (isspace((unsigned char)c))
360b39c5158Smillert while (*buf != 0 && isspace((unsigned char)*buf))
361b39c5158Smillert buf++;
362b39c5158Smillert else if (c != *buf++)
363b39c5158Smillert return 0;
364b39c5158Smillert continue;
365b39c5158Smillert }
366b39c5158Smillert
367b39c5158Smillert Ealternative = 0;
368b39c5158Smillert Oalternative = 0;
369b39c5158Smillert label:
370b39c5158Smillert c = *ptr++;
371b39c5158Smillert switch (c) {
372b39c5158Smillert case 0:
373b39c5158Smillert case '%':
374b39c5158Smillert if (*buf++ != '%')
375b39c5158Smillert return 0;
376b39c5158Smillert break;
377b39c5158Smillert
378b39c5158Smillert case '+':
379*9f11ffb7Safresh1 buf = _strptime(aTHX_ buf, "%c", tm, got_GMT);
380b39c5158Smillert if (buf == 0)
381b39c5158Smillert return 0;
382b39c5158Smillert break;
383b39c5158Smillert
384b39c5158Smillert case 'C':
385b39c5158Smillert if (!isdigit((unsigned char)*buf))
386b39c5158Smillert return 0;
387b39c5158Smillert
388b39c5158Smillert /* XXX This will break for 3-digit centuries. */
389b39c5158Smillert len = 2;
390b39c5158Smillert for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) {
391b39c5158Smillert i *= 10;
392b39c5158Smillert i += *buf - '0';
393b39c5158Smillert len--;
394b39c5158Smillert }
395b39c5158Smillert if (i < 19)
396b39c5158Smillert return 0;
397b39c5158Smillert
398b39c5158Smillert tm->tm_year = i * 100 - 1900;
399b39c5158Smillert break;
400b39c5158Smillert
401b39c5158Smillert case 'c':
402b39c5158Smillert /* NOTE: c_fmt is intentionally ignored */
403*9f11ffb7Safresh1
404*9f11ffb7Safresh1 buf = _strptime(aTHX_ buf, "%a %d %b %Y %I:%M:%S %p %Z", tm, got_GMT);
405b39c5158Smillert if (buf == 0)
406b39c5158Smillert return 0;
407b39c5158Smillert break;
408b39c5158Smillert
409b39c5158Smillert case 'D':
410898184e3Ssthen buf = _strptime(aTHX_ buf, "%m/%d/%y", tm, got_GMT);
411b39c5158Smillert if (buf == 0)
412b39c5158Smillert return 0;
413b39c5158Smillert break;
414b39c5158Smillert
415b39c5158Smillert case 'E':
416b39c5158Smillert if (Ealternative || Oalternative)
417b39c5158Smillert break;
418b39c5158Smillert Ealternative++;
419b39c5158Smillert goto label;
420b39c5158Smillert
421b39c5158Smillert case 'O':
422b39c5158Smillert if (Ealternative || Oalternative)
423b39c5158Smillert break;
424b39c5158Smillert Oalternative++;
425b39c5158Smillert goto label;
426b39c5158Smillert
427b39c5158Smillert case 'F':
428*9f11ffb7Safresh1 buf = _strptime(aTHX_ buf, "%Y-%m-%d", tm, got_GMT);
429b39c5158Smillert if (buf == 0)
430b39c5158Smillert return 0;
431b39c5158Smillert break;
432b39c5158Smillert
433b39c5158Smillert case 'R':
434898184e3Ssthen buf = _strptime(aTHX_ buf, "%H:%M", tm, got_GMT);
435b39c5158Smillert if (buf == 0)
436b39c5158Smillert return 0;
437b39c5158Smillert break;
438b39c5158Smillert
439b39c5158Smillert case 'r':
440898184e3Ssthen buf = _strptime(aTHX_ buf, "%I:%M:%S %p", tm, got_GMT);
441b39c5158Smillert if (buf == 0)
442b39c5158Smillert return 0;
443b39c5158Smillert break;
444b39c5158Smillert
445898184e3Ssthen case 'n': /* whitespace */
446898184e3Ssthen case 't':
447898184e3Ssthen if (!isspace((unsigned char)*buf))
448898184e3Ssthen return 0;
449898184e3Ssthen while (isspace((unsigned char)*buf))
450898184e3Ssthen buf++;
451898184e3Ssthen break;
452898184e3Ssthen
453b39c5158Smillert case 'T':
454898184e3Ssthen buf = _strptime(aTHX_ buf, "%H:%M:%S", tm, got_GMT);
455b39c5158Smillert if (buf == 0)
456b39c5158Smillert return 0;
457b39c5158Smillert break;
458b39c5158Smillert
459b39c5158Smillert case 'X':
460*9f11ffb7Safresh1 buf = _strptime(aTHX_ buf, "%I:%M:%S %p", tm, got_GMT);
461b39c5158Smillert if (buf == 0)
462b39c5158Smillert return 0;
463b39c5158Smillert break;
464b39c5158Smillert
465b39c5158Smillert case 'x':
466*9f11ffb7Safresh1 buf = _strptime(aTHX_ buf, "%a %d %b %Y", tm, got_GMT);
467b39c5158Smillert if (buf == 0)
468b39c5158Smillert return 0;
469b39c5158Smillert break;
470b39c5158Smillert
471b39c5158Smillert case 'j':
472b39c5158Smillert if (!isdigit((unsigned char)*buf))
473b39c5158Smillert return 0;
474b39c5158Smillert
475b39c5158Smillert len = 3;
476b39c5158Smillert for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) {
477b39c5158Smillert i *= 10;
478b39c5158Smillert i += *buf - '0';
479b39c5158Smillert len--;
480b39c5158Smillert }
481b39c5158Smillert if (i < 1 || i > 366)
482b39c5158Smillert return 0;
483b39c5158Smillert
484b39c5158Smillert tm->tm_yday = i - 1;
4856fb12b70Safresh1 tm->tm_mday = 0;
486b39c5158Smillert break;
487b39c5158Smillert
488b39c5158Smillert case 'M':
489b39c5158Smillert case 'S':
490b39c5158Smillert if (*buf == 0 || isspace((unsigned char)*buf))
491b39c5158Smillert break;
492b39c5158Smillert
493b39c5158Smillert if (!isdigit((unsigned char)*buf))
494b39c5158Smillert return 0;
495b39c5158Smillert
496b39c5158Smillert len = 2;
497b39c5158Smillert for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) {
498b39c5158Smillert i *= 10;
499b39c5158Smillert i += *buf - '0';
500b39c5158Smillert len--;
501b39c5158Smillert }
502b39c5158Smillert
503b39c5158Smillert if (c == 'M') {
504b39c5158Smillert if (i > 59)
505b39c5158Smillert return 0;
506b39c5158Smillert tm->tm_min = i;
507b39c5158Smillert } else {
508b39c5158Smillert if (i > 60)
509b39c5158Smillert return 0;
510b39c5158Smillert tm->tm_sec = i;
511b39c5158Smillert }
512b39c5158Smillert
513b39c5158Smillert if (*buf != 0 && isspace((unsigned char)*buf))
514b39c5158Smillert while (*ptr != 0 && !isspace((unsigned char)*ptr))
515b39c5158Smillert ptr++;
516b39c5158Smillert break;
517b39c5158Smillert
518b39c5158Smillert case 'H':
519b39c5158Smillert case 'I':
520b39c5158Smillert case 'k':
521b39c5158Smillert case 'l':
522b39c5158Smillert /*
523b39c5158Smillert * Of these, %l is the only specifier explicitly
524b39c5158Smillert * documented as not being zero-padded. However,
525b39c5158Smillert * there is no harm in allowing zero-padding.
526b39c5158Smillert *
527b39c5158Smillert * XXX The %l specifier may gobble one too many
528b39c5158Smillert * digits if used incorrectly.
529b39c5158Smillert */
530b39c5158Smillert if (!isdigit((unsigned char)*buf))
531b39c5158Smillert return 0;
532b39c5158Smillert
533b39c5158Smillert len = 2;
534b39c5158Smillert for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) {
535b39c5158Smillert i *= 10;
536b39c5158Smillert i += *buf - '0';
537b39c5158Smillert len--;
538b39c5158Smillert }
539b39c5158Smillert if (c == 'H' || c == 'k') {
540b39c5158Smillert if (i > 23)
541b39c5158Smillert return 0;
542b39c5158Smillert } else if (i > 12)
543b39c5158Smillert return 0;
544b39c5158Smillert
545b39c5158Smillert tm->tm_hour = i;
546b39c5158Smillert
547b39c5158Smillert if (*buf != 0 && isspace((unsigned char)*buf))
548b39c5158Smillert while (*ptr != 0 && !isspace((unsigned char)*ptr))
549b39c5158Smillert ptr++;
550b39c5158Smillert break;
551b39c5158Smillert
552b39c5158Smillert case 'p':
553*9f11ffb7Safresh1 case 'P':
554b39c5158Smillert /*
555b39c5158Smillert * XXX This is bogus if parsed before hour-related
556b39c5158Smillert * specifiers.
557b39c5158Smillert */
558b39c5158Smillert len = strlen(Locale->am);
559*9f11ffb7Safresh1 if (strncasecmp(buf, Locale->am, len) == 0 ||
560*9f11ffb7Safresh1 strncasecmp(buf, Locale->AM, len) == 0) {
561b39c5158Smillert if (tm->tm_hour > 12)
562b39c5158Smillert return 0;
563b39c5158Smillert if (tm->tm_hour == 12)
564b39c5158Smillert tm->tm_hour = 0;
565b39c5158Smillert buf += len;
566b39c5158Smillert break;
567b39c5158Smillert }
568b39c5158Smillert
569b39c5158Smillert len = strlen(Locale->pm);
570*9f11ffb7Safresh1 if (strncasecmp(buf, Locale->pm, len) == 0 ||
571*9f11ffb7Safresh1 strncasecmp(buf, Locale->PM, len) == 0) {
572b39c5158Smillert if (tm->tm_hour > 12)
573b39c5158Smillert return 0;
574b39c5158Smillert if (tm->tm_hour != 12)
575b39c5158Smillert tm->tm_hour += 12;
576b39c5158Smillert buf += len;
577b39c5158Smillert break;
578b39c5158Smillert }
579b39c5158Smillert
580b39c5158Smillert return 0;
581b39c5158Smillert
582b39c5158Smillert case 'A':
583b39c5158Smillert case 'a':
584b8851fccSafresh1 for (i = 0; i < (int)asizeof(Locale->weekday); i++) {
585b39c5158Smillert if (c == 'A') {
586b39c5158Smillert len = strlen(Locale->weekday[i]);
587b39c5158Smillert if (strncasecmp(buf,
588b39c5158Smillert Locale->weekday[i],
589b39c5158Smillert len) == 0)
590b39c5158Smillert break;
591b39c5158Smillert } else {
592b39c5158Smillert len = strlen(Locale->wday[i]);
593b39c5158Smillert if (strncasecmp(buf,
594b39c5158Smillert Locale->wday[i],
595b39c5158Smillert len) == 0)
596b39c5158Smillert break;
597b39c5158Smillert }
598b39c5158Smillert }
599b8851fccSafresh1 if (i == (int)asizeof(Locale->weekday))
600b39c5158Smillert return 0;
601b39c5158Smillert
602b39c5158Smillert tm->tm_wday = i;
603b39c5158Smillert buf += len;
604b39c5158Smillert break;
605b39c5158Smillert
606b39c5158Smillert case 'U':
607*9f11ffb7Safresh1 case 'V':
608b39c5158Smillert case 'W':
609b39c5158Smillert /*
610b39c5158Smillert * XXX This is bogus, as we can not assume any valid
611b39c5158Smillert * information present in the tm structure at this
612b39c5158Smillert * point to calculate a real value, so just check the
613b39c5158Smillert * range for now.
614b39c5158Smillert */
615b39c5158Smillert if (!isdigit((unsigned char)*buf))
616b39c5158Smillert return 0;
617b39c5158Smillert
618b39c5158Smillert len = 2;
619b39c5158Smillert for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) {
620b39c5158Smillert i *= 10;
621b39c5158Smillert i += *buf - '0';
622b39c5158Smillert len--;
623b39c5158Smillert }
624b39c5158Smillert if (i > 53)
625b39c5158Smillert return 0;
626b39c5158Smillert
627b39c5158Smillert if (*buf != 0 && isspace((unsigned char)*buf))
628b39c5158Smillert while (*ptr != 0 && !isspace((unsigned char)*ptr))
629b39c5158Smillert ptr++;
630b39c5158Smillert break;
631b39c5158Smillert
632*9f11ffb7Safresh1 case 'u':
633b39c5158Smillert case 'w':
634b39c5158Smillert if (!isdigit((unsigned char)*buf))
635b39c5158Smillert return 0;
636b39c5158Smillert
637b39c5158Smillert i = *buf - '0';
638*9f11ffb7Safresh1 if (i > 6 + (c == 'u'))
639b39c5158Smillert return 0;
640*9f11ffb7Safresh1 if (i == 7)
641*9f11ffb7Safresh1 i = 0;
642b39c5158Smillert
643b39c5158Smillert tm->tm_wday = i;
644b39c5158Smillert
645*9f11ffb7Safresh1 buf++;
646b39c5158Smillert if (*buf != 0 && isspace((unsigned char)*buf))
647b39c5158Smillert while (*ptr != 0 && !isspace((unsigned char)*ptr))
648b39c5158Smillert ptr++;
649b39c5158Smillert break;
650b39c5158Smillert
651b39c5158Smillert case 'd':
652b39c5158Smillert case 'e':
653b39c5158Smillert /*
654b39c5158Smillert * The %e specifier is explicitly documented as not
655b39c5158Smillert * being zero-padded but there is no harm in allowing
656b39c5158Smillert * such padding.
657b39c5158Smillert *
658b39c5158Smillert * XXX The %e specifier may gobble one too many
659b39c5158Smillert * digits if used incorrectly.
660b39c5158Smillert */
661b39c5158Smillert if (!isdigit((unsigned char)*buf))
662b39c5158Smillert return 0;
663b39c5158Smillert
664b39c5158Smillert len = 2;
665b39c5158Smillert for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) {
666b39c5158Smillert i *= 10;
667b39c5158Smillert i += *buf - '0';
668b39c5158Smillert len--;
669b39c5158Smillert }
670b39c5158Smillert if (i > 31)
671b39c5158Smillert return 0;
672b39c5158Smillert
673b39c5158Smillert tm->tm_mday = i;
674b39c5158Smillert
675b39c5158Smillert if (*buf != 0 && isspace((unsigned char)*buf))
676b39c5158Smillert while (*ptr != 0 && !isspace((unsigned char)*ptr))
677b39c5158Smillert ptr++;
678b39c5158Smillert break;
679b39c5158Smillert
680b39c5158Smillert case 'B':
681b39c5158Smillert case 'b':
682b39c5158Smillert case 'h':
683b8851fccSafresh1 for (i = 0; i < (int)asizeof(Locale->month); i++) {
684b39c5158Smillert if (Oalternative) {
685b39c5158Smillert if (c == 'B') {
686b39c5158Smillert len = strlen(Locale->alt_month[i]);
687b39c5158Smillert if (strncasecmp(buf,
688b39c5158Smillert Locale->alt_month[i],
689b39c5158Smillert len) == 0)
690b39c5158Smillert break;
691b39c5158Smillert }
692b39c5158Smillert } else {
693b39c5158Smillert if (c == 'B') {
694b39c5158Smillert len = strlen(Locale->month[i]);
695b39c5158Smillert if (strncasecmp(buf,
696b39c5158Smillert Locale->month[i],
697b39c5158Smillert len) == 0)
698b39c5158Smillert break;
699b39c5158Smillert } else {
700b39c5158Smillert len = strlen(Locale->mon[i]);
701b39c5158Smillert if (strncasecmp(buf,
702b39c5158Smillert Locale->mon[i],
703b39c5158Smillert len) == 0)
704b39c5158Smillert break;
705b39c5158Smillert }
706b39c5158Smillert }
707b39c5158Smillert }
708b8851fccSafresh1 if (i == (int)asizeof(Locale->month))
709b39c5158Smillert return 0;
710b39c5158Smillert
711b39c5158Smillert tm->tm_mon = i;
712b39c5158Smillert buf += len;
713b39c5158Smillert break;
714b39c5158Smillert
715b39c5158Smillert case 'm':
716b39c5158Smillert if (!isdigit((unsigned char)*buf))
717b39c5158Smillert return 0;
718b39c5158Smillert
719b39c5158Smillert len = 2;
720b39c5158Smillert for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) {
721b39c5158Smillert i *= 10;
722b39c5158Smillert i += *buf - '0';
723b39c5158Smillert len--;
724b39c5158Smillert }
725b39c5158Smillert if (i < 1 || i > 12)
726b39c5158Smillert return 0;
727b39c5158Smillert
728b39c5158Smillert tm->tm_mon = i - 1;
729b39c5158Smillert
730b39c5158Smillert if (*buf != 0 && isspace((unsigned char)*buf))
731b39c5158Smillert while (*ptr != 0 && !isspace((unsigned char)*ptr))
732b39c5158Smillert ptr++;
733b39c5158Smillert break;
734b39c5158Smillert
735898184e3Ssthen case 's':
736898184e3Ssthen {
737898184e3Ssthen char *cp;
738898184e3Ssthen int sverrno;
739898184e3Ssthen long n;
740898184e3Ssthen time_t t;
741898184e3Ssthen struct tm mytm;
742898184e3Ssthen
743898184e3Ssthen sverrno = errno;
744898184e3Ssthen errno = 0;
745898184e3Ssthen n = strtol(buf, &cp, 10);
746898184e3Ssthen if (errno == ERANGE || (long)(t = n) != n) {
747898184e3Ssthen errno = sverrno;
748898184e3Ssthen return 0;
749898184e3Ssthen }
750898184e3Ssthen errno = sverrno;
751898184e3Ssthen buf = cp;
752898184e3Ssthen memset(&mytm, 0, sizeof(mytm));
753*9f11ffb7Safresh1
754*9f11ffb7Safresh1 if(*got_GMT == 1)
755*9f11ffb7Safresh1 mytm = *localtime(&t);
756*9f11ffb7Safresh1 else
757898184e3Ssthen mytm = *gmtime(&t);
758*9f11ffb7Safresh1
759898184e3Ssthen tm->tm_sec = mytm.tm_sec;
760898184e3Ssthen tm->tm_min = mytm.tm_min;
761898184e3Ssthen tm->tm_hour = mytm.tm_hour;
762898184e3Ssthen tm->tm_mday = mytm.tm_mday;
763898184e3Ssthen tm->tm_mon = mytm.tm_mon;
764898184e3Ssthen tm->tm_year = mytm.tm_year;
765898184e3Ssthen tm->tm_wday = mytm.tm_wday;
766898184e3Ssthen tm->tm_yday = mytm.tm_yday;
767898184e3Ssthen tm->tm_isdst = mytm.tm_isdst;
768898184e3Ssthen }
769898184e3Ssthen break;
770898184e3Ssthen
771b39c5158Smillert case 'Y':
772b39c5158Smillert case 'y':
773b39c5158Smillert if (*buf == 0 || isspace((unsigned char)*buf))
774b39c5158Smillert break;
775b39c5158Smillert
776b39c5158Smillert if (!isdigit((unsigned char)*buf))
777b39c5158Smillert return 0;
778b39c5158Smillert
779b39c5158Smillert len = (c == 'Y') ? 4 : 2;
780b39c5158Smillert for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) {
781b39c5158Smillert i *= 10;
782b39c5158Smillert i += *buf - '0';
783b39c5158Smillert len--;
784b39c5158Smillert }
785b39c5158Smillert if (c == 'Y')
786b39c5158Smillert i -= 1900;
787b39c5158Smillert if (c == 'y' && i < 69)
788b39c5158Smillert i += 100;
789b39c5158Smillert if (i < 0)
790b39c5158Smillert return 0;
791b39c5158Smillert
792b39c5158Smillert tm->tm_year = i;
793b39c5158Smillert
794b39c5158Smillert if (*buf != 0 && isspace((unsigned char)*buf))
795b39c5158Smillert while (*ptr != 0 && !isspace((unsigned char)*ptr))
796b39c5158Smillert ptr++;
797b39c5158Smillert break;
798b39c5158Smillert
799b39c5158Smillert case 'Z':
800b39c5158Smillert {
801b39c5158Smillert const char *cp;
802b39c5158Smillert char *zonestr;
803b39c5158Smillert
804b39c5158Smillert for (cp = buf; *cp && isupper((unsigned char)*cp); ++cp)
805b39c5158Smillert {/*empty*/}
806b39c5158Smillert if (cp - buf) {
807*9f11ffb7Safresh1 zonestr = (char *)malloc((size_t) (cp - buf + 1));
808898184e3Ssthen if (!zonestr) {
809898184e3Ssthen errno = ENOMEM;
810898184e3Ssthen return 0;
811898184e3Ssthen }
812*9f11ffb7Safresh1 strncpy(zonestr, buf,(size_t) (cp - buf));
813b39c5158Smillert zonestr[cp - buf] = '\0';
814b39c5158Smillert my_tzset(aTHX);
815b39c5158Smillert if (0 == strcmp(zonestr, "GMT")) {
816898184e3Ssthen *got_GMT = 1;
817b39c5158Smillert }
818898184e3Ssthen free(zonestr);
819898184e3Ssthen if (!*got_GMT) return 0;
820b39c5158Smillert buf += cp - buf;
821b39c5158Smillert }
822b39c5158Smillert }
823b39c5158Smillert break;
824898184e3Ssthen
825898184e3Ssthen case 'z':
826898184e3Ssthen {
827898184e3Ssthen int sign = 1;
828898184e3Ssthen
829898184e3Ssthen if (*buf != '+') {
830898184e3Ssthen if (*buf == '-')
831898184e3Ssthen sign = -1;
832898184e3Ssthen else
833898184e3Ssthen return 0;
834898184e3Ssthen }
835898184e3Ssthen
836898184e3Ssthen buf++;
837898184e3Ssthen i = 0;
838898184e3Ssthen for (len = 4; len > 0; len--) {
839898184e3Ssthen if (isdigit((int)*buf)) {
840898184e3Ssthen i *= 10;
841898184e3Ssthen i += *buf - '0';
842898184e3Ssthen buf++;
843898184e3Ssthen } else
844898184e3Ssthen return 0;
845898184e3Ssthen }
846898184e3Ssthen
847898184e3Ssthen tm->tm_hour -= sign * (i / 100);
848898184e3Ssthen tm->tm_min -= sign * (i % 100);
849898184e3Ssthen *got_GMT = 1;
850898184e3Ssthen }
851898184e3Ssthen break;
852b39c5158Smillert }
853b39c5158Smillert }
854b39c5158Smillert return (char *)buf;
855b39c5158Smillert }
856b39c5158Smillert
8576fb12b70Safresh1 /* Saves alot of machine code.
8586fb12b70Safresh1 Takes a (auto) SP, which may or may not have been PUSHed before, puts
8596fb12b70Safresh1 tm struct members on Perl stack, then returns new, advanced, SP to caller.
8606fb12b70Safresh1 Assign the return of push_common_tm to your SP, so you can continue to PUSH
8616fb12b70Safresh1 or do a PUTBACK and return eventually.
8626fb12b70Safresh1 !!!! push_common_tm does not touch PL_stack_sp !!!!
8636fb12b70Safresh1 !!!! do not use PUTBACK then SPAGAIN semantics around push_common_tm !!!!
8646fb12b70Safresh1 !!!! You must mortalize whatever push_common_tm put on stack yourself to
8656fb12b70Safresh1 avoid leaking !!!!
8666fb12b70Safresh1 */
867*9f11ffb7Safresh1 static SV **
push_common_tm(pTHX_ SV ** SP,struct tm * mytm)8686fb12b70Safresh1 push_common_tm(pTHX_ SV ** SP, struct tm *mytm)
869b39c5158Smillert {
8706fb12b70Safresh1 PUSHs(newSViv(mytm->tm_sec));
8716fb12b70Safresh1 PUSHs(newSViv(mytm->tm_min));
8726fb12b70Safresh1 PUSHs(newSViv(mytm->tm_hour));
8736fb12b70Safresh1 PUSHs(newSViv(mytm->tm_mday));
8746fb12b70Safresh1 PUSHs(newSViv(mytm->tm_mon));
8756fb12b70Safresh1 PUSHs(newSViv(mytm->tm_year));
8766fb12b70Safresh1 PUSHs(newSViv(mytm->tm_wday));
8776fb12b70Safresh1 PUSHs(newSViv(mytm->tm_yday));
878b8851fccSafresh1 PUSHs(newSViv(mytm->tm_isdst));
8796fb12b70Safresh1 return SP;
8806fb12b70Safresh1 }
881b39c5158Smillert
8826fb12b70Safresh1 /* specialized common end of 2 XSUBs
8836fb12b70Safresh1 SV ** SP -- pass your (auto) SP, which has not been PUSHed before, but was
8846fb12b70Safresh1 reset to 0 (PPCODE only or SP -= items or XSprePUSH)
8856fb12b70Safresh1 tm *mytm -- a tm *, will be proprocessed with my_mini_mktime
8866fb12b70Safresh1 return -- none, after calling return_11part_tm, you must call "return;"
8876fb12b70Safresh1 no exceptions
8886fb12b70Safresh1 */
889*9f11ffb7Safresh1 static void
return_11part_tm(pTHX_ SV ** SP,struct tm * mytm)8906fb12b70Safresh1 return_11part_tm(pTHX_ SV ** SP, struct tm *mytm)
8916fb12b70Safresh1 {
8926fb12b70Safresh1 my_mini_mktime(mytm);
8936fb12b70Safresh1
894*9f11ffb7Safresh1 /* 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); */
8956fb12b70Safresh1 EXTEND(SP, 11);
8966fb12b70Safresh1 SP = push_common_tm(aTHX_ SP, mytm);
8976fb12b70Safresh1 /* epoch */
8986fb12b70Safresh1 PUSHs(newSViv(0));
8996fb12b70Safresh1 /* islocal */
9006fb12b70Safresh1 PUSHs(newSViv(0));
9016fb12b70Safresh1 PUTBACK;
9026fb12b70Safresh1 {
9036fb12b70Safresh1 SV ** endsp = SP; /* the SV * under SP needs to be mortaled */
9046fb12b70Safresh1 SP -= (11 - 1); /* subtract 0 based count of SVs to mortal */
9056fb12b70Safresh1 /* mortal target of SP, then increment before function call
9066fb12b70Safresh1 so SP is already calculated before next comparison to not stall CPU */
9076fb12b70Safresh1 do {
9086fb12b70Safresh1 sv_2mortal(*SP++);
9096fb12b70Safresh1 } while(SP <= endsp);
9106fb12b70Safresh1 }
9116fb12b70Safresh1 return;
912b39c5158Smillert }
913b39c5158Smillert
914*9f11ffb7Safresh1
_populate_C_time_locale(pTHX_ HV * locales)915*9f11ffb7Safresh1 static void _populate_C_time_locale(pTHX_ HV* locales )
916*9f11ffb7Safresh1 {
917*9f11ffb7Safresh1 AV* alt_names = (AV *) SvRV( *hv_fetch(locales, "alt_month", 9, 0) );
918*9f11ffb7Safresh1 AV* long_names = (AV *) SvRV( *hv_fetch(locales, "month", 5, 0) );
919*9f11ffb7Safresh1 AV* short_names = (AV *) SvRV( *hv_fetch(locales, "mon", 3, 0) );
920*9f11ffb7Safresh1 int i;
921*9f11ffb7Safresh1
922*9f11ffb7Safresh1 for (i = 0; i < 1 + (int) av_len( long_names ); i++) {
923*9f11ffb7Safresh1 Locale->alt_month[i] = SvPV_nolen( (SV *) *av_fetch(alt_names, i, 0) );
924*9f11ffb7Safresh1 Locale->month[i] = SvPV_nolen( (SV *) *av_fetch(long_names, i, 0) );
925*9f11ffb7Safresh1 Locale->mon[i] = SvPV_nolen( (SV *) *av_fetch(short_names, i, 0) );
926*9f11ffb7Safresh1 }
927*9f11ffb7Safresh1
928*9f11ffb7Safresh1 long_names = (AV *) SvRV( *hv_fetch(locales, "weekday", 7, 0) );
929*9f11ffb7Safresh1 short_names = (AV *) SvRV( *hv_fetch(locales, "wday", 4, 0) );
930*9f11ffb7Safresh1
931*9f11ffb7Safresh1 for (i = 0; i < 1 + (int) av_len( long_names ); i++) {
932*9f11ffb7Safresh1 Locale->wday[i] = SvPV_nolen( (SV *) *av_fetch(short_names, i, 0) );
933*9f11ffb7Safresh1 Locale->weekday[i] = SvPV_nolen( (SV *) *av_fetch(long_names, i, 0) );
934*9f11ffb7Safresh1 }
935*9f11ffb7Safresh1
936*9f11ffb7Safresh1 Locale->am = SvPV_nolen( (SV *) *hv_fetch(locales, "am", 2, 0) );
937*9f11ffb7Safresh1 Locale->pm = SvPV_nolen( (SV *) *hv_fetch(locales, "pm", 2, 0) );
938*9f11ffb7Safresh1 Locale->AM = SvPV_nolen( (SV *) *hv_fetch(locales, "AM", 2, 0) );
939*9f11ffb7Safresh1 Locale->PM = SvPV_nolen( (SV *) *hv_fetch(locales, "PM", 2, 0) );
940*9f11ffb7Safresh1
941*9f11ffb7Safresh1 return;
942*9f11ffb7Safresh1 }
943*9f11ffb7Safresh1
944b39c5158Smillert MODULE = Time::Piece PACKAGE = Time::Piece
945b39c5158Smillert
946b39c5158Smillert PROTOTYPES: ENABLE
947b39c5158Smillert
948b39c5158Smillert void
949b8851fccSafresh1 _strftime(fmt, epoch, islocal = 1)
950b39c5158Smillert char * fmt
951b8851fccSafresh1 time_t epoch
952b8851fccSafresh1 int islocal
953b39c5158Smillert CODE:
954b39c5158Smillert {
955*9f11ffb7Safresh1 char tmpbuf[TP_BUF_SIZE];
956b39c5158Smillert struct tm mytm;
957b8851fccSafresh1 size_t len;
958b8851fccSafresh1
959b8851fccSafresh1 if(islocal == 1)
960b8851fccSafresh1 mytm = *localtime(&epoch);
961b8851fccSafresh1 else
962b8851fccSafresh1 mytm = *gmtime(&epoch);
963b8851fccSafresh1
964*9f11ffb7Safresh1 len = strftime(tmpbuf, TP_BUF_SIZE, fmt, &mytm);
965b39c5158Smillert /*
966b39c5158Smillert ** The following is needed to handle to the situation where
967b39c5158Smillert ** tmpbuf overflows. Basically we want to allocate a buffer
968b39c5158Smillert ** and try repeatedly. The reason why it is so complicated
969b39c5158Smillert ** is that getting a return value of 0 from strftime can indicate
970b39c5158Smillert ** one of the following:
971b39c5158Smillert ** 1. buffer overflowed,
972b39c5158Smillert ** 2. illegal conversion specifier, or
973b39c5158Smillert ** 3. the format string specifies nothing to be returned(not
974b39c5158Smillert ** an error). This could be because format is an empty string
975b39c5158Smillert ** or it specifies %p that yields an empty string in some locale.
976b39c5158Smillert ** If there is a better way to make it portable, go ahead by
977b39c5158Smillert ** all means.
978b39c5158Smillert */
979*9f11ffb7Safresh1 if ((len > 0 && len < TP_BUF_SIZE) || (len == 0 && *fmt == '\0'))
980b39c5158Smillert ST(0) = sv_2mortal(newSVpv(tmpbuf, len));
981b39c5158Smillert else {
982b39c5158Smillert /* Possibly buf overflowed - try again with a bigger buf */
983*9f11ffb7Safresh1 size_t fmtlen = strlen(fmt);
984*9f11ffb7Safresh1 size_t bufsize = fmtlen + TP_BUF_SIZE;
985b39c5158Smillert char* buf;
986*9f11ffb7Safresh1 size_t buflen;
987b39c5158Smillert
988b39c5158Smillert New(0, buf, bufsize, char);
989b39c5158Smillert while (buf) {
990b39c5158Smillert buflen = strftime(buf, bufsize, fmt, &mytm);
991b39c5158Smillert if (buflen > 0 && buflen < bufsize)
992b39c5158Smillert break;
993b39c5158Smillert /* heuristic to prevent out-of-memory errors */
994b39c5158Smillert if (bufsize > 100*fmtlen) {
995b39c5158Smillert Safefree(buf);
996b39c5158Smillert buf = NULL;
997b39c5158Smillert break;
998b39c5158Smillert }
999b39c5158Smillert bufsize *= 2;
1000b39c5158Smillert Renew(buf, bufsize, char);
1001b39c5158Smillert }
1002b39c5158Smillert if (buf) {
1003b39c5158Smillert ST(0) = sv_2mortal(newSVpv(buf, buflen));
1004b39c5158Smillert Safefree(buf);
1005b39c5158Smillert }
1006b39c5158Smillert else
1007b39c5158Smillert ST(0) = sv_2mortal(newSVpv(tmpbuf, len));
1008b39c5158Smillert }
1009b39c5158Smillert }
1010b39c5158Smillert
1011b39c5158Smillert void
1012b39c5158Smillert _tzset()
1013b39c5158Smillert PPCODE:
10146fb12b70Safresh1 PUTBACK; /* makes rest of this function tailcall friendly */
1015b39c5158Smillert my_tzset(aTHX);
10166fb12b70Safresh1 return; /* skip XSUBPP's PUTBACK */
1017b39c5158Smillert
1018b39c5158Smillert void
1019*9f11ffb7Safresh1 _strptime ( string, format, got_GMT, SV* localization )
1020b39c5158Smillert char * string
1021b39c5158Smillert char * format
1022*9f11ffb7Safresh1 int got_GMT
1023b39c5158Smillert PREINIT:
1024b39c5158Smillert struct tm mytm;
1025b39c5158Smillert char * remainder;
1026*9f11ffb7Safresh1 HV * locales;
1027b39c5158Smillert PPCODE:
1028*9f11ffb7Safresh1 memset(&mytm, 0, sizeof(mytm));
1029*9f11ffb7Safresh1
1030*9f11ffb7Safresh1 /* sensible defaults. */
1031*9f11ffb7Safresh1 mytm.tm_mday = 1;
1032*9f11ffb7Safresh1 mytm.tm_year = 70;
1033*9f11ffb7Safresh1 mytm.tm_wday = 4;
1034b8851fccSafresh1 mytm.tm_isdst = -1; /* -1 means we don't know */
1035*9f11ffb7Safresh1
1036*9f11ffb7Safresh1 if( SvTYPE(SvRV( localization )) == SVt_PVHV ){
1037*9f11ffb7Safresh1 locales = (HV *)SvRV(localization);
1038*9f11ffb7Safresh1 }
1039*9f11ffb7Safresh1 else{
1040*9f11ffb7Safresh1 croak("_strptime requires a Hash Reference of locales");
1041*9f11ffb7Safresh1 }
1042*9f11ffb7Safresh1
1043*9f11ffb7Safresh1 /* populate our locale data struct (used for %[AaBbPp] flags) */
1044*9f11ffb7Safresh1 _populate_C_time_locale(aTHX_ locales );
10456fb12b70Safresh1
10466fb12b70Safresh1 remainder = (char *)_strptime(aTHX_ string, format, &mytm, &got_GMT);
1047b39c5158Smillert if (remainder == NULL) {
1048b39c5158Smillert croak("Error parsing time");
1049b39c5158Smillert }
1050b39c5158Smillert if (*remainder != '\0') {
1051*9f11ffb7Safresh1 warn("Garbage at end of string in strptime: %s", remainder);
1052*9f11ffb7Safresh1 warn("Perhaps a format flag did not match the actual input?");
1053b39c5158Smillert }
1054b39c5158Smillert
10556fb12b70Safresh1 return_11part_tm(aTHX_ SP, &mytm);
10566fb12b70Safresh1 return;
1057b39c5158Smillert
1058b39c5158Smillert void
1059b39c5158Smillert _mini_mktime(int sec, int min, int hour, int mday, int mon, int year)
1060b39c5158Smillert PREINIT:
1061b39c5158Smillert struct tm mytm;
1062b39c5158Smillert time_t t;
1063b39c5158Smillert PPCODE:
1064b39c5158Smillert t = 0;
1065b39c5158Smillert mytm = *gmtime(&t);
1066b39c5158Smillert
1067b39c5158Smillert mytm.tm_sec = sec;
1068b39c5158Smillert mytm.tm_min = min;
1069b39c5158Smillert mytm.tm_hour = hour;
1070b39c5158Smillert mytm.tm_mday = mday;
1071b39c5158Smillert mytm.tm_mon = mon;
1072b39c5158Smillert mytm.tm_year = year;
1073b39c5158Smillert
10746fb12b70Safresh1 return_11part_tm(aTHX_ SP, &mytm);
10756fb12b70Safresh1 return;
1076898184e3Ssthen
1077898184e3Ssthen void
1078898184e3Ssthen _crt_localtime(time_t sec)
10796fb12b70Safresh1 ALIAS:
10806fb12b70Safresh1 _crt_gmtime = 1
1081898184e3Ssthen PREINIT:
1082898184e3Ssthen struct tm mytm;
1083898184e3Ssthen PPCODE:
10846fb12b70Safresh1 if(ix) mytm = *gmtime(&sec);
10856fb12b70Safresh1 else mytm = *localtime(&sec);
1086898184e3Ssthen /* Need to get: $s,$n,$h,$d,$m,$y */
1087898184e3Ssthen
1088*9f11ffb7Safresh1 EXTEND(SP, 10);
10896fb12b70Safresh1 SP = push_common_tm(aTHX_ SP, &mytm);
10906fb12b70Safresh1 PUSHs(newSViv(mytm.tm_isdst));
10916fb12b70Safresh1 PUTBACK;
10926fb12b70Safresh1 {
10936fb12b70Safresh1 SV ** endsp = SP; /* the SV * under SP needs to be mortaled */
1094*9f11ffb7Safresh1 SP -= (10 - 1); /* subtract 0 based count of SVs to mortal */
10956fb12b70Safresh1 /* mortal target of SP, then increment before function call
10966fb12b70Safresh1 so SP is already calculated before next comparison to not stall CPU */
10976fb12b70Safresh1 do {
10986fb12b70Safresh1 sv_2mortal(*SP++);
10996fb12b70Safresh1 } while(SP <= endsp);
11006fb12b70Safresh1 }
11016fb12b70Safresh1 return;
1102*9f11ffb7Safresh1
1103*9f11ffb7Safresh1 SV*
1104*9f11ffb7Safresh1 _get_localization()
1105*9f11ffb7Safresh1 INIT:
1106*9f11ffb7Safresh1 HV* locales = newHV();
1107*9f11ffb7Safresh1 AV* wdays = newAV();
1108*9f11ffb7Safresh1 AV* weekdays = newAV();
1109*9f11ffb7Safresh1 AV* mons = newAV();
1110*9f11ffb7Safresh1 AV* months = newAV();
1111*9f11ffb7Safresh1 SV** tmp;
1112*9f11ffb7Safresh1 size_t len;
1113*9f11ffb7Safresh1 char buf[TP_BUF_SIZE];
1114*9f11ffb7Safresh1 size_t i;
1115*9f11ffb7Safresh1 time_t t = 1325386800; /*1325386800 = Sun, 01 Jan 2012 03:00:00 GMT*/
1116*9f11ffb7Safresh1 struct tm mytm = *gmtime(&t);
1117*9f11ffb7Safresh1 CODE:
1118*9f11ffb7Safresh1
1119*9f11ffb7Safresh1 for(i = 0; i < 7; ++i){
1120*9f11ffb7Safresh1
1121*9f11ffb7Safresh1 len = strftime(buf, TP_BUF_SIZE, "%a", &mytm);
1122*9f11ffb7Safresh1 av_push(wdays, (SV *) newSVpvn(buf, len));
1123*9f11ffb7Safresh1
1124*9f11ffb7Safresh1 len = strftime(buf, TP_BUF_SIZE, "%A", &mytm);
1125*9f11ffb7Safresh1 av_push(weekdays, (SV *) newSVpvn(buf, len));
1126*9f11ffb7Safresh1
1127*9f11ffb7Safresh1 ++mytm.tm_wday;
1128*9f11ffb7Safresh1 }
1129*9f11ffb7Safresh1
1130*9f11ffb7Safresh1 for(i = 0; i < 12; ++i){
1131*9f11ffb7Safresh1
1132*9f11ffb7Safresh1 len = strftime(buf, TP_BUF_SIZE, "%b", &mytm);
1133*9f11ffb7Safresh1 av_push(mons, (SV *) newSVpvn(buf, len));
1134*9f11ffb7Safresh1
1135*9f11ffb7Safresh1 len = strftime(buf, TP_BUF_SIZE, "%B", &mytm);
1136*9f11ffb7Safresh1 av_push(months, (SV *) newSVpvn(buf, len));
1137*9f11ffb7Safresh1
1138*9f11ffb7Safresh1 ++mytm.tm_mon;
1139*9f11ffb7Safresh1 }
1140*9f11ffb7Safresh1
1141*9f11ffb7Safresh1 tmp = hv_store(locales, "wday", 4, newRV_noinc((SV *) wdays), 0);
1142*9f11ffb7Safresh1 tmp = hv_store(locales, "weekday", 7, newRV_noinc((SV *) weekdays), 0);
1143*9f11ffb7Safresh1 tmp = hv_store(locales, "mon", 3, newRV_noinc((SV *) mons), 0);
1144*9f11ffb7Safresh1 tmp = hv_store(locales, "month", 5, newRV_noinc((SV *) months), 0);
1145*9f11ffb7Safresh1 tmp = hv_store(locales, "alt_month", 9, newRV((SV *) months), 0);
1146*9f11ffb7Safresh1
1147*9f11ffb7Safresh1 len = strftime(buf, TP_BUF_SIZE, "%p", &mytm);
1148*9f11ffb7Safresh1 tmp = hv_store(locales, "AM", 2, newSVpvn(buf,len), 0);
1149*9f11ffb7Safresh1 mytm.tm_hour = 18;
1150*9f11ffb7Safresh1 len = strftime(buf, TP_BUF_SIZE, "%p", &mytm);
1151*9f11ffb7Safresh1 tmp = hv_store(locales, "PM", 2, newSVpvn(buf,len), 0);
1152*9f11ffb7Safresh1
1153*9f11ffb7Safresh1 if(tmp == NULL || !SvOK( (SV *) *tmp)){
1154*9f11ffb7Safresh1 croak("Failed to get localization.");
1155*9f11ffb7Safresh1 }
1156*9f11ffb7Safresh1
1157*9f11ffb7Safresh1 RETVAL = newRV_noinc((SV *)locales);
1158*9f11ffb7Safresh1 OUTPUT:
1159*9f11ffb7Safresh1 RETVAL
1160