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