use strict; use warnings; use diagnostics; use File::Slurp; use File::Copy::Recursive qw(rcopy fcopy); use File::Basename; my @dirs; my @patterns; my $dir1 = $ARGV[0]; get_filelist($dir1); get_patterns(); move_files(); mkdir('./ripped'); sub get_filelist { my ($dir) = @_; my ($dh); if ( !opendir( $dh, $dir ) ) { return; } while ( my $file = readdir($dh) ) { next if ( -d $file ); my $path = "$dir/$file"; if ( -d $path ) { get_filelist("$path"); } else { push( @dirs, "$dir/$file" ); } } } sub get_patterns{ my @files = read_dir('patterns'); foreach my $element(@files){ open my $file, '<', "patterns/$element"; while(<$file>){ #$_ =~s/[*]/.*/g; #$_ =~s/\\/\//g; $_ =~ s[\\/][\\\\/]g; $_ =~ s/\\/\\\//g; $_ =~ s/\./\\./g; $_ =~ s/^\*//; $_ .= '$' if $_ !~ s/\*$//; $_ =~ s/\*/.*/g; $_ =~ s/\?/./g; chomp $_; $_ = $_.'|'; push @patterns, $_; } close($file); } } sub move_files{ my $regex = join('', @patterns); print $regex; for my $element(@dirs){ if ($element =~ $regex){ print "Found $element\n"; # rcopy($element, "ripped/$element"); } } }