用Perl面对音乐问题
我的数字音乐库混乱不堪。分散在几个设备和几次与iTunes Match和iCloud的尝试中，我无法把所有东西放在一个地方——讽刺的是。不仅如此，苹果还用它认为更好的版本替换了一些文件。虽然我不愿意进行实验来证实这一点，但我确信新文件具有不同的元数据。我需要整理一下，才能从更好的系统开始。我认为这项任务会很艰巨，直到我找到了一个更简单的问题，几个Perl模块很快解决了。
我的第一步是找到我所有的音乐。在我让苹果用更好的版本替换它们之前，我已经备份了我的文件。但似乎我做了几个备份，每个备份都有我音乐的不同子集。一个备份会有大部分Led Zepplin但没有披头士乐队，而另一个则没有Zepplin但有披头士乐队的一部分。另一个备份有所有的披头士乐队但没有猫斯图尔特。
我开始收集我在找到音乐的所有目录中的所有唯一文件。这个程序有一些我最喜欢的Perl特性，特别是自从我在C阶段移动文件时留下了一些伤口之后。
use v5.10;
use strict;
use warnings;
use Digest::MD5 qw(md5_hex);
use File::Copy qw(copy);
use File::Find;
use File::Map qw(map_file);
use File::Path qw(make_path);
use File::Spec::Functions qw(catfile);
my $wanted = sub {
state $Seen = {};
my $full_name = $File::Find::name;
return if -d $full_name;
map_file my $map, $full_name, '+<';
my $digest_hex = md5_hex( $map );
return if $Seen->{ $digest_hex }++;
my( $extension ) = $full_name =~ /(\.[^.]+)\z/;
my( $n, $m, $o, $p ) = $digest_hex =~ /\A (..) (..) (..) (..)/x;
my $basename = $_;
my $dir = catfile( $new_dir, $n, $m, $o, $p );
my $new_file = catfile( $dir, $basename );
return if -e $new_file;
make_path( $dir ) unless -d $dir;
copy(
$full_name,
catfile( $dir, $basename )
);
};
find( $wanted, @ARGV );File::Find 提供了遍历文件结构的代码。我给find提供起始目录的列表，在本例中是@ARGV，以及一个回调子程序的引用。我程序的精华就在那个$wanted子程序中。这段代码中最难的部分是记住$File::Find::name是完整路径，而$_只是文件名。我把它们放入变量中来提醒自己哪个是哪个。
File::Map 允许我直接从磁盘作为内存映射来访问文件的数据，而不是将其读入内存。我不需要更改文件来获取其摘要（使用Digest::MD5），因此对于成千上万的音乐文件来说，内存映射是一个巨大的胜利。如果我已经看到了那个摘要，我就继续下一个文件。否则，我进行一些字符串操作来创建新的文件路径，使用跨平台的File::Spec 来拼接这些碎片。我用File::Copy 将文件复制到新位置。我特意进行复制，这样我现在就留下了原始文件。我预计至少会出错几次。新路径有四个层级，每个层级都是基于文件摘要的下两个字符。这样，没有目录会变得太大，从而减慢所有目录操作的速度。
一些粗略的计算显示，没有一个音乐库的完成度超过85%。从这里开始，真正的乐趣开始了，但也是我尴尬的悲伤故事。在新的复制文件中，我需要选择我想保留的文件。
首先，我只是清理了我的iTunes库，重新导入了一切，看看我在处理什么。我大部分音乐都有重复，有些甚至有三份。iTunes Match已将MP3文件升级到M4A（使用苹果的AAC编解码器编码）和M4P文件，后者是我购买的带DRM的音乐版本。每个版本都有一个不同的摘要，因此相同内容的几个版本都幸存了下来。
我在解决问题的下一部分时遇到了困难，因为我有太多的计算机处理能力。我可以收集每个文件的元数据并将其存储在数据库中。我可以将它扔进一个NoSQL的东西。我还考虑过Redis。这些技术中的任何一项都是一种有趣的变化，但它们需要太多的工作。我开始并放弃了几个方法，包括尝试使用AppleScript直接与iTunes交互的短暂尝试。哦，疯狂。
每次从已处理目录开始都是一个糟糕的决定。我必须收集元数据然后按专辑或艺术家分组文件。iTunes已经为我做了这件事，尽管我一周后才意识到这一点。当我导入音乐时，它将文件复制到以艺术家和专辑命名的文件夹中（我本可以用这种方式而不是使用摘要）。我的大部分工作将仅限于单个目录中的文件。我不需要一种数据结构来保存所有这些。我当然不需要数据库。
如果我能进入一个目录，检查该目录中的每个文件，然后在退出该目录时处理它们，删除重复文件就变得容易多了。我记得File::Find有一个post_process选项，允许我这样做，尽管我多年没用了。
use File::Find qw(find);
find(
{
wanted => $wanted, #code refs
postprocess => $post,
},
@ARGV,
);当我进入每个目录时，我可以收集每个文件的信息。每个文件已经按艺术家和专辑排序，但我仍然需要选择保留哪个重复文件。经过一番思考，解决方案变得很简单。我可以按文件扩展名排序，查找散列中的排序。当我有两个具有相同扩展名的文件时，我将选择比特率更高的文件。当比特率匹配时，我将选择文件名最短的文件。在各个音乐库中，我有一些像Susie Q.m4a和Susie Q 1.m4a这样的文件；实质上相同的文件，只是有一些微小的元数据差异。我使用Music::Tag来获取元数据，因为它自动将插件委托给各种文件格式。
排序后，我将除了列表中的第一个元素之外的所有项目标记为删除。我不会立即删除它们；我将列表打印到文件中，稍后可以使用它来删除文件。我太老，不会立即删除文件。
#!/Users/brian/bin/perls/perl5.18.1
use v5.18;
use Digest::MD5 qw( md5_hex );
use Data::Dumper;
use File::Basename qw( basename );
use File::Find;
use File::Map qw( map_file );
use File::Copy qw( copy );
use File::Path qw( make_path );
use File::Spec::Functions qw(abs2rel rel2abs splitdir);
use Music::Tag;
my $extensions_order = {
m4a => -2,
mp3 => -1,
m4p => 0,
};
open my $fh, '>', 'delete_files.txt';
my $hash = {};
my( $wanted, $post ) = make_subs( $dir, $hash );
find(
{
wanted => $wanted,
postprocess => $post,
},
@ARGV,
);
sub make_subs {
my( $dir, $hash ) = @_;
sub { # wanted
# my $path = $File::Find::name;
# my $filename = $_;
state $count = 0;
return if( -d $File::Find::name or -l $File::Find::name );
return if $_ eq '.DS_Store';
my $filename = basename( $File::Find::name );
my $relative = abs2rel( $File::Find::name, $dir );
my $basename_no_ext = $filename =~ s/\.[^.]+\z//r;
my( $extension ) = $filename =~ m/ \. ( [^.]+ ) \z /x;
return unless exists $extensions_order->{$extension};
my $this_file = {};
my $info = eval { Music::Tag->new( $filename )->get_tag };
my $title = eval{ $info->title };
if( $@ ) {
warn "Title had a problem: $@";
}
$this_file->{tag} = {
title => $title,
bitrate => eval{ $info->bitrate },
};
$this_file->{file} = {
extension => $extension,
basename => $filename,
relative => $relative,
no_ext => $basename_no_ext,
'File::Find::name' => $File::Find::name,
'_' => $_,
};
push @{ $hash->{$File::Find::dir}{$title} }, $this_file;
$hash->{extensions}{$extension}++;
},
sub { # postprocess
my $this = $hash->{$File::Find::dir};
TITLE: foreach my $title ( sort keys %$this ) {
my $songs = $this->{ $title };
next if @$songs == 1; # no duplicates, no problem
my @sorted = sort {
state $e = $extensions_order;
$e->{ $a->{file}{extension} } <=> $e->{ $b->{file}{extension} }
or
length $a->{file}{basename} <=> length $b->{file}{basename}
or
$b->{tag}{bitrate} <=> $a->{tag}{bitrate}
} @$songs;
# everything without the chosen key will be deleted
$sorted[0]{chosen}++;
SONG: foreach my $song ( @sorted ) {
$hash->{seen}++;
next unless exists $extensions_order->{
$song->{file}{extension} };
$hash->{examined}++;
next if $song->{chosen};
# ignore other files, such as videos and e-books
next unless exists $extensions_order->{
$song->{file}{extension} };
$hash->{deleted}++;
print { $fh } "delete:\t$song->{file}{relative}\n";
}
}
delete $hash->{$File::Find::dir};
}
}就是这样。这留下了一些问题，比如损坏的元数据，但无论如何我也无法通过编程解决它。获得一个没有重复文件的完整文件集解决了大部分问题，并让我享受到翻阅我们这些灰白头发的物理专辑的乐趣。
这篇文章最初发表在PerlTricks.com上。
标签
brian d foy
brian d foy是一位Perl培训师和作家，也是Perl.com的高级编辑。他是Mastering Perl、Mojolicious Web Clients、Learning Perl Exercises的作者，以及Programming Perl、Learning Perl、Intermediate Perl和Effective Perl Programming的合著者。
浏览他们的文章
反馈
这篇文章有什么问题吗？通过在GitHub上打开一个issue或pull request来帮助我们。
