Perl Script to Rename Numbered Image Files and Adding or Subtracting from the Image Name

I have a directory of files that I want to copy to a new directory and rename the files.

The directory has images named 01_0001.tif to 01_0963.tif

and when I copy them to the new directory I need the following:

Images 1-4 need to have 3 added to them -  01_0001.tif becomes 01_0004.tif
Images 5-460 need to have 2 added to them - 01_0005.tif becomes 01_0007.tif

He is an example I am going by (we currently have a script doing the adding when the image is called,but now I just want to rename them without using the script that does the adding)

1       +3
5       +2
461     +5
704     +7

I have multiple variables like this and need to run the script against one directory at a time and the numbers above will always change.

FYI - I am not familiar enough with Perl Script to write this script, but I am familiar enough to understand what is being done and how to change the script.  We also are using an older version of Perl.  5 maybe?
Who is Participating?
ozoConnect With a Mentor Commented:
for my $i ( reverse <01_[0-9][0-9][0-9][0-9].tif> ){
  rename $i,$_ or warn "rename($i,$_) $!"
If images 1-4 add 3, then image 4 becomes 7
If images 5-460 add 2, them image 5 becomes 7
Is this what you want?
Which should really be image 7?
rschooffAuthor Commented:
How do I tell it which directory to run on or do I place the script inside the directory where I want it to run.

Or do I make a variable that I can change for each directory:

$storage_dir = "/usr/www";
TintinConnect With a Mentor Commented:
To specify the directory, use

for my $i ( reverse </usr/www/01_[0-9][0-9][0-9][0-9].tif> ){
For a pretty complete version try this:

---->8 cut here 8<----

#!/usr/bin/perl -w
use strict;

my $TRACE = 0;  # set to 1 to see how files are renamed

# load addition configuration
my %data;
while(<DATA>) { /^(\d+),(\d+)/ or next; $data{$1} = $2 }

# pass directory on the command or assume current directory
my $dir = $ARGV[0] || '.';

for my $source (reverse glob("$dir/*")) {
    next    unless($source =~ /tif$/);
    my $target = add($source);
    next    if($source eq $target);
    print "$source => $target\n"    if($TRACE);
    rename $source, $target
        or warn "Cannot rename $source to $target: $!\n";

sub add {
    my $file = shift;

    # note this does not assume only 4 character numbers
    my ($this,$zero,$that,$other) = $file =~ /^(.*)(0+)(\d+)(\.\w+)$/;
    return $file    unless($other);

    my $width = length($that);
    my $count = 0;
    for my $index (sort {$a <=> $b} keys %data) {
        last    if($index > $that);
        $count = $data{$index};

    $that += $count;
    $width = length($that) - $width;

    $file = $this . substr($zero,$width) . $that . $other;


---->8 cut here 8<----

The data at the end indicates the range start value, and the increment required.

Hope that helps.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.