r35478 - in /branches/upstream/libtime-piece-perl/current: Changes META.yml Piece.pm Piece.xs t/02core.t

ryan52-guest at users.alioth.debian.org ryan52-guest at users.alioth.debian.org
Sat May 16 03:35:58 UTC 2009


Author: ryan52-guest
Date: Sat May 16 03:35:53 2009
New Revision: 35478

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=35478
Log:
[svn-upgrade] Integrating new upstream version, libtime-piece-perl (1.14)

Modified:
    branches/upstream/libtime-piece-perl/current/Changes
    branches/upstream/libtime-piece-perl/current/META.yml
    branches/upstream/libtime-piece-perl/current/Piece.pm
    branches/upstream/libtime-piece-perl/current/Piece.xs
    branches/upstream/libtime-piece-perl/current/t/02core.t

Modified: branches/upstream/libtime-piece-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtime-piece-perl/current/Changes?rev=35478&op=diff
==============================================================================
--- branches/upstream/libtime-piece-perl/current/Changes (original)
+++ branches/upstream/libtime-piece-perl/current/Changes Sat May 16 03:35:53 2009
@@ -1,5 +1,10 @@
 
 Time::Piece Changes
+
+1.14
+	- rework add_months() to not rely on strptime being able to parse illegal
+	  dates (Gisle Aas).
+        - Various win32 TZ fixes from p5p core perl version
 
 1.13
     - More QNX fixes (kraai at ftbfs.org)

Modified: branches/upstream/libtime-piece-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtime-piece-perl/current/META.yml?rev=35478&op=diff
==============================================================================
--- branches/upstream/libtime-piece-perl/current/META.yml (original)
+++ branches/upstream/libtime-piece-perl/current/META.yml Sat May 16 03:35:53 2009
@@ -1,10 +1,19 @@
-# http://module-build.sourceforge.net/META-spec.html
-#XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
-name:         Time-Piece
-version:      1.13
-version_from: Piece.pm
-installdirs:  site
-requires:
-
-distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.21
+--- #YAML:1.0
+name:               Time-Piece
+version:            1.14
+abstract:           Object Oriented time objects
+author:
+    - Matt Sergeant
+license:            unknown
+distribution_type:  module
+configure_requires:
+    ExtUtils::MakeMaker:  0
+requires:  {}
+no_index:
+    directory:
+        - t
+        - inc
+generated_by:       ExtUtils::MakeMaker version 6.48
+meta-spec:
+    url:      http://module-build.sourceforge.net/META-spec-v1.4.html
+    version:  1.4

Modified: branches/upstream/libtime-piece-perl/current/Piece.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtime-piece-perl/current/Piece.pm?rev=35478&op=diff
==============================================================================
--- branches/upstream/libtime-piece-perl/current/Piece.pm (original)
+++ branches/upstream/libtime-piece-perl/current/Piece.pm Sat May 16 03:35:53 2009
@@ -1,4 +1,4 @@
-# $Id: Piece.pm 76 2008-03-02 20:15:09Z matt $
+# $Id: Piece.pm 81 2009-05-09 02:31:43Z matt $
 
 package Time::Piece;
 
@@ -22,7 +22,7 @@
     ':override' => 'internal',
     );
 
-our $VERSION = '1.13';
+our $VERSION = '1.14';
 
 bootstrap Time::Piece $VERSION;
 
@@ -607,12 +607,8 @@
         $final_month = $final_month % 12;
     }
     
-    my $string = ($time->year + $num_years) . "-" .
-                 ($final_month + 1) . "-" .
-                 ($time->mday) . " " . $time->hms;
-    my $format = "%Y-%m-%d %H:%M:%S";
-    #warn("Parsing string: $string\n");
-    my @vals = _strptime($string, $format);
+    my @vals = _mini_mktime($time->sec, $time->min, $time->hour,
+                            $time->mday, $final_month, $time->year - 1900 + $num_years);
 #    warn(sprintf("got vals: %d-%d-%d %d:%d:%d\n", reverse(@vals)));
     return scalar $time->_mktime(\@vals, $time->[c_islocal]);
 }
@@ -824,6 +820,21 @@
 
     use Time::Piece ':override';
 
+=head1 CAVEATS
+
+=head2 Setting $ENV{TZ} in Threads on Win32
+
+Note that when using perl in the default build configuration on Win32
+(specifically, when perl is built with PERL_IMPLICIT_SYS), each perl
+interpreter maintains its own copy of the environment and only the main
+interpreter will update the process environment seen by strftime.
+
+Therefore, if you make changes to $ENV{TZ} from inside a thread other than
+the main thread then those changes will not be seen by strftime if you
+subsequently call that with the %Z formatting code. You must change $ENV{TZ}
+in the main thread to have the desired effect in this case (and you must
+also call _tzset() in the main thread to register the environment change).
+
 =head1 AUTHOR
 
 Matt Sergeant, matt at sergeant.org

Modified: branches/upstream/libtime-piece-perl/current/Piece.xs
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtime-piece-perl/current/Piece.xs?rev=35478&op=diff
==============================================================================
--- branches/upstream/libtime-piece-perl/current/Piece.xs (original)
+++ branches/upstream/libtime-piece-perl/current/Piece.xs Sat May 16 03:35:53 2009
@@ -10,7 +10,7 @@
 #endif
 
 /* XXX struct tm on some systems (SunOS4/BSD) contains extra (non POSIX)
- * fields for which we don't have Configure support yet:
+ * fields for which we don't have Configure support prior to Perl 5.8.0:
  *   char *tm_zone;   -- abbreviation of timezone name
  *   long tm_gmtoff;  -- offset from GMT in seconds
  * To workaround core dumps from the uninitialised tm_zone we get the
@@ -19,17 +19,20 @@
  * localtime(time()). That should give the desired result most of the
  * time. But probably not always!
  *
- * This is a temporary workaround to be removed once Configure
- * support is added and NETaa14816 is considered in full.
- * It does not address tzname aspects of NETaa14816.
+ * This is a vestigial workaround for Perls prior to 5.8.0.  We now
+ * rely on the initialization (still likely a workaround) in util.c.
  */
-#if !defined(HAS_GNULIBC)
+#if !defined(PERL_VERSION) || PERL_VERSION < 8
+
+#if defined(HAS_GNULIBC)
 # ifndef STRUCT_TM_HASZONE
 #    define STRUCT_TM_HASZONE
 # else
 #    define USE_TM_GMTOFF
 # endif
 #endif
+
+#endif /* end of pre-5.8 */
 
 #define    DAYS_PER_YEAR    365
 #define    DAYS_PER_QYEAR    (4*DAYS_PER_YEAR+1)
@@ -45,6 +48,8 @@
 /* as used here, the algorithm leaves Sunday as day 1 unless we adjust it */
 #define    WEEKDAY_BIAS    6    /* (1+6)%7 makes Sunday 0 again */
 
+#if !defined(PERL_VERSION) || PERL_VERSION < 8
+
 #ifdef STRUCT_TM_HASZONE
 static void
 my_init_tm(struct tm *ptm)        /* see mktime, strftime and asctime    */
@@ -57,6 +62,121 @@
 #else
 # define my_init_tm(ptm)
 #endif
+
+#else
+/* use core version from util.c in 5.8.0 and later */
+# define my_init_tm init_tm
+#endif 
+
+#ifdef WIN32
+
+/*
+ * (1) The CRT maintains its own copy of the environment, separate from
+ * the Win32API copy.
+ *
+ * (2) CRT getenv() retrieves from this copy. CRT putenv() updates this
+ * copy, and then calls SetEnvironmentVariableA() to update the Win32API
+ * copy.
+ *
+ * (3) win32_getenv() and win32_putenv() call GetEnvironmentVariableA() and
+ * SetEnvironmentVariableA() directly, bypassing the CRT copy of the
+ * environment.
+ *
+ * (4) The CRT strftime() "%Z" implementation calls __tzset(). That
+ * calls CRT tzset(), but only the first time it is called, and in turn
+ * that uses CRT getenv("TZ") to retrieve the timezone info from the CRT
+ * local copy of the environment and hence gets the original setting as
+ * perl never updates the CRT copy when assigning to $ENV{TZ}.
+ *
+ * Therefore, we need to retrieve the value of $ENV{TZ} and call CRT
+ * putenv() to update the CRT copy of the environment (if it is different)
+ * whenever we're about to call tzset().
+ *
+ * In addition to all that, when perl is built with PERL_IMPLICIT_SYS
+ * defined:
+ *
+ * (a) Each interpreter has its own copy of the environment inside the
+ * perlhost structure. That allows applications that host multiple
+ * independent Perl interpreters to isolate environment changes from
+ * each other. (This is similar to how the perlhost mechanism keeps a
+ * separate working directory for each Perl interpreter, so that calling
+ * chdir() will not affect other interpreters.)
+ *
+ * (b) Only the first Perl interpreter instantiated within a process will
+ * "write through" environment changes to the process environment.
+ *
+ * (c) Even the primary Perl interpreter won't update the CRT copy of the
+ * the environment, only the Win32API copy (it calls win32_putenv()).
+ *
+ * As with CPerlHost::Getenv() and CPerlHost::Putenv() themselves, it makes
+ * sense to only update the process environment when inside the main
+ * interpreter, but we don't have access to CPerlHost's m_bTopLevel member
+ * from here so we'll just have to check PL_curinterp instead.
+ *
+ * Therefore, we can simply #undef getenv() and putenv() so that those names
+ * always refer to the CRT functions, and explicitly call win32_getenv() to
+ * access perl's %ENV.
+ *
+ * We also #undef malloc() and free() to be sure we are using the CRT
+ * functions otherwise under PERL_IMPLICIT_SYS they are redefined to calls
+ * into VMem::Malloc() and VMem::Free() and all allocations will be freed
+ * when the Perl interpreter is being destroyed so we'd end up with a pointer
+ * into deallocated memory in environ[] if a program embedding a Perl
+ * interpreter continues to operate even after the main Perl interpreter has
+ * been destroyed.
+ *
+ * Note that we don't free() the malloc()ed memory unless and until we call
+ * malloc() again ourselves because the CRT putenv() function simply puts its
+ * pointer argument into the environ[] arrary (it doesn't make a copy of it)
+ * so this memory must otherwise be leaked.
+ */
+
+#undef getenv
+#undef putenv
+#undef malloc
+#undef free
+
+static void
+fix_win32_tzenv(void)
+{
+    static char* oldenv = NULL;
+    char* newenv;
+    const char* perl_tz_env = win32_getenv("TZ");
+    const char* crt_tz_env = getenv("TZ");
+    if (perl_tz_env == NULL)
+        perl_tz_env = "";
+    if (crt_tz_env == NULL)
+        crt_tz_env = "";
+    if (strcmp(perl_tz_env, crt_tz_env) != 0) {
+        newenv = (char*)malloc((strlen(perl_tz_env) + 4) * sizeof(char));
+        if (newenv != NULL) {
+            sprintf(newenv, "TZ=%s", perl_tz_env);
+            putenv(newenv);
+            if (oldenv != NULL)
+                free(oldenv);
+            oldenv = newenv;
+        }
+    }
+}
+
+#endif
+
+/*
+ * my_tzset - wrapper to tzset() with a fix to make it work (better) on Win32.
+ * This code is duplicated in the POSIX module, so any changes made here
+ * should be made there too.
+ */
+static void
+my_tzset(pTHX)
+{
+#ifdef WIN32
+#if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
+    if (PL_curinterp == aTHX)
+#endif
+        fix_win32_tzenv();
+#endif
+    tzset();
+}
 
 /*
  * my_mini_mktime - normalise struct tm values without the localtime()
@@ -183,12 +303,23 @@
     ptm->tm_wday = (jday + WEEKDAY_BIAS) % 7;
 }
 
-/* No strptime on Win32 or QNX4 */
-#if defined(WIN32) || (defined(__QNX__) && defined(__WATCOMC__))
+#ifndef HAS_STRPTIME
+    /* Assume everyone has strptime except Win32 and QNX4 */
+#   define HAS_STRPTIME 1
+#   if defined(WIN32) || (defined(__QNX__) && defined(__WATCOMC__))
+#       undef HAS_STRPTIME
+#   endif
+#endif
+
+#ifndef HAS_STRPTIME
 #define strncasecmp(x,y,n) strnicmp(x,y,n)
 
 #if defined(WIN32)
+#if defined(__BORLANDC__)
+void * __cdecl _EXPFUNC alloca(_SIZE_T __size);
+#else
 #define alloca _alloca
+#endif
 #endif
 
 /* strptime copied from freebsd with the following copyright: */
@@ -240,7 +371,7 @@
 #include "pthread_private.h"
 #endif /* _THREAD_SAFE */
 
-static char * _strptime(const char *, const char *, struct tm *);
+static char * _strptime(pTHX_ const char *, const char *, struct tm *);
 
 #ifdef _THREAD_SAFE
 static struct pthread_mutex	_gotgmt_mutexd = PTHREAD_MUTEX_STATIC_INITIALIZER;
@@ -330,7 +461,7 @@
 #define Locale (&_C_time_locale)
 
 static char *
-_strptime(const char *buf, const char *fmt, struct tm *tm)
+_strptime(pTHX_ const char *buf, const char *fmt, struct tm *tm)
 {
 	char c;
 	const char *ptr;
@@ -366,7 +497,7 @@
 			break;
 
 		case '+':
-			buf = _strptime(buf, Locale->date_fmt, tm);
+			buf = _strptime(aTHX_ buf, Locale->date_fmt, tm);
 			if (buf == 0)
 				return 0;
 			break;
@@ -390,13 +521,13 @@
 
 		case 'c':
 			/* NOTE: c_fmt is intentionally ignored */
-                        buf = _strptime(buf, "%a %Ef %T %Y", tm);
+                        buf = _strptime(aTHX_ buf, "%a %Ef %T %Y", tm);
 			if (buf == 0)
 				return 0;
 			break;
 
 		case 'D':
-			buf = _strptime(buf, "%m/%d/%y", tm);
+			buf = _strptime(aTHX_ buf, "%m/%d/%y", tm);
 			if (buf == 0)
 				return 0;
 			break;
@@ -417,37 +548,37 @@
 		case 'f':
 			if (!Ealternative)
 				break;
-			buf = _strptime(buf, (c == 'f') ? Locale->Ef_fmt : Locale->EF_fmt, tm);
+			buf = _strptime(aTHX_ buf, (c == 'f') ? Locale->Ef_fmt : Locale->EF_fmt, tm);
 			if (buf == 0)
 				return 0;
 			break;
 
 		case 'R':
-			buf = _strptime(buf, "%H:%M", tm);
+			buf = _strptime(aTHX_ buf, "%H:%M", tm);
 			if (buf == 0)
 				return 0;
 			break;
 
 		case 'r':
-			buf = _strptime(buf, "%I:%M:%S %p", tm);
+			buf = _strptime(aTHX_ buf, "%I:%M:%S %p", tm);
 			if (buf == 0)
 				return 0;
 			break;
 
 		case 'T':
-			buf = _strptime(buf, "%H:%M:%S", tm);
+			buf = _strptime(aTHX_ buf, "%H:%M:%S", tm);
 			if (buf == 0)
 				return 0;
 			break;
 
 		case 'X':
-			buf = _strptime(buf, Locale->X_fmt, tm);
+			buf = _strptime(aTHX_ buf, Locale->X_fmt, tm);
 			if (buf == 0)
 				return 0;
 			break;
 
 		case 'x':
-			buf = _strptime(buf, Locale->x_fmt, tm);
+			buf = _strptime(aTHX_ buf, Locale->x_fmt, tm);
 			if (buf == 0)
 				return 0;
 			break;
@@ -746,7 +877,7 @@
 				zonestr = (char *)alloca(cp - buf + 1);
 				strncpy(zonestr, buf, cp - buf);
 				zonestr[cp - buf] = '\0';
-				tzset();
+				my_tzset(aTHX);
 				if (0 == strcmp(zonestr, "GMT")) {
 				    got_GMT = 1;
 				} else {
@@ -763,7 +894,7 @@
 
 
 char *
-strptime(const char *buf, const char *fmt, struct tm *tm)
+strptime(pTHX_ const char *buf, const char *fmt, struct tm *tm)
 {
 	char *ret;
 
@@ -772,7 +903,7 @@
 #endif
 
         got_GMT = 0;
-	ret = _strptime(buf, fmt, tm);
+	ret = _strptime(aTHX_ buf, fmt, tm);
 
 #ifdef _THREAD_SAFE
 	pthread_mutex_unlock(&gotgmt_mutex);
@@ -781,7 +912,7 @@
 	return ret;
 }
 
-#endif /* Mac OS X */
+#endif /* !HAS_STRPTIME */
 
 MODULE = Time::Piece     PACKAGE = Time::Piece
 
@@ -866,7 +997,7 @@
 void
 _tzset()
   PPCODE:
-    tzset();
+    my_tzset(aTHX);
 
 
 void
@@ -880,13 +1011,14 @@
   PPCODE:
        t = 0;
        mytm = *gmtime(&t);
-       
+#ifdef HAS_STRPTIME
        remainder = (char *)strptime(string, format, &mytm);
-       
+#else
+       remainder = (char *)strptime(aTHX_ string, format, &mytm);
+#endif
        if (remainder == NULL) {
 	  croak("Error parsing time");
        }
-
        if (*remainder != '\0') {
            warn("garbage at end of string in strptime: %s", remainder);
        }
@@ -910,3 +1042,37 @@
        PUSHs(sv_2mortal(newSViv(0)));
        /* islocal */
        PUSHs(sv_2mortal(newSViv(0)));
+
+void
+_mini_mktime(int sec, int min, int hour, int mday, int mon, int year)
+  PREINIT:
+       struct tm mytm;
+       time_t t;
+  PPCODE:
+       t = 0;
+       mytm = *gmtime(&t);
+
+       mytm.tm_sec = sec;
+       mytm.tm_min = min;
+       mytm.tm_hour = hour;
+       mytm.tm_mday = mday;
+       mytm.tm_mon = mon;
+       mytm.tm_year = year;
+       
+       my_mini_mktime(&mytm);
+
+       EXTEND(SP, 11);
+       PUSHs(sv_2mortal(newSViv(mytm.tm_sec)));
+       PUSHs(sv_2mortal(newSViv(mytm.tm_min)));
+       PUSHs(sv_2mortal(newSViv(mytm.tm_hour)));
+       PUSHs(sv_2mortal(newSViv(mytm.tm_mday)));
+       PUSHs(sv_2mortal(newSViv(mytm.tm_mon)));
+       PUSHs(sv_2mortal(newSViv(mytm.tm_year)));
+       PUSHs(sv_2mortal(newSViv(mytm.tm_wday)));
+       PUSHs(sv_2mortal(newSViv(mytm.tm_yday)));
+       /* isdst */
+       PUSHs(sv_2mortal(newSViv(0)));
+       /* epoch */
+       PUSHs(sv_2mortal(newSViv(0)));
+       /* islocal */
+       PUSHs(sv_2mortal(newSViv(0)));

Modified: branches/upstream/libtime-piece-perl/current/t/02core.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtime-piece-perl/current/t/02core.t?rev=35478&op=diff
==============================================================================
--- branches/upstream/libtime-piece-perl/current/t/02core.t (original)
+++ branches/upstream/libtime-piece-perl/current/t/02core.t Sat May 16 03:35:53 2009
@@ -1,4 +1,4 @@
-use Test::More tests => 93;
+use Test::More tests => 95;
 
 my $is_win32 = ($^O =~ /Win32/);
 my $is_qnx = ($^O eq 'qnx');
@@ -47,6 +47,14 @@
 cmp_ok($t->daylight_savings, '==', 0);
 
 # ->tzoffset?
+{
+    local $ENV{TZ} = "EST5";
+    Time::Piece::_tzset();  # register the environment change
+    my $lt = localtime;
+    cmp_ok(scalar($lt->tzoffset), 'eq', '-18000');
+    cmp_ok($lt->strftime("%Z"), 'eq', 'EST');
+}
+
 cmp_ok(($t->julian_day / 2451604.0243 ) - 1, '<', 0.001);
 cmp_ok(($t->mjd        /   51603.52426) - 1, '<', 0.001);
 cmp_ok($t->week, '==', 9);




More information about the Pkg-perl-cvs-commits mailing list