プレイリスト生成スクリプト: flv , aviが10分単位とかで分割されている場合はプレイするのがめんどくさいのでのプレイリスト生成するスクリプトを作成したのその後のバージョンアップ(漢数字対応)(モジュール使用)

#!/usr/local/bin/perl
#!/usr/bin/perl
#!/bin/perl
# ヽ（京）ﾉ
use Lingua::JA::Numbers qw/ ja2num /;
use DirHandle;
use constant MINUTE => 60;
use constant HOUR   => 60 * MINUTE;
use constant DAY    => 24 * HOUR;


use utf8;
use Jcode;
use Encode;

# ISO 6429
    use Term::ANSIColor qw(:constants);
    $Term::ANSIColor::AUTORESET = 1;


# --------------------------------------------------------------------
do 'config.pl';
do "$ENV{HOME}/autoytb.conf";
$DLDIR ||= '/tmp/';
$base = $DLDIR;
$playlist = 'playlist.pls';

$t = time;
$d = new DirHandle $base;
if (defined $d) {
    while (defined($_ = $d->read)) {
		print "\n";
		next if(/^\.\.?$/); # . .. ignore
		next unless(-d "$base$_"); # dir only
		print GREEN " --- playlist maker* $_";

		if(-f "$base$_/$playlist" ) {
			($write_time)=(stat("$base$_/$playlist"))[9];
			printf(GREEN . " --- exist($base$_/$playlist), " . CYAN . "%u days ago", ($t - $write_time)/DAY);
			
			next if(($t - $write_time)/DAY<2); # 2day?
		}
		print YELLOW " => do";
		&make_playlist("$base$_/");
	}
    undef $d;
}


# DIR のみ取り出す
sub make_playlist
{
	($dir) = @_;

	my %fhash = ();
	# ファイル...
	my $d = new DirHandle $dir;
	if (defined $d) {
   	 	while (defined($_ = $d->read)) {
			chomp;
			next if(/^\.\.?$/); # . .. ignore
			next unless(-f "$dir$_"); # file only
			next unless(/\.(avi|mpeg|flv|wmv|divx?|rm|asf|mov|mp4|3gp|mp3|aac|wma|swf)$/i); # . .. ignore

			# 変漢: $file は後で使う正しいファイル名
			my $file = $_;

			# 日本語数字 適当に対応
			s/１/1/g;
			s/２/2/g;
			s/３/3/g;
			s/４/4/g;
			s/５/5/g;
			s/６/6/g;
			s/７/7/g;
			s/８/8/g;
			s/９/9/g;
			s/０/0/g;

			# 漢数字
			$_ = kanji($_);

			# おまえらも結構ややこしいぜ
			s/①/_1_/g;
			s/②/_2_/g;
			s/③/_3_/g;
			s/④/_4_/g;
			s/⑤/_5_/g;
			s/⑥/_6_/g;
			s/⑦/_7_/g;
			s/⑧/_8_/g;
			s/⑨/_9_/g;
			s/⑩/_10_/g;
			s/⑪/_11_/g;
			s/⑫/_12_/g;
			s/⑬/_13_/g;
			s/⑭/_14_/g;
			s/⑮/_15_/g;
			s/⑯/_16_/g;
			s/⑰/_17_/g;
			s/⑱/_18_/g;
			s/⑲/_19_/g;
			s/⑳/_20_/g;

			# フェイク
			s/FIN(AL)?/_9999999999_/ig;
			s/END/_99999999_/ig;
			s/OP(enn)?(ing)?/_0_/ig;
			s/En?d(ing)?/_9999999_/ig;

			# 数値だけ抜き出し
			while(1)
			{
				/(\d+)/ or last;
				$fhash{$file} .= sprintf( "%032d", $1);
				$_ = $';
			}

			# 最後にファイル名添加して微妙な物を選別できる幼にする
			$fhash{$file} .= $file;

		}

	    undef $d;
	}

	# 数値のみでソーティング
	@keys = sort { $fhash{$a} cmp $fhash{$b} } keys %fhash;
	$entry=$#keys+1;

	# ファイルがなければ次へ
	unless(@keys)
	{
		print GREEN " => nofile ach so ";
		unlink "$dir$playlist" or do print RED "$dir$playlist ($!)." and do print GREEN "=>ok.";
		return;
	}
	
	print GREEN " => make";
	# playlist.pls として保存 nkfパイプ
	open PLS, "| nkf --cp932 -s | tee  \'$dir$playlist$$.work\'" or die $!;
	# plsファイル生成
	print PLS <<"_PLAYLIST_";
[playlist]
NumberOfEntries=$entry
Version=2
_PLAYLIST_

	$cnt = 1;
	foreach(@keys)
	{
		print PLS "File$cnt=$_\n";
		$cnt ++;
	}
	close PLS;

	rename "$dir$playlist$$.work","$dir$playlist" or die $!;

	print GREEN " => done.";
	return;
};
;



# --------------------------------------------------------------------
sub kanji
{
	my $RE_Numerals = $Lingua::JA::Numbers::RE_Numerals;
	my $name = shift;

	Encode::_utf8_on($name);
    $name  =~ s{ ($RE_Numerals)  }{ ja2num($1) }iegx;
	Encode::_utf8_off($name);

	return $name;
}