#!/bin/sh
# -*- perl -*-
# This code allows us to start perl from our path or an environment variable
# rather than hardcoding a path into the #! line.  It works from sh or csh.
(exit $?0) && eval 'exec ${QPERLQ-perl} -x $0 ${1+"$@"}'
if (! $?QPERLQ) setenv QPERLQ perl
exec $QPERLQ -x $0 $argv:q

#!/usr/local/bin/perl -w
#
# $Id: fix_rcs_strings,v 1.3 1999/01/29 02:40:42 ejb Exp $
# $Source: /home/ejb/scripts/RCS/fix_rcs_strings,v $
# $Author: ejb $
#

require 5.002;
use strict;

my $whoami = ($0 =~ m,([^/\\]*)$,) ? $1 : $0;
#my $dirname = ($0 =~ m,(.*)[/\\][^/\\]+$,) ? $1 : ".";

&usage if (@ARGV > 1);
my $dir = ".";
$dir = $ARGV[0] if (@ARGV);
die "$whoami: directory must be an absolute path.\n" if ($dir !~ m:^/:)

$| = 1; # unbuffered output for tail -f...

@files = ();
&list_files($dir);
    
foreach $i (@files)
{
    &check_rcs_file($i);
}

sub list_files {
    local($topdir) = (@_);
    local($file, $log);

    if (open(FIND, "find $topdir/. -type f " .
	     "\\( -name '*,v' -o -name '.*,v' \\) -print|"))
    {
	while (<FIND>)
	{
	    chop;
	    s,/\./,/,;
	    push(@files, $_);
	}

	close(FIND);
    }
    else
    {
	print STDERR "$whoami: can't run find over $topdir: $!\n";
    }
}

sub check_rcs_file {
    local($log) = @_;
    local($file);

    $file = $log;
    $file =~ s:(^.*/)RCS/([^/]*),v:$1$2:;
    &check_file($file);
}

sub check_file {
    local($file) = @_;

    if (-r $file)
    {
	if (open(RCSDIFF, "rcsdiff $file 2>/dev/null|"))
	{
	    local(@lines) = ();
	    local($fix_rcs_strings, $i, $pat);
	    while (<RCSDIFF>)
	    {
		if (m/^[<>] /)
		{
		    s/^[<>] //;
		    push(@lines, $_);
		}
	    }
	    close(RCSDIFF);
	    if (scalar(@lines) > 0)
	    {
		$fix_rcs_strings = 0;
		$a = $b if 0;	# keep perl from warning about $a and $b below
		@slines = sort {$a cmp $b} @lines;
		if ((scalar(@slines) % 2) == 0)
		{
		    $fix_rcs_strings = 1;
		    for ($i = 0; $i < scalar(@lines); $i += 2)
		    {
			if ($slines[$i] =~ m/\$([a-zA-Z]+):/)
			{
			    $pat = "\\\$" . $1 . ":";
			    if (! ($slines[$i + 1] =~ m/$pat/))
			    {
				$fix_rcs_strings = 0;
			    }
			}
			else
			{
			    $fix_rcs_strings = 0;
			}
		    }
		}
		if ($fix_rcs_strings)
		{
		    print "$file -- fixing rcs strings\n";
		    &fix_rcs_strings($file);
		}
	    }
	}
	else
	{
	    print $file, " has an unreadable RCS log!\n";
	}
    }
}

sub fix_rcs_strings {
    local($file) = @_;
    local(@stat, $atime, $mtime);

    @stat = stat $file;
    $atime = $stat[8];
    $mtime = $stat[9];
    
    (unlink ($file) == 1) &&
	(system("co $file >/dev/null 2>&1") == 0) &&
	    (utime $atime, $mtime, $file);
}

sub usage {
    print STDERR "Usage: $whoami [ dir ]\n";
    exit 1;
}