...
# 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";
    }
}