Initial bulk commit for "Git on MSys"
[msysgit/historical-msysgit.git] / lib / cvs / contrib / cln_hist
blob0cacbc834b52d4bfd27a1cf64ff7c0eceba2d5b7
1 #! /bin/perl
2 # -*-Perl-*-
4 # Contributed by David G. Grubbs <dgg@ksr.com>
6 # Clean up the history file. 10 Record types: MAR OFT WUCG
8 # WUCG records are thrown out.
9 # MAR records are retained.
10 # T records: retain only last tag with same combined tag/module.
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.
18 $r = $ENV{"CVSROOT"};
19 $c = "$r/CVSROOT";
20 $h = "$c/history";
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
26 %tags = ();
27 %outs = ();
30 # Move history file to safe place and re-initialize a new one.
32 rename($h, "$h.bak");
33 open(XX, ">$h");
34 close(XX);
37 # Pass1 -- remember last tag and checkout.
39 open(HIST, "$h.bak");
40 while (<HIST>) {
41 next if /^[MARWUCG]/;
43 # Save whole line keyed by tag|module
44 if (/^T/) {
45 @tmp = split(/\|/, $_);
46 $tags{$tmp[4] . '|' . $tmp[5]} = $_;
48 # Save whole line
49 if (/^[OF]/) {
50 @tmp = split(/\|/, $_);
51 $outs{$tmp[1] . '|' . $tmp[2] . '|' . $tmp[5]} = $_;
56 # Pass2 -- print out what we want to save.
58 open(SAVE, ">$h.work");
59 open(HIST, "$h.bak");
60 while (<HIST>) {
61 next if /^[FWUCG]/;
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 $_;
68 # Save whole line
69 if (/^O/) {
70 @tmp = split(/\|/, $_);
71 next if $outs{$tmp[1] . '|' . $tmp[2] . '|' . $tmp[5]} ne $_;
74 print SAVE $_;
78 # Put back the saved stuff
80 system "cat $h >> $h.work";
82 if (-s $h) {
83 rename ($h, "$h.interim");
84 print "history.interim has non-zero size.\n";
85 } else {
86 unlink($h);
89 rename ("$h.work", $h);
91 exit(0);