own implementation of parsing the timezone file because freepascals implementation...

git-svn-id: file:///svnroot/lcore/trunk@164 b1de8a11-f9be-4011-bde0-cc7ace90066a

diff --git a/btime.pas b/btime.pas
index 8826a4da4afd1b315060d246d172d58a91dcc13e..ae6ffa56a72c149b5944c9feeeca3821798a22a7 100644 (file)
--- a/btime.pas
+++ b/btime.pas
@@ -64,6 +64,12 @@ function timestrisoutc(i:float):string;          // 2012-08-15T14:21:09.255553Z
 procedure beginhightimerrate;\r
 procedure endhightimerrate;\r
 \r
+procedure tzinvalidate;\r
+\r
+{$ifdef unix}\r
+function tzgetoffsetforts(ts:tunixtimeint):integer;\r
+{$endif}\r
+\r
 {$ifdef mswindows}\r
 function unixtimefloat_systemtime:float;\r
 {$endif}\r
@@ -262,10 +268,15 @@ end;
 \r
 {------------------------------ end of *nix/freepascal section}\r
 \r
-{$else} {delphi 3}\r
+{$else} {windows}\r
 {------------------------------ windows/delphi code to read time}\r
 \r
 \r
+procedure tzinvalidate;\r
+begin\r
+  gettimezone;\r
+end;\r
+\r
 {simulate gettimeofday on windows so one can always use gettimeofday if preferred}\r
 \r
 procedure gettimeofday(var tv:ttimeval);\r
@@ -665,6 +676,226 @@ begin
 end;\r
 \r
 \r
+{$ifdef unix}\r
+\r
+var\r
+  tzerror:boolean;\r
+  tzfile:ansistring;\r
+\r
+function tzgetfilename:ansistring;\r
+var\r
+  t:textfile;\r
+\r
+  s,tz,tzdir:ansistring;\r
+begin\r
+  result := '';\r
+  filemode := 0;\r
+  {$ifdef unix}\r
+  tz := getenv('TZ');\r
+\r
+  if (copy(tz,1,1) = ':') then begin\r
+    tz := copy(tz,2,99999);\r
+\r
+    if (copy(tz,1,1) <> '/') then begin\r
+      tzdir := getenv('TZDIR');\r
+      if (tzdir = '') then begin\r
+        tzdir := '/usr/share/zoneinfo/';\r
+      end else begin\r
+        if (copy(tzdir,length(tzdir),1) <> '/') then tzdir := tzdir + '/';\r
+      end;\r
+      tz := tzdir + tz;\r
+    end;\r
+\r
+    assignfile(t,tz);\r
+    {$i-}reset(t);{$i+}\r
+    if (ioresult = 0) then begin\r
+      closefile(t);\r
+      result := tz;\r
+      exit;\r
+    end;\r
+\r
+  end;\r
+  {$endif}\r
+  \r
+  assignfile(t,'/etc/localtime');\r
+  {$i-}reset(t);{$i+}\r
+  if (ioresult = 0) then begin\r
+    closefile(t);\r
+    result := '/etc/localtime';\r
+    exit;\r
+  end;\r
+\r
+  assignfile(t,'/etc/timezone');\r
+\r
+  s := '';\r
+  {$i-}reset(t);{$i+}\r
+  if (ioresult = 0) then begin\r
+    readln(t,s);\r
+    closefile(t);\r
+    if (s <> '') then begin\r
+      result := '/usr/share/zoneinfo/'+s;\r
+      exit;\r
+    end;\r
+  end;\r
+end;\r
+\r
+type\r
+  dvar=array[0..65535] of byte;\r
+  pdvar=^dvar;\r
+\r
+var\r
+  tzcache:pdvar;\r
+  tzsize:integer;\r
+\r
+procedure tzinvalidate;\r
+begin\r
+  if assigned(tzcache) then freemem(tzcache);\r
+  tzcache := nil;\r
+  tzsize := 0;\r
+  tzfile := '';\r
+  gettimezone;\r
+end;\r
+\r
+\r
+function tzgetoffsetforts(ts:tunixtimeint):integer;\r
+var\r
+  f:file;\r
+  buf:pdvar;\r
+  fs:integer;\r
+  ofs,ofs2:integer;\r
+  mode64:boolean;\r
+  has64:boolean;\r
+  a,index:integer;\r
+  //tzstrofs:integer;\r
+  t:int64;\r
+  tzh_ttisgmtcnt:integer;\r
+  tzh_ttisstdcnt:integer;\r
+  tzh_leapcnt:integer;\r
+  tzh_timecnt:integer;\r
+  tzh_typecnt:integer;\r
+  tzh_charcnt:integer;\r
+\r
+\r
+function getint:integer;\r
+begin\r
+  if (ofs < 0) or ((ofs + 4) > fs) then raise exception.create('getint');\r
+  result := (buf[ofs] shl 24) + (buf[ofs+1] shl 16) + (buf[ofs+2] shl 8) + buf[ofs+3];\r
+  inc(ofs,4);\r
+end;\r
+\r
+function getint64:int64;\r
+begin\r
+  if (ofs < 0) or ((ofs + 8) > fs) then raise exception.create('getint64');\r
+  result := int64(getint) shl 32;\r
+  inc(result,cardinal(getint));\r
+end;\r
+\r
+\r
+function getbyte:byte;\r
+begin\r
+  if (ofs < 0) or ((ofs + 1) > fs) then raise exception.create('getbyte');\r
+  result := buf[ofs];\r
+  inc(ofs);\r
+end;\r
+\r
+begin\r
+  result := 0;\r
+  tzerror := true;\r
+\r
+  if not assigned(tzcache) then begin\r
+\r
+    if (tzfile = '') then tzfile := tzgetfilename;\r
+\r
+    if (tzfile = '') then exit;\r
+\r
+    assignfile(f,tzfile);\r
+    filemode := 0;\r
+    {$i-}reset(f,1);{$i+}\r
+    if (ioresult <> 0) then begin\r
+      exit;\r
+    end;\r
+    tzsize := filesize(f);\r
+    if (tzsize > 65536) then tzsize := 65536;\r
+    getmem(tzcache,tzsize);\r
+    blockread(f,tzcache^,tzsize);\r
+    closefile(f);\r
+  end;\r
+  fs := tzsize;\r
+  buf := tzcache;\r
+  ofs := 0;\r
+  mode64 := false;\r
+\r
+ try\r
+   repeat\r
+     if (getint <> $545a6966) then exit; // 'TZif'\r
+     has64 := getbyte >= $32; //  '2'\r
+\r
+     inc(ofs,15);\r
+\r
+     tzh_ttisgmtcnt := getint;\r
+     tzh_ttisstdcnt := getint;\r
+     tzh_leapcnt := getint;\r
+     tzh_timecnt := getint;\r
+     tzh_typecnt := getint;\r
+     tzh_charcnt := getint;\r
+\r
+     if mode64 or (not has64) then break;\r
+     inc(ofs, 5 * tzh_timecnt + 6 * tzh_typecnt + 8 * tzh_leapcnt + tzh_ttisstdcnt + tzh_ttisgmtcnt + tzh_charcnt);\r
+     mode64 := true;\r
+   until false;\r
+   index := 0;\r
+\r
+   if (tzh_timecnt < 0) or (tzh_timecnt > fs) then raise exception.create('tzh_timecnt');\r
+   ofs2 := ofs;\r
+\r
+   for a := 0 to tzh_timecnt -1 do begin\r
+     if mode64 then t := getint64 else t := getint;\r
+     if (t > ts) then begin\r
+       index := a - 1;\r
+       break;\r
+     end;\r
+     if (a = tzh_timecnt -1) and (ts >= t) then index := a;\r
+   end;\r
+   ofs := ofs2 + tzh_timecnt * (1 + ord(mode64)) * 4;\r
+\r
+   if (cardinal(ofs + index) >= fs) or (index < 0) then raise exception.create('index');\r
+   index := buf[ofs+index];\r
+   inc(ofs,tzh_timecnt);\r
+\r
+   if (index >= tzh_typecnt) then raise exception.create('type');\r
+   ofs2 := ofs;\r
+  // writeln('ofs2 ',inttohex(ofs2,8));\r
+   inc(ofs,6 * index);\r
+   result := getint;\r
+\r
+   //tzisdst := getbyte;\r
+\r
+  //the abbreviation string\r
+  { tzstrofs := getbyte;\r
+   tzstr := '';\r
+   ofs := ofs2 + 6 * tzh_typecnt;\r
+   inc(ofs, tzstrofs);\r
+\r
+   repeat\r
+     a := getbyte;\r
+     if (a <> 0) then tzstr := tzstr + chr(a);\r
+   until (a = 0); }\r
+\r
+   tzerror := false;\r
+ except\r
+\r
+ end;\r
+end;\r
+\r
+function tzgetoffset:integer;\r
+begin\r
+  tzgetoffsetforts(unixtimeint);\r
+end;\r
+\r
+\r
+{$endif}\r
+\r
+\r
 procedure gettimezone;\r
 var\r
   {$ifdef UNIX}\r
@@ -681,7 +912,8 @@ var
 begin\r
   {$ifdef UNIX}\r
     {$ifdef above194}\r
-      timezone := tzseconds;\r
+      timezone := tzgetoffset;\r
+      //freepascal tzseconds is not 2038 safe\r
     {$else}\r
       gettime(hh,mm,ss);\r
       timezone := (longint(hh) * 3600 + mm * 60 + ss) - (unixtimeint mod 86400);\r
@@ -690,8 +922,8 @@ begin
   timezone := round((now-now_utc)*86400);\r
   {$endif}\r
 \r
-  while timezone > 43200 do dec(timezone,86400);\r
-  while timezone < -43200 do inc(timezone,86400);\r
+  while timezone > 50400 do dec(timezone,86400);\r
+  while timezone < -50400 do inc(timezone,86400);\r
 \r
   if timezone >= 0 then timezonestr := '+' else timezonestr := '-';\r
   l := abs(timezone) div 60;\r