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