freepascal.compiler/rtl/linux/timezone.inc

{
  $Id$

  Support for timezone info in /usr/share/timezone
}

type
  plongint=^longint;
  pbyte=^byte;

  ttzhead=packed record
    tzh_reserved : array[0..19] of byte;
    tzh_ttisgmtcnt,
    tzh_ttisstdcnt,
    tzh_leapcnt,
    tzh_timecnt,
    tzh_typecnt,
    tzh_charcnt  : longint;
  end;

  pttinfo=^tttinfo;
  tttinfo=packed record
    offset : longint;
    isdst  : boolean;
    idx    : byte;
    isstd  : byte;
    isgmt  : byte;
  end;

  pleap=^tleap;
  tleap=record
    transition : longint;
    change     : longint;
  end;

var
  num_transitions,
  num_leaps,
  num_types    : longint;

  transitions  : plongint;
  type_idxs    : pbyte;
  types        : pttinfo;
  zone_names   : pchar;
  leaps        : pleap;

function find_transition(timer:longint):pttinfo;
var
  i : longint;
begin
  if (num_transitions=0) or (timer<transitions[0]) then
   begin
     i:=0;
     while (i<num_types) and (types[i].isdst) do
      inc(i);
     if (i=num_types) then
      i:=0;
   end
  else
   begin
     for i:=1 to num_transitions do
      if (timer<transitions[i]) then
       break;
     i:=type_idxs[i-1];
   end;
  find_transition:=@types[i];
end;


procedure GetLocalTimezone(timer:longint;var leap_correct,leap_hit:longint);
var
  info : pttinfo;
  i    : longint;
begin
  info:=find_transition(timer);
  TZDaylight:=info^.isdst;
  TZSeconds:=info^.offset;
  i:=0;
  while (i<num_types) and (i<2) do
   begin
     tzname[types[i].isdst]:=@zone_names[types[i].idx];
     inc(i);
   end;
  tzname[info^.isdst]:=@zone_names[info^.idx];
  leap_correct:=0;
  leap_hit:=0;
  i:=num_leaps;
  while (i>0) do
   begin
     if (timer>leaps[i].transition) then
      break;
     dec(i);
   end;
  leap_correct:=leaps[i].change;
  if (timer=leaps[i].transition) and
     (((i=0) and (leaps[i].change>0)) or
      (leaps[i].change>leaps[i-1].change)) then
   begin
     leap_hit:=1;
     while (i>0) and
           (leaps[i].transition=leaps[i-1].transition+1) and
           (leaps[i].change=leaps[i-1].change+1) do
      begin
        inc(leap_hit);
        dec(i);
      end;
   end;
end;


procedure GetLocalTimezone(timer:longint);
var
  lc,lh : longint;
begin
  GetLocalTimezone(timer,lc,lh);
end;


procedure ReadTimezoneFile(fn:string);

  procedure decode(var l:longint);
  var
    k : longint;
    p : pbyte;
  begin
    p:=pbyte(@l);
    if (p[0] and (1 shl 7))<>0 then
     k:=not 0
    else
     k:=0;
    k:=(k shl 8) or p[0];
    k:=(k shl 8) or p[1];
    k:=(k shl 8) or p[2];
    k:=(k shl 8) or p[3];
    l:=k;
  end;

var
  f      : longint;
  tzdir  : string;
  tzhead : ttzhead;
  i      : longint;
  chars  : longint;
  buf    : pbyte;
begin
  if fn='' then
   fn:='localtime';
  if fn[1]<>'/' then
   begin
     tzdir:=getenv('TZDIR');
     if tzdir='' then
      tzdir:='/usr/share/zoneinfo';
     if tzdir[length(tzdir)]<>'/' then
      tzdir:=tzdir+'/';
     fn:=tzdir+fn;
   end;
  f:=fdopen(fn,Open_RdOnly);
  if f<0 then
   exit;
  i:=fdread(f,tzhead,sizeof(tzhead));
  if i<>sizeof(tzhead) then
   exit;
  decode(tzhead.tzh_timecnt);
  decode(tzhead.tzh_typecnt);
  decode(tzhead.tzh_charcnt);
  decode(tzhead.tzh_leapcnt);
  decode(tzhead.tzh_ttisstdcnt);
  decode(tzhead.tzh_ttisgmtcnt);

  num_transitions:=tzhead.tzh_timecnt;
  num_types:=tzhead.tzh_typecnt;
  chars:=tzhead.tzh_charcnt;

  reallocmem(transitions,num_transitions*sizeof(longint));
  reallocmem(type_idxs,num_transitions);
  reallocmem(types,num_types*sizeof(tttinfo));
  reallocmem(zone_names,chars);
  reallocmem(leaps,num_leaps*sizeof(tleap));

  fdread(f,transitions^,num_transitions*4);
  fdread(f,type_idxs^,num_transitions);

  for i:=0 to num_transitions-1 do
   decode(transitions[i]);

  for i:=0 to num_types-1 do
   begin
     fdread(f,types[i].offset,4);
     fdread(f,types[i].isdst,1);
     fdread(f,types[i].idx,1);
     decode(types[i].offset);
     types[i].isstd:=0;
     types[i].isgmt:=0;
   end;

  fdread(f,zone_names^,chars);

  for i:=0 to num_leaps-1 do
   begin
     fdread(f,leaps[i].transition,4);
     fdread(f,leaps[i].change,4);
     decode(leaps[i].transition);
     decode(leaps[i].change);
   end;

  getmem(buf,tzhead.tzh_ttisstdcnt);
  fdread(f,buf^,tzhead.tzh_ttisstdcnt);
  for i:=0 to tzhead.tzh_ttisstdcnt-1 do
   types[i].isstd:=byte(buf[i]<>0);
  freemem(buf);

  getmem(buf,tzhead.tzh_ttisgmtcnt);
  fdread(f,buf^,tzhead.tzh_ttisgmtcnt);
  for i:=0 to tzhead.tzh_ttisgmtcnt-1 do
   types[i].isgmt:=byte(buf[i]<>0);
  freemem(buf);
  fdclose(f);
end;


function GetTimezoneFile:string;
var
  f,len : longint;
  s : string;
begin
  GetTimezoneFile:='';
  f:=fdopen('/etc/timezone',Open_RdOnly);
  if f=0 then
   exit;
  len:=fdread(f,s[1],high(s));
  s[0]:=chr(len);
  len:=pos(#10,s);
  if len<>0 then
   s[0]:=chr(len-1);
  fdclose(f);
  GetTimezoneFile:=s;
end;


procedure InitLocalTime;
begin
  ReadTimezoneFile(GetTimezoneFile);
  GetLocalTimezone(GetTimeOfDay);
end;


procedure DoneLocalTime;
begin
  freemem(transitions);
  freemem(type_idxs);
  freemem(types);
  freemem(zone_names);
  freemem(leaps);
end;

{
  $Log$
  Revision 1.1  1999-12-01 22:46:59  peter
    + timezone support

}