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