perl与mp3
我使用从 FreeDB 搜索中返回的数据来生成带有适当元素的匿名散列。虽然 WebService::FreeDB 字段和 ID3v2 标签元素之间的映射是试验性的,但它工作得很好。
清单 8. make_tag_from_freedb() 函数
# {{{ make_tag_from_freedb: make the ID3 tag info from a FreeDB entry
sub make_tag_from_freedb
{
my $disc = shift @_;
my $track = shift @_;
# argument checking
return undef unless $track =~ m/^\d+$/;
# note that the user inputs track "1" but WebService::FreeDB gives us that
# track at position 0, so we decrement $track
$track--;
return undef unless exists $disc->{trackinfo};
return undef unless exists $disc->{trackinfo}->[$track];
my $track_data = $disc->{trackinfo}->[$track];
return {
TIT1 => $disc->{genre},
TIT2 => $track_data->[0],
TRCK => $track+1,
TPE1 => $disc->{artist},
TALB => $disc->{cdname},
TYER => $disc->{year},
WXXX => $disc->{url},
COMM => $disc->{rest}||'',
};
}
# }}}
|
大规模加注标签、大规模重命名、剥离注释和猜测曲目数量
autotag.pl 的主要功能是识别 MP3 文件。但在这个过程中,往往需要对很多组文件进行小的调整。输入 Four Autotagging Horsemen。
剥离注释是非常简单的过程。我使用 get_tag() 获得散列标签,清空 COMM 和 WXXX 字段,以及使用 set_tag() 将该标签写回。实际上,注释剥离可能已经通过大规模标签加注完成了,但这个函数使用得非常频繁,以至于使我感到有必要为它设置一个独立的选项。
猜测曲目数量也使相当简单的。获取散列标签,在该文件和散列标签上使用 guess_track_number() 函数,请求确认,然后将该标签写回到文件中。
在一系列文件上对多个键(例如 TALB)进行大规模标签加注操作。例如:
autotag.pl -mt "TALB=Best" *.mp3
于是,所有具有 mp3 扩展名的文件都在其 ID3v2 标签中指定了 TALB 值。当您拥有某个艺术家的全部乐曲的目录时,以及希望用该艺术家的名字标记所有这些乐曲时,采用大规模标签加注的方式是非常合适的。只有受支持的标签元素才可以大规模加注标签。再一次进行这样的过程:获取散列标签、进行修改,然后将它写回。这样做目的是使它的维护简单便利。
清单 9. 大规模加注标签、注释剥离和猜测曲目数量
# {{{ handle the one-shot options
if ($config->GUESS_TRACK_NUMBERS_ONLY() ||
$config->STRIP_COMMENT_ONLY() ||
scalar keys %{$config->MASS_TAG_ONLY()})
{
foreach my $file (@ARGV)
{
my $tag = get_tag($file, 1);
unless (defined $tag)
{
warn "No ID3 TAG info in '$file', skipping";
next;
}
next if $config->DRYRUN();
# delegate stripping comments to the mass tagging function
if ($config->STRIP_COMMENT_ONLY())
{
$config->MASS_TAG_ONLY()->{COMM} = '';
$config->MASS_TAG_ONLY()->{WXXX} = '';
}
if (scalar keys %{$config->MASS_TAG_ONLY()})
{
foreach (keys %{$config->MASS_TAG_ONLY()})
{
unless (exists $supported_frames{$_})
{
warn "Unsupported tag element $_ requested for mass tagging, skipping";
next;
}
$tag->{$_} = $config->MASS_TAG_ONLY()->{$_};
}
set_tag($file, $tag);
}
else
{
my $track_number_guess = guess_track_number($file, $tag);
next if $config->DRYRUN();
if (defined $track_number_guess &&
read_yes_no("Is track number $track_number_guess OK for '$file'?", 1))
{
$tag->{TRCK} = $track_number_guess;
set_tag ($file, $tag);
}
else
{
warn "Could not guess a track number for file $file, sorry";
}
}
}
exit 0;
}
# }}}
|
噢,该介绍大规模重命名选项了。我之所以将这个问题留在最后,是因为这个问题最复杂。对于每个重命名参数而言,我将标签值中的每个“%”都表示为“{{{%}}}”,因为不这样的话,当后面跟随一个特殊的重命名参数时,“%”字符就可能被曲解。例如,用“100%true”作为曲目名,我们来看一看它如何变成“100%TRACKNAMErue”的,这里 TRACKNAME 是我从该散列标签中获取的曲目名。
大规模重命名也可消除不良的字符,代之以某些带有“_”的字符,以确保文件名合理。最后,除非通过命令行给出 -c(accept_all)选项,否则 autotag.pl 将询问是否可以对文件重命名。
清单 10. 大规模重命名
# {{{ handle the -rename_only option
if ($config->RENAME_ONLY())
{
foreach my $file (@ARGV)
{
my $tag = get_tag($file, 1);
# the extra parameter will ask us about upgrading V1 to V2
unless (defined $tag)
{
warn "No ID3 TAG info in '$file', skipping";
next;
}
my %map = (
'%c' => 'COMM',
'%s' => 'TIT2',
'%a' => 'TPE1',
'%t' => 'TALB',
'%n' => 'TRCK',
);
my $name = $config->RENAME_FORMAT();
foreach my $key (keys %map)
{
my $tagkey = $map{$key};
my $replacement = '';
if (exists $tag->{$tagkey})
{
$replacement = substr $tag->{$tagkey}, 0, $config->RENAME_MAX_CHARS();
# limit to N characters
if ($tagkey eq 'TRCK' && $replacement =~ m/^\d$/)
{
$replacement = "0$replacement";
}
}
$replacement =~ s/%/{{{%}}}/g;
# this is how we preserve %a in the fields, for example
$name =~ s/$key/$replacement/;
}
$name =~ s/{{{%}}}/%/g; # turn the {{{%}}} back into % in the fields
print "The name after % expansion is $name\n" if $config->DEBUG();
foreach my $char (map { quotemeta } @{$config->RENAME_BADCHARS()})
{
$name =~ s/$char//g;
}
print "The name after character removals is $name\n" if $config->DEBUG();
my $newchar = quotemeta $config->RENAME_REPLACEMENT();
foreach my $char (map { quotemeta } @{$config->RENAME_REPLACECHARS()})
{
$name =~ s/$char/$newchar/eg;
}
print "The name after character replacements is $name\n" if $config->DEBUG();
if ($name eq $file)
{
# do nothing
print "Renaming $file is unnecessary, it already answers to our high standards\n"
if $config->DEBUG();
}
elsif (-e $name)
{
warn "Could not use name $name, it's already taken by an existing
file or directory $file";
}
elsif ($config->ACCEPT_ALL() || read_yes_no("Is name $name OK for '$file'?", 1))
{
next if $config->DRYRUN();
print "Renaming $file -> $name\n";
rename($file, $name);
}
else
{
# do nothing
}
}
exit 0;
}
# }}}
|
Tags:perl,mp

