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 #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)));