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