home *** CD-ROM | disk | FTP | other *** search
/ Crawly Crypt Collection 1 / crawlyvol1.bin / program / compiler / m2posx14 / test / listdir.mpp < prev    next >
Encoding:
Text File  |  1994-05-29  |  8.2 KB  |  320 lines
  1. MODULE ListDir;
  2. __IMP_SWITCHES__
  3. __DEBUG__
  4. #ifdef HM2
  5. #ifdef __LONG_WHOLE__
  6. (*$!i+: Modul muss mit $i- uebersetzt werden! *)
  7. (*$!w+: Modul muss mit $w- uebersetzt werden! *)
  8. #else
  9. (*$!i-: Modul muss mit $i+ uebersetzt werden! *)
  10. (*$!w-: Modul muss mit $w+ uebersetzt werden! *)
  11. #endif
  12. #endif
  13. (* Test und Anwendungsbeispiel fuer die Verzeichnisprozeduren
  14.  *
  15.  * Benutzung: listdir [ Muster [ Verzeichnis ... ]]
  16.  *
  17.  * Vorsicht beim Aufruf in einer Kommandoshell: Das Muster muss hier
  18.  * ``gequoted'' werden!
  19.  * Bei der Angabe des Musters ist zu beachten, dass zwischen Gross- und
  20.  * Kleinschreibung unterschieden wird.
  21.  *
  22.  * Die Variablen fuer Pfade und Dateinamen sind der Einfachheit halber
  23.  * alle statisch. In einem richtigen Programm muesste die maximale
  24.  * Laenge der Pfade und Dateinamen mit "pathconf()" ermittelt
  25.  * und dann entsprechend Speicher dynamisch angefordert werden.
  26.  *
  27.  * 29-Mai-94, Holger Kleinschmidt
  28.  *)
  29.  
  30. #if (defined MM2) && (defined __DEBUG_CODE__)
  31. IMPORT Debug;
  32. #endif
  33.  
  34. VAL_INTRINSIC
  35. CAST_IMPORT
  36. PTR_ARITH_IMPORT
  37.  
  38. FROM SYSTEM IMPORT
  39. (* TYPE *) ADDRESS,
  40. (* PROC *) ADR;
  41.  
  42. FROM PORTAB IMPORT
  43. (* CONST*) NULL,
  44. (* TYPE *) WORDSET, SIGNEDWORD, UNSIGNEDWORD, UNSIGNEDLONG;
  45.  
  46. IMPORT e;
  47.  
  48. FROM types IMPORT
  49. (* CONST*) PATHMAX, EOS,
  50. (* TYPE *) FileName, PathName, StrPtr, offT;
  51.  
  52. FROM file IMPORT
  53. (* TYPE *) FileModes, modeT, StatRec,
  54. (* PROC *) stat, lstat, sISCHR, sISDIR, sISBLK, sISREG, sISFIFO, sISLNK;
  55.  
  56. FROM dir IMPORT
  57. (* TYPE *) DIR, DirentPtr, DirentRec,
  58. (* PROC *) opendir, readdir, rewinddir, closedir, telldir, readlink;
  59.  
  60. FROM proc IMPORT
  61. (* PROC *) chdir, getcwd;
  62.  
  63. FROM cmdline IMPORT
  64. (* PROC *) ArgCount, GetArg;
  65.  
  66. FROM cstr IMPORT
  67. (* PROC *) AssignCToM2, strerror;
  68.  
  69. FROM pSTRING IMPORT
  70. (* PROC *) COMPARE;
  71.  
  72. FROM POSIX2 IMPORT
  73. (* TYPE *) FNMFlags,
  74. (* PROC *) fnmatch;
  75.  
  76. FROM lib IMPORT
  77. (* PROC *) qsort;
  78.  
  79. FROM InOut IMPORT
  80. (* PROC *) Read, Write, WriteString, WriteLn, WriteCard;
  81.  
  82. FROM pOUT IMPORT
  83. (* PROC *) PutCard;
  84.  
  85. (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
  86.  
  87. CONST
  88.   MAXCOUNT = 511;
  89.  
  90. VAR
  91.   CWD   : PathName;
  92.   list  : ARRAY [0..MAXCOUNT] OF RECORD
  93.             name : FileName;
  94.             off  : offT;
  95.           END;
  96.  
  97. (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
  98. #ifdef HM2
  99. (*$E+ Prozedur als Parameter erlaubt *)
  100. #endif
  101. PROCEDURE CompStr ((* EIN/ -- *) cmp1 : ADDRESS;
  102.                    (* EIN/ -- *) cmp2 : ADDRESS ): INTEGER;
  103.  
  104. VAR p1, p2 : POINTER TO FileName;
  105.  
  106. BEGIN
  107.  p1 := cmp1;
  108.  p2 := cmp2;
  109.  RETURN(COMPARE(p1^, p2^));
  110. END CompStr;
  111. #ifdef HM2
  112. (*$E=*)
  113. #endif
  114.  
  115. (*---------------------------------------------------------------------------*)
  116.  
  117. PROCEDURE DoList ((* EIN/ -- *) dir     : PathName;
  118.                   (* EIN/ -- *) pattern : ARRAY OF CHAR );
  119.  
  120. CONST SEP = "==============================================";
  121.  
  122. VAR void    : INTEGER;
  123.     dirp    : DIR;
  124.     dp      : DirentPtr;
  125.     count   : SIGNEDWORD;
  126.     i       : SIGNEDWORD;
  127.     symlink : BOOLEAN;
  128.     errstr  : ARRAY [0..40] OF CHAR;
  129.     attr    : ARRAY [0..11] OF CHAR;
  130.     st      : StatRec;
  131.     t       : CHAR;
  132.     total   : offT;
  133.     offset  : offT;
  134.     file    : FileName;
  135.     link    : PathName;
  136.     llen    : INTEGER;
  137.  
  138. BEGIN
  139.   WriteString("Dateimuster: "); WriteString(pattern); WriteLn;
  140.   WriteString("Verzeichnis: "); WriteString(dir); WriteLn;
  141.  
  142.   dirp := opendir(dir);
  143.   IF dirp = NULL THEN
  144.     AssignCToM2(strerror(e.errno), 0, errstr);
  145.     WriteString("opendir: "); WriteString(errstr); WriteLn;
  146.     RETURN;
  147.   END;
  148.  
  149.   count  := 0;
  150.   offset := telldir(dirp);
  151.   dp     := readdir(dirp);
  152.   WHILE dp <> NULL DO
  153.     AssignCToM2(dp^.dName, 0, file);
  154.     IF fnmatch(file, pattern, FNMFlags{}) = 0 THEN
  155.       IF count < MAXCOUNT THEN
  156.         list[count].name := file;
  157.         list[count].off  := offset;
  158.         INC(count);
  159.       ELSE
  160.         void := closedir(dirp);
  161.         void := chdir(CWD);
  162.         WriteString("DoList: tab overflow"); WriteLn;
  163.         RETURN;
  164.       END;
  165.     END; (* IF fnmatch() *)
  166.     offset := telldir(dirp);
  167.     dp     := readdir(dirp);
  168.   END;
  169.   void := closedir(dirp);
  170.  
  171.   qsort(ADR(list),
  172.         VAL(UNSIGNEDLONG,count),
  173.         VAL(UNSIGNEDLONG,ABS(DIFADR(ADR(list[1]), ADR(list[0])))),
  174.         CompStr);
  175.  
  176.   WriteString("  # Dateien: "); WriteCard(VAL(CARDINAL,count), 0); WriteLn;
  177.   WriteLn;
  178.   WriteString(" inode       attr lnk  uid  gid   pos     size"); WriteLn;
  179.   WriteString(SEP); WriteLn;
  180.   void  := chdir(dir); (* damit "lstat()" die Dateien findet *)
  181.   total := 0;
  182.   FOR i := 0 TO count - 1 DO
  183.     IF lstat(list[i].name, st) < 0 THEN
  184.       AssignCToM2(strerror(e.errno), 0, errstr);
  185.       WriteString("lstat: "); WriteString(list[i].name); WriteString(": ");
  186.       WriteString(errstr); WriteLn;
  187.     ELSE
  188.       WITH st DO
  189.         attr    := " ----------";
  190.         t       := ' ';
  191.         symlink := FALSE;
  192.  
  193.         IF sISREG(stMode) THEN
  194.           IF sIXUSR IN stMode THEN
  195.             t := '*';
  196.           END;
  197.         ELSIF sISDIR(stMode) THEN
  198.           attr[1] := 'd'; t := '/';
  199.         ELSIF sISCHR(stMode) THEN
  200.           attr[1] := 'c';
  201.         ELSIF sISLNK(stMode) THEN
  202.           attr[1] := 'l'; symlink := TRUE;
  203.         ELSIF sISFIFO(stMode) THEN
  204.           attr[1] := 'p'; t := '|';
  205.         ELSIF sISBLK(stMode) THEN
  206.           attr[1] := 'b';
  207.         ELSE
  208.           attr[1] := '?';
  209.         END;
  210.  
  211.         IF sIRUSR IN stMode THEN
  212.           attr[2] := 'r';
  213.         END;
  214.         IF sIRGRP IN stMode THEN
  215.           attr[5] := 'r';
  216.         END;
  217.         IF sIROTH IN stMode THEN
  218.           attr[8] := 'r';
  219.         END;
  220.         IF sIWUSR IN stMode THEN
  221.           attr[3] := 'w';
  222.         END;
  223.         IF sIWGRP IN stMode THEN
  224.           attr[6] := 'w';
  225.         END;
  226.         IF sIWOTH IN stMode THEN
  227.           attr[9] := 'w';
  228.         END;
  229.         IF sIXUSR IN stMode THEN
  230.           attr[4] := 'x';
  231.         END;
  232.         IF sIXGRP IN stMode THEN
  233.           attr[7] := 'x';
  234.         END;
  235.         IF sIXOTH IN stMode THEN
  236.           attr[10] := 'x';
  237.         END;
  238.         PutCard(stIno, 6);
  239.         WriteString(attr);
  240.         Write(' ');
  241.         WriteCard(VAL(CARDINAL,stNlink), 3);
  242.         Write(' ');
  243.         WriteCard(VAL(CARDINAL,stUid), 4);
  244.         Write(' ');
  245.         WriteCard(VAL(CARDINAL,stGid), 4);
  246.         Write(' ');
  247.         WriteCard(VAL(CARDINAL,list[i].off), 5);
  248.         Write(' ');
  249.         PutCard(stSize, 8);
  250.         INC(total, stSize);
  251.         Write(' ');
  252.         WriteString(list[i].name); Write(t);
  253.         IF symlink THEN
  254.           WriteString("-> ");
  255.           llen := readlink(list[i].name, CAST(StrPtr,ADR(link)), PATHMAX);
  256.           IF llen < 0 THEN
  257.             AssignCToM2(strerror(e.errno), 0, errstr);
  258.             WriteString("readlink: "); WriteString(errstr);
  259.           ELSE
  260.             link[VAL(UNSIGNEDWORD,llen)] := EOS;
  261.             WriteString(link);
  262.             IF stat(list[i].name, st) < 0 THEN
  263.               AssignCToM2(strerror(e.errno), 0, errstr);
  264.               WriteString("stat: "); WriteString(errstr);
  265.             ELSIF sISREG(stMode) AND (sIXUSR IN stMode) THEN
  266.               Write('*');
  267.             ELSIF sISDIR(stMode) THEN
  268.               Write('/');
  269.             ELSIF sISFIFO(stMode) THEN
  270.               Write('|');
  271.             END;
  272.           END;
  273.         END;
  274.         WriteLn;
  275.       END; (* WITH *)
  276.     END; (* IF lstat *)
  277.   END; (* FOR *)
  278.   WriteString(SEP); WriteLn;
  279.   PutCard(total, 46);
  280.   WriteString(" Bytes total"); WriteLn;
  281.   void := chdir(CWD);
  282. END DoList;
  283.  
  284. (*===========================================================================*)
  285.  
  286. VAR
  287.   voidp : StrPtr;
  288.   i     : INTEGER;
  289.   ch    : CHAR;
  290.   argc  : INTEGER;
  291.   DIRS  : PathName;
  292.   PAT   : PathName;
  293.  
  294. BEGIN
  295.   voidp := getcwd(CAST(StrPtr,ADR(CWD)), PATHMAX+1);
  296.   WriteString("akt. Verzeichnis: ");
  297.   WriteString(CWD);
  298.   WriteLn;
  299.   WriteLn;
  300.  
  301.   DIRS := ".";
  302.   PAT  := "*";
  303.  
  304.   argc := ArgCount();
  305.   IF argc <= 1 THEN
  306.     DoList(DIRS, PAT);
  307.   ELSIF argc <= 2 THEN
  308.     GetArg(1, PAT);
  309.     DoList(DIRS, PAT);
  310.   ELSE
  311.     GetArg(1, PAT);
  312.     FOR i := 2 TO argc - 1 DO
  313.       GetArg(i, DIRS);
  314.       DoList(DIRS, PAT);
  315.       WriteLn;
  316.     END;
  317.   END;
  318.   Read(ch);
  319. END ListDir.
  320.