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

投稿：2019-08-28

背景

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

プログラム

#!/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/Ｒａｄｉｋｏ - ショートカット.lnk");
my $path = Encode::decode locale_fs => $sc->{Path};
say "ＤＡＰ：$path";
-e Encode::encode locale_fs => $path or die "ＤＡＰが接続されていません。\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 "ＤＡＰ：@{[$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