finally, bump the version
[alioth/cvs.git] / 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);