external/gpl2/xcvs/dist/contrib/cln_hist.in

   1 #! @PERL@
   2 # -*-Perl-*-
   3
   4 # Copyright (C) 1995-2005 The Free Software Foundation, Inc.
   5
   6 # This program is free software; you can redistribute it and/or modify
   7 # it under the terms of the GNU General Public License as published by
   8 # the Free Software Foundation; either version 2, or (at your option)
   9 # any later version.
  10 #
  11 # This program is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 # GNU General Public License for more details.
  15 #
  16 # Contributed by David G. Grubbs <dgg@ksr.com>
  17 #
  18 # Clean up the history file.  10 Record types: MAR OFT WUCG
  19 #
  20 # WUCG records are thrown out.
  21 # MAR records are retained.
  22 # T records: retain only last tag with same combined tag/module.
  23 #
  24 # Two passes:  Walk through the first time and remember the
  25 #       1. Last Tag record with same "tag" and "module" names.
  26 #       2. Last O record with unique user/module/directory, unless followed
  27 #          by a matching F record.
  28 #
  29
  30 $r = $ENV{"CVSROOT"};
  31 $c = "$r/CVSROOT";
  32 $h = "$c/history";
  33
  34 eval "print STDERR \$die='Unknown parameter $1\n' if !defined \$$1; \$$1=\$';"
  35     while ($ARGV[0] =~ /^(\w+)=/ && shift(@ARGV));
  36 exit 255 if $die;               # process any variable=value switches
  37
  38 %tags = ();
  39 %outs = ();
  40
  41 #
  42 # Move history file to safe place and re-initialize a new one.
  43 #
  44 rename($h, "$h.bak");
  45 open(XX, ">$h");
  46 close(XX);
  47
  48 #
  49 # Pass1 -- remember last tag and checkout.
  50 #
  51 open(HIST, "$h.bak");
  52 while (<HIST>) {
  53     next if /^[MARWUCG]/;
  54
  55     # Save whole line keyed by tag|module
  56     if (/^T/) {
  57         @tmp = split(/\|/, $_);
  58         $tags{$tmp[4] . '|' . $tmp[5]} = $_;
  59     }
  60     # Save whole line
  61     if (/^[OF]/) {
  62         @tmp = split(/\|/, $_);
  63         $outs{$tmp[1] . '|' . $tmp[2] . '|' . $tmp[5]} = $_;
  64     }
  65 }
  66
  67 #
  68 # Pass2 -- print out what we want to save.
  69 #
  70 open(SAVE, ">$h.work");
  71 open(HIST, "$h.bak");
  72 while (<HIST>) {
  73     next if /^[FWUCG]/;
  74
  75     # If whole line matches saved (i.e. "last") one, print it.
  76     if (/^T/) {
  77         @tmp = split(/\|/, $_);
  78         next if $tags{$tmp[4] . '|' . $tmp[5]} ne $_;
  79     }
  80     # Save whole line
  81     if (/^O/) {
  82         @tmp = split(/\|/, $_);
  83         next if $outs{$tmp[1] . '|' . $tmp[2] . '|' . $tmp[5]} ne $_;
  84     }
  85
  86     print SAVE $_;
  87 }
  88
  89 #
  90 # Put back the saved stuff
  91 #
  92 system "cat $h >> $h.work";
  93
  94 if (-s $h) {
  95     rename ($h, "$h.interim");
  96     print "history.interim has non-zero size.\n";
  97 } else {
  98     unlink($h);
  99 }
 100
 101 rename ("$h.work", $h);
 102
 103 exit(0);