En utilisant Perl, comment puis-je renommer les fichiers dans tous les sous-répertoires d'un lecteur?

Question

Comment puis-je renommer tous les fichiers sur un lecteur avec les extensions .wma et .wmv à l'extension .txt en utilisant Perl, quelle que soit leur profondeur dans la structure du répertoire?

Answer 1

Voir perldoc File::Find. Les exemples dans la documentation sont assez explicites et vous y conduiront le plus possible. Lorsque vous avez une tentative, mettez à jour la question avec plus d'informations.

Si c'est un exercice d'apprentissage, vous apprendrez mieux en essayant d'abord de faire vous-même.

MISE À JOUR:

En supposant que vous avez eu l'occasion de se pencher sur la façon de faire vous-même et en tenant compte du fait que diverses solutions ont été publiées, je signale que je l'aurais fait. Notez que je choisirais d'ignorer les fichiers tels que ".wmv": My regex nécessite quelque chose à venir avant le point.

#!/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__ 

Answer 2

Et si vous êtes un débutant, une pièce de plus utile conseil: pour renommer les fichiers, utiliser la méthode « move() » de « File :: Copy » Module (et toujours vérifier si mouvement() a échoué)

en outre, éviter un bug non évident de renommer accidentellement un répertoire dont le nom se termine par .wma/.wmv (depuis le « voulait » rappel est appelée sur les fichiers et répertoires)

PS Je suis définitivement d'accord avec File :: Find conseils ci-dessus (aussi, envisager de regarder dans File :: Find :: Rule, comme expliqué dans this link). Cependant, pour apprendre à Perl, écrire votre propre chercheur de fichiers récursif (ou mieux encore, passer de la boucle de recherche récursive à la première) est quelque chose que vous pourriez envisager si votre objectif est d'apprendre au lieu d'écrire simplement rapide unique.

Answer 3

J'ai dû faire quelque chose de similaire récemment. Ce script nécessiterait une modification, mais a tous les éléments essentiels:

1. Il récursif dans les fichiers et répertoires (sous recurse).
2. Il a une fonction pour agir sur répertoires (processDir) et un séparé pour agir sur les fichiers (processFile).
3. Il gère les espaces dans les noms de fichiers en utilisant une autre version de la fonction glob de File :: Glob.
4. Il effectue aucune action, mais au lieu écrit un fichier de sortie (CSV, TAB ou script perl) afin que l'utilisateur puisse examen les modifications proposées avant de faire une grosse erreur.
5. Il produit des résultats partiels périodiquement, ce qui est utile si votre système diminue en partie.
6. Il procède en profondeur de premier ordre. Ceci est important, car si vous avez un script qui modifie (renomme ou déplace) un répertoire parent avant de traiter les sous-répertoires et , des erreurs peuvent se produire.
7. Il lit à partir d'un fichier de liste de sélections, , ce qui vous permet d'éviter les répertoires volumineux et les volumes montés que vous ne souhaitez pas visiter .
8. Il ne suit pas les liens symboliques, qui provoquent souvent des circularités.

Une petite modification de processFile est la plupart de ce que vous auriez besoin de faire, en plus de vider les fonctionnalités dont vous n'avez pas besoin. (Ce script a été conçu pour rechercher des fichiers dont les noms ne sont pas pris en charge sous Windows.)

REMARQUE: À la fin, il appelle "open", ce qui ouvre le fichier résultant dans le MAC dans son application par défaut. Sous Windows, utilisez "démarrer". Sur les autres systèmes Unix, il existe des commandes similaires.

#!/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's 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`; 
} 

Answer 4

Regardez rename.

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

ou

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

Ou faire votre propre 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); 

Answer 5

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

Ok, il y a deux problèmes fondamentaux avec ce qui précède. Tout d'abord, c'est trouver, pas perl. Deuxièmement, il s'agit simplement de mettre le .txt à la fin, pas tout à fait ce que vous vouliez.

Le premier problème est seulement un problème si vous devez vraiment le faire en perl. Ce qui signifie probablement que vous êtes en train d'apprendre Perl, mais ce n'est pas grave, car ce n'est qu'un premier pas. La seconde est seulement un problème si vous voulez simplement faire le travail et ne se soucient pas de la langue. Je vais résoudre le deuxième problème premier:

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

qui obtient tout le travail, mais en réalité nous éloigne d'une solution de Perl. En effet, si vous avez tout fait à trouver, vous pouvez convertir en perl avec find2perl:

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

Cette imprimera un script perl, que vous pouvez enregistrer:

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

Il comprend un Fonction doexec() qui peut être modifiée pour faire ce que vous voulez. Le premier serait de changer le deuxième argument au bon nom (en utilisant la fonction basename de File::Basename: basename ($ command [2], qw/.wmv .wma /)), le second serait juste pour éliminer les appels au système, STDOUT munging, etc., et appelez simplement rename. Mais ceci au moins vous donne un début.

Answer 6

# 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 - $!"); 
    } 
} 

Answer 7

 
#!/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[av]$/; 
     rename $file, "$1.txt" or die $!; 
    }, $dir 
);