1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22 generate_pnotice:
23 proc;
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 %page;
51
52
53
54 dcl Fany bit (1),
55
56 Fcopy_right bit (1),
57 Fdcopy_right bit (1),
58 Fdtrade_secret bit (1),
59 Fname bit (1),
60 Fmust_reset_object bit (1),
61 Fmust_reset_source bit (1),
62 Fsti bit (1),
63 Fpublic_domain bit (1),
64 Fmid bit (1),
65 Fspec bit (1),
66 Ftrade_secret bit (1),
67 Idx fixed bin,
68 Idx1 fixed bin,
69 Idx2 fixed bin,
70 Idx3 fixed bin,
71 Isnotice fixed bin,
72 Ionotice fixed bin,
73 Larg fixed bin (21),
74 Ltemp fixed bin,
75 Ltotal fixed bin,
76 Nargs fixed bin,
77 Parg ptr,
78 P_line ptr,
79 Piocb ptr,
80 Pnotices ptr,
81 Po_archive ptr,
82 Ppsp_info ptr,
83 Ps_archive ptr,
84 Ptemp ptr,
85 answer char (168) var,
86 sbit_count fixed bin (24),
87 obit_count fixed bin (24),
88 case fixed bin,
89 code fixed bin (35),
90 component_name char (32),
91 current_year_a char(4),
92 Iyr fixed bin(24),
93 sdir char (168),
94 odir char (168),
95 match_found bit (1),
96 object_pnotices fixed bin,
97 oentry char (32),
98 path char (168),
99 pn char (512) var,
100 prod char (20),
101 prod_mid char (7),
102 prod_object_pnotice (10) char (32) var,
103 prod_object_ename char (32),
104 prod_source_pnotice (10) char (32) var,
105 prod_source_ename char (32),
106 prod_sti char (12),
107 sentry char (32),
108 source_pnotices fixed bin,
109 this_is_object_archive bit(1),
110 this_is_source_archive bit(1),
111 user_on_source_acl bit(1),
112 user_on_object_acl bit(1),
113 working_dir char (168);
114
115
116
117 dcl argument char (Larg) based (Parg);
118 dcl temp char (Ltemp) based (Ptemp);
119 dcl 1 ACI,
120 2 aci like archive_component_info;
121
122 dcl 1 ACIS aligned int static options (constant),
123 2 vers fixed bin init (1),
124 2 bc fixed bin (24),
125 2 c_ptr ptr,
126 2 nm char (32) unaligned,
127 2 tmod fixed bin (71),
128 2 tupd fixed bin (71),
129 2 c_lgth fixed bin (19),
130 2 acl bit (36) unaligned;
131
132
133 dcl 1 query_info aligned int static,
134 2 version fixed bin init (1),
135 2 switches,
136 3 yes_or_no_sw bit (1) unal init ("0"b),
137 3 suppress_name_sw bit (1) unal init ("1"b),
138 3 suppress_spacing_sw bit (1) unal init ("1"b),
139 3 cp_escape_control bit (2) unal init ("00"b),
140 3 pad bit (31) unal,
141 2 status_code fixed bin (35) init (0),
142 2 query_code fixed bin (35) init (0),
143 2 question_iocbp ptr init (null),
144 2 answer_iocbp ptr init (null),
145 2 repeat_time fixed bin (71) init (0);
146
147
148
149
150 dcl (addr,
151 after,
152 before,
153 clock,
154 dim,
155 hbound,
156 index,
157 length,
158 null,
159 reverse,
160 rtrim,
161 substr,
162 unspec) builtin;
163
164
165 dcl (cleanup,
166 not_in_write_bracket,
167 no_write_permission) condition;
168
169
170 dcl alm entry options(variable),
171 archive entry options(variable),
172 archive_$get_component_info
173 entry (ptr, fixed bin(24), char(*), ptr, fixed bin(35)),
174 check_entryname_ entry (char(*), fixed bin(35)),
175 com_err_ entry() options(variable),
176 command_query_ entry() options(variable),
177 cu_$arg_count entry (fixed bin, fixed bin(35)),
178 cu_$arg_ptr entry (fixed bin, ptr, fixed bin(21), fixed bin(35)),
179 date_time_$format entry (char(*), fixed bin(71), char(*), char(*)) returns(char(250) var),
180 delete_$path entry (char(*), char(*), bit(6), char(*), fixed bin(35)),
181 expand_pathname_ entry (char(*), char(*), char(*), fixed bin(35)),
182 get_group_id_ entry() returns(char(32)),
183 get_temp_segment_ entry (char(*), ptr, fixed bin(35)),
184 get_wdir_ entry() returns(char(168)),
185 hcs_$add_acl_entries entry (char(*), char(*), ptr, fixed bin, fixed bin(35)),
186 hcs_$delete_acl_entries entry (char(*), char(*), ptr, fixed bin, fixed bin(35)),
187 hcs_$initiate_count entry (char(*), char(*), char(*), fixed bin(24), fixed bin(2), ptr, fixed bin(35)),
188 hcs_$list_acl entry (char(*), char(*), ptr, ptr, ptr, fixed bin, fixed bin(35)),
189 ioa_ entry() options(variable),
190 ioa_$ioa_switch entry() options(variable),
191 iox_$attach_ioname entry (char(*), ptr, char(*), fixed bin(35)),
192 iox_$close entry (ptr, fixed bin(35)),
193 iox_$detach_iocb entry (ptr, fixed bin(35)),
194 iox_$open entry (ptr, fixed bin, bit(1) aligned, fixed bin(35)),
195 list_pnotice_names entry options(variable),
196 parse_pnotice_info_ entry (ptr, fixed bin (35)),
197 parse_pnotice_info_$validate_sti
198 entry (char(12)) returns(bit(1)),
199 pnotice_paths_ entry (char(*), bit(*), ptr, fixed bin(35)),
200 release_temp_segment_ entry (char(*), ptr, fixed bin(35)),
201 terminate_file_ entry (ptr, fixed bin(24), bit(*), fixed bin(35));
202
203
204
205 dcl error_table_$badopt fixed bin(35) ext static,
206 error_table_$name_not_found fixed bin(35) ext static,
207 error_table_$active_function fixed bin(35) ext static,
208 error_table_$no_w_permission fixed bin(35) ext static,
209 error_table_$lower_ring fixed bin(35) ext static,
210 error_table_$no_component fixed bin(35) ext static,
211 error_table_$noentry fixed bin(35) ext static,
212 error_table_$wrong_no_of_args fixed bin(35) ext static;
213
214
215
216
217 dcl ME char (16) int static options (constant) init ("generate_pnotice"),
218 NL char (1) int static options (constant) init ("
219 "),
220 True bit (1) int static options (constant) init ("1"b),
221 False bit (1) int static options (constant) init ("0"b);
222
223
224
225 on cleanup call clean_up;
226 call init;
227 call cu_$arg_count (Nargs, code);
228 if code = error_table_$active_function then
229 goto USAGE;
230 else if Nargs = 0 then do;
231 code = error_table_$wrong_no_of_args;
232 go to USAGE;
233 end;
234 do Idx = 1 to Nargs;
235 call cu_$arg_ptr (Idx, Parg, Larg, code);
236 if code ^= 0 then do;
237 call com_err_ (code, ME, argument);
238 return;
239 end;
240 else if substr(argument, 1, 1) ^= "-" then
241 goto USAGE;
242 else if argument = "-name" | argument = "-nm" then do;
243 Idx = Idx + 1;
244 call cu_$arg_ptr (Idx, Parg, Larg, code);
245 if code ^= 0 then do;
246 call com_err_ (code, ME, "Arg= ^a", argument);
247 return;
248 end;
249 prod = argument;
250 Fany = True;
251 Fname = True;
252 end;
253 else if argument = "-id" then do;
254 Idx = Idx + 1;
255 call cu_$arg_ptr (Idx, Parg, Larg, code);
256 if code ^= 0 then do;
257 call com_err_ (code, ME, "Arg= ^a", argument);
258 return;
259 end;
260 prod_mid = argument;
261 Fany = True;
262 Fmid = True;
263 end;
264 else if argument = "-sti" then do;
265
266 Idx = Idx + 1;
267 call cu_$arg_ptr (Idx, Parg, Larg, code);
268 if code ^= 0 then do;
269 call com_err_ (code, ME, "Arg= ^a", argument);
270 return;
271 end;
272 prod_sti = argument;
273 if ^parse_pnotice_info_$validate_sti (prod_sti) then do;
274 call ioa_ ("Error - invalid STI: ^a", argument);
275 return;
276 end;
277 Fany = True;
278 Fsti = True;
279 end;
280 else if argument = "-special" then
281 Fspec = True;
282 else do;
283 code = error_table_$badopt;
284 goto USAGE;
285 end;
286 end;
287 MORE_TRASH:
288 if Fname & Fmid then do;
289 call ioa_ ("The name and match args are mutually exclusive.");
290 code = error_table_$wrong_no_of_args;
291 goto USAGE;
292 end;
293 else if Fspec & Fany then do;
294 call ioa_ ("The special arg is to be used alone.");
295 code = error_table_$wrong_no_of_args;
296 goto USAGE;
297 end;
298 else go to WORK;
299 USAGE: call com_err_ (code, ME, "
300 Usage: generate_pnotice {-name | -nm <generic name>}
301 {-id <MID>}
302 {-sti <STI>}
303 {-special}");
304 return;
305 WORK: call get_temp_segment_ (ME, Ppsp_info, code);
306 if code ^= 0 then do;
307 call com_err_ (code, ME, "getting temp seg for psp_info.");
308 return;
309 end;
310 SI_ptr = Ppsp_info;
311 call parse_pnotice_info_ (SI_ptr, code);
312 if code ^= 0 then do;
313 call com_err_ (code, ME, "filling in psp_info.");
314 call release_temp_segment_ (ME, Ppsp_info, code);
315 return;
316 end;
317 call pnotice_paths_ (ME, "00"b, Ppaths, code);
318 if code ^= 0 then
319 goto CLEAN;
320 pnotice_paths.templates(*).primary_name = before(pnotice_paths.templates(*).primary_name, ".pnotice");
321
322
323 working_dir = get_wdir_ ();
324 if Fspec then do;
325 call get_PNOTICE_info;
326 goto CHECK_PN;
327 end;
328 else if Fname then do;
329 do Idx3 = 1 to product.prod_number while (prod ^= product.num(Idx3).prod_name);
330 end;
331 if Idx3 > product.prod_number then do;
332 code = error_table_$name_not_found;
333 call com_err_ (code, ME, "^/Looking for ""^a"" in psp_info_", prod);
334 call clean_up;
335 return;
336 end;
337 end;
338 else if Fmid then do;
339 do Idx3 = 1 to product.prod_number while (prod_mid ^= product.num(Idx3).MI);
340 end;
341 if Idx3 > product.prod_number then do;
342 code = error_table_$name_not_found;
343 call com_err_ (code, ME, "^/Specified MID was not found in psp_info_.", prod_mid);
344 call clean_up;
345 end;
346 end;
347 prod = product.num(Idx3).prod_name;
348 if product.num(Idx3).prod_use(1) ^= "" then do;
349 call ioa_ ("Multiple products found in psp_info_.
350 ^/Please use this command with each product.");
351 call clean_up;
352 return;
353 end;
354 if ^Fsti then
355 prod_sti = product.num(Idx3).prod_STI;
356 Idx = 0;
357 do Idx2 = 1 to 10 while (product.num(Idx3).source_C(Idx2) ^= "");
358
359 prod_source_pnotice(Idx2) = product.num(Idx3).source_C(Idx2);
360 Idx1 = check_name(prod_source_pnotice(Idx2));
361 if Idx1 > pnotice_paths.Ntemplates then do;
362 code = error_table_$name_not_found;
363 call com_err_ (code, ME, "^/Invalid psp_info_ name - ^a.", prod_source_pnotice(Idx2));
364 goto CLEAN;
365 end;
366 Idx = Idx + 1;
367 if Idx > 1 then
368 if ^templates_compatible(prod_source_pnotice) then do;
369 call com_err_ (code, ME, "^a - ^/pnotice types not compatible.", prod);
370 goto CLEAN;
371 end;
372 source_pnotices = source_pnotices + 1;
373 end;
374 Idx = 0;
375 do Idx2 = 1 to 10 while (product.num(Idx3).object_C(Idx2) ^= "");
376
377 prod_object_pnotice(Idx2) = product.num(Idx3).object_C(Idx2);
378 Idx1 = check_name(prod_object_pnotice(Idx2));
379 if Idx1 > pnotice_paths.Ntemplates then do;
380 code = error_table_$name_not_found;
381 call com_err_ (code, ME, "^/Invalid psp_info_ name - ^a.", prod_object_pnotice(Idx2));
382 goto CLEAN;
383 end;
384 Idx = Idx + 1;
385 if Idx > 1 then
386 if ^templates_compatible(prod_object_pnotice) then do;
387 call com_err_ (code, ME, "^a - ^/pnotice types not compatible.", prod);
388 goto CLEAN;
389 end;
390 object_pnotices = object_pnotices + 1;
391 end;
392
393 prod_source_ename = product.num(Idx3).source_path.entryname;
394
395 prod_object_ename = product.num(Idx3).object_path.entryname;
396 CHECK_PN:
397 if source_pnotices = 1 & object_pnotices = 1 then do;
398 if prod_source_pnotice(1) = prod_object_pnotice(1) then
399 case = 1;
400 else case = 3;
401 end;
402 else do;
403
404 if ^check_multiple_pnotices() then do;
405 call ioa_ ("Unexpected errors encountered - procedure terminated.");
406 call clean_up;
407 return;
408 end;
409 if source_pnotices ^= object_pnotices then do;
410 case = 4;
411 goto CONTINUE;
412 end;
413 else do Idx = 1 to source_pnotices;
414
415 match_found = False;
416 do Idx2 = 1 to object_pnotices;
417 if prod_object_pnotice(Idx2) = prod_source_pnotice(Idx) then
418 match_found = True;
419 end;
420 if ^match_found then do;
421 case = 4;
422 goto CONTINUE;
423 end;
424 end;
425 case = 2;
426 end;
427
428 CONTINUE:
429 call make_PNOTICE (case);
430 if Fspec then
431 call archive_PNOTICE (sdir, odir);
432 else
433 call archive_PNOTICE (working_dir, working_dir);
434
435 CLEAN: call clean_up;
436 return;
437
438 %page;
439
440
441 check_archive:
442 proc (Adir, Aentry, Aptr);
443
444 dcl Adir char(*),
445 Aentry char(*),
446 Aptr ptr;
447 dcl one_word char(4) based;
448
449 on not_in_write_bracket begin;
450 call com_err_ (error_table_$lower_ring, ME, "^/Writing ^a>^a.", Adir, Aentry);
451 goto CLEAN;
452 end;
453 on no_write_permission goto COMPLAIN;
454 Aptr -> one_word = Aptr -> one_word;
455 return;
456 COMPLAIN: call com_err_ (error_table_$no_w_permission, ME, "^/Checking ACL of ^a>^a.", Adir, Aentry);
457 goto CLEAN;
458 end check_archive;
459
460 %page;
461
462
463 clean_up: proc;
464
465 if Ppaths ^= null then do;
466 do Idx = 1 to dim(pnotice_paths.templates, 1);
467
468 call terminate_file_ (pnotice_paths.templates(Idx).Ptemplate,
469 pnotice_paths.templates(Idx).Ltemplate * 9, TERM_FILE_TERM, code);
470 end;
471 call release_temp_segment_ (ME, Ppaths, code);
472
473 end;
474
475 if Ppsp_info ^= null then
476 call release_temp_segment_ (ME, Ppsp_info, code);
477
478 if Fspec then do;
479 if Fmust_reset_source then
480 call check_acl$reset_acl (Ps_archive, sdir, sentry, "1"b, user_on_source_acl);
481 if Fmust_reset_object then
482 call check_acl$reset_acl (Po_archive, odir, oentry, "0"b, user_on_object_acl);
483 end;
484 if Ps_archive ^= null then
485 call terminate_file_ (Ps_archive, sbit_count, TERM_FILE_TERM, code);
486 if Po_archive ^= null then
487 call terminate_file_ (Po_archive, obit_count, TERM_FILE_TERM, code);
488 end clean_up;
489 %page;
490
491
492
493
494 init: proc;
495
496 Fmust_reset_source, Fmust_reset_object = False;
497 Idx = 0;
498 Idx2 = 0;
499 Idx3 = 0;
500 Isnotice = 0;
501 Ionotice = 0;
502 Ps_archive = null;
503 Po_archive = null;
504 Ppaths = null;
505 Ptemp = null;
506 P_line = null;
507 Ppsp_info = null;
508 Pnotices = null;
509 Ltotal = 0;
510 pn = "";
511 source_pnotices = 0;
512 object_pnotices = 0;
513 prod_source_pnotice(*) = "";
514 prod_object_pnotice(*) = "";
515 unspec (ACI) = unspec (ACIS);
516 match_found = False;
517 Fany = False;
518 Fname = False;
519 Fsti = False;
520 Fspec = False;
521 Fmid = False;
522 case = 0;
523
524 current_year_a = date_time_$format("^9999yc",clock(),"","");
525 end init;
526
527 %page;
528
529
530
531
532 make_PNOTICE:
533 proc (CASE);
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566 dcl CASE fixed bin;
567
568
569 goto PNOTICE (CASE);
570
571 PNOTICE(1):
572
573
574 Piocb = null;
575 call iox_$attach_ioname (ME, Piocb, "vfile_ "
576 || rtrim(working_dir) || ">" || "PNOTICE_"
577 || rtrim(prod) || ".alm", code);
578 if code ^= 0 then do;
579 call com_err_ (code, ME, "^/Attaching PNOTICE segment.");
580 return;
581 end;
582 call iox_$open (Piocb, 2, "0"b, code);
583 if code ^= 0 then do;
584 call com_err_ (code, ME, "^/Opening PNOTICE seg switch for output.");
585 return;
586 end;
587 call ioa_ ("Creating ^a>PNOTICE_^a.alm.", rtrim(working_dir), prod);
588 call ioa_$ioa_switch (Piocb, "^-dec^-1^3-""version 1 structure");
589 call ioa_$ioa_switch (Piocb, "^-dec^-^d^3-""no. of pnotices", source_pnotices);
590 call ioa_$ioa_switch (Piocb, "^-dec^-3^3-""no. of STIs");
591
592 if substr (prod_source_pnotice(1), 1, 8) = "default." then
593
594 do Idx2 = 1 to pnotice_paths.Ntemplates;
595 if pnotice_paths.templates(Idx2).defaultC then do;
596 Ltotal = Ltotal + pnotice_paths.templates(Idx2).Ltemplate - 1;
597 Ltemp = pnotice_paths.templates(Idx2).Ltemplate - 1;
598
599 Ptemp = pnotice_paths.templates(Idx2).Ptemplate;
600 call get_year;
601 end;
602 end;
603 else if substr (prod_source_pnotice(1), 1, 20) = "default_trade_secret" then
604
605 do Idx2 = 1 to pnotice_paths.Ntemplates;
606 if pnotice_paths.templates(Idx2).defaultTS then do;
607 Ltotal = Ltotal + pnotice_paths.templates(Idx2).Ltemplate - 1;
608 Ltemp = pnotice_paths.templates(Idx2).Ltemplate - 1;
609
610 Ptemp = pnotice_paths.templates(Idx2).Ptemplate;
611 pn = pn || " acc " || """" || temp || """" || NL;
612 end;
613 end;
614
615 else do Idx2 = 1 to pnotice_paths.Ntemplates;
616 if pnotice_paths.templates(Idx2).primary_name = prod_source_pnotice(1) then do;
617 Ltotal = Ltotal + pnotice_paths.templates(Idx2).Ltemplate - 1;
618
619 Ltemp = pnotice_paths.templates(Idx2).Ltemplate - 1;
620 Ptemp = pnotice_paths.templates(Idx2).Ptemplate;
621 call get_year;
622 end;
623 end;
624 call ioa_$ioa_switch (Piocb, "^-dec^-^d^3-""lgth of all pnotices + no. of pnotices", Ltotal + source_pnotices);
625 call ioa_$ioa_switch (Piocb, "^a", pn);
626 call ioa_$ioa_switch (Piocb, "^-aci^-""^a""", prod_sti);
627
628 call ioa_$ioa_switch (Piocb, "^-aci^-""^a""", substr(prod_sti, 1, 1) || "2" || substr(prod_sti, 3));
629
630 call ioa_$ioa_switch (Piocb, "^-aci^-""^a""", substr(prod_sti, 1, 1) || "3" || substr(prod_sti, 3));
631
632 call ioa_$ioa_switch (Piocb, "^-end");
633 call iox_$close (Piocb, code);
634 if code ^= 0 then
635 call com_err_ (code, ME, "Closing PNOTICE switch.");
636 call iox_$detach_iocb (Piocb, code);
637 if code ^= 0 then
638 call com_err_ (code, ME, "Detaching PNOTICE switch.");
639
640
641
642 call ioa_ ("Creating ^a>PNOTICE_^a.", rtrim(working_dir), prod);
643 call alm (rtrim(working_dir) || ">PNOTICE_" || prod);
644 return;
645
646 PNOTICE(2):
647
648
649 Piocb = null;
650 working_dir = get_wdir_ ();
651 call iox_$attach_ioname (ME, Piocb, "vfile_ "
652 || rtrim(working_dir) || ">" || "PNOTICE_"
653 || rtrim(prod) || ".alm", code);
654 if code ^= 0 then do;
655 call com_err_ (code, ME, "^/Attaching PNOTICE segment.");
656 return;
657 end;
658 call iox_$open (Piocb, 2, "0"b, code);
659 if code ^= 0 then do;
660 call com_err_ (code, ME, "^/Opening PNOTICE seg switch for output.");
661 return;
662 end;
663 call ioa_ ("Creating ^a>PNOTICE_^a.alm.", rtrim(working_dir), prod);
664 call ioa_$ioa_switch (Piocb, "^-dec^-1^3-""version 1 structure");
665 call ioa_$ioa_switch (Piocb, "^-dec^-^d^3-""no. of pnotices", source_pnotices);
666 call ioa_$ioa_switch (Piocb, "^-dec^-3^3-""no. of STIs");
667
668 do Idx = 1 to source_pnotices;
669
670
671 if substr (prod_source_pnotice(Idx), 1, 8) = "default." then
672
673 do Idx2 = 1 to pnotice_paths.Ntemplates;
674 if pnotice_paths.templates(Idx2).defaultC then do;
675 Ltotal = Ltotal + pnotice_paths.templates(Idx2).Ltemplate - 1;
676 Ltemp = pnotice_paths.templates(Idx2).Ltemplate - 1;
677
678 Ptemp = pnotice_paths.templates(Idx2).Ptemplate;
679 call get_year;
680 end;
681 end;
682 else if substr (prod_source_pnotice(Idx), 1, 20) = "default_trade_secret" then
683
684 do Idx2 = 1 to pnotice_paths.Ntemplates;
685 if pnotice_paths.templates(Idx2).defaultTS then do;
686 Ltotal = Ltotal + pnotice_paths.templates(Idx2).Ltemplate - 1;
687 Ltemp = pnotice_paths.templates(Idx2).Ltemplate - 1;
688
689 Ptemp = pnotice_paths.templates(Idx2).Ptemplate;
690 pn = pn || " acc " || """" || temp || """" || NL;
691
692 end;
693 end;
694
695 else do Idx2 = 1 to pnotice_paths.Ntemplates;
696 if pnotice_paths.templates(Idx2).primary_name = prod_source_pnotice(Idx) then do;
697 Ltotal = Ltotal + pnotice_paths.templates(Idx2).Ltemplate - 1;
698
699 Ltemp = pnotice_paths.templates(Idx2).Ltemplate - 1;
700 Ptemp = pnotice_paths.templates(Idx2).Ptemplate;
701 call get_year;
702
703
704 end;
705 end;
706 end;
707 call ioa_$ioa_switch (Piocb, "^-dec^-^d^3-""lgth of all pnotices + no. of pnotices", Ltotal + source_pnotices);
708 call ioa_$ioa_switch (Piocb, "^a", pn);
709 call ioa_$ioa_switch (Piocb, "^-aci^-""^a""", prod_sti);
710
711 call ioa_$ioa_switch (Piocb, "^-aci^-""^a""", substr(prod_sti, 1, 1) || "2" || substr(prod_sti, 3));
712
713 call ioa_$ioa_switch (Piocb, "^-aci^-""^a""", substr(prod_sti, 1, 1) || "3" || substr(prod_sti, 3));
714
715 call ioa_$ioa_switch (Piocb, "^-end");
716 call iox_$close (Piocb, code);
717 if code ^= 0 then
718 call com_err_ (code, ME, "Closing PNOTICE switch.");
719 call iox_$detach_iocb (Piocb, code);
720 if code ^= 0 then
721 call com_err_ (code, ME, "Detaching PNOTICE switch.");
722
723
724
725 call ioa_ ("Creating ^a>PNOTICE_^a.", rtrim(working_dir), prod);
726 call alm (rtrim(working_dir) || ">PNOTICE_" || prod);
727 return;
728
729 PNOTICE(3):
730
731
732 Piocb = null;
733 working_dir = get_wdir_ ();
734 call iox_$attach_ioname (ME, Piocb, "vfile_ "
735 || rtrim(working_dir) || ">" || "PNOTICE_"
736 || rtrim(prod) || ".alm", code);
737 if code ^= 0 then do;
738 call com_err_ (code, ME, "^/Attaching PNOTICE segment.");
739 return;
740 end;
741 call iox_$open (Piocb, 2, "0"b, code);
742 if code ^= 0 then do;
743 call com_err_ (code, ME, "^/Opening PNOTICE seg switch for output.");
744 return;
745 end;
746
747
748
749
750 call ioa_ ("Multiple PNOTICE segs required. Object will be done first.");
751 call ioa_$ioa_switch (Piocb, "^-dec^-1^3-""version 1 structure");
752 call ioa_$ioa_switch (Piocb, "^-dec^-^d^3-""no. of pnotices", object_pnotices);
753 call ioa_$ioa_switch (Piocb, "^-dec^-3^3-""no. of STIs");
754
755 if substr (prod_object_pnotice(1), 1, 8) = "default." then
756
757 do Idx2 = 1 to pnotice_paths.Ntemplates;
758 if pnotice_paths.templates(Idx2).defaultC then do;
759 Ltotal = Ltotal + pnotice_paths.templates(Idx2).Ltemplate - 1;
760 Ltemp = pnotice_paths.templates(Idx2).Ltemplate - 1;
761
762 Ptemp = pnotice_paths.templates(Idx2).Ptemplate;
763 call get_year;
764 end;
765 end;
766 else if substr (prod_object_pnotice(1), 1, 20) = "default_trade_secret" then
767
768 do Idx2 = 1 to pnotice_paths.Ntemplates;
769 if pnotice_paths.templates(Idx2).defaultTS then do;
770 Ltotal = Ltotal + pnotice_paths.templates(Idx2).Ltemplate - 1;
771 Ltemp = pnotice_paths.templates(Idx2).Ltemplate - 1;
772
773 Ptemp = pnotice_paths.templates(Idx2).Ptemplate;
774 pn = pn || " acc " || """" || temp || """" || NL;
775
776 end;
777 end;
778
779 else do Idx2 = 1 to pnotice_paths.Ntemplates;
780 if pnotice_paths.templates(Idx2).primary_name = prod_object_pnotice(1) then do;
781 Ltotal = Ltotal + pnotice_paths.templates(Idx2).Ltemplate - 1;
782
783 Ltemp = pnotice_paths.templates(Idx2).Ltemplate - 1;
784 Ptemp = pnotice_paths.templates(Idx2).Ptemplate;
785 call get_year;
786 end;
787 end;
788 call ioa_$ioa_switch (Piocb, "^-dec^-^d^3-""lgth of all pnotices + no. of pnotices", Ltotal + object_pnotices);
789 call ioa_$ioa_switch (Piocb, "^a", pn);
790 call ioa_$ioa_switch (Piocb, "^-aci^-""^a""", prod_sti);
791
792 call ioa_$ioa_switch (Piocb, "^-aci^-""^a""", substr(prod_sti, 1, 1) || "2" || substr(prod_sti, 3));
793
794 call ioa_$ioa_switch (Piocb, "^-aci^-""^a""", substr(prod_sti, 1, 1) || "3" || substr(prod_sti, 3));
795
796 call ioa_$ioa_switch (Piocb, "^-end");
797 call iox_$close (Piocb, code);
798 if code ^= 0 then
799 call com_err_ (code, ME, "Closing PNOTICE switch.");
800 call iox_$detach_iocb (Piocb, code);
801 if code ^= 0 then
802 call com_err_ (code, ME, "Detaching PNOTICE switch.");
803
804
805
806 call ioa_ ("Creating ^a>PNOTICE_^a.", rtrim(working_dir), prod);
807 call alm (rtrim(working_dir) || ">PNOTICE_" || prod);
808 call delete_$path (working_dir, "PNOTICE_" || rtrim(prod) || ".alm", "100100"b, ME, code);
809 if code ^= 0 then
810 call com_err_ (code, ME, "Deleting PNOTICE source for the object archive.");
811
812 Piocb = null;
813 Ltotal = 0;
814 pn = "";
815 call iox_$attach_ioname (ME, Piocb, "vfile_ "
816 || rtrim(working_dir) || ">" || "PNOTICE_"
817 || rtrim(prod) || ".alm", code);
818 if code ^= 0 then do;
819 call com_err_ (code, ME, "^/Attaching PNOTICE segment.");
820 return;
821 end;
822 call iox_$open (Piocb, 2, "0"b, code);
823 if code ^= 0 then do;
824 call com_err_ (code, ME, "^/Opening PNOTICE seg switch for output.");
825 return;
826 end;
827 call ioa_ ("Creating ^a>PNOTICE_^a.alm.", rtrim(working_dir), prod);
828 call ioa_$ioa_switch (Piocb, "^-dec^-1^3-""version 1 structure");
829 call ioa_$ioa_switch (Piocb, "^-dec^-^d^3-""no. of pnotices", source_pnotices);
830 call ioa_$ioa_switch (Piocb, "^-dec^-3^3-""no. of STIs");
831
832 if substr (prod_source_pnotice(1), 1, 8) = "default." then
833
834 do Idx2 = 1 to pnotice_paths.Ntemplates;
835 if pnotice_paths.templates(Idx2).defaultC then do;
836 Ltotal = Ltotal + pnotice_paths.templates(Idx2).Ltemplate - 1;
837 Ltemp = pnotice_paths.templates(Idx2).Ltemplate - 1;
838
839 Ptemp = pnotice_paths.templates(Idx2).Ptemplate;
840 call get_year;
841 end;
842 end;
843 else if substr (prod_source_pnotice(1), 1, 20) = "default_trade_secret" then
844
845 do Idx2 = 1 to pnotice_paths.Ntemplates;
846 if pnotice_paths.templates(Idx2).defaultTS then do;
847 Ltotal = Ltotal + pnotice_paths.templates(Idx2).Ltemplate - 1;
848 Ltemp = pnotice_paths.templates(Idx2).Ltemplate - 1;
849
850 Ptemp = pnotice_paths.templates(Idx2).Ptemplate;
851 pn = pn || " acc " || """" || temp || """" || NL;
852
853 end;
854 end;
855
856 else do Idx2 = 1 to pnotice_paths.Ntemplates;
857 if pnotice_paths.templates(Idx2).primary_name = prod_source_pnotice(1) then do;
858 Ltotal = Ltotal + pnotice_paths.templates(Idx2).Ltemplate - 1;
859
860 Ltemp = pnotice_paths.templates(Idx2).Ltemplate - 1;
861 Ptemp = pnotice_paths.templates(Idx2).Ptemplate;
862 call get_year;
863 end;
864 end;
865 call ioa_$ioa_switch (Piocb, "^-dec^-^d^3-""lgth of all pnotices + no. of pnotices", Ltotal + source_pnotices);
866 call ioa_$ioa_switch (Piocb, "^a", pn);
867 call ioa_$ioa_switch (Piocb, "^-aci^-""^a""", prod_sti);
868
869 call ioa_$ioa_switch (Piocb, "^-aci^-""^a""", substr(prod_sti, 1, 1) || "2" || substr(prod_sti, 3));
870
871 call ioa_$ioa_switch (Piocb, "^-aci^-""^a""", substr(prod_sti, 1, 1) || "3" || substr(prod_sti, 3));
872
873 call ioa_$ioa_switch (Piocb, "^-end");
874 call iox_$close (Piocb, code);
875 if code ^= 0 then
876 call com_err_ (code, ME, "Closing PNOTICE switch.");
877 call iox_$detach_iocb (Piocb, code);
878 if code ^= 0 then
879 call com_err_ (code, ME, "Detaching PNOTICE switch.");
880
881
882
883 return;
884
885 PNOTICE(4):
886
887
888 Piocb = null;
889 working_dir = get_wdir_ ();
890 call iox_$attach_ioname (ME, Piocb, "vfile_ "
891 || rtrim(working_dir) || ">" || "PNOTICE_"
892 || rtrim(prod) || ".alm", code);
893 if code ^= 0 then do;
894 call com_err_ (code, ME, "^/Attaching PNOTICE segment.");
895 return;
896 end;
897 call iox_$open (Piocb, 2, "0"b, code);
898 if code ^= 0 then do;
899 call com_err_ (code, ME, "^/Opening PNOTICE seg switch for output.");
900 return;
901 end;
902
903
904
905
906 call ioa_ ("Multiple PNOTICE segs required. Object will be done first.");
907 call ioa_$ioa_switch (Piocb, "^-dec^-1^3-""version 1 structure");
908 call ioa_$ioa_switch (Piocb, "^-dec^-^d^3-""no. of pnotices", object_pnotices);
909 call ioa_$ioa_switch (Piocb, "^-dec^-3^3-""no. of STIs");
910
911 do Idx = 1 to object_pnotices;
912
913
914 if substr (prod_object_pnotice(Idx), 1, 8) = "default." then
915
916 do Idx2 = 1 to pnotice_paths.Ntemplates;
917 if pnotice_paths.templates(Idx2).defaultC then do;
918 Ltotal = Ltotal + pnotice_paths.templates(Idx2).Ltemplate - 1;
919 Ltemp = pnotice_paths.templates(Idx2).Ltemplate - 1;
920
921 Ptemp = pnotice_paths.templates(Idx2).Ptemplate;
922 call get_year;
923 end;
924 end;
925 else if substr (prod_object_pnotice(Idx), 1, 20) = "default_trade_secret" then
926
927 do Idx2 = 1 to pnotice_paths.Ntemplates;
928 if pnotice_paths.templates(Idx2).defaultTS then do;
929 Ltotal = Ltotal + pnotice_paths.templates(Idx2).Ltemplate - 1;
930 Ltemp = pnotice_paths.templates(Idx2).Ltemplate - 1;
931
932 Ptemp = pnotice_paths.templates(Idx2).Ptemplate;
933 pn = pn || " acc " || """" || temp || """" || NL;
934
935 end;
936 end;
937
938 else do Idx2 = 1 to pnotice_paths.Ntemplates;
939 if pnotice_paths.templates(Idx2).primary_name = prod_object_pnotice(Idx) then do;
940 Ltotal = Ltotal + pnotice_paths.templates(Idx2).Ltemplate - 1;
941
942 Ltemp = pnotice_paths.templates(Idx2).Ltemplate - 1;
943 Ptemp = pnotice_paths.templates(Idx2).Ptemplate;
944 call get_year;
945 end;
946 end;
947 end;
948 call ioa_$ioa_switch (Piocb, "^-dec^-^d^3-""lgth of all pnotices + no. of pnotices", Ltotal + object_pnotices);
949 call ioa_$ioa_switch (Piocb, "^a", pn);
950 call ioa_$ioa_switch (Piocb, "^-aci^-""^a""", prod_sti);
951
952 call ioa_$ioa_switch (Piocb, "^-aci^-""^a""", substr(prod_sti, 1, 1) || "2" || substr(prod_sti, 3));
953
954 call ioa_$ioa_switch (Piocb, "^-aci^-""^a""", substr(prod_sti, 1, 1) || "3" || substr(prod_sti, 3));
955
956 call ioa_$ioa_switch (Piocb, "^-end");
957 call iox_$close (Piocb, code);
958 if code ^= 0 then
959 call com_err_ (code, ME, "Closing PNOTICE switch.");
960 call iox_$detach_iocb (Piocb, code);
961 if code ^= 0 then
962 call com_err_ (code, ME, "Detaching PNOTICE switch.");
963
964
965
966 call ioa_ ("Creating ^a>PNOTICE_^a.", rtrim(working_dir), prod);
967 call alm (rtrim(working_dir) || ">PNOTICE_" || prod);
968
969 call delete_$path (working_dir, "PNOTICE_" || rtrim(prod) || ".alm", "100100"b, ME, code);
970 if code ^= 0 then
971 call com_err_ (code, ME, "Deleting PNOTICE source for the object archive.");
972
973 Piocb = null;
974 Ltotal = 0;
975 pn = "";
976 call iox_$attach_ioname (ME, Piocb, "vfile_ "
977 || rtrim(working_dir) || ">" || "PNOTICE_"
978 || rtrim(prod) || ".alm", code);
979 if code ^= 0 then do;
980 call com_err_ (code, ME, "^/Attaching PNOTICE segment.");
981 return;
982 end;
983 call iox_$open (Piocb, 2, "0"b, code);
984 if code ^= 0 then do;
985 call com_err_ (code, ME, "^/Opening PNOTICE seg switch for output.");
986 return;
987 end;
988 call ioa_ ("Creating ^a>PNOTICE_^a.alm.", rtrim(working_dir), prod);
989 call ioa_$ioa_switch (Piocb, "^-dec^-1^3-""version 1 structure");
990 call ioa_$ioa_switch (Piocb, "^-dec^-^d^3-""no. of pnotices", source_pnotices);
991 call ioa_$ioa_switch (Piocb, "^-dec^-3^3-""no. of STIs");
992
993 do Idx = 1 to source_pnotices;
994 if substr (prod_source_pnotice(Idx), 1, 8) = "default." then
995
996 do Idx2 = 1 to pnotice_paths.Ntemplates;
997 if pnotice_paths.templates(Idx2).defaultC then do;
998 Ltotal = Ltotal + pnotice_paths.templates(Idx2).Ltemplate - 1;
999 Ltemp = pnotice_paths.templates(Idx2).Ltemplate - 1;
1000
1001 Ptemp = pnotice_paths.templates(Idx2).Ptemplate;
1002 call get_year;
1003 end;
1004 end;
1005 else if substr (prod_source_pnotice(Idx), 1, 20) = "default_trade_secret" then
1006
1007 do Idx2 = 1 to pnotice_paths.Ntemplates;
1008 if pnotice_paths.templates(Idx2).defaultTS then do;
1009 Ltotal = Ltotal + pnotice_paths.templates(Idx2).Ltemplate - 1;
1010 Ltemp = pnotice_paths.templates(Idx2).Ltemplate - 1;
1011
1012 Ptemp = pnotice_paths.templates(Idx2).Ptemplate;
1013 pn = pn || " acc " || """" || temp || """" || NL;
1014
1015 end;
1016 end;
1017
1018 else do Idx2 = 1 to pnotice_paths.Ntemplates;
1019 if pnotice_paths.templates(Idx2).primary_name = prod_source_pnotice(Idx) then do;
1020 Ltotal = Ltotal + pnotice_paths.templates(Idx2).Ltemplate - 1;
1021
1022 Ltemp = pnotice_paths.templates(Idx2).Ltemplate - 1;
1023 Ptemp = pnotice_paths.templates(Idx2).Ptemplate;
1024 call get_year;
1025 end;
1026 end;
1027 end;
1028 call ioa_$ioa_switch (Piocb, "^-dec^-^d^3-""lgth of all pnotices + no. of pnotices", Ltotal + source_pnotices);
1029 call ioa_$ioa_switch (Piocb, "^a", pn);
1030 call ioa_$ioa_switch (Piocb, "^-aci^-""^a""", prod_sti);
1031
1032 call ioa_$ioa_switch (Piocb, "^-aci^-""^a""", substr(prod_sti, 1, 1) || "2" || substr(prod_sti, 3));
1033
1034 call ioa_$ioa_switch (Piocb, "^-aci^-""^a""", substr(prod_sti, 1, 1) || "3" || substr(prod_sti, 3));
1035
1036 call ioa_$ioa_switch (Piocb, "^-end");
1037 call iox_$close (Piocb, code);
1038 if code ^= 0 then
1039 call com_err_ (code, ME, "Closing PNOTICE switch.");
1040 call iox_$detach_iocb (Piocb, code);
1041 if code ^= 0 then
1042 call com_err_ (code, ME, "Detaching PNOTICE switch.");
1043
1044
1045
1046 return;
1047
1048
1049 get_year:
1050 proc;
1051
1052 dcl temp2 char(Ltemp);
1053
1054 Iyr = index(Ptemp->temp,"<yr>");
1055 if Iyr = 0 then
1056 pn = pn || " acc " || """" || temp || """" || NL;
1057 else do;
1058 temp2 = Ptemp->temp;
1059 substr(temp2,Iyr,4) = current_year_a;
1060 pn = pn || " acc " || """" || temp2 || """" || NL;
1061 end;
1062 return;
1063 end get_year;
1064
1065
1066 end make_PNOTICE;
1067 %page;
1068
1069
1070
1071 archive_PNOTICE:
1072 proc (source_dir, object_dir);
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084 dcl source_dir char(*),
1085 object_dir char(*);
1086
1087
1088 S_ARCHIVE:
1089 component_name = "PNOTICE_" || rtrim(prod) || ".alm";
1090 if Fspec then do;
1091 this_is_source_archive = True;
1092 call check_acl (Ps_archive, sdir, sentry, Fmust_reset_source);
1093 goto S_INFO;
1094 end;
1095 call hcs_$initiate_count (source_dir, prod_source_ename, "", sbit_count, 0, Ps_archive, code);
1096 if Ps_archive = null then do;
1097 call com_err_ (code, ME, "Initiating source archive - Procedure terminated.");
1098 return;
1099 end;
1100 S_INFO: call archive_$get_component_info (Ps_archive, sbit_count, component_name, addr(ACI), code);
1101 if code = error_table_$no_component then
1102 goto NO_S_COMPONENT;
1103 else if code ^= 0 then do;
1104 call com_err_ (code, ME, "^/Getting source archive component info, PNOTICE not appended.");
1105 return;
1106 end;
1107 else do;
1108 call ioa_ ("Replacing ^a in ^a in ^a.", component_name, prod_source_ename, source_dir);
1109 call archive ("rd", rtrim(source_dir) || ">" || rtrim(prod_source_ename),
1110 rtrim(working_dir) || ">" || rtrim(component_name));
1111
1112 goto O_ARCHIVE;
1113 end;
1114
1115 NO_S_COMPONENT:
1116 call ioa_ ("Appending ^a to ^a in ^a.", component_name, prod_source_ename, source_dir);
1117 call archive ("ad", rtrim(source_dir) || ">" || rtrim(prod_source_ename),
1118 rtrim(working_dir) || ">" || rtrim(component_name));
1119
1120
1121
1122 O_ARCHIVE:
1123 component_name = rtrim("PNOTICE_" || rtrim(prod));
1124 if Fspec then do;
1125 this_is_object_archive = True;
1126 call check_acl (Po_archive, odir, oentry, Fmust_reset_object);
1127 goto O_INFO;
1128 end;
1129 call hcs_$initiate_count (object_dir, prod_object_ename, "", obit_count, 0, Po_archive, code);
1130 if Po_archive = null then do;
1131 call com_err_ (code, ME, "Initiating object archive - Procedure terminated.");
1132 return;
1133 end;
1134 O_INFO: call archive_$get_component_info (Po_archive, obit_count, component_name, addr(ACI), code);
1135 if code = error_table_$no_component then
1136 goto NO_O_COMPONENT;
1137 else if code ^= 0 then do;
1138 call com_err_ (code, ME, "^/Getting object archive component info, PNOTICE not appended.");
1139 return;
1140 end;
1141 else do;
1142 call ioa_ ("Replacing ^a in ^a in ^a.", component_name, prod_object_ename, object_dir);
1143 call archive ("rd", rtrim(object_dir) || ">" || rtrim(prod_object_ename),
1144 rtrim(working_dir) || ">" || rtrim(component_name));
1145
1146 goto END_ARCHIVE;
1147 end;
1148 NO_O_COMPONENT:
1149 call ioa_ ("Appending ^a to ^a in ^a.", component_name, prod_object_ename, object_dir);
1150 call archive ("ad", rtrim(object_dir) || ">" || rtrim(prod_object_ename),
1151 rtrim(working_dir) || ">" || rtrim(component_name));
1152
1153
1154
1155 END_ARCHIVE:
1156 return;
1157 end archive_PNOTICE;
1158 %page;
1159
1160
1161
1162 check_acl:
1163 proc (Aptr, Adir, Aentry, Areset_acl);
1164
1165
1166 dcl Aptr ptr,
1167 Adir char(*),
1168 Aentry char(*),
1169 Atype bit(1),
1170 Areset_acl bit(1);
1171 dcl Acode fixed bin (35),
1172 original_source_mode bit(36) aligned,
1173 original_object_mode bit(36) aligned;
1174
1175 dcl 1 acle(1),
1176
1177 2 name char(32) aligned,
1178 2 mode bit(36) aligned,
1179 2 mbz bit(36) aligned,
1180 2 code fixed bin (35);
1181
1182 dcl 1 del_acl(1),
1183 2 name char(32) aligned,
1184 2 code fixed bin (35);
1185
1186 dcl one_word char(4) based,
1187 error_table_$user_not_found fixed bin(35) ext static;
1188
1189 on no_write_permission goto FORCE_ACL;
1190 Aptr -> one_word = Aptr -> one_word;
1191 return;
1192
1193
1194 FORCE_ACL:
1195 acle(1).name = get_group_id_ ();
1196 acle(1).mode = "0"b;
1197 acle(1).mbz = "0"b;
1198 acle(1).code = 0;
1199 call hcs_$list_acl (Adir, Aentry, null, null, addr(acle), 1, Acode);
1200 if acle(1).code ^= 0 then
1201 if acle(1).code = error_table_$user_not_found then do;
1202
1203 if this_is_source_archive then
1204 user_on_source_acl = False;
1205 if this_is_object_archive then
1206 user_on_object_acl = False;
1207 end;
1208 else
1209 goto ERROR;
1210 else do;
1211 if Acode ^= 0 then do;
1212 acle(1).code = Acode;
1213 goto ERROR;
1214 end;
1215 if this_is_source_archive then do;
1216 user_on_source_acl = True;
1217 original_source_mode = acle(1).mode;
1218 end;
1219 if this_is_object_archive then do;
1220 user_on_object_acl = True;
1221 original_object_mode = acle(1).mode;
1222 end;
1223 end;
1224 acle(1).mode = "101"b;
1225 acle(1).mbz = "0"b;
1226 acle(1).code = 0;
1227 call hcs_$add_acl_entries (Adir, Aentry, addr(acle), 1, Acode);
1228 if Acode ^= 0 then do;
1229 call com_err_ (Acode, ME, "
1230 Unable to force write access for ^a to ^a>^a.", acle(1).name, Adir, Aentry);
1231 goto CLEAN;
1232 end;
1233 Areset_acl = True;
1234 return;
1235 ERROR: call com_err_ (acle(1).code, ME, "
1236 When listing ^a's access to ^a>^a", acle(1).name, Adir, Aentry);
1237 goto CLEAN;
1238
1239
1240
1241
1242 check_acl$reset_acl:
1243 entry (Aptr, Adir, Aentry, Atype, Areset_acl);
1244
1245 acle(1).name = get_group_id_ ();
1246
1247 if Areset_acl then do;
1248 if Atype = True then
1249 acle(1).mode = original_source_mode;
1250 else
1251 acle(1).mode = original_object_mode;
1252 acle(1).mbz = "0"b;
1253 acle(1).code = 0;
1254 call hcs_$add_acl_entries (Adir, Aentry, addr(acle), 1, Acode);
1255 if acle(1).code ^= 0 then do;
1256 call com_err_ (Acode, ME, "
1257 Restoring access for ^a to ^a>^a.", acle(1).name, Adir, Aentry);
1258 return;
1259 end;
1260 end;
1261 else do;
1262 del_acl(1).name = acle(1).name;
1263 del_acl(1).code = 0;
1264 call hcs_$delete_acl_entries (Adir, Aentry, addr(del_acl), 1, Acode);
1265 if Acode ^= 0 then
1266 call com_err_ (Acode, ME, "
1267 Removing access for ^a to ^a>^a.", del_acl(1).name, Adir, Aentry);
1268 return;
1269 end;
1270 return;
1271
1272 end check_acl;
1273
1274 %page;
1275
1276
1277
1278
1279
1280 check_multiple_pnotices:
1281 proc returns (bit (1));
1282
1283 dcl Idx1 fixed bin,
1284 Idx2 fixed bin,
1285 value bit (1),
1286 TS bit (1),
1287 CP bit (1);
1288
1289 value = True;
1290 TS = False;
1291 CP = False;
1292 do Idx = 1 to source_pnotices;
1293 if after(prod_source_pnotice(Idx), ".") = "trade_secret.pnotice" then
1294 TS = True;
1295 else
1296 CP = True;
1297 do Idx1 = 1 to source_pnotices;
1298 do Idx2 = Idx1 + 1 to source_pnotices;
1299 if prod_source_pnotice(Idx1) = prod_source_pnotice(Idx2) then
1300 call ioa_ ("Error in psp_info_ for ^a: Duplicate source notices.", prod);
1301 end;
1302 end;
1303 end;
1304 if CP & TS then do;
1305 call ioa_ ("Error in psp_info_ for ^a: mixed copyright and Trade Secret for source.", prod);
1306 value = False;
1307 end;
1308
1309 TS = False;
1310 CP = False;
1311 do Idx = 1 to object_pnotices;
1312 if after(prod_object_pnotice(Idx), ".") = "trade_secret.pnotice" then
1313 TS = True;
1314 else
1315 CP = True;
1316 do Idx1 = 1 to object_pnotices;
1317 do Idx2 = Idx1 + 1 to object_pnotices;
1318 if prod_object_pnotice(Idx1) = prod_object_pnotice(Idx2) then
1319 call ioa_ ("Error in psp_info_ for ^a: duplicate object notices.", prod);
1320 end;
1321 end;
1322 end;
1323 if CP & TS then do;
1324 call ioa_ ("Error in psp_info_ for ^a: mixed copyright and Trade Secret for object.", prod);
1325 value = False;
1326 end;
1327
1328
1329 return (value);
1330 end check_multiple_pnotices;
1331 %page;
1332
1333
1334
1335
1336 get_PNOTICE_info:
1337 proc;
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352 dcl product_known bit(1),
1353 prodno fixed bin;
1354
1355
1356 call ioa_ ("Type ""?"" for more info on any question.");
1357 call ioa_ ("Type ""exit"" at any time to exit prematurely.");
1358 ASK_PROD: call command_query_ (addr(query_info), answer, ME, "-> Generic name? ");
1359 if answer = "exit" then
1360 goto CLEAN;
1361 if answer = "?" then do;
1362 call ioa_ ("Generic name (<= 20 chars).
1363 ^/A descriptive short name for the software module(s) to be protected.");
1364 goto ASK_PROD;
1365 end;
1366 else do;
1367 call check_entryname_ ("PNOTICE_" || answer || ".alm", code);
1368
1369 if code ^= 0 then do;
1370 call com_err_ (code, ME, "
1371 Your answer would form an illegal name:^/PNOTICE_^a.alm", answer);
1372 goto ASK_PROD;
1373 end;
1374 else
1375 prod = answer;
1376 end;
1377 do prodno = 1 to product.prod_number while (prod ^= product.num(prodno).prod_name);
1378
1379 end;
1380 if prodno > product.prod_number then
1381 product_known = False;
1382 else product_known = True;
1383 if product_known & product.num(prodno).prod_use(1) ^= "" then do;
1384 call ioa_ ("Multiple products found in psp_info_.
1385 ^/Please use this command for each product.");
1386
1387
1388
1389
1390 goto CLEAN;
1391 end;
1392 if product_known then
1393 call ioa_ ("^a is in psp_info_, type ""pr"" to see the STI, else input new STI.", prod);
1394 ASK_STI: call command_query_ (addr(query_info), answer, ME, "-> STI? ");
1395 if answer = "exit" then
1396 goto CLEAN;
1397 if answer = "?" then do;
1398 call ioa_ ("STI (12 chars).
1399 Software Technical ID. May be blank for non-product software.
1400 Type CR for blank STI.^/Type ""..help sti.gi"" for more information.");
1401 goto ASK_STI;
1402 end;
1403 else if answer = "pr" then do;
1404 if product_known then
1405 call ioa_ ("STI for ^a:^-^a", prod, product.num(prodno).prod_STI);
1406 else
1407 call ioa_ ("^a is not in psp_info_, there is no STI.", prod);
1408 goto ASK_STI;
1409 end;
1410 else if product_known then do;
1411 if answer = "" then do;
1412 call ioa_ ("Error - ^a is in psp_info_. You must supply an updated STI.", prod);
1413 call ioa_ ("Type ""pr"" to see STI, type ""..help sti.gi"" for more information.");
1414 goto ASK_STI;
1415 end;
1416 else if length(answer) ^= 12 then do;
1417 call ioa_ ("Error - the STI must be 12 characters long.");
1418 goto ASK_STI;
1419 end;
1420 prod_sti = answer;
1421 if ^parse_pnotice_info_$validate_sti (prod_sti) then do;
1422 call ioa_ ("Error - invalid STI: ^a", prod_sti);
1423 goto ASK_STI;
1424 end;
1425 end;
1426 else do;
1427 if answer = "" then do;
1428 prod_sti = answer;
1429 goto ASK_PNOTICE;
1430 end;
1431
1432 else if length(answer) ^= 12 then do;
1433 call ioa_ ("Error - the STI must be 12 characters long.^/Type ""..help sti.gi"" for more information.");
1434 goto ASK_STI;
1435 end;
1436 prod_sti = answer;
1437 if ^parse_pnotice_info_$validate_sti (prod_sti) then do;
1438 call ioa_ ("Error - Invalid Software Technical Identifier.");
1439 goto ASK_STI;
1440 end;
1441 end;
1442 answer = "";
1443 ASK_PNOTICE:
1444 if product_known then do;
1445
1446 call ioa_ ("^a is in psp_info_.^/Type ""ls"" for list of notice names in psp_info_ for ^a.", prod, prod);
1447 call ioa_ ("Type ""lpn"" to see all available notice names.
1448 Type ""yes"" to include notices already in psp_info_, or ""no"" to input your own notices.");
1449 ASK1: call command_query_ (addr(query_info), answer, ME,
1450 "Include the notices from psp_info_? Type ""yes"" or ""no"".");
1451 if answer = "exit" then
1452 goto CLEAN;
1453 if answer = "yes" then do;
1454 Idx = 0;
1455 do Idx3 = 1 to hbound (product.num.source_C, 2);
1456 if product.num(prodno).source_C(Idx3) = "" then;
1457 else do;
1458 prod_source_pnotice(Idx3) = product.num(prodno).source_C(Idx3);
1459 Idx1 = check_name(prod_source_pnotice(Idx3));
1460 if Idx1 > pnotice_paths.Ntemplates then do;
1461 code = error_table_$name_not_found;
1462 call com_err_ (code, ME, "^/Invalid psp_info_ name - ^a.", prod_source_pnotice(Idx3));
1463 goto CLEAN;
1464 end;
1465 Idx = Idx + 1;
1466 if Idx > 1 then
1467 if ^templates_compatible(prod_source_pnotice)
1468 then do;
1469 call com_err_ (code, ME, "^a - ^/pnotice types not compatible", prod);
1470 goto CLEAN;
1471 end;
1472 source_pnotices = source_pnotices + 1;
1473 end;
1474 end;
1475 Idx = 0;
1476 do Idx3 = 1 to hbound (product.num.object_C, 2);
1477 if product.num(prodno).object_C(Idx3) = "" then;
1478 else do;
1479 prod_object_pnotice(Idx3) = product.num(prodno).object_C(Idx3);
1480 Idx1 = check_name(prod_object_pnotice(Idx3));
1481 if Idx1 > pnotice_paths.Ntemplates then do;
1482 code = error_table_$name_not_found;
1483 call com_err_ (code, ME, "^/Invalid psp_info_ name - ^a.", prod_object_pnotice(Idx3));
1484 goto CLEAN;
1485 end;
1486 Idx = Idx + 1;
1487 if Idx > 1 then
1488 if ^templates_compatible(prod_object_pnotice)
1489 then do;
1490 call com_err_ (code, ME, "^a - ^/pnotice types not compatible", prod);
1491 goto CLEAN;
1492 end;
1493 object_pnotices = object_pnotices + 1;
1494 end;
1495 end;
1496 goto GOT_PSP;
1497 end;
1498
1499 else if answer = "lpn" then do;
1500
1501 call list_pnotice_names ();
1502 goto ASK1;
1503 end;
1504 else if answer = "ls" then do;
1505 call ioa_ ("Source notices in psp_info_ for ^a:", prod);
1506 do Idx = 1 to hbound(product.num.source_C, 2) while (product.num(prodno).source_C(Idx) ^= "");
1507 call ioa_ ("^3x^a", product.num(prodno).source_C(Idx));
1508 end;
1509 call ioa_ ("Object notices in psp_info_ for ^a:", prod);
1510 do Idx = 1 to hbound(product.num.object_C, 2) while (product.num(prodno).object_C(Idx) ^= "");
1511 call ioa_ ("^3x^a", product.num(prodno).object_C(Idx));
1512 end;
1513 goto ASK1;
1514 end;
1515 else if answer = "no" then do;
1516 source_pnotices = 0;
1517 object_pnotices = 0;
1518 goto START_PN;
1519 end;
1520 else do;
1521 call ioa_ ("Unrecognized answer - ^a", answer);
1522 goto ASK_PNOTICE;
1523 end;
1524 GOT_PSP: call ioa_ ("Notices from psp_info_ have been included.");
1525 call command_query_ (addr(query_info), answer, ME, "->Do you wish to input more? Type ""yes"" or ""no"":");
1526 if answer = "exit" then
1527 goto CLEAN;
1528 if answer = "yes" then do;
1529 START_PN: call ioa_ ("Input source pnotice names, type ""q"" when done.");
1530 Idx = 0;
1531 GET_PN: do Idx3 = source_pnotices to hbound(prod_source_pnotice, 1);
1532 ASK_SNAME: call command_query_ (addr(query_info), answer, ME, "-> Source pnotice name? ");
1533 if answer = "exit" then
1534 goto CLEAN;
1535 else if answer = "q" then do;
1536 if source_pnotices = 0 then do;
1537 call ioa_ ("There must be at least one source notice.");
1538 goto ASK_SNAME;
1539 end;
1540 else
1541 goto BEGIN_ONAME;
1542 end;
1543 else if answer = "?" then do;
1544 call ioa_ ("Source pnotice name (<= 24 chars).
1545 ^/Primary name of a pnotice template, without the "".pnotice"" suffix.");
1546 goto ASK_SNAME;
1547 end;
1548 else if answer = "lpn" then do;
1549 call list_pnotice_names ();
1550 goto ASK_SNAME;
1551 end;
1552 else if index (answer, "pnotice") ^= 0 then do;
1553 call ioa_ ("Error - Type template primary name, without the ""pnotice"" suffix.");
1554 goto ASK_SNAME;
1555 end;
1556 else do;
1557 Idx2 = check_name(answer);
1558 if Idx2 > pnotice_paths.Ntemplates then do;
1559 code = error_table_$name_not_found;
1560 call com_err_ (code, ME, "^/The template was not found - ^a.", answer);
1561 call ioa_ ("Type ""lpn"" for template names.");
1562 goto ASK_SNAME;
1563 end;
1564 Idx = Idx + 1;
1565 prod_source_pnotice(Isnotice + Idx) =
1566 templates(Idx2).primary_name;
1567
1568 if Idx > 1 then
1569 if ^templates_compatible(prod_source_pnotice)
1570 then do;
1571 call com_err_ (code, ME, "^a - ^/pnotice types not compatible", prod);
1572 goto ASK_SNAME;
1573 end;
1574 end;
1575 source_pnotices = Idx;
1576 end;
1577 BEGIN_ONAME: call ioa_ ("Input object pnotice names, type ""q"" when done.");
1578 Idx = 0;
1579 do Idx3 = object_pnotices to hbound(prod_object_pnotice, 1);
1580 ASK_ONAME: call command_query_ (addr(query_info), answer, ME, "-> Object pnotice name? ");
1581 if answer = "exit" then
1582 goto CLEAN;
1583 if answer = "q" then do;
1584 if object_pnotices = 0 then do;
1585 call ioa_ ("There must be at least one object notice.");
1586 goto ASK_ONAME;
1587 end;
1588 else
1589 goto ASK_SARCHIVE;
1590 end;
1591 else if answer = "?" then do;
1592 call ioa_ ("Object pnotice name (<= 24 chars).
1593 ^/Primary name of a pnotice template, without the "".pnotice"" suffix.");
1594 goto ASK_ONAME;
1595 end;
1596 else if answer = "lpn" then do;
1597 call list_pnotice_names ();
1598 goto ASK_ONAME;
1599 end;
1600 else if index (answer, "pnotice") ^= 0 then do;
1601 call ioa_ ("Error - Type template primary name, without the ""pnotice"" suffix.");
1602 goto ASK_ONAME;
1603 end;
1604 else do;
1605 Idx2 = check_name(answer);
1606 if Idx2 > pnotice_paths.Ntemplates then do;
1607 code = error_table_$name_not_found;
1608 call com_err_ (code, ME, "^/The template was not found - ^a.", answer);
1609 call ioa_ ("^/Type ""lpn"" for template names.");
1610 goto ASK_ONAME;
1611 end;
1612 Idx = Idx + 1;
1613 prod_object_pnotice(Ionotice + Idx) =
1614 templates(Idx2).primary_name;
1615
1616 if Idx > 1 then
1617 if ^templates_compatible(prod_object_pnotice)
1618 then do;
1619 call com_err_ (code, ME, "^a - ^/pnotice types not compatible", prod);
1620 goto ASK_ONAME;
1621 end; end;
1622 object_pnotices = Idx;
1623 end;
1624 end;
1625 end;
1626 else do;
1627 Idx = 0;
1628 call ioa_ ("Input source pnotice names.
1629 Type ""q"" when done.^/Type ""lpn"" to see all available notice names.");
1630 do Idx3 = object_pnotices to hbound(prod_object_pnotice, 1);
1631 ASK_SNAME_ALL: call command_query_ (addr(query_info), answer, ME, "-> Source pnotice name? ");
1632 if answer = "exit" then
1633 goto CLEAN;
1634 if answer = "?" then do;
1635 call ioa_ ("Source pnotice name (<= 24 chars).
1636 Primary name of a pnotice template, without the "".pnotice"" suffix.
1637 Type ""lpn"" for available names. Type ""q"" when finished.");
1638 goto ASK_SNAME_ALL;
1639 end;
1640 else if answer = "lpn" then do;
1641 call list_pnotice_names ();
1642 goto ASK_SNAME_ALL;
1643 end;
1644 else if index (answer, "pnotice") ^= 0 then do;
1645 call ioa_ ("Error - Type template primary name, without the ""pnotice"" suffix.");
1646 goto ASK_SNAME_ALL;
1647 end;
1648 else if answer = "" then do;
1649 call ioa_ ("Error - A pnotice primary name is required.");
1650 goto ASK_SNAME_ALL;
1651 end;
1652 else if answer = "q" & source_pnotices > 0 then
1653 goto BEGIN_ONAME_ALL;
1654 else do;
1655 Idx2 = check_name(answer);
1656 if Idx2 > pnotice_paths.Ntemplates then do;
1657 code = error_table_$name_not_found;
1658 call com_err_ (code, ME, "^/The template was not found - ^a.", answer);
1659 call ioa_ ("Type ""lpn"" for available names.");
1660 goto ASK_SNAME_ALL;
1661 end;
1662 Idx = Idx + 1;
1663 prod_source_pnotice(Idx) =
1664 templates(Idx2).primary_name;
1665
1666 if Idx > 1 then
1667 if ^templates_compatible(prod_source_pnotice) then
1668 goto ASK_SNAME_ALL;
1669 end;
1670 source_pnotices = Idx;
1671 end;
1672 BEGIN_ONAME_ALL:
1673 Idx = 0;
1674 call ioa_ ("Input object pnotice names. Type ""q"" when done.");
1675 do Idx3 = object_pnotices to hbound(prod_object_pnotice, 1);
1676 ASK_ONAME_ALL: call command_query_ (addr(query_info), answer, ME, "-> Object pnotice name? ");
1677 if answer = "exit" then
1678 goto CLEAN;
1679 if answer = "?" then do;
1680 call ioa_ ("Object pnotice name (<= 24 chars).
1681 Primary name of a pnotice template, without the "".pnotice"" suffix.
1682 Type ""lpn"" for available names. Type ""q"" when finished.");
1683 goto ASK_ONAME_ALL;
1684 end;
1685 else if answer = "lpn" then do;
1686 call list_pnotice_names ();
1687 goto ASK_ONAME_ALL;
1688 end;
1689 else if index (answer, "pnotice") ^= 0 then do;
1690
1691 call ioa_ ("Error - Type template primary name, without the ""pnotice"" suffix.");
1692 goto ASK_ONAME_ALL;
1693 end;
1694 else if answer = "" then do;
1695 call ioa_ ("Error - A pnotice primary name is required.");
1696 goto ASK_ONAME_ALL;
1697 end;
1698 else if answer = "q" & object_pnotices > 0 then
1699 goto ASK_SARCHIVE;
1700 else do;
1701 Idx2 = check_name(answer);
1702 if Idx2 > pnotice_paths.Ntemplates then do;
1703 code = error_table_$name_not_found;
1704 call com_err_ (code, ME, "^/The template was not found - ^a.", answer);
1705 call ioa_ ("^/Type ""lpn"" for available names.");
1706 goto ASK_ONAME_ALL;
1707 end;
1708 Idx = Idx + 1;
1709 prod_object_pnotice(Idx) =
1710 templates(Idx2).primary_name;
1711
1712 if Idx > 1 then
1713 if ^templates_compatible(prod_object_pnotice) then
1714 goto ASK_ONAME_ALL;
1715
1716 end;
1717 object_pnotices = Idx;
1718 end;
1719 end;
1720 ASK_SARCHIVE:
1721 call command_query_ (addr(query_info), answer, ME, "-> Pathname of source archive? ");
1722 if answer = "exit" then
1723 goto CLEAN;
1724 if answer = "?" then do;
1725 call ioa_ ("Archive pathname of source archive.
1726 ^/Example: >exl>new_dir>source>bound_new_.s");
1727 goto ASK_SARCHIVE;
1728 end;
1729 if index(answer, ".archive") = 0 then
1730 path = answer || ".archive";
1731 else
1732 path = answer;
1733 call expand_pathname_ (path, sdir, sentry, code);
1734 if code ^= 0 then do;
1735 call com_err_ (code, ME, "^a.", path);
1736 goto CLEAN;
1737 end;
1738 call hcs_$initiate_count (sdir, sentry, "", sbit_count, 0, Ps_archive, code);
1739 if Ps_archive = null then do;
1740 if code = error_table_$noentry then do;
1741 call com_err_ (code, ME, "^a.", path);
1742 goto ASK_SARCHIVE;
1743 end;
1744 else do;
1745 call com_err_ (code, ME, "^a. ^/Terminating this procedure.", path);
1746 goto CLEAN;
1747 end;
1748 end;
1749 if ^Fspec then
1750 call check_archive (sdir, sentry, Ps_archive);
1751 prod_source_ename = sentry;
1752
1753
1754 ASK_OARCHIVE:
1755 call command_query_ (addr(query_info), answer, ME, "-> Pathname of object archive? ");
1756 if answer = "exit" then
1757 goto CLEAN;
1758 if answer = "?" then do;
1759 call ioa_ ("Archive pathname of object archive.
1760 ^/Example: >exl>new_dir>object>bound_new_");
1761 goto ASK_OARCHIVE;
1762 end;
1763 if index(answer, ".archive") = 0 then
1764 path = answer || ".archive";
1765 else
1766 path = answer;
1767 call expand_pathname_ (path, odir, oentry, code);
1768 if code ^= 0 then do;
1769 call com_err_ (code, ME, "^a.", path);
1770 goto CLEAN;
1771 end;
1772 call hcs_$initiate_count (odir, oentry, "", obit_count, 0, Po_archive, code);
1773 if Po_archive = Ps_archive then do;
1774
1775 call ioa_ ("The same archive may not be used for both source and object pnotices.");
1776 call com_err_ (code, ME, "^a. ^/Terminating this procedure.",path);
1777 goto CLEAN;
1778 end;
1779 if Po_archive = null then do;
1780 if code = error_table_$noentry then do;
1781 call com_err_ (code, ME, "^a.", path);
1782 goto ASK_OARCHIVE;
1783 end;
1784 else do;
1785 call com_err_ (code, ME, "^a. ^/Terminating this procedure.", path);
1786 goto CLEAN;
1787 end;
1788 end;
1789 if ^Fspec then
1790 call check_archive (odir, oentry, Po_archive);
1791 prod_object_ename = oentry;
1792
1793
1794
1795
1796
1797 end get_PNOTICE_info;
1798
1799 %page;
1800 check_template_name:
1801 proc;
1802 check_name:
1803 entry(name_in) returns (fixed bin);
1804
1805 dcl name_in char(*) var,
1806 count_of fixed bin;
1807
1808 Fdcopy_right = False;
1809 Fdtrade_secret = False;
1810
1811 if name_in = "-trade_secret" | name_in = "-dts" then
1812 Fdtrade_secret = True;
1813
1814 if name_in = "-default_copyright" | name_in = "-dc" then
1815 Fdcopy_right = True;
1816
1817 if Ftrade_secret then do count_of = 1 to pnotice_paths.Ntemplates while (^pnotice_paths.templates(count_of).defaultTS);
1818 end;
1819
1820 if Fdcopy_right then do count_of = 1 to pnotice_paths.Ntemplates while (^pnotice_paths.templates(count_of).defaultC);
1821 end;
1822
1823 if ^Fdcopy_right & ^Fdtrade_secret then
1824 do count_of = 1 to pnotice_paths.Ntemplates while (name_in ^= templates(count_of).primary_name);
1825 end;
1826
1827 return(count_of);
1828
1829 end check_template_name;
1830 %page;
1831 templates_compatible:
1832 proc(name_in) returns(bit(1));
1833
1834 dcl name_in (10) char(32) varying,
1835 i fixed bin(24);
1836
1837 Ftrade_secret = False;
1838 Fdtrade_secret = False;
1839 Fpublic_domain = False;
1840 Fcopy_right = False;
1841 Fdcopy_right = False;
1842
1843 do i = 1 to Idx by 1;
1844 if name_in(i) = "-default_trade_secret" | name_in(i) = "-dts" then
1845 Fdtrade_secret = True;
1846 else
1847 if name_in(i) = "-default_copy_right" | name_in(i) = "-dc" then
1848 Fdcopy_right = True;
1849 else
1850 if name_in(i) = "public_domain" then
1851 Fpublic_domain = True;
1852 else
1853 if reverse(before(reverse(name_in(i)),".")) = "trade_secret" then
1854 Ftrade_secret = True;
1855 else
1856 Fcopy_right = True;
1857 end;
1858
1859 if (Fcopy_right | Fdcopy_right | Ftrade_secret| Fdtrade_secret) &
1860 Fpublic_domain then do;
1861 call ioa_ ("A public domain pnotice can only exist by itself");
1862 Idx = Idx - 1;
1863 return(False);
1864 end;
1865 if (Fcopy_right | Fdcopy_right | Fpublic_domain) & (Ftrade_secret |
1866 Fdtrade_secret) then do;
1867 call ioa_("Trade secret pnotices can only exist by themselves");
1868 return(False);
1869 end;
1870
1871 return(True);
1872
1873 end templates_compatible;
1874 %page;
1875 %include archive_component_info;
1876 %page;
1877 %include pnotice_paths;
1878 %page;
1879 %include software_pnotice_info_;
1880 %page;
1881 %include terminate_file;
1882
1883 end generate_pnotice;