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