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