MODULA - M2PROT.ZIP - PATHFIND.MOD

 
Output of file : PATHFIND.MOD contained in archive : M2PROT.ZIP

(*%F _fdata *)
(*# call(seg_name => null) *)
(*%E *)
(*# module(implementation=>off) *)
(*# data(seg_name => null) *)
(*# call(o_a_copy => off) *)
(*# check(stack=>off,
index=>off,
range=>off,
overflow=>off,
nil_ptr=>off) *)
IMPLEMENTATION MODULE PathFind;

(* Source code for JPI TopSpeed Modula-2 by

Carl Neiburger
169 N. 25th St.
San Jose, Calif. 95116

CompuServe No. 72336,2257

NOTE: This module requires MODULE FioAsm by the same author. If you can't
find this module, you can write your own routines for this procedure:

PROCEDURE Drives(): SHORTCARD;
(* tells how many on system *)

NFIO is a substitute for JPI's FIO, and all the imported procedures
listed here work the same as in FIO
*)

FROM Lib IMPORT Environment, CommandType;
FROM Str IMPORT Append, Caps, CHARSET, Copy, Delete, Item, Length, Pos,
Slice, Concat, Compare;
FROM NFIO IMPORT GetDir, ChDir, OK, Exists;
FROM FioAsm IMPORT Drives, ReadFirstEntry, ReadNextEntry,
FileAttributes, DirEntry, FileAttr;
FROM Storage IMPORT ALLOCATE, DEALLOCATE;

CONST
FileOrDir = FileAttr{readonly,directory};

TYPE str80 = ARRAY [0..79] OF CHAR;

PROCEDURE FindEnvStr( target : ARRAY OF CHAR; VAR string: ARRAY OF CHAR );
VAR i : CARDINAL; c : CommandType;
BEGIN
i := 0;
REPEAT
c := Environment(i);
Copy(string, c^ );
Caps(string);
INC(i)
UNTIL ( string[0] = 0C ) OR ( Pos(string, target ) < MAX( CARDINAL ) );
i := Pos(string, '=');
IF i < MAX ( CARDINAL ) THEN
Delete(string, 0, i+1);
WHILE string[0] IN CHARSET{11C, 40C} DO
Delete(string, 0, 1)
END
END
END FindEnvStr;

PROCEDURE FindPath(PathName,
TargetName: ARRAY OF CHAR;
VAR TargetPath: ARRAY OF CHAR): BOOLEAN;

VAR path: str80; item: PathStr; i : CARDINAL;
BEGIN
IF Exists( TargetName ) THEN
Copy(TargetPath, TargetName);
RETURN TRUE
END;
FindEnvStr( PathName, path );
i := 0;
LOOP
Item( item, path, CHARSET{';'}, i);
IF item[0] = 0C THEN
Copy(TargetPath, TargetName);
RETURN FALSE
END;
IF NOT ( item[Length(item)-1] IN CHARSET{':', '\'} ) THEN
Append( item, '\' );
END;
Append( item, TargetName );
IF Exists( item ) THEN
Copy(TargetPath, item);
RETURN TRUE;
END;
INC ( i )
END;
END FindPath;

PROCEDURE ParsePath(VAR Path: PathStr;
VAR FileName: PathTail): BOOLEAN;
VAR DE: DirEntry;
Len: CARDINAL;
Parent,
PathOnly : BOOLEAN;
CurrentPath : PathStr;

PROCEDURE CompletePath(): BOOLEAN;
VAR SavePath: PathStr; d : SHORTCARD;
BEGIN
IF Path[1] = ':' THEN
d := SHORTCARD(CAP(Path[0])) - 64;
IF d > Drives() THEN
RETURN FALSE
END
ELSE
d := 0
END;
GetDir(0, SavePath);
IF Path[0] = 0C THEN
Path := SavePath;
RETURN TRUE
END;
ChDir ( Path );
IF OK THEN
GetDir( d, Path );
ChDir( SavePath );
RETURN TRUE
END;
RETURN FALSE
END CompletePath;

PROCEDURE SlicePath;
VAR i: CARDINAL;
BEGIN
i := Len;
WHILE NOT (Path[i] IN CHARSET{':', '\'}) AND (i > 0) DO
DEC(i)
END;
IF (i = Len) AND (Path[i] IN CHARSET{':', '\', '.'}) THEN
PathOnly := TRUE;
RETURN
ELSE
PathOnly := FALSE
END;
IF i = 0 THEN
Copy(FileName, Path);
Path[0] := 0C;
RETURN
END;
Slice(FileName, Path, i+1, Len );
IF (Path[i] = ':') OR (Path[i-1] = ':') THEN
INC(i);
END;
Path[i] := 0C;
END SlicePath;

BEGIN (* ParsePath *)
Len := Length(Path) - 1;
Caps(Path);
Caps(FileName);
Parent := Compare(Path, '..') = 0;
IF Parent THEN

GetDir( 0, CurrentPath );
Parent := Length(CurrentPath) > 3
END;
IF Parent OR ReadFirstEntry( Path, FileOrDir, DE ) THEN
IF (Pos(Path, '*') < MAX(CARDINAL) )
OR (Pos(Path, '?') < MAX(CARDINAL) )
OR NOT ( Parent OR (directory IN DE.attr) ) THEN
SlicePath;
END;
RETURN CompletePath()
END;
SlicePath;
RETURN CompletePath() AND PathOnly (* RETURN FALSE if file not found *)
END ParsePath;

PROCEDURE FileTree ( Path: PathStr ): FilePtr;
VAR Ptr, this: FilePtr; p: PathStr; FileName: PathTail; DE: DirEntry;
BEGIN
FileName := '*.*';
IF ParsePath( Path, FileName) THEN
IF Path[Length(Path)-1] <> '\' THEN
Append( Path, '\')
END;
Concat( p, Path, FileName);
IF ReadFirstEntry( p, FileAttr{readonly}, DE ) THEN
NEW(this);
Concat(this^.Name, Path, DE.Name);
this^.Next := NIL;
Ptr := this;
WHILE ReadNextEntry( DE ) DO
NEW(this^.Next);
this := this^.Next;
Concat(this^.Name, Path, DE.Name);
this^.Next := NIL
END;
RETURN Ptr
END
END;
RETURN NIL;
END FileTree;

PROCEDURE UnFileTree ( VAR Ptr : FilePtr );
VAR this: FilePtr;
BEGIN;
this := Ptr;
WHILE this <> NIL DO
Ptr := Ptr^.Next;
DISPOSE(this);
this := Ptr
END
END UnFileTree;

END PathFind.