PerlでBOM付きUTF-16LE

修理に出したタブレットが戻ってきたが、全ての記憶を失って出荷状態になっていた。
そのセッティングをして、メインPCとのファイル共有を行った。
その結果、GOM PlayerでメインPCの中の動画ファイルを読めるようになってまずはめでたい。
しかしながら、普通のエクスプローラーで開いてファイルを探して、と言うのは面倒なので、各ディレクトリにそのディレクトリに入っている動画ファイルのasxファイルを作るようにしてみた。
asxファイルは、なんか動画ソフトで読み込める動画のリストフォーマットのようで、その実態はXMLだ。こんな感じ。

<asx version="3.0">
	<entry>
		<title>動画1のタイトル</title>
		<ref href="動画1の場所" />
	</entry>
	<entry>
		<title>動画2のタイトル</title>
		<ref href="動画2の場所" />
	</entry>
</asx>

場所については、そもそもhttpを想定しているので、href属性になっている模様。
で、これを各ディレクトリに一つ、各ディレクトリに含まれる全ての動画ファイルをリストアップして、この形式にまとめて保存するようにPerlでやってみたところ、文字コードがちょっと特殊だと言うことがわかった。

で、どうやるのかをGoogle先生に聞いてみたところ、こんな回答。
シフトJISからUTF-16へ変換 - 燈明日記
しかしここで気になる記述が。

Encodeモジュールのfrom_to関数で、なぜか、BOM付きリトルエディアンの指定が不明です。
知っている方、教えてください。(Supported.podを見ても分かりませんでした)

うひょー。しかし、Google先生にもう一度聞いたら、ロシアの宇宙鉛筆の如き回答が。
perlでUTF-16LE + BOM - あくる日

UTF-16LE + BOMってどう変換するのかがいまいち不明だ。そういうエンコードの指定がある訳ではなさそうだし。ということで、普通にUTF-16LEでencodeしてからBOMを付けることにした。

ああ、そうだよねー。うんうん、なければ出力してやればいいんだよねー。TMTOWTDIだよねー。

binmode( OUT );
print OUT pack('H*','fffe');

これでよかったよ、と。
あと、注意点としては、ファイルの場所はフルパス指定でなければならなかったことかな。
で、そうすると今度はネットワーク越しにasxファイルを読み込むとファイルが特定できなくて失敗すると言う。全然解決になってねー!

成果

use strict;
use warnings;
use Encode qw ( from_to );
use CGI qw ( -any );
use Cwd;
my $cwd = cwd();

my $q = CGI->new();

opendir ( DIR, '.' );
my @dirs = grep { -d $_ } grep { !/^\./ } readdir ( DIR );
closedir ( DIR );

foreach my $dir ( @dirs ) {
	opendir ( DIR, $dir );
	my @ob = map { $_ } grep { !/^\./ } readdir ( DIR );
	closedir ( DIR );
	
	my @list = ();
	foreach my $file ( @ob ) {
		$file =~ /airvideo/ and next;
		$file =~ /asx$/ and next;
		$file =~ /db$/ and next;
		push @list, $file;
	}

	my @line = ();

	open ( OUT, '>'.$dir."\\index.asx" );
	binmode ( OUT );
	print OUT pack('H*','fffe');
	push @line, $q->start_asx({version=>"3.0"});
	foreach my $file ( @list ) {
		my $title = $file;
		push @line, "\t".$q->start_entry();
			push @line, "\t\t".$q->title($title);
			push @line, "\t\t".$q->ref({href=>$cwd."\\".$dir."\\".$file});
#			push @line, "\t\t".$q->ref({href=>"\.\\".$file});
		push @line, "\t".$q->end_entry();
	}
	push @line, $q->end_asx();

	my $line = join ( "\r\n", @line );

	from_to(
		$line,
		"shift_jis",
		"UTF-16LE"
	);
	print OUT $line;
	close ( OUT );
}