C!T ROM 2/ctrom_ii_b.zip/ctrom_ii_b/PROGRAM/PASCAL/DU111/DU.MOD

Text File | 1991-10-29 | 14KB | 662 lines

MODULE du;

IMPORT FIO,IO,Lib,Str,SYSTEM;

TYPE
  String = ARRAY [0..255] OF CHAR;
  FileSpec = RECORD
    i : BOOLEAN;
    n : String;
  END;
  bs = SET OF [0..31];

CONST
  FileAttr = FIO.FileAttr{FIO.archive,FIO.hidden,FIO.system,FIO.directory};

  eol =
    CHAR(13)+CHAR(10);
  helptext =
    'du v1.11 (c) 1991 Arnt Gulbrandsen'+eol+eol+
    'du {options|filespec} {directory {options|filespecs}} '+eol+
    '/a -a  List individual file sizes'+eol+
    '/d -d  Debug'+eol+
    '/i -i  Include following filespecs'+eol+
    "/n -n  Don't include subdirectories in directory size"+eol+
    '/s -s  Sum only (like -0)'+eol+
    '/x -x  Exclude following filespecs'+eol+
    "/w -w  Show wasted space (in percent)"+eol+
    "/z -z  Don't show 0k directories / files"+eol+
    '/0...  Show only the top 0..65535 levels of the directory tree'+eol+
    '/? /h  Help'+eol+eol+
    'Filespecs may contain ? (any single character except /), * (0 or more'+eol+
    'chars), and [list] (matches any single character in the list).  The full'+eol+
    'stop is not special, *[a-cx]* will match any file containing A,B,C or'+eol+
    'X anywhere in the file name or extension.';

VAR
  opt_a,
  opt_d,
  opt_h,
  opt_n,
  opt_w,
  opt_z:BOOLEAN;
  max_depth,
  cur_depth:CARDINAL;
  IncludeAll,
  include:BOOLEAN;

  Specs : ARRAY [0..99] OF FileSpec;
  FileSpecs : CARDINAL;

  stepup ,
  granularity : LONGCARD;




PROCEDURE Match(VAR a,b: String):BOOLEAN;

  PROCEDURE Test(p,q:CARDINAL):BOOLEAN;
  VAR
    f:BOOLEAN;
    r:CARDINAL;
  BEGIN
    IF (p=0) AND (q=0) THEN
      RETURN(TRUE);
    ELSIF (p=0) AND (b[q-1]='/') THEN
      RETURN(TRUE);
    ELSIF (p=0) OR (q=0) THEN
      RETURN(FALSE);
    ELSE
      DEC(p);
      DEC(q);
      CASE a[p] OF
        |'?':
          RETURN(Test(p,q));
        |'*':
          r:=q;
          REPEAT
            IF b[r]='/' THEN
              f:=(p=0);
            ELSE
              f:=Test(p,r);
            END;
            IF r>0 THEN
              DEC(r);
            END;
          UNTIL f OR (r=0);
          RETURN(f);
        |']':
          r:=p;
          WHILE (a[r]#'[') AND (r>0) DO
            DEC(r);
          END;
          INC(r);
          f:=FALSE;
          WHILE NOT(f) AND (r<p) DO
            IF a[r+1]='-' THEN
              f:=(a[r]<=b[q]) AND (a[r+2]>=b[q]);
            ELSE
              f:=(a[r]=b[q]);
            END;
            INC(r);
          END;
          RETURN(f);
      ELSE
        RETURN((a[p]=b[q]) AND Test(p,q));
      END;
    END;
  END Test;

BEGIN
  RETURN(Test(Str.Length(a),Str.Length(b)));
END Match;



PROCEDURE Print(TrueSize,NominalSize:LONGCARD;VAR name:String;dir:BOOLEAN);

  PROCEDURE PrintWasted;
  BEGIN
    IF opt_w THEN
      IF TrueSize>0 THEN
        IO.WrLngCard(LONGCARD(LONGREAL(TrueSize-NominalSize)*100.0/LONGREAL(TrueSize)),2);
        IO.WrStr('.');
        IO.WrLngCard(LONGCARD(LONGREAL(TrueSize-NominalSize)*10005.0/LONGREAL(TrueSize)/10.0) MOD 10,1);
      ELSE
        IO.WrStr(' 0.0');
      END;
      IO.WrStr('%  ');
    END;
  END PrintWasted;

BEGIN
  IF dir THEN
    IF (cur_depth<=max_depth) AND (NOT(opt_z) OR (TrueSize>0)) THEN
      IO.WrLn;
      IO.WrLngCard(TrueSize DIV 1024,7);
      IO.WrStr('k  ');
      PrintWasted;
      IO.WrStr(name);
    END;
  ELSE
    IF opt_a AND (NOT(opt_z) OR (TrueSize>0)) THEN
      IO.WrLn;
      IO.WrLngCard(TrueSize DIV 1024,7);
      IO.WrStr('k  ');
      PrintWasted;
      IO.WrStr(name);
    END;
  END;
END Print;



PROCEDURE ScanDirectory(dir:String;VAR TrueSize,NominalSize:LONGCARD);
VAR
  filedata:FIO.DirEntry;
  NominalFileSize,
  TrueFileSize : LONGCARD;
  file : String;
  foo : BOOLEAN;
  bar : CARDINAL;
BEGIN
  INC(cur_depth);
  Str.Concat(file,dir,'*.*');
  NominalSize:=0;
  TrueSize:=0;
  IF FIO.ReadFirstEntry(file,FileAttr,filedata) THEN
    REPEAT
      Str.Lows(filedata.Name);
      IF IncludeAll THEN
        INC(NominalSize,32);
        INC(TrueSize,32);
      END;
      TrueFileSize:=0;
      NominalFileSize:=0;
      IF
        (Str.Compare(filedata.Name,'.')#0)
      AND
        (Str.Compare(filedata.Name,'..')#0)
      THEN
        Str.Concat(file,dir,filedata.Name);
        IF FIO.directory IN filedata.attr THEN
          Str.Append(file,'/');
          ScanDirectory(file,TrueFileSize,NominalFileSize);
          Print(TrueFileSize,NominalFileSize,file,TRUE);
          IF opt_n THEN
            TrueFileSize:=0;
            NominalFileSize:=0;
          END;
        ELSE
          foo:=IncludeAll;
          FOR bar:=1 TO FileSpecs DO
            IF Specs[bar].i THEN
              foo:=foo OR Match(Specs[bar].n,file);
            ELSE
              foo:=foo AND NOT(Match(Specs[bar].n,file));
            END;
          END;
          IF foo THEN
            NominalFileSize:=filedata.size;
            TrueFileSize:=LONGCARD(bs(filedata.size+stepup)*bs(granularity));
            Print(TrueFileSize,NominalFileSize,file,FALSE);
          END;
        END;
      END;
      INC(TrueSize,TrueFileSize);
      INC(NominalSize,NominalFileSize);
    UNTIL NOT(FIO.ReadNextEntry(filedata));
  END;
  DEC(cur_depth);
  TrueSize:=LONGCARD(bs(TrueSize+stepup)*bs(granularity));
END ScanDirectory;




PROCEDURE IsFilespec(VAR a:String):BOOLEAN;
VAR
  p:CARDINAL;
  f:BOOLEAN;
BEGIN
  p:=0;
  f:=(a[0]#CHAR(0)) AND (a[0]#'/');
  WHILE f AND (a[p]#CHAR(0)) DO
    IF a[p]='\' THEN
      a[p]:='/';
    END;
    f:=f AND (a[p] IN Str.CHARSET{'0'..'9','a'..'z','.','/','[','?','*'});
    IF a[p]='[' THEN
      REPEAT
        INC(p);
        f:=f AND (a[p]#CHAR(0)) AND (a[p]#'[') AND (a[p]#'-');
        IF f AND (a[p+1]='-') AND (a[p+2]#']') THEN
          INC(p);
        END;
        INC(p);
      UNTIL NOT(f) OR (a[p]=']');
    END;
    INC(p);
  END;
  RETURN(f);
END IsFilespec;



PROCEDURE IsDirectory(a:String):BOOLEAN;

  (*
   * I copied the FIO ReadFirstEntry / ReadNextEntry
   * and deleted some error checking so ReadFirstEntry
   * doesn't burp on being given a nonsense path
   * like -a or *.zip
   *)

  PROCEDURE ReadFirstEntry ( DirName : ARRAY OF CHAR;
                             Attr    : FIO.FileAttr;
                             VAR D   : FIO.DirEntry) : BOOLEAN;
  VAR
    r  : SYSTEM.Registers;
  BEGIN
    WITH r DO
      AH := 1AH;
      DS := Seg(D);
      DX := Ofs(D);
      Lib.Dos(r);    (* set DTA *)
      AH := 4EH;
      DS := Seg(DirName);
      DX := Ofs(DirName);
      CL := SHORTCARD(Attr);
      CH := SHORTCARD(0);
      Lib.Dos(r);
      IF (BITSET{SYSTEM.CarryFlag} * Flags) # BITSET{} THEN
        RETURN FALSE;
      END;
    END;
    RETURN TRUE;
  END ReadFirstEntry;

  PROCEDURE ReadNextEntry(VAR D: FIO.DirEntry) : BOOLEAN;
  VAR
    r : SYSTEM.Registers;
  BEGIN
    WITH r DO
      AH := 1AH;
      DS := Seg(D);
      DX := Ofs(D);
      Lib.Dos(r);    (* set DTA *)
      AH := 4FH;
      Lib.Dos(r);
      IF (BITSET{SYSTEM.CarryFlag} * Flags) # BITSET{} THEN
        RETURN FALSE;
      END;
    END;
    RETURN TRUE;
  END ReadNextEntry;


VAR
  d:FIO.DirEntry;
  foo:String;
BEGIN
  IF (Str.CharPos(a,'*')<65535) THEN
    RETURN(FALSE);
  END;
  IF (Str.CharPos(a,'[')<65535) THEN
    RETURN(FALSE);
  END;
  IF (Str.CharPos(a,'?')<65535) THEN
    RETURN(FALSE);
  END;
  IF ReadFirstEntry(a,FileAttr,d) AND (FIO.directory IN d.attr) THEN
    RETURN(TRUE);
  ELSE
    IF (a[Str.Length(a)-1] IN Str.CHARSET{'/','\'}) THEN
      Str.Concat(foo,a,'*.*');
    ELSE
      Str.Concat(foo,a,'/*.*');
    END;
    RETURN(ReadFirstEntry(foo,FileAttr,d));
  END;
END IsDirectory;


PROCEDURE IsSwitch(a:String):BOOLEAN;
VAR
  foo,
  bar:CARDINAL;
  valid:BOOLEAN;
BEGIN
  IF Str.Length(a)>1 THEN
    IF (a[0]='-') OR (a[0]='/') THEN
      valid:=TRUE;
      bar:=0;
      FOR foo:=1 TO Str.Length(a)-1 DO
        IF (a[foo]>='0') AND (a[foo]<='9') THEN
          IF (bar>6553) OR ( (bar=6553) AND (a[foo]>'5') ) THEN
            valid:=FALSE;
          ELSE
            bar:=bar*10+(CARDINAL(a[foo])-48);
          END;
        ELSIF a[foo] IN Str.CHARSET{'a','s','d','h','?','w','z','i','x','n'} THEN
          bar:=0;
        ELSE
          valid:=FALSE;
        END;
      END;
    ELSE
      valid:=FALSE;
    END;
  ELSE
    valid:=FALSE;
  END;
  RETURN(valid);
END IsSwitch;



PROCEDURE CheckArgs();
VAR
  argno,
  argv:CARDINAL;
  arg:String;
BEGIN
  opt_d:=FALSE;
  opt_h:=FALSE;
  argv:=Lib.ParamCount();
  FOR argno:=1 TO argv DO
    Lib.ParamStr(arg,argno);
    IF IsSwitch(arg) THEN
      IF IsDirectory(arg) THEN
        IO.WrLn;
        IO.WrStr(arg);
        IO.WrStr(' is valid both as switch and base directory.');
        Lib.SetReturnCode(2);
        HALT;
      ELSIF IsFilespec(arg) THEN
        IO.WrLn;
        IO.WrStr(arg);
        IO.WrStr(' is valid both as switch and file specification.');
        Lib.SetReturnCode(2);
        HALT;
      ELSE
        IF Str.CharPos(arg,'d')<MAX(CARDINAL) THEN
          opt_d:=TRUE;
        END;
        IF Str.CharPos(arg,'h')<MAX(CARDINAL) THEN
          opt_h:=TRUE;
        END;
      END;
    ELSIF IsDirectory(arg) THEN
      (* all dirs are filespecs also so don't try IsFilespec *)
    ELSIF IsFilespec(arg) THEN
      (* no action necessary *)
    ELSE
      IO.WrLn;
      IO.WrStr(arg);
      IO.WrStr(" isn't a valid argument.");
      Lib.SetReturnCode(2);
      HALT;
    END;
  END;
  IF opt_d THEN
    IO.WrLn;
    IO.WrStr('Command line arguments:');
    FOR argno:=1 TO argv DO
      Lib.ParamStr(arg,argno);
      IO.WrLn;
      IO.WrStr('  "');
      IO.WrStr(arg);
      IF IsDirectory(arg) THEN
        IO.WrStr('" is a base directory');
      ELSIF IsSwitch(arg) THEN
        IO.WrStr('" is a switch');
      ELSE
        IO.WrStr('" is a file specification');
      END;
    END;
  END;
END CheckArgs;




PROCEDURE SetFlags(a:String);
VAR
  foo:CARDINAL;
  bar:BOOLEAN;
BEGIN
  bar:=FALSE;
  FOR foo:=1 TO Str.Length(a) DO
    CASE a[foo] OF
      |'a':
        opt_a:=TRUE;
        bar:=FALSE;
      |'s':
        max_depth:=0;
        bar:=FALSE;
      |'d':
        bar:=FALSE;
      |'h','?':
        bar:=FALSE;
      |'w':
        opt_w:=TRUE;
        bar:=FALSE;
      |'z':
        opt_z:=TRUE;
        bar:=FALSE;
      |'x':
        include:=FALSE;
        bar:=FALSE;
      |'i':
        include:=TRUE;
        bar:=FALSE;
      |'n':
        opt_n:=TRUE;
        bar:=FALSE;
      |'0'..'9':
        IF NOT(bar) THEN
          max_depth:=0;
        END;
        max_depth:=max_depth*10+(CARDINAL(a[foo])-48);
        bar:=TRUE;
    END;
  END;
END SetFlags;



PROCEDURE FindClusterSize(dir:String);
VAR
  r : SYSTEM.Registers;
BEGIN
  IF (Str.Length(dir)>2) AND (dir[1]=':') THEN
    r.DL:=SHORTCARD(dir[0])-96;
  ELSE
    r.DL:=0;
  END;
  r.AH:=36H;
  Lib.Dos(r);
  IF r.AX=0FFFFH THEN
    stepup:=1023;
  ELSE
    stepup:=LONGCARD(r.AX*r.CX-1);
  END;
  granularity:=MAX(LONGCARD)-stepup;
END FindClusterSize;




PROCEDURE ParseArgs();
VAR
  argv,
  argno : CARDINAL;
  arg : String;

  s_depth : CARDINAL;
  s_a,
  s_n,
  s_w,
  s_z,
  s_inc : BOOLEAN;

  base : String;

  lastglobalfs : CARDINAL;

  PROCEDURE DoScan();
  VAR
    TrueSize,
    NominalSize : LONGCARD;

    foo:CARDINAL;
    bar:LONGCARD;
  BEGIN
    IncludeAll:=TRUE;
    FOR foo:=1 TO FileSpecs DO
      IF Specs[foo].i THEN
        IncludeAll:=FALSE;
      END;
    END;
    IF base[Str.Length(base)-1]#'/' THEN
      Str.Append(base,'/');
    END;
    IF opt_d THEN
      IO.WrLn;
      IO.WrLn;
      IO.WrStr('Base directory: ');
      IO.WrStr(base);
      IO.WrLn;
      IO.WrStr('  Switches: ');
      IF opt_a THEN
        IO.WrStr('a ');
      END;
      IF opt_n THEN
        IO.WrStr('n ');
      END;
      IF opt_w THEN
        IO.WrStr('w ');
      END;
      IF opt_z THEN
        IO.WrStr('z ');
      END;
      IO.WrLn;
      IO.WrStr('  List depth:');
      IO.WrCard(max_depth,6);
      IF IncludeAll THEN
        IO.WrLn;
        IO.WrStr('  Include all files');
      END;
      FOR foo:=1 TO FileSpecs DO
        IO.WrLn;
        IF Specs[foo].i THEN
          IO.WrStr('  Include: ');
        ELSE
          IO.WrStr('  Exclude: ');
        END;
        IO.WrStr(Specs[foo].n);
      END;
    ELSE
      FindClusterSize(base);
      ScanDirectory(base,TrueSize,NominalSize);
      Print(TrueSize,NominalSize,base,TRUE);
    END;
  END DoScan;

  PROCEDURE FixAppearance();
  VAR
    foo:CARDINAL;
  BEGIN
    foo:=0;
    WHILE arg[foo]#CHAR(0) DO
      IF arg[foo]='\' THEN
        arg[foo]:='/';
      ELSIF (arg[foo]>='A') AND (arg[foo]<='Z') THEN
        arg[foo]:=CHAR(CARDINAL(arg[foo])+32);
      END;
      INC(foo);
    END;
  END FixAppearance;

BEGIN
  opt_a:=FALSE;
  opt_n:=FALSE;
  opt_w:=FALSE;
  opt_z:=FALSE;
  include:=TRUE;
  max_depth:=65535;
  base:='.';
  FileSpecs:=0;
  argv:=Lib.ParamCount();
  argno:=0;
  WHILE argno<argv DO
    INC(argno);
    Lib.ParamStr(arg,argno);
    IF IsSwitch(arg) THEN
      SetFlags(arg);
    ELSE
      FixAppearance;
      IF IsDirectory(arg) THEN
        IF Str.Compare(base,'.')#0 THEN
          DoScan;
          opt_a:=s_a;
          opt_n:=s_n;
          opt_w:=s_w;
          opt_z:=s_z;
          include:=s_inc;
          max_depth:=s_depth;
          FileSpecs:=lastglobalfs;
        END;
        base:=arg;
        s_a:=opt_a;
        s_n:=opt_n;
        s_w:=opt_w;
        s_z:=opt_z;
        s_inc:=include;
        s_depth:=max_depth;
        lastglobalfs:=FileSpecs;
      ELSE
        INC(FileSpecs);
        Specs[FileSpecs].i:=include;
        Specs[FileSpecs].n:=arg;
      END;
    END;
  END;
  DoScan;
END ParseArgs;



BEGIN
  CheckArgs;
  IF opt_h THEN
    IO.WrLn;
    IO.WrStr(helptext);
    Lib.SetReturnCode(1);
  ELSE
    ParseArgs;
    Lib.SetReturnCode(0);
  END;
  IO.WrLn;
END du.