cpan/Time-Piece/Piece.xs

   1 #ifdef __cplusplus
   2 extern "C" {
   3 #endif
   4 #define PERL_NO_GET_CONTEXT
   5 #include "EXTERN.h"
   6 #include "perl.h"
   7 #include "XSUB.h"
   8 #include <time.h>
   9 #ifdef __cplusplus
  10 }
  11 #endif
  12
  13 /* XXX struct tm on some systems (SunOS4/BSD) contains extra (non POSIX)
  14  * fields for which we don't have Configure support prior to Perl 5.8.0:
  15  *   char *tm_zone;   -- abbreviation of timezone name
  16  *   long tm_gmtoff;  -- offset from GMT in seconds
  17  * To workaround core dumps from the uninitialised tm_zone we get the
  18  * system to give us a reasonable struct to copy.  This fix means that
  19  * strftime uses the tm_zone and tm_gmtoff values returned by
  20  * localtime(time()). That should give the desired result most of the
  21  * time. But probably not always!
  22  *
  23  * This is a vestigial workaround for Perls prior to 5.8.0.  We now
  24  * rely on the initialization (still likely a workaround) in util.c.
  25  */
  26 #if !defined(PERL_VERSION) || PERL_VERSION < 8
  27
  28 #if defined(HAS_GNULIBC)
  29 # ifndef STRUCT_TM_HASZONE
  30 #    define STRUCT_TM_HASZONE
  31 # else
  32 #    define USE_TM_GMTOFF
  33 # endif
  34 #endif
  35
  36 #endif /* end of pre-5.8 */
  37
  38 #define    DAYS_PER_YEAR    365
  39 #define    DAYS_PER_QYEAR    (4*DAYS_PER_YEAR+1)
  40 #define    DAYS_PER_CENT    (25*DAYS_PER_QYEAR-1)
  41 #define    DAYS_PER_QCENT    (4*DAYS_PER_CENT+1)
  42 #define    SECS_PER_HOUR    (60*60)
  43 #define    SECS_PER_DAY    (24*SECS_PER_HOUR)
  44 /* parentheses deliberately absent on these two, otherwise they don't work */
  45 #define    MONTH_TO_DAYS    153/5
  46 #define    DAYS_TO_MONTH    5/153
  47 /* offset to bias by March (month 4) 1st between month/mday & year finding */
  48 #define    YEAR_ADJUST    (4*MONTH_TO_DAYS+1)
  49 /* as used here, the algorithm leaves Sunday as day 1 unless we adjust it */
  50 #define    WEEKDAY_BIAS    6    /* (1+6)%7 makes Sunday 0 again */
  51
  52 #if !defined(PERL_VERSION) || PERL_VERSION < 8
  53
  54 #ifdef STRUCT_TM_HASZONE
  55 static void
  56 my_init_tm(struct tm *ptm)        /* see mktime, strftime and asctime    */
  57 {
  58     Time_t now;
  59     (void)time(&now);
  60     Copy(localtime(&now), ptm, 1, struct tm);
  61 }
  62
  63 #else
  64 # define my_init_tm(ptm)
  65 #endif
  66
  67 #else
  68 /* use core version from util.c in 5.8.0 and later */
  69 # define my_init_tm init_tm
  70 #endif
  71
  72 #ifdef WIN32
  73
  74 /*
  75  * (1) The CRT maintains its own copy of the environment, separate from
  76  * the Win32API copy.
  77  *
  78  * (2) CRT getenv() retrieves from this copy. CRT putenv() updates this
  79  * copy, and then calls SetEnvironmentVariableA() to update the Win32API
  80  * copy.
  81  *
  82  * (3) win32_getenv() and win32_putenv() call GetEnvironmentVariableA() and
  83  * SetEnvironmentVariableA() directly, bypassing the CRT copy of the
  84  * environment.
  85  *
  86  * (4) The CRT strftime() "%Z" implementation calls __tzset(). That
  87  * calls CRT tzset(), but only the first time it is called, and in turn
  88  * that uses CRT getenv("TZ") to retrieve the timezone info from the CRT
  89  * local copy of the environment and hence gets the original setting as
  90  * perl never updates the CRT copy when assigning to $ENV{TZ}.
  91  *
  92  * Therefore, we need to retrieve the value of $ENV{TZ} and call CRT
  93  * putenv() to update the CRT copy of the environment (if it is different)
  94  * whenever we're about to call tzset().
  95  *
  96  * In addition to all that, when perl is built with PERL_IMPLICIT_SYS
  97  * defined:
  98  *
  99  * (a) Each interpreter has its own copy of the environment inside the
 100  * perlhost structure. That allows applications that host multiple
 101  * independent Perl interpreters to isolate environment changes from
 102  * each other. (This is similar to how the perlhost mechanism keeps a
 103  * separate working directory for each Perl interpreter, so that calling
 104  * chdir() will not affect other interpreters.)
 105  *
 106  * (b) Only the first Perl interpreter instantiated within a process will
 107  * "write through" environment changes to the process environment.
 108  *
 109  * (c) Even the primary Perl interpreter won't update the CRT copy of the
 110  * the environment, only the Win32API copy (it calls win32_putenv()).
 111  *
 112  * As with CPerlHost::Getenv() and CPerlHost::Putenv() themselves, it makes
 113  * sense to only update the process environment when inside the main
 114  * interpreter, but we don't have access to CPerlHost's m_bTopLevel member
 115  * from here so we'll just have to check PL_curinterp instead.
 116  *
 117  * Therefore, we can simply #undef getenv() and putenv() so that those names
 118  * always refer to the CRT functions, and explicitly call win32_getenv() to
 119  * access perl's %ENV.
 120  *
 121  * We also #undef malloc() and free() to be sure we are using the CRT
 122  * functions otherwise under PERL_IMPLICIT_SYS they are redefined to calls
 123  * into VMem::Malloc() and VMem::Free() and all allocations will be freed
 124  * when the Perl interpreter is being destroyed so we'd end up with a pointer
 125  * into deallocated memory in environ[] if a program embedding a Perl
 126  * interpreter continues to operate even after the main Perl interpreter has
 127  * been destroyed.
 128  *
 129  * Note that we don't free() the malloc()ed memory unless and until we call
 130  * malloc() again ourselves because the CRT putenv() function simply puts its
 131  * pointer argument into the environ[] arrary (it doesn't make a copy of it)
 132  * so this memory must otherwise be leaked.
 133  */
 134
 135 #undef getenv
 136 #undef putenv
 137 #  ifdef UNDER_CE
 138 #    define getenv xcegetenv
 139 #    define putenv xceputenv
 140 #  endif
 141 #undef malloc
 142 #undef free
 143
 144 static void
 145 fix_win32_tzenv(void)
 146 {
 147     static char* oldenv = NULL;
 148     char* newenv;
 149     const char* perl_tz_env = win32_getenv("TZ");
 150     const char* crt_tz_env = getenv("TZ");
 151     if (perl_tz_env == NULL)
 152         perl_tz_env = "";
 153     if (crt_tz_env == NULL)
 154         crt_tz_env = "";
 155     if (strcmp(perl_tz_env, crt_tz_env) != 0) {
 156         STRLEN perl_tz_env_len = strlen(perl_tz_env);
 157         newenv = (char*)malloc((perl_tz_env_len + 4) * sizeof(char));
 158         if (newenv != NULL) {
 159 /* putenv with old MS CRTs will cause a double free internally if you delete
 160    an env var with the CRT env that doesn't exist in Win32 env (perl %ENV only
 161    modifies the Win32 env, not CRT env), so always create the env var in Win32
 162    env before deleting it with CRT env api, so the error branch never executes
 163    in __crtsetenv after SetEnvironmentVariableA executes inside __crtsetenv.
 164
 165    VC 9/2008 and up dont have this bug, older VC (msvcrt80.dll and older) and
 166    mingw (msvcrt.dll) have it see [perl #125529]
 167 */
 168 #if !(_MSC_VER >= 1500)
 169             if(!perl_tz_env_len)
 170                 SetEnvironmentVariableA("TZ", "");
 171 #endif
 172             sprintf(newenv, "TZ=%s", perl_tz_env);
 173             putenv(newenv);
 174             if (oldenv != NULL)
 175                 free(oldenv);
 176             oldenv = newenv;
 177         }
 178     }
 179 }
 180
 181 #endif
 182
 183 /*
 184  * my_tzset - wrapper to tzset() with a fix to make it work (better) on Win32.
 185  * This code is duplicated in the POSIX module, so any changes made here
 186  * should be made there too.
 187  */
 188 static void
 189 my_tzset(pTHX)
 190 {
 191 #ifdef WIN32
 192 #if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
 193     if (PL_curinterp == aTHX)
 194 #endif
 195         fix_win32_tzenv();
 196 #endif
 197     tzset();
 198 }
 199
 200 /*
 201  * my_mini_mktime - normalise struct tm values without the localtime()
 202  * semantics (and overhead) of mktime(). Stolen shamelessly from Perl's
 203  * Perl_mini_mktime() in util.c - for details on the algorithm, see that
 204  * file.
 205  */
 206 static void
 207 my_mini_mktime(struct tm *ptm)
 208 {
 209     int yearday;
 210     int secs;
 211     int month, mday, year, jday;
 212     int odd_cent, odd_year;
 213
 214     year = 1900 + ptm->tm_year;
 215     month = ptm->tm_mon;
 216     mday = ptm->tm_mday;
 217     /* allow given yday with no month & mday to dominate the result */
 218     if (ptm->tm_yday >= 0 && mday <= 0 && month <= 0) {
 219         month = 0;
 220         mday = 0;
 221         jday = 1 + ptm->tm_yday;
 222     }
 223     else {
 224         jday = 0;
 225     }
 226     if (month >= 2)
 227         month+=2;
 228     else
 229         month+=14, year--;
 230
 231     yearday = DAYS_PER_YEAR * year + year/4 - year/100 + year/400;
 232     yearday += month*MONTH_TO_DAYS + mday + jday;
 233     /*
 234      * Note that we don't know when leap-seconds were or will be,
 235      * so we have to trust the user if we get something which looks
 236      * like a sensible leap-second.  Wild values for seconds will
 237      * be rationalised, however.
 238      */
 239     if ((unsigned) ptm->tm_sec <= 60) {
 240         secs = 0;
 241     }
 242     else {
 243         secs = ptm->tm_sec;
 244         ptm->tm_sec = 0;
 245     }
 246     secs += 60 * ptm->tm_min;
 247     secs += SECS_PER_HOUR * ptm->tm_hour;
 248     if (secs < 0) {
 249         if (secs-(secs/SECS_PER_DAY*SECS_PER_DAY) < 0) {
 250             /* got negative remainder, but need positive time */
 251             /* back off an extra day to compensate */
 252             yearday += (secs/SECS_PER_DAY)-1;
 253             secs -= SECS_PER_DAY * (secs/SECS_PER_DAY - 1);
 254         }
 255         else {
 256             yearday += (secs/SECS_PER_DAY);
 257             secs -= SECS_PER_DAY * (secs/SECS_PER_DAY);
 258         }
 259     }
 260     else if (secs >= SECS_PER_DAY) {
 261         yearday += (secs/SECS_PER_DAY);
 262         secs %= SECS_PER_DAY;
 263     }
 264     ptm->tm_hour = secs/SECS_PER_HOUR;
 265     secs %= SECS_PER_HOUR;
 266     ptm->tm_min = secs/60;
 267     secs %= 60;
 268     ptm->tm_sec += secs;
 269     /* done with time of day effects */
 270     /*
 271      * The algorithm for yearday has (so far) left it high by 428.
 272      * To avoid mistaking a legitimate Feb 29 as Mar 1, we need to
 273      * bias it by 123 while trying to figure out what year it
 274      * really represents.  Even with this tweak, the reverse
 275      * translation fails for years before A.D. 0001.
 276      * It would still fail for Feb 29, but we catch that one below.
 277      */
 278     jday = yearday;    /* save for later fixup vis-a-vis Jan 1 */
 279     yearday -= YEAR_ADJUST;
 280     year = (yearday / DAYS_PER_QCENT) * 400;
 281     yearday %= DAYS_PER_QCENT;
 282     odd_cent = yearday / DAYS_PER_CENT;
 283     year += odd_cent * 100;
 284     yearday %= DAYS_PER_CENT;
 285     year += (yearday / DAYS_PER_QYEAR) * 4;
 286     yearday %= DAYS_PER_QYEAR;
 287     odd_year = yearday / DAYS_PER_YEAR;
 288     year += odd_year;
 289     yearday %= DAYS_PER_YEAR;
 290     if (!yearday && (odd_cent==4 || odd_year==4)) { /* catch Feb 29 */
 291         month = 1;
 292         yearday = 29;
 293     }
 294     else {
 295         yearday += YEAR_ADJUST;    /* recover March 1st crock */
 296         month = yearday*DAYS_TO_MONTH;
 297         yearday -= month*MONTH_TO_DAYS;
 298         /* recover other leap-year adjustment */
 299         if (month > 13) {
 300             month-=14;
 301             year++;
 302         }
 303         else {
 304             month-=2;
 305         }
 306     }
 307     ptm->tm_year = year - 1900;
 308     if (yearday) {
 309       ptm->tm_mday = yearday;
 310       ptm->tm_mon = month;
 311     }
 312     else {
 313       ptm->tm_mday = 31;
 314       ptm->tm_mon = month - 1;
 315     }
 316     /* re-build yearday based on Jan 1 to get tm_yday */
 317     year--;
 318     yearday = year*DAYS_PER_YEAR + year/4 - year/100 + year/400;
 319     yearday += 14*MONTH_TO_DAYS + 1;
 320     ptm->tm_yday = jday - yearday;
 321     /* fix tm_wday if not overridden by caller */
 322     ptm->tm_wday = (jday + WEEKDAY_BIAS) % 7;
 323 }
 324
 325 #   if defined(WIN32) || (defined(__QNX__) && defined(__WATCOMC__))
 326 #       define strncasecmp(x,y,n) strnicmp(x,y,n)
 327 #   endif
 328
 329 /* strptime.c    0.1 (Powerdog) 94/03/27 */
 330 /* strptime copied from freebsd with the following copyright: */
 331 /*
 332  * Copyright (c) 1994 Powerdog Industries.  All rights reserved.
 333  *
 334  * Redistribution and use in source and binary forms, with or without
 335  * modification, are permitted provided that the following conditions
 336  * are met:
 337  *
 338  * 1. Redistributions of source code must retain the above copyright
 339  *    notice, this list of conditions and the following disclaimer.
 340  *
 341  * 2. Redistributions in binary form must reproduce the above copyright
 342  *    notice, this list of conditions and the following disclaimer
 343  *    in the documentation and/or other materials provided with the
 344  *    distribution.
 345  *
 346  * THIS SOFTWARE IS PROVIDED BY POWERDOG INDUSTRIES ``AS IS'' AND ANY
 347  * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 348  * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
 349  * PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE POWERDOG INDUSTRIES BE
 350  * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
 351  * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
 352  * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
 353  * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
 354  * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
 355  * OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
 356  * EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 357  *
 358  * The views and conclusions contained in the software and documentation
 359  * are those of the authors and should not be interpreted as representing
 360  * official policies, either expressed or implied, of Powerdog Industries.
 361  */
 362
 363 #include <time.h>
 364 #include <ctype.h>
 365 #include <string.h>
 366 static char * _strptime(pTHX_ const char *, const char *, struct tm *,
 367                         int *got_GMT);
 368
 369 #define asizeof(a)      (sizeof (a) / sizeof ((a)[0]))
 370
 371 struct lc_time_T {
 372     const char *    mon[12];
 373     const char *    month[12];
 374     const char *    wday[7];
 375     const char *    weekday[7];
 376     const char *    X_fmt;
 377     const char *    x_fmt;
 378     const char *    c_fmt;
 379     const char *    am;
 380     const char *    pm;
 381     const char *    date_fmt;
 382     const char *    alt_month[12];
 383     const char *    Ef_fmt;
 384     const char *    EF_fmt;
 385 };
 386
 387 struct lc_time_T _time_localebuf;
 388 int _time_using_locale;
 389
 390 const struct lc_time_T  _C_time_locale = {
 391         {
 392                 "Jan", "Feb", "Mar", "Apr", "May", "Jun",
 393                 "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"
 394         }, {
 395                 "January", "February", "March", "April", "May", "June",
 396                 "July", "August", "September", "October", "November", "December"
 397         }, {
 398                 "Sun", "Mon", "Tue", "Wed",
 399                 "Thu", "Fri", "Sat"
 400         }, {
 401                 "Sunday", "Monday", "Tuesday", "Wednesday",
 402                 "Thursday", "Friday", "Saturday"
 403         },
 404
 405         /* X_fmt */
 406         "%H:%M:%S",
 407
 408         /*
 409         ** x_fmt
 410         ** Since the C language standard calls for
 411         ** "date, using locale's date format," anything goes.
 412         ** Using just numbers (as here) makes Quakers happier;
 413         ** it's also compatible with SVR4.
 414         */
 415         "%m/%d/%y",
 416
 417         /*
 418         ** c_fmt (ctime-compatible)
 419         ** Not used, just compatibility placeholder.
 420         */
 421         NULL,
 422
 423         /* am */
 424         "AM",
 425
 426         /* pm */
 427         "PM",
 428
 429         /* date_fmt */
 430         "%a %Ef %X %Z %Y",
 431
 432         {
 433                 "January", "February", "March", "April", "May", "June",
 434                 "July", "August", "September", "October", "November", "December"
 435         },
 436
 437         /* Ef_fmt
 438         ** To determine short months / day order
 439         */
 440         "%b %e",
 441
 442         /* EF_fmt
 443         ** To determine long months / day order
 444         */
 445         "%B %e"
 446 };
 447
 448 #define Locale (&_C_time_locale)
 449
 450 static char *
 451 _strptime(pTHX_ const char *buf, const char *fmt, struct tm *tm, int *got_GMT)
 452 {
 453         char c;
 454         const char *ptr;
 455         int i,
 456                 len;
 457         int Ealternative, Oalternative;
 458
 459     /* There seems to be a slightly improved version at
 460      * http://www.opensource.apple.com/source/Libc/Libc-583/stdtime/strptime-fbsd.c
 461      * which we may end up borrowing more from
 462      */
 463         ptr = fmt;
 464         while (*ptr != 0) {
 465                 if (*buf == 0)
 466                         break;
 467
 468                 c = *ptr++;
 469
 470                 if (c != '%') {
 471                         if (isspace((unsigned char)c))
 472                                 while (*buf != 0 && isspace((unsigned char)*buf))
 473                                         buf++;
 474                         else if (c != *buf++)
 475                                 return 0;
 476                         continue;
 477                 }
 478
 479                 Ealternative = 0;
 480                 Oalternative = 0;
 481 label:
 482                 c = *ptr++;
 483                 switch (c) {
 484                 case 0:
 485                 case '%':
 486                         if (*buf++ != '%')
 487                                 return 0;
 488                         break;
 489
 490                 case '+':
 491                         buf = _strptime(aTHX_ buf, Locale->date_fmt, tm, got_GMT);
 492                         if (buf == 0)
 493                                 return 0;
 494                         break;
 495
 496                 case 'C':
 497                         if (!isdigit((unsigned char)*buf))
 498                                 return 0;
 499
 500                         /* XXX This will break for 3-digit centuries. */
 501                         len = 2;
 502                         for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) {
 503                                 i *= 10;
 504                                 i += *buf - '0';
 505                                 len--;
 506                         }
 507                         if (i < 19)
 508                                 return 0;
 509
 510                         tm->tm_year = i * 100 - 1900;
 511                         break;
 512
 513                 case 'c':
 514                         /* NOTE: c_fmt is intentionally ignored */
 515                         buf = _strptime(aTHX_ buf, "%a %Ef %T %Y", tm, got_GMT);
 516                         if (buf == 0)
 517                                 return 0;
 518                         break;
 519
 520                 case 'D':
 521                         buf = _strptime(aTHX_ buf, "%m/%d/%y", tm, got_GMT);
 522                         if (buf == 0)
 523                                 return 0;
 524                         break;
 525
 526                 case 'E':
 527                         if (Ealternative || Oalternative)
 528                                 break;
 529                         Ealternative++;
 530                         goto label;
 531
 532                 case 'O':
 533                         if (Ealternative || Oalternative)
 534                                 break;
 535                         Oalternative++;
 536                         goto label;
 537
 538                 case 'F':
 539                 case 'f':
 540                         if (!Ealternative)
 541                                 break;
 542                         buf = _strptime(aTHX_ buf, (c == 'f') ? Locale->Ef_fmt : Locale->EF_fmt, tm, got_GMT);
 543                         if (buf == 0)
 544                                 return 0;
 545                         break;
 546
 547                 case 'R':
 548                         buf = _strptime(aTHX_ buf, "%H:%M", tm, got_GMT);
 549                         if (buf == 0)
 550                                 return 0;
 551                         break;
 552
 553                 case 'r':
 554                         buf = _strptime(aTHX_ buf, "%I:%M:%S %p", tm, got_GMT);
 555                         if (buf == 0)
 556                                 return 0;
 557                         break;
 558
 559                 case 'n': /* whitespace */
 560                 case 't':
 561                         if (!isspace((unsigned char)*buf))
 562                                 return 0;
 563                         while (isspace((unsigned char)*buf))
 564                                 buf++;
 565                         break;
 566
 567                 case 'T':
 568                         buf = _strptime(aTHX_ buf, "%H:%M:%S", tm, got_GMT);
 569                         if (buf == 0)
 570                                 return 0;
 571                         break;
 572
 573                 case 'X':
 574                         buf = _strptime(aTHX_ buf, Locale->X_fmt, tm, got_GMT);
 575                         if (buf == 0)
 576                                 return 0;
 577                         break;
 578
 579                 case 'x':
 580                         buf = _strptime(aTHX_ buf, Locale->x_fmt, tm, got_GMT);
 581                         if (buf == 0)
 582                                 return 0;
 583                         break;
 584
 585                 case 'j':
 586                         if (!isdigit((unsigned char)*buf))
 587                                 return 0;
 588
 589                         len = 3;
 590                         for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) {
 591                                 i *= 10;
 592                                 i += *buf - '0';
 593                                 len--;
 594                         }
 595                         if (i < 1 || i > 366)
 596                                 return 0;
 597
 598                         tm->tm_yday = i - 1;
 599                         tm->tm_mday = 0;
 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 < (int)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 == (int)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 < (int)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 == (int)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 's':
 842                         {
 843                         char *cp;
 844                         int sverrno;
 845                         long n;
 846                         time_t t;
 847             struct tm mytm;
 848
 849                         sverrno = errno;
 850                         errno = 0;
 851                         n = strtol(buf, &cp, 10);
 852                         if (errno == ERANGE || (long)(t = n) != n) {
 853                                 errno = sverrno;
 854                                 return 0;
 855                         }
 856                         errno = sverrno;
 857                         buf = cp;
 858             memset(&mytm, 0, sizeof(mytm));
 859             my_init_tm(&mytm);    /* XXX workaround - see my_init_tm() above */
 860             mytm = *gmtime(&t);
 861             tm->tm_sec    = mytm.tm_sec;
 862             tm->tm_min    = mytm.tm_min;
 863             tm->tm_hour   = mytm.tm_hour;
 864             tm->tm_mday   = mytm.tm_mday;
 865             tm->tm_mon    = mytm.tm_mon;
 866             tm->tm_year   = mytm.tm_year;
 867             tm->tm_wday   = mytm.tm_wday;
 868             tm->tm_yday   = mytm.tm_yday;
 869             tm->tm_isdst  = mytm.tm_isdst;
 870                         }
 871                         break;
 872
 873                 case 'Y':
 874                 case 'y':
 875                         if (*buf == 0 || isspace((unsigned char)*buf))
 876                                 break;
 877
 878                         if (!isdigit((unsigned char)*buf))
 879                                 return 0;
 880
 881                         len = (c == 'Y') ? 4 : 2;
 882                         for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) {
 883                                 i *= 10;
 884                                 i += *buf - '0';
 885                                 len--;
 886                         }
 887                         if (c == 'Y')
 888                                 i -= 1900;
 889                         if (c == 'y' && i < 69)
 890                                 i += 100;
 891                         if (i < 0)
 892                                 return 0;
 893
 894                         tm->tm_year = i;
 895
 896                         if (*buf != 0 && isspace((unsigned char)*buf))
 897                                 while (*ptr != 0 && !isspace((unsigned char)*ptr))
 898                                         ptr++;
 899                         break;
 900
 901                 case 'Z':
 902                         {
 903                         const char *cp;
 904                         char *zonestr;
 905
 906                         for (cp = buf; *cp && isupper((unsigned char)*cp); ++cp)
 907                             {/*empty*/}
 908                         if (cp - buf) {
 909                                 zonestr = (char *)malloc(cp - buf + 1);
 910                                 if (!zonestr) {
 911                                     errno = ENOMEM;
 912                                     return 0;
 913                                 }
 914                                 strncpy(zonestr, buf, cp - buf);
 915                                 zonestr[cp - buf] = '\0';
 916                                 my_tzset(aTHX);
 917                                 if (0 == strcmp(zonestr, "GMT")) {
 918                                     *got_GMT = 1;
 919                                 }
 920                                 free(zonestr);
 921                                 if (!*got_GMT) return 0;
 922                                 buf += cp - buf;
 923                         }
 924                         }
 925                         break;
 926
 927                 case 'z':
 928                         {
 929                         int sign = 1;
 930
 931                         if (*buf != '+') {
 932                                 if (*buf == '-')
 933                                         sign = -1;
 934                                 else
 935                                         return 0;
 936                         }
 937
 938                         buf++;
 939                         i = 0;
 940                         for (len = 4; len > 0; len--) {
 941                                 if (isdigit((int)*buf)) {
 942                                         i *= 10;
 943                                         i += *buf - '0';
 944                                         buf++;
 945                                 } else
 946                                         return 0;
 947                         }
 948
 949                         tm->tm_hour -= sign * (i / 100);
 950                         tm->tm_min  -= sign * (i % 100);
 951                         *got_GMT = 1;
 952                         }
 953                         break;
 954                 }
 955         }
 956         return (char *)buf;
 957 }
 958
 959 /* Saves alot of machine code.
 960    Takes a (auto) SP, which may or may not have been PUSHed before, puts
 961    tm struct members on Perl stack, then returns new, advanced, SP to caller.
 962    Assign the return of push_common_tm to your SP, so you can continue to PUSH
 963    or do a PUTBACK and return eventually.
 964    !!!! push_common_tm does not touch PL_stack_sp !!!!
 965    !!!! do not use PUTBACK then SPAGAIN semantics around push_common_tm !!!!
 966    !!!! You must mortalize whatever push_common_tm put on stack yourself to
 967         avoid leaking !!!!
 968 */
 969 SV **
 970 push_common_tm(pTHX_ SV ** SP, struct tm *mytm)
 971 {
 972         PUSHs(newSViv(mytm->tm_sec));
 973         PUSHs(newSViv(mytm->tm_min));
 974         PUSHs(newSViv(mytm->tm_hour));
 975         PUSHs(newSViv(mytm->tm_mday));
 976         PUSHs(newSViv(mytm->tm_mon));
 977         PUSHs(newSViv(mytm->tm_year));
 978         PUSHs(newSViv(mytm->tm_wday));
 979         PUSHs(newSViv(mytm->tm_yday));
 980         PUSHs(newSViv(mytm->tm_isdst));
 981         return SP;
 982 }
 983
 984 /* specialized common end of 2 XSUBs
 985   SV ** SP -- pass your (auto) SP, which has not been PUSHed before, but was
 986               reset to 0 (PPCODE only or SP -= items or XSprePUSH)
 987   tm *mytm -- a tm *, will be proprocessed with my_mini_mktime
 988   return   -- none, after calling return_11part_tm, you must call "return;"
 989               no exceptions
 990 */
 991 void
 992 return_11part_tm(pTHX_ SV ** SP, struct tm *mytm)
 993 {
 994        my_mini_mktime(mytm);
 995
 996   /* 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); */
 997        EXTEND(SP, 11);
 998        SP = push_common_tm(aTHX_ SP, mytm);
 999        /* epoch */
1000        PUSHs(newSViv(0));
1001        /* islocal */
1002        PUSHs(newSViv(0));
1003        PUTBACK;
1004        {
1005             SV ** endsp = SP; /* the SV * under SP needs to be mortaled */
1006             SP -= (11 - 1); /* subtract 0 based count of SVs to mortal */
1007 /* mortal target of SP, then increment before function call
1008    so SP is already calculated before next comparison to not stall CPU */
1009             do {
1010                 sv_2mortal(*SP++);
1011             } while(SP <= endsp);
1012        }
1013        return;
1014 }
1015
1016 MODULE = Time::Piece     PACKAGE = Time::Piece
1017
1018 PROTOTYPES: ENABLE
1019
1020 void
1021 _strftime(fmt, epoch, islocal = 1)
1022     char *      fmt
1023     time_t      epoch
1024     int         islocal
1025     CODE:
1026     {
1027         char tmpbuf[128];
1028         struct tm mytm;
1029         size_t len;
1030
1031         if(islocal == 1)
1032             mytm = *localtime(&epoch);
1033         else
1034             mytm = *gmtime(&epoch);
1035
1036         len = strftime(tmpbuf, sizeof tmpbuf, fmt, &mytm);
1037         /*
1038         ** The following is needed to handle to the situation where
1039         ** tmpbuf overflows.  Basically we want to allocate a buffer
1040         ** and try repeatedly.  The reason why it is so complicated
1041         ** is that getting a return value of 0 from strftime can indicate
1042         ** one of the following:
1043         ** 1. buffer overflowed,
1044         ** 2. illegal conversion specifier, or
1045         ** 3. the format string specifies nothing to be returned(not
1046         **      an error).  This could be because format is an empty string
1047         **    or it specifies %p that yields an empty string in some locale.
1048         ** If there is a better way to make it portable, go ahead by
1049         ** all means.
1050         */
1051         if ((len > 0 && len < sizeof(tmpbuf)) || (len == 0 && *fmt == '\0'))
1052         ST(0) = sv_2mortal(newSVpv(tmpbuf, len));
1053         else {
1054         /* Possibly buf overflowed - try again with a bigger buf */
1055         int     fmtlen = strlen(fmt);
1056         int    bufsize = fmtlen + sizeof(tmpbuf);
1057         char*     buf;
1058         int    buflen;
1059
1060         New(0, buf, bufsize, char);
1061         while (buf) {
1062             buflen = strftime(buf, bufsize, fmt, &mytm);
1063             if (buflen > 0 && buflen < bufsize)
1064             break;
1065             /* heuristic to prevent out-of-memory errors */
1066             if (bufsize > 100*fmtlen) {
1067             Safefree(buf);
1068             buf = NULL;
1069             break;
1070             }
1071             bufsize *= 2;
1072             Renew(buf, bufsize, char);
1073         }
1074         if (buf) {
1075             ST(0) = sv_2mortal(newSVpv(buf, buflen));
1076             Safefree(buf);
1077         }
1078         else
1079             ST(0) = sv_2mortal(newSVpv(tmpbuf, len));
1080         }
1081     }
1082
1083 void
1084 _tzset()
1085   PPCODE:
1086     PUTBACK; /* makes rest of this function tailcall friendly */
1087     my_tzset(aTHX);
1088     return; /* skip XSUBPP's PUTBACK */
1089
1090 void
1091 _strptime ( string, format )
1092         char * string
1093         char * format
1094   PREINIT:
1095        struct tm mytm;
1096        time_t t;
1097        char * remainder;
1098        int got_GMT;
1099   PPCODE:
1100        t = 0;
1101        mytm = *gmtime(&t);
1102        mytm.tm_isdst = -1; /* -1 means we don't know */
1103        got_GMT = 0;
1104
1105        remainder = (char *)_strptime(aTHX_ string, format, &mytm, &got_GMT);
1106        if (remainder == NULL) {
1107            croak("Error parsing time");
1108        }
1109        if (*remainder != '\0') {
1110            warn("garbage at end of string in strptime: %s", remainder);
1111        }
1112
1113        return_11part_tm(aTHX_ SP, &mytm);
1114        return;
1115
1116 void
1117 _mini_mktime(int sec, int min, int hour, int mday, int mon, int year)
1118   PREINIT:
1119        struct tm mytm;
1120        time_t t;
1121   PPCODE:
1122        t = 0;
1123        mytm = *gmtime(&t);
1124
1125        mytm.tm_sec = sec;
1126        mytm.tm_min = min;
1127        mytm.tm_hour = hour;
1128        mytm.tm_mday = mday;
1129        mytm.tm_mon = mon;
1130        mytm.tm_year = year;
1131
1132        return_11part_tm(aTHX_ SP, &mytm);
1133        return;
1134
1135 void
1136 _crt_localtime(time_t sec)
1137     ALIAS:
1138         _crt_gmtime = 1
1139     PREINIT:
1140         struct tm mytm;
1141     PPCODE:
1142         if(ix) mytm = *gmtime(&sec);
1143         else mytm = *localtime(&sec);
1144         /* Need to get: $s,$n,$h,$d,$m,$y */
1145
1146         EXTEND(SP, 9);
1147         SP = push_common_tm(aTHX_ SP, &mytm);
1148         PUSHs(newSViv(mytm.tm_isdst));
1149         PUTBACK;
1150         {
1151             SV ** endsp = SP; /* the SV * under SP needs to be mortaled */
1152             SP -= (9 - 1); /* subtract 0 based count of SVs to mortal */
1153 /* mortal target of SP, then increment before function call
1154    so SP is already calculated before next comparison to not stall CPU */
1155             do {
1156                 sv_2mortal(*SP++);
1157             } while(SP <= endsp);
1158         }
1159         return;