#!/usr/bin/perl
# From: ilya@math.ohio-state.edu (Ilya Zakharevich)
# So if you do not want to
# descend into directories, just do
# 	rnm '$_ = lc'
# (with 5.004 or close, with perls which are older than a week you need
# 	rnm '$_ = lc $_'
# ).
# 
# I wrote a similarly nice tool which does a similar thing to
# "find". Use it like this:
# 	pfind . '$_ = lc'
# 
# To lowercase only the files which names contain `blah', do
# 	pfind . /blah/ '$_ = lc'
# 
# To lowercase only the files which contain `blah', do
# 	pfind . "=~ /blah/" '$_ = lc'

# 	$rcs = ' $Id: pfind.pl,v 1.10 1997/12/11 11:21:57 ilya Exp ilya $ ' ;	

# 1.5:	correctly open files with leading/trailing spaces in names.
# 1.6:	handle substitutions, -bak;
#	-nosubdir; 
#	-debug exits;
#       -nosubdir bug fixed
#       inserts a stat($_) iff any filter matching /^!?-(M|A|C)/ is used
#       this allows for    -M _ < 2
#       inserts  `if test'  instead of  `unless ! test' if  !test is given
# 1.8:	Preserves attributes of the file if s///
#	Optimizations of -f to -f _ performed
#	Pod added

use strict;
use vars qw($Line_Found $version $debug $prune $bak $StartDir $binary $haveS);
undef $Line_Found;

sub usage {
  print <<EOU;
usage: $0 [-debug] [-nosubdir] [-bin] [-bak=suffix] [--] startdir 
          rule1 rule2 ...
			>>>> Version: $version. <<<< 
	Rules are perl statements to execute. Statements starting with
`-', `/', or `!' are considered filters, a file will be discarded unless
the statement returns true. The rest is executed "as is".
	If only filters are given the default action is `prt' (see below).
	Variables \$_, \$name, \$dir contain the file name, full file name
and the name of the directory. Statements are executed in the directory
of the each processed file.
	If file is not discarded, and \$_ is changed after the perl
statements are executed, the file is renamed to the new value of \$_.
	Convenience function `prt' prints \\n-terminated name of the file.

	If a rule starts with `=~', it is considered as a filter to
match contents of the file. The rest is the regular expression to
match. If regexp contains modifiers `s' or `m', it is matched against
the file as a whole, otherwise it is matched line-by-line. 
	If the regexp-filter fails, file processing stops. Otherwise 
whatever was matched against is available in the variable \$line unless
modifiers `s' or `m' are given.
	If a rule starts with `=~s' it is considered as a filter to
match and MODIFY the contents of the file. Modifiers 's' and 'm' are applicable
as above. To make several modifications at a time, use e.g.
=~ s/abc/ABC/ &&& s/def/DEF/ (modifiers should be the same, though).
In case you give the modifiers 's' or 'm' you should think about using
the modifier 'g', as well.

Option -debug just shows and evals the expression - IT DOES NO PROCESSING !
With option -nosubdir does not descend into subdirectories.
Without option -bin binary files are not processed for substrings,
and files are opened in text mode.
EOU
  ;                             # '; # for Emacs
  exit;
}

sub prt
{ 
  print "$File::Find::name";
  print " : $Line_Found"  if  defined($Line_Found);
  print "\n";
}
sub setup_bak {
  my ($file,$bak) = @_;
  return unless -e "$file$bak";
  my ($prefix,$count,$i) = ("", $bak, 0);
  unless ($bak =~ /^\w+\d+$/) {
    ($prefix,$count) = ($bak, 0);
  }
  $count++, $i++ while $i < 1000 and -e "$file$prefix$count";
  die "Cannot find backup name for '$file'\n" if $i >= 1000;
  if (rename "$file$bak", "$file$prefix$count") {
    print STDERR "rename '$file$bak' to '$file$prefix$count'\n";
  } else {
    die "Cannot rename '$file$bak' to '$file$prefix$count'";
  }
}

sub wrapper {
  my ($regexp,$regexp_find) = shift;
  my $SubsIt = $regexp =~ /^\s*s/;
  my $Single = $regexp !~ /\w*[sm]\w*\s*$/;
  if ( $SubsIt ) { 
    $haveS++;
    my @SubsList= split /&&&/,$regexp;
    if ( @SubsList > 1 ) { 
      $regexp_find= join '||',@SubsList;
      $regexp= join ',',@SubsList;
    } else {
      $regexp_find= $regexp;
    }
  }
  my $Code;
  if ($binary) {
  $Code = <<'EOS';
return unless -f _ and -r _;
EOS
  } else {
  $Code = <<'EOS';
return unless -f _ and -r _ and -T _;
EOS
  }
  $Code .= <<'EOS' if $SubsIt ;
  print (STDERR "$_ is not writable\n"), return unless -w _;
EOS
  $Code .= <<'EOS';
  { my ($FileName,$found)= ($_,0);
    $FileName =~ s|^(\s)|./$1|; 
    my $openfile = $FileName;
    $openfile =~ s/(\s)$/$1\0/;
    open(FILE, "< $openfile") or die "cannot open '$FileName': $!";
    local $_;
EOS
  $Code .= <<'EOS' if $binary;
    binmode FILE;
EOS
  if ( $SubsIt ) { 
    my $bmode = '';
    $bmode = <<'EOS' if $binary;
      binmode FILE;
      binmode OUTPUT;
EOS
    my $move_copy = 'rename $FileName, "$FileName$bak"';
    my $op = 'rename';
    my $open_write = 'open(OUTPUT, "> $openfile")';
    my $set_mode = 'chmod $Mode, $FileName';
    if (defined &File::Copy::syscopy) { # There is more than $Mode
      $move_copy = 'File::Copy::syscopy $FileName, "$FileName$bak"';
      $op = 'copy';
      $open_write = 'open(OUTPUT, "+< $openfile") and truncate OUTPUT, 0';
      $set_mode = '';
    }
    if ( $Single ) {		# Single-line substitution
      $Code .= <<EOSS;
    1 while defined (\$_ = <FILE>) and not (\$found = $regexp_find);
    if ( \$found ) { 
      close FILE or die "cannot close '\$FileName' for write: \$!"; 
      setup_bak(\$FileName, \$bak);
      $move_copy
	or die "cannot $op '\$FileName' to '\$FileName\$bak': \$!";
      open (FILE, "< \$FileName\$bak");
      $open_write
	or die "cannot open '\$FileName' for write: \$!";
$bmode
      while (<FILE>) { $regexp; print OUTPUT; }
      close OUTPUT or die "cannot close \$FileName: \$!";
      $set_mode;
      \$FileName .= \$bak;
    }
EOSS
    } else {			# Multi-line substitution
      $Code .= <<EOSB;
    local \$/ = undef;
    \$_ = <FILE>;
    \$found = $regexp_find;
    if ( \$found ) { 
      close FILE or die "cannot close '\$FileName' for write: \$!"; 
      setup_bak(\$FileName, \$bak);
      $move_copy
	or die "cannot rename '\$FileName': \$!";
      open (FILE, "< \$FileName\$bak");
      open(OUTPUT, "> \$openfile") 
	or die "cannot open '\$FileName' for write: \$!";
$bmode
      \$_ = <FILE>; $regexp; print OUTPUT;
      close OUTPUT or die "cannot close '\$FileName' for write: \$!";
      $set_mode;
      \$FileName .= \$bak;
    }
EOSB
    }
  }
  else {
    if ( $Single ) {		# Single line match
      $Code .= <<EOSS;
    while (defined (\$line = <FILE>)) { \$found = 1, last if \$line =~ $regexp; }
EOSS
    } else { 
      $Code .= <<EOSB;		# Multiline match
    local \$/ = undef;
    \$_ = <FILE>;
    \$found = $regexp;
EOSB
    }
  }

  if ( $Single )
  { $Code .= <<'EOSS';
    $Line_Found = $line if $found;
EOSS
  }
  
  $Code .= <<'EOS';
    close FILE or die "cannot close '$FileName': $!";
    return unless $found;
  }
EOS
}

$StartDir = shift;
usage unless @ARGV;
$bak = ".bak";
while ($StartDir =~ /^-/) {
  $debug = 1 if $StartDir eq '-debug';
  $prune = 1 if $StartDir eq '-stay';
  $binary = 1 if $StartDir eq '-bin';
  $bak =  $1 if $StartDir =~ /^-bak=(.*)/;
  $StartDir = shift;
  $StartDir = shift, last if $StartDir eq '--';
}
#die "Starting directory `$StartDir' not found.\n" unless -d $StartDir;
while ( -l $StartDir )
{ my $Link = readlink $StartDir;
  $StartDir= ( $StartDir =~ m|(.*)/[^/]+$|s ? $1 : '.');
  $StartDir= ( substr($Link,0,1) eq '/' ? $Link : $StartDir .'/'.$Link );
}
  
die "Starting directory `$StartDir' not found.\n" unless -d $StartDir;

my $NF = 0;  # no of filter arguments
map { $NF++ if  m:^([-/!]):  || m/^=~/ } @ARGV;
# Convert -f to -f _, -M < 3 to -M _ < 3
@ARGV = map { s/^\s*((!\s*)?-[a-su-zA-Z])\s*([!=<>]|$)/$1 _ $3/; $_ } @ARGV;
my $NeedsStat = 0;
map { $NeedsStat++  if m/^\s*(!\s)*-[a-su-zA-Z]\s+_\b/ } @ARGV;
my @rows = map { s:^([-/]):return unless $1:; s:^!:return if : ; $_ } @ARGV;
@rows = map { s! ^ =~ (.*) ! $NeedsStat++; wrapper($1) !xes ; $_ } @rows;

my $text = join ";\n  ", @rows;
$text .= "  ;\n  prt"  if $NF == @ARGV;
$text = "my (\$dev,\$inode,\$Mode) = CORE::stat(\$_);\n" . $text  
  if  $haveS;
$text = "CORE::stat(\$_);\n" . $text  
  if  $NeedsStat and not $haveS;
@ARGV = ();

my $setup = <<'EOS';
  my $name = $File::Find::name;
  my $dir  = $File::Find::dir;
  my $was = $_;
  my ($line, $found);
EOS

my $PRUNE= ( $prune ? 
             '$File::Find::prune=1  unless $File::Find::name eq $StartDir;'
            : '' );

my $finish = <<'EOS';
  rename($was,$_) unless $was eq $_;
EOS

my $wanted = <<EOW;
sub {
$setup
  $PRUNE
  $text;
$finish
}
EOW

print STDERR "$wanted\n" if  $debug ;

my $sub = eval $wanted;
die $@ if $@;

exit if $debug;

use File::Find;

File::Find::find ( $sub, $StartDir );

__END__

=head1 NAME

pfind - find-like utility with Perl syntax

=head1 SYNOPSYS

To lowercase only the files names of which contain C<blah>, do

  pfind . /blah/ '$_ = lc'

To lowercase only the files which contain C<blah> inside, do

  pfind . "=~ /blah/" '$_ = lc'

=head1 DESCRIPTION

usage: 

  pfind [-debug] [-nosubdir] [-bin] [-bak=suffix] [--] startdir \
        rule1 rule2 ...

=over 8

=item Rules, filters and actions

Rules are perl statements to execute. Statements starting with C<->,
C</>, or C<!> are considered filters, a file will be discarded unless
the statement returns true. The rest is executed I<as is>.

Rules are executed in the directory of the file.

If only filters are given the default action C<prt> (see below) is added.

=item File

In rules variables $_, $name, $dir contain the file name, full file
name and the name of the directory. Statements are executed in the
directory of the each processed file.

If file is not discarded, and $_ is changed after the perl statements
are executed, the file is renamed to the new value of $_.

=item C<prt>

Convenience function C<prt> prints C<\n>-terminated name of the file.

=item Contents of the file

If a rule starts with C<=~>, it is considered as a filter to
match contents of the file. The rest is the regular expression to
match. If regexp contains modifiers C<s> or C<m>, it is matched against
the file as a whole, otherwise it is matched line-by-line. 

If the regexp-filter fails, file processing stops. Otherwise 
whatever was matched against is available in the variable $line unless
modifiers C<s> or C<m> are given.

=item Modifying file

If a rule starts with C<=~ s> it is considered as a filter to match
and MODIFY the contents of the file.  Modifiers C<s> and C<m> are
applicable as above. To make several modifications at a time, use e.g.
C<=~ s/abc/ABC/ &&& s/def/DEF/> (modifiers should be the same, though).
In case you give the modifiers C<s> or C<m> you should think about using
the modifier C<g>, as well.

=back

=head1 OPTIONS

=over 8

=item C<-debug> 

just shows the expression which will be given to File::Find.

=item C<-nosubdir> 

do not descend into subdirectories.

=item C<-bin> 

without this binary files are not processed for substrings, and files
are opened in text mode.

=back

=head1 VERSION

$Revision: 1.10 $.

=head1 AUTHOR

Ilya Zakharevich <ilya@math.ohio-state.edu> with significant additions
by Helmut Jarausch <jarausch@igpm.rwth-aachen.de>

=cut