fpc/rtl/unix/unixutil.pp

{
    This file is part of the Free Pascal run time library.
    Copyright (c) 1999-2013 by the Free Pascal development team

    DO NOT ADD ROUTINES TO THIS FILE!
    THE ROUTINES IN THIS FILE ARE INTERNAL AND NOT FOR END USER USAGE!

    Background: This unit contains leftovers from the unix restructure that
    shouldn't be in the interface of unit baseunix/unix, but are needed
    in these units. (at the time routines were still being moved
    from baseunix to unix, and unit baseunix couldn't depend on unix) 
    
    The routines are fairly OS independent but can't move to
    OS independent because the lowlevel units baseunix/unix depend
    on them. If they need to be generally accessable, copy these
    functions to a general purpose, OS independent, supportable unit.

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}
unit unixutil;

interface

uses BaseUnix;

type
  TTZInfo = record
    daylight     : boolean;
    name         : array[boolean] of pchar;
    seconds      : Longint; // difference from UTC
    validsince   : int64;   // UTC timestamp
    validuntil   : int64;   // UTC timestamp
    leap_correct : longint;
    leap_hit     : longint;
  end;

var
  Tzinfo : TTZInfo;
  ReloadTzinfo : TProcedure;

Function GetTzseconds : Longint;
property Tzseconds : Longint read GetTzseconds;

Function StringToPPChar(S: PChar;ReserveEntries:integer):ppchar;
Function StringToPPChar(Var S:RawByteString;ReserveEntries:integer):ppchar;
function ArrayStringToPPchar(const S:Array of RawByteString;reserveentries:Longint):ppchar; // const ?
Function LocalToEpoch(year,month,day,hour,minute,second:Word):int64; deprecated 'use DateUtils.DateTimeToUnix';
Procedure EpochToLocal(epoch:int64;var year,month,day,hour,minute,second:Word); deprecated 'use DateUtils.UnixToDateTime';
Procedure EpochToUniversal(epoch:int64;var year,month,day,hour,minute,second:Word); deprecated 'use DateUtils.UnixToDateTime';
Procedure JulianToGregorian(JulianDN:LongInt;Var Year,Month,Day:Word); deprecated 'use DateUtils.DateTimetoJulianDate';
Function GregorianToJulian(Year,Month,Day:Longint):LongInt; deprecated 'use DateUtils.JulianDateToDateTime';

implementation

Function GetTzseconds : Longint;
var
  curtime: time_t;
begin
  curtime:=fptime;
  if assigned(ReloadTzinfo) and ((curtime<Tzinfo.validsince+Tzinfo.seconds) or (curtime>Tzinfo.validuntil+Tzinfo.seconds)) then
    ReloadTzinfo;
  GetTzseconds:=Tzinfo.seconds;
end;

function ArrayStringToPPchar(const S:Array of RawByteString;reserveentries:Longint):ppchar; // const ?
// Extra allocate reserveentries pchar's at the beginning (default param=0 after 1.0.x ?)
// Note: for internal use by skilled programmers only
// if "s" goes out of scope in the parent procedure, the pointer is dangling.

var p   : ppchar;
    i   : LongInt;
begin
  if High(s)<Low(s) Then Exit(NIL);
  Getmem(p,sizeof(pchar)*(high(s)-low(s)+ReserveEntries+2));  // one more for NIL, one more
                                              // for cmd
  if p=nil then
    begin
      {$ifdef xunix}
      fpseterrno(ESysEnomem);
      {$endif}
      exit(NIL);
    end;
  for i:=low(s) to high(s) do
     p[i+Reserveentries]:=pchar(s[i]);
  p[high(s)+1+Reserveentries]:=nil;
  ArrayStringToPPchar:=p;
end;

Function StringToPPChar(Var S:RawByteString;ReserveEntries:integer):ppchar;
{
  Create a PPChar to structure of pchars which are the arguments specified
  in the string S. Especially useful for creating an ArgV for Exec-calls
}

begin
  StringToPPChar:=StringToPPChar(PChar(S),ReserveEntries);
end;

Function StringToPPChar(S: PChar;ReserveEntries:integer):ppchar;

var
  i,nr  : longint;
  Buf : ^char;
  p   : ppchar;

begin
  buf:=s;
  nr:=1;
  while (buf^<>#0) do                   // count nr of args
   begin
     while (buf^ in [' ',#9,#10]) do    // Kill separators.
      inc(buf);
     inc(nr);
     if buf^='"' Then                   // quotes argument?
      begin
        inc(buf);
        while not (buf^ in [#0,'"']) do // then end of argument is end of string or next quote
         inc(buf);
        if buf^='"' then                // skip closing quote.
          inc(buf);
      end
     else
       begin                            // else std
         while not (buf^ in [' ',#0,#9,#10]) do
           inc(buf);
       end;
   end;
  getmem(p,(ReserveEntries+nr)*sizeof(pchar));
  StringToPPChar:=p;
  if p=nil then
   begin
     {$ifdef xunix}
     fpseterrno(ESysEnomem);
     {$endif}
     exit;
   end;
  for i:=1 to ReserveEntries do inc(p); // skip empty slots
  buf:=s;
  while (buf^<>#0) do
   begin
     while (buf^ in [' ',#9,#10]) do    // Kill separators.
      begin
       buf^:=#0;
       inc(buf);
      end;
     if buf^='"' Then                   // quotes argument?
      begin
        inc(buf);
        p^:=buf;
        inc(p);
        p^:=nil;
        while not (buf^ in [#0,'"']) do // then end of argument is end of string or next quote
         inc(buf);
        if buf^='"' then                // skip closing quote.
          begin
            buf^:=#0;
            inc(buf);
          end;
      end
     else
       begin
        p^:=buf;
        inc(p);
        p^:=nil;
         while not (buf^ in [' ',#0,#9,#10]) do
           inc(buf);
       end;
   end;
end;

Const
{Date Translation}
  C1970=2440588;
  D0   =   1461;
  D1   = 146097;
  D2   =1721119;


Procedure JulianToGregorian(JulianDN:LongInt;Var Year,Month,Day:Word);
Var
  YYear,XYear,Temp,TempMonth : LongInt;
Begin
  Temp:=((JulianDN-D2) shl 2)-1;
  JulianDN:=Temp Div D1;
  XYear:=(Temp Mod D1) or 3;
  YYear:=(XYear Div D0);
  Temp:=((((XYear mod D0)+4) shr 2)*5)-3;
  Day:=((Temp Mod 153)+5) Div 5;
  TempMonth:=Temp Div 153;
  If TempMonth>=10 Then
   Begin
     inc(YYear);
     dec(TempMonth,12);
   End;
  inc(TempMonth,3);
  Month := TempMonth;
  Year:=YYear+(JulianDN*100);
end;

Procedure EpochToLocal(epoch:Int64;var year,month,day,hour,minute,second:Word);
{
  Transforms Epoch time into local time (hour, minute,seconds)
}
Var
  DateNum: LongInt;
Begin
  inc(Epoch,TZSeconds);
  EpochToUniversal(epoch,year,month,day,hour,minute,second);
End;

Procedure EpochToUniversal(epoch:Int64;var year,month,day,hour,minute,second:Word);
{
  Transforms Epoch time into universal time (hour, minute,seconds)
}
Var
  DateNum: LongInt;
Begin
  Datenum:=(Epoch Div 86400) + c1970;
  JulianToGregorian(DateNum,Year,Month,day);
  Epoch:=Abs(Epoch Mod 86400);
  Hour:=Epoch Div 3600;
  Epoch:=Epoch Mod 3600;
  Minute:=Epoch Div 60;
  Second:=Epoch Mod 60;
End;

Function LocalToEpoch(year,month,day,hour,minute,second:Word):Int64;
{
  Transforms local time (year,month,day,hour,minutes,second) to Epoch time
   (seconds since 00:00, january 1 1970, corrected for local time zone)
}
Begin
  LocalToEpoch:=(Int64(GregorianToJulian(Year,Month,Day)-c1970)*86400)+
                (LongInt(Hour)*3600)+(Longint(Minute)*60)+Second-TZSeconds;
End;

Function GregorianToJulian(Year,Month,Day:Longint):LongInt;
Var
  Century,XYear: LongInt;
Begin
  If Month<=2 Then
   Begin
     Dec(Year);
     Inc(Month,12);
   End;
  Dec(Month,3);
  Century:=(longint(Year Div 100)*D1) shr 2;
  XYear:=(longint(Year Mod 100)*D0) shr 2;
  GregorianToJulian:=((((Month*153)+2) div 5)+Day)+D2+XYear+Century;
End;

end.