This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix pthread include error for Time::Piece
[perl5.git] / cpan / Time-Piece / Piece.xs
CommitLineData
16433e2b 1#ifdef __cplusplus
c944940b 2extern "C" {
16433e2b
SP
3#endif
4#include "EXTERN.h"
5#include "perl.h"
6#include "XSUB.h"
7#include <time.h>
8#ifdef __cplusplus
9}
10#endif
11
12/* XXX struct tm on some systems (SunOS4/BSD) contains extra (non POSIX)
d4d72fe6 13 * fields for which we don't have Configure support prior to Perl 5.8.0:
16433e2b
SP
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!
21 *
d4d72fe6
CB
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.
16433e2b 24 */
d4d72fe6
CB
25#if !defined(PERL_VERSION) || PERL_VERSION < 8
26
036055ae 27#if defined(HAS_GNULIBC)
16433e2b
SP
28# ifndef STRUCT_TM_HASZONE
29# define STRUCT_TM_HASZONE
30# else
31# define USE_TM_GMTOFF
32# endif
33#endif
34
d4d72fe6
CB
35#endif /* end of pre-5.8 */
36
16433e2b
SP
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 */
50
d4d72fe6
CB
51#if !defined(PERL_VERSION) || PERL_VERSION < 8
52
16433e2b
SP
53#ifdef STRUCT_TM_HASZONE
54static void
55my_init_tm(struct tm *ptm) /* see mktime, strftime and asctime */
56{
57 Time_t now;
58 (void)time(&now);
59 Copy(localtime(&now), ptm, 1, struct tm);
60}
61
62#else
63# define my_init_tm(ptm)
64#endif
65
d4d72fe6
CB
66#else
67/* use core version from util.c in 5.8.0 and later */
68# define my_init_tm init_tm
69#endif
70
6e073399
SH
71#ifdef WIN32
72
73/*
74 * (1) The CRT maintains its own copy of the environment, separate from
75 * the Win32API copy.
76 *
77 * (2) CRT getenv() retrieves from this copy. CRT putenv() updates this
78 * copy, and then calls SetEnvironmentVariableA() to update the Win32API
79 * copy.
80 *
81 * (3) win32_getenv() and win32_putenv() call GetEnvironmentVariableA() and
82 * SetEnvironmentVariableA() directly, bypassing the CRT copy of the
83 * environment.
84 *
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}.
90 *
91 * Therefore, we need to retrieve the value of $ENV{TZ} and call CRT
12016aad
SH
92 * putenv() to update the CRT copy of the environment (if it is different)
93 * whenever we're about to call tzset().
94 *
95 * In addition to all that, when perl is built with PERL_IMPLICIT_SYS
96 * defined:
97 *
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.)
104 *
105 * (b) Only the first Perl interpreter instantiated within a process will
106 * "write through" environment changes to the process environment.
107 *
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()).
110 *
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.
115 *
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.
119 *
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
126 * been destroyed.
127 *
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.
6e073399
SH
132 */
133
6e073399 134#undef getenv
6e073399 135#undef putenv
12016aad
SH
136#undef malloc
137#undef free
6e073399
SH
138
139static void
140fix_win32_tzenv(void)
141{
12016aad
SH
142 static char* oldenv = NULL;
143 char* newenv;
144 const char* perl_tz_env = win32_getenv("TZ");
145 const char* crt_tz_env = getenv("TZ");
146 if (perl_tz_env == NULL)
147 perl_tz_env = "";
148 if (crt_tz_env == NULL)
149 crt_tz_env = "";
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);
154 putenv(newenv);
155 if (oldenv != NULL)
156 free(oldenv);
157 oldenv = newenv;
158 }
6e073399 159 }
6e073399
SH
160}
161
162#endif
163
81ab4c44
SH
164/*
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.
168 */
6e073399 169static void
12016aad 170my_tzset(pTHX)
6e073399
SH
171{
172#ifdef WIN32
12016aad
SH
173#if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
174 if (PL_curinterp == aTHX)
175#endif
176 fix_win32_tzenv();
6e073399
SH
177#endif
178 tzset();
179}
180
16433e2b
SP
181/*
182 * my_mini_mktime - normalise struct tm values without the localtime()
124e6c84
RGS
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
185 * file.
16433e2b
SP
186 */
187static void
188my_mini_mktime(struct tm *ptm)
189{
190 int yearday;
191 int secs;
192 int month, mday, year, jday;
193 int odd_cent, odd_year;
194
16433e2b
SP
195 year = 1900 + ptm->tm_year;
196 month = ptm->tm_mon;
197 mday = ptm->tm_mday;
198 /* allow given yday with no month & mday to dominate the result */
199 if (ptm->tm_yday >= 0 && mday <= 0 && month <= 0) {
200 month = 0;
201 mday = 0;
202 jday = 1 + ptm->tm_yday;
203 }
204 else {
205 jday = 0;
206 }
207 if (month >= 2)
208 month+=2;
209 else
210 month+=14, year--;
211
212 yearday = DAYS_PER_YEAR * year + year/4 - year/100 + year/400;
213 yearday += month*MONTH_TO_DAYS + mday + jday;
214 /*
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.
219 */
220 if ((unsigned) ptm->tm_sec <= 60) {
221 secs = 0;
222 }
223 else {
224 secs = ptm->tm_sec;
225 ptm->tm_sec = 0;
226 }
227 secs += 60 * ptm->tm_min;
228 secs += SECS_PER_HOUR * ptm->tm_hour;
229 if (secs < 0) {
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);
235 }
236 else {
237 yearday += (secs/SECS_PER_DAY);
238 secs -= SECS_PER_DAY * (secs/SECS_PER_DAY);
239 }
240 }
241 else if (secs >= SECS_PER_DAY) {
242 yearday += (secs/SECS_PER_DAY);
243 secs %= SECS_PER_DAY;
244 }
245 ptm->tm_hour = secs/SECS_PER_HOUR;
246 secs %= SECS_PER_HOUR;
247 ptm->tm_min = secs/60;
248 secs %= 60;
249 ptm->tm_sec += secs;
250 /* done with time of day effects */
251 /*
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.
258 */
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;
269 year += odd_year;
270 yearday %= DAYS_PER_YEAR;
271 if (!yearday && (odd_cent==4 || odd_year==4)) { /* catch Feb 29 */
272 month = 1;
273 yearday = 29;
274 }
275 else {
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 */
280 if (month > 13) {
281 month-=14;
282 year++;
283 }
284 else {
285 month-=2;
286 }
287 }
288 ptm->tm_year = year - 1900;
289 if (yearday) {
290 ptm->tm_mday = yearday;
291 ptm->tm_mon = month;
292 }
293 else {
294 ptm->tm_mday = 31;
295 ptm->tm_mon = month - 1;
296 }
297 /* re-build yearday based on Jan 1 to get tm_yday */
298 year--;
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;
304}
305
12016aad 306# if defined(WIN32) || (defined(__QNX__) && defined(__WATCOMC__))
90d55c29 307# define strncasecmp(x,y,n) strnicmp(x,y,n)
12016aad 308# endif
be8a15fc 309
124e6c84
RGS
310/* strptime copied from freebsd with the following copyright: */
311/*
312 * Copyright (c) 1994 Powerdog Industries. All rights reserved.
313 *
314 * Redistribution and use in source and binary forms, with or without
315 * modification, are permitted provided that the following conditions
316 * are met:
317 * 1. Redistributions of source code must retain the above copyright
318 * notice, this list of conditions and the following disclaimer.
319 * 2. Redistributions in binary form must reproduce the above copyright
320 * notice, this list of conditions and the following disclaimer
321 * in the documentation and/or other materials provided with the
322 * distribution.
323 * 3. All advertising materials mentioning features or use of this
324 * software must display the following acknowledgement:
325 * This product includes software developed by Powerdog Industries.
326 * 4. The name of Powerdog Industries may not be used to endorse or
327 * promote products derived from this software without specific prior
328 * written permission.
329 *
330 * THIS SOFTWARE IS PROVIDED BY POWERDOG INDUSTRIES ``AS IS'' AND ANY
331 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
332 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
333 * PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE POWERDOG INDUSTRIES BE
334 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
335 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
336 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
337 * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
338 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
339 * OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
340 * EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
341 */
342
343#ifndef lint
344#ifndef NOID
345static char copyright[] =
346"@(#) Copyright (c) 1994 Powerdog Industries. All rights reserved.";
347static char sccsid[] = "@(#)strptime.c 0.1 (Powerdog) 94/03/27";
348#endif /* !defined NOID */
349#endif /* not lint */
be8a15fc 350
16433e2b
SP
351#include <time.h>
352#include <ctype.h>
353#include <string.h>
e9f284c9
MB
354static char * _strptime(pTHX_ const char *, const char *, struct tm *,
355 int *got_GMT);
16433e2b
SP
356
357#define asizeof(a) (sizeof (a) / sizeof ((a)[0]))
358
359struct lc_time_T {
360 const char * mon[12];
361 const char * month[12];
362 const char * wday[7];
363 const char * weekday[7];
364 const char * X_fmt;
365 const char * x_fmt;
366 const char * c_fmt;
367 const char * am;
368 const char * pm;
369 const char * date_fmt;
370 const char * alt_month[12];
371 const char * Ef_fmt;
372 const char * EF_fmt;
373};
374
375struct lc_time_T _time_localebuf;
376int _time_using_locale;
377
378const struct lc_time_T _C_time_locale = {
379 {
380 "Jan", "Feb", "Mar", "Apr", "May", "Jun",
381 "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"
382 }, {
383 "January", "February", "March", "April", "May", "June",
384 "July", "August", "September", "October", "November", "December"
385 }, {
386 "Sun", "Mon", "Tue", "Wed",
387 "Thu", "Fri", "Sat"
388 }, {
389 "Sunday", "Monday", "Tuesday", "Wednesday",
390 "Thursday", "Friday", "Saturday"
391 },
392
393 /* X_fmt */
394 "%H:%M:%S",
395
396 /*
397 ** x_fmt
398 ** Since the C language standard calls for
399 ** "date, using locale's date format," anything goes.
400 ** Using just numbers (as here) makes Quakers happier;
401 ** it's also compatible with SVR4.
402 */
403 "%m/%d/%y",
404
405 /*
406 ** c_fmt (ctime-compatible)
407 ** Not used, just compatibility placeholder.
408 */
409 NULL,
410
411 /* am */
412 "AM",
413
414 /* pm */
415 "PM",
416
417 /* date_fmt */
418 "%a %Ef %X %Z %Y",
419
420 {
421 "January", "February", "March", "April", "May", "June",
422 "July", "August", "September", "October", "November", "December"
423 },
424
425 /* Ef_fmt
426 ** To determine short months / day order
427 */
428 "%b %e",
429
430 /* EF_fmt
431 ** To determine long months / day order
432 */
433 "%B %e"
434};
435
436#define Locale (&_C_time_locale)
437
438static char *
e9f284c9 439_strptime(pTHX_ const char *buf, const char *fmt, struct tm *tm, int *got_GMT)
16433e2b
SP
440{
441 char c;
442 const char *ptr;
443 int i,
444 len;
445 int Ealternative, Oalternative;
446
90d55c29
CBW
447 /* There seems to be a slightly improved version at
448 * http://www.opensource.apple.com/source/Libc/Libc-583/stdtime/strptime-fbsd.c
449 * which we may end up borrowing more from
450 */
16433e2b
SP
451 ptr = fmt;
452 while (*ptr != 0) {
453 if (*buf == 0)
454 break;
455
456 c = *ptr++;
90d55c29 457
16433e2b
SP
458 if (c != '%') {
459 if (isspace((unsigned char)c))
460 while (*buf != 0 && isspace((unsigned char)*buf))
461 buf++;
462 else if (c != *buf++)
463 return 0;
464 continue;
465 }
466
467 Ealternative = 0;
468 Oalternative = 0;
469label:
470 c = *ptr++;
471 switch (c) {
472 case 0:
473 case '%':
474 if (*buf++ != '%')
475 return 0;
476 break;
477
478 case '+':
e9f284c9 479 buf = _strptime(aTHX_ buf, Locale->date_fmt, tm, got_GMT);
16433e2b
SP
480 if (buf == 0)
481 return 0;
482 break;
483
484 case 'C':
485 if (!isdigit((unsigned char)*buf))
486 return 0;
487
488 /* XXX This will break for 3-digit centuries. */
489 len = 2;
490 for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) {
491 i *= 10;
492 i += *buf - '0';
493 len--;
494 }
495 if (i < 19)
496 return 0;
497
498 tm->tm_year = i * 100 - 1900;
499 break;
500
501 case 'c':
502 /* NOTE: c_fmt is intentionally ignored */
e9f284c9 503 buf = _strptime(aTHX_ buf, "%a %Ef %T %Y", tm, got_GMT);
16433e2b
SP
504 if (buf == 0)
505 return 0;
506 break;
507
508 case 'D':
e9f284c9 509 buf = _strptime(aTHX_ buf, "%m/%d/%y", tm, got_GMT);
16433e2b
SP
510 if (buf == 0)
511 return 0;
512 break;
513
514 case 'E':
515 if (Ealternative || Oalternative)
516 break;
517 Ealternative++;
518 goto label;
519
520 case 'O':
521 if (Ealternative || Oalternative)
522 break;
523 Oalternative++;
524 goto label;
525
526 case 'F':
527 case 'f':
528 if (!Ealternative)
529 break;
e9f284c9 530 buf = _strptime(aTHX_ buf, (c == 'f') ? Locale->Ef_fmt : Locale->EF_fmt, tm, got_GMT);
16433e2b
SP
531 if (buf == 0)
532 return 0;
533 break;
534
535 case 'R':
e9f284c9 536 buf = _strptime(aTHX_ buf, "%H:%M", tm, got_GMT);
16433e2b
SP
537 if (buf == 0)
538 return 0;
539 break;
540
541 case 'r':
e9f284c9 542 buf = _strptime(aTHX_ buf, "%I:%M:%S %p", tm, got_GMT);
16433e2b
SP
543 if (buf == 0)
544 return 0;
545 break;
546
90d55c29
CBW
547 case 'n': /* whitespace */
548 case 't':
549 if (!isspace((unsigned char)*buf))
550 return 0;
551 while (isspace((unsigned char)*buf))
552 buf++;
553 break;
554
16433e2b 555 case 'T':
e9f284c9 556 buf = _strptime(aTHX_ buf, "%H:%M:%S", tm, got_GMT);
16433e2b
SP
557 if (buf == 0)
558 return 0;
559 break;
560
561 case 'X':
e9f284c9 562 buf = _strptime(aTHX_ buf, Locale->X_fmt, tm, got_GMT);
16433e2b
SP
563 if (buf == 0)
564 return 0;
565 break;
566
567 case 'x':
e9f284c9 568 buf = _strptime(aTHX_ buf, Locale->x_fmt, tm, got_GMT);
16433e2b
SP
569 if (buf == 0)
570 return 0;
571 break;
572
573 case 'j':
574 if (!isdigit((unsigned char)*buf))
575 return 0;
576
577 len = 3;
578 for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) {
579 i *= 10;
580 i += *buf - '0';
581 len--;
582 }
583 if (i < 1 || i > 366)
584 return 0;
585
586 tm->tm_yday = i - 1;
587 break;
588
589 case 'M':
590 case 'S':
591 if (*buf == 0 || isspace((unsigned char)*buf))
592 break;
593
594 if (!isdigit((unsigned char)*buf))
595 return 0;
596
597 len = 2;
598 for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) {
599 i *= 10;
600 i += *buf - '0';
601 len--;
602 }
603
604 if (c == 'M') {
605 if (i > 59)
606 return 0;
607 tm->tm_min = i;
608 } else {
609 if (i > 60)
610 return 0;
611 tm->tm_sec = i;
612 }
613
614 if (*buf != 0 && isspace((unsigned char)*buf))
615 while (*ptr != 0 && !isspace((unsigned char)*ptr))
616 ptr++;
617 break;
618
619 case 'H':
620 case 'I':
621 case 'k':
622 case 'l':
623 /*
624 * Of these, %l is the only specifier explicitly
625 * documented as not being zero-padded. However,
626 * there is no harm in allowing zero-padding.
627 *
628 * XXX The %l specifier may gobble one too many
629 * digits if used incorrectly.
630 */
90d55c29 631 if (!isdigit((unsigned char)*buf))
16433e2b
SP
632 return 0;
633
634 len = 2;
635 for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) {
636 i *= 10;
637 i += *buf - '0';
638 len--;
639 }
640 if (c == 'H' || c == 'k') {
641 if (i > 23)
642 return 0;
643 } else if (i > 12)
644 return 0;
645
646 tm->tm_hour = i;
647
648 if (*buf != 0 && isspace((unsigned char)*buf))
649 while (*ptr != 0 && !isspace((unsigned char)*ptr))
650 ptr++;
651 break;
652
653 case 'p':
654 /*
655 * XXX This is bogus if parsed before hour-related
656 * specifiers.
657 */
90d55c29 658 len = strlen(Locale->am);
16433e2b
SP
659 if (strncasecmp(buf, Locale->am, len) == 0) {
660 if (tm->tm_hour > 12)
661 return 0;
662 if (tm->tm_hour == 12)
663 tm->tm_hour = 0;
664 buf += len;
665 break;
666 }
667
668 len = strlen(Locale->pm);
669 if (strncasecmp(buf, Locale->pm, len) == 0) {
670 if (tm->tm_hour > 12)
671 return 0;
672 if (tm->tm_hour != 12)
673 tm->tm_hour += 12;
674 buf += len;
675 break;
676 }
677
678 return 0;
679
680 case 'A':
681 case 'a':
682 for (i = 0; i < asizeof(Locale->weekday); i++) {
683 if (c == 'A') {
684 len = strlen(Locale->weekday[i]);
685 if (strncasecmp(buf,
686 Locale->weekday[i],
687 len) == 0)
688 break;
689 } else {
690 len = strlen(Locale->wday[i]);
691 if (strncasecmp(buf,
692 Locale->wday[i],
693 len) == 0)
694 break;
695 }
696 }
697 if (i == asizeof(Locale->weekday))
698 return 0;
699
700 tm->tm_wday = i;
701 buf += len;
702 break;
703
704 case 'U':
705 case 'W':
706 /*
707 * XXX This is bogus, as we can not assume any valid
708 * information present in the tm structure at this
709 * point to calculate a real value, so just check the
710 * range for now.
711 */
90d55c29 712 if (!isdigit((unsigned char)*buf))
16433e2b
SP
713 return 0;
714
715 len = 2;
716 for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) {
717 i *= 10;
718 i += *buf - '0';
719 len--;
720 }
721 if (i > 53)
722 return 0;
723
724 if (*buf != 0 && isspace((unsigned char)*buf))
725 while (*ptr != 0 && !isspace((unsigned char)*ptr))
726 ptr++;
727 break;
728
729 case 'w':
730 if (!isdigit((unsigned char)*buf))
731 return 0;
732
733 i = *buf - '0';
734 if (i > 6)
735 return 0;
736
737 tm->tm_wday = i;
738
739 if (*buf != 0 && isspace((unsigned char)*buf))
740 while (*ptr != 0 && !isspace((unsigned char)*ptr))
741 ptr++;
742 break;
743
744 case 'd':
745 case 'e':
746 /*
747 * The %e specifier is explicitly documented as not
748 * being zero-padded but there is no harm in allowing
749 * such padding.
750 *
751 * XXX The %e specifier may gobble one too many
752 * digits if used incorrectly.
753 */
754 if (!isdigit((unsigned char)*buf))
755 return 0;
756
757 len = 2;
758 for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) {
759 i *= 10;
760 i += *buf - '0';
761 len--;
762 }
763 if (i > 31)
764 return 0;
765
766 tm->tm_mday = i;
767
768 if (*buf != 0 && isspace((unsigned char)*buf))
769 while (*ptr != 0 && !isspace((unsigned char)*ptr))
770 ptr++;
771 break;
772
773 case 'B':
774 case 'b':
775 case 'h':
776 for (i = 0; i < asizeof(Locale->month); i++) {
777 if (Oalternative) {
778 if (c == 'B') {
779 len = strlen(Locale->alt_month[i]);
780 if (strncasecmp(buf,
781 Locale->alt_month[i],
782 len) == 0)
783 break;
784 }
785 } else {
786 if (c == 'B') {
787 len = strlen(Locale->month[i]);
788 if (strncasecmp(buf,
789 Locale->month[i],
790 len) == 0)
791 break;
792 } else {
793 len = strlen(Locale->mon[i]);
794 if (strncasecmp(buf,
795 Locale->mon[i],
796 len) == 0)
797 break;
798 }
799 }
800 }
801 if (i == asizeof(Locale->month))
802 return 0;
803
804 tm->tm_mon = i;
805 buf += len;
806 break;
807
808 case 'm':
809 if (!isdigit((unsigned char)*buf))
810 return 0;
811
812 len = 2;
813 for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) {
814 i *= 10;
815 i += *buf - '0';
816 len--;
817 }
818 if (i < 1 || i > 12)
819 return 0;
820
821 tm->tm_mon = i - 1;
822
823 if (*buf != 0 && isspace((unsigned char)*buf))
824 while (*ptr != 0 && !isspace((unsigned char)*ptr))
825 ptr++;
826 break;
827
90d55c29
CBW
828 case 's':
829 {
830 char *cp;
831 int sverrno;
832 long n;
833 time_t t;
834 struct tm mytm;
835
836 sverrno = errno;
837 errno = 0;
838 n = strtol(buf, &cp, 10);
839 if (errno == ERANGE || (long)(t = n) != n) {
840 errno = sverrno;
841 return 0;
842 }
843 errno = sverrno;
844 buf = cp;
845 memset(&mytm, 0, sizeof(mytm));
846 my_init_tm(&mytm); /* XXX workaround - see my_init_tm() above */
847 mytm = *gmtime(&t);
848 tm->tm_sec = mytm.tm_sec;
849 tm->tm_min = mytm.tm_min;
850 tm->tm_hour = mytm.tm_hour;
851 tm->tm_mday = mytm.tm_mday;
852 tm->tm_mon = mytm.tm_mon;
853 tm->tm_year = mytm.tm_year;
854 tm->tm_wday = mytm.tm_wday;
855 tm->tm_yday = mytm.tm_yday;
856 tm->tm_isdst = mytm.tm_isdst;
857 }
858 break;
859
16433e2b
SP
860 case 'Y':
861 case 'y':
862 if (*buf == 0 || isspace((unsigned char)*buf))
863 break;
864
865 if (!isdigit((unsigned char)*buf))
866 return 0;
867
868 len = (c == 'Y') ? 4 : 2;
869 for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) {
870 i *= 10;
871 i += *buf - '0';
872 len--;
873 }
874 if (c == 'Y')
875 i -= 1900;
876 if (c == 'y' && i < 69)
877 i += 100;
878 if (i < 0)
879 return 0;
880
881 tm->tm_year = i;
882
883 if (*buf != 0 && isspace((unsigned char)*buf))
884 while (*ptr != 0 && !isspace((unsigned char)*ptr))
885 ptr++;
886 break;
887
888 case 'Z':
889 {
890 const char *cp;
891 char *zonestr;
892
893 for (cp = buf; *cp && isupper((unsigned char)*cp); ++cp)
894 {/*empty*/}
895 if (cp - buf) {
8a0cff69 896 zonestr = (char *)malloc(cp - buf + 1);
ded2eedc
CB
897 if (!zonestr) {
898 errno = ENOMEM;
899 return 0;
900 }
16433e2b
SP
901 strncpy(zonestr, buf, cp - buf);
902 zonestr[cp - buf] = '\0';
12016aad 903 my_tzset(aTHX);
16433e2b 904 if (0 == strcmp(zonestr, "GMT")) {
e9f284c9 905 *got_GMT = 1;
16433e2b 906 }
ded2eedc 907 free(zonestr);
e9f284c9 908 if (!*got_GMT) return 0;
16433e2b
SP
909 buf += cp - buf;
910 }
911 }
912 break;
90d55c29
CBW
913
914 case 'z':
915 {
916 int sign = 1;
917
918 if (*buf != '+') {
919 if (*buf == '-')
920 sign = -1;
921 else
922 return 0;
923 }
924
925 buf++;
926 i = 0;
927 for (len = 4; len > 0; len--) {
928 if (isdigit((int)*buf)) {
929 i *= 10;
930 i += *buf - '0';
931 buf++;
932 } else
933 return 0;
934 }
935
936 tm->tm_hour -= sign * (i / 100);
937 tm->tm_min -= sign * (i % 100);
e9f284c9 938 *got_GMT = 1;
90d55c29
CBW
939 }
940 break;
16433e2b
SP
941 }
942 }
943 return (char *)buf;
944}
945
946
947char *
90d55c29 948our_strptime(pTHX_ const char *buf, const char *fmt, struct tm *tm)
16433e2b
SP
949{
950 char *ret;
e9f284c9 951 int got_GMT = 0;
16433e2b 952
e9f284c9 953 return _strptime(aTHX_ buf, fmt, tm, &got_GMT);
16433e2b
SP
954}
955
16433e2b
SP
956MODULE = Time::Piece PACKAGE = Time::Piece
957
958PROTOTYPES: ENABLE
959
9331e88f 960void
16433e2b
SP
961_strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1)
962 char * fmt
963 int sec
964 int min
965 int hour
966 int mday
967 int mon
968 int year
969 int wday
970 int yday
971 int isdst
972 CODE:
973 {
974 char tmpbuf[128];
975 struct tm mytm;
976 int len;
977 memset(&mytm, 0, sizeof(mytm));
978 my_init_tm(&mytm); /* XXX workaround - see my_init_tm() above */
979 mytm.tm_sec = sec;
980 mytm.tm_min = min;
981 mytm.tm_hour = hour;
982 mytm.tm_mday = mday;
983 mytm.tm_mon = mon;
984 mytm.tm_year = year;
985 mytm.tm_wday = wday;
986 mytm.tm_yday = yday;
987 mytm.tm_isdst = isdst;
988 my_mini_mktime(&mytm);
989 len = strftime(tmpbuf, sizeof tmpbuf, fmt, &mytm);
990 /*
991 ** The following is needed to handle to the situation where
992 ** tmpbuf overflows. Basically we want to allocate a buffer
993 ** and try repeatedly. The reason why it is so complicated
994 ** is that getting a return value of 0 from strftime can indicate
995 ** one of the following:
996 ** 1. buffer overflowed,
997 ** 2. illegal conversion specifier, or
998 ** 3. the format string specifies nothing to be returned(not
999 ** an error). This could be because format is an empty string
1000 ** or it specifies %p that yields an empty string in some locale.
1001 ** If there is a better way to make it portable, go ahead by
1002 ** all means.
1003 */
1004 if ((len > 0 && len < sizeof(tmpbuf)) || (len == 0 && *fmt == '\0'))
1005 ST(0) = sv_2mortal(newSVpv(tmpbuf, len));
1006 else {
1007 /* Possibly buf overflowed - try again with a bigger buf */
1008 int fmtlen = strlen(fmt);
1009 int bufsize = fmtlen + sizeof(tmpbuf);
1010 char* buf;
1011 int buflen;
1012
1013 New(0, buf, bufsize, char);
1014 while (buf) {
1015 buflen = strftime(buf, bufsize, fmt, &mytm);
1016 if (buflen > 0 && buflen < bufsize)
1017 break;
1018 /* heuristic to prevent out-of-memory errors */
1019 if (bufsize > 100*fmtlen) {
1020 Safefree(buf);
1021 buf = NULL;
1022 break;
1023 }
1024 bufsize *= 2;
1025 Renew(buf, bufsize, char);
1026 }
1027 if (buf) {
1028 ST(0) = sv_2mortal(newSVpv(buf, buflen));
1029 Safefree(buf);
1030 }
1031 else
1032 ST(0) = sv_2mortal(newSVpv(tmpbuf, len));
1033 }
1034 }
1035
1036void
1037_tzset()
1038 PPCODE:
12016aad 1039 my_tzset(aTHX);
16433e2b
SP
1040
1041
1042void
1043_strptime ( string, format )
1044 char * string
1045 char * format
1046 PREINIT:
16433e2b
SP
1047 struct tm mytm;
1048 time_t t;
1049 char * remainder;
16433e2b
SP
1050 PPCODE:
1051 t = 0;
1052 mytm = *gmtime(&t);
90d55c29 1053 remainder = (char *)our_strptime(aTHX_ string, format, &mytm);
16433e2b 1054 if (remainder == NULL) {
90d55c29 1055 croak("Error parsing time");
16433e2b 1056 }
16433e2b
SP
1057 if (*remainder != '\0') {
1058 warn("garbage at end of string in strptime: %s", remainder);
1059 }
1060
1061 my_mini_mktime(&mytm);
1062
1063 /* 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); */
1064
1065 EXTEND(SP, 11);
1066 PUSHs(sv_2mortal(newSViv(mytm.tm_sec)));
1067 PUSHs(sv_2mortal(newSViv(mytm.tm_min)));
1068 PUSHs(sv_2mortal(newSViv(mytm.tm_hour)));
1069 PUSHs(sv_2mortal(newSViv(mytm.tm_mday)));
1070 PUSHs(sv_2mortal(newSViv(mytm.tm_mon)));
1071 PUSHs(sv_2mortal(newSViv(mytm.tm_year)));
1072 PUSHs(sv_2mortal(newSViv(mytm.tm_wday)));
1073 PUSHs(sv_2mortal(newSViv(mytm.tm_yday)));
1074 /* isdst */
1075 PUSHs(sv_2mortal(newSViv(0)));
1076 /* epoch */
1077 PUSHs(sv_2mortal(newSViv(0)));
1078 /* islocal */
1079 PUSHs(sv_2mortal(newSViv(0)));
3df1a9e2
GA
1080
1081void
1082_mini_mktime(int sec, int min, int hour, int mday, int mon, int year)
1083 PREINIT:
1084 struct tm mytm;
1085 time_t t;
1086 PPCODE:
1087 t = 0;
1088 mytm = *gmtime(&t);
1089
1090 mytm.tm_sec = sec;
1091 mytm.tm_min = min;
1092 mytm.tm_hour = hour;
1093 mytm.tm_mday = mday;
1094 mytm.tm_mon = mon;
1095 mytm.tm_year = year;
1096
1097 my_mini_mktime(&mytm);
1098
1099 EXTEND(SP, 11);
1100 PUSHs(sv_2mortal(newSViv(mytm.tm_sec)));
1101 PUSHs(sv_2mortal(newSViv(mytm.tm_min)));
1102 PUSHs(sv_2mortal(newSViv(mytm.tm_hour)));
1103 PUSHs(sv_2mortal(newSViv(mytm.tm_mday)));
1104 PUSHs(sv_2mortal(newSViv(mytm.tm_mon)));
1105 PUSHs(sv_2mortal(newSViv(mytm.tm_year)));
1106 PUSHs(sv_2mortal(newSViv(mytm.tm_wday)));
1107 PUSHs(sv_2mortal(newSViv(mytm.tm_yday)));
1108 /* isdst */
1109 PUSHs(sv_2mortal(newSViv(0)));
1110 /* epoch */
1111 PUSHs(sv_2mortal(newSViv(0)));
1112 /* islocal */
1113 PUSHs(sv_2mortal(newSViv(0)));
90d55c29
CBW
1114
1115void
1116_crt_localtime(time_t sec)
1117 PREINIT:
1118 struct tm mytm;
1119 PPCODE:
1120 mytm = *localtime(&sec);
1121 /* Need to get: $s,$n,$h,$d,$m,$y */
1122
1123 EXTEND(SP, 9);
1124 PUSHs(sv_2mortal(newSViv(mytm.tm_sec)));
1125 PUSHs(sv_2mortal(newSViv(mytm.tm_min)));
1126 PUSHs(sv_2mortal(newSViv(mytm.tm_hour)));
1127 PUSHs(sv_2mortal(newSViv(mytm.tm_mday)));
1128 PUSHs(sv_2mortal(newSViv(mytm.tm_mon)));
1129 PUSHs(sv_2mortal(newSViv(mytm.tm_year)));
1130 PUSHs(sv_2mortal(newSViv(mytm.tm_year)));
1131 PUSHs(sv_2mortal(newSViv(mytm.tm_wday)));
1132 PUSHs(sv_2mortal(newSViv(mytm.tm_yday)));
1133 PUSHs(sv_2mortal(newSViv(mytm.tm_isdst)));
1134
1135void
1136_crt_gmtime(time_t sec)
1137 PREINIT:
1138 struct tm mytm;
1139 PPCODE:
1140 mytm = *gmtime(&sec);
1141 /* Need to get: $s,$n,$h,$d,$m,$y */
1142
1143 EXTEND(SP, 9);
1144 PUSHs(sv_2mortal(newSViv(mytm.tm_sec)));
1145 PUSHs(sv_2mortal(newSViv(mytm.tm_min)));
1146 PUSHs(sv_2mortal(newSViv(mytm.tm_hour)));
1147 PUSHs(sv_2mortal(newSViv(mytm.tm_mday)));
1148 PUSHs(sv_2mortal(newSViv(mytm.tm_mon)));
1149 PUSHs(sv_2mortal(newSViv(mytm.tm_year)));
1150 PUSHs(sv_2mortal(newSViv(mytm.tm_wday)));
1151 PUSHs(sv_2mortal(newSViv(mytm.tm_yday)));
1152 PUSHs(sv_2mortal(newSViv(mytm.tm_isdst)));
1153