Perl - YouTube の動画の音声を iTunes に登録

Perl のモジュール WWW-YouTube-Download と ffmpeg を使って、YouTube から動画をダウンロードしてきてその音声を iTunes に登録させる話。LWP::UserAgent のコールバックの書き方が勉強になった。

• Windows でも Mac でも OK
• ffmpeg は Windows は お気に入りの動画を携帯で見よう から、Mac なら Homebrew からインストールできる。 PATH を通しておく。
• 作業するディレクトリは Windows はテンプフォルダ、Mac はダウンロードフォルダにしてある。ソースをいじって適当に変更した方がいいかも。Windows の場合は後で start コマンドを使うためフルパスで記述すべし。
• ダウンロードしてくる動画はビットレートの高い音声 aac な動画にしたつもり。Wikipedia を参考に手動で @aac_fmt_list をいじってもいい。
• iTunes は設定で「ライブラリへの追加時にファイルを"iTunes Media"フォルダにコピーする」のチェックをしておく。
• 動画のダウンロードだけなら WWW::YouTube::Download モジュール同封の youtube-download コマンドで簡単にできる。

#!/usr/bin/env perl
use strict;
use warnings;
use utf8;
use Encode;
use WWW::YouTube::Download;
use Term::ReadKey;
use Errno ();
use List::Util qw(first);
use Cwd;
use IO::File;

# ダウンロードしたい音声 aac な fmt の優先順位
my @aac_fmt_list = (37,35,34,18,22);

my ($terminal_width) = GetTerminalSize();
my $encoder = $^O eq "MSWin32" ? find_encoding("cp932")
            : $^O eq "darwin"  ? find_encoding("utf8")
            :                    die "Only for Mac or Windows.";

STDOUT->autoflush;

# 作業するディレクトリの指定
my $root_dir = $ENV{TEMP} || $ENV{TMP} || "$ENV{HOME}/Downloads";
#my $root_dir = Cwd::getcwd;

chdir $root_dir;
my $workspace = 'www-youtube-download';
unless (mkdir $workspace or $! == Errno::EEXIST) {
    die "Failed to create dir:$workspace:$!";
}
chdir $workspace;

print "Input a video URL:\n";
chomp(my $video_url = <STDIN>);

my $client = WWW::YouTube::Download->new;

# title, fmt, suffix を決定
my $meta_data = $client->prepare_download($video_url);
my $title = decode_utf8($meta_data->{title});
$title = filename_normalize($title);
$title = $encoder->encode($title, sub {sprintf 'U+%x', shift});
my $fmt = get_aac_fmt($meta_data->{fmt_list})
    or die "Error: The audio codec of the video is not aac.\n";
my $suffix = $meta_data->{video_url_map}{$fmt}{suffix};

# ビデオダウンロード
open my $wfh, '>', "$title.$suffix"
    or die "Error: Can't create a file: $!";
binmode $wfh;
print "Downloading: $title ($suffix, $fmt)\n";
eval {
    $client->download($video_url, {
        fmt => $fmt,
        cb  => \&callback,
    });
};
die "Error: Can't complete downloading: $@" if $@;
close $wfh;
print "Successfully finished downloading.\n";

# ffmpeg
my $nul = $^O eq "MSWin32" ? 'NUL' : '/dev/null';
system qq|ffmpeg -i "$title.$suffix" -vn |
      .qq|-acodec copy -y "$title.m4a" 1> $nul 2>&1|;

# iTunes
if ($^O eq 'MSWin32') {
    system qw|start iTunes|, "$root_dir/$workspace/$title.m4a";
}
else {
    system qw{open -a /Applications/iTunes.app}, "$title.m4a";
}

# unlink files
print "Please wait for a while to unlink $suffix and m4a files...";
sleep 8;
if (unlink "$title.$suffix", "$title.m4a") {
    print " OK\n";
}
else {
    warn "\nFailed to unlink files: $!\n";
}


sub callback {
    my ($chunk, $res, $proto) = @_;
    print {$wfh} $chunk;

    my $size = tell $wfh;
    my $total = $res->header('Content-Length');
    my $width = $terminal_width - 26;
    my $progress = int ($size / $total * $width);
    print 
        sprintf(
            "Total:%5.1fMB (%5.1f%%)",
            $total / 1024 / 1024, $size / $total * 100
        ),
        " [", "=" x $progress, " " x ($width - $progress), "]\r";
    print "\n" if $total == $size;
}

sub get_aac_fmt {
    my %get_fmt_list = map { $_ => 1 } @{shift()};
    first { exists $get_fmt_list{$_} } @aac_fmt_list;
}

# 以下は youtube-download からの丸写し
sub filename_normalize {
    my $filename = shift;
    $filename =~ s#[[:cntrl:]]##smg;          # remove all control characters
    $filename =~ s#^\s+|\s+$##g;              # trim spaces
    $filename =~ s#^\.+##;                    # remove multiple leading dots
    $filename =~ tr#"/\\:*?<>|#'\-\-\-_____#; # NTFS and FAT unsupported characters
    return $filename;
}

以上を適当な名前で保存して実行してみるとこんな感じ。

今日の疑問

• system iTunes コマンドの引数をフルパスで指定しなければいけないの？
• サブルーチン get_aac_fmt の作り方を工夫したが、これでいいのか？
• コールバックの中で画面幅分 - 1 のプログレスバーを作ったけど、これは画面幅丁度だと Windows でうまくいかなかったから。なんで？
• 後処理で www-youtube-download フォルダも消そうとしたけど、消せないことが多々起きたのでそのまま残すことにした。なぜ消せない？
• iTunes を呼び出した後にすぐファイルを消すと iTunes によってコピーされる前に消してしまうことが起きた。だから sleep 8; をして待ってから消してるんだけど、もっといい方法はあるか？