perlでMP4やMOVの縦横サイズを取得する
タイトルのまんまのエントリ。
動機としては、ウチのおひとり様ActivityPubサーバーに動画をアップロードしてみたい。
んで、ActivityPubサーバーは、フォロワーさんのところに投稿（ActivityのJSON）を配送するんだけど、この時に縦横のピクセルサイズが必要っぽい。
動画を扱う時に、鉄板の定番のffmpegでサイズ取得も当然、ほかに解像度変更やファイルサイズの圧縮とかいろいろできるんだけど、レンタルサーバーでffmpegを使えるという話を見たことがなく、当然わたしが利用しているロリポップも使えない。
となると、縦横のピクセルサイズは自力でなんとかする必要がある。
ぐーぐる先生に聞きまくってなんとかなったのでメモ。
「MP4のファイル構造を解説」
https://qiita.com/satken2/items/d14b4113fe3fb5f5597b
↑こちらのサイトで一発解答（多謝！）
MP3とMOVファイルは基本３つのブロックの塊らしい。
| サイズ | タイプ名 | データ |
| 4バイト | 4バイト | 可変 |
最初の4バイトに入ってるサイズでブロック全体の長さがわかる。
BOXの長さの情報が2^32バイト(=4294967296)を超える場合、最初の4バイトには0x00000001が格納され、その変わりに9バイト～16バイトに実際のBOXの長さが書かれます
ということだけど、今回わたしの場合は10秒もないようなSNSに上げるためだけの動画なのでスルーする。
そのブロックにもろもろの情報が入っているので、欲しいところを取得する。
このブロックのタイプはいったいなんなの？というのは
「QuickTime File Format」
https://developer.apple.com/documentation/quicktime-file-format#//apple_ref/doc/uid/TP40000939-CH204-SW1
↑こちらに全部ある。
ここまでわかればやることはわりと単純。
1)最初の4バイトをみてブロックサイズを取得
2)次の4バイトをみてブロックのタイプを取得
3)必要なタイプだったらそこで情報を取得して終了
必要なタイプじゃなかったら次のブロックをみにいく
ちょっとハマったのが
各ブロックはデータを持たないものと持ってるものがあるということ。
しょうがないんで、次のブロックを先読みしてタイプ名があるかないかで判定。
以下で欲しい情報が取れた。
わたしが欲しいのはタイプ「tkhd」(たぶん、トラックヘッダーの略)のブロックのデータ部に入ってる幅と高さ。
my @parent = (
'cmov', 'ctts', 'edts', 'esds',
'free', 'ftyp', 'iods', 'junk',
'mdia', 'minf', 'moov', 'mvhd',
'pict', 'pnot', 'rmda', 'rmra',
'skip', 'stbl', 'trak', 'uuid',
'wide');
my @child = (
'fiel', 'mdat', 'rdrf', 'rmcd',
'rmcs', 'rmdr', 'rmqu', 'rmvc',
'wfex', 'cmvd', 'co64', 'dcom',
'elst', 'gmhd', 'hdlr', 'mdhd',
'smhd', 'stco', 'stsc', 'stsd',
'stss', 'stsz', 'stts', 'tkhd',
'vmhd');
open(IMG, $file) || die;
binmode IMG;
my $len; my $type; my $data;
my $width; my $height;
while(1){
my $buf;
read(IMG, $buf, 4);
$len = unpack("N", $buf);
read(IMG, $type, 4);
last if ! $type;
# check next type
my $has_data;
seek(IMG,4, 1) || last;
read(IMG,$buf,4);
last if ! $buf;
$buf = quotemeta $buf;
unless( grep(m!$buf!, @parent) || grep(m!$buf!, @child) ){
$has_data = 1;
}
seek(IMG, -8, 1);
if( $has_data ){
$len -= 8;
last if $len < 0;
my $begin = tell(IMG);
read(IMG, $data, $len);
}
if($type =~ m!tkhd!){
my @check = unpack("x76 n x2 n", $data);
if( $check[0] && $check[1] ){
$width = $check[0]; $height = $check[1];
last;
}
}
}
perlはやっぱり凄くて、バイナリファイルも簡単に扱うことができる。
とはいえ、それを扱うスキルがない人間のせいでずいぶん時間がかかってしまった。
これでうちのActivityPubサーバーに動画をあげるための下準備はできた！
…と思ったんだけど、動画ファイルって5秒ぐらいのものでも1M〜2Mもあって慌てた（今さら
わたしはロリポップのビギナーコース。そんなでかいファイルを気楽に上げてたらあっという間に利用できるディスクスペースを食い尽くしてしまう。
なもんで、ここまで作ったけど諦め。きっとそのうち何かの約に立つ、こともある、かな。
今の時期、まじでタケノコ美味くて悶絶する。
刺身で美味いのはもちろん、焼きタケノコがもう絶品。
水分を飛ばすイメージでじっくり弱火のフライパン。水分が飛んできたかなと思ったらオリーブオイルを回しかけてタケノコに焼きめをつけて、塩をふたふり。
これだけでいくらでもご飯が食えるし酒が飲める。
マジでオススメ！！！
» ローカル環境で電子書籍を作る、Macアプリ・Windows版ツール 「かんたんEPUB3作成easy_epub」
ActivityPubサーバーのバグ修正メモ
ここんとこ時間もあるので、おひとり様サーバーの機能追加やバグ修正。
忘れないようにメモしておこう。
・仏語アクサンや独語ウムラウトまじりの投稿で文字化けを起こしてJSONのdecodeで失敗していた。
JSON.pmは文字コードというかutf8フラグの扱いにクセがあって。
decode_jsonに渡すJSONはutf8フラグがついていてはいけない/事前にutf8フラグを外す必要がある。
なので、事前にEncode::is_utf8でutf8フラグの有無を調べて、utf8フラグがついてたらEncode::encode('utf8',JSON)などと、utf8フラグを外して渡してた。
アクサンやウムラウトは見た目1文字
「â」「ë」
だけど、コードポイントは２バイト使う（日本語などは3バイト）ので、スクリプトではutf8フラグをつけて扱う（検索などにそのまま使えるから）
これをEncode::is_utf8でうまく検知できてなかったっぽい…「ぽい」というのは、まだしっかり特定できてないから。
evalでdecode_jsonを括って$@でエラーを捕捉してるところ、エラーが出たらもう一度同じ処理を入れることにした。原因追求をさぼって結果オーライ、というのは昔からの得意技（技？
・お相手サーバーの生存確認を追加した。
応答の確認に時間がかかるサーバーがあった。セッション切れを起こしてしまうのは致命的。
「LWPでtimeout指定が効かない」
https://t2aki.doncha.net/?id=1731205503
↑この対応で解決したはずなのに、このtimeoutの処理が効いていないサーバーがあった。
同じ500番代なのになんでだろ…。
てことで、投稿を配送する前にお相手サーバーが応答してるかどうかの確認することにした。
lwpでリクエストを投げてもたぶん同じことだろうし、Net::Pingを使うことにした。
今のところ意図通りに捕捉できてる。
・アナウンスした時にフォロワーさん以外に通知が飛ばない。
Activityの配送先は自分のフォロワーさん。なので「自分のフォロワーさんじゃないアカウント」の投稿をAnnounce（ブースト、リポスト、リノート）したら、そのアカウントにも配送する必要がある、ということをすっかり忘れてた。
AnnounceするActivityの投稿者をフォロワーリストで確認。
フォロワーリストに入ってなかったら、配送先に追加。
細々というか、2年近く使ってるというのに、いろいろ出てくるもんだ。
けっこうなスピードで疾走感があった。楽しそうでいいよねえ。
» ローカル環境で電子書籍を作る、Macアプリ・Windows版ツール 「かんたんEPUB3作成easy_epub」
自作ActivityPubサーバーにリプライを実装
当初からリプライを実装するつもりはなかったんだけど、今日とりあえずリプライを実装した。
どうしてリプライを実装しなかったのか。
タイムラインの投稿の返信（リプライ）ボタンをポチッとクリックして、画面の向こうのたぶん面識のないひとに安直に話しかけることの距離感があやういから（わたしの場合）
返信するケースというのは、ほとんどの場合がマウント合戦だと思っていて、
「それ、おれ/わたしも知ってるー！」とか
「おれ/わたしはもうやってきたことだ」とか
「おれ/わたしの方が詳しい/当事者だよ！」とか
そこまでの関係性のない、あかの他人に話しかける動機というのはやっぱり、親近感とか共感だけではなくて、なにかが少し混じってビミョーに違ってると思う。
なので、SNSでやらかすのはこんな局面だろうと思ってるし、わたしもやらかしの返信をしてきたこともあり、リプライは危ないから実装をしない、とActivityPubサーバーを作り始めた時点で決めていた。
なんだけど。
Mentionをいただいて返事をする時に、ウチはリプライに未対応なのでリプライ要素のないJSONを返していた。投稿に対するリプライ要素があればツリー表示となるけど、リプライ要素がないJSONだと単品のMentionとして表示されるだけ（だと思う）
お相手にしてみると「あれ？なんだっけ？これ」ということになるだろうしなあ。
てことで、リプライ要素を付与したActivity（JSON）を返すように実装した。
ただし、返信（リプライ）ボタンを表示するのはMentionをいただいた投稿限定。
ホームタイムラインに流す投稿には表示しない。（わたしの場合）やらかす危険しかないから。
昨日実装した「転送」と今日実装した「リプライ」について、別サーバーの別アカを使って確認したところ、「意図通り」反映してるっぽい。
転送もリプライも、いろいろちょっと危ういんで、様子を見てながら運用する、ということで。
昨日、今日と2日続けてActivityPubサーバーをいじっててしみじみ。
やっぱ、ActivityPubも、それを実装するperlもめっちゃ面白い！
還暦過ぎの趣味、ボケ防止の趣味としては文句のつけようがないよなあ。
通り抜けた向こう側に光がある、という絵面。定番だし、やっぱ好きだわ。
» ローカル環境で電子書籍を作る、Macアプリ・Windows版ツール 「かんたんEPUB3作成easy_epub」
LWPでtimeout指定が効かない
自作実装のActivityPubサーバーから、フォロワーさんの所属しているリモートサーバーに投稿を送信する時に、お相手のリモートサーバーがなんらかの事情で落ちてるケースがある。
レスポンスは500番代のエラーとなる。
perlで定番のLWP UserAgentを使ってリクエストを投げてるんだけど。
400番代のエラーと違って、サーバーに問題が発生している500番のエラーの場合、返事が戻ってくるのに時間がかかる、待たされる。投稿するためのPOSTもアカウント情報取得のためのGETもなかなか戻ってこない。
デフォルトだと、リクエストを投げてお相手の反応が返ってくるまで180秒（3分）待つことになっている。
LWP::UserAgent - Web ユーザエージェントクラス
https://perldoc.jp/docs/modules/libwww-perl-6.04/LWP/UserAgent.pod
timeout( $secs )
秒単位のタイムアウト値を取得または設定します。 デフォルトのtimeout()の値は180秒、つまり3分です。
サーバへの接続においてtimeout秒反応がないと、リクエストは中断します。 つまり、トランザクションが完了してrequest()メソッドが実際に返るまでの 時間を意味します。
ということなのでtimeoutに10秒とか設定してみてたんだけど、どうもそれが効いてない。
検索したら、やっぱりtimeoutの指定は効かないことがあるらしい。
LWP::UserAgentのタイムアウトがうまく効かなかった事象の調査 (序章)
https://papix.hatenablog.com/entry/2020/12/25/180640
もう少し粘って検索してみると
lWP::UserAgentの「:content_cb」（コールバック）のサブルーチンでSIGNALを設定してalarmで対応できるという記事を発見。
LWP::UserAgent get callback with timeout
https://stackoverflow.com/questions/29071348/lwpuseragent-get-callback-with-timeout
リクエストをサブルーチンで処理することになるのが、素人のわたし的に難しそう…影響範囲がわからない。
思いつきでデフォルトを180秒にしたわけじゃあるまいし、なにか理由がありそう。それをここで指定しちゃうと、全部に影響するわけだしなあ、と。
てことで、それならリモートに投稿を送信するリクエストのサブルーチン限定にしてしまえば大丈夫っぽいんじゃないかと。
サブルーチン丸ごとSIGNALのALRMを設定してevalで捕まえることにした。
結果オーライとか、やっつけ仕事だけは昔から得意だし。
my $res = "";
eval{
local $SIG{ALRM} = sub{die "timeout";};
alarm $self->{timeout};
$res = $self->post_actpb({url=>$u, content=>$args->{json}});
alarm 0;
};
if( $@ ){
printf qq{ERROR deliver %s ::: %s}, $u, $@;
}
設定を15秒にしてみたら、意図通りにtimeoutをキャッチして、待ち時間が少なくなった。
ちゃんとしたActivityPubサーバーのMastodonなんかだと、リクエストの送受信は裏側でやってるんで、アクセスしてるユーザーが待たされることはないはず。
わたしの自作ActivityPubサーバーは最低限で、いろいろ手抜きしていて表示するだけのために3分以上待たされるんだよなあ。自業自得というか。
サーバーのお守り代わりの画像
（松戸市立博物館）
» ローカル環境で電子書籍を作る、Macアプリ・Windows版ツール 「かんたんEPUB3作成easy_epub」
perlの再帰でlocalの使い途
perlでディレクトリを辿ってファイルをリストする。
というのは File::Find というモジュールがあるのでそれを使えば一発で解決するんだけど。自分のモジュールに組み込む方法がよくわからず。
File::Find - ディレクトリツリーを辿る
https://perldoc.jp/docs/modules/File-Find-1.19/File/Find.pod
読んでもなんか使い勝手が違う、というかナニソレwanted？
てことで自分のモジュールで使えるものを自作。
「static」というディレクトリ以下にある、ホームページ用のhtmlファイルをリストアップする。というもの。以前から同じことをやってるスクリプトからの使い回しのサブルーチンの再帰。
use vars qw( $HTML );
〜〜〜〜〜
〜〜〜〜〜
sub parse_static{
my $self = shift;
my $args = shift;
my @dirs = ();
my $d = ($args->{dir} || 'static');
opendir(DIR, $d ) || die;
@dirs = grep(!/^\.\.?/, readdir(DIR));
closedir(DIR);
foreach my $f (sort @dirs){
if(-d $d . '/' . $f ){
$self->parse_static({dir=> sprintf(qq{%s/%s}, $d ,$f) });
}
else{
push(@{$HTML}, $d . '/' . $f) if $f =~ m!\.x?html!;
}
}
return $HTML;
}
1)ディレクトリ一覧を取得して
2)ファイルなら配列に放り込んで
3)ディレクトリなら(1)に戻る
というありがちなスクリプト。
…なんだけど、放り込む配列は use vars を使ってのグローバル変数。そうグローバル変数！なのが前から気に入らなかった。
もっと「かっこいい書き方」があるんじゃないかと。わたしのような野良、素人にとって「かっこいい」かどうかがポイント。
検索してみた。やっぱりこれも以前からちょっと気になってた my と local の違いがきっと魔法の種だと思ったらビンゴだった。
Perl で再帰呼出し時のスタック間データ共有
https://amachang.hatenablog.com/entry/20061010/1160506848
知りたかったのが、まさにこれ。かっちょええよなあ。
ダイナミックスコープとかレキシカルスコープとか意味は分からない、グローバル変数を局所化するとかも分からない。
けど、匂いでわかるかっこよさ。さっそくこのままいただいた（多謝！
sub parse_static{
my $self = shift;
my $args = shift;
my @dirs = ();
my $d = ($args->{dir} || 'static');
local $ongoldenpond::html = $ongoldenpond::html;
opendir(DIR, $d ) || die;
@dirs = grep(!/^\.\.?/, readdir(DIR));
closedir(DIR);
foreach my $f (sort @dirs){
if(-d $d . '/' . $f ){
$self->parse_static({dir=> sprintf(qq{%s/%s}, $d ,$f) });
}
else{
push(@{$ongoldenpond::html}, $d . '/' . $f) if $f =~ m!\.x?html!;
}
}
return $ongoldenpond::html;
}
おかげで、このサブルーチンの中だけで記述が完結することができた。
パッケージ名ongoldenpondというのは、わたしがここんとこどっぷりハマってる 個人ホームページ（On Golden Pond） 用のオレオレMovableTypeのスクリプトだから。
このブログ『ひまつぶし雑記帖』にはperlの小ネタもあるから、その手のも集めて、改めて個人ホームページに掲載するかなあ。
前にも書いたように、ここは日常雑記のために記法というか、書き込んだものを変換するけど、perlやhtmlのコードをそのまま掲載しても見づらいだけになってしまう。今さら変換規則を変えると過去25年以上の分全部に影響するんで、HTMLやperlのコードをそのまま掲載できる個人ホームページの方が見やすくなる。
ちょっと整理してみるか。
「よんでますよアザゼルさん」
アザゼル篤史とベルゼブブ優一
たぶん、今、こんなものTV放映したら大騒ぎだろう（最上の褒め言葉
» ローカル環境で電子書籍を作る、Macアプリ・Windows版ツール 「かんたんEPUB3作成easy_epub」
サブルーチンの確認
perlで自作したおひとり様ActivityPubサーバーはその後も増築改築をちまちま続けていて、例によってその場での思いつき、やっつけ仕事の現物合わせ仕様で、わけわかめ状態となっている。
Activityを約束事どおりに対応するモジュール（pmファイル）で、いったい何をしてるのか。
もうすでに忘れてる自分がいるので、サブルーチンの洗い出し用にテキトーなスクリプトをでっちあげた。という覚え書きが今回のエントリ。
#!/usr/bin/perl
use strict;
use utf8;
use Encode;
my $f = shift(@ARGV);
if(! -e $f ){
printf qq{Not Found pm %s\n}, $f;
exit;
}
open(IN, $f) || die;
my $name; my @buf=; close(IN);
foreach (@buf){
if( m!^sub (.+) *\{! ){
$name->{$1}++;
}
}
printf qq{sum : %s\n}, scalar( keys %{$name} );
foreach my $sub (sort keys %{$name}){
my $pm = join('', @buf);
my $cnt = $pm =~ s!$sub!!g;
printf qq{%s :\n}, $sub;
my @called; my $zzz;
if( $cnt > 1 ){
my $subname;
foreach (@buf){
if(m!^sub (.+) *\{!){
$subname = $1;
next;
}
if( m!\$self\-\>$sub! && !$zzz->{$subname}++ ){
push(@called, $subname);
}
}
}
printf qq{\t%s\n}, join("\t", sort @called);
}
・サブルーチンの総数
・サブルーチンの名前
・サブルーチンを呼び出しているサブルーチン
ぐらい見えれば、そこそこ役に立つかなあ、と。
文字列検索でひっかけてるだけで、signなんかはサブルーチン呼び出しじゃない部分にもヒットする。本当は動かしながらcaller()でチェックするのが確実…だけど、ざっくり見るだけのためにあちこちにcaller()を仕込むのはうっとーしいんで却下。
使い捨てのつもりで書いたスクリプトだけど、思ったよりちゃんと見えるようにしてくれたので自画自賛＆エントリとして書き起こし
10/4、ポケモンGOの対人戦GBLでACEに到達。
初期レートが1984で、ACE到達時のレートは2007。GBLで遊んでいて、ずっと継続してACEにたどり着いてたんだけど、前期初めてACEに到達できず、今期もやべえかなあ、と思ってたので、ほっとひと息。
まる6年続いているゲームで、まだ全然飽きないのがすげーす。
» ローカル環境で電子書籍を作る、Macアプリ・Windows版ツール 「かんたんEPUB3作成easy_epub」
