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