#!/usr/local/bin/perl
#
# locks
#
# This perl program determines which RCS files in the current
# directory and its subdirectories are locked.  It reports the RCS
# filename of the file and the userid that holds the lock on the file.
#
# History
# -------
# $Log: locks,v $
# Revision 1.1  1997/05/15  19:11:58  dieter
# Initial revision
#
#

#
# find all the RCS files in or below the current directory
#
open(FIND, "find . -follow -name '*,v' -print |") || die "Couldn't run find: $!\n";

while ($rcsfile = <FIND>) {
    chop $rcsfile;

    #
    # run rlog on the file to determine if it is checked out
    #
    open(RLOG, "rlog -L -h " . $rcsfile . " |" ) || die "rlog failed: $!\n";
    $locker = "";

    #
    # Loop through the output of rlog, extracting the relevant
    # information
    #
    while (<RLOG>) {
	if( /^Working file: (.*)/ ) {
	    $filename = $1;
	}
	if( /^RCS file: (.*)/ ) {
	    $rcsname = $1
	    }
	if( /^locks:/ ) {
	    $_ = <RLOG>;
	    if( /^\s+(.*):/ ) {
		$locker = $1;
	    }
	}
    }

    #
    # print the output
    #
    if( $locker ne "" ) {
	write;
    }
}

format STDOUT_TOP =
filename               RCS file                              lock holder
----------------       -------------------------             --------------
.

format STDOUT =
@<<<<<<<<<<<<<<<<<<<<  @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<  @<<<<<<<<
$filename,             $rcsname,                             $locker
.
