The ModulAtor

Ublantis' 1st Independent Oberon & Modula-2 Technical Publication

Nr. 93, Oct-2015

ModulaTor logo, 7.8KB

R. Singer, G. Dotzel: WildCards - Yet another Directory Walker in Modula-2 for DEC PDP-11/RT-11

Copyright © (2015) by Guenter Dotzel, modulAware.com

UseWildCards is a demo how to use module WildCards, which enumerates files of a directory allowing simple wildcard selection.

Module VIR, the last module of this page, is a directory listing tool which allows more sophisticated wildcard specification.

It served to develop the final version wildcard file enumerator WildFiles. Here are the definition modules TextBinCIO and Uni* imported by VIR.

MODULE UseWildCards; (* RS 18-Dec-1986 *)
(* Application example for module WildCards *)

FROM WildCards IMPORT FWILD, FNEXT, FCLOSE, 
  WildCard, maxWild, FileName, Time;
FROM UnivString IMPORT ReadString, TermString;
FROM UnivOutput IMPORT WriteString, Writeln, WriteCard;
FROM TTIO IMPORT Read, Write;
FROM UnivDate IMPORT WriteDate, WriteTime;
FROM UnivWriteFileName IMPORT WriteFileName;
FROM Clock IMPORT GetTime;
FROM ASCII IMPORT ESC, NUL, BS, CR;

CONST DevLen = 2;
  emptyFile =  "            ";
  maxDev = 9;

VAR nf, nbl: CARDINAL;
  ch: CHAR;

  Dev: ARRAY [0..DevLen] OF CHAR;
  Device: ARRAY[0..maxDev] OF FileName;
  NWild, NDev: CARDINAL;

  Wild: ARRAY [0..maxWild-1] OF WildCard;

  PROCEDURE WriteNames (d: FileName);
  VAR t: Time; j, b, fnl: CARDINAL;
    ok, prot: BOOLEAN;
    fn: FileName;
  BEGIN
    GetTime(t);
    WriteDate (Write, t); WriteString (Write, ', '); WriteTime (Write, t);
    WriteString (Write, ', Device ');
    WriteFileName(Write, d, fnl);
    Write (BS); Write (' ');
    Writeln (Write);
    REPEAT
      FNEXT (fn, b, prot, t, ok);
      IF ok THEN
        Write (fn [3]);Write (fn [4]);Write (fn [5]);Write (fn [6]);
        Write (fn [7]);Write (fn [8]);Write('.');
        Write (fn [9]);Write (fn [10]);Write (fn [11]);
        WriteCard (Write, b, 6); 
        IF prot THEN Write('P'); ELSE Write(' '); END;
        Write(' ');
        WriteDate (Write, t); 
        (*Write(' '); WriteTime (Write, t);*)
        Writeln (Write);
        INC(nbl,b); INC(nf);
      END;
    UNTIL NOT ok;
  END WriteNames;

  PROCEDURE ERROR (reply: INTEGER; file: FileName);
  VAR f: CARDINAL;
  BEGIN
    CASE reply OF
      -1 : WriteString (Write, ' ---- ERROR: no file-channel free');
     |-2 : WriteString (Write, ' ---- ERROR: device/file not found : ');
           WriteFileName (Write, file, f); Writeln (Write);
     |-3 : WriteString (Write, ' ---- ERROR: no directory-structure : ');
           WriteFileName (Write, file, f); Writeln (Write);
     |-4 : WriteString (Write, ' ---- ERROR: wrong wildcard-format');
    ELSE WriteString (Write,
      ' ---- ERROR: illegal device or handler not loaded : ');
      WriteFileName (Write, file, f); Writeln (Write);
    END;
  END ERROR;

  PROCEDURE GetFiles (Wild: ARRAY OF WildCard; NWild: CARDINAL);
  VAR x, f, b: CARDINAL; reply: INTEGER;
  BEGIN
    x := 0;
    WHILE x < NDev DO
      FWILD (Device[x], NWild, Wild, FALSE, reply);
      IF (-255 <= reply) & (reply <0) THEN ERROR (reply, Device[x]);
      ELSE WriteNames (Device[x]); FCLOSE (b, f);
      END;
      INC (x);
    END;
  END GetFiles;

  PROCEDURE TermDev (c:CHAR): BOOLEAN;
  BEGIN RETURN TermString (c) OR (c = ',');
  END TermDev;

  PROCEDURE TermWild (c:CHAR): BOOLEAN;
  BEGIN RETURN TermString (c) OR (c = '.');
  END TermWild;

BEGIN
  LOOP
    NWild := 0; NDev := 0; nf := 0; nbl := 0;
    Writeln (Write);
    WriteString (Write, 
      'Type list of devices names (max = 10, default: DK), separated by ","');
    Writeln (Write);
    Write ('>');
    REPEAT
      ReadString (Read, Write, Dev, TRUE, TermDev, ch);
      IF Dev[0] = NUL THEN Dev := 'DK ';
      ELSIF Dev[1] = NUL THEN Dev[1] := ' '; Dev[2]:=' ';
      ELSIF Dev[2] = NUL THEN Dev[2] := ' ';
      END;
      Device [NDev] := emptyFile; Device[NDev,0] := Dev[0];
      Device[NDev,1] := Dev[1]; Device[NDev,2] := Dev[2];
      INC (NDev);
      IF ch = ',' THEN Write (','); END;
    UNTIL (ch = CR) OR (ch = ESC) OR (NDev > maxDev);
    Writeln (Write);
    IF ch = ESC THEN EXIT; END;
    WriteString (Write, 'Type wildcards "name.ext", default: *.*, ');
    Writeln (Write);
    WriteString (Write, ' separated by , terminate with ');
    Writeln (Write);
    REPEAT
      Write ('>');
      WITH Wild[NWild] DO
        ReadString (Read, Write, n, FALSE, TermWild, ch);
        IF n[0] = NUL THEN n[0] := '*'; n[1] := NUL; END;
        IF ch = '.' THEN
          Write ('.'); ReadString (Read, Write, e, FALSE, TermString, ch);
          IF e[0] = NUL THEN e[0] := '*'; e[1] := NUL; END;
        ELSE e[0] := '*'; e[1] := NUL;
        END;
      END;
      INC (NWild);
      Writeln (Write);
    UNTIL (ch = ESC) OR (NWild >= maxWild);
    DEC (NWild);
    GetFiles (Wild, NWild);
    WriteString(Write, 'Files '); WriteCard (Write, nf, 7); 
    WriteString(Write, ', Blocks'); WriteCard (Write,nbl, 7); 
  END;
END UseWildCards.

DEFINITION MODULE WildCards; (* Wildcard operations for RT11A/RT11X directories, example: UseWil.MOD > > (c) Copyright (1986) by Gunter Dotzel, ModulaWare.com > Started: Aug-1986 by R. Singer Revisions: comments 20-Aug GD. *) IMPORT Files, Clock; TYPE FileName = Files.FileName; Time = Clock.Time; CONST NamLen = 5; ExtLen = 2; maxWild = 20; TYPE Name = ARRAY[0..NamLen] OF CHAR; Ext = ARRAY[0..ExtLen] OF CHAR; WildCard = RECORD n:Name; e: Ext; END; PROCEDURE FWILD (dirName: FileName; NWild: CARDINAL; Wild: ARRAY OF WildCard; exclude: BOOLEAN; VAR reply: INTEGER); (* Initialises the directory wildcard operation for FNEXT. dirName [0..2] specifies the device name; if the device name is shorter than 3 chars, it must be filled up with " ". dirName [3..11] should be set to " ". NWild specifies the number of valid WildCard's in the array Wild. If any Wild[x].n or Wild[x].e is not of legal wildcard format then FWILD returns iswild = FALSE, otherwise the device d is successfully opened, FNEXT may be repeatedly called to get all file names which can (not, for exclude = TRUE) be derived from the wildcard specification. The order of the file names delivered is system (directory) dependent. Error codes for reply: IF (-255 <= reply) & (reply < 0) THEN (* error: CASE reply OF -1: no file-channel free; | -2: device/file not found; | -3: no valid directory structure; | -4): wrong wildcard-`format; ELSE (* reply < -4 *): illegal device or other error; END;*) ELSE (* CARDINAL(reply) is file (device) size (or 0 under SHAREplus) *) END Syntax: alpha = 'A' | .. | 'Z' | 'a' | .. | 'z' | '0' | .. | '9' . wild = '*'. singlewild = '%'. Legal wildcard formats: d = {alpha}. n = { {alpha} [wild | {singlewild} ] }. e = n. Syntax/sematics of RT-11's wildcard specification. Imported module: GetDirectory (works also with SHAREplus' RT11X structure) *) PROCEDURE FNEXT (VAR fn: FileName; VAR size: CARDINAL; VAR protected: BOOLEAN; VAR t: Time; VAR FileFound: BOOLEAN); (* gives next file name which matches the wildcard specification, which must be initialised with FWILD. If there is a file name then it's device, name and extension is assigned to fn and FileFound = TRUE,~, otherwise FileFound = FALSE and file channel is released implicitely. *) PROCEDURE FCLOSE (VAR nFiles, nBlocks: CARDINAL); (* close directory channel and give the number of files found nFiles and total number of blocks nBlocks *) END WildCards.
IMPLEMENTATION MODULE WildCards; (* > > (c) Copyright (1986) by Gunter Dotzel, ModulaWare.com > Aug-1986: FNEXT, FWILD by R. Singer. *) FROM GetDirectory IMPORT OpenDir, ReleaseDir, GetNext, FileName, Time; CONST DevLen = 2; NILFILE = ' XXXXXXXXX'; VAR Device: FileName; FileOpen, excl: BOOLEAN; numFiles, numBlocks, NumWild: CARDINAL; WILD: ARRAY[0..maxWild] OF RECORD n: ARRAY[0..NamLen+1] OF CHAR; e: ARRAY[0..ExtLen+1] OF CHAR; END; PROCEDURE FWILD (d: FileName; N: CARDINAL; W: ARRAY OF WildCard; exclude: BOOLEAN; VAR reply: INTEGER); PROCEDURE Empty(s: ARRAY OF CHAR): BOOLEAN; BEGIN RETURN s[0]=0C; END Empty; PROCEDURE Length (VAR s: ARRAY OF CHAR): CARDINAL; VAR i: CARDINAL; BEGIN i := 0; WHILE (i <= HIGH (s)) & (s[i] # 0C) DO INC(i); END; RETURN i; END Length; PROCEDURE Copy (VAR s: ARRAY OF CHAR; ss: ARRAY OF CHAR); VAR i: CARDINAL; BEGIN i := 0; WHILE i<=HIGH(ss) DO s[i] := ss[i]; INC(i); END; s[i] := 0C; END Copy; PROCEDURE Parse (VAR str: ARRAY OF CHAR; VAR iswild: BOOLEAN); VAR i: CARDINAL; BEGIN iswild := TRUE; i := 0; WHILE iswild & (i < Length (str)) DO IF ('a' <= str[i]) & (str[i] <= 'z') THEN str[i] := CAP (str[i]); END; iswild := (str[i] = '*') OR (str[i] = '%') OR (('A' <= str[i]) & (str[i] <= 'Z')) OR (('0' <= str[i]) & (str[i] <= '9')); INC (i); END; END Parse; VAR z,i: CARDINAL; ch: CHAR; iswild: BOOLEAN;*) BEGIN (* FWILD *) excl := exclude; FileOpen := FALSE; numBlocks:=0; numFiles:=0; i := 0; NumWild := N; iswild := TRUE; WHILE (i < N) & (i <= maxWild) & iswild DO WITH W[i] DO IF Empty (n) THEN n[0] := '*'; n[1] := 0C; ELSE Parse (n, iswild); END; IF iswild THEN Copy (WILD[i].n, n); IF Empty (e) THEN e[0] := '*'; e[1] := 0C; ELSE Parse (e, iswild); END; IF iswild THEN Copy (WILD[i].e, e); END; END; END; (*WITH*) INC (i); END;(*WHILE*) IF iswild THEN OpenDir (d, z, FileOpen); reply := z; IF NOT FileOpen & (reply >= 0) THEN reply := -3; END; ELSE reply := -4; END; END FWILD; PROCEDURE FNEXT (VAR fn: FileName; VAR size: CARDINAL; VAR protected: BOOLEAN; VAR t: Time; VAR found: BOOLEAN); PROCEDURE Match (w,s: ARRAY OF CHAR): BOOLEAN; PROCEDURE End (a: ARRAY OF CHAR; ai: CARDINAL): BOOLEAN; BEGIN IF ai <= HIGH (a) THEN RETURN ((a[ai] = ' ') OR (a[ai] = 0C)); ELSE RETURN TRUE; END; END End; VAR si, wi, LastWild: CARDINAL; Wild: BOOLEAN; BEGIN si := 0; wi := 0; Wild := FALSE; LastWild := 0;(* := NILWILD*) REPEAT WHILE w[wi] = '*' DO INC (wi); Wild := TRUE; LastWild := wi; END; IF w[wi] = s[si] THEN INC (wi); INC (si); Wild := FALSE; ELSIF w[wi] = '%' THEN INC (wi); INC (si); IF Wild THEN LastWild := wi; END; ELSIF Wild THEN INC (si); ELSIF LastWild # 0 (* # NILWILD*) THEN wi := LastWild; Wild := TRUE; ELSE RETURN FALSE; END; UNTIL End (s, si) ; WHILE w[wi] = '*' DO INC (wi); END; RETURN End (w, wi); END Match; VAR N: ARRAY[0..NamLen] OF CHAR; E: ARRAY[0..ExtLen] OF CHAR; nf, nbl, start, i: CARDINAL; ok: BOOLEAN; BEGIN found := FALSE; size:=0; IF NOT FileOpen THEN fn := NILFILE; RETURN; END; LOOP GetNext (fn, protected, size, start, t, ok); IF NOT ok THEN EXIT; END; FOR i := 0 TO NamLen DO N[i] := fn[i+DevLen+1]; END; FOR i := 0 TO ExtLen DO E[i] := fn[i+DevLen+NamLen+2]; END; i := 0; WHILE (i < NumWild) & NOT found DO WITH WILD[i] DO found := Match (n, N) & Match (e, E); END; INC (i); END; IF (found & NOT excl) OR (NOT found & excl) THEN found := TRUE; EXIT; ELSE found := FALSE; END; END; IF NOT found THEN fn := NILFILE; ReleaseDir (nf, nbl); FileOpen := FALSE; ELSE INC(numFiles); INC(numBlocks, size); END; END FNEXT; PROCEDURE FCLOSE (VAR nFiles, nBlocks: CARDINAL); VAR i,j: CARDINAL; BEGIN IF FileOpen THEN ReleaseDir (i,j); FileOpen:=FALSE; END; nFiles := numFiles; nBlocks := numBlocks END FCLOSE; BEGIN FileOpen := FALSE; END WildCards.
MODULE VIR; (* > > (c) Copyright (1986) by Gunter Dotzel, ModulaWare.com > alpha = 'A' | .. | 'Z' | 'a' | .. | 'z' | '0' | .. | '9' . wild = '*'. singlewild = '%'. leftB = '('. rightB = ')'. seperator = ','. devsign = ':'. extsign = '.'. wildalpha = alpha | wild | singlewild. brackets = leftB alpha {alpha} { ',' alpha {alpha} } rightB. wildbrackets = leftB wildalpha {wildalpha} { seperator wildalpha {wildalpha} } rightB. expression = {alpha {alpha} [brackets] | {alpha} brackets }. wildexpression = {wildalpha {wildalpha} [wildbrackets] | {wildalpha} wildbrackets }. device = expression devsign. name = wildexpression ext = extsign wildexpression. wildcard = [ device ] [ name ] [ ext ]. Legal wildstring formats: wildcard { seperator wildcard }. Examples of valid wildstrings: DU1: .COM gives all .COM files in all .DSK files of DU1: DU(0,1): for devices DU0, DU1 DEMO(A,B).D%% gives all DEMOA.D%% and DEMOB.D%% files in all .DSK files of DU0: and DU1: DEMO*.(DEF,MOD),.(SAV,SYS,SYG) gives all DEMO*.MOD and DEMO*.DEF and .SAV and and .SYS and .SYG files of DK: D(A,B,C)(A,B).*(A,B,C)*,DEMO2.MO(D,B) gives all DAA and DAB and DBA and DBB and DCA and DCB files each with extension *A* or *B* or *C* and all DEMO2.MOB and DEMO2.MOD files of DK: D(U,Y)(0,1): for devices DU0, DU1, DY0, DY1 same as DU(0,1),DY(0,1): for devices DU0, DU1, DY0, DY1 For syntax of the wildcard specification: see RT-11 Directory command. *) FROM SYSTEM IMPORT RT11CALL; FROM WildCards IMPORT FWILD, FNEXT, FCLOSE, Name, Ext, FileName, Time, maxWild, WildCard; FROM UnivEdit IMPORT Retype; FROM UnivString IMPORT TermString; FROM UnivOutput IMPORT WriteString, Writeln, WriteCard; FROM UniLOutput IMPORT WriteLong; FROM TextBinCIO IMPORT NoEcho, Channel, DeChannel, CHANNEL, TT, Put, SetPut; FROM TTIO IMPORT Read, Write; FROM UnivDate IMPORT WriteDate, WriteTime; FROM UnivRDate IMPORT ReadDate; FROM UnivWriteFileName IMPORT WriteFileName; FROM UnivFileName IMPORT ReadFileName; FROM Clock IMPORT GetTime; FROM ASCII IMPORT ESC, NUL, BS, CR; CONST maxWildLen = 79; maxPartLen = 6; NILL = maxWildLen + 1; emptyFile = " "; maxPuffLen = 20; DevLen = 2; maxSubDir = 99; TYPE PartType = (nil,dev,nam,ext); OptKind = (new,since,date,col,brief,fast,subdir,output,printer, exclude,illegal); Dev = ARRAY[0..DevLen] OF CHAR; OptionSet = SET OF OptKind; WILDSTRING = ARRAY[0..maxWildLen-1] OF CHAR; VAR WildString: WILDSTRING; nf: CARDINAL; nbl: LONGINT; ok: BOOLEAN; ch: CHAR; SubDirFiles: ARRAY[0..maxSubDir] OF FileName; NSubDir: CARDINAL; SubDir: BOOLEAN; Mixed: BOOLEAN; Options: OptionSet; DATE, DATEsince, DATEnew: Time; FULL, EXCLUDE: BOOLEAN; COLUMNS: CARDINAL; FileOut: CHANNEL; ExtPuff: ARRAY[0..maxPuffLen-1] OF Ext; NamPuff: ARRAY[0..maxPuffLen-1] OF Name; DevPuff: ARRAY[0..maxPuffLen-1] OF Dev; DCount, NCount, ECount: CARDINAL; VAR tempWS: WILDSTRING; IX: CARDINAL; PROCEDURE StringRead (VAR ch: CHAR); (* used for substitution in ReadDate *) BEGIN ch := tempWS [IX]; INC (IX); IF (ch = '/') OR (ch = NUL) OR (IX > HIGH(tempWS)) THEN ch := CR; (** assume(TermString(CR)) **) END; END StringRead; PROCEDURE ResetCtrlO; BEGIN RT11CALL(355B, 0); END ResetCtrlO; PROCEDURE Length (s: ARRAY OF CHAR): CARDINAL; (* $T- *) VAR j: CARDINAL; BEGIN j := 0; WHILE (j <= HIGH (s)) & (s[j] # 0C) DO INC (j); END; RETURN j; END Length; (* $T= *) PROCEDURE Scan (VAR str, s: ARRAY OF CHAR; VAR sc: CHAR; VAR len: CARDINAL; delimiters: ARRAY OF CHAR); VAR j: CARDINAL; BEGIN len := 0; s[0] := NUL; LOOP IF len > (HIGH (s)+1) THEN len := NILL; EXIT; ELSIF (str [len] = NUL) OR (len > HIGH (str)) THEN EXIT; ELSE FOR j := 0 TO HIGH (delimiters) DO IF str[len] = delimiters [j] THEN EXIT; END; END; INC (len); END; END; IF len # NILL THEN j := 0; WHILE j < len DO s[j] := str[j]; INC (j); END; IF j <= HIGH (s) THEN s[j] := NUL; END; IF j <= HIGH (str) THEN sc := str[j]; ELSE sc := NUL; END; INC (j); WHILE (j <= HIGH (str)) & (str[j] # NUL) & (sc # NUL) DO str[j-len-1] := str[j]; INC (j); END; str[j-len-1] := NUL; END; END Scan; PROCEDURE WriteNames (d: FileName); VAR t: Time; j, b, fnl: CARDINAL; ok, prot: BOOLEAN; fn: FileName; PROCEDURE OptsFullfilled(): BOOLEAN; BEGIN RETURN NOT (Options*OptionSet{new,since,date} <> OptionSet{}) OR ((OptionSet{new} <= Options) & (t.day = DATEnew.day)) OR ((OptionSet{since} <= Options) & (t.day >= DATEsince.day)) OR ((OptionSet{date} <= Options) & (t.day = DATE.day)); END OptsFullfilled; BEGIN GetTime(t); WriteDate (Put, t); WriteString (Put, ', '); WriteTime (Put, t); WriteString (Put, ', Device '); WriteFileName(Put, d, fnl); IF SubDir THEN Put (':'); ELSE Put (BS); Put (' '); END; Writeln (Put); j := 1; REPEAT FNEXT (fn, b, prot, t, ok); IF ok & OptsFullfilled() THEN Put (fn [3]);Put (fn [4]);Put (fn [5]); Put (fn [6]); Put (fn [7]);Put (fn [8]);Put('.'); Put (fn [9]);Put (fn [10]);Put (fn [11]); IF FULL THEN WriteCard (Put, b, 6); IF prot THEN Put('P'); ELSE Put(' '); END; Put(' '); WriteDate (Put, t); (*Put(' '); WriteTime (Put, t);*) END; IF j >= COLUMNS THEN Writeln (Put); j := 1; ELSE WriteString (Put, ' '); INC (j); END; INC(nbl,b); INC(nf); END; UNTIL NOT ok; IF j # 1 THEN Writeln (Put); END; END WriteNames; PROCEDURE GetFName (VAR WildString: ARRAY OF CHAR; VAR ok: BOOLEAN); TYPE PS = ARRAY[0..maxPartLen-1] OF CHAR; VAR OPCount, NPCount, len, i: CARDINAL; Del: CHAR; LastType: PartType; Brack: BOOLEAN; OPartPuff, NPartPuff: ARRAY[0..maxPuffLen-1] OF PS; PartString: PS; PROCEDURE Copy (VAR s: ARRAY OF CHAR; ss: ARRAY OF CHAR); VAR i: CARDINAL; BEGIN i := 0; WHILE (i<=HIGH(ss)) & (i<=HIGH(s)) & (ss[i]#NUL) DO s[i] := ss[i]; INC(i); END; IF i<=HIGH(s) THEN s[i] := NUL; ELSIF (i <= HIGH (ss)) & (ss[i] # NUL) THEN ok := FALSE; END; END Copy; PROCEDURE Concat (s1,s2: ARRAY OF CHAR; VAR ss: ARRAY OF CHAR); VAR i, k: CARDINAL; BEGIN i := 0; WHILE (i <= HIGH (s1)) & (s1[i] # NUL) DO ss[i] := s1[i]; INC (i); END; k := i; IF i > HIGH (s1) THEN ok := FALSE; ELSE WHILE (i <= HIGH (s1)) & (s2[i-k] # NUL) DO ss[i] := s2[i-k]; INC (i); END; IF (i > HIGH (s1)) & (s2[i-k] # NUL) THEN ok := FALSE; ELSIF i <= HIGH (ss) THEN ss[i] := NUL; END; END; END Concat; PROCEDURE Insert (VAR s: PS; VAR ok: BOOLEAN); VAR str: ARRAY[0..maxPartLen-1] OF CHAR; BEGIN IF Brack THEN IF Length (s) = 0 THEN s[0] := '*'; s[1] := NUL; END; IF OPCount = 0 THEN NPartPuff[NPCount] := s; INC (NPCount); ELSE i := 0; WHILE i < OPCount DO Concat (OPartPuff[i], s, str); IF ok THEN Copy (NPartPuff[NPCount], str); INC (NPCount); END; INC (i); END; END; ELSE IF Length (s) > 0 THEN IF OPCount = 0 THEN OPartPuff[OPCount] := s; INC (OPCount); ELSE i := 0; WHILE i < OPCount DO Concat (OPartPuff[i], s, str); IF ok THEN Copy (OPartPuff[i], str); END; INC (i); END; END; END; END; END Insert; BEGIN LastType := nil; OPCount := 0; Brack := FALSE; ok := TRUE; LOOP IF NOT ok THEN EXIT; END; Scan (WildString, PartString, Del, len, ',.():/'); IF len = NILL THEN ok := FALSE; EXIT; END; CASE Del OF ',': Insert (PartString, ok); IF NOT Brack THEN CASE LastType OF nil, dev: i:= 0; WHILE i < OPCount DO Copy (NamPuff[i], OPartPuff[i]); INC (NCount); INC (i); END; |nam: i:= 0; WHILE i < OPCount DO Copy (ExtPuff[i], OPartPuff[i]); INC (ECount); INC (i); END; ELSE ok := FALSE; END; EXIT; END; | '(': IF Brack THEN ok := FALSE; EXIT; ELSE Insert (PartString, ok); Brack := TRUE; NPCount := 0; END; | NUL, '/' : Insert (PartString, ok); IF Brack THEN OPartPuff := NPartPuff; OPCount := NPCount; END; IF ok THEN CASE LastType OF nil, dev: i:= 0; WHILE i < OPCount DO Copy (NamPuff[i], OPartPuff[i]); INC (NCount); INC (i); END; | nam: i:= 0; WHILE i < OPCount DO Copy (NamPuff[i], OPartPuff[i]); INC (NCount); INC (i); END; | nam: i:= 0; WHILE i < OPCount DO Copy (ExtPuff[i], OPartPuff[i]); INC (ECount); INC (i); END; ELSE ok := FALSE; END; END; EXIT; | ')': IF Brack THEN Insert (PartString, ok); Brack := FALSE; OPartPuff := NPartPuff; OPCount := NPCount; ELSE ok := FALSE; EXIT; END; | '.': IF Brack OR (LastType > dev) THEN ok := FALSE; EXIT; ELSE Insert (PartString, ok); IF ok THEN LastType := nam; i := 0; WHILE i < OPCount DO Copy (NamPuff[i], OPartPuff[i]); INC (NCount); INC (i); END; OPCount := 0; ELSE EXIT; END; END; | ':': IF Brack OR (LastType > nil) THEN ok := FALSE; EXIT; ELSE Insert (PartString, ok); IF ok THEN LastType := dev; i := 0; WHILE i < OPCount DO Copy (DevPuff[i], OPartPuff[i]); INC (DCount); INC (i); END; OPCount := 0; ELSE EXIT; END; END; END;(*CASE*) END;(*LOOP*) END GetFName; PROCEDURE GetWildList (VAR W: ARRAY OF CHAR; VAR Wild: ARRAY OF WildCard; VAR NWild: CARDINAL; ext: Ext; VAR ok: BOOLEAN); VAR i, j: CARDINAL; BEGIN DCount := 0; NCount := 0; ECount := 0; GetFName (W, ok); IF ok THEN IF DCount = 0 THEN DevPuff[DCount] := 'DK '; INC (DCount); ELSIF Mixed & NOT SubDir THEN Mixed := FALSE; DevPuff[0] := 'DK '; DCount := 1; END; IF NCount = 0 THEN NamPuff[NCount,0] := '*'; NamPuff[NCount,1] := NUL; INC (NCount); END; IF ECount = 0 THEN ExtPuff[ECount] := ext; INC (ECount); END; i := 0; WHILE i < NCount DO j := 0; WHILE j < ECount DO WITH Wild[NWild] DO n := NamPuff[i]; e := ExtPuff[j]; END; INC (j); INC (NWild); IF NWild > maxWild THEN ok := FALSE; WriteString (Write, ' ---- ERROR: too many wildcards'); RETURN; END; END; INC (i); END; END; END GetWildList; PROCEDURE ERROR (reply: INTEGER; file: FileName); VAR f: CARDINAL; BEGIN CASE reply OF -1 : WriteString (Write, ' ---- ERROR: no file-channel free'); |-2 : WriteString (Write, ' ---- ERROR: device/file not found : '); WriteFileName (Write, file, f); Writeln (Write); |-3 : WriteString (Write, ' ---- ERROR: no directory-structure : '); WriteFileName (Write, file, f); Writeln (Write); |-4 : WriteString (Write, ' ---- ERROR: wrong wildcard-format'); ELSE WriteString (Write, ' ---- ERROR: illegal device or handler not loaded : '); WriteFileName (Write, file, f); Writeln (Write); END; END ERROR; PROCEDURE GetFiles (W: WILDSTRING; VAR ok: BOOLEAN); VAR Len, z, OWild, NWild, f, b: CARDINAL; Wild: ARRAY[0..maxWild] OF WildCard; ext: Ext; OW: WILDSTRING; Del: CHAR; reply: INTEGER; BEGIN Scan (W, OW, Del, Len, '//'); W := OW; ext[0] := '*'; ext[1] := NUL; LOOP NWild := 0; IF Mixed THEN REPEAT OW := W; OWild := NWild; GetWildList (W, Wild, NWild, ext, ok); IF NOT ok THEN EXIT; END; UNTIL (Length (W) = 0) OR (NOT Mixed); IF NOT Mixed THEN NWild := OWild; FOR z := 0 TO HIGH (W) DO W[z] := OW[z]; END; IF NWild = 0 THEN GetWildList (W, Wild, NWild, ext, ok); IF NOT ok THEN EXIT; END; END; END; ELSE GetWildList (W, Wild, NWild, ext, ok); IF NOT ok THEN EXIT; END; END; IF NOT SubDir THEN NSubDir := 0; WHILE NSubDir < DCount DO SubDirFiles[NSubDir] := emptyFile; z := 0; WHILE (z <= DevLen) & (DevPuff[NSubDir,z] # NUL) DO SubDirFiles[NSubDir,z] := DevPuff[NSubDir,z]; INC (z); END; INC (NSubDir); END; END; z := 0; WHILE z < NSubDir DO FWILD (SubDirFiles[z], NWild, Wild, EXCLUDE, reply); ok := NOT ((-255 <= reply) & (reply < 0)); IF ok THEN WriteNames (SubDirFiles[z]); FCLOSE (f, b); ELSE ERROR (reply, SubDirFiles [z]); END; INC (z); END; IF (Length (W) = 0) THEN EXIT; END; END;(*LOOP*) END GetFiles; PROCEDURE GetSDir (VAR W: ARRAY OF CHAR; VAR ok: BOOLEAN); VAR k, z: CARDINAL; ext: Ext; DirFile: FileName; NWild, OWild: CARDINAL; Wild: ARRAY[0..maxWild] OF WildCard; size: CARDINAL; prot: BOOLEAN; t: Time; reply: INTEGER; BEGIN ext := 'DSK'; Mixed := FALSE; LOOP NWild := 0; GetWildList (W, Wild, NWild, ext, ok); IF NOT ok THEN EXIT; END; k := 0; WHILE k < DCount DO DirFile := emptyFile; z := 0; WHILE (z <= DevLen) & (DevPuff[k,z] # NUL) DO DirFile [z] := DevPuff[k,z]; INC (z); END; FWILD (DirFile, NWild, Wild, FALSE, reply); ok := NOT ((-255 <= reply) & (reply < 0)); IF NOT ok THEN ERROR (reply, DirFile); EXIT; END; WHILE ok DO FNEXT (SubDirFiles[NSubDir], size, prot, t, ok); IF ok THEN INC (NSubDir); END; END; FCLOSE (z, z); ok := TRUE; INC (k); END; IF Length (W) = 0 THEN EXIT; END; END;(*LOOP*) END GetSDir; PROCEDURE GetOptions (WildString: WILDSTRING; VAR ok: BOOLEAN); CONST maxOptLen = 12; TYPE OptText = ARRAY [0..maxOptLen - 1] OF CHAR; Option = RECORD minlen, maxlen: CARDINAL; text: OptText; END; VAR Del: CHAR; Len: CARDINAL; options: ARRAY OptKind OF Option; OptStr: OptText; Optkind: OptKind; PROCEDURE New; BEGIN GetTime (DATEnew); INCL (Options,new); END New; PROCEDURE Since; BEGIN IF Del = ':' THEN IX := 0;tempWS:=WildString; ReadDate (StringRead,NoEcho,DATEsince,ok,ch); IF (IX <= HIGH (WildString)) & (WildString[IX-1] # '/') & (WildString[IX-1] # NUL) THEN ok := FALSE; END; Scan (WildString, tempWS, Del, Len, '//'); ELSE ok := FALSE; END; IF NOT ok THEN WriteString (Write, ' ---- error in date: '); WriteString (Write, tempWS); Writeln (Write); ELSE INCL(Options, since); END; END Since; PROCEDURE Date; VAR sinceOpt: BOOLEAN; sinceDate: Time; BEGIN sinceOpt := OptionSet{since} <= Options; sinceDate := DATEsince; Since; IF ok THEN DATE := DATEsince; IF NOT sinceOpt THEN EXCL (Options, since); ELSE DATEsince:=sinceDate; END; INCL (Options, date); END; END Date; PROCEDURE Columns; BEGIN IF col IN Options THEN ok := FALSE; WriteString (Write, ' ---- ERROR: column-option defined twice'); Writeln (Write); ELSE IF Del = ':' THEN Scan (WildString, tempWS, Del, Len, '//'); ok := ('0' <= tempWS[0]) & (tempWS[0] <= '9') & (Len = 1); IF ok THEN COLUMNS := ORD(tempWS[0])-ORD('0'); INCL (Options, col); END; ELSE ok := FALSE; WriteString (Write, ' ---- error in column-option format'); Writeln (Write); END; END; END Columns; PROCEDURE Full; BEGIN FULL := FALSE; IF NOT (col IN Options) THEN COLUMNS := 5; END; INCL (Options, fast); INCL (Options, brief); END Full; PROCEDURE Subdir; BEGIN IF subdir IN Options THEN ok := FALSE; WriteString (Write, ' ---- ERROR: subdirectory-option defined twice'); Writeln (Write); ELSE IF Del = ':' THEN Scan (WildString, tempWS, Del, Len, '//'); GetSDir (tempWS, ok); SubDir := ok & (NSubDir > 0); IF ok THEN INCL (Options, subdir); ELSE WriteString (Write, ' ---- error in subdirectory-string'); Writeln (Write); END; ELSE ok := FALSE; WriteString (Write, ' ---- error in subdirectory-option format'); Writeln (Write); END; END; END Subdir; PROCEDURE Output; VAR fn: FileName; xx: BITSET; fnl: CARDINAL; ch: CHAR; BEGIN IF (output IN Options) OR (printer IN Options) THEN ok := FALSE; WriteString (Write, ' ---- ERROR: option conflict with output'); Writeln (Write); ELSE IF Del = ':' THEN IX := 0; tempWS := WildString; ReadFileName (StringRead, NoEcho, fn, 'DK XXXXXLST', xx, ch); ok := 1 IN xx; Scan (WildString, tempWS, Del, Len, '//'); IF ok THEN Channel (fn, TRUE, FALSE, FileOut, ok); IF ok THEN SetPut (FileOut); INCL (Options, output); ELSE WriteString (Write, " ---- ERROR: Can't open output-file "); WriteFileName (Write,fn,fnl); Writeln (Write); END; ELSE WriteString (Write, ' ---- error in output-parameter format'); Writeln (Write); END; ELSE ok := FALSE; WriteString (Write, ' ---- error in output-option format'); Writeln (Write); END; END; END Output; PROCEDURE Printer; BEGIN IF (output IN Options) OR (printer IN Options) THEN ok := FALSE; WriteString (Write, ' ---- ERROR: option conflict with printer'); Writeln (Write); ELSE Channel ('LP VIR LST', TRUE, FALSE, FileOut, ok); IF ok THEN SetPut (FileOut); INCL (Options, printer); ELSE WriteString (Write, " ---- ERROR: Can't open printer device LP:VIR.LST"); Writeln (Write); END; END; END Printer; PROCEDURE Exclude; BEGIN EXCLUDE := TRUE; END Exclude; PROCEDURE InitOpt (Optkind: OptKind; Opttext: OptText; min, max: CARDINAL); BEGIN WITH options [Optkind] DO text := Opttext; minlen := min; maxlen := max; END; END InitOpt; PROCEDURE FindOpt (VAR Opttext: OptText; OptLen: CARDINAL; VAR Optkind: OptKind); VAR found: BOOLEAN; ix: CARDINAL; BEGIN Optkind := new; found := FALSE; WHILE NOT found & (Optkind < illegal) DO WITH options [Optkind] DO IF (minlen <= OptLen) & (OptLen <= maxlen) THEN ix := 0; WHILE (ix < OptLen) & (Opttext[ix] = text[ix]) DO INC (ix); END; found := ix = OptLen; END; END; IF NOT found THEN INC (Optkind); END; END; END FindOpt; BEGIN SubDir := FALSE; ok := TRUE; FULL := TRUE; EXCLUDE := FALSE; COLUMNS := 2; NSubDir := 0; Scan (WildString, tempWS, Del, Len, '//'); IF Del = '/' THEN InitOpt (new, 'NEWFILES', 1, 8); InitOpt (since, 'SINCE', 2, 5); InitOpt (date, 'DATE', 1, 4); InitOpt (col, 'COLUMNS', 1, 7); InitOpt (brief, 'BRIEF', 1, 5); InitOpt (fast, 'FAST', 1, 4); InitOpt (subdir, 'SUBDIRECTORY', 2, 12); InitOpt (output, 'OUTPUT', 1, 6); InitOpt (printer, 'PRINTER', 1, 7); InitOpt (exclude, 'EXCLUDE', 1, 7); REPEAT Scan (WildString, OptStr, Del, Len, '/:'); IF (Len # 0) & (Len # NILL) THEN FindOpt (OptStr, Len, Optkind); CASE Optkind OF new : New; |since : Since; |date : Date; |col : Columns; |brief, fast : Full; |subdir : Subdir; |output : Output; |printer : Printer; |exclude : Exclude; |illegal : WriteString (Write, ' ---- illegal option : '); WriteString (Write, OptStr); Writeln (Write); ok := FALSE; END; ELSE ok := FALSE; END; UNTIL (Del = NUL) OR NOT ok; END; END GetOptions; BEGIN ok := TRUE; LOOP nf := 0; nbl := 0D; Writeln (Write); Mixed := TRUE; IF ok THEN WildString [0] := NUL; ELSE WriteString (Write, 'retype '); END; WriteString (Write, 'wildcard (default: DK:*.*): Dev:Name.Ext/Options >'); Writeln (Write); Retype (Read, Write, WildString, TRUE, TermString, ch); Writeln (Write); IF ch = ESC THEN EXIT; END; Options := OptionSet {}; GetOptions (WildString, ok); IF ok THEN GetFiles (WildString, ok); IF ok THEN ResetCtrlO; WriteString(Put, 'Files '); WriteCard (Put, nf, 7); WriteString(Put, ', Blocks'); WriteLong (Put,nbl, 7); END; IF (output IN Options) OR (printer IN Options) THEN DeChannel (FileOut, TRUE, TRUE); SetPut (TT); END; END; END; END VIR.
(Last revised 27-Oct-2015)
IMPRESSUM: The ModulAtor is an unrefereed journal. Technical papers are to be taken as working papers and personal rather than organizational statements; all source code is experimental — use at your own risk. Articles are published at the discretion of the Editor based upon his judgement on the interest and relevancy to the readership. Letters, announcements, and other items of professional interest are selected on the same basis. You're welcome to submit articles for publication by writing to the Editor

ModulaWare.com website navigator

[ Home | Site_index | Contact | Legal | OpenVMS_compiler | Alpha_Oberon_System | ModulAtor | Bibliography | Oberon[-2]_links | Modula-2_links | modulAware.com's Alpha Oberon System home page (Alignment Trap) | General book recommendations ]

Copyright © (2002-2016) by modulAware.com