gnu/usr.bin/cvs/contrib/easy-import.pl

   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
  14 require "complete.pl";
  15 require "getopts.pl";
  16
  17
  18 sub 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
  40 sub 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
  65 sub 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
  80 sub 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
 122 sub 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
 150 sub 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
 164 sub 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
 184 sub 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
 215 if(! $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
 224 chdir $moduledir || die "Cannot chdir to $moduledir\n";
 225
 226 print "${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
 238 die "\aYou cannot create new repositories with this script.\n"
 239     unless &contains($selected, @reps);
 240
 241 $rep = $selected;
 242
 243 print "\n${so}Selected repository:${se} ${us}$rep${ue}\n";
 244
 245
 246 @areas = &lsdir("$cvsroot/$rep");
 247
 248 print "${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
 257 print "\a${us}Warning: this will create a new area.${ue}\n"
 258     unless &contains($selected, @areas);
 259
 260 $area = "$rep/$selected";
 261
 262 print "\n${so}[Working on:${se} ${us}$area${ue}${so}]${se}\n";
 263
 264 %cvsmods = &lsmodules();
 265
 266 for(;;) {
 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
 289 if(!$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
 323 for(;;) {
 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
 332 for(;;) {
 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;
 343 print "${so}This is your last chance to interrupt, " .
 344     "hit <return> to go on:${se} ";
 345 $| = 0;
 346 <>;
 347
 348 if (!$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
 382 print "${so}Importing source.  Enter a commit message in the editor.${se}\n";
 383
 384 system("cvs $dont_do_it import $area/$modpath $vtag $rtag");
 385
 386 print "${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
 390 print "\nPlease don't forget to edit the parent Makefile to add what you\n".
 391     "just imported.\n";
 392
 393 if($dont_do_it) {
 394 print <<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}
 402 END
 403 ;
 404 }