This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix pthread include error for Time::Piece
[perl5.git] / cpan / 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 #   if defined(WIN32) || (defined(__QNX__) && defined(__WATCOMC__))
307 #       define strncasecmp(x,y,n) strnicmp(x,y,n)
308 #   endif
309
310 /* strptime copied from freebsd with the following copyright: */
311 /*
312  * Copyright (c) 1994 Powerdog Industries.  All rights reserved.
313  *
314  * Redistribution and use in source and binary forms, with or without
315  * modification, are permitted provided that the following conditions
316  * are met:
317  * 1. Redistributions of source code must retain the above copyright
318  *    notice, this list of conditions and the following disclaimer.
319  * 2. Redistributions in binary form must reproduce the above copyright
320  *    notice, this list of conditions and the following disclaimer
321  *    in the documentation and/or other materials provided with the
322  *    distribution.
323  * 3. All advertising materials mentioning features or use of this
324  *    software must display the following acknowledgement:
325  *      This product includes software developed by Powerdog Industries.
326  * 4. The name of Powerdog Industries may not be used to endorse or
327  *    promote products derived from this software without specific prior
328  *    written permission.
329  *
330  * THIS SOFTWARE IS PROVIDED BY POWERDOG INDUSTRIES ``AS IS'' AND ANY
331  * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
332  * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
333  * PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE POWERDOG INDUSTRIES BE
334  * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
335  * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
336  * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
337  * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
338  * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
339  * OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
340  * EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
341  */
342  
343 #ifndef lint
344 #ifndef NOID
345 static char copyright[] =
346 "@(#) Copyright (c) 1994 Powerdog Industries.  All rights reserved.";
347 static char sccsid[] = "@(#)strptime.c  0.1 (Powerdog) 94/03/27";
348 #endif /* !defined NOID */
349 #endif /* not lint */
350
351 #include <time.h>
352 #include <ctype.h>
353 #include <string.h>
354 static char * _strptime(pTHX_ const char *, const char *, struct tm *,
355                         int *got_GMT);
356
357 #define asizeof(a)      (sizeof (a) / sizeof ((a)[0]))
358
359 struct lc_time_T {
360     const char *    mon[12];
361     const char *    month[12];
362     const char *    wday[7];
363     const char *    weekday[7];
364     const char *    X_fmt;     
365     const char *    x_fmt;
366     const char *    c_fmt;
367     const char *    am;
368     const char *    pm;
369     const char *    date_fmt;
370     const char *    alt_month[12];
371     const char *    Ef_fmt;
372     const char *    EF_fmt;
373 };
374
375 struct lc_time_T _time_localebuf;
376 int _time_using_locale;
377
378 const struct lc_time_T  _C_time_locale = {
379         {
380                 "Jan", "Feb", "Mar", "Apr", "May", "Jun",
381                 "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"
382         }, {
383                 "January", "February", "March", "April", "May", "June",
384                 "July", "August", "September", "October", "November", "December"
385         }, {
386                 "Sun", "Mon", "Tue", "Wed",
387                 "Thu", "Fri", "Sat"
388         }, {
389                 "Sunday", "Monday", "Tuesday", "Wednesday",
390                 "Thursday", "Friday", "Saturday"
391         },
392
393         /* X_fmt */
394         "%H:%M:%S",
395
396         /*
397         ** x_fmt
398         ** Since the C language standard calls for
399         ** "date, using locale's date format," anything goes.
400         ** Using just numbers (as here) makes Quakers happier;
401         ** it's also compatible with SVR4.
402         */
403         "%m/%d/%y",
404
405         /*
406         ** c_fmt (ctime-compatible)
407         ** Not used, just compatibility placeholder.
408         */
409         NULL,
410
411         /* am */
412         "AM",
413
414         /* pm */
415         "PM",
416
417         /* date_fmt */
418         "%a %Ef %X %Z %Y",
419         
420         {
421                 "January", "February", "March", "April", "May", "June",
422                 "July", "August", "September", "October", "November", "December"
423         },
424
425         /* Ef_fmt
426         ** To determine short months / day order
427         */
428         "%b %e",
429
430         /* EF_fmt
431         ** To determine long months / day order
432         */
433         "%B %e"
434 };
435
436 #define Locale (&_C_time_locale)
437
438 static char *
439 _strptime(pTHX_ const char *buf, const char *fmt, struct tm *tm, int *got_GMT)
440 {
441         char c;
442         const char *ptr;
443         int i,
444                 len;
445         int Ealternative, Oalternative;
446
447     /* There seems to be a slightly improved version at
448      * http://www.opensource.apple.com/source/Libc/Libc-583/stdtime/strptime-fbsd.c
449      * which we may end up borrowing more from
450      */
451         ptr = fmt;
452         while (*ptr != 0) {
453                 if (*buf == 0)
454                         break;
455
456                 c = *ptr++;
457                 
458                 if (c != '%') {
459                         if (isspace((unsigned char)c))
460                                 while (*buf != 0 && isspace((unsigned char)*buf))
461                                         buf++;
462                         else if (c != *buf++)
463                                 return 0;
464                         continue;
465                 }
466
467                 Ealternative = 0;
468                 Oalternative = 0;
469 label:
470                 c = *ptr++;
471                 switch (c) {
472                 case 0:
473                 case '%':
474                         if (*buf++ != '%')
475                                 return 0;
476                         break;
477
478                 case '+':
479                         buf = _strptime(aTHX_ buf, Locale->date_fmt, tm, got_GMT);
480                         if (buf == 0)
481                                 return 0;
482                         break;
483
484                 case 'C':
485                         if (!isdigit((unsigned char)*buf))
486                                 return 0;
487
488                         /* XXX This will break for 3-digit centuries. */
489                         len = 2;
490                         for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) {
491                                 i *= 10;
492                                 i += *buf - '0';
493                                 len--;
494                         }
495                         if (i < 19)
496                                 return 0;
497
498                         tm->tm_year = i * 100 - 1900;
499                         break;
500
501                 case 'c':
502                         /* NOTE: c_fmt is intentionally ignored */
503                         buf = _strptime(aTHX_ buf, "%a %Ef %T %Y", tm, got_GMT);
504                         if (buf == 0)
505                                 return 0;
506                         break;
507
508                 case 'D':
509                         buf = _strptime(aTHX_ buf, "%m/%d/%y", tm, got_GMT);
510                         if (buf == 0)
511                                 return 0;
512                         break;
513
514                 case 'E':
515                         if (Ealternative || Oalternative)
516                                 break;
517                         Ealternative++;
518                         goto label;
519
520                 case 'O':
521                         if (Ealternative || Oalternative)
522                                 break;
523                         Oalternative++;
524                         goto label;
525
526                 case 'F':
527                 case 'f':
528                         if (!Ealternative)
529                                 break;
530                         buf = _strptime(aTHX_ buf, (c == 'f') ? Locale->Ef_fmt : Locale->EF_fmt, tm, got_GMT);
531                         if (buf == 0)
532                                 return 0;
533                         break;
534
535                 case 'R':
536                         buf = _strptime(aTHX_ buf, "%H:%M", tm, got_GMT);
537                         if (buf == 0)
538                                 return 0;
539                         break;
540
541                 case 'r':
542                         buf = _strptime(aTHX_ buf, "%I:%M:%S %p", tm, got_GMT);
543                         if (buf == 0)
544                                 return 0;
545                         break;
546
547                 case 'n': /* whitespace */
548                 case 't':
549                         if (!isspace((unsigned char)*buf))
550                                 return 0;
551                         while (isspace((unsigned char)*buf))
552                                 buf++;
553                         break;
554                 
555                 case 'T':
556                         buf = _strptime(aTHX_ buf, "%H:%M:%S", tm, got_GMT);
557                         if (buf == 0)
558                                 return 0;
559                         break;
560
561                 case 'X':
562                         buf = _strptime(aTHX_ buf, Locale->X_fmt, tm, got_GMT);
563                         if (buf == 0)
564                                 return 0;
565                         break;
566
567                 case 'x':
568                         buf = _strptime(aTHX_ buf, Locale->x_fmt, tm, got_GMT);
569                         if (buf == 0)
570                                 return 0;
571                         break;
572
573                 case 'j':
574                         if (!isdigit((unsigned char)*buf))
575                                 return 0;
576
577                         len = 3;
578                         for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) {
579                                 i *= 10;
580                                 i += *buf - '0';
581                                 len--;
582                         }
583                         if (i < 1 || i > 366)
584                                 return 0;
585
586                         tm->tm_yday = i - 1;
587                         break;
588
589                 case 'M':
590                 case 'S':
591                         if (*buf == 0 || isspace((unsigned char)*buf))
592                                 break;
593
594                         if (!isdigit((unsigned char)*buf))
595                                 return 0;
596
597                         len = 2;
598                         for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) {
599                                 i *= 10;
600                                 i += *buf - '0';
601                                 len--;
602                         }
603
604                         if (c == 'M') {
605                                 if (i > 59)
606                                         return 0;
607                                 tm->tm_min = i;
608                         } else {
609                                 if (i > 60)
610                                         return 0;
611                                 tm->tm_sec = i;
612                         }
613
614                         if (*buf != 0 && isspace((unsigned char)*buf))
615                                 while (*ptr != 0 && !isspace((unsigned char)*ptr))
616                                         ptr++;
617                         break;
618
619                 case 'H':
620                 case 'I':
621                 case 'k':
622                 case 'l':
623                         /*
624                          * Of these, %l is the only specifier explicitly
625                          * documented as not being zero-padded.  However,
626                          * there is no harm in allowing zero-padding.
627                          *
628                          * XXX The %l specifier may gobble one too many
629                          * digits if used incorrectly.
630                          */
631             if (!isdigit((unsigned char)*buf))
632                                 return 0;
633
634                         len = 2;
635                         for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) {
636                                 i *= 10;
637                                 i += *buf - '0';
638                                 len--;
639                         }
640                         if (c == 'H' || c == 'k') {
641                                 if (i > 23)
642                                         return 0;
643                         } else if (i > 12)
644                                 return 0;
645
646                         tm->tm_hour = i;
647
648                         if (*buf != 0 && isspace((unsigned char)*buf))
649                                 while (*ptr != 0 && !isspace((unsigned char)*ptr))
650                                         ptr++;
651                         break;
652
653                 case 'p':
654                         /*
655                          * XXX This is bogus if parsed before hour-related
656                          * specifiers.
657                          */
658             len = strlen(Locale->am);
659                         if (strncasecmp(buf, Locale->am, len) == 0) {
660                                 if (tm->tm_hour > 12)
661                                         return 0;
662                                 if (tm->tm_hour == 12)
663                                         tm->tm_hour = 0;
664                                 buf += len;
665                                 break;
666                         }
667
668                         len = strlen(Locale->pm);
669                         if (strncasecmp(buf, Locale->pm, len) == 0) {
670                                 if (tm->tm_hour > 12)
671                                         return 0;
672                                 if (tm->tm_hour != 12)
673                                         tm->tm_hour += 12;
674                                 buf += len;
675                                 break;
676                         }
677
678                         return 0;
679
680                 case 'A':
681                 case 'a':
682                         for (i = 0; i < asizeof(Locale->weekday); i++) {
683                                 if (c == 'A') {
684                                         len = strlen(Locale->weekday[i]);
685                                         if (strncasecmp(buf,
686                                                         Locale->weekday[i],
687                                                         len) == 0)
688                                                 break;
689                                 } else {
690                                         len = strlen(Locale->wday[i]);
691                                         if (strncasecmp(buf,
692                                                         Locale->wday[i],
693                                                         len) == 0)
694                                                 break;
695                                 }
696                         }
697                         if (i == asizeof(Locale->weekday))
698                                 return 0;
699
700                         tm->tm_wday = i;
701                         buf += len;
702                         break;
703
704                 case 'U':
705                 case 'W':
706                         /*
707                          * XXX This is bogus, as we can not assume any valid
708                          * information present in the tm structure at this
709                          * point to calculate a real value, so just check the
710                          * range for now.
711                          */
712             if (!isdigit((unsigned char)*buf))
713                                 return 0;
714
715                         len = 2;
716                         for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) {
717                                 i *= 10;
718                                 i += *buf - '0';
719                                 len--;
720                         }
721                         if (i > 53)
722                                 return 0;
723
724                         if (*buf != 0 && isspace((unsigned char)*buf))
725                                 while (*ptr != 0 && !isspace((unsigned char)*ptr))
726                                         ptr++;
727                         break;
728
729                 case 'w':
730                         if (!isdigit((unsigned char)*buf))
731                                 return 0;
732
733                         i = *buf - '0';
734                         if (i > 6)
735                                 return 0;
736
737                         tm->tm_wday = i;
738
739                         if (*buf != 0 && isspace((unsigned char)*buf))
740                                 while (*ptr != 0 && !isspace((unsigned char)*ptr))
741                                         ptr++;
742                         break;
743
744                 case 'd':
745                 case 'e':
746                         /*
747                          * The %e specifier is explicitly documented as not
748                          * being zero-padded but there is no harm in allowing
749                          * such padding.
750                          *
751                          * XXX The %e specifier may gobble one too many
752                          * digits if used incorrectly.
753                          */
754                         if (!isdigit((unsigned char)*buf))
755                                 return 0;
756
757                         len = 2;
758                         for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) {
759                                 i *= 10;
760                                 i += *buf - '0';
761                                 len--;
762                         }
763                         if (i > 31)
764                                 return 0;
765
766                         tm->tm_mday = i;
767
768                         if (*buf != 0 && isspace((unsigned char)*buf))
769                                 while (*ptr != 0 && !isspace((unsigned char)*ptr))
770                                         ptr++;
771                         break;
772
773                 case 'B':
774                 case 'b':
775                 case 'h':
776                         for (i = 0; i < asizeof(Locale->month); i++) {
777                                 if (Oalternative) {
778                                         if (c == 'B') {
779                                                 len = strlen(Locale->alt_month[i]);
780                                                 if (strncasecmp(buf,
781                                                                 Locale->alt_month[i],
782                                                                 len) == 0)
783                                                         break;
784                                         }
785                                 } else {
786                                         if (c == 'B') {
787                                                 len = strlen(Locale->month[i]);
788                                                 if (strncasecmp(buf,
789                                                                 Locale->month[i],
790                                                                 len) == 0)
791                                                         break;
792                                         } else {
793                                                 len = strlen(Locale->mon[i]);
794                                                 if (strncasecmp(buf,
795                                                                 Locale->mon[i],
796                                                                 len) == 0)
797                                                         break;
798                                         }
799                                 }
800                         }
801                         if (i == asizeof(Locale->month))
802                                 return 0;
803
804                         tm->tm_mon = i;
805                         buf += len;
806                         break;
807
808                 case 'm':
809                         if (!isdigit((unsigned char)*buf))
810                                 return 0;
811
812                         len = 2;
813                         for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) {
814                                 i *= 10;
815                                 i += *buf - '0';
816                                 len--;
817                         }
818                         if (i < 1 || i > 12)
819                                 return 0;
820
821                         tm->tm_mon = i - 1;
822
823                         if (*buf != 0 && isspace((unsigned char)*buf))
824                                 while (*ptr != 0 && !isspace((unsigned char)*ptr))
825                                         ptr++;
826                         break;
827
828                 case 's':
829                         {
830                         char *cp;
831                         int sverrno;
832                         long n;
833                         time_t t;
834             struct tm mytm;
835
836                         sverrno = errno;
837                         errno = 0;
838                         n = strtol(buf, &cp, 10);
839                         if (errno == ERANGE || (long)(t = n) != n) {
840                                 errno = sverrno;
841                                 return 0;
842                         }
843                         errno = sverrno;
844                         buf = cp;
845             memset(&mytm, 0, sizeof(mytm));
846             my_init_tm(&mytm);    /* XXX workaround - see my_init_tm() above */
847             mytm = *gmtime(&t);
848             tm->tm_sec    = mytm.tm_sec;
849             tm->tm_min    = mytm.tm_min;
850             tm->tm_hour   = mytm.tm_hour;
851             tm->tm_mday   = mytm.tm_mday;
852             tm->tm_mon    = mytm.tm_mon;
853             tm->tm_year   = mytm.tm_year;
854             tm->tm_wday   = mytm.tm_wday;
855             tm->tm_yday   = mytm.tm_yday;
856             tm->tm_isdst  = mytm.tm_isdst;
857                         }
858                         break;
859
860                 case 'Y':
861                 case 'y':
862                         if (*buf == 0 || isspace((unsigned char)*buf))
863                                 break;
864
865                         if (!isdigit((unsigned char)*buf))
866                                 return 0;
867
868                         len = (c == 'Y') ? 4 : 2;
869                         for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) {
870                                 i *= 10;
871                                 i += *buf - '0';
872                                 len--;
873                         }
874                         if (c == 'Y')
875                                 i -= 1900;
876                         if (c == 'y' && i < 69)
877                                 i += 100;
878                         if (i < 0)
879                                 return 0;
880
881                         tm->tm_year = i;
882
883                         if (*buf != 0 && isspace((unsigned char)*buf))
884                                 while (*ptr != 0 && !isspace((unsigned char)*ptr))
885                                         ptr++;
886                         break;
887
888                 case 'Z':
889                         {
890                         const char *cp;
891                         char *zonestr;
892
893                         for (cp = buf; *cp && isupper((unsigned char)*cp); ++cp) 
894                             {/*empty*/}
895                         if (cp - buf) {
896                                 zonestr = (char *)malloc(cp - buf + 1);
897                                 if (!zonestr) {
898                                     errno = ENOMEM;
899                                     return 0;
900                                 }
901                                 strncpy(zonestr, buf, cp - buf);
902                                 zonestr[cp - buf] = '\0';
903                                 my_tzset(aTHX);
904                                 if (0 == strcmp(zonestr, "GMT")) {
905                                     *got_GMT = 1;
906                                 }
907                                 free(zonestr);
908                                 if (!*got_GMT) return 0;
909                                 buf += cp - buf;
910                         }
911                         }
912                         break;
913
914                 case 'z':
915                         {
916                         int sign = 1;
917
918                         if (*buf != '+') {
919                                 if (*buf == '-')
920                                         sign = -1;
921                                 else
922                                         return 0;
923                         }
924
925                         buf++;
926                         i = 0;
927                         for (len = 4; len > 0; len--) {
928                                 if (isdigit((int)*buf)) {
929                                         i *= 10;
930                                         i += *buf - '0';
931                                         buf++;
932                                 } else
933                                         return 0;
934                         }
935
936                         tm->tm_hour -= sign * (i / 100);
937                         tm->tm_min  -= sign * (i % 100);
938                         *got_GMT = 1;
939                         }
940                         break;
941                 }
942         }
943         return (char *)buf;
944 }
945
946
947 char *
948 our_strptime(pTHX_ const char *buf, const char *fmt, struct tm *tm)
949 {
950         char *ret;
951         int got_GMT = 0;
952
953         return _strptime(aTHX_ buf, fmt, tm, &got_GMT);
954 }
955
956 MODULE = Time::Piece     PACKAGE = Time::Piece
957
958 PROTOTYPES: ENABLE
959
960 void
961 _strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1)
962     char *        fmt
963     int        sec
964     int        min
965     int        hour
966     int        mday
967     int        mon
968     int        year
969     int        wday
970     int        yday
971     int        isdst
972     CODE:
973     {
974         char tmpbuf[128];
975         struct tm mytm;
976         int len;
977         memset(&mytm, 0, sizeof(mytm));
978         my_init_tm(&mytm);    /* XXX workaround - see my_init_tm() above */
979         mytm.tm_sec = sec;
980         mytm.tm_min = min;
981         mytm.tm_hour = hour;
982         mytm.tm_mday = mday;
983         mytm.tm_mon = mon;
984         mytm.tm_year = year;
985         mytm.tm_wday = wday;
986         mytm.tm_yday = yday;
987         mytm.tm_isdst = isdst;
988         my_mini_mktime(&mytm);
989         len = strftime(tmpbuf, sizeof tmpbuf, fmt, &mytm);
990         /*
991         ** The following is needed to handle to the situation where 
992         ** tmpbuf overflows.  Basically we want to allocate a buffer
993         ** and try repeatedly.  The reason why it is so complicated
994         ** is that getting a return value of 0 from strftime can indicate
995         ** one of the following:
996         ** 1. buffer overflowed,
997         ** 2. illegal conversion specifier, or
998         ** 3. the format string specifies nothing to be returned(not
999         **      an error).  This could be because format is an empty string
1000         **    or it specifies %p that yields an empty string in some locale.
1001         ** If there is a better way to make it portable, go ahead by
1002         ** all means.
1003         */
1004         if ((len > 0 && len < sizeof(tmpbuf)) || (len == 0 && *fmt == '\0'))
1005         ST(0) = sv_2mortal(newSVpv(tmpbuf, len));
1006         else {
1007         /* Possibly buf overflowed - try again with a bigger buf */
1008         int     fmtlen = strlen(fmt);
1009         int    bufsize = fmtlen + sizeof(tmpbuf);
1010         char*     buf;
1011         int    buflen;
1012
1013         New(0, buf, bufsize, char);
1014         while (buf) {
1015             buflen = strftime(buf, bufsize, fmt, &mytm);
1016             if (buflen > 0 && buflen < bufsize)
1017             break;
1018             /* heuristic to prevent out-of-memory errors */
1019             if (bufsize > 100*fmtlen) {
1020             Safefree(buf);
1021             buf = NULL;
1022             break;
1023             }
1024             bufsize *= 2;
1025             Renew(buf, bufsize, char);
1026         }
1027         if (buf) {
1028             ST(0) = sv_2mortal(newSVpv(buf, buflen));
1029             Safefree(buf);
1030         }
1031         else
1032             ST(0) = sv_2mortal(newSVpv(tmpbuf, len));
1033         }
1034     }
1035
1036 void
1037 _tzset()
1038   PPCODE:
1039     my_tzset(aTHX);
1040
1041
1042 void
1043 _strptime ( string, format )
1044         char * string
1045         char * format
1046   PREINIT:
1047        struct tm mytm;
1048        time_t t;
1049        char * remainder;
1050   PPCODE:
1051        t = 0;
1052        mytm = *gmtime(&t);
1053        remainder = (char *)our_strptime(aTHX_ string, format, &mytm);
1054        if (remainder == NULL) {
1055            croak("Error parsing time");
1056        }
1057        if (*remainder != '\0') {
1058            warn("garbage at end of string in strptime: %s", remainder);
1059        }
1060           
1061        my_mini_mktime(&mytm);
1062
1063   /* 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); */
1064           
1065        EXTEND(SP, 11);
1066        PUSHs(sv_2mortal(newSViv(mytm.tm_sec)));
1067        PUSHs(sv_2mortal(newSViv(mytm.tm_min)));
1068        PUSHs(sv_2mortal(newSViv(mytm.tm_hour)));
1069        PUSHs(sv_2mortal(newSViv(mytm.tm_mday)));
1070        PUSHs(sv_2mortal(newSViv(mytm.tm_mon)));
1071        PUSHs(sv_2mortal(newSViv(mytm.tm_year)));
1072        PUSHs(sv_2mortal(newSViv(mytm.tm_wday)));
1073        PUSHs(sv_2mortal(newSViv(mytm.tm_yday)));
1074        /* isdst */
1075        PUSHs(sv_2mortal(newSViv(0)));
1076        /* epoch */
1077        PUSHs(sv_2mortal(newSViv(0)));
1078        /* islocal */
1079        PUSHs(sv_2mortal(newSViv(0)));
1080
1081 void
1082 _mini_mktime(int sec, int min, int hour, int mday, int mon, int year)
1083   PREINIT:
1084        struct tm mytm;
1085        time_t t;
1086   PPCODE:
1087        t = 0;
1088        mytm = *gmtime(&t);
1089
1090        mytm.tm_sec = sec;
1091        mytm.tm_min = min;
1092        mytm.tm_hour = hour;
1093        mytm.tm_mday = mday;
1094        mytm.tm_mon = mon;
1095        mytm.tm_year = year;
1096        
1097        my_mini_mktime(&mytm);
1098
1099        EXTEND(SP, 11);
1100        PUSHs(sv_2mortal(newSViv(mytm.tm_sec)));
1101        PUSHs(sv_2mortal(newSViv(mytm.tm_min)));
1102        PUSHs(sv_2mortal(newSViv(mytm.tm_hour)));
1103        PUSHs(sv_2mortal(newSViv(mytm.tm_mday)));
1104        PUSHs(sv_2mortal(newSViv(mytm.tm_mon)));
1105        PUSHs(sv_2mortal(newSViv(mytm.tm_year)));
1106        PUSHs(sv_2mortal(newSViv(mytm.tm_wday)));
1107        PUSHs(sv_2mortal(newSViv(mytm.tm_yday)));
1108        /* isdst */
1109        PUSHs(sv_2mortal(newSViv(0)));
1110        /* epoch */
1111        PUSHs(sv_2mortal(newSViv(0)));
1112        /* islocal */
1113        PUSHs(sv_2mortal(newSViv(0)));
1114
1115 void
1116 _crt_localtime(time_t sec)
1117     PREINIT:
1118         struct tm mytm;
1119     PPCODE:
1120         mytm = *localtime(&sec);
1121         /* Need to get: $s,$n,$h,$d,$m,$y */
1122         
1123         EXTEND(SP, 9);
1124         PUSHs(sv_2mortal(newSViv(mytm.tm_sec)));
1125         PUSHs(sv_2mortal(newSViv(mytm.tm_min)));
1126         PUSHs(sv_2mortal(newSViv(mytm.tm_hour)));
1127         PUSHs(sv_2mortal(newSViv(mytm.tm_mday)));
1128         PUSHs(sv_2mortal(newSViv(mytm.tm_mon)));
1129         PUSHs(sv_2mortal(newSViv(mytm.tm_year)));
1130         PUSHs(sv_2mortal(newSViv(mytm.tm_year)));
1131         PUSHs(sv_2mortal(newSViv(mytm.tm_wday)));
1132         PUSHs(sv_2mortal(newSViv(mytm.tm_yday)));
1133         PUSHs(sv_2mortal(newSViv(mytm.tm_isdst)));
1134         
1135 void
1136 _crt_gmtime(time_t sec)
1137     PREINIT:
1138         struct tm mytm;
1139     PPCODE:
1140         mytm = *gmtime(&sec);
1141         /* Need to get: $s,$n,$h,$d,$m,$y */
1142         
1143         EXTEND(SP, 9);
1144         PUSHs(sv_2mortal(newSViv(mytm.tm_sec)));
1145         PUSHs(sv_2mortal(newSViv(mytm.tm_min)));
1146         PUSHs(sv_2mortal(newSViv(mytm.tm_hour)));
1147         PUSHs(sv_2mortal(newSViv(mytm.tm_mday)));
1148         PUSHs(sv_2mortal(newSViv(mytm.tm_mon)));
1149         PUSHs(sv_2mortal(newSViv(mytm.tm_year)));
1150         PUSHs(sv_2mortal(newSViv(mytm.tm_wday)));
1151         PUSHs(sv_2mortal(newSViv(mytm.tm_yday)));
1152         PUSHs(sv_2mortal(newSViv(mytm.tm_isdst)));
1153