181404Speter#! @PERL@
281404Speter# -*-Perl-*-
3175261Sobrien
4175261Sobrien# Copyright (C) 1995-2005 The Free Software Foundation, Inc.
5175261Sobrien
6175261Sobrien# This program is free software; you can redistribute it and/or modify
7175261Sobrien# it under the terms of the GNU General Public License as published by
8175261Sobrien# the Free Software Foundation; either version 2, or (at your option)
9175261Sobrien# any later version.
1081404Speter#
11175261Sobrien# This program is distributed in the hope that it will be useful,
12175261Sobrien# but WITHOUT ANY WARRANTY; without even the implied warranty of
13175261Sobrien# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14175261Sobrien# GNU General Public License for more details.
15175261Sobrien#
1681404Speter# Contributed by David G. Grubbs <dgg@ksr.com>
1781404Speter#
1881404Speter# Clean up the history file.  10 Record types: MAR OFT WUCG
1981404Speter#
2081404Speter# WUCG records are thrown out.
2181404Speter# MAR records are retained.
2281404Speter# T records: retain only last tag with same combined tag/module.
2381404Speter#
2481404Speter# Two passes:  Walk through the first time and remember the
2581404Speter#	1. Last Tag record with same "tag" and "module" names.
2681404Speter#	2. Last O record with unique user/module/directory, unless followed
2781404Speter#	   by a matching F record.
2881404Speter#
2981404Speter
3081404Speter$r = $ENV{"CVSROOT"};
3181404Speter$c = "$r/CVSROOT";
3281404Speter$h = "$c/history";
3381404Speter
3481404Spetereval "print STDERR \$die='Unknown parameter $1\n' if !defined \$$1; \$$1=\$';"
3581404Speter    while ($ARGV[0] =~ /^(\w+)=/ && shift(@ARGV));
3681404Speterexit 255 if $die;               # process any variable=value switches
3781404Speter
3881404Speter%tags = ();
3981404Speter%outs = ();
4081404Speter
4181404Speter#
4281404Speter# Move history file to safe place and re-initialize a new one.
4381404Speter#
4481404Speterrename($h, "$h.bak");
4581404Speteropen(XX, ">$h");
4681404Speterclose(XX);
4781404Speter
4881404Speter#
4981404Speter# Pass1 -- remember last tag and checkout.
5081404Speter#
5181404Speteropen(HIST, "$h.bak");
5281404Speterwhile (<HIST>) {
5381404Speter    next if /^[MARWUCG]/;
5481404Speter
5581404Speter    # Save whole line keyed by tag|module
5681404Speter    if (/^T/) {
5781404Speter	@tmp = split(/\|/, $_);
5881404Speter	$tags{$tmp[4] . '|' . $tmp[5]} = $_;
5981404Speter    }
6081404Speter    # Save whole line
6181404Speter    if (/^[OF]/) {
6281404Speter	@tmp = split(/\|/, $_);
6381404Speter	$outs{$tmp[1] . '|' . $tmp[2] . '|' . $tmp[5]} = $_;
6481404Speter    }
6581404Speter}
6681404Speter
6781404Speter#
6881404Speter# Pass2 -- print out what we want to save.
6981404Speter#
7081404Speteropen(SAVE, ">$h.work");
7181404Speteropen(HIST, "$h.bak");
7281404Speterwhile (<HIST>) {
7381404Speter    next if /^[FWUCG]/;
7481404Speter
7581404Speter    # If whole line matches saved (i.e. "last") one, print it.
7681404Speter    if (/^T/) {
7781404Speter	@tmp = split(/\|/, $_);
7881404Speter	next if $tags{$tmp[4] . '|' . $tmp[5]} ne $_;
7981404Speter    }
8081404Speter    # Save whole line
8181404Speter    if (/^O/) {
8281404Speter	@tmp = split(/\|/, $_);
8381404Speter	next if $outs{$tmp[1] . '|' . $tmp[2] . '|' . $tmp[5]} ne $_;
8481404Speter    }
8581404Speter
8681404Speter    print SAVE $_;
8781404Speter}
8881404Speter
8981404Speter#
9081404Speter# Put back the saved stuff
9181404Speter#
9281404Spetersystem "cat $h >> $h.work";
9381404Speter
9481404Speterif (-s $h) {
9581404Speter    rename ($h, "$h.interim");
9681404Speter    print "history.interim has non-zero size.\n";
9781404Speter} else {
9881404Speter    unlink($h);
9981404Speter}
10081404Speter
10181404Speterrename ("$h.work", $h);
10281404Speter
10381404Speterexit(0);
104