#!/usr/bin/perl -w
#
#  This script is based on rename version 1.8 by Robin Barker
#  (Robin.Barker@npl.co.uk), from Larry Wall's original script eg/rename from
#  the perl source.
#
#  This script is free software; you can redistribute it and/or modify it
#  under the same terms as Perl itself.
#
# 2012/08/14

use strict;

use File::Basename;
use Getopt::Long;
Getopt::Long::Configure('bundling');

my ($verbose, $no_act, $force, $op);

die "Usage: lnrename [-v] [-n] [-f] <perlexpr> [<filenames>]\n"
    unless GetOptions(
	'v|verbose' => \$verbose,
	'n|no-act'  => \$no_act,
	'f|force'   => \$force,
    ) and $op = shift;

$verbose++ if $no_act;

if (!@ARGV) {
    print "reading filenames from STDIN\n" if $verbose;
    @ARGV = <STDIN>;
    chomp(@ARGV);
}

for (@ARGV) {
    my $link = $_;
    my $dir = dirname($link);
    $dir =~ s#$#/# unless $dir =~ s/^\.$//;
    my $was = readlink($link);
    unless ($was)
    {
	warn "Cannot read target of $link: $!\n";
	next;
    }
    $_ = $was;
    eval $op;
    die $@ if $@;
    next if $was eq $_; # ignore quietly    
    if (!-e "$dir$_" and !$force)
    {
	warn  "$link not changed: the new target $dir$_ does not exist\n";
    }
    elsif ($no_act or (unlink $link and symlink $_, $link))
    {
	print "$link lnrenamed from $was to $_\n" if $verbose;
    }
    else
    {
	warn  "Can't lnrename $link from $was to $_: $!\n";
    }
}

__END__

=encoding utf-8

=head1 NAME

lnrename - modifies the link target of multiple symbolic link files

=head1 SYNOPSIS

B<lnrename> S<[ B<-v> ]> S<[ B<-n> ]> S<[ B<-f> ]> I<perlexpr> S<[ I<files> ]>

=head1 DESCRIPTION

C<lnrename>
renames the target of the symbolic links supplied according to the rule
specified as the first argument.
The I<perlexpr> 
argument is a Perl expression which is expected to modify the C<$_>
string in Perl for at least some of the symlink targets specified.
If a given target is not modified by the expression, it will not be
changed.
If no filenames are given on the command line, filenames will be read
via standard input.

For example, to correct all symbolic links that used to point to files
matching C<*.bak> whose extension you just stripped with

	rename 's/\.bak$//' *.bak

you might say similarly

	lnrename 's/\.bak$//' *

To translate uppercase names to lower, you'd use

	lnrename 'y/A-Z/a-z/' *

=head1 OPTIONS

=over 8

=item B<-v>, B<--verbose>

Verbose: print names of symlinks successfully modified.

=item B<-n>, B<--no-act>

No Action: show what symlinks would have been modified.

=item B<-f>, B<--force>

Force: create dangling symlinks.

=back

=head1 ENVIRONMENT

No environment variables are used.

=head1 AUTHOR

Larry Wall, Géraud Meyer

=head1 SEE ALSO

rename(1), ln(1), perl(1)

=head1 DIAGNOSTICS

If you give an invalid Perl expression you'll get a syntax error.

=cut
