Like Perl, how can I rename files in all subdirectories of a drive?

How can I rename all files on a disk with the .wma and .wmv extensions to the .txt extension using Perl, no matter how deep they are in the directory structure?

+4
source share
7 answers

See perldoc File :: Find . The examples in the documentation are pretty clear and will get you most of the way. When you try, update the question with more information.

If this is a training exercise, you will learn better by first trying to do it yourself.

UPDATE:

Assuming that you had the opportunity to see how to do it yourself, and taking into account the fact that the various solutions were published, I publish how I would do it. Note that I would prefer to ignore files such as ".wmv": my regex requires something to appear before the dot.

#!/usr/bin/perl use strict; use warnings; use File::Find; my ($dir) = @ARGV; find( \&wanted, $dir ); sub wanted { return unless -f; return unless /^(.+)\.wm[av]$/i; my $new = "$1.txt"; rename $_ => $new or warn "'$_' => '$new' failed: $!\n"; return; } __END__ 
+10
source
  #! / usr / bin / perl

 use strict;
 use warnings;
 use File :: Find;

 my $ dir = '/ path / to / dir';

 File :: Find :: find (
     sub {
         my $ file = $ _;
         return if -d $ file;
         return if $ file! ~ /(.*)\.wm[avapter$/;
         rename $ file, "$ 1.txt" or die $ !;
     }, $ dir
 );
+3
source

And if you are a beginner, another useful tip: to rename files, use the "move ()" method from the "File :: Copy" module (and always check whether move () has worked)

Also, avoid the non-obvious mistake of accidentally renaming a directory whose name ends with .wma / .wmv (since the “desired” callback is called for both files and directories)

PS I definitely agree with the file :: Find tip above (also consider searching in File :: Find :: Rule, as described in this link ). However, as an exercise in learning Perl, writing your own recursive file finder (or better yet, turning it from a recursive to a loop with a wide search loop) is something you can consider if your goal is to learn, rather than just write fast disposable.

+2
source
 find . -name '*.wm[va]' -a -type f -exec mv '{}' '{}.txt' \; 

Well, there are two main problems with this. First, he finds, not perl. Secondly, it’s actually just putting .txt at the end, not quite what you wanted.

The first problem is only a problem if you really have to do this in perl. This probably means you are just learning perl, but that’s fine, because this is just the first step. The second problem is only a problem if you just want to get the job done and don’t care about the language. First, I will solve the second problem:

 find . -name '*.wm[va]' -a -type f | while read f; do mv $f ${f%.*}; done 

It just does its job, but actually distracts us from the perl solution. This is because if you do everything in the search, you can convert to perl with find2perl:

 find . -name '*.wm[va]' -a -type f -exec mv '{}' '{}.txt' \; 

The perl script file opens, which you can save:

 find2perl . -name '*.wm[va]' -a -type f -exec mv '{}' '{}.txt' \; > my.pl 

It includes a doexec () function, which can be modified to do what you want. At first it would be to change the second argument to the correct name (using File :: Basename basename function: basename ($ command [2], qw / .wmv.wma /)), the second would simply eliminate system calls, STDOUT munging, etc. , and just call the rename. But that, at least, gives you a start.

+1
source

I had to do something recently. This script requires modification, but has everything you need:

  • It recurses through files and directories (helper recursion).
  • It has a function to operate directories (processDir) and a separate one for actions on files (ProcessFile).
  • It handles spaces in file names using an alternate version of glob from the :: Glob file.
  • It does not take any action, but instead writes the output file (CSV, TAB or perl script) so that the user can review the proposed changes before making a big mistake.
  • It displays partial results periodically, which is useful if your system goes down.
  • It goes deep into the first order. This is important because if you have a script that changes (renames or moves) the parent directory before processing subdirectories and files, bad things can happen.
  • It reads from a skip list file, which avoids huge directories and mounted volumes that you don’t use want to visit.
  • It does not follow symbolic links, which often cause roundness.

A small modification to processFile is a big part of what you will need to do, as well as get rid of functions that you don't need. (This script was designed to search for files with characters in their names that are not supported on Windows.)

NOTE. In the end, it calls "open", which on the MAC will open the resulting file in its default application. On Windows, use "start". Other Unix systems have similar commands.

 #!/usr/bin/perl -w # 06/04/2009. PAC. Fixed bug in processDir. Was using $path instead of $dir when forming newpath. use strict; use File::Glob ':glob'; # This glob allows spaces in filenames. The default one does not. sub recurse(&$); sub processFile($); sub stem($); sub processXMLFile($); sub readFile($); sub writeFile($$); sub writeResults($); sub openFileInApplication($); if (scalar @ARGV < 4) { print <<HELP_TEXT; Purpose: Report on files and directories whose names violate policy by: o containing illegal characters o being too long o beginning or ending with certain characters Usage: perl EnforceFileNamePolicy.pl root-path skip-list format output-file root-path .... Recursively process all files and subdirectories starting with this directory. skip-list .... Name of file with directories to skip, one to a line. format ....... Output format: tab = tab delimited list of current and proposed file names csv = comma separated list of current and proposed file names perl = perl script to do the renaming output-file .. Name of file to hold results. Output: A script or delimited file that will rename the offending files and directories is printed to output-file. As directories are processed or problems found, diagnostic messages will be printed to STDOUT. Note: Symbolic links are not followed, otherwise infinite recursion would result. Note: Directories are processed in depth-first, case-insensitive alphabetical order. Note: If \$CHECKPOINT_FREQUENCY > 0, partial results will be written to intermediate files periodically. This is useful if you need to kill the process before it completes and do not want to lose all your work. HELP_TEXT exit; } ######################################################## # # # CONFIGURABLE OPTIONS # # # ######################################################## my $BAD_CHARACTERS_CLASS = "[/\\?<>:*|\"]"; my $BAD_SUFFIX_CLASS = "[. ]\$"; my $BAD_PREFIX_CLASS = "^[ ]"; my $REPLACEMENT_CHAR = "_"; my $MAX_PATH_LENGTH = 256; my $WARN_PATH_LENGTH = 250; my $LOG_PATH_DEPTH = 4; # How many directories down we go when logging the current directory being processed. my $CHECKPOINT_FREQUENCY = 20000; # After an integral multiple of this number of directories are processed, write a partial results file in case we later kill the process. ######################################################## # # # COMMAND LINE ARGUMENTS # # # ######################################################## my $rootDir = $ARGV[0]; my $skiplistFile = $ARGV[1]; my $outputFormat = $ARGV[2]; my $outputFile = $ARGV[3]; ######################################################## # # # BEGIN PROCESSING # # # ######################################################## my %pathChanges = (); # Old name to new name, woth path attached. my %reasons = (); my %skip = (); # Directories to skip, as read from the skip file. my $dirsProcessed = 0; # Load the skiplist my $skiplist = readFile($skiplistFile); foreach my $skipentry (split(/\n/, $skiplist)) { $skip{$skipentry} = 1; } # Find all improper path names under directory and store in %pathChanges. recurse(\&processFile, $rootDir); # Write the output file. writeResults(0); print "DONE!\n"; # Open results in an editor for review. #WARNING: If your default application for opening perl files is the perl exe itself, this will run the otput perl script! # Thus, you may want to comment this out. # Better yet: associate a text editor with the perl script. openFileInApplication($outputFile); exit; sub recurse(&$) { my($func, $path) = @_; if ($path eq '') { $path = "."; } ## append a trailing / if it not there $path .= '/' if($path !~ /\/$/); ## loop through the files contained in the directory for my $eachFile (sort { lc($a) cmp lc($b) } glob($path.'*')) { # If eachFile has a shorter name and is a prefix of $path, then stop recursing. We must have traversed "..". if (length($eachFile) > length($path) || substr($path, 0, length($eachFile)) ne $eachFile) { ## if the file is a directory my $skipFile = defined $skip{$eachFile}; if( -d $eachFile && ! -l $eachFile && ! $skipFile) { # Do not process symbolic links like directories! Otherwise, this will never complete - many circularities. my $depth = depthFromRoot($eachFile); if ($depth <= $LOG_PATH_DEPTH) { # Printing every directory as we process it slows the program and does not give the user an intelligible measure of progress. # So we only go so deep in printing directory names. print "Processing: $eachFile\n"; } ## pass the directory to the routine ( recursion ) recurse(\&$func, $eachFile); # Process the directory AFTER its children to force strict depth-first order. processDir($eachFile); } else { if ($skipFile) { print "Skipping: $eachFile\n"; } # Process file. &$func($eachFile); } } } } sub processDir($) { my ($path) = @_; my $newpath = $path; my $dir; my $file; if ($path eq "/") { return; } elsif ($path =~ m|^(.*/)([^/]+)$|) { ($dir, $file) = ($1, $2); } else { # This path has no slashes, hence must be the root directory. $file = $path; $dir = ''; } if ($file =~ /$BAD_CHARACTERS_CLASS/) { $file =~ s/($BAD_CHARACTERS_CLASS)/$REPLACEMENT_CHAR/g; $newpath = $dir . $file; rejectDir($path, $newpath, "Illegal character in directory."); } elsif ($file =~ /$BAD_SUFFIX_CLASS/) { $file =~ s/($BAD_SUFFIX_CLASS)/$REPLACEMENT_CHAR/g; $newpath = $dir . $file; rejectDir($path, $newpath, "Illegal character at end of directory."); } elsif ($file =~ /$BAD_PREFIX_CLASS/) { $file =~ s/($BAD_PREFIX_CLASS)/$REPLACEMENT_CHAR/g; $newpath = $dir . $file; rejectDir($path, $newpath, "Illegal character at start of directory."); } elsif (length($path) >= $MAX_PATH_LENGTH) { rejectDir($path, $newpath, "Directory name length > $MAX_PATH_LENGTH."); } elsif (length($path) >= $WARN_PATH_LENGTH) { rejectDir($path, $newpath, "Warning: Directory name length > $WARN_PATH_LENGTH."); } $dirsProcessed++; if ($CHECKPOINT_FREQUENCY > 0 && $dirsProcessed % $CHECKPOINT_FREQUENCY == 0) { writeResults(1); } } sub processFile($) { my ($path) = @_; my $newpath = $path; $path =~ m|^(.*/)([^/]+)$|; my ($dir, $file) = ($1, $2); if (! defined ($file) || $file eq '') { $file = $path; } if ($file =~ /$BAD_CHARACTERS_CLASS/) { $file =~ s/($BAD_CHARACTERS_CLASS)/$REPLACEMENT_CHAR/g; $newpath = $dir . $file; rejectFile($path, $newpath, "Illegal character in filename."); } elsif ($file =~ /$BAD_SUFFIX_CLASS/) { $file =~ s/($BAD_SUFFIX_CLASS)/$REPLACEMENT_CHAR/g; $newpath = $dir . $file; rejectFile($path, $newpath, "Illegal character at end of filename."); } elsif ($file =~ /$BAD_PREFIX_CLASS/) { $file =~ s/($BAD_PREFIX_CLASS)/$REPLACEMENT_CHAR/g; $newpath = $dir . $file; rejectFile($path, $newpath, "Illegal character at start of filename."); } elsif (length($path) >= $MAX_PATH_LENGTH) { rejectFile($path, $newpath, "File name length > $MAX_PATH_LENGTH."); } elsif (length($path) >= $WARN_PATH_LENGTH) { rejectFile($path, $newpath, "Warning: File name length > $WARN_PATH_LENGTH."); } } sub rejectDir($$$) { my ($oldName, $newName, $reason) = @_; $pathChanges{$oldName} = $newName; $reasons{$oldName} = $reason; print "Reason: $reason Dir: $oldName\n"; } sub rejectFile($$$) { my ($oldName, $newName, $reason) = @_; $pathChanges{$oldName} = $newName; $reasons{$oldName} = $reason; print "Reason: $reason File: $oldName\n"; } sub readFile($) { my ($filename) = @_; my $contents; if (-e $filename) { # This is magic: it opens and reads a file into a scalar in one line of code. # See http://www.perl.com/pub/a/2003/11/21/slurp.html $contents = do { local( @ARGV, $/ ) = $filename ; <> } ; } else { $contents = ''; } return $contents; } sub writeFile($$) { my( $file_name, $text ) = @_; open( my $fh, ">$file_name" ) || die "Can't create $file_name $!" ; print $fh $text ; } # writeResults() - Compose results in the appropriate format: perl script, tab delimited, or comma delimited, then write to output file. sub writeResults($) { my ($checkpoint) = @_; my $outputText = ''; my $outputFileToUse; my $checkpointMessage; if ($checkpoint) { $checkpointMessage = "$dirsProcessed directories processed so far."; } else { $checkpointMessage = "$dirsProcessed TOTAL directories processed."; } if ($outputFormat eq 'tab') { $outputText .= "Reason\tOld name\tNew name\n"; $outputText .= "$checkpointMessage\t\t\n"; } elsif ($outputFormat eq 'csv') { $outputText .= "Reason,Old name,New name\n"; $outputText .= "$checkpointMessage,,\n"; } elsif ($outputFormat eq 'perl') { $outputText = <<END_PERL; #/usr/bin/perl # $checkpointMessage # # Rename files and directories with bad names. # If the reason is that the filename is too long, you must hand edit this script and choose a suitable, shorter new name. END_PERL } foreach my $file (sort { my $shortLength = length($a) > length($b) ? length($b) : length($a); my $prefixA = substr($a, 0, $shortLength); my $prefixB = substr($b, 0, $shortLength); if ($prefixA eq $prefixB) { return $prefixA eq $a ? 1 : -1; # If one path is a prefix of the other, the longer path must sort first. We must process subdirectories before their parent directories. } else { return $a cmp $b; } } keys %pathChanges) { my $changedName = $pathChanges{$file}; my $reason = $reasons{$file}; if ($outputFormat eq 'tab') { $outputText .= "$reason\t$file\t$changedName\n"; } elsif ($outputFormat eq 'csv') { $outputText .= "$reason,$file,$changedName\n"; } else { # Escape the spaces so the mv command works. $file =~ s/ /\\ /g; $changedName =~ s/ /\\ /g; $outputText .= "#$reason\nrename \"$file\", \"$changedName\"\n"; } } $outputFileToUse = $outputFile; if ($checkpoint) { $outputFileToUse =~ s/(^.*)([.][^.]+$)/$1-$dirsProcessed$2/; } writeFile($outputFileToUse, $outputText); } # Compute how many directories deep the given path is below the root for this script. sub depthFromRoot($) { my ($dir) = @_; $dir =~ s/\Q$rootDir\E//; my $count = 1; for (my $i = 0; $i < length($dir); $i++) { if (substr($dir, $i, 1) eq "/") { $count ++; } } return $count; } #openFileInApplication($filename) - Open the file in its default application. # # TODO: Must be changed for WINDOWS. Use 'start' instead of 'open'??? sub openFileInApplication($) { my ($filename) = @_; `open $filename`; } 
0
source

Take a look at rename .

 find -type f -name '*.wm?' -print0 | xargs -0 rename 's/\.wm[av]$/.txt/' 

or

 find -type f -name '*.wm?' -exec rename 's/\.wm[av]$/.txt/' {} + 

Or create your own script

 #!/usr/bin/perl use strict; use warnings; use File::Find; find( sub { return unless -f; my $new = $_; return unless $new =~ s/\.wm[av]$/.txt/; rename $_ => $new or warn "rename '$_' => '$new' failed: $!\n"; }, @ARGV ); 
0
source
 # include the File::Find module, that can be used to traverse directories use File::Find; # starting in the current directory, tranverse the directory, calling # the subroutine "wanted" on each entry (see man File::Find) find(\&wanted, "."); sub wanted { if (-f and /.wm[av]$/) { # when this subroutine is called, $_ will contain the name of # the directory entry, and the script will have chdir()ed to # the containing directory. If we are looking at a file with # the wanted extension - then rename it (warning if it fails). my $new_name = $_; $new_name =~ s/\.wm[av]$/.txt/; rename($_, $new_name) or warn("rename($_, $new_name) failed - $!"); } } 
0
source

Source: https://habr.com/ru/post/1286809/


All Articles