如何根据文件名将文件分类到目录？

Question

我有大量的文件来排序所有命名在一些可怕的约定。
下面是一些例子：。。。

（4）_mr__mcloughlin ____ TXT
12__sir_john_farr ____ TXT
（b）中mr__chope ____ TXT
dame_elaine_kellett-鲍曼____ TXT
dr__blackburn ______ TXT

这些名称都应该成为不同的人（发言者）。另一个IT部门的人员使用一些脚本从大量XML文件中产生了这些文件，但是您可以看到命名非常愚蠢。

我需要从字面上对数万个这些文件进行排序，每个人都有多个文本文件;每个都有一些愚蠢的东西让文件名不同，不管它是更多的下划线还是一些随机数。他们需要由演讲者排序。

用脚本来完成大部分工作会更容易，然后我可以返回并合并应该使用相同名称或其他名称的文件夹。

我在想这样做有很多方法。

• 解析每个文件的名称并将它们分类到每个唯一名称的文件夹中。
• 从文件名中获得所有唯一名称的列表，然后查看这个简化的类似名称的唯一名称列表，并询问它们是否相同，并且一旦确定它将相应地对它们进行排序。

我打算使用Perl，但我可以尝试一种新的语言，如果它是值得的。我不知道如何去读取一个目录中的每个文件名中的每个文件名，并将其解析为一个字符串以解析为实际名称。我不完全知道如何用Perl中的正则表达式解析，但这可能是可以谷歌的。

对于分选，我只是要使用的shell命令：

`cp filename.txt /example/destination/filename.txt` 

，但只是导致这就是我知道，它是最容易。

我甚至没有一个伪代码想法即将做什么即使如此，如果有人知道最好的动作序列，即时通讯所有的耳朵。我想我正在寻找很多帮助，我愿意接受任何建议。许多人非常感谢任何能够帮助的人。

B.

Answer 1

我希望我明白你的问题的权利，这是一个有点暧昧恕我直言。这段代码没有经过测试，但应该做我认为你想要的。

use File::Copy; 

sub sanatize { 
    local $_ = shift; 
    s/\b(?:dame|dr|mr|sir)\b|\d+|\(\w+\)|.txt$//g; 
    s/[ _]+/ /g; 
    s/^ | $//g; 
    return lc $_; 
} 

sub sort_files_to_dirs { 
    my @files = @_; 
    for my $filename (@files) { 
     my $dirname = sanatize($filename); 
     mkdir $dirname if not -e $dirname; 
     copy($filename, "$dirname/$filename"); 
    } 
} 

Answer 2

我在一段时间没有使用过Perl，所以我打算在Ruby中编写它。我会评论它来建立一些伪代码。

DESTINATION = '/some/faraway/place/must/exist/and/ideally/be/empty' 

# get a list of all .txt files in current directory 
Dir["*.txt"].each do |filename| 
    # strategy: 
    # - chop off the extension 
    # - switch to all lowercase 
    # - get rid of everything but spaces, dashes, letters, underscores 
    # - then swap any run of spaces, dashes, and underscores for a single space 
    # - then strip whitespace off front and back 
    name = File.basename(filename).downcase. 
     gsub(/[^a-z_\s-]+/, '').gsub(/[_\s-]+/, ' ').strip 
    target_folder = DESTINATION + '/' + name 

    # make sure we dont overwrite a file 
    if File.exists?(target_folder) && !File.directory?(target_folder) 
    raise "Destination folder is a file" 
    # if directory doesnt exist then create it 
    elsif !File.exists?(target_folder) 
    Dir.mkdir(target_folder) 
    end 
    # now copy the file 
    File.copy(filename, target_folder) 
end 

这就是想法，无论如何 - 我已经确保所有的API调用都是正确的，但这不是测试代码。这看起来像你想要完成的？这可以帮助你在Perl中编写代码吗？

Answer 3

您可以使用诸如

@tokens = split /_+/, $filename 

东西@tokens最后一项应该是".txt"所有这些文件名的拆分文件名，但第二个到最后应该是同一个人的名字也有类似的被拼写错误（或“琼斯博士”改为“布赖恩琼斯”）。您可能需要使用某种edit distance作为相似性度量，以比较@tokens[-2]的各种文件名;当两个条目具有相似的姓氏时，他们应该提示您作为合并的候选人。

Answer 4

目前所有文件都在同一目录下吗？如果是这种情况，那么你可以使用'opendir'和'readdir'逐个读取所有文件。使用文件名作为关键字（删除所有“_”以及括号内的任何信息）建立一个哈希值，让你得到这样的事情 -

(4)_mr__mcloughlin____.txt -> 'mr mcloughlin' 
12__sir_john_farr____.txt -> 'sir john farr' 
(b)mr__chope____.txt -> 'mr chope' 
dame_elaine_kellett-bowman____.txt -> 'dame elaine kellett-bowman' 
dr__blackburn______.txt -> 'dr blackburn' 

集的哈希值是多少到目前为止发生的名称实例。因此，这些条目后，你应该有一个哈希看起来像这样 -

'mr mcloughlin' => 1 
'sir john farr' => 1 
'mr chope' => 1 
'dame elaine kellett-bowman' => 1 
'dr blackburn' => 1 

每当你在哈希遇到一个新条目简单地创建使用该密钥名称的新目录。现在，您所要做的就是将具有更改名称的文件（将相应的散列值作为后缀）复制到新目录中。因此，对于例如，你是在另一个入口读取为“先生的女友科琳”绊倒，那么你可以将它复制为

./mr mcloughlin/mr mcloughlin_2.txt 

Answer 5

我想：

1. 定义什么名字的显著：

   • 比dr_blackburndr__blackburn不同？
   • 是dr__blackburn不同于mr__blackburn？
   • 是主要数字有意义吗？
   • 是领先/尾随下划线有意义吗？
   • 等

2. 拿出的规则和算法的名称转换为一个目录（莱昂的是一个很好的开始）

3. 阅读的名称和处理它们一次一个

   • 我会使用opendir和递归的组合
   • 我会复制它们，当你处理它们;再次莱昂的职位是一个很好的例子

4. 如果该脚本将需要保持并在未来使用的，我会defintely创建测试（例如使用http://search.cpan.org/dist/Test-More/）每个正则表达式路径;当你发现一个新的皱纹，增加一个新的测试并确保它失败，然后修复正则表达式，然后重新运行测试，以确保没有爆发

Answer 6

当你问一个很一般问题只要我们有更好的规则编纂，任何语言都可以做到这一点。我们甚至没有细节，只有一个“样本”。

因此，盲人工作时，看起来需要人工监控。所以这个想法是筛。一些你可以重复运行并检查并再次运行并一次又一次检查，直到你把所有东西都分类为几个小的手动任务。

下面的代码使大量假设的，因为你很可能就由我们来处理它。其中之一是样本是所有可能姓氏的清单;如果还有其他姓氏，请添加'em并再次运行。

use strict; 
use warnings; 
use File::Copy; 
use File::Find::Rule; 
use File::Spec; 
use Readonly; 

Readonly my $SOURCE_ROOT => '/mess/they/left'; 
Readonly my $DEST_DIRECTORY => '/where/i/want/all/this'; 

my @lname_list = qw<mcloughlin farr chope kelette-bowman blackburn>; 
my $lname_regex 
    = join('|' 
      , sort { ($b =~ /\P{Alpha}/) <=> ($a =~ /\P{Alpha}/) 
       || (length $b) <=> (length $a) 
       || $a cmp $b 
       } @lname_list 
     ) 
    ; 
my %dest_dir_for; 

sub get_dest_directory { 
    my $case = shift; 
    my $dest_dir = $dest_dir_for{$case}; 
    return $dest_dir if $dest_dir; 

    $dest_dir = $dest_dir_for{$case} 
     = File::Spec->catfile($DEST_DIRECTORY, $case) 
     ; 
    unless (-e $dest_dir) { 
     mkdir $dest_dir; 
    } 
    return $dest_dir; 
} 

foreach my $file_path ( 
    File::Find::Rule->file 
     ->name('*.txt')->in($SOURCE_ROOT) 
) { 
    my $file_name = [ File::Spec->splitpath($file_path) ]->[2]; 
    $file_name =~ s/[^\p{Alpha}.-]+/_/g; 
    $file_name =~ s/^_//; 
    $file_name =~ s/_[.]/./; 

    my ($case) = $file_name =~ m/(^|_)($lname_regex)[._]/i; 

    next unless $case; 
    # as we next-ed, we're dealing with only the cases we want here. 

    move($file_path 
     , File::Spec->catfile(get_dest_directory(lc $case) 
          , $file_name 
          ) 
     ); 
}