1 /* ***********************************************************
  2    *                                                         *
  3    * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  4    *                                                         *
  5    *********************************************************** */
  6 move_quota: movequota: mq: proc;
  7 
  8 /* Implements the get_quota and move_quota commands and the get_quota active function. */
  9 /* Coded November 1969 by M.R. Thompson */
 10 /* Converted to pl1 1970 J.W. Gintell */
 11 /* Star convention added September 1971 J. W. Gintell */
 12 /* Converted to Version 2 December 1971 J.W. Gintell */
 13 /* Removed set_quota entry point to tools May 1975 J. Whitmore */
 14 /* Extra blank line removed from output 07/14/76 S. Herbst */
 15 /* Rewrote, added gq af and -quota, -records_left, -records_used 09/29/82 S. Herbst */
 16 /* Fixed to print table when multiple paths specified 10/29/82 S. Herbst */
 17 /* Fixed error message for invalid numeric arg 01/03/83 S. Herbst */
 18 /* Fixed bug in gq active function 03/17/83 S. Herbst */
 19 /* Fixed -rec_left on link to use target's parent quota not link's parent quota 07/06/84 S. Herbst */
 20 /* Added -nonzero, -total, -zero 07/06/84 S. Herbst */
 21 /* Changed -all to print trp price at current rate structure 07/09/84 S. Herbst */
 22 /* Added -sort 07/12/84 S. Herbst */
 23 /* Fixed bug truncating record-days to an integer 11/15/84 Steve Herbst */
 24 /* Fixed -long to align its output data in a column 11/26/84 Steve Herbst */
 25 /* Fixed bug in error message when no directories match a starname 02/15/85 Steve Herbst */
 26 
 27 
 28 /* Constants */
 29 
 30 dcl NO_ACCESS fixed bin int static options (constant) init (-1);
 31 dcl (QUOTA init (1), RECORDS_LEFT init (2), RECORDS_USED init (3)) fixed bin int static options (constant);
 32 
 33 /* Based */
 34 
 35 dcl area area based (area_ptr);
 36 
 37 dcl 1 node aligned based,
 38    2 sort_value fixed bin (35),
 39    2 next ptr,
 40    2 info,
 41     3 path char (168) unaligned,
 42     3 lvname char (36),
 43     3 trp fixed bin (71),
 44     3 time_updated fixed bin (36),
 45     3 (terminal_quota, quota_value, records_left, records_used) fixed bin;
 46 
 47 dcl arg char (arg_len) based (arg_ptr);
 48 dcl return_arg char (return_len) varying based (return_ptr);
 49 
 50 /* Automatic */
 51 
 52 dcl (dn, path) char (168);
 53 dcl lvname_string char (36);
 54 dcl (default_lvname, en, lvname, me, time_string) char (32);
 55 
 56 dcl sons_lvid bit (36);
 57 dcl (af_sw, dir_quota_sw, long_sw, nonzero_sw, print_header_sw, quota_sw, records_left_sw, records_used_sw) bit (1);
 58 dcl (some_matches, some_nonzero, some_zero, sort_sw, star_sw, total_sw, type_specified_sw, wdir_sw, zero_sw) bit (1);
 59 
 60 dcl (area_ptr, arg_ptr, first_node_ptr, last_node_ptr, p, return_ptr) ptr;
 61 
 62 dcl rate_structure_number fixed bin (9);
 63 dcl (arg_count, i, j, node_count, path_count, quota_value, records_left, records_used) fixed bin;
 64 dcl (sort_by, terminal_quota, total_quota, total_records_used) fixed bin;
 65 dcl (arg_len, return_len) fixed bin (21);
 66 dcl (code, time_updated) fixed bin (35);
 67 dcl trp fixed bin (71);
 68 dcl record_days float bin;
 69 dcl dummy_rate (0:7) float bin;
 70 dcl (disk_rate, dummy_float) float bin;
 71 
 72 dcl error_table_$badopt fixed bin (35) ext;
 73 dcl error_table_$badstar fixed bin (35) ext;
 74 dcl error_table_$nomatch fixed bin (35) ext;
 75 dcl error_table_$nostars fixed bin (35) ext;
 76 dcl error_table_$not_act_fnc fixed bin (35) ext;
 77 
 78 dcl complain variable entry options (variable);
 79 dcl get_arg variable entry (fixed bin, ptr, fixed bin (21), fixed bin (35));
 80 
 81 dcl absolute_pathname_ entry (char (*), char (*), fixed bin (35));
 82 dcl active_fnc_err_ entry options (variable);
 83 dcl check_star_name_$path entry (char (*), fixed bin (35));
 84 dcl (com_err_, com_err_$suppress_name) entry options (variable);
 85 dcl cu_$af_return_arg entry (fixed bin, ptr, fixed bin (21), fixed bin (35));
 86 dcl cu_$arg_count entry (fixed bin, fixed bin (35));
 87 dcl (cu_$af_arg_ptr, cu_$arg_ptr) entry (fixed bin, ptr, fixed bin (21), fixed bin (35));
 88 dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin);
 89 dcl date_time_$fstime entry (fixed bin (35), char (*));
 90 dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35));
 91 dcl get_system_free_area_ entry returns (ptr);
 92 dcl get_wdir_ entry returns (char (168));
 93 dcl (hcs_$dir_quota_move, hcs_$quota_move) entry (char (*), char (*), fixed bin, fixed bin (35));
 94 dcl (hcs_$dir_quota_read, hcs_$quota_read) entry (char (*), fixed bin, fixed bin (71), fixed bin (35),
 95           bit (36), fixed bin, fixed bin, fixed bin (35));
 96 dcl hcs_$get_link_target entry (char (*), char (*), char (*), char (*), fixed bin (35));
 97 dcl hcs_$star_ entry (char (*), char (*), fixed bin (2), ptr, fixed bin, ptr, ptr, fixed bin (35));
 98 dcl hcs_$star_dir_list_ entry (char (*), char (*), fixed bin (2), ptr, fixed bin, fixed bin,
 99           ptr, ptr, fixed bin (35));
100 dcl (ioa_, ioa_$rsnnl) entry options (variable);
101 dcl mdc_$find_lvname entry (bit (36), char (*), fixed bin (35));
102 dcl pathname_ entry (char (*), char (*)) returns (char (168));
103 dcl sort_items_$fixed_bin entry (ptr);
104 dcl system_info_$prices_rs entry (fixed bin (9), (0:7)float bin, (0:7)float bin, (0:7)float bin, (0:7)float bin,
105           float bin, float bin);
106 dcl user_info_$rs_number entry (fixed bin (9));
107 
108 dcl (addr, binary, divide, float, index, length, mod, null, reverse, substr, sum, unspec) builtin;
109 
110 dcl cleanup condition;
111 %page;
112           me = "move_quota";
113           dir_quota_sw = "0"b;
114           go to MOVE_COMMON;
115 
116 move_dir_quota: entry;
117 
118           me = "move_dir_quota";
119           dir_quota_sw = "1"b;
120 
121 MOVE_COMMON:
122           call cu_$arg_count (arg_count, code);
123           if code ^= 0 then do;
124                call com_err_ (code, me);
125                return;
126           end;
127 
128           if arg_count < 2 | mod (arg_count, 2) ^= 0 then do;
129                call com_err_$suppress_name (0, me, "Usage:  ^a path1 records1 ... pathN recordsN", me);
130                return;
131           end;
132 
133           do i = 1 by 2 to arg_count;
134 
135                call cu_$arg_ptr (i, arg_ptr, arg_len, code);
136                if index (arg, "-") = 1 then
137                     if arg = "-working_directory" | arg = "-working_dir" | arg = "-wd" then do;
138                          dn = get_wdir_ ();
139                          en = "";
140                     end;
141                     else do;
142                          call com_err_ (error_table_$badopt, me, "^a", arg);
143                          return;
144                     end;
145                else do;
146                     call expand_pathname_ (arg, dn, en, code);
147                     if code ^= 0 then do;
148                          call com_err_ (code, me, "^a", arg);
149                          return;
150                     end;
151                end;
152 
153                call cu_$arg_ptr (i + 1, arg_ptr, arg_len, code);
154 
155                quota_value = cv_dec_check_ (arg, code);
156                if code ^= 0 then do;
157                     call com_err_ (0, me, "Invalid numeric argument.  ^a", arg);
158                     return;
159                end;
160 
161                if dir_quota_sw then call hcs_$dir_quota_move (dn, en, quota_value, code);
162                else call hcs_$quota_move (dn, en, quota_value, code);
163 
164                if code ^= 0 then do;
165                     call com_err_ (code, me, "^a", pathname_ (dn, en));
166                     return;
167                end;
168           end;
169 
170           return;
171 %page;
172 get_quota: getquota: gq: entry;
173 
174           me = "get_quota";
175           dir_quota_sw = "0"b;
176           go to GET_COMMON;
177 
178 get_dir_quota: entry;
179 
180           me = "get_dir_quota";
181           dir_quota_sw = "1"b;
182 
183 GET_COMMON:
184           call cu_$af_return_arg (arg_count, return_ptr, return_len, code);
185           if code = 0 then do;
186                af_sw = "1"b;
187                get_arg = cu_$af_arg_ptr;
188                complain = active_fnc_err_;
189           end;
190           else if code = error_table_$not_act_fnc then do;
191                af_sw = "0"b;
192                get_arg = cu_$arg_ptr;
193                complain = com_err_;
194           end;
195           else do;
196                call com_err_ (code, me);
197                return;
198           end;
199 
200           long_sw, nonzero_sw, quota_sw, records_left_sw, records_used_sw = "0"b;
201           sort_sw, total_sw, type_specified_sw, wdir_sw, zero_sw = "0"b;
202           path_count = 0;
203 
204           do i = 1 to arg_count;
205                call cu_$arg_ptr (i, arg_ptr, arg_len, code);
206                if index (arg, "-") = 1 then
207                     if arg = "-all" | arg = "-a" then do;
208 LONG:
209                          if af_sw then do;
210 BAD_OPT:                      call complain (error_table_$badopt, me, "^a", arg);
211                               return;
212                          end;
213                          long_sw, quota_sw, records_left_sw, records_used_sw = "1"b;
214                     end;
215                     else if arg = "-long" | arg = "-lg" then go to LONG;
216                     else if arg = "-nonzero" | arg = "-nz" then
217                          if af_sw then go to BAD_OPT;
218                          else nonzero_sw = "1"b;
219                     else if arg = "-quota" then quota_sw, type_specified_sw = "1"b;
220                     else if arg = "-records_left" | arg = "-rec_left" | arg = "-left" then
221                          records_left_sw, type_specified_sw = "1"b;
222                     else if arg = "-records_used" | arg = "-rec_used" | arg = "-ru" | arg = "-used" then
223                          records_used_sw, type_specified_sw = "1"b;
224                     else if arg = "-sort" then
225                          if af_sw then go to BAD_OPT;
226                          else sort_sw = "1"b;
227                     else if arg = "-total" | arg = "-tt" then total_sw = "1"b;
228                     else if arg = "-working_directory" | arg = "-working_dir" | arg = "-wd" then
229                          if af_sw & path_count > 0 then go to AF_TWO_PATHS;
230                          else do;
231                               wdir_sw = "1"b;
232                               path_count = path_count + 1;
233                          end;
234                     else if arg = "-zero" then
235                          if af_sw then go to BAD_OPT;
236                          else zero_sw = "1"b;
237                     else go to BAD_OPT;
238                else do;
239                     if af_sw & path_count > 0 then do;
240 AF_TWO_PATHS:
241                          call complain (0, me, "Only one directory allowed.");
242                          return;
243                     end;
244                     path_count = path_count + 1;
245                end;
246           end;
247 
248           if nonzero_sw & zero_sw then do;
249                call complain (0, me, "Incompatible control arguments -zero and -nonzero");
250                return;
251           end;
252 
253           if af_sw then
254                if (quota_sw & records_left_sw) |
255                   (records_left_sw & records_used_sw) |
256                   (quota_sw & records_used_sw) then do;
257                     call complain (0, me, "Only one of -quota, -records_left, -records_used is allowed.");
258                     return;
259                end;
260 
261           if ^type_specified_sw then
262                if af_sw then quota_sw = "1"b;               /* af default: just return quota */
263                else quota_sw, records_used_sw = "1"b;
264 
265           if sort_sw then do;                               /* decide which value to sort by */
266                if quota_sw & ^records_left_sw & ^records_used_sw then sort_by = QUOTA;
267                else if records_left_sw & ^quota_sw & ^records_used_sw then sort_by = RECORDS_LEFT;
268                else sort_by = RECORDS_USED;
269                node_count = 0;
270           end;
271 
272           default_lvname = "";
273           print_header_sw = "1"b;
274           some_nonzero, some_zero, star_sw = "0"b;
275           total_quota, total_records_used = 0;
276 
277           star_entry_ptr, star_names_ptr = null;
278           first_node_ptr, last_node_ptr = null;
279           area_ptr = get_system_free_area_ ();
280 
281           on cleanup call clean_up;
282 
283           if wdir_sw | path_count = 0 then do;
284                call process_path (get_wdir_ ());
285                if path_count < 2 then go to TOTAL;          /* no args or -wd by itself */
286           end;
287 
288           do i = 1 to arg_count;
289 
290                call get_arg (i, arg_ptr, arg_len, code);
291 
292                if index (arg, "-") ^= 1 then do;            /* pathname */
293 
294                     call absolute_pathname_ (arg, path, code);
295                     if code ^= 0 then do;
296                          call complain (code, me, "^a", arg);
297                          return;
298                     end;
299 
300                     star_sw = "0"b;
301                     if path ^= ">" then do;
302                          call check_star_name_$path (path, code);
303                          if code = error_table_$badstar then do;
304                               call complain (code, me, "^a", path);
305                               return;
306                          end;
307                          star_sw = (code ^= 0);
308                     end;
309 
310                     if ^star_sw then call process_path (path);
311 
312                     else do;                                /* starname */
313 
314                          if af_sw then do;
315                               call complain (error_table_$nostars, me, "^a", path);
316                               return;
317                          end;
318 
319                          call expand_pathname_ (path, dn, en, code);
320                          if code ^= 0 then do;              /* absolute_pathname_ probably caught this */
321                               call complain (code, me, "^a", path);
322                               return;
323                          end;
324 
325                          if dir_quota_sw then call hcs_$dir_quota_read (dn, quota_value, trp, time_updated,
326                               sons_lvid, terminal_quota, records_used, code);
327                          else call hcs_$quota_read (dn, quota_value, trp, time_updated,
328                               sons_lvid, terminal_quota, records_used, code);
329                          if code ^= 0 then do;
330                               call complain (code, me, "^a", dn);
331                               return;
332                          end;
333 
334                          call mdc_$find_lvname (sons_lvid, default_lvname, code);
335                          if code ^= 0 then do;
336                               call complain (code, me, "^a ^w", dn, sons_lvid);
337                               return;
338                          end;
339 
340                          call hcs_$star_ (dn, en, star_BRANCHES_ONLY, area_ptr, star_entry_count,
341                               star_entry_ptr, star_names_ptr, code);
342                          if code ^= 0 then do;
343                               call complain (code, me, "^a", pathname_ (dn, en));
344                               return;
345                          end;
346 
347                          some_matches = "0"b;
348 
349                          do j = 1 to star_entry_count;
350 
351                               if star_entries (j).type = star_DIRECTORY then do;
352 
353                                    some_matches = "1"b;
354 
355                                    call process_path (pathname_ (dn, star_names (star_entries (j).nindex)));
356                               end;
357                          end;
358 
359                          if ^some_matches then call complain (0, me, "No directories match starname ^a",
360                               pathname_ (dn, en));
361 
362                          call clean_up_stars;
363                     end;
364                end;
365           end;
366 
367 TOTAL:
368           if nonzero_sw & ^some_nonzero then
369                call com_err_ (0, me, "No directories with nonzero quota-used.");
370           else if zero_sw & ^some_zero then
371                call com_err_ (0, me, "No directories with zero quota-used.");
372 
373           if sort_sw then
374 begin;
375 dcl 1 sort_array aligned,
376    2 n fixed bin (18),
377    2 eltp (node_count) ptr unaligned;
378 
379           sort_array.n = node_count;
380           i = 0;
381 
382           do p = first_node_ptr repeat (p -> node.next) while (p ^= null);
383                i = i + 1;
384                sort_array.eltp (i) = addr (p -> node.sort_value);
385           end;
386 
387           call sort_items_$fixed_bin (addr (sort_array));
388 
389           do i = sort_array.n by -1 to 1;
390                p = eltp (i);
391                lvname = p -> node.lvname;
392                trp = p -> node.trp;
393                time_updated = p -> node.time_updated;
394                terminal_quota = p -> node.terminal_quota;
395                quota_value = p -> node.quota_value;
396                records_left = p -> node.records_left;
397                records_used = p -> node.records_used;
398 
399                call print_line (p -> node.path);
400           end;
401 end;
402 
403           if star_sw & ^af_sw & ^print_header_sw & ^long_sw then
404                if (quota_sw | records_used_sw) then call ioa_ ("^/^[^6d^-^;^s^]^[^6d^-^;^s^]^[^-^]^-Total^/",
405                     quota_sw, total_quota, records_used_sw, total_records_used, records_left_sw);
406                else call ioa_ ("");
407 
408           return;
409 %page;
410 add_node: proc () returns (ptr);
411 
412 dcl newp ptr;
413 
414           allocate node in (area) set (newp);
415           unspec (newp -> node) = "0"b;
416           newp -> node.next = null;
417           if first_node_ptr = null then first_node_ptr, last_node_ptr = newp;
418           else do;
419                last_node_ptr -> node.next = newp;
420                last_node_ptr = newp;
421           end;
422 
423           node_count = node_count + 1;
424 
425           return (newp);
426 
427 end add_node;
428 %page;
429 clean_up: proc;
430 
431 dcl (nextp, p) ptr;
432 
433           call clean_up_stars;
434 
435           if first_node_ptr ^= null then
436                do p = first_node_ptr repeat (nextp) while (p ^= null);
437                     nextp = p -> node.next;
438                     free p -> node in (area);
439                end;
440 
441 end clean_up;
442 %page;
443 clean_up_stars: proc;
444 
445           if star_names_ptr ^= null then free star_names in (area);
446           if star_entry_ptr ^= null then free star_entries in (area);
447           star_entry_ptr, star_names_ptr = null;
448 
449 end clean_up_stars;
450 %page;
451 entryname: proc (P_path) returns (char (*));
452 
453 dcl P_path char (*);
454 dcl (i, j) fixed bin;
455 
456           if P_path = ">" then return (">");
457           i = index (reverse (P_path), ">");
458           if i = 0 then return (P_path);
459           j = length (P_path) - i + 2;
460           return (substr (P_path, j));
461 
462 end entryname;
463 %page;
464 get_records_left: proc (P_path, P_quota_value, P_records_used, P_terminal_quota) returns (fixed bin);
465 
466 /* This procedure calls itself recursively */
467 
468 dcl P_path char (*);
469 dcl (P_quota_value, P_records_used, P_terminal_quota) fixed bin;
470 dcl (dn, target_dn) char (168);
471 dcl (en, target_en) char (32);
472 dcl (quota_value, records_used, terminal_quota) fixed bin;
473 dcl code fixed bin (35);
474 
475           if P_terminal_quota ^= 0 then return (P_quota_value - P_records_used);
476 
477           else do;
478 
479                call expand_pathname_ (P_path, dn, en, code);
480 
481                call hcs_$get_link_target (dn, en, target_dn, target_en, code);
482                                                             /* if nonlink, target_foo set same as foo */
483                if code ^= 0 then return (NO_ACCESS);
484 
485                if dir_quota_sw then call hcs_$dir_quota_read (target_dn, quota_value, 0, 0, "0"b, terminal_quota,
486                     records_used, code);
487                else call hcs_$quota_read (target_dn, quota_value, 0, 0, "0"b, terminal_quota,
488                     records_used, code);
489 
490                if code ^= 0 then return (NO_ACCESS);
491 
492                else return (get_records_left (target_dn, quota_value, records_used, terminal_quota));
493           end;
494 
495 end get_records_left;
496 %page;
497 print_line: proc (P_path);
498 
499 dcl P_path char (*);
500 
501           if ^long_sw then
502                if ^star_sw & path_count < 2 then call ioa_
503                     ("^[quota = ^d^[; ^]^;^2s^]^[used = ^d^[; ^]^;^2s^]^[remaining = ^[(no access)^;^d^]^]",
504                     quota_sw, quota_value, records_left_sw | records_used_sw,
505                     records_used_sw, records_used, records_left_sw,
506                     records_left_sw, records_left = NO_ACCESS, records_left);
507 
508                else do;                                     /* star case */
509                     if print_header_sw then do;             /* print heading first time */
510                          call ioa_ ("^/^[^xquota^-^]^[^2xused^-^]^[^2xremaining^-^]^-directory name^/",
511                               quota_sw, records_used_sw, records_left_sw);
512                          print_header_sw = "0"b;
513                     end;
514                     if lvname = default_lvname then lvname_string = "";
515                     else call ioa_$rsnnl ("(^a)", lvname_string, 0, lvname);
516                     call ioa_ ("^[^6d^-^;^s^]^[^6d^-^;^s^]^[^[no access^s^;^6d^]^-^;^2s^]^-^a  ^a",
517                          quota_sw, quota_value,
518                          records_used_sw, records_used,
519                          records_left_sw, records_left = NO_ACCESS, records_left,
520                          entryname (P_path), lvname_string);
521                end;
522 
523           else do;                                          /* -long */
524                call ioa_ ("^/quota for:   ^a^/", P_path);
525                call date_time_$fstime (time_updated, time_string);
526                record_days = (float (trp) + 43200.) / 86400.;
527                call ioa_ ("quota:^28t^d pages ^[(space is charged to superior directory)^]",
528                     quota_value, terminal_quota = 0);
529                call ioa_ ("used:^28t^d pages", records_used);
530                call ioa_ ("remaining:^28t^[(no access)^;^d pages^]", records_left = NO_ACCESS, records_left);
531                call ioa_ ("sons volume:^28t^a", lvname);
532                if time_updated ^= 0 then do;
533                     call ioa_ ("time-record-product:^28t^.3f record-days", record_days);
534                     call ioa_ ("trp last updated:^28t^a", time_string);
535                     call user_info_$rs_number (rate_structure_number);
536                     disk_rate = 0;
537                     call system_info_$prices_rs (rate_structure_number,
538                          dummy_rate, dummy_rate, dummy_rate, dummy_rate, disk_rate, dummy_float);
539                     if disk_rate > 0 then
540                          call ioa_ ("trp price at current rate:^28t$^.2f", trp * disk_rate);
541                     call ioa_ ("");
542                end;
543           end;
544 
545 end print_line;
546 %page;
547 process_path: proc (P_path);
548 
549 dcl P_path char (*);
550 
551           if dir_quota_sw then call hcs_$dir_quota_read (P_path, quota_value, trp, time_updated,
552                sons_lvid, terminal_quota, records_used, code);
553           else call hcs_$quota_read (P_path, quota_value, trp, time_updated,
554                sons_lvid, terminal_quota, records_used, code);
555           if code ^= 0 then do;
556                call complain (code, me, "^a", P_path);
557                return;
558           end;
559 
560           if total_sw & terminal_quota ^= 0 then
561                records_used = records_used + subdir_records_used (P_path);
562 
563           if nonzero_sw then
564                if records_used = 0 then return;
565                else some_nonzero = "1"b;
566           else if zero_sw then
567                if records_used ^= 0 then return;
568                else some_zero = "1"b;
569 
570           call mdc_$find_lvname (sons_lvid, lvname, code);
571           if code ^= 0 then call complain (code, me, "^a ^w", P_path, sons_lvid);
572 
573           total_quota = total_quota + quota_value;
574           total_records_used = total_records_used + records_used;
575 
576           if records_left_sw then records_left = get_records_left (P_path, quota_value, records_used, terminal_quota);
577 
578           if af_sw then do;
579                call ioa_$rsnnl ("^[^d^;^s^]^[^d^;^s^]^[^d^]", return_arg, return_len,
580                     quota_sw, quota_value, records_left_sw, records_left, records_used_sw, records_used);
581                return;
582           end;
583 
584           if ^sort_sw then call print_line (P_path);
585 
586           else do;                                          /* -sort: save data for sorting */
587                p = add_node ();
588                p -> node.path = P_path;
589                p -> node.lvname = lvname;
590                p -> node.trp = trp;
591                p -> node.time_updated = time_updated;
592                p -> node.terminal_quota = terminal_quota;
593                p -> node.quota_value = quota_value;
594                p -> node.records_left = records_left;
595                p -> node.records_used = records_used;
596                if sort_by = QUOTA then p -> node.sort_value = quota_value;
597                else if sort_by = RECORDS_LEFT then p -> node.sort_value = records_left;
598                else p -> node.sort_value = records_used;
599           end;
600 
601 end process_path;
602 %page;
603 subdir_records_used: proc (P_dn) returns (fixed bin);
604 
605 dcl P_dn char (*);
606 dcl path char (168);
607 dcl (eptr, nptr) ptr;
608 dcl (ecount, j, lcount, records_used, terminal_quota, total_ru) fixed bin;
609 dcl code fixed bin (35);
610 
611           eptr, nptr = null;
612           on cleanup call local_cleanup;
613 
614           total_ru = 0;
615 
616           call hcs_$star_dir_list_ (P_dn, "**", star_BRANCHES_ONLY, area_ptr, ecount, lcount, eptr, nptr, code);
617           if code = 0 & ecount > 0 then do;
618                star_branch_count = ecount;                  /* to satisfy the structure declarations */
619                star_link_count = lcount;
620                star_select_sw = star_BRANCHES_ONLY;
621                do j = 1 to ecount;
622                     if eptr -> star_dir_list_branch (j).type = star_DIRECTORY then do;
623                          path = pathname_
624                               (P_dn, (nptr -> star_list_names (eptr -> star_dir_list_branch (j).nindex)));
625                          if eptr -> star_dir_list_branch (j).master_dir then call complain (0, me,
626                               "^a is a master directory; its quota will not be included in the total.", path);
627                          else do;
628                               if dir_quota_sw then call hcs_$dir_quota_read (path, 0, 0, 0, "0"b,
629                                    terminal_quota, records_used, code);
630                               else call hcs_$quota_read (path, 0, 0, 0, "0"b,
631                                    terminal_quota, records_used, code);
632                               if code ^= 0 then call complain (code, me,
633                                    "^a^/Directory's quota will not be included in the total.", path);
634                               else if terminal_quota ^= 0 then
635                                    total_ru = total_ru + records_used + subdir_records_used (path);
636                          end;
637                     end;
638                end;
639                call local_cleanup;
640           end;
641           else if code ^= 0 & code ^= error_table_$nomatch then call complain (code, me, "^a", P_dn);
642 
643           return(total_ru);
644 
645 local_cleanup: proc;
646 
647           star_list_branch_ptr = eptr;                      /* to make the declaration happy */
648           if nptr ^= null then free nptr -> star_list_names in (area);
649           if eptr ^= null then free eptr -> star_dir_list_branch in (area);
650 
651 end local_cleanup;
652 
653 end subdir_records_used;
654 %page;
655 %include star_structures;
656 
657 end move_quota;