Move files to directories - perl

Is there any reason why the following construction would not work? The file list contains file names. The name list contains a list of names that when matched as a substring to a file name, causes the loop to move the file to the directory called $name. It seems like it should work but it is not moving files. What is a better way to construct this?
FILE: for my $file (#file_list) {
for my $name (#name_list) {
if ($file =~ /^\Q$name\E/) {
rename "/Users/path/to/file/I/need/to/move/$file", "/Users/path/to/directory/i/need/to/move/file/to/$name/$file" or die "rename failed because: $!\n";
next FILE;
}
}
print "no match for $file\n";
}

Right code:
for my $file (#file_list) {
my $found = 0;
for my $name (#name_list) {
if ($file =~ /^\Q$name\E/) {
print "failed to rename $file\n" unless rename "/Users/path/to/file/I/need/to/move/$file", "/Users/path/to/directory/i/need/to/move/file/to/$name/$file";
$found = 1;
last;
}
}
print "no match for $file\n" unless $found;
}

Related

Changing names of the files found with File::Find

Hi consider this Perl code:
for my $line (#files){
#print "$line\n";
if ($line =~ /gene\/(\w.+)\s\w+\/(\w.+)(\.\S.+\.\S.+\.gz)/){
#print "$line\n";
#array = split ('\t', $1);
my $path = $array[0];
foreach my $pathi (sort(keys(%legend))){
foreach my $name ( keys %{$legend{$pathi}}){
foreach my $sample ( keys %{$legend{$pathi}{$name}}){
if ($pathi =~ $path){
my $dirsearch = "/Users/bob/Desktop/gene_ex/";
find(\&wantede, $dirsearch);
sub wantede {
if ($_ eq $name){
my $finalname = "$sample\_$name";
rename ($File::Find::name, "$File::Find::dir/$finalname") or print "Rename error";
}
}
}
}
}
}
}
}
What i want to do is search for a particular file and attach another branch at the name: the find function goes exactly like this when but when i try to find the $name inside i got an error that $name is not declared or something. I've controlled all the hashes and they are fine, i can't figure out what is wrong. If i make the concatenation first, i get every time the same name on the files
In #files there are all the files within the working directory
In %legend is a hash where the first key is the name of the folder, second key is filename, third key is a string.

File managing issues

im working on a simple script to rename & move files into a new directory. I can't seem to get it work properly, basically if the folder is already created it will moves the files into it only if the files are renamed, if the folder is already created but files need to be renamed it won't work it will just rename the files and give me an error because it won't be able to move the files. If the folder need to be created and files to be renamed it will create the folder and rename the files but it won't be able to move them. So i am a bit lost really..
http://i.stack.imgur.com/v8smp.jpg
I've been trying a lot of different way but it ends up not working or giving me the same result i think i am doing something wrong, heres my code :
use strict;
use warnings;
use File::Copy qw(mv);
my ($movie, $season, $cont) = #ARGV;
if (not defined $movie) {
die "need a name as first argument\n";
}
if (defined $movie and defined $season and defined $cont) {
print "\n\nProcessing $movie season $season with container .$cont :\n";
my $npath = "Saison "."$season";
my $exist = 0;
my $num = 1;
my $ind = 0;
my $flast = undef;
my $rpath = undef;
my #files = glob("*.$cont");
my #all = glob('*');
foreach my $f (#files) {
if ($f =~ m/e([0-1_-] ?)\Q$num/i or $f =~ m/episode([0-1_-] ?)\Q$num/i) {
$flast = "$movie.S$season"."E$num.$cont";
rename($f, $flast) or die "\nError while renaming $f !";
$num++;
}
}
if (-d "$npath") {
$exist = 1;
print "\n$npath";
}
else {
mkdir($npath) or die "\nError while making new directory";
$exist = 1;
}
sleep(1);
if ($exist == 1) {
foreach my $f (#files) {
$npath = "Saison "."$season/$f";
mv($f, $npath) or die "\nError while moving $f";
print "\n$f done !";
$ind++;
}
print "\n\n$ind files processed successfully !";
}
}
The problem is that you are renaming the files and then moving them, but after the rename the file no longer exists under its old name in the #files array
You can use mv to change the name of the file as well as putting it into a new directory. In other words, you can call
mv 'movie.title.s01.e08.(2008).[1080p].mkv', 'Saison 01/Movie TitleS01E08.mkv'
which simplifies your program considerably. You just need to create the new directory if it doesn't exist, and then call mv $f, "$npath/$flast" for each name in #files

Copy files from one folder to another based on similar file name

I trying to write a script that will copy files from one folder to another based on the file name(similar). As I got Few thousands text files in a folder. But I try to find few hundreds of files out of thousands files. It's takes a lot of time to search it one by one.
Copy seem like a good idea to use in this and then use for to loop through the list of files that I try to find out of thousands. But Copy need a specified name. The problem is I only have part of the file name.
Example of list of files(Content of the text file):
ABCDEF-A01
ADEWSD-B03
ABDDER-C23
Example of filename:
GGI_1409506_ABCDEF-A01.txt,GGI_ADEWSD-B03.txt,DA_ABDDER-C23_12304.txt
I only got the ABCDEF-A01 instead of the full filename.
Expected result:
Able to search through the folder and copy the files to another location that matched according the list of files (one text files).
Anything that you can share? Info/ans/related posts? Thank you so much!
Try the below code in perl . When running the program pass the arguments for Source Directory path and Destination Directory path along with the list of filename that need to be searched. If destination directory doesn't exist it will create a folder automatically through the program as shown below :
Code:
use strict;
use warnings;
use File::Copy;
my $source = $ARGV[0];
my $destination = $ARGV[1];
my $listFiles = $ARGV[2];
if(-f $destination)
{
print "Already unknown extension of file exists with the same name of directory. So rename the file and run the program";
exit 0;
}
if(-d "$destination")
{
print "Directory where files need to be copied: $destination\n";
}
else
{
print "No Directory found and hence created the directory $destination\n";
mkdir("$destination");
}
opendir DIR, $source or die "cant open dir";
my #files = grep /(.*?)(\.txt)$/,(readdir DIR);
open my $fh, '<', "$listFiles" or die "Cannot open the file names to search $listFiles - $!";
open my $out,'>', "$ARGV[1]\\NoMatch.txt" or die "Cannot write to the file NoMatch.txt - $!";
my #listFileNames = <$fh>;
my #listFiles = ();
foreach my $InputFiles (#files)
{
chomp($InputFiles);
foreach my $list(#listFileNames)
{
chomp($list);
if($InputFiles =~ /$list/isg)
{
print "Files : $InputFiles copying\t";
copy("$InputFiles","$destination");
print "Files : $InputFiles copied\n";
push(#listFiles,$list);
}
}
}
my %seen = ();
my $count = 0;
foreach my $list (#listFiles)
{
$seen{lc($list)} = 1;
#print $list . "\n";
}
foreach my $listnames (#listFileNames)
{
if($seen{lc($listnames)})
{
}
else
{
if($count ==0)
{
print "\nFilenames that did not match the text files are present in the destination folder : NoMatch.txt file " . "\n";
}
print $out "$listnames\n";
$count++;
}
}
close($out);
close($fh);
closedir(DIR);
create a batch file and put it in the source folder, with your list of files you want to copy.
for /f %%f in (list.txt) do robocopy c:\source d:\dest %%f
Hope this helps
#!/usr/bin/perl -w
use strict;
use File::Copy;
my $sorce_direcrtory = qq{};
my $new_directory = "";
opendir(my $dh, $sorce_direcrtory) || die;
while(readdir $dh) {
if($_ =~ /[A..Z]+\-[A..Z]\d+/){
move("$sorce_direcrtory/$_", "$new_directory/$_");
}
}
closedir $dh;

Search for occurrences of contents of a file in another file

I want to search the contents of files in a directory for words present in files in another directory. Is there a better way to do it than the following? (By better mean memory usage wise)
More specifically:
folder 1 has several files, each file has several lines of text.
folder 2 has several files, each file has several words, each on its line.
What I want to do is count the number of occurrences of each word in each file in folder 2 in each line of each file of folder 1.
I hope that wasn't too confusing.
open my $output, ">>D:/output.txt";
my #files = <"folder1/*">;
my #categories = <"folder2/*">;
foreach my $file (#files){
open my $fileh, $file || die "Can't open file $companyName";
foreach my $line (<$fileh>){
foreach my $categoryName (#categories){
open my $categoryFile, $categoryName || die "Can't open file $categoryName";
foreach my $word(<$categoryFile>){
#search using regex
}
#print to output
}
}
}
One obvious improvement is to open all the category files first in a separate loop and cache the words in them into a hash of arrays (hash key being the filename), or just one big array if you don't care which search word came from which file.
This will avoid having to re-read the search files for every line in every $file - AND help get rid of duplicate search words in the bargain.
use File::Slurp;
open my $output, ">>D:/output.txt";
my %categories = ();
my #files = <"folder1/*">;
my #categories = <"folder2/*">;
foreach my $categoryName (#categories) {
my #lines = read_file($categoryName);
foreach my $category (#lines) {
chomp($category);
$categories{$category} = 0;
}
}
# add in some code to uniquify #categories
foreach my $file (#files) {
open my $fileh, $file || die "Can't open file $companyName";
foreach my $line (<$fileh>) {
foreach my $category (#categories) {
# count
}
}
# output
}
Also, if these are real "words" - meaning a category of "cat" needs to match "cat dog" but not "mcat" - I would count the word usage by splitting instead of a regex:
foreach my $line (<$fileh>) {
my #words = split(/\s+/, $line);
foreach my $word (#words) {
$categories{$word}++ if exists $categories{$word};
}
}

Perl Rename Folders And Files With File::Find

I'm using this code to process my folders and files with two subs:
"sub folders" for folder names only
"sub files" for file names with extensions only
But I realized that "sub folders" messes with my files with extensions during the rename process.
How to distinguish the processes from one another or what is the intelligent way to tell "sub folders" to rename "names" with no extension and "sub files" to rename "names" with externsion?
find(\&folders, $dir_source);
sub folders {
my $fh = $File::Find::dir;
my $artist = (File::Spec->splitdir($fh))[3];
if (-d $fh) {
my $folder_name = $_;
# some substitution
rename $folder_name, $_;
}
}
find(\&files, $dir_source);
sub files {
/\.\w+$/ or return;
my $fn = $File::Find::name;
my ($genre, $artist, $boxset, $album, $disc);
if ($fn =~ /Singles/ or $fn =~ /Box Set/) {
($genre, $artist, $boxset, $album, $disc) = (File::Spec->splitdir($fn))[2..6];
}
else {
($genre, $artist, $album, $disc) = (File::Spec->splitdir($fn))[2..5];
}
if (-e $fn) {
my $file_name = $_;
# some substitution
rename $file_name, $_;
}
}
File::Find::find() calls your sub for every file and folder. If you only want to affect folders, then ignore files:
And you'll need to call finddepth() instead of find(), since you're changing directory names (you'll want to rename the "deeper" directories before the more "shallow" ones).
finddepth(sub {
return unless -d;
(my $new = $_) =~ s/this/that/ or return;
rename $_, $new or warn "Err renaming $_ to $new in $File::Find::dir: $!";
}, ".");
Alternative for multiple substitutions:
finddepth(sub {
return unless -d;
my $new = $_;
for ($new) {
s/this/that/;
s/something/something_else/;
}
return if $_ eq $new;
rename $_, $new or warn "Err renaming $_ to $new in $File::Find::dir: $!";
}, ".");
And in the files sub, I'd make the first statement:
return unless -f;