home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / cvs-1.8.7-src.tgz / tar.out / fsf / cvs / contrib / cln_hist.pl < prev    next >
Perl Script  |  1996-09-28  |  2KB  |  93 lines

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