Did you write some code? We'd be glad to critique it and give pointers.

Thinking fuzzily before sufficient coffee, you want something like longest common substring.

Another way to look at it is to join the names, and match that way. Here's an untried, unsophisticated approach:

...
# get the list of filenames (somehow)
my @files = readdir;

# make a copy
my @files_copy = @files; 

# the number of files, less 1
my $file_count_less_one = $#files;

# hash map for results
my %new_file_names; 

# loop until explicit last
while (1) {
    # join them with a character that's unlikely to be in the names
    my $joined = join('|',@files_copy);    

    # look for matches, catch the first one only (they're all the same
+)
    if (my ($match) = $joined =~ m/[^|]*?([^|]+)[^|]*?(?:[|][^|]*?\1[^
+|]*?){$file_count_less_one/) {
       # remove the matched substrings
       my @files_new;
       for my $file (@files_copy) {
           $file =~ s/$match//;
           push @files_new, $file;
       }
      
       # get ready for next loop
       @files_copy = @files_new;
       next;
   } else {
       # no more matches, make a hash map for the rename
       @new_file_names{@files} = @files_copy;
       last; # no more matches
   }
}

while (my ($old,$new) = each %new_file_names) {
    unless (rename $old, $new) {
        warn "Error renaming $old to $new";
    }
}
[download]

Lots of room for improvement there, including checking whether a new file name already exists, aliasing array elements in for loops, considering dir names in file names, etc.