Perl script to rename multiple files with vi(m)

Question

I'm new to Perl, learning on my own. I've wrote many scripts (utilities) for myself but never posted them online. I would really appreciate any feedback on this script before I post it on a forum.

The script takes list of files names on command line, writes the name list in tmp file and opens it with vi(m). After user is done renaming, it reads new names from tmp file and renames files accordingly. Script can also process symlinks, where it lists and renames the target file name and also updates the symlink to point to renamed file afterwards.

#!/usr/bin/perl -w
use strict;
use Getopt::Std;
use File::Temp qw( tempfile );
use File::Basename qw( basename dirname );

# HANDLING CMD ARGS
$Getopt::Std::STANDARD_HELP_VERSION = 1;
my $usage = \&main::HELP_MESSAGE;
my %opts;

sub main::VERSION_MESSAGE {
    print "virename v0.1\n";
}

sub main::HELP_MESSAGE {
    print << "EOF";
Usage:\n virename [OPTIONS] [file_names]

OPTIONS
 -s                act on symlink target (also update symlink)
 -v                be verbose
 --help            pirnt help and exit
 --version         version
EOF
}

if (@ARGV) {
    getopts( 'vs', \%opts ) or $usage->();
}
else {
    print "Not enough arguments!\n\n";
    $usage->();
    exit 1;
}

my ( @names, @new_names, %symlinks );

if ( $opts{s} ) {
    for my $name (@ARGV) {
        if ( my $target = readlink $name ) {
            my $target_name = basename $target;
            $symlinks{$target_name} = { 'symlink', $name, 'target', $target };
            push @names, $target_name;
        }
        else {
            push @names, $name;
        }
    }
}
else {
    @names = @ARGV;
}

die "Nothing to rename!\n" unless @names;

my ( $tmp, $tmp_name ) = tempfile();    # Tmp file

print {$tmp} join "\n", @names;         # Writing names to tmp file
if ( !system "vim $tmp_name 2>/dev/null" ) {
}
elsif ( !system 'vi', $tmp_name ) {
}
else { exit; }

seek $tmp, 0, 0;
chomp( @new_names = <$tmp> );           # Reading new names from tmp file

unlink $tmp_name;                       # Removing tmp file

exit if @names != @new_names;

#Renaming
for ( 0 .. $#names ) {
    my ( $new_name, $old_name );
    my $is_symlink = exists $symlinks{ $names[$_] };
    if ( $opts{s} && $is_symlink ) {
        $old_name = $symlinks{ $names[$_] }->{target};
        $new_name = dirname($old_name) . q{/} . $new_names[$_];
    }
    else {
        $old_name = $names[$_];
        $new_name = $new_names[$_];
    }

    if ( -e $new_name ) {    #Skip if file already exists
        print "'$new_name' already exits!\n" if $opts{v};
    }
    elsif ( rename $old_name => $new_name ) {
        if ( $opts{s} && $is_symlink ) {
            my $symlink = $symlinks{ $names[$_] }->{symlink};
            unlink $symlink;    # Removing old symlink
            symlink $new_name => $symlink    # Creating new symlink
              or warn "symlink: $!\n";
            print "'$symlink': '$old_name' => '$new_name'" if $opts{v};
        }
        else {
            print "'$old_name' => '$new_name'\n" if $opts{v};
        }
    }
    else {
        warn "failed to rename $old_name to $new_name: $!\n";
    }
}
__END__

Answer 1

That is a nice and useful script, although a few things could be improved.

• You specified the -w command line option. You should instead use warnings. While the result is identical for such a small script, the warnings pragma allows for fine-grained control of warnings.

• You do not have to specify main:: when defining subroutines. When no package is specified, then you are already in the package main. Reduce the syntactic clutter, and simply write sub VERSION_MESSAGE { ... }.

• In HELP_MESSAGE, I'd use the heredoc-marker differently: I'd prefer it to be <<'EOF'. Rationale: Double quotes allow interpolation of variables. For a reader of the code, this increases the cognitive load: where do you interpolate something? Nowhere. If I specify the marker with single quotes, I can just skip to the end marker; knowing that nothing interesting happens in between.

  I'd also rather not put a space between the << and the 'END'. The heredoc-marker is syntactically one single token, and you can't specify the marker with other quoting operators like << q(END).

  As we now use single quotes, no escapes are available, so your \n won't work any more. No problem, just use a literal newline:

  <<'EOF';
  Usage:
   virename [OPTIONS] [file_names]
  ...
  EOF
  

  for the same effect.

• Why do you put the HELP_MESSAGE sub into the scalar $usage? You can invoke the sub directly like HELP_MESSAGE() instead of the much more complicated $usage->().

• sub VERSION_MESSAGE { print "virename v0.1\n"; }. Nope. The documentation for Getopt::Std may not make this perfectly clear, but your VERSION_MESSAGE sub receives some paramaters. The first of these is the filehandle you are expected to print to. Error messages or information that is not the primary output of your script should generally not go to STDOUT, but to STDERR. So we will rewrite that to

  # callback for Getopt::Std
  sub VERSION_MESSAGE {
    my ($handle) = @_;
    print {$handle} "virename v0.1\n";
  }
  

  Notice also the comment that tells a reader why you put this seemingly unused sub here and why you chose a name in offending uppercase.

  The same considerations hold for HELP_MESSAGE, which should be rewritten as well.

• print "Not enough arguments!\n\n"; ...; exit 1. Nope.

  First, what you are expressing is very close to die, so we'll rather use that. The above rant about how error messages shouldn't go to STDOUT applies here as well, but using die fixes that. But we would like to print out the usage without having to call a sub that prints it out. The solution is to put this message into a variable, e.g.

  my $help_message = <<'EOF';
  ...
  EOF
  
  # callback for Getopt::Std
  sub HELP_MESSAGE {
    my ($handle) = @_;
    print {$handle} $help_message;
  }
  

  Now we can say

  @ARGV or die "Not enough arguments!\n\n", $help_message;
  getopts 'vs', \%opts or die $help_message;
  

  When an unknown flag is among the arguments and getopts returns a false value, I not only print the usage (as you do), but also terminate execution. I think this is preferable than continuing with possibly wrong arguments.

• A comment here and there would not hurt. E.g.

  if ( $opts{s} ) {
    # If a file is a symlink, we need to find the actual target
    # and put that into @names instead.
    ...
  }
  

  A short paragraph telling a reader what you are about to do can really help.

• What the hell?

  if ( !system "vim $tmp_name 2>/dev/null" ) {
  }
  elsif ( !system 'vi', $tmp_name ) {
  }
  else { exit; }
  

  I do understand what you are trying to express, but it isn't exactly obvious. There is a nicer way to do that. Also, don't fail with a normal exit code when there clearly was an error, and don't exit abnormally without an error message!

  system("vim $tmp_name 2>/dev/null") == 0
    or system("vi", $tmp_name) == 0
    or die "Can't launch vim or vi\n";
  

  Note: Don't write code that isn't self-explanatory without a comment. Also, If you're using empty bodies for an if in Perl, this should raise an eyebrow.

• chomp( @new_names = <$tmp> ); # Reading new names from tmp file

  Thankyou for the comment, but that code is fairly self-explaining. Ergo, this comment is unneccessary.

  As this is the first occasion where the @new_names variable is used, it should also be declared here, and not further upwards. This would work as well:

  chomp( my @new_names = <$tmp> );
  

  … altough others may not like embedding declarations inside an argument list. Then:

  my @new_names = <$tmp>;
  chomp @new_names;
  

• exit if @names != @new_names;. I covered this already: Don't exit abnormally without reflecting this in the error code, and don't abort execution without an error message telling the user what went wrong:

  @names == @new_names or die "Number of filenames changed. Did you delete a line?\n";
  

• In the loop, you could consider changing the definition of $is_symlink to

  my $is_symlink = $opts{s} && exists $symlinks{ $names[$_] };
  

  This reduced a tiny bit of code duplicatation.

• The following if/elsif/else confuses two unrelated topics: Loop control and error handling.

  if ( -e $new_name ) {    #Skip if file already exists
      print "'$new_name' already exits!\n" if $opts{v};
  } elsif ( rename $old_name => $new_name ) {
      ...
  } else {
      warn ...;
  }
  

  If you want to move on to the next iteration of the loop, just use next:

  if ( -e $new_name ) {
    print ... if $opst{$v};
    next;
  }
  

  I am not sure if what you are printing is considered regular output, or an error message. I assume it is normal output, so my STDERR ranting does not apply here.

  Your rename and the correspondig error handling (in form of a warn) are seperated by a dozen lines. I would move them closer together:

  rename $old_name => $new_name or do {
    warn ...;
    next;
  };
  ...;
  

• The __END__ marker is generally useless, unless you keep some non-code resources in the same file, or when you pipe the code to the perl interpreter. All this marker does is to stop the parsing of the source file.