Perl: moving files into dedicated folders -

i have perl script move files 1 directory (/folder/) (/folder2/) , if file name (file20.doc) matches folder name (folder/file20) put file folder.

what need if part of file name matches folder put file folder. example if file named file24.doc put file file20.

here script have match extact file names matching folders.

#!/usr/bin/perl use warnings; use file::copy;  $srcdir = "/folder/";  $dest = "/folder2/";  opendir(dir, $srcdir) or die "can't open $srcdir: $!";  @files = grep {!/^\.+$/ }  readdir(dir);    foreach $file (@files) {   $old = "$srcdir/$file";    move($old, $dest) or die "move $old -> $dest failed: $!";    }    close(dir);  print "  -complete"; exit; 

i'm proposing solution problem. while it's far perfect, has, think, benefit of having factored out destination finding routine.

use strict; use warnings; use file::copy 'move';  # determine destination folder file based on filename. # destinations below fallback destination provided input. sub make_dest_finder {     $fallback_dest = shift;     return sub {         $fnam = shift;         # determine basename start looking destination folder.         $basename = substr $fnam, 0, rindex $fnam, '.';         # shorten name while no homonymous folder exists.         chop $basename while $basename && ! -d "$fallback_dest/$basename";         return "$fallback_dest/$basename" if $basename;         return  $fallback_dest;     }; }  $srcdir      = "/tmp/folder"; $dest_finder = make_dest_finder '/tmp/folder2';  opendir $dh, $srcdir or die "can't open $srcdir: $!"; @files = grep ! /^\.+$/, readdir $dh; close $dh;  $moved = 0; foreach $file (@files) {     $old = "$srcdir/$file";     $dest = $dest_finder->( $file );     print stderr "moving $file $dest\n";     if ( ! move $old, $dest ) {         warn "move $old -> $dest failed: $!";         last;     }     $moved++; }  print stderr "\n\n- moved $moved files\n";