ID3v2(mp3のタグ)を読む
投稿:2018-12-01
このツイートを見て
CPANにID3を扱うモジュールがいくつもあるので自分が使えそうなのを選びました。
MP3::Info - Manipulate / fetch info from MP3 audio files - metacpan.org
MP3::Info - Manipulate / fetch info from MP3 audio files - metacpan.org
タイトルに「編集」とありますが表示だけです(^^ゞ
コードにコメントしましたがEncode::Guessの記述だけで回避してます。
MP3::InfoがmainパッケージにあるEncode::Guessで指定された文字コードに依存して自動変換しているようです。
こんな感じです。例によって日本では希少なPerl/Tkxで書いてあります。
#!/usr/bin/env perl -w use utf8; use strict; use warnings; use open IO => ":utf8"; use Data::Dumper; use DateTime; use DateTime::Format::Strptime; use Encode::Argv; use Encode::Locale; use Encode::Guess qw/cp932 utf8/; # MP3::Infoが変換に使う use File::Basename; use FindBin; use IO::File; use MP3::Info; use Tkx; use Tkx::Scrolled; use lib $FindBin::Bin; use TkxMenuBuild; use TkxMsgBox; use constant FONT_NAME => "MS ゴシック"; binmode STDIN, ":encoding(console_in)"; binmode STDOUT, ":encoding(console_out)"; $| = 1; # リストボックス内の文字を等幅にするため一律でフォントを指定 my $font_size = 11; my $item_font = [FONT_NAME, $font_size, 'normal', ]; Tkx::option_add("*Listbox.font", $item_font); my $mw = Tkx::widget->new("."); TkxMenuBuild->new($mw, [ [ "ファイル", "F", [ [ "mp3を開く", "O", \&file_open, ], [ "終了", "X", \&wm_delete_window, ], ], ], ]); $mw->g_wm_title("mp3タグ編集"); $mw->g_wm_minsize(0, 0); $mw->g_wm_protocol(WM_DELETE_WINDOW => \&wm_delete_window); $mw->g_wm_resizable(0, 0); $mw->new_label( -text => "タグ 内容", -font => $item_font, )->g_pack(-anchor => "w"); my $mp3tag_lbx = $mw->new_tkx_Scrolled( "listbox", -selectmode => "extended", -scrollbars => "e", -width => 24 + 1 + 60, -height => 10, -activestyle => "none", ); $mp3tag_lbx->g_pack(-anchor => "w"); my %mp3tag; Tkx::MainLoop(); exit; sub file_open { my $temp_mp3 = Tkx::tk___getOpenFile( -defaultextension => "*.mp3", -filetypes => [ ["mp3ファイル", [".mp3",]], ["すべてのファイル", [".*",]], ], -title => "mp3を選択してください", ); if ($temp_mp3) { load_mp3($temp_mp3); update_lbx(); } } sub update_lbx { my $cursor = $mp3tag_lbx->index("active"); $mp3tag_lbx->delete(0, "end"); $mp3tag_lbx->insert("end", line_format($_, $mp3tag{$_})) for sort keys %mp3tag; $mp3tag_lbx->activate($cursor) if "" ne $cursor; } sub line_format { my ($tag, $value) = @_; $value = $value // "-"; return sprintf "%24s %s", $tag, $value; } sub load_mp3 { my ($mp3_file) = @_; my $mp3tag = get_mp3tag(Encode::encode locale_fs => $mp3_file); %mp3tag = (); for (keys %{$mp3tag}) { $mp3tag{$_} = $mp3tag->{$_}; } } sub wm_delete_window { $mw->g_destroy; }
Perl/Tkxでよく使う処理をモジュールにしてあります。
1つ目は、階層を配列にして渡すとメニューを構築するモジュールです。
2つ目はメッセージボックスです。
1つ目は、階層を配列にして渡すとメニューを構築するモジュールです。
package TkxMenuBuild; use utf8; use strict; use warnings; sub new { my $class = shift; my $self = {}; bless $self, $class; menu_build(@_); } sub menu_build_sub { my ($parent, $tree) = @_; my $label = ${$tree}[0]; my $label_after = ""; my $underline = 1 + length ${$tree}[0]; if ($label =~ /\.\.\.$/) { $label =~ s/\.\.\.$//; $label_after = "..."; $underline -= 3; } $label .= "(${$tree}[1])$label_after"; if ("CODE" eq ref ${$tree}[2]) { $parent->add_command( -label => $label, -underline => $underline, -command => ${$tree}[2], ); } elsif ("SCALAR" eq ref ${$tree}[2]) { $parent->add_checkbutton( -label => $label, -underline => $underline, -variable => ${$tree}[2], -offvalue => 0, -onvalue => 1, ); } elsif ("ARRAY" eq ref ${$tree}[2]) { my $submenu = $parent->new_menu( -tearoff => 0, ); $parent->add_cascade( -label => "${$tree}[0](${$tree}[1])", -underline => 1 + length ${$tree}[0], -menu => $submenu, ); for (@{${$tree}[2]}) { menu_build_sub($submenu, $_); } } } sub menu_build { my ($mainwindow, $tree) = @_; my $parent = $mainwindow->new_menu; for (@$tree) { my $submenu = $parent->new_menu( -tearoff => 0, ); $parent->add_cascade( -label => "${$_}[0](${$_}[1])", -underline => 1 + length ${$_}[0], -menu => $submenu, ); for (@{${$_}[2]}) { menu_build_sub($submenu, $_); } } $mainwindow->configure(-menu => $parent); } 1;
2つ目はメッセージボックスです。
use utf8; use strict; use warnings; sub TkxMsgBox($) { my ($msg) = @_; Tkx::tk___messageBox( -title => "メッセージ", -type => "ok", -icon => "info", -message => "$msg", ); } 1;