ルモーリン
ホーム 更新 Perl Sample ランドナー サービス 雑談 コースガイド 鉄ゲタ 自転車 Linux リンク 連絡先

再生時間が一定量以上の音声ファイルを移動

2019-08-28

背景

Radikoからぶっこ抜いた音声データをパソコンのデスクトップ上のフォルダに入れてパソコンで再生しています。 それと通勤中に聞きたいのでファイルをDAPに手作業で移動しています(スマホを持ってない)。 その際、省力化のためにフォルダ内にDAPへのショートカットを置き、ファイルのドロップ(コンテンツメニューの移動を選択)で移動しています。 DAPに入れておくファイルは、放送日時が古いほうから再生時間が4時間を越える程度にとどめています。 これらをプログラムで自動化したい。

プログラム

#!/usr/bin/env perl

use v5.26;
use utf8;
use strict;
use warnings;

use Encode;
use Encode::Locale;
use MP4::Info;
use Win32::Shortcut;
use File::NCopy qw/ copy /;

use open IO => ":utf8";
binmode STDIN, ":encoding(console_in)";
binmode STDOUT, ":encoding(console_out)";
binmode STDERR, ":encoding(console_out)";

$| = 1;

my $sc = Win32::Shortcut->new;
$sc->Load(Encode::encode locale_fs => "$ENV{USERPROFILE}/Desktop/radiko/Radiko - ショートカット.lnk");
my $path = Encode::decode locale_fs => $sc->{Path};
say "DAP:$path";
-e Encode::encode locale_fs => $path or die "DAPが接続されていません。\n";

my $total_sec = 0;
for(map {chomp; $_ = Encode::decode locale_fs => $_} glob Encode::encode locale_fs => $path . "/" . "*.mp4") {
	my $mp4 = MP4::Info->new(Encode::encode locale_fs => $_);
	$total_sec += $mp4->secs;
	say "DAP:@{[$mp4->secs]}, $total_sec, $_";
}

use constant TIME_TO_FILL => 3600 * 4;
my @mp4 = sort map {chomp; $_ = Encode::decode locale_fs => $_} glob Encode::encode locale_fs => "$ENV{USERPROFILE}/Desktop/radiko/*.mp4";
for (@mp4[1 .. $#mp4]) {
	last if TIME_TO_FILL < $total_sec;

	my $mp4 = MP4::Info->new(Encode::encode locale_fs => $_);
	print "$_ ... ";
	copy Encode::encode(locale_fs => $_) => Encode::encode(locale_fs => $path);
	unlink Encode::encode locale_fs => $_;
	print "done.\n";

	$total_sec += $mp4->secs;
}

解説

use MP4::Info

mp4ファイルの再生時間を取得してます。
MP4::Info - Fetch info from MPEG-4 files (.mp4, .m4a, .m4p, .3gp) - metacpan.org

use Win32::Shortcut

Windowsのショートカット(*.lnkファイル)からリンク先を取得してます。
Win32::Shortcut - Perl Module to deal with Windows Shortcuts - metacpan.org

use File::NCopy

Perlにファイルを移動したりコピーする関数はありません。
File::NCopy - Deprecated module. Use File::Copy::Recursive instead. Copy file, file. Copy file[s] | dir[s], dir - metacpan.org

$ENV{USERPROFILE}

Windowsでログインしたユーザーのフォルダです。

-e

「X は以下にあげる文字で、ファイルテストを行ないます。 ファイルテストを行ないます。 この単項演算子は、ファイル名かファイルハンドルを唯一の引数として動作し、 『あること』について真であるか否かを判定した結果を返します。」
「-e ファイルが存在する。」
Perlの組み込み関数 -X の翻訳 - perldoc.jp

glob

「リストコンテキストでは、 EXPR の値を、標準 Unix シェル /bin/csh が行なうように ファイル名の展開を行なった結果のリスト(空かもしれません)を返します。」
Perlの組み込み関数 glob の翻訳 - perldoc.jp

map

「LIST の個々の要素に対して、BLOCK か EXPR を評価し ($_ は、ローカルに個々の要素が設定されます) 、 それぞれの評価結果からなるリスト値が返されます。」
Perlの組み込み関数 map の翻訳 - perldoc.jp

sort

【重要】sortは文字列順です。【警告】
「リストコンテキストでは、LIST をソートし、ソートされたリスト値を返します。」
「SUBNAME や BLOCK を省略すると、sort は標準の 文字列比較の順番で行なわれます。」
Perlの組み込み関数 sort の翻訳 - perldoc.jp

last

「C の break 文と 同じようなもので、LABEL で指定されるループを即座に抜けます。 LABEL が省略されると、コマンドは一番内側のループを参照します。」
Perlの組み込み関数 last の翻訳 - perldoc.jp

改行なしprint

ファイルの移動に時間がかかるので、移動中は「ファイル名 ... 」まで表示しておき、移動後に「done.」を追加します。
ファイル名 ...
の後で
ファイル名 ... done.
になります。

unlink

「LIST に含まれるファイルを削除します。」
Perlの組み込み関数 unlink の翻訳 - perldoc.jp