(**********************************************************************

:Program.    Header.mod
:Contens.    Ein Modul für M2m, das globale Daten und Prozeduren für M2m
:Contens.    zur Verfügung stellt.
:Author.     Bernd Braun
:Address.    Lippestr. 11, D-3300 Braunschweig
:Phone.      0531/845498
:Copyright.  Public Domain
:Language.   Modula-2
:Translator. M2Amiga A+L V4.096d
:History.    V1.0 21.Jun.1991
:History.    V1.1 19.Jul.1991 SyncRun aus ARP eingebaut.
:History.    V1.2 26.Jul.1991 Programm läßt sich jetzt unterbrechen,
:History.                     allerdings nicht Compiler oder Linker.
:History.    V1.3 27.Jul.1991 Härtetest mit A+L Sourcen überstanden.

***********************************************************************)

IMPLEMENTATION MODULE Header;

   FROM Arts IMPORT
      Assert;
   FROM DosD IMPORT
      Date, FileInfoBlockPtr, FileLockPtr, accessRead;
   FROM DosL IMPORT
      Examine;
   FROM DosSupport IMPORT
      Lock, UnLock;
   FROM Heap IMPORT
      AllocMem, Deallocate;
   FROM String IMPORT
      Length, LastPos, CopyPart, Copy, FirstPos, noOccur, ConcatChar,
      Occurs, Delete;
   FROM SYSTEM IMPORT
      ADR;

   CONST
      nochip   = 'Kein CHIP-Speicher mehr!';
      exerr    = 'Fehler bei Examine!';

   (*
      Extrahiert aus Str den Pfad und den Programmnamen.
   *)
   PROCEDURE PathandProg ( VAR Path,
                               Prog : ARRAY OF CHAR;
                               Str  : ARRAY OF CHAR );
      VAR
         len,
         pos1,
         pos2 : INTEGER;
   BEGIN
      len  := Length  ( Str );
      pos1 := LastPos ( Str, len, ':' );
      pos2 := LastPos ( Str, len, '/' );
      IF pos1 > pos2 THEN
         CopyPart ( Path, Str, 0, pos1 + 1 );
         CopyPart ( Prog, Str, pos1 + 1, len - ( pos1 + 1 ) );
      ELSIF pos2 > pos1 THEN
         CopyPart ( Path, Str , 0, pos2 + 1 );
         CopyPart ( Prog, Str, pos2 + 1, len - ( pos2 + 1 ) );
      ELSE
         Copy ( Path, '' );
         Copy ( Prog, Str );
      END;
      pos1 := Occurs ( Path, 0, 'txt/', FALSE );
      IF pos1 # noOccur THEN
         Delete ( Path, pos1, 4 );
      END;
   END PathandProg;

   (*
      Extrahiert aus einem Programmnamen den Namen und die Extension.
   *)
   PROCEDURE NameandExt ( VAR Name,
                              Ext  : ARRAY OF CHAR;
                              Prog : ARRAY OF CHAR );
      VAR
         pos : INTEGER;
   BEGIN
      pos := FirstPos ( Prog, 0, '.' );
      IF pos = noOccur THEN
         Copy ( Name, Prog );
         Copy ( Ext, '' );
      ELSE
         CopyPart ( Name, Prog, 0, pos );
         CopyPart ( Ext, Prog, pos + 1, Length ( Prog ) - ( pos + 1 ) );
      END;
   END NameandExt;

   (*
      Macht aus einem String einen gültigen Pfad.
   *)
   PROCEDURE MakePath ( VAR Str : ARRAY OF CHAR );
      VAR
         len : INTEGER;
   BEGIN
      len := Length ( Str ) - 1;
      IF ( len >= 0 ) AND
         ( Str [ len ] # ':' ) AND
         ( Str [ len ] # '/' ) THEN
         ConcatChar ( Str, '/' );
      END;
   END MakePath;

   (*
      Vergleicht zwei Dati,
      gibt -1 zurück, wenn Date1 älter  Date2
      gibt  0 zurück, wenn Date1 gleich Date2
      gibt  1 zurück, wenn Date1 jünger Date2
   *)
   PROCEDURE CompareDate ( Date1, Date2 : Date ) : INTEGER;
   BEGIN
      IF Date1.days < Date2.days THEN
         RETURN -1;
      ELSIF Date1.days > Date2.days THEN
         RETURN 1;
      ELSE
         IF Date1.minute < Date2.minute THEN
            RETURN -1;
         ELSIF Date1.minute > Date2.minute THEN
            RETURN 1;
         ELSE
            IF Date1.tick < Date2.tick THEN
               RETURN -1;
            ELSE
               RETURN 1;
            END;
         END;
      END;
   END CompareDate;

   (*
      Legt in Result das größere ( jüngere ) Datum von Date1 und
      Date2 ab.
   *)
   PROCEDURE MaxDate ( VAR Result : Date;
                           Date1,
                           Date2  : Date );
   BEGIN
      IF CompareDate ( Date1, Date2 ) > 0 THEN
         Result := Date1;
      ELSE
         Result := Date2;
      END;
   END MaxDate;

   (*
      Holt aus dem File Name das Datum, gibt in found TRUE zurück,
      wenn gefunden.
   *)
   PROCEDURE GetDatefromFile (     Name  : ARRAY OF CHAR;
                               VAR Datum : Date;
                               VAR found : BOOLEAN   );
      VAR
         fibptr   : FileInfoBlockPtr;
         filelock : FileLockPtr;
   BEGIN
      Datum := NullDate;
      filelock := Lock ( ADR ( Name ), accessRead );
      IF filelock # NIL THEN
         AllocMem ( fibptr, SIZE ( fibptr^ ), TRUE );
         Assert ( fibptr # NIL, ADR ( nochip ) );
         Assert ( Examine ( filelock, fibptr ),
                  ADR ( exerr ) );
         Datum := fibptr^.date;
         Deallocate ( fibptr );
         UnLock ( filelock );
         found := TRUE;
      ELSE
         found := FALSE;
      END;
   END GetDatefromFile;

BEGIN
   WITH NullDate DO
      days := 0;
      minute := 0;
      tick := 0;
   END;
   latestDate := NullDate;
   PfadListe  := NIL;
END Header.