#!/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: patmv,v 1.4 1996/02/05 19:21:06 ejb Exp $
# $Source: /home/ejb/scripts/RCS/patmv,v $
# $Author: ejb $
#

$whoami = ($0 =~ m,([^/]*)$,) ? $1 : $0;

$no_action = $force = 0;
$verbose = 1;

while (@ARGV)
{
    $arg = shift(@ARGV);
    (($no_action = 1), next)  if ($arg eq "-n");
    (($force = 1), next) if ($arg eq "-f");
    (($verbose = 0), next) if ($arg eq "-s");
    $expr = $arg;
    last;
}

&usage unless defined($expr);

if (! $force)
{
    open(TTY, "</dev/tty") || ($force = 1);
}

if (!@ARGV)
{
    @ARGV = <STDIN>;
    chop(@ARGV);
}

for (@ARGV)
{
    $oldname = $_;
    eval $expr;
    die $@ if $@;
    if (($oldname ne $_) &&
	($force || (! (-e $_)) || $no_action ||
	 (&yn("$_ exists.  Overwrite?"))))
    {
	if ($no_action || $verbose)
	{
	    print "mv $oldname $_\n";
	}

	if (! $no_action)
	{
	    rename($oldname, $_) ||
		warn "$whoami: rename of $oldname to $_ failed: $!\n";
	}
    }
}

sub usage {
    print STDERR "Usage: $whoami [ -n -f -s ] perlexpr [ filenames ]
  Perlexp must operate on $_.  Evaluates perlexpr on each file given on 
  the commandline.If no files are given, read a list from stdin.  If the
  perl expression does not change the file, no rename is done.  If the
  target file exists, user is prompted.

  The -n flag causes this script to print what it would do instead of
  doing it.  The -f flag suppresses checking of target file's existence.
  The -s flag suppresses the printing of each rename.
";
    exit 1;
}

sub yn {
    local($prompt) = @_;
    local($answer);
    print $prompt . " [y/n] ";
    do {
	chop($answer = <TTY>);
	if ($answer eq "y")
	{
	    return 1;
	}
	elsif ($answer eq "n")
	{
	    return 0;
	}
	else
	{
	    print "Please enter y or n: ";
	}
    }
    while (($answer ne "y") && ($answer ne "n"));
}