1#! xPERL_PATHx
2#
3# Support for importing a source collection into CVS.
4# Tries to prevent the user from the most common pitfalls (like creating
5# new top-level repositories or second-level areas accidentally), and
6# cares to do some of the `dirty' work like maintaining the modules
7# database accordingly.
8#
9# Written by J�rg Wunsch, 95/03/07, and placed in the public domain.
10#
11# $FreeBSD$
12
13require "complete.pl";
14require "getopts.pl";
15
16
17sub scan_opts
18{
19    local($status);
20
21    $status = &Getopts("nv");
22
23    $dont_do_it = "-n" if $opt_n;
24    if($opt_v) {
25	print STDERR '$FreeBSD$' . "\n"; # 'emacs kludge
26	exit 0;
27    }
28    die "usage: $0 [-v] [-n] [moduledir]\n" .
29	"       -n: don't do any commit, show only\n" .
30	"       -v: show program version\n"
31	    unless $status && $#ARGV <= 0;
32
33    if($#ARGV == 0) {
34	$moduledir = $ARGV[0];
35	shift;
36    }
37}
38
39sub lsdir
40{
41    # find all subdirectories under @_
42    # ignore all CVS entries, dot entries, and non-directories
43
44    local($base) = @_;
45    local(@ls, @rv, $fname);
46
47    opendir(DIR, $base) || die "Cannot find dir $base.\n";
48
49    @ls = readdir(DIR);
50    closedir(DIR);
51
52    @rv = ();
53
54    foreach $fname (@ls) {
55	next if $fname =~ /^CVS/ || $fname eq "Attic"
56	    || $fname =~ /^\./ || ! -d "$base/$fname";
57	@rv = (@rv, $fname);
58    }
59
60    return sort(@rv);
61}
62
63
64sub contains
65{
66    # look if the first parameter is contained in the list following it
67    local($item, @list) = @_;
68    local($found, $i);
69
70    $found = 0;
71    foreach $i (@list) {
72	return 1 if $i eq $item;
73    }
74    return 0;
75}
76
77
78
79sub term_init
80{
81    # first, get some terminal attributes
82
83    # try bold mode first
84    $so = `tput md`; $se = `tput me`;
85
86    # if no bold mode available, use standout mode
87    if ($so eq "") {
88	$so = `tput so`; $se = `tput se`;
89    }
90
91    # try if we can underscore
92    $us = `tput us`; $ue = `tput ue`;
93    # if we don't have it available, or same as bold/standout, disable it
94    if ($us eq "" || $us eq $so) {
95	$us = $ue = "";
96    }
97
98    # look how many columns we've got
99    if($ENV{'COLUMNS'} ne "") {
100	$columns = $ENV{'COLUMNS'};
101    } elsif(-t STDIN) {		# if we operate on a terminal...
102	local($word, $tmp);
103
104	open(STTY, "stty -a|");
105	$_ = <STTY>;		# try getting the tty win structure value
106	close(STTY);
107	chop;
108	$columns = 0;
109	foreach $word (split) {
110	    $columns = $tmp if $word eq "columns;"; # the number preceding
111	    $tmp = $word;
112	}
113    } else {
114	$columns = 80;
115    }
116    # sanity
117    $columns = 80 unless $columns >= 5;
118}
119
120
121sub list
122{
123    # pretty-print a list
124    # imports: global variable $columns
125    local(@items) = @_;
126    local($longest,$i,$item,$cols,$width);
127
128    # find the longest item
129    $longest = 0;
130    foreach $item (@items) {
131	$i = length($item);
132	$longest = $i if $longest < $i;
133    }
134    $width = $longest + 1;
135    $cols = int($columns / $width);
136
137    $i = 0;
138    foreach $item (@items) {
139	print $item;
140	if(++$i == $cols) {
141	    $i = 0; print "\n";
142	} else {
143	    print ' ' x ($width - length($item));
144	}
145    }
146    print "\n" unless $i == 0;
147}
148
149sub cvs_init
150{
151    # get the CVS repository(s)
152
153    die "You need to have the \$CVSROOT variable set.\n"
154	unless $ENV{'CVSROOT'} ne "";
155
156    # get the list of available repositories
157    $cvsroot = $ENV{'CVSROOT'};
158    $cvsroot = (split(/:/, $cvsroot, 2))[1] if $cvsroot =~ /:/;
159    @reps = &lsdir($cvsroot);
160}
161
162
163sub lsmodules
164{
165    # list all known CVS modules
166    local(%rv, $mname, $mpath, $_);
167
168    %rv = ();
169
170    open(CVS, "cvs co -c|");
171    while($_ = <CVS>) {
172	chop;
173	($mname,$mpath) = split;
174	next if $mname eq "";
175	$rv{$mname} = $mpath;
176    }
177    close(CVS);
178
179    return %rv;
180}
181
182
183sub checktag
184{
185    # check a given string for tag rules
186    local($s, $name) = @_;
187    local($regexp);
188
189    if($name eq "vendor") { $regexp = '^[A-Z][A-Z0-9_]*$'; }
190    elsif($name eq "release") { $regexp = '^[a-z][a-z0-9_]*$'; }
191    else {
192	print STDERR "Internal error: unknown tag name $name\n";
193	exit(2);
194    }
195
196    if($s !~ /$regexp/) {
197	print "\a${us}Valid $name tags must match the regexp " .
198	    "$regexp.${ue}\n";
199	return 0;
200    }
201    if($s =~ /^RELENG/) {
202	print "\a${us}Tags must not start with the word \"RELENG\".${ue}\n";
203	return 0;
204    }
205
206    return 1;
207}
208
209
210&scan_opts;
211&term_init;
212&cvs_init;
213
214if(! $moduledir) {
215    @dirs = &lsdir(".");
216    print "${so}Import from which directory?${se}\n";
217    @dirs = (@dirs, ".");
218    &list(@dirs);
219    $moduledir = &Complete("Which? [.]: ", @dirs);
220    $moduledir = "." unless $moduledir ne "";
221}
222
223chdir $moduledir || die "Cannot chdir to $moduledir\n";
224
225print "${so}Available repositories:${se}\n";
226&list(@reps);
227
228# the following kludge prevents the Complete package from starting
229# over with the string just selected; Complete should better provide
230# some reinitialize method
231$Complete'return = "";   $Complete'r = 0;
232
233$selected =
234    &Complete("Enter repository (<TAB>=complete, ^D=show): ",
235	      @reps);
236
237die "\aYou cannot create new repositories with this script.\n"
238    unless &contains($selected, @reps);
239
240$rep = $selected;
241
242print "\n${so}Selected repository:${se} ${us}$rep${ue}\n";
243
244
245@areas = &lsdir("$cvsroot/$rep");
246
247print "${so}Existent areas in this repository:${se}\n";
248&list(@areas);
249
250$Complete'return = "";   $Complete'r = 0;
251
252$selected =
253    &Complete("Enter area name (<TAB>=complete, ^D=show): ",
254	      @areas);
255
256print "\a${us}Warning: this will create a new area.${ue}\n"
257    unless &contains($selected, @areas);
258
259$area = "$rep/$selected";
260
261print "\n${so}[Working on:${se} ${us}$area${ue}${so}]${se}\n";
262
263%cvsmods = &lsmodules();
264
265for(;;) {
266    $| = 1;
267    print "${so}Gimme the module name:${se} ";
268    $| = 0;
269    $modname = <>;
270    chop $modname;
271    if ($modname eq "") {
272	print "\a${us}You cannot use an empty module name.${ue}\n";
273	next;
274    }
275    last if !$cvsmods{$modname};
276    print "\a${us}This module name does already exist; do you intend to\n" .
277	"perform a vendor-branch import to the existing sources?${ue}: ";
278    $rep = <>;
279    if ($rep =~ /\s*[yY]/) {
280	($area,$modpath) = split(/\//,$cvsmods{$modname},2);
281	$branchimport = 1;
282	last;
283    }
284    print "${us}Choose another name.${ue}\n";
285}
286
287
288if(!$branchimport) {
289    for(;;) {
290	$| = 1;
291	print "${so}Enter the module path:${se} $area/";
292	$| = 0;
293	$modpath = <>;
294	chop $modpath;
295	if ($modpath eq "") {
296	    print "\a${us}You cannot use an empty module path.${ue}\n";
297	    next;
298	}
299	last if ! -d "$cvsroot/$area/$modpath";
300	print "\a${us}This module path does already exist; " .
301	    "choose another one.${ue}\n";
302    }
303
304
305    @newdirs = ();
306    $dir1 = "$cvsroot/$area";
307    $dir2 = "$area";
308
309    @newdirs = (@newdirs, "$dir2") if ! -d $dir1;
310
311    foreach $ele (split(/\//, $modpath)) {
312	$dir1 = "$dir1/$ele";
313	$dir2 = "$dir2/$ele";
314	@newdirs = (@newdirs, "$dir2") if ! -d $dir1;
315    }
316
317    print "${so}You're going to create the following new directories:${se}\n";
318
319    &list(@newdirs);
320}
321
322for(;;) {
323    $| = 1;
324    print "${so}Enter a \`vendor\' tag (e. g. the authors ID):${se} ";
325    $| = 0;
326    $vtag = <>;
327    chop $vtag;
328    last if &checktag($vtag, "vendor");
329}
330
331for(;;) {
332    $| = 1;
333    print "${so}Enter a \`release\' tag (e. g. the version #):${se} ";
334    $| = 0;
335    $rtag = <>;
336    chop $rtag;
337    last if &checktag($rtag, "release");
338}
339
340
341$| = 1;
342print "${so}This is your last chance to interrupt, " .
343    "hit <return> to go on:${se} ";
344$| = 0;
345<>;
346
347if (!$branchimport) {
348    $mod = "";
349    foreach $tmp (sort(keys(%cvsmods))) {
350	if($tmp gt $modname) {
351	    $mod = $tmp;
352	    last;
353	}
354    }
355    if($mod eq "") {
356	# we are going to append our module
357	$cmd = "\$\na\n";
358    } else {
359	# we can insert it
360	$cmd = "/^${mod}[ \t]/\ni\n";
361    }
362
363    print "${so}Checking out the modules database...${se}\n";
364    system("cvs co modules") && die "${us}failed.\n${ue}";
365
366    print "${so}Inserting new module...${se}\n";
367    open(ED, "|ed modules/modules") || die "${us}Cannot start ed${ue}\n";
368    print(ED "${cmd}${modname} " . ' ' x (15 - length($modname)) .
369	  "$area/${modpath}\n.\nw\nq\n");
370    close(ED);
371
372    print "${so}Commiting new modules database...${se}\n";
373    system("cvs $dont_do_it commit -m \"  " .
374	   "${modname} --> $area/${modpath}\" modules")
375	&& die "Commit failed\n";
376
377    # we always release "modules" to prevent duplicate
378    system("cvs -Q release -d modules");
379}
380
381print "${so}Importing source.  Enter a commit message in the editor.${se}\n";
382
383system("cvs $dont_do_it import $area/$modpath $vtag $rtag");
384
385print "${so}You are done now.  Go to a different directory, perform a${se}\n".
386    "${us}cvs co ${modname}${ue} ${so}command, and see if your new module" .
387    " builds ok.${se}\n";
388
389print "\nPlease don't forget to edit the parent Makefile to add what you\n".
390    "just imported.\n";
391
392if($dont_do_it) {
393print <<END
394
395
396${so}Since you did not allow to commit anything, you'll have${se}
397${so}to remove the edited modules' database yourself.${se}
398${so}To do this, perform a${se}
399${us}cd ${moduledir}; cvs -Q release -d modules${ue}
400${so}command.${se}
401END
402;
403}
404