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
  13 require "complete.pl";
  14 require "getopts.pl";
  15
  16
  17 sub 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: src/gnu/usr.bin/cvs/contrib/easy-import.pl,v 1.16 1999/09/05 17:35:31 peter Exp $' . "\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
  39 sub 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
  64 sub 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
  79 sub 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
 121 sub 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
 149 sub 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
 163 sub 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
 183 sub 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
 214 if(! $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
 223 chdir $moduledir || die "Cannot chdir to $moduledir\n";
 224
 225 print "${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
 237 die "\aYou cannot create new repositories with this script.\n"
 238     unless &contains($selected, @reps);
 239
 240 $rep = $selected;
 241
 242 print "\n${so}Selected repository:${se} ${us}$rep${ue}\n";
 243
 244
 245 @areas = &lsdir("$cvsroot/$rep");
 246
 247 print "${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
 256 print "\a${us}Warning: this will create a new area.${ue}\n"
 257     unless &contains($selected, @areas);
 258
 259 $area = "$rep/$selected";
 260
 261 print "\n${so}[Working on:${se} ${us}$area${ue}${so}]${se}\n";
 262
 263 %cvsmods = &lsmodules();
 264
 265 for(;;) {
 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
 288 if(!$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
 322 for(;;) {
 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
 331 for(;;) {
 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;
 342 print "${so}This is your last chance to interrupt, " .
 343     "hit <return> to go on:${se} ";
 344 $| = 0;
 345 <>;
 346
 347 if (!$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
 381 print "${so}Importing source.  Enter a commit message in the editor.${se}\n";
 382
 383 system("cvs $dont_do_it import $area/$modpath $vtag $rtag");
 384
 385 print "${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
 389 print "\nPlease don't forget to edit the parent Makefile to add what you\n".
 390     "just imported.\n";
 391
 392 if($dont_do_it) {
 393 print <<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}
 401 END
 402 ;
 403 }