目次


洗練されたPerl: MP3とPerlで遊ぶ、第1回

PerlでMP3タグを操作・推測する

Comments

コンピュータ好きの音楽ファンにはMP3ファイルの操作は必須です。他にもフォーマットはあり、それぞれ十分育っていますが、この記事ではどう見ても一番人気がある、MP3フォーマットに集中することにします。ところがここでご紹介する一般的な取り組み方が、タグを許す他の音楽ファイル・フォーマットにも同じように適用できるのです。実際、タグを使う多くのファイル・フォーマットが私のアプリケーションであるautotag.plで恩恵を受けるのです。皆さんからの助言を歓迎します。

この記事で説明するのはPerlの一般的な問題についてですが、特にMP3ファイルの操作に関連した部分について、また具体的なautotag.plアプリケーションについても説明します。

モジュールとしてはMP3::InfoMP3::ID3LibMusicBrainz::ClientそれにAudioFile::Identify::MusicBrainzなどがあり、それぞれ使いやすいかも知れないのですが、私はMP3::TagWebService::FreeDBCPANモジュールのみを使いました。MP3::ID3Libを使わなかった主な理由は、id3libソフトウェアが要求されるためです(参考文献)。MP3::Infoは純然たるPerlで簡単にインストールできますが、私はMP3::Tagの方がより強力なことに気がついたのです。MusicBrainz::ClientAudioFile::Identify::MusicBrainzは使いませんでした。これは発売されたCDのデータベースとして、MusicBrainzはFreeDBよりも分かりにくいように見えるためです。最終的にID3タグ付けモジュールとトラック情報モジュールにどれを選ぶかは読者の選択次第です。いろいろ試したり失敗したりという経験から私が学んだのは、MP3::TagWebService::FreeDBが一番良いだろうということです。

私はCDDB(Gracenote)ディスク・データベースは(非常に分かりやすいのですが)使わないことにしました。GracenoteはCDの曲目リストを独自のデータベースで保存している会社です。このデータベースは検索ができるだけで、販売用にダウンロードすることはできません。このデータベースのかなりの部分は、GracenoteがまだCDDBであった初期の頃にボランティアの貢献によって蓄積されたものです。FreeCDの方は無料で制限のないCD曲目リストのデータベースを提供するために、ボランティアの努力によって整備されたものです。FreeDBデータベースの全内容は著作権制限無しにダウンロードすることができるので、お望みであれば自分独自のFreeDBサーバーを立ち上げることもできます。

私が使わなかったモジュールは必ずしも質が劣るわけではないので、好みで使うことも当然できます。先に書いた通り、私は単に自分の個人的な経験からMP3::TagWebService::FreeDBを好んでいるだけです。タグの実際の読み書きは機能の中に抽象化されているので、MP3タグの読み書きに別のモジュールを使うのであれば、それほど変更の必要はありません。

もう一つ、私にはLinuxのxtermとEtermターミナル・エミュレーター内部にあるデフォルトのモジュールTerm::ReadLine::Perlよりも、Term::ReadLine::GnuCPANモジュールの方がうまく行く事も言っておくべきでしょう。テキストを入力するべきプロンプトでおかしな振る舞いに気が付いたら、Term::ReadLineの上にそのデフォルト・モジュールをインストールします。

基本的なautotag.pl機能

autotag.plの中には私が別機能として追加した、いくつかの機能があります。第1にcontains_word_char()はあるテキストに単語(Perlの\w)が含まれているか判断します。この機能は未定義の値にも正しく動作しますが、警告をオンにしておくと未定義の値に一致する通常表現は警告を出力します。この機能は警告を見せることはないので、基本的に有用です。この機能無しで同じことをしようとすると、毎回文字列が定義されているかどうかチェックしなければなりません。

リスト1. contains_word_char()機能
# {{{ contains_word_char: return 1 if the text contains a word character
sub contains_word_char
{
 my $text = shift @_;
 return $text & length $text & $text =~ m/\w/;
}
# }}}

次は入力ルーチン群です。これらはきわめて冗長で、(プログラムが必要とする)ユーザーとの相互動作の大部分を処理します。

リスト2. get_tag()機能
# {{{ get_tag: get a ID3 V2 tag, using V1 if necessary
sub get_tag
{
 my $file    = shift @_;
 my $upgrade = shift @_;
 my $mp3 = MP3::Tag->new($file);
 return undef unless defined $mp3;
 $mp3->get_tags();
 my $tag = {};
 if (exists $mp3->{ID3v2})
 {
  my $id3v2 = $mp3->{ID3v2};
  my $frames = $id3v2->supported_frames();
  while (my ($fname, $longname) = each %$frames)
  {
   # only grab the frames we know
   next unless exists $supported_frames{$fname};
   $tag->{$fname} = $id3v2->get_frame($fname);
   delete $tag->{$fname} unless defined $tag->{$fname};
   $tag->{$fname} = $tag->{$fname}->{Text} if $fname eq 'COMM';
   $tag->{$fname} = $tag->{$fname}->{URL} if $fname eq 'WXXX';
   $tag->{$fname} = '' unless defined $tag->{$fname};
  }
 }
 elsif (exists $mp3->{ID3v1})
 {
  warn "No ID3 v2 TAG info in $file, using the v1 tag";
  my $id3v1 = $mp3->{ID3v1};
  $tag->{COMM} = $id3v1->comment();
  $tag->{TIT2} = $id3v1->song();
  $tag->{TPE1} = $id3v1->artist();
  $tag->{TALB} = $id3v1->album();
  $tag->{TYER} = $id3v1->year();
  $tag->{TRCK} = $id3v1->track();
  $tag->{TIT1} = $id3v1->genre();
  if ($upgrade & read_yes_no("Upgrade ID3v1 tag to ID3v2 for $file?", 1))
  {
   set_tag($file, $tag);
  }
 }
 else
 {
  warn "No ID3 TAG info in $file, creating it";
  $tag = {
      TIT2 => '',
      TPE1 => '',
      TALB => '',
      TYER => 9999,
      COMM => '',
      };
 }
 print "Got tag ", Dumper $tag
  if $config->DEBUG();
 return $tag;
}
# }}}

ちょっと変わった機能はread_yes_no()ですが、これはデフォルト・パラメーターとしてYまたは1を与えるとデフォルトを真(true)とし、他のパラメーターを与えるとデフォルトを偽(false)とします。ですからユーザーがEnterか空白(Space)を渡した場合に、異なるデフォルト値を受け付けるようにread_yes_no()を設定できるのです。さらに、バックスペースまたは削除(delete)キーはデフォルトを反転させます。華やかではありませんが、非常に使い道があります。

autotag.plの前書き

autotag.plアプリケーションはちょっとした初期化ルーチンで始まります。

リスト3. 初期化
use constant SEARCH_ALL   => 'all';
my %freedb_searches = (
   artist  => { keywords => [], abbrev => 'I', tagequiv => 'TPE1' },
   title   => { keywords => [], abbrev => 'T', tagequiv => 'TALB' },
   track   => { keywords => [], abbrev => 'K', tagequiv => 'TIT2' },
   rest    => { keywords => [], abbrev => 'R', tagequiv => 'COMM' },
      );
# maps ID3 v2 tag info to WebService::FreeDB info
my %info2freedb = (
   TALB  => 'cdname',
   TPE1  => 'artist',
      );
my %supported_frames = (
   TIT1 => 1,
   TIT2 => 1,
   TRCK => 1,
   TALB => 1,
   TPE1 => 1,
   COMM => 1,
   WXXX => 1,
   TYER => 1,
      );
my @supported_frames = keys %supported_frames;
my $term = new Term::ReadLine 'Input> '; # global input

SEARCH_ALL定数は、ユーザーがどこかにある単語(曲名、演奏者名等)を検索する時に、私が使うものです。誰かが他のものに変えたい時には変えられるように定数にしておきましたが、「all」としてハードコード化しておくこともできます。

%freedb_searchesハッシュはFreeDBフィールドを、(ID3v2タグ要素を含めて)そのフィールドの情報にマッピングします。例えば、FreeDBで「artist」と呼ぶものがMP3タグでは「TPE1」だ、のように言うのです。ハッシュ入力項目の「abbrev」フィールドはコマンドライン・スイッチを定義するために使います。ですから後で-artistスイッチを定義し、%freedb_searches情報に基づいて-iとして省略できるのです。

%info2freedbハッシュは、ディスク上の全曲に共通なFreeDBフィールドをID3v2フィールドにマッピングします。これらは%freedb_searchesにあるフィールドではなく、別のマッピングでそれぞれ「TALB」や「TPE1」としても知られる「cdname」や「artists」が、アルバム中の全曲に対して全て同じであることを言っているのです。

%supported_framesハッシュは@supported_framesリストは、どのID3v2タグ要素がサポートされているかを判別するために使われます。ハッシュからリストを得るのではなく、リストからハッシュを生成することもできたのですが、その違いは重要ではないと思います。サポートしたフレームは一括タグ付けする時とタグを書く時に使います(私はサポートしているフレームのみを手直しします)。

最後に、アプリケーション全体を通してのユーザー入力にTerm::ReadLineオブジェクトを作成します。

次に、AppConfigオプションを初期化します。ちょっと我慢してください。これは便利なのです。

リスト4. AppConfig初期化
# {{{ set up AppConfig and process -help
my $config = AppConfig->new();
$config->define(
   DEBUG       =>
   { ARGCOUNT => ARGCOUNT_ONE, DEFAULT => 0, ALIAS => 'D' },
   CONFIG_FILE       =>
   { ARGCOUNT => ARGCOUNT_ONE, DEFAULT => 0, ALIAS => 'F' },
   HELP        =>
   { ARGCOUNT => ARGCOUNT_NONE, DEFAULT => 0, ALIAS => 'H' },
   DUMP        =>
   { ARGCOUNT => ARGCOUNT_NONE, DEFAULT => 0 },
   ACCEPT_ALL  =>
   { ARGCOUNT => ARGCOUNT_NONE, DEFAULT => 0, ALIAS => 'C' },
   DRYRUN      =>
   { ARGCOUNT => ARGCOUNT_NONE, DEFAULT => 0, ALIAS => 'N' },
   GUESS_TRACK_NUMBERS_ONLY  =>
   { ARGCOUNT => ARGCOUNT_NONE, DEFAULT => 0, ALIAS => 'G' },
    STRIP_COMMENT_ONLY =>
    { ARGCOUNT => ARGCOUNT_NONE, DEFAULT => 0, ALIAS => 'SC' },
   MASS_TAG_ONLY =>
   { ARGCOUNT => ARGCOUNT_HASH, ALIAS => 'M' },
   RENAME_ONLY =>
   { ARGCOUNT => ARGCOUNT_NONE, DEFAULT => 0, ALIAS => 'RO' },
   RENAME_MAX_CHARS =>
   { ARGCOUNT => ARGCOUNT_ONE, DEFAULT => 30},
   RENAME_FORMAT =>
   { ARGCOUNT => ARGCOUNT_ONE, DEFAULT => '%a-%t-%n-%c-%s.mp3'},
   RENAME_BADCHARS =>
   { ARGCOUNT => ARGCOUNT_LIST, ALIAS => 'RB' },
   RENAME_REPLACECHARS =>
   { ARGCOUNT => ARGCOUNT_LIST, ALIAS => 'RR' },
   RENAME_REPLACEMENT =>
   { ARGCOUNT => ARGCOUNT_ONE, DEFAULT => '_' },
   FREEDB_HOST =>
   { ARGCOUNT => ARGCOUNT_ONE, DEFAULT => 'http://www.freedb.org', },
   OR =>
   { ARGCOUNT => ARGCOUNT_NONE, DEFAULT => '0', },
   SEARCH_ALL()  =>
   { ARGCOUNT => ARGCOUNT_LIST, ALIAS => 'A' },
      );
foreach my $search (keys %freedb_searches)
{
 $config->define($search => {
      ARGCOUNT => ARGCOUNT_LIST,
      ALIAS => $freedb_searches{$search}->{abbrev},
      });
}
$config->args();
$config->file($config->CONFIG_FILE())
 if $config->CONFIG_FILE();
unless (scalar @{$config->RENAME_BADCHARS()})
{
 push @{$config->RENAME_BADCHARS()}, split(//, "\"`!'?&[]()/;\n\t");
}
unless (scalar @{$config->RENAME_REPLACECHARS()})
{
 push @{$config->RENAME_REPLACECHARS()}, split(//, " ");
}
if ($config->HELP())
{
 print <EOHIPPUS;
$0 [options] File1.mp3 File2.mp3 ...
Options:
 -help (-h)          : print this help
 -config_file (-f) N : use this config file, see AppConfig module docs for format
 -debug (-d) N       : print debugging information (level N, 0 is lowest)
 -dump               : just dump the list of albums and tracks within them
 -dryrun (-n)        : do everything but modify the MP3 files
 -freedb_host H      : set the FreeDB host, default "www.freedb.org"
 -or                 : search for keyword A or keyword B, not A and B as usual
 -accept_all (c)     : accept all search results for consideration for each file,
                       also accept all renames without asking
 -rename_badchars (-rb) A -rb B     : characters A and B to remove when renaming
 -rename_replacechars (-rr) A -rr B : characters A and B to replace
                                      when renaming
 -rename_maxchars N : use at most this many characters from a tag
                      element when renaming, default: ${\$config->RENAME_MAX_CHARS()}
 -rename_replacement X : character to use when replacing,
                      default: [${\$config->RENAME_REPLACEMENT()}]
 -rename_format (-f) F : format for renaming; default "${\$config->RENAME_FORMAT()}"
                         %a -> Artist
                         %t -> Track number
                         %n -> Album name
                         %c -> Comment
                         %s -> Song title
 -guess_track_numbers_only (-g) : guess track numbers using the file
                     name, then exit
 -rename_only (-ro)  : rename tracks using the given format (see
                       -rename_format), then exit
 -mass_tag_only (-m) A=X -m B=Y : mass-tag files (tag element A is X,
                                  B is Y), then exit (tag elements
                                  available: @supported_frames)
 -strip_comment_only (-sc) : strip comments and URLs, then exit
Repeatable options (you can specify them more than once, K is the keyword):
 -all (-a)    K : search everywhere
 -artist (-i) K : search for these artists
 -title (-t)  K : search for these titles
 -track (-k)  K : search for these tracks
 -rest (-r)   K : search for these keywords everywhere else
Note that the repeatable options are cumulative, so artist A and title
B will produce matches for A and B, not A or B. In the same way,
artist A and artist B will produce matches for A and B, not A or B.
If you want to match A or B terms, use -or, for instance:
$0 -or -artist "pink floyd" -artist "fred flintstone"
EOHIPPUS
 exit;
}
# }}}

そう、このコード全ては単にコマンドライン・オプションを初期化するだけなのです。AppConfigを使えば、こうしたオプションをプログラム全体に渡って使用、変更することができます。AppConfigを使う利点はこの記事の範囲外ですが、たくさんあるのです(AppConfigについてさらに詳しくは参考文献に挙げてあります)。

それから、私は%freedb_searchesハッシュの入力項目を使って適切な設定オプションを作成しましたが、これでユーザーもプログラマーも楽になります。私は%freedb_searchesハッシュの入力項目を使って適切な設定オプションを作成します。

設定ファイルをロードした後でユーザーが規定した場合には、置き換え文字とおかしな文字配列を、意味が通るようなデフォルト値で埋めます。

最後に-helpスイッチを処理します。各種オプションに対するデフォルト値が、可変補完を使ってヘルプ・テキスト内部にどのように出力されているかに注意してください。これでヘルプ・メッセージが非常に読みやすくなるのです。私はフィーチャーを追加した直後、時には追加する前に、必ずヘルプ・メッセージを更新しています。ヘルプはプログラムの機能と常に同期しているべきだと私は思っています。そうしないとプログラムは分かりにくくなり、ヘルプは誤解を招くものになってしまいます。autotag.plプログラムは特に、もっと文書化が必要です。POD式の文書が良いのですが、読者がこの記事を読む頃にはそれも用意できているかもしれません。POD文書はスクリプトの一部なので、読者がautotag.pl(参考文献)をダウンロードする時までに私が書き終えていれば、ダウンロードした中にPOD文書も一緒に含まれているはずです。

ID3v2タグ関連の機能

get_tag()機能はautotag.plで一番大事なもので、MP3ファイル名を与えると、そのファイルからハッシュ・タグを構築します。タグがID3v1のみの場合には、get_tag()は無料でID3タグをアップグレードするように申し出てくるのです(何とお得な!)。ID3タグが無ければget_tag()がそれを作ります。さらにget_tag()は、COMMとWXXXタグ要素のそれぞれTextとURLサブ要素を見る必要があることも知っています。

リスト5. get_tag()機能
# {{{ get_tag: get a ID3 V2 tag, using V1 if necessary
sub get_tag
{
 my $file    = shift @_;
 my $upgrade = shift @_;
 my $mp3 = MP3::Tag->new($file);
 return undef unless defined $mp3;
 $mp3->get_tags();
 my $tag = {};
 if (exists $mp3->{ID3v2})
 {
  my $id3v2 = $mp3->{ID3v2};
  my $frames = $id3v2->supported_frames();
  while (my ($fname, $longname) = each %$frames)
  {
   # only grab the frames we know
   next unless exists $supported_frames{$fname};
   $tag->{$fname} = $id3v2->get_frame($fname);
   delete $tag->{$fname} unless defined $tag->{$fname};
   $tag->{$fname} = $tag->{$fname}->{Text} if $fname eq 'COMM';
   $tag->{$fname} = $tag->{$fname}->{URL} if $fname eq 'WXXX';
   $tag->{$fname} = '' unless defined $tag->{$fname};
  }
 }
 elsif (exists $mp3->{ID3v1})
 {
  warn "No ID3 v2 TAG info in $file, using the v1 tag";
  my $id3v1 = $mp3->{ID3v1};
  $tag->{COMM} = $id3v1->comment();
  $tag->{TIT2} = $id3v1->song();
  $tag->{TPE1} = $id3v1->artist();
  $tag->{TALB} = $id3v1->album();
  $tag->{TYER} = $id3v1->year();
  $tag->{TRCK} = $id3v1->track();
  $tag->{TIT1} = $id3v1->genre();
  if ($upgrade & read_yes_no("Upgrade ID3v1 tag to ID3v2 for $file?", 1))
  {
   set_tag($file, $tag);
  }
 }
 else
 {
  warn "No ID3 TAG info in $file, creating it";
  $tag = {
      TIT2 => '',
      TPE1 => '',
      TALB => '',
      TYER => 9999,
      COMM => '',
      };
 }
 print "Got tag ", Dumper $tag
  if $config->DEBUG();
 return $tag;
}
# }}}

set_tag()機能はget_tag()の兄弟分であり、COMMとWXXXフレームのサブ要素を見てID3v2タグを書きます。set_tag()機能はget_tag()が生成するようなハッシュ参照を受け取ります。

リスト6. set_tag()機能
# {{{ set_tag: set a ID3 V2 tag on a file
sub set_tag
{
 my $file = shift @_;
 my $tag  = shift @_;
 my $mp3 = MP3::Tag->new($file);
 print Dumper $tag;
 my $tags = $mp3->get_tags();
 my $id3v2;
 if (ref $tags eq 'HASH' & exists $tags->{ID3v2})
 {
  $id3v2 = $tags->{ID3v2};
 }
 else
 {
  $id3v2 = $mp3->new_tag("ID3v2");
 }
 my %old_frames = %{$id3v2->get_frame_ids()};
 foreach my $fname (keys %$tag)
 {
  $id3v2->remove_frame($fname)
   if exists $old_frames{$fname};
  if ($fname eq 'WXXX')
  {
   $id3v2->add_frame('WXXX', 'ENG', 'FreeDB URL', $tag->{WXXX}) ;
  }
  elsif ($fname eq 'COMM')
  {
   $id3v2->add_frame('COMM', 'ENG', 'Comment', $tag->{COMM}) ;
  }
  else
  {
   $id3v2->add_frame($fname, $tag->{$fname});
  }
 }
 $id3v2->write_tag();
 return 0;
}
# }}}

print_tag_info()機能は単純にタグの要約を出力します。私が(時には必要も無いのに)autotag.plのそこら中で使っているData::Dumperとは異なり、print_tag_info()は見やすくユーザーに分かりやすい形でハッシュ・タグ要素を出力します。この機能は、実際のファイル名ではなくハッシュ参照をとることに注意してください。

guess_track_number()と機能とguess_artist_and_track()機能は、ファイル名と、場合によってはID3タグ情報も与えれば、最大限の努力で情報を持ってきます。guess_track_number()は、曲番号が30を超えるのはごく稀、としていることには注意が必要です。

リスト7. print_tag_info()機能とguess_track_number()機能そしてguess_artist_and_track()機能
# {{{ print_tag_info: print the tag info
sub print_tag_info
{
 my $filename = shift @_;
 my $tag      = shift @_;
 my $extra    = shift @_ || 'Track info';
 # argument checking
 return unless ref $tag eq 'HASH';
 print "$extra for '$filename':\n";
 foreach (keys %$tag)
 {
  printf "%10s : %s\n", $_, $tag->{$_};
 }
}
# }}}
# {{{ guess_track_number: guess track number from ID3 tag and file name
sub guess_track_number
{
 my $filename = shift @_;
 my $tag      = shift @_ || return undef;
 $filename = basename($filename);   # directories can contain confusing data
 # first try to guess the track number from the old tag
 if (exists $tag->{TRCK} & contains_word_char($tag->{TRCK}))
 {
  my $n = $tag->{TRCK} + 0;    # fix tracks like 1/10
  return $n;
 }
 elsif ($filename =~ m/([012]?\d).*\.[^.]+$/)
                     # now look for numbers in the filename (0 through 29)
 {
  print "Guessed track number $1 from filename '$filename'\n"
   if $config->DEBUG();
  return $1;
 }
 return undef; # if all else fails, return undef
}
# }}}
# {{{ guess_artist_and_track: guess artist and track from file name
sub guess_artist_and_track
{
 my $filename = shift @_;
 my $artist;
 my $track;
 $filename = basename($filename);   # directories can contain confusing data
 if ($filename =~ m/([^-_]{3,})\s*-\s*(.{3,})\s*\.[^.]+$/)
 {
  print "Guessed artist $1 from filename '$filename'\n"
   if $config->DEBUG();
  $artist = $1;
  $track = $2;
 }
 return ($artist, $track);
}
# }}}

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」の場合に、ハッシュ・タグから取得する曲名がTRACKNAMEだとすると、曲名が「100%TRACKNAMErue」になってしまうことを考えてみればわかると思います。

一括リネームはまた、おかしな文字を削除し、またある文字は「_」で置き換えて、もっともらしいファイル名になるようにします。そして最後に、コマンドラインから-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;
}
# }}}

まとめ

この記事の第2回目ではautotag.plのメイン・ループと、このプログラムの一般的な使い方を説明する予定です。


ダウンロード可能なリソース


関連トピック


コメント

コメントを登録するにはサインインあるいは登録してください。

static.content.url=http://www.ibm.com/developerworks/js/artrating/
SITE_ID=60
Zone=Linux
ArticleID=228119
ArticleTitle=洗練されたPerl: MP3とPerlで遊ぶ、第1回
publish-date=09092003