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