如何根據文件名將文件分類到目錄？

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 
          ) 
     ); 
}