使用Perl,如何重命名驱动器的所有子目录中的文件?

时间:2009-06-26 11:59:10

标签: perl recursion rename

如何使用Perl将扩展名为.wma和.wmv扩展名的驱动器上的所有文件重命名为.txt扩展名,无论它们在目录结构中有多深?

7 个答案:

答案 0 :(得分:10)

perldoc File::Find。文档中的示例非常明确,可以帮助您完成大部分工作。尝试时,请使用更多信息更新问题。

如果这是一项学习练习,首先要尝试自己学习,你会学得更好。

<强>更新

假设您有机会自己研究如何做到这一点,并考虑到已发布各种解决方案的事实,我发布了我将如何做到这一点。请注意,我会选择忽略诸如“.wmv”之类的文件:我的正则表达式需要点之前的内容。

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

答案 1 :(得分:3)

#!/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
);

答案 2 :(得分:2)

如果你是新手,还有一条更有用的建议: 要重命名文件,请使用“File :: Copy”模块中的“move()”方法 (并始终检查move()是否失败)

另外,避免一个不明显的错误,即意外重命名名称以.wma / .wmv结尾的目录(因为在两个文件和目录上都调用了“想要的”回调)

P.S。我肯定同意上面的File :: Find建议(另外,请考虑查看File :: Find :: Rule,如this link中所述)。 但是,作为学习Perl的练习,编写自己的递归文件查找器(或者更好,将其从递归转换为广度优先搜索循环)是你可以考虑做的事情,如果你的目标是学习而不是快速写一次性的。

答案 3 :(得分:1)

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

好的,上面有两个基本问题。首先,它找到了,而不是perl。其次,它实际上只是将.txt放在最后,而不是你想要的。

如果你真的必须在perl中执行此操作,第一个问题只是一个问题。这可能意味着你只是在学习perl,但这没关系,因为这只是第一步。如果您只是想完成工作并且不关心语言,那么第二个问题就是问题。我先解决第二个问题:

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

这只是完成了工作,但实际上让我们远离了perl解决方案。那是因为,如果你在find中完成所有操作,你可以使用find2perl转换为perl:

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

这将打印出一个perl脚本,您可以保存:

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

它包含一个doexec()函数,可以对其进行修改以执行您想要的操作。首先是将第二个参数更改为正确的名称(使用File::Basename的基本名称函数:basename($ command [2],qw / .wmv .wma /)),第二个参数只是为了消除调用系统,STDOUT munging等,只需调用重命名。但这至少可以给你一个开始。

答案 4 :(得分:0)

我最近不得不做类似的事情。这个脚本需要修改,但有所有必需品:

  1. 它通过文件和 目录(sub recurse)。
  2. 它有作用的功能 目录(processDir)和a 分开一个来处理文件 (processFile)。
  3. 它处理文件名中的空格 使用替代版本的 来自File :: Glob的glob函数。
  4. 它不执行任何操作,而是执行操作 写入输出文件(CSV,TAB或 perl脚本)以便用户可以 在犯大错之前审核提议的更改。
  5. 输出部分结果 定期,这是有用的,如果 你的系统部分失效。
  6. 深入第一顺序。 这很重要,因为如果你 有一个修改的脚本(重命名 或移动)之前的父目录 处理子目录和 文件,坏事都可能发生。
  7. 从跳过列表文件中读取, 这可以让你避免庞大的目录     并且您没有安装卷     想去参观。
  8. 它不遵循符号链接, 这常常导致循环。
  9. 对processFile的一个小修改是您需要做的大部分工作,并且还会删除您不需要的功能。 (此脚本旨在查找Windows上不支持其名称中包含字符的文件。)

    注意:最后它调用“open”,在MAC上将打开生成的文件在其默认应用程序中。在Windows上,使用“开始”。在其他Unix系统上,有类似的命令。

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

答案 5 :(得分:0)

请看rename

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

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

或制作自己的剧本

#!/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 );

答案 6 :(得分:0)

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