1
2
3
4
5
6
7
8
9
10
11
12
13 copy_dir:
14 cpd:
15 procedure options (variable);
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36 dcl check_star_name_$entry entry (char (*), fixed bin (35));
37 dcl com_err_ entry options (variable);
38 dcl com_err_$suppress_name entry options (variable);
39 dcl copy_dir_ entry (char (*), char (*), char (*), char (*), char (*), ptr,
40 fixed bin (35));
41 dcl cu_$arg_count entry (fixed bin, fixed bin (35));
42 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35));
43 dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35));
44 dcl get_equal_name_ entry (char (*), char (*), char (32), fixed bin (35));
45 dcl get_system_free_area_ entry returns (ptr);
46 dcl get_wdir_ entry returns (char (168));
47 dcl hcs_$star_ entry (char (*), char (*), fixed bin (2), ptr, fixed bin, ptr, ptr,
48 fixed bin (35));
49
50
51
52 dcl cleanup condition;
53
54
55
56 dcl arg char (arg_len) based (arg_ptr);
57 dcl area area based (area_ptr);
58
59
60
61 dcl whoami char (8);
62 dcl code fixed bin (35);
63
64 dcl (
65 all_entries,
66 all_names,
67 errors,
68 have_source,
69 have_target,
70 same_dir,
71 multiple_sources,
72 move
73 ) bit (1);
74 dcl (
75 argno,
76 entry_count,
77 entry_index,
78 nargs
79 ) fixed bin;
80 dcl arg_len fixed bin (21);
81
82
83 dcl (sd_name, td_name, wd) char (168);
84 dcl (entry_temp, se_name, te_name)
85 char (32);
86 dcl (arg1, arg2) char (32) varying;
87 dcl (
88 area_ptr,
89 arg_ptr
90 ) ptr;
91
92
93
94 dcl (
95 error_table_$badopt,
96 error_table_$inconsistent,
97 error_table_$notadir,
98 error_table_$no_s_permission
99 ) fixed bin (35) external;
100
101
102
103 dcl (addr, binary, null, substr, sum)
104 builtin;
105 ^L
106
107 whoami = "copy_dir";
108 move = "0"b;
109 go to START;
110
111 move_dir:
112 mvd:
113 entry options (variable);
114
115 whoami = "move_dir";
116 move = "1"b;
117
118
119
120 START:
121 star_branch_count, star_link_count = 0;
122 star_select_sw = star_BRANCHES_ONLY;
123 area_ptr = get_system_free_area_ ();
124 star_entry_ptr, star_names_ptr = null ();
125 on condition (cleanup)
126 begin;
127 if star_names_ptr ^= null ()
128 then free star_names in (area);
129 if star_entry_ptr ^= null ()
130 then free star_entries in (area);
131 end;
132
133 wd = get_wdir_ ();
134 have_source = "0"b;
135 have_target = "0"b;
136 all_names = "1"b;
137 all_entries = "1"b;
138 errors = "0"b;
139 same_dir = "0"b;
140
141 cdo.version = copy_dir_options_version_0;
142 cdo.replace = "0"b;
143 cdo.link_translation = "1"b;
144 cdo.primary = "0"b;
145 cdo.acl = "0"b;
146 cdo.force = "0"b;
147 cdo.brief = "0"b;
148 cdo.chase = "0"b;
149 cdo.parent_ac_sw = "0"b;
150 cdo.link = "0"b;
151 cdo.seg = "0"b;
152 cdo.msf = "0"b;
153 cdo.nnlk = "0"b;
154 cdo.update = "0"b;
155 cdo.dir = "0"b;
156 cdo.raw = "0"b;
157 cdo.pad1, cdo.pad2 = "0"b;
158 if move
159 then cdo.delete = "1"b;
160 else cdo.delete = "0"b;
161
162
163
164
165 call cu_$arg_count (nargs, code);
166 if code ^= 0
167 then do;
168 call com_err_ (code, whoami);
169 return;
170 end;
171 if nargs = 0
172 then do;
173 usage:
174 call com_err_$suppress_name (0, whoami,
175 "Usage: ^a source_dir {target_dir} {-entry_type_keys} {-control_args} ", whoami);
176 goto finish;
177 end;
178
179
180 do argno = 1 to nargs;
181 call cu_$arg_ptr (argno, arg_ptr, arg_len, code);
182 if code ^= 0
183 then do;
184 call com_err_ (code, whoami, "On argument number ^d", argno);
185 goto finish;
186 end;
187
188 if substr (arg, 1, 1) ^= "-"
189 then if ^have_source
190 then do;
191 call expand_pathname_ (arg, sd_name, se_name, code);
192 if code ^= 0
193 then do;
194 err:
195 call com_err_ (code, whoami, "^a", arg);
196 goto finish;
197 end;
198 call check_star_name_$entry (se_name, code);
199 if code = 0
200 then do;
201 entry_count = 1;
202 multiple_sources = "0"b;
203 end;
204 else if (code = 1 | code = 2)
205 then multiple_sources = "1"b;
206 else do;
207 call com_err_ (code, whoami, "Star name check failed on ^a.", se_name);
208 goto finish;
209 end;
210 have_source = "1"b;
211 end;
212
213
214
215 else if ^have_target
216 then do;
217
218 call expand_pathname_ (arg, td_name, entry_temp, code);
219 if code ^= 0
220 then do;
221 call com_err_ (code, whoami, "^a", arg);
222 goto finish;
223 end;
224
225 have_target = "1"b;
226 end;
227 else do;
228 call com_err_ (error_table_$badopt, whoami,
229 "Too many pathnames, a maximum of two is allowed.");
230 goto finish;
231 end;
232 else if arg = "-replace" | arg = "-rp"
233 then cdo.replace = "1"b;
234 else if arg = "-update" | arg = "-ud"
235 then cdo.update = "1"b;
236 else if (arg = "-no_link_translation" | arg = "-nlt") & ^move
237 then cdo.link_translation = "0"b;
238 else if arg = "-acl"
239 then cdo.acl = "1"b;
240 else if arg = "-force" | arg = "-fc"
241 then cdo.force = "1"b;
242 else if arg = "-brief" | arg = "-bf"
243 then cdo.brief = "1"b;
244 else if arg = "-chase"
245 then cdo.chase = "1"b;
246 else if arg = "-primary" | arg = "-pri"
247 then cdo.primary = "1"b;
248 else if arg = "-interpret_as_standard_entry" | arg = "-inase"
249 then cdo.raw = "1"b;
250
251 else if arg = "-interpret_as_extended_entry" | arg = "-inaee"
252 then cdo.raw = "0"b;
253
254
255
256 else if arg = "-link" | arg = "-lk"
257 then do;
258 all_entries = "0"b;
259 cdo.link = "1"b;
260 end;
261 else if arg = "-sm" | arg = "-segment"
262 then do;
263 all_entries = "0"b;
264 cdo.seg = "1"b;
265 end;
266 else if arg = "-dr" | arg = "-directory"
267 then do;
268 all_entries = "0"b;
269 cdo.dir = "1"b;
270 end;
271 else if arg = "-branch" | arg = "-br"
272 then do;
273 all_entries = "0"b;
274 cdo.seg = "1"b;
275 cdo.msf = "1"b;
276 cdo.dir = "1"b;
277 end;
278 else if arg = "-file" | arg = "-f"
279 then do;
280 all_entries = "0"b;
281 cdo.seg = "1"b;
282 cdo.msf = "1"b;
283 end;
284 else if arg = "-msf" | arg = "-multisegment_file"
285 then do;
286 all_entries = "0"b;
287 cdo.msf = "1"b;
288 end;
289 else if arg = "-non_null_link" | arg = "-nnlk"
290 then do;
291 all_entries = "0"b;
292 cdo.nnlk = "1"b;
293 end;
294 else do;
295 call com_err_ (error_table_$badopt, whoami, "^a", arg);
296 goto finish;
297 end;
298 end;
299
300
301
302 if (cdo.nnlk & cdo.link)
303 then do;
304 arg1 = "-non_null_link";
305 arg2 = "-link";
306 incompatarg:
307 call com_err_ (error_table_$inconsistent, whoami, "Incompatible arguments ^a and ^a", arg1, arg2);
308 goto finish;
309 end;
310 if (cdo.replace & cdo.update)
311 then do;
312 arg1 = "-replace";
313 arg2 = "-update";
314 goto incompatarg;
315 end;
316 if (cdo.chase & ^(cdo.link | all_entries))
317 then do;
318 arg1 = "-chase";
319 arg2 = "not -link";
320 goto incompatarg;
321 end;
322 if ^have_target
323 then do;
324 td_name = wd;
325 entry_temp = "==";
326 end;
327 if all_entries
328 then cdo.link, cdo.seg, cdo.dir, cdo.msf = "1"b;
329
330
331
332
333
334
335 if multiple_sources
336 then do;
337
338 call hcs_$star_ (sd_name, se_name, star_BRANCHES_ONLY, area_ptr, star_entry_count, star_entry_ptr,
339 star_names_ptr, code);
340 if code ^= 0
341 then do;
342 call com_err_ (code, whoami, "Could not get matching names for ^a^[>^]^a.", sd_name,
343 sd_name ^= ">", se_name);
344 goto finish;
345 end;
346 entry_count = star_entry_count;
347 end;
348
349
350
351 do entry_index = 1 to entry_count;
352 if multiple_sources
353 then if star_entries (entry_index).type = star_DIRECTORY
354
355 then se_name = star_names (star_entries (entry_index).nindex);
356 else goto NEXT_ENTRY;
357
358 call get_equal_name_ (se_name, entry_temp, te_name, code);
359 call copy_dir_ (whoami, sd_name, se_name, td_name, te_name, addr (cdo), code);
360
361
362
363
364 NEXT_ENTRY:
365 end;
366 finish:
367 if star_names_ptr ^= null ()
368 then free star_names in (area);
369 if star_entry_ptr ^= null ()
370 then free star_entries in (area);
371
372 return;
373 %page;
374
375
376 %include star_structures;
377 %page;
378 %include query_info_;
379 %page;
380 %include copy_dir_options;
381
382 declare 1 cdo aligned like copy_dir_options;
383
384 end copy_dir;