perl で mp3 の歌詞を自動で入れたい。と、思い作成。
下のファイルを名前を付けて保存。動かし方：フォルダーに mp3 を入れて起動。
perl filegetlyrics.pl "/mnt/d/music/mp3/test/"
mp3 の tag の曲名とアーティスト名から、歌詞をとってきます。
ただ、取りに行っているサイトの関係で、海外の歌ぐらいしか取れてません。
環境：windows10 に ubuntu を入れて実行してます。
$ sudo apt-get install libmp3-tag-perl
とかで、モジュールは追加。
習作ですがとりあえず公開。
------------------------------- filegetlyrics.pl の名前で以下を保存
#!/usr/bin/perl
# 日本語EUC-JP、LF
use strict;
use warnings;
use Data::Dumper;
use Jcode;
use URI::Escape;
use LWP::UserAgent;
use MP3::Tag;
use File::Basename;
die "Please specify folder" if ( $#ARGV < 0 );
while ( my $path = shift @ARGV ) {
chdir($path);
my @files = glob "*.mp3";
foreach my $f (@files){
print "try $f \n";
my $result = GetLyrics( $f )
}
}
sub GetLyrics {
my $file = shift @_;
my $lyr = GetInferedLyrics( $file )
or warn "18 Lyrics not found for " . basename( $file );
# エラー
return if ( !$lyr );
#歌詞を見るとき
##print "$lyr \n";
#text file に歌詞を書き出す場合
# my $txtWrite = WriteWriteLyrics($file,$lyr);
#mp3 処理
my $mp3 = MP3::Tag->new( $file ) or return; # エラー
print "56 $file \n";
$mp3->select_id3v2_frame_by_descr("USLT(eng)", $lyr); # 歌詞
$mp3->update_tags();
$mp3->close;
warn "All done ----- $file";
return $file
}
#text file 書き出し
sub WriteWriteLyrics {
my $file = shift @_;
my $lyr = shift @_;
my $txtFile = $file;
$txtFile =~ s/\.mp3$/.txt/i;
open( W, ">" . $txtFile ) or next;
binmode W;
print W $lyr;
close( W );
return $txtFile;
}
sub GetInferedLyrics {
my $file = shift @_;
# tag 取得
my( $title, $art ) = GetFuzzyID3Tags( $file ) or return; # エラー
# 歌詞取得
my @list = GetCandidates(
$art,
$title
) or return; # エラー
return if ( $#list != 0 ); # エラー
return $list[0]->{head} ;
}
sub GetFuzzyID3Tags {
my $file = shift @_;
my( $title, $art ) = GetID3Tags( $file ) or return; # エラー
$title =~ s/\(.*?\)//g;
$art =~ s/\(.*?\)//g;
return( $title, $art );
}
sub GetID3Tags {
my $file = shift @_;
my $mp3 = MP3::Tag->new( $file ) or return; # エラー
my( $title, $track, $art ) = $mp3->autoinfo() or return; # エラー
$mp3->close;
# ID3タグがないときは勝手にファイル名が参照される
$title =~ s/\t/ /g;
$art =~ s/\t/ /g;
my $from =
'０１２３４５６７８９'
. 'ＡＢＣＤＥＦＧＨＩＪＫＬＭＮＯＰＱＲＳＴＵＺＷＸＹＺ'
. 'ａｂｃｄｅｆｇｈｉｊｋｌｍｎｏｐｑｒｓｔｕｚｗｘｙｚ'
. '（）“”［］'
. '＝：；！？＃'
. ' ' #全角スペース
;
my $to =
'0123456789'
. 'ABCDEFGHIJKLMNOPQRSTUZWXYZ'
. 'abcdefghijklmnopqrstuzwxyz'
. '()""[]'
. '=:;!?#'
. ' ' #半角スペース
;
my $str = "$title\t$art";
$str =~ s/－/-/g;
return( split( /\t/, $str ) );
}
sub GetEucContent {
my $url = shift @_;
my $ua = LWP::UserAgent->new(
agent => 'Mozilla/4.0 (compatible; MSIE 6.0)',
timeout => 15,
max_size => 128 * 1024,
);
my $response = $ua->get( $url ) or return; # エラー
return # エラー
if ( !$response->is_success );
my $eucContent;
eval {
$eucContent = jcode( $response->content )->h2z->euc;
};
return # エラー
if ( $@ );
return $eucContent;
}
sub GetCandidates {
my $art = shift @_;
my $title = shift @_;
my $baseurl = 'http://lyrics.wikia.com/wiki/';
my $url = $baseurl . '%ART%:%TITLE%';
my $head = '%ART%:%TITLE%';
$art = uri_escape_utf8($art);
$title = uri_escape_utf8($title);
$url =~ s/\%ART\%/$art/;
$url =~ s/\%TITLE\%/$title/;
# 空白はアンダースコアに置き換え
$url =~ s/\%20/_/g;
print "$url \n";
my $eucContent = GetEucContent( $url ) or return; # エラー
my $found = ( $eucContent);
return unless ( $found ); # エラー
my @candidates;
my $this;
$this->{url} = $baseurl;
$this->{title} = $title;
if ($eucContent =~ /(.*\'lyricsbreak.*)/) {
use HTML::Entities;
my $decoded;
$decoded=decode_entities($1);
$decoded =~ s/\>/ \n/g;
$decoded =~ s/\<.+\s?/\n/g;
$this->{head} = $decoded;
}
push( @candidates, $this );
return @candidates;
}
1;
