system/std.zusatz/1.8.7/src/purge

Raw file
Back to index

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
PACKET purge DEFINES purge :

 
TEXT VAR task name, record, file name, dummy ;

FILE VAR permit ;


PROC purge :

  IF exists ("permitted tasks")
    THEN access catalogue ;
         permit := sequential file (input, "permitted tasks") ;
         say (""10""13"TASKS :"10""10""13"") ;
         IF myself < supervisor
           THEN purge son tasks (brother (supervisor))
           ELSE purge son tasks (myself)
         FI
  FI ;
  IF exists ("permitted files")
    THEN permit := sequential file (input, "permitted files") ;
         say (""10""13"DATEIEN :"10""10""13"") ;
         purge files
  FI

ENDPROC purge ;

PROC purge son tasks (TASK CONST father task) :

  TASK VAR actual task := son (father task) ;
  WHILE NOT is niltask (actual task) REP
    purge son tasks (actual task) ;
    IF NOT actual task permitted
      THEN erase actual task
    FI ;
    actual task := brother (actual task)
  END REP .

erase actual task :
  say ("""") ; say (task name) ; say ("""") ;
  IF yes (" loeschen")
    THEN end (actual task)
  FI .

actual task permitted :
  task name := name (actual task) ;
  reset (permit) ;
  WHILE NOT eof (permit) REP
    getline (permit, record) ;
    IF task name = record
      THEN LEAVE actual task permitted WITH TRUE
    FI
  END REP ;
  FALSE .

ENDPROC purge son tasks ;

PROC purge files :

  begin list ;
  get list entry (file name, dummy) ;
  WHILE file name <> "" REP
    IF NOT file permitted
      THEN forget (file name)
    FI ;
    get list entry (file name, dummy)
  END REP .

file permitted :
  IF file name = "permitted tasks" OR file name = "permitted files"
    THEN LEAVE file permitted WITH TRUE
  FI ;
  reset (permit) ;
  WHILE NOT eof (permit) REP
    getline (permit, record) ;
    IF file name = record
      THEN LEAVE file permitted WITH TRUE
    FI
  END REP ;
  FALSE .

ENDPROC purge files ;

ENDPACKET purge ;