1
2
3
4
5
6 move_quota: movequota: mq: proc;
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
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
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
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;
263 else quota_sw, records_used_sw = "1"b;
264
265 if sort_sw then do;
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;
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;
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;
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;
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
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
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;
509 if print_header_sw then do;
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;
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;
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;
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;
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;