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