I'm attempting to use the perl script below to create symlinks of all folders from three locations. My desired result would be something like:
Source
/TV720/GoT/Season00/
/TV1080/GoT/Season01/
/TV2160/GoT/Season02/
Destination (Symlink)
/TV/GoT/Season00/
/TV/GoT/Season01/
/TV/GoT/Season02/
However when I run the script, I get: /TV/GoT/Season00/ without the other folders found in other sources.
It appears the 2nd and 3rd source location sub-folders aren't symlinked and merged in the event of duplicate folder names.
#!/usr/bin/perl
use strict;
use warnings;
my #sourceList = (
"/Volumes/Disk/TV720",
"/Volumes/Disk/TV1080",
"/Volumes/Disk/TV2160",
);
my $destinationFolder = "/Volumes/Disk/TV";
foreach my $currentSource (#sourceList) {
opendir SDIR, $currentSource or do {
warn "$0: can't opendir $currentSource: $!\n";
next;
};
my #sourceFolders = grep { not /^\.{1,2}$/ } readdir SDIR;
closedir SDIR;
foreach my $currentFolder (sort #sourceFolders) {
my $fromPath = $currentSource . '/' . $currentFolder;
my $toPath = $destinationFolder . '/' . $currentFolder;
if (not -e $toPath) {
# print "Creating $toPath as symlink to $fromPath\n";
symlink $fromPath, $toPath
or warn "$0: can't symlink $toPath to $fromPath: $!\n";
}
}
}
Given the information above, you might be able to accomplish what you want with union mounts on the file system. This is where you can overlay directories on top of other directories. It's more advanced than a symlink for sure, but it might do what you want.
If you want to continue with the symlinks, I would suggest modifying your script to loop through your sources and recursively iterate the subfolders in each directory.
Then for each subfolder, create an actual new folder in the destination, then iterate the files in the source subfolder and symlink each file individually.
Related
I have multiple folders where two files are present.
For example, 123.jpg, 456.jpg under folder ABC. I want to rename the files to IT1_ABC_123.v1.jpg and IT2_ABC_456.v1.jpg. Similarly, other folders have two files.
How can I do this in shell or Perl?
Try this, using shell and perl:
mkdir /tmp/test; cd $_
mkdir ABC DEF
touch {ABC,DEF}/{123,456}.jpg #creates four files, two in each directory
find|perl -nlE's,((.*)/(.+))/((123|456).jpg),$1/IT#{[++$n]}_$3_$4,&&say"$&\n$_\n"'
./ABC/123.jpg
./ABC/IT1_ABC_123.jpg
./ABC/456.jpg
./ABC/IT2_ABC_456.jpg
./DEF/123.jpg
./DEF/IT3_DEF_123.jpg
./DEF/456.jpg
./DEF/IT4_DEF_456.jpg
Now, after confirming this is what you want, replace the say with a rename:
find|perl -nlE's,((.*)/(.+))/((123|456).jpg),$1/IT#{[++$n]}_$3_$4, and rename$&,$_'
The new filenames:
find -type f
./ABC/IT1_ABC_123.jpg
./ABC/IT2_ABC_456.jpg
./DEF/IT3_DEF_123.jpg
./DEF/IT4_DEF_456.jpg
This will find filenames with 123.jpg or 456.jpg and rename them.
s,,, is the search-replace and it returns 1 (the number of changes it made) which again leads to the right side of the and being done (the rename).
Filenames that doesn't match 123.jpg or 456.jpg isn't renamed since s,,, will return 0 and the and is "short cutted" since it then logically cannot be true with a false (0) left side. So then the rename is not executed.
This variant does the same, but might be easier to read:
find|perl -nlE 'rename$&,$_ if s,((.*)/(.+))/((123|456).jpg),$1/IT#{[++$n]}_$3_$4,'
I have found this pattern useful in many cases of mass renamings. Also, dedicated software for mass renaming with GUIs exists, which for some might be easier to use.
Rewritten as a program abc.pl, it could be:
#!/usr/bin/perl
while(<>){
chomp;
next if not s,((.*)/([A-Z]{3}))/(\d{3}\.jpg),$1/IT#{[++$n]}_$3_$4,;
print "Found: $&\nNew name: $_\n\n";
#rename $&, $_;
}
Run:
find|perl abc.pl
You can do this in core Perl using the File::Find, File::Basename, and File::Copy modules. You can test it out with the script below. It won't make any changes until you uncomment the line with the "move" function.
#! perl
use strict;
use warnings;
use File::Basename;
use File::Copy;
use File::Find;
my $root_dir = '/path/to/main/folder';
# Recursively searches for all files below the $root_dir
my #fileset;
find(
sub {
# Get the absolute file path
my $path = $File::Find::name;
# Only capture the path if not a directory
# You can add any number of conditions here
if (!-d $path) {
push #fileset, $path;
}
},
$root_dir
);
# set the IT counter in new file name
my $int = 1;
# list of all possible file suffixes to have fileparse() look for. It will
# capture the end of the file path verbatim (including the period) if it's
# in this array
my #suffixes = ('.jpg', '.txt');
my $previous_dir;
foreach my $old_path (#fileset) {
# split apart the basename of the file, the directory path, and the file suffix
my ($basename, $parent_dir, $suffix) = fileparse($old_path, #suffixes);
# strip off trailing slash so fileparse() will capture parent dir name correctly
$parent_dir =~ s{[/]$}{};
# capture just the name of the parent directory
my $parent_name = fileparse($parent_dir);
# Assemble the new path
my $new_path = $parent_dir . '/IT' . $int . '_'
. $parent_name . '_' . "$basename.v1" . $suffix;
# Move the file to rename (this is safer than using rename() for cross-platform)
# move $old_path, $new_path;
print "OLD PATH: $old_path\n";
print "NEW PATH: $new_path\n\n";
# Reset counter when dir changes
if (!$previous_dir) {
$previous_dir = $parent_dir; # set previous_dir on first loop
}
elsif($previous_dir ne $parent_dir) {
$previous_dir = $parent_dir; # update previous_dir to check next loop
$int = 0; # reset counter
}
$int++; # iterate the counter
}
Edit 2018-07-12: I've updated the answer to show how to reset the counter when the directory changes by evaluating the current path with the one used in the previous loop and updating accordingly. This is not tested so it may need some adjustments.
Given the abc/def examples given, the output should look something like this:
OLD PATH: /path/to/main/folder/abc/123.jpg
NEW PATH: /path/to/main/folder/abc/IT1_abc_123.v1.jpg
OLD PATH: /path/to/main/folder/abc/456.txt
NEW PATH: /path/to/main/folder/abc/IT2_abc_456.v1.jpg
OLD PATH: /path/to/main/folder/def/123.jpg
NEW PATH: /path/to/main/folder/def/IT1_def_123.v1.jpg
OLD PATH: /path/to/main/folder/def/456.jpg
NEW PATH: /path/to/main/folder/def/IT2_def_456.v1.jpg
I am working on a windows machine and I have a directory filled with ~200k of files which I need to organise. This is a job I will need to do regularly with different filename sets but with similar patterns so perl seemed a good tool to use.
Each filename is made up of {a string A}{2 or 3 digit number B}{single letter "r" or "x"}{3 digit number}.extension
I want to create a folder for each string A
Within each folder I want a sub-folder for each B
I then want to move each file into its relevant sub-folder
So it will end up looking something like
/CustomerA/1
/CustomerA/2
/CustomerA/3
/CustomerB/1
/CustomerB/2
/CustomerB/3
etc with the files in each sub-folder
so CustomerA888x123.xml is moved into /CustomerA/888/
I have the list of files in an array but I am struggling with splitting the file name out to its constituent parts and using the parts effectively.
Thanks for the answer. I ended up with this:
#!usr/bin/perl
use warnings;
use strict;
use File::Copy qw(move);
use File::Path qw(make_path);
opendir my $dir, ".";
my #files = readdir($dir);
closedir $dir;
foreach my $file (#files) {
my ($cust, $num) = $file =~ m/(\D+)(\d+)/;
my $dirname = "$cust/$num";
my #dirs_made = make_path($dirname, { verbose => 1 });
move($file, $dirname) or warn "cant move $file to $dirname: $!";
}
Given your description of file names, this regex should parse what you need
my ($cust, $num) = $filename =~ m/(\D+)(\d+)/;
Use a more precise pattern if you wish or need to be more specific about what precedes the number, for example [a-zA-Z] for letters only.
With that on hand, you can create directories using the core module File::Path, for example
use File::Path qw(make_path);
my $dirname = "$cust/$num";
my #dirs_made = make_path($dirname, { verbose => 1 });
This creates the path as needed, returning the names of created directories. It also prints the names with the verbose. If the directory exists it quietly skips it. If there are problems it raises a die so you may want to wrap it in eval
eval { make_path($dirname) };
if ($#) {
warn "Error with make_path($dirname): $#";
}
Also note the File::Path::Tiny module as an alternative, thanks to Sinan Ünür for bringing it up. Other than being far lighter, it also has the more common error-handling policy whereby a false is returned on failure so you don't need an eval but only the usual check
use File::Path::Tiny;
File::Path::Tiny::mk($path) or warn "Can't mk($path): $!";
The module behaves similarly to mkdir in many ways, see the linked documentation.
Move the files using the move function form the core module File::Copy, for example
use File::Copy qw(move);
move($file, $dirname) or warn "Can't move $file to $dirname: $!";
All this can be in a loop over the array with the file names.
I'm just barely familiar with bash scripts, and am trying to achieve being able to specify a source location (a directory with files / sub-directories) and a list of multiple destination directories, along with a list of files / directories from the source to exclude when copying & replacing.
The script should loop through each destination location, copy the files from the source and replace them in the destination location, excluding any files / directories listed in the script to skip.
In PHP it would be something like:
$source = '/home/user1/public_html';
$destinations = array(
'user2',
'user3',
'user4'
);
$exclude = array(
'/uploads/custom',
'/config/conf.php'
);
foreach ($destinations as $destination) {
$dir = '/home/' .$destination. '/public_html';
if (is_dir($dir)) {
exec('cp -R ' .$source. '/* ' .$dir);
// and somehow exclude overwriting any files / directories matching what's in the $exclude array
}
}
So, my question is, how would a bash script with similar functionality be written?
Here's how I ended up doing it:
#!/bin/bash
while IFS= read -r line || [[ $line ]]; do
if [[ -d "$line" ]]; then
rsync -rv --exclude-from "exclude.txt" /home/source/public_html/ "$line"
else
echo "Directory $line does not exist!"
fi
done < "accounts.txt"
This reads from a file called "accounts.txt" that has all the destination account directories in it, one per line. Ex:
/home/user1/public_html
/home/myblog/public_html
It loops through each one, and if the directory exists, it copies the files from /home/source/public_html to the destination. It also reads from a file called "exclude.txt" that includes, one per line, any files or directories to exclude. Ex:
.git
/uploads/custom
/config/conf.php
This is my code:
opendir(DIR, $directoryPath) or die "Cant open $directoryPath$!";
my #files = readdir(DIR); #Array of file names
closedir (DIR) or die "Cant close $directoryPath$!";
I'm using #files to create an array of the file names within the directory for renaming later in the program.
The problem is:
I am getting the error "Bad Symbol for dirhandle" at the closedir line.
If I don't closedir to avoid this, I don't have permission to change file names (I'm using Windows).
I tried an alternative way of renaming the files (below) to try a different solution to the problem by renaming the files a different way and within the dirhandles, but this just repeat the permission errors.
opendir(DIR, $directoryPath) or die "Cant open $directoryPath$!";
while( (my $filename = readdir(DIR)))
{
rename($filename, $nFileName . $i) or die "Cant rename file $filename$!";
i++;
}
closedir (DIR) or die "Cant close $directoryPath$!";
From a quick bit of research I think the permission error is a Windows security feature so you can't edit a file while its open, but I haven't been able to find a solution simple enough for me to understand.
An answer to point 1. or point 3. is preferrable, but an answer to point 2. will also be useful.
Full code used in points 1. and 2. below
use 5.16.3;
use strict;
print "Enter Directory: ";
my $directoryPath = <>;
chomp($directoryPath);
chdir("$directoryPath") or die "Cant chdir to $directoryPath$!";
opendir(DIR, $directoryPath) or die "Cant open $directoryPath$!";
my #files = readdir(DIR); #Array of file names
closedir (DIR) or die "Cant close $directoryPath$!";
my $fileName = "File ";
for my $i (0 .. #files)
{
rename($files[$i], $fileName . ($i+1)) or die "Cant rename file $files[$i]$!";
}
chdir; #return to home directory
I can input the path correctly, but then error message (copied exactly) is:
Can't rename file .Permission denied at C:\path\to\file\RenameFiles.pl line 19, <> line 1.
The error
Can't rename file .Permission denied at C:\path\to\file\RenameFiles.pl line 19, <> line 1.
says that you are trying to rename the file ., which is a special file that is a shortcut for "current directory". You should add exceptions to your code to not rename this file, and the one called ... Something like:
next if $files[$i] =~ /^\./;
Would do. This will skip over any file that begins with a period .. Alternatively you can skip directories:
next if -d $files[$i]; # skip directories (includes . and ..)
As TLP has already pointed out, readdir returns . and .. which corresponds to the current and parent directory.
You'll need to filter those out in order to avoid renaming directories.
use strict;
use warnings;
use autodie;
print "Enter Directory: ";
chomp( my $dirpath = <> );
opendir my $dh, $dirpath or die "Can't open $dirpath: $!";
my $number = 0;
while ( my $file = readdir($dh) ) {
next if $file =~ /^\.+$/;
my $newfile = "$dirpath/File " . ++$number;
rename "$dirpath/$file", $newfile or die "Cant rename file $file -> $newfile: $!";
}
closedir $dh;
Cross Platform Compatibility using Path::Class
One way to simplify this script and logic is to use Path::Class to handle file and directory operations.
use strict;
use warnings;
use autodie;
use Path::Class;
print "Enter Directory: ";
chomp( my $dirname = <> );
my $dir = dir($dirname);
my $number = 0;
for my $file ( $dir->children ) {
next if $file->is_dir();
my $newfile = $dir->file( "File" . ++$number );
$file->move_to($newfile);
}
I am perl noob, and trying to do following:
Search for files with specific string in a directory recursively. Say string is 'abc.txt'
The file can be in two different sub-directories, say dir_1 or dir_2
Once the file is found, if it is found in dir_1, rename it to dir_1_abc.txt. If it is in dir_2, then rename it to dir_2_abc.txt.
Once all the files have been found and renamed, move them all to a new directory named, say dir_3
I don't care if I have to use any module to accomplish this. I have been trying to do it using File::Find::Rule and File::copy, but not getting the desired result. Here is my sample code:
#!/usr/bin/perl -sl
use strict;
use warnings;
use File::Find::Rule;
use File::Copy;
my $dir1 = '/Users/macuser/ParentDirectory/logs/dir_1'
my $dir2 = '/Users/macuser/ParentDirectory/logs/dir_2'
#ideally I just want to define one directory but because of the logic I am using in IF
#statement, I am specifying two different directory paths
my $dest_dir = '/Users/macuser/dir_3';
my(#old_files) = find(
file => (),
name => '*abc.txt',
in => $dir1, $dir2 ); #not sure if I can give two directories, works with on
foreach my $old_file(#old_files) {
print $old_file; #added this for debug
if ($dest_dir =~ m/dir_1/)
{
print "yes in the loop";
rename ($old_file, "dir_1_$old_file");
print $old_file;
copy "$old_file", "$dest_dir";
}
if ($dest_dir =~ m/dir_2/)
{
print "yes in the loop";
rename ($old_file, "dir_2_$old_file");
print $old_file;
copy "$old_file", "dest_dir";
}
}
The code above does not change the file name, instead when I am printing $old_file inside if, it spits the whole directory path, where the file is found, and it is prefixing the path with dir_1 and dir_2 respectively. Something is horribly wrong. Please help simply.
If you have bash ( I assume in OSX it is available), you can do this in a few lines (usually I put them in one line).
destdir="your_dest_dir"
for i in `find /Users/macuser/ParentDirectory/logs -type f -iname '*abc.txt' `
do
prefix=`dirname $i`
if [[ $prefix = *dir_1* ]] ; then
prefix="dir_1"
fi
dest="$destdir/${prefix}_`basename $i`"
mv "$i" "$dest"
done
The advantage of this method is that you can have many sub dirs under logs and you don't need to specify them. you can search for files like blah_abc.txt, tada_abc.txt too. If you want a exact match just juse abc.txt, instead of *abc.txt.
If the files can be placed in the destination as you rename them, try this:
#!/usr/bin/perl
use strict;
use File::Find;
use File::Copy;
my $dest_dir = '/Users/macuser/dir_3';
foreach my $dir ('/Users/macuser/ParentDirectory/logs/dir_1', '/Users/macuser/ParentDirectory/logs/dir_2') {
my $prefix = $dir; $prefix =~ s/.*\///;
find(sub {
move($File::Find::name, "$dest_dir/${prefix}_$_") if /abc\.txt$/;
}, $dir);
}
If you need to do all the renaming first and then move them all, you could either remember the list of files you have to move or you can make two passes making sure the pattern on the second pass is still OK after the initial rename in the first pass.