Amiga MA Magazine 1998 #6/amigamamagazinepolishissue1998.iso/coders/showlinks/showlinks.mod

Text File | 1995-08-04 | 5KB | 238 lines

MODULE ShowLinks;


FROM    SYSTEM            IMPORT    ADR, LONGSET;
FROM    Arts            IMPORT    BreakPoint;
FROM    ExecL            IMPORT    SetSignal;
FROM    DosD            IMPORT    ctrlC,
                    sharedLock,
                    dosFib,
                    noFreeStore, noMoreEntries, objectNotFound, break,
                    stLinkFile, stLinkDir,
                    FileLockPtr, FileInfoBlockPtr;
FROM    DosL            IMPORT    IoErr, Fault,
                    AllocDosObject, FreeDosObject,
                    Lock, UnLock,
                    AddPart, NameFromLock,
                    Examine, ExNext;
FROM    String            IMPORT    Length,
                    Copy, CopyPart;
FROM    InOut            IMPORT    WriteString, WriteInt, WriteLn;
FROM    NewArgSupport        IMPORT    Str, StrPtr,
                    StrArray, StrArrayPtr,
                    SetArgumentInfo, UseArguments,
                    ArgMultiple;

CONST    Pen1            ="\e[31m";
    Pen2            ="\e[32m";

    Version            ="$VER: ShowLinks 0.1 (04.01.94) von Reiner B. Nix";

    maxName            =108;
    Space            ="                                                            ";

VAR    Weiter            :BOOLEAN;
    i            :CARDINAL;
    Pfade            :StrArrayPtr;


PROCEDURE UntersuchePfad    (    Pfad        :ARRAY OF CHAR);

VAR    ok, Abbruch        :BOOLEAN;
    Signale            :LONGSET;
    PfadSperre        :FileLockPtr;
    InfoBlock        :FileInfoBlockPtr;


  PROCEDURE FehlerAusgeben    (    KopfText        :ARRAY OF CHAR;
                       FehlerNummer    :LONGINT;
                     ErsatzText        :ARRAY OF CHAR);

  VAR    FehlerText        :ARRAY [0..80] OF CHAR;

  BEGIN
  WriteString (Pen2);
  IF Fault (FehlerNummer, ADR (KopfText), ADR (FehlerText), 80) THEN
    WriteString ("ShowLinks: ");
    WriteString (FehlerText);
  ELSE
    WriteString ("ShowLinks: ");
    WriteString (KopfText);
    WriteString (" ");
    WriteString (ErsatzText);
    END;
  WriteString (Pen1);
  WriteLn;

  (* BreakPoint (ADR ("Fehler!")); *)
  END FehlerAusgeben;



  PROCEDURE VerweisAusgeben    (    InfoBlock        :FileInfoBlockPtr);

  VAR    LeerText        :ARRAY [0..60] OF CHAR;
        VerweisName,
        OriginalName        :ARRAY [0..maxName] OF CHAR;


    PROCEDURE VerfolgeVerweis    (    VerweisName    :ARRAY OF CHAR;
                     VAR OriginalName    :ARRAY OF CHAR);

    VAR    ok            :BOOLEAN;
        VerweisSperre        :FileLockPtr;

    BEGIN
    VerweisSperre := Lock (ADR (VerweisName), sharedLock);
    IF VerweisSperre # NIL THEN
      IF NOT (NameFromLock (VerweisSperre, ADR (OriginalName), HIGH (OriginalName))) THEN
        Copy (OriginalName, "???")
        END;
      UnLock (VerweisSperre)

    ELSE
      Copy (OriginalName, "???")
      END
    END VerfolgeVerweis;


  (* VerweisAusgeben *)
  BEGIN
  WITH InfoBlock^ DO
    Copy (VerweisName, Pfad);
    IF AddPart (ADR (VerweisName), ADR (InfoBlock^.fileName), maxName) THEN
      WriteString (VerweisName);
      CopyPart (LeerText, Space, 0, 60-Length (VerweisName));
      WriteString (LeerText);

      IF    dirEntryType = stLinkFile THEN
        WriteString (" hardlink to ")
      ELSIF dirEntryType = stLinkDir THEN
        WriteString (" dir-link to ")
        END;

      VerfolgeVerweis (VerweisName, OriginalName);
      WriteString (OriginalName);
      WriteLn

      END
    END
  END VerweisAusgeben;


  PROCEDURE UntersucheNeuenPfad    (    Pfad        :ARRAY OF CHAR;
                     InfoBlock        :FileInfoBlockPtr);

  VAR    NeuerPfad        :ARRAY [0..maxName] OF CHAR;

  BEGIN
  Copy (NeuerPfad, Pfad);
  IF AddPart (ADR (NeuerPfad), ADR (InfoBlock^.fileName), maxName) THEN
    (*
    WriteString ("NeuerPfad: ");
    WriteString (NeuerPfad);
    WriteLn;
    *)

    UntersuchePfad (NeuerPfad)
    END
  END UntersucheNeuenPfad;



(* UntersuchePfad *)
BEGIN
PfadSperre := Lock (ADR (Pfad), sharedLock);
IF PfadSperre = NIL THEN
  IF IoErr() # objectNotFound THEN            (* Programmfehler: bei         *)
    FehlerAusgeben (Pfad, IoErr (), "Pfad unbekannt!")    (* Rekursion enthält der erste    *)
    END;                        (* Pfad vorheriges Verzeichnis    *)


ELSE (* PfadSperre # NIL *)
  InfoBlock := AllocDosObject (dosFib, NIL);
  IF InfoBlock = NIL THEN
    FehlerAusgeben ("", noFreeStore, "Speicherplatzmangel!")


  ELSE
    ok :=Examine (PfadSperre, InfoBlock);
    WHILE ok & Weiter DO
      (*
      WriteString (" >>");
      WriteString (Pfad);
      WriteString (" >>");
      WriteString (InfoBlock^.fileName);
      WriteString (" >>");
      WriteInt    (InfoBlock^.dirEntryType, 3);
      WriteLn;
      *)

      Signale := SetSignal (LONGSET {}, LONGSET {});
      IF ctrlC IN Signale THEN
        IF Weiter THEN
          FehlerAusgeben ("", break, "*** Abbruch!");
          Weiter := FALSE
          END
        END;

      IF (InfoBlock^.dirEntryType = stLinkDir) OR    (* Verweis gefunden        *)
         (InfoBlock^.dirEntryType = stLinkFile) THEN
        VerweisAusgeben (InfoBlock)

      ELSIF InfoBlock^.dirEntryType > 0 THEN        (* VerzeichnisInfo gefunden    *)
        UntersucheNeuenPfad (Pfad, InfoBlock)
        END;

      ok := ExNext (PfadSperre, InfoBlock);
      END;
    IF Weiter & (IoErr () # noMoreEntries) THEN
      FehlerAusgeben (Pfad, IoErr (), "Suchfehler!")
      END;

    FreeDosObject (dosFib, InfoBlock);
    END;


  UnLock (PfadSperre);
  END
END UntersuchePfad;



PROCEDURE ProgrammInfo ();

VAR    KurzVersion    :ARRAY [0..80] OF CHAR;

BEGIN
CopyPart (KurzVersion, Version, 6, Length (Version)-6);

WriteLn;
WriteString (Pen2);
WriteString (KurzVersion);
WriteString (Pen1);
WriteLn;

WriteString ("  Sucht rekursiv alle Links im angegebenen Pfad.");
WriteLn
END ProgrammInfo;



(* MODULE ShowLinks *)
BEGIN
SetArgumentInfo (ProgrammInfo);
UseArguments ("Path/A/M");

Weiter := TRUE;
Pfade := ArgMultiple ("Path");
IF Pfade # NIL THEN
  i := 0;
  WHILE Pfade^[i] # NIL DO
    UntersuchePfad (Pfade^[i]^);
    INC (i)
    END
  END

END ShowLinks.