contrib/cvs-1.12.9/contrib/cln_hist.in

   1 #! @PERL@
   2 # -*-Perl-*-
   3 #
   4 # Contributed by David G. Grubbs <dgg@ksr.com>
   5 #
   6 # Clean up the history file.  10 Record types: MAR OFT WUCG
   7 #
   8 # WUCG records are thrown out.
   9 # MAR records are retained.
  10 # T records: retain only last tag with same combined tag/module.
  11 #
  12 # Two passes:  Walk through the first time and remember the
  13 #       1. Last Tag record with same "tag" and "module" names.
  14 #       2. Last O record with unique user/module/directory, unless followed
  15 #          by a matching F record.
  16 #
  17
  18 $r = $ENV{"CVSROOT"};
  19 $c = "$r/CVSROOT";
  20 $h = "$c/history";
  21
  22 eval "print STDERR \$die='Unknown parameter $1\n' if !defined \$$1; \$$1=\$';"
  23     while ($ARGV[0] =~ /^(\w+)=/ && shift(@ARGV));
  24 exit 255 if $die;               # process any variable=value switches
  25
  26 %tags = ();
  27 %outs = ();
  28
  29 #
  30 # Move history file to safe place and re-initialize a new one.
  31 #
  32 rename($h, "$h.bak");
  33 open(XX, ">$h");
  34 close(XX);
  35
  36 #
  37 # Pass1 -- remember last tag and checkout.
  38 #
  39 open(HIST, "$h.bak");
  40 while (<HIST>) {
  41     next if /^[MARWUCG]/;
  42
  43     # Save whole line keyed by tag|module
  44     if (/^T/) {
  45         @tmp = split(/\|/, $_);
  46         $tags{$tmp[4] . '|' . $tmp[5]} = $_;
  47     }
  48     # Save whole line
  49     if (/^[OF]/) {
  50         @tmp = split(/\|/, $_);
  51         $outs{$tmp[1] . '|' . $tmp[2] . '|' . $tmp[5]} = $_;
  52     }
  53 }
  54
  55 #
  56 # Pass2 -- print out what we want to save.
  57 #
  58 open(SAVE, ">$h.work");
  59 open(HIST, "$h.bak");
  60 while (<HIST>) {
  61     next if /^[FWUCG]/;
  62
  63     # If whole line matches saved (i.e. "last") one, print it.
  64     if (/^T/) {
  65         @tmp = split(/\|/, $_);
  66         next if $tags{$tmp[4] . '|' . $tmp[5]} ne $_;
  67     }
  68     # Save whole line
  69     if (/^O/) {
  70         @tmp = split(/\|/, $_);
  71         next if $outs{$tmp[1] . '|' . $tmp[2] . '|' . $tmp[5]} ne $_;
  72     }
  73
  74     print SAVE $_;
  75 }
  76
  77 #
  78 # Put back the saved stuff
  79 #
  80 system "cat $h >> $h.work";
  81
  82 if (-s $h) {
  83     rename ($h, "$h.interim");
  84     print "history.interim has non-zero size.\n";
  85 } else {
  86     unlink($h);
  87 }
  88
  89 rename ("$h.work", $h);
  90
  91 exit(0);