UNSAFE MODULE FileStamp_ux EXPORTS FileStamp, FileStamp_ux;

(***************************************************************************)
(*                      Copyright (C) Olivetti 1989                        *)
(*                          All Rights reserved                            *)
(*                                                                         *)
(* Use and copy of this software and preparation of derivative works based *)
(* upon this software are permitted to any person, provided this same      *)
(* copyright notice and the following Olivetti warranty disclaimer are     *) 
(* included in any copy of the software or any modification thereof or     *)
(* derivative work therefrom made by any person.                           *)
(*                                                                         *)
(* This software is made available AS IS and Olivetti disclaims all        *)
(* warranties with respect to this software, whether expressed or implied  *)
(* under any law, including all implied warranties of merchantibility and  *)
(* fitness for any purpose. In no event shall Olivetti be liable for any   *)
(* damages whatsoever resulting from loss of use, data or profits or       *)
(* otherwise arising out of or in connection with the use or performance   *)
(* of this software.                                                       *)
(***************************************************************************)

IMPORT Text;
IMPORT Ustat, Unix, Utime, Utypes, UnixMutex, Ctypes, M3toC;
IMPORT OSError_ux, TimeDate_ux, PathName_ux;
IMPORT OSError, TimeDate;


PROCEDURE ToStamp(clock: Utypes.time_t): T RAISES {}=
  BEGIN
    IF clock = 0 THEN
      RETURN Bad;
    ELSE
      WITH t = NEW(T) DO
        t.tv_sec := clock;
        t.tv_usec := 0;
        RETURN t;
      END;
    END;
  END ToStamp;


PROCEDURE FromStamp(t: T; VAR tv: Utime.struct_timeval) RAISES {}=
  BEGIN
    tv.tv_usec := 0;
    IF t = Bad THEN
      tv.tv_sec := 0;
    ELSE
      tv.tv_sec := t.tv_sec;
      IF t.tv_usec > TimeDate.Mega DIV 2 THEN INC(tv.tv_sec) END;
    END; (* if *)
  END FromStamp;


<*INLINE*> PROCEDURE UnixName(name: Text.T): Ctypes.char_star RAISES {}=
  VAR
    realName: Text.T;
  BEGIN
    IF Text.Length(name) = 0 THEN
      realName := PathName_ux.CurrentDirText;
    ELSE
      realName := name;
    END;
    RETURN M3toC.TtoS(realName);
  END UnixName;


PROCEDURE Get(name: Text.T): T RAISES {OSError.E}=
  VAR
    statBuf: Ustat.struct_stat;
  BEGIN
    LOCK UnixMutex.errno DO
      IF Ustat.stat(UnixName(name), ADR(statBuf)) < 0 THEN
        OSError_ux.Raise();
      END;
    END;
    RETURN ToStamp(statBuf.st_mtime);
  END Get;


PROCEDURE Set(name: Text.T; t: T) RAISES {OSError.E}=
  CONST Accessed = 0; Updated = 1;
  VAR
    u: ARRAY [0..1] OF Utime.struct_timeval;
  BEGIN
    FromStamp(t, u[Updated]);
    TimeDate_ux.GetTimeOfDay(u[Accessed]);
    LOCK UnixMutex.errno DO
      IF Unix.utimes(UnixName(name), ADR(u)) < 0 THEN
        OSError_ux.Raise();
      END; (* if *)
    END; (* lock *)
  END Set;


PROCEDURE Copy(t: T): T RAISES {}=
  BEGIN
    IF t = Bad THEN RETURN Bad END;
    WITH copy = NEW(T) DO
      copy^ := t^;
      RETURN copy;
    END;
  END Copy;


PROCEDURE InternalAdd(
    VAR tv: Utime.struct_timeval;
    secs, uSecs: INTEGER)
    RAISES {OutOfRange} =
  VAR
    seconds := ARRAY [0..1] OF INTEGER {secs, 0};
  BEGIN
    (* first deal with the micro seconds *)
    VAR
      absUSecs := ABS(uSecs);
    BEGIN
      WITH moreSecs = seconds[1] DO
        IF absUSecs >= TimeDate.Mega THEN
          moreSecs := absUSecs DIV TimeDate.Mega;
          absUSecs := absUSecs MOD TimeDate.Mega;
        END;
        IF uSecs < 0 THEN
          DEC(tv.tv_usec, absUSecs);
          IF tv.tv_usec < 0 THEN
            INC(tv.tv_usec, TimeDate.Mega);
            INC(moreSecs);
          END;
          moreSecs := -moreSecs;
        ELSE
          INC(tv.tv_usec, absUSecs);
          IF tv.tv_usec >= TimeDate.Mega THEN
            DEC(tv.tv_usec, TimeDate.Mega);
            INC(moreSecs);
          END;
        END;
      END;
    END;
    (* now the seconds *)
    FOR i := FIRST(seconds) TO LAST(seconds) DO
      WITH add = seconds[i] DO
        IF add < 0 THEN
          WITH newSec = tv.tv_sec + add DO
            IF newSec < 0 THEN RAISE OutOfRange ELSE tv.tv_sec := newSec END;
          END;
        ELSIF add > 0 THEN
          IF LAST(INTEGER) - add < tv.tv_sec THEN
            RAISE OutOfRange;
          ELSE
            INC(tv.tv_sec, add)
          END;
        END;
      END;
    END;
  END InternalAdd;


PROCEDURE Add(t: T; secs: INTEGER; uSecs: INTEGER := 0) RAISES {OutOfRange}=
  BEGIN
    InternalAdd(t^, secs, uSecs);
  END Add;


PROCEDURE Compare(
    t1, t2: T;
    uSecs: CARDINAL := 0)
    : INTEGER
    RAISES {OutOfRange}=
  BEGIN
    IF uSecs = 0 THEN
      IF t1.tv_sec # t2.tv_sec THEN
        RETURN t1.tv_sec - t2.tv_sec;
      ELSE
        RETURN t1.tv_usec - t2.tv_usec;
      END;
    ELSE
      VAR
        tv1 := t1^;
        tv2 := t2^;
        temp := tv1;
      BEGIN
        InternalAdd(temp, 0, uSecs);
        IF temp.tv_sec < tv2.tv_sec OR
            temp.tv_sec = tv2.tv_sec AND temp.tv_usec < tv2.tv_usec THEN
          RETURN -1;
        ELSE
          InternalAdd(tv2, 0, uSecs);
          IF tv1.tv_sec > tv2.tv_sec OR
              tv1.tv_sec = tv2.tv_sec AND tv1.tv_usec > tv2.tv_usec THEN
            RETURN 1;
          ELSE
            RETURN 0;
          END;
        END;
      END;
    END;
  END Compare;


PROCEDURE IsFuture(
    t: T;
    uSecs: CARDINAL := 0)
    : BOOLEAN
    RAISES {OutOfRange, OSError.E}=
  VAR
    now := TimeDate.Current();
  BEGIN
    IF uSecs # 0 THEN Add(now, 0, uSecs) END;
    RETURN Compare(t, now) > 0;
  END IsFuture;


BEGIN
END FileStamp_ux.