#!/usr/bin/perl
# -d:SmallProf
#use Perl6::Slurp;
#use XML::Simple;
#use CGI;
#use CGI::Lite;
#use Date::Manip;
#Date_Init("TZ=JST","ConvTZ=JST");
#use SVG;
#use KCatch;
use warnings;
use utf8;
use Algorithm::Diff qw(LCS);
use Archive::Zip;
use CGI;
use CGI::Carp qw( fatalsToBrowser warningsToBrowser );
use Config::Simple;
use Data::Dumper::Concise;
use Date::Simple;
use DateTime;
use DBI;
use Encode;
use File::Slurp;
use List::Compare;
use List::Util;
use MIME::Base64;
use Sort::Naturally;
use SVG;
use Time::Piece;
use Time::Seconds;
use Time::HiRes;
use Tie::IxHash;
use XML::Atom::Feed;
use XML::Atom::Entry;
use XML::Generator::DBI;
use XML::SAX::Writer;
use XML::TreePP;
#%DB::packages = ( 'main' => 1 );


################ バージョン定義 ################


my $rectool_version = 102;


################ 初期化ここから ################


my $tz = DateTime::TimeZone->new( name => 'local' );
my $hires = Time::HiRes::time();

my $cfg = new Config::Simple;
if ( -e 'rec10.conf' ) {
	$cfg->read( 'rec10.conf' );
}
elsif ( -e '/etc/rec10.conf' ) {
	$cfg->read( '/etc/rec10.conf' );
}
else { 
	die 'rec10.confが見つかりません。';
}

my $sql = $cfg->param( 'db.db' );

if ( $sql eq 'MySQL' ) {
	my $name = $cfg->param( 'db.mysql_dbname' );
	my $host = $cfg->param( 'db.mysql_host' );
	my $port = $cfg->param( 'db.mysql_port' );
	my $user = $cfg->param( 'db.mysql_user' );
	my $pass = $cfg->param( 'db.mysql_passwd' );
	$dbh = DBI->connect("dbi:mysql:$name:$host:$port", $user, $pass, {
		AutoCommit => 1,
		RaiseError => 1,
		mysql_enable_utf8 => 1, # only availavle for MySQL
	});
	$dbh->do( 'SET NAMES utf8' );
}

my $rec10_version = eval {
	$dbh->selectrow_array( "SELECT version FROM in_status " );
};

my $HTML;

$HTTP_HEADER = "Content-Type: text/html\n\n";
$HTML .= <<EOM;
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
<html lang="ja">
<head>
<title>Rec10%HTML_TITLE_OPT%</title>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
<meta http-equiv="Content-Script-Type" content="text/javascript">
<meta http-equiv="Content-Style-Type" content="text/css">
<meta name="robots" content="noindex,nofollow,noarchive">
<link rev="made" href="Rea10">
<link rel="alternate" type="application/atom+xml" title= "Rec10 Atom Feed" href="./rectool.pl?mode=atom">
%REFRESH%
%SCRIPT%
%CSS%
</head>
<body>
%HTML_HEADER%
EOM

my ( $user, $pass, $auth );
( $user, $pass ) = eval {
	$dbh->selectrow_array( "SELECT webuser, webpass FROM in_settings " );
};

if ( $user and $pass ) {
	if ( $ENV{'HTTP_AUTHORIZATION'} ) {
		my ( $base64 ) = $ENV{'HTTP_AUTHORIZATION'} =~ /Basic\s(.*)/;
		if ( $base64 eq encode_base64( "$user:$pass" ) ) {
			$auth = 1;
		}
		else {
			$auth = 0;
		}
	}
	else {
		$auth = 0;
	}
}
else {
	$auth = 1;
}

if ( !$auth ) {
	my ( $base64 ) = $ENV{'REMOTE_USER'} =~ /Basic (.*)/;
	$HTTP_HEADER = qq {Status: 401 Authorization Required\nWWW-Authenticate: Basic realm="Protected Rec10 $ENV{'HTTP_AUTHORIZATION'}"\n} . $HTTP_HEADER;
	goto end;
}

if ( $rec10_version != $rectool_version ) {
	$HTML .= qq {<div style="font-size: 200%; font-weight: bold; color: red">\n};

	if ( $rec10_version > $rectool_version ) {
		$HTML .= qq {Rec10本体のバージョンが新しいため、実行できません。<br>\n};
		$HTML .= qq {rectoolのバージョンアップを行ってください。<br>\n};
	}

	if ( $rec10_version < $rectool_version ) {
		$HTML .= qq {Rec10本体のバージョンが古いため、実行できません。<br>\n};
		$HTML .= qq {Rec10のバージョンアップを行ってください。<br>\n};
	}

	$HTML .= qq {Rec10のバージョンは$rec10_version 、rectoolのバージョンは$rectool_version です。<br>\n};
	$HTML .= qq {<a href="http://sourceforge.jp/projects/rec10/">公式ページ</a>\n};
	goto end;
}

$q = new CGI;
%params = $q->Vars;
$mode = $params{ 'mode' };
$mode_sub = $params{ 'mode_sub' };

################ %chtxt_chnameの準備 ################

my %chtxt_chname;
my %chtxt_0_chname;
tie %chtxt_0_chname, 'Tie::IxHash';

my $ary_ref = $dbh->selectall_arrayref(
	"SELECT chtxt, chname, ch, bctype FROM epg_ch
	WHERE visible = 1
	AND chname != ''
	ORDER BY chtxt"
);

%chtxt_chname = map { $_->[0], $_->[1] } @{$ary_ref};

# te: 地上波
# bc: BS、CS
my @te_ary = grep $_->[0]=~ /^\d/, @{$ary_ref};
my @bc_ary = grep $_->[0]!~ /^\d/, @{$ary_ref};

# teの操作(まとめる)
foreach my $line ( @te_ary ) {
	# te xx_yyyy(chtxt) -> xx(ch)
	if ( $line->[3] =~ /te/ ) {
		push @{ $chtxt_0_chname{        $line->[2] . '_0'} }, $line->[1];
	}
	else {
		push @{ $chtxt_0_chname{'BS_' . $line->[2]       } }, $line->[1];
	}
}
foreach my $key ( keys %chtxt_0_chname ) {
	my @chname = @{ $chtxt_0_chname{$key} };
	if ( @chname >= 2 ) {
		# 2つ以上ある場合
		my @tmp = map { my @ary = split //, $_; \@ary } @chname;
		# 1つ目と2つ目のみ比較
		# FIXME: すべてを比較するべき
		$chtxt_0_chname{$key} = join '', LCS( $tmp[0], $tmp[1] );
	}
	else {
		# 1つしかない場合
		$chtxt_0_chname{$key} = $chname[0];
	}
}

# bs/csの操作(そのまま)
foreach my $line ( @bc_ary ) {
	$chtxt_0_chname{$line->[0]} = $line->[1];
}
undef $ary_ref;


################ 定数宣言 ################


tie %type, 'Tie::IxHash';
%type = (
	'search_everyday'          => '隔日検索',
	'search_today'             => '当日検索',
	'reserve_flexible'         => '浮動予約',
	'reserve_fixed'            => '確定予約',

	'reserve_running'          => '録画途中',

	'convert_b25_ts'           => '解読予約',
	'convert_b25_ts_running'   => '解読途中',
	'convert_b25_ts_miss'      => '解読失敗',

	'convert_ts_mp4'           => '縁故予約',
	'convert_ts_mp4_running'   => '縁故於鯖',
	'convert_ts_mp4_network'   => '縁故於網',
	'convert_ts_mp4_finished'  => '縁故完了',

	'convert_avi_mkv'          => '変換旧露',
	'convert_avi_mp4'          => '変換旧四',
	'convert_mkv_mp4'          => '変換露四',
	'convert_mkv_mp4_runnings' => '換途露四',

	'auto_suggest_dec'         => '予測解読',
	'auto_suggest_enc'         => '予測縁故',
	'auto_suggest_avi2fp'      => '予測旧四',
	'auto_suggest_ap2fp'       => '予測露四',

	'move_end'                 => '移動完了',
);

%type_suggest = (
	'auto_suggest_dec'    => 'convert_b25_ts',
	'auto_suggest_enc'    => 'convert_ts_mp4',
	'auto_suggest_avi2fp' => 'convert_avi_mkv',
	'auto_suggest_ap2fp'  => 'convert_mp4_mkv',
);

%color = (
	'search_everyday'        => '#8B008B',
	'search_today'           => '#8B008B',
	'reserve_flexible'       => '#4169E1',
	'reserve_fixed'          => '#4169E1',
	'reserve_running'        => '#FF8C00',
	'convert_b25_ts'         => '#CD5C5C',
	'convert_b25_ts_running' => '#DC143C',
	'convert_ts_mp4'         => '#32CD32',
	'convert_ts_mp4_running' => '#2E8B57',
	'convert_ts_mp4_network' => '#808000',

	'other'                  => '#A0A0A0',
);

$type_user_made = "( 'search_everyday', 'search_today', 'reserve_flexible', 'reserve_fixed', 'reserve_running' )";

tie %category, 'Tie::IxHash';
%category = (
	'news'        => { name => 'ニュース・報道'          , color => '#ff0000' }, 
	'sports'      => { name => 'スポーツ'                , color => '#ff8000' }, 
	'information' => { name => '情報'                    , color => '#ffff00' }, 
	'drama'       => { name => 'ドラマ'                  , color => '#80ff00' }, 
	'music'       => { name => '音楽'                    , color => '#00ff00' }, 
	'variety'     => { name => 'バラエティ'              , color => '#00ff80' }, 
	'cinema'      => { name => '映画'                    , color => '#00ffff' }, 
	'anime'       => { name => 'アニメ・特撮'            , color => '#0080ff' }, 
	'documentary' => { name => 'ドキュメンタリー・教養'  , color => '#0000ff' }, 
	'stage'       => { name => '演劇'                    , color => '#8000ff' }, 
	'hobby'       => { name => '趣味・実用'              , color => '#ff00ff' }, 
	'welfare'     => { name => '福祉'                    , color => '#ff0080' }, 
	'reserved'    => { name => '予備'                    , color => '#808080' }, 
	'etc'         => { name => 'その他'                  , color => '#808080' }, 
);

################ 初期化ここまで ################


################ mode=schedule ################

if ( $mode eq 'schedule' ) {

	$HTML =~ s/%HTML_TITLE_OPT%/ - Schedule Viewer/;
	#$HTML =~ s|%REFRESH%|<meta http-equiv="refresh" content="300">|;
	$css = <<EOM;
		<style type="text/css">
		td {
			white-space: nowrap;
		}
		</style>
EOM
	$css =~ s/^\t{2}//gm;
	$HTML =~ s/%CSS%/$css/;

	my $order = $params{ 'order' };
	my $extra = $params{ 'extra' };
	if ( $order ne 'id' ) {
		$order = 'btime';
	}
	$reverse_extra = $extra            ? '' : '&amp;extra=1';
	$forward_order = $order eq 'btime' ? '' : '&amp;order=id';

	my $ary_ref = $dbh->selectall_arrayref(
		"SELECT id, type, timeline.chtxt, epg_ch.chname, title, btime, etime, opt, deltaday, deltatime, 
		epgtitle, epgbtime, epgetime, epgexp, epgduplicate, epgchange, counter 
		FROM timeline 
		LEFT OUTER JOIN epg_ch ON timeline.chtxt = epg_ch.chtxt 
		ORDER BY $order"
		, {Slice=>{}});

	$HTML .= qq {<div style="font-size: 80%; float: left">\n};
	$HTML .= qq {<form method="get" action="rectool.pl">\n};
	$HTML .= qq {<div>\n};
	$HTML .= qq {<input type="hidden" name="mode" value="change">\n};
	$HTML .= qq {<table summary="rectimetable" border=1 cellspacing=0>\n<tr>\n};
	$HTML .= qq {<th><a href="rectool.pl?mode=schedule$forward_order$reverse_extra">■</a></th>\n};
	$HTML .= qq {<th><a href="rectool.pl?mode=schedule&amp;order=id">ID</a></th>\n};
	$HTML .= qq {<th>タイプ</th>\n};
	$HTML .= qq {<th>チャンネル</th>\n};
	$HTML .= qq {<th>タイトル</th>\n};
	$HTML .= qq {<th><a href="rectool.pl?mode=schedule">開始時刻</a></th>\n};
	$HTML .= qq {<th>終了時刻</th>\n};
	$HTML .= qq {<th>録画時間</th>\n};
	$HTML .= qq {<th>オプション</th>\n};
	$HTML .= qq {<th>dd</th>\n};
	$HTML .= qq {<th>dt</th>\n};
	$HTML .= qq {<th>残り</th>\n};
	$HTML .= qq {</tr>\n};
	foreach my $line ( @{ $ary_ref } ) {

		$type = $type{$line->{type}} || $line->{type};
		if    ( $line->{type} =~ /^search/ ) {
			$type = qq {<span style="color: #8B008B">$type</span>};
			$line->{deltaday} = qq {<span style="color: #FF0000">空</span>} if ( !$line->{deltaday} && $line->{type} eq 'search_everyday' );
			$line->{deltatime} = qq {<span style="color: #FF0000">空</span>} if ( !$line->{deltatime} );
		}
		else {
			my $color = $color{$line->{type}} ? $color{$line->{type}} : $color{'other'};
			$type = qq {<span style="color: $color">$type</span>};
		}
		# 地上波の場合、xx_yyyをxx_0に置換する
		( $line->{chtxt_0} = $line->{chtxt} ) =~ s/(\d+)_/$1_0/;
		# chnameが無いとき(移動縁故など)、chtxtを代わりに使う
		$line->{chname} = 
			$line->{chname} || 
			$chtxt_0_chname{$line->{chtxt}} || 
			$chtxt_0_chname{$line->{chtxt_0}};
		if ( !$line->{chname} ) {
			# chnameが無いとき、リンクを作成しない
			$line->{chname} = $line->{chtxt};
			$line->{chname_link} = qq {$line->{chname}</a>};
		}
		else {
			$line->{chname_link} = qq {<a href="rectool.pl?mode=program&amp;chtxt=$line->{chtxt}">$line->{chname}</a>};
		}
		$line->{title} = 'タイトルなし' if ( !$line->{title} );
		$line->{tr_style} = '';
		$line->{title_2} = '';
		my $unix_b = str2datetime( $line->{btime} );
		my $unix_e = str2datetime( $line->{etime} );

		my $btime = $unix_b->strftime( '%Y%m%d%H%M%S' );
		my $etime = $unix_e->strftime( '%Y%m%d%H%M%S' );
		if ( $extra and $line->{type} =~ /^search_|^reserve_(?!running)/ ) {
			#my @ary = $dbh->selectrow_array(
			#	"SELECT title, exp FROM epg_timeline 
			#	WHERE channel = '$line->{chname}' 
			#	AND start = '$btime' 
			#	AND stop  = '$etime' ");
			#my @ary = ( $line->{epgtitle}, $line->{epgexp} );
			my ( $epgtitle, $epgexp ) = ( $line->{epgtitle}, $line->{epgexp} );

			if ( $epgtitle ) {
				$epgtitle =~ s/無料≫//;

				if ( $epgtitle ne $line->{title} ) {
					# epgtitleとtitleが一致しない
					# []に囲まれた部分を除去して比較
					my @brackets = $line->{title} =~ /(\[.+\])+/;
					my $epgtitle_nobrackets = $epgtitle;
					my $title_nobrackets = $line->{title};
					if ( @brackets && $epgtitle =~ /(\[.+\])+/ >= @brackets ) {
						foreach ( @brackets ) {
							$epgtitle_nobrackets =~ s/\Q$_\E//;
						}
					}
					$title_nobrackets =~ s/(\[.+\])+//;
					if ( !scalar $epgtitle_nobrackets =~ s/\Q$title_nobrackets\E// ) {
						# epgtitleにtitleが含まれていない
						my $href  = qq {<a href="rectool.pl?mode=edit&amp;id=$line->{id}&amp;suggest=auto">自動検索</a>};
						$epgtitle = qq {<span style="color: #FF4000">$epgtitle■$href■</span>};
					}
					else {
						# epgtitleにtitleが含まれている
						$epgtitle = $epgtitle_nobrackets;
					}
				}
				else {
					# epgtitleとtitleが一致している
					$epgtitle = '説明';
				}

				$line->{title_2} = qq {<div style="float: right; cursor: help" title="$epgexp">$epgtitle</div>};
			}
			else {
				# epgtitleがない
				my $href    = qq {<a href="rectool.pl?mode=edit&amp;id=$line->{id}&amp;suggest=auto">自動検索</a>};
				$line->{title_2}  = qq {<span style="float: right; color: #FF0000">■$href■</span>};
				$line->{tr_style} = qq {style="background-color: #A0A0A0"};
			}
		}

		my ( $begin, $end, $diff ) = &str2readable( $unix_b, $unix_e );

		my $hr = '';
		if ( 
			$line->{type} eq 'reserve_running' 
				&&
			$unix_b->epoch <= time && time <= $unix_e->epoch
		)
		{
			$percent = int( ( 100 * ( time - $unix_b->epoch ) ) / ( $unix_e->epoch - $unix_b->epoch ) );
			$hr .= qq {<hr style="margin: 0 auto 0 0; height: 4px; width: $percent%;};
			$hr .= qq { background-color: blue; border: none" title="$percent%">};
		}

		$line->{title} = qq {<a href="rectool.pl?mode=edit&amp;id=$line->{id}">$line->{title}</a>};
		#$line->{title} = qq {<div style="float: left">$line->{title}</div>} if ( $line->{title_2} );
		$HTML .= qq {<tr align="center" $line->{tr_style}>\n};
		$HTML .= qq {<td><input type="checkbox" name="id" value="$line->{id}"></td>\n};
		$HTML .= qq {<td>$line->{id}</td>\n};
		$HTML .= qq {<td>$type</td>\n};
		$HTML .= qq {<td>$line->{chname_link}</td>\n};
		$HTML .= qq {<td align="left" style="white-space: normal">$line->{title}$line->{title_2}</td>\n};
		$HTML .= qq {<td>$begin</td>\n<td>$end</td>\n};
		$HTML .= qq {<td>$hr$diff</td>\n};
		$HTML .= qq {<td>$line->{opt}</td>\n<td>$line->{deltaday}</td>\n<td>$line->{deltatime}</td>\n<td>$line->{counter}</td>\n};
		$HTML .= qq {</tr>\n};
	}
	$HTML .= qq {</table>\n};
	#$HTML .= qq {<input type="submit" name="edit" value="編集(要JS)">\n};
	$HTML .= qq {<input type="submit" name="delete" value="削除">\n</div>\n</form>\n};
	goto end;
}

################ mode=graph ################

if ( $mode eq 'graph' ) {

	my $date = $params{ 'date' };

	if ( $date )
	{
		print "Content-Type: image/svg+xml\n\n";

		$date = Date::Simple->new( split /-/, $date );
		$graph_bgn = $date->format('%Y-%m-%d');
		$graph_end = $date->next->format('%Y-%m-%d');
		$day = $date->day;
		$today = $date eq Date::Simple->today() ? 1 : 0;

		$tuner{terrestrial} = $cfg->param( 'env.te_max'   );# 2;
		$tuner{satellite}   = $cfg->param( 'env.bscs_max' );# 2;
		$tuner{all} = $tuner{terrestrial} + $tuner{satellite};
		$hours = 24;
		$width = 30 * $hours;
		my %category_color = map { $_->{name}, $_->{color} } values %category;

		$svg = new SVG( width => 820, height => $tuner{all} * 20 + 40 );
		$svg->rectangle( 'x' => 40, 'y' => 20, 
			width => $width + 20, height => $tuner{all} * 20 + 10, 
			rx => 15, ry => 15, 
			style => { stroke => 'blue', fill => 'white' } );
		for ( 1..$tuner{terrestrial} ) {
			$svg->text( 'x' => 10, 'y' => ( $_ + 1 ) * 20 )
				->cdata( "T$_" );
		}
		for ( 1..$tuner{satellite} ) {
			$svg->text( 'x' => 10, 'y' => ( $_ + $tuner{terrestrial} + 1 ) * 20 )
				->cdata( "S$_" );
		}
		for ( 0..$hours ) {
			$svg->text( 'x' => $_ * 30 + 65, 'y' => 15, 
				style => { 'text-anchor' => 'middle' } )
				->cdata( sprintf( '%02d', $_ ) ) if ( $_ < $hours );
			# $svg->line( ); # can't be used when required
			$svg->tag( 'line', x1 => $_ * 30 + 50, x2 => $_ * 30 + 50, y1 => 30, y2 => $tuner{all} * 20 + 20, 
				style => { stroke => 'gray' } );
		}
		for ( 1..$tuner{all} ) {
#			$svg->tag( 'line', x1 =>50, x2 => 50 + $width, y1 => $_ * 20 + 10, y2 => $_ * 20 + 10, 
#				style => { stroke => 'gray' } );
#			$svg->rectangle( 'x' => 50, 'y' => $_ * 20 + 10, width => $width, height => 10 );
			$svg->rectangle( 'x' => 50, 'y' => $_ * 20 + 14, width => $width, height => 2 );
		}
		if ( $today ) {
			my $time = Time::Piece->localtime;
			my $x = ( $time->hour * 60 + $time->minute ) * 0.5 + 50;
			$svg->tag( 'line', x1 => $x, x2 => $x, y1 => 30, y2 => $tuner{all} * 20 + 20, 
				style => { stroke => 'red', 'fill-opacity' => '1.0' } );
		}
		my $ary_ref = $dbh->selectall_arrayref(
			#	epg_timeline.channel = timeline.chtxt && 
			"SELECT id, title, chtxt, btime, etime, epgcategory, opt FROM timeline 
			WHERE type IN $type_user_made 
			AND 
			(
				'$graph_bgn 00:00' <= btime AND btime <  '$graph_end 00:00'
					OR
				'$graph_bgn 00:00' <  etime AND etime <= '$graph_end 00:00'
			)
			ORDER BY btime"
			, {Slice=>{}}
		);

		foreach my $bctype ( '\d+_', 'S_' ) {
			my $tuner = $bctype eq '\d+_' ? $tuner{terrestrial} : $tuner{satellite};
			my @ary_ref = grep { $_->{chtxt} =~ /$bctype/ } @{ $ary_ref };
			my @y_drawn = ('') x $tuner;
			foreach my $line ( @ary_ref ) {
				@start = $line->{btime} =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2})/;
				@stop  = $line->{etime} =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2})/;
				$start = ( ( $day == $start[2] ? 0 : 24 * 60 ) + $start[3] * 60 + $start[4] ) * 0.5;
				$stop  = ( ( $day == $stop [2] ? 0 : 24 * 60 ) + $stop [3] * 60 + $stop [4] ) * 0.5;
				$start = 0      if ( $start < 0 || $day > $start[2] ); # 月の変わり目はスルー
				$stop  = $width if ( $stop  > $width );
				$begin = $line->{btime};
				$end   = $line->{etime};

				my @ary = grep { ( $_->{etime} cmp $line->{btime} ) > 0 and ( $_->{btime} cmp $line->{etime} ) < 0 and $_->{id} != $line->{id} } @ary_ref;
				foreach my $i ( 0..$tuner - 1 ) {
					next if ( ( $y_drawn[$i] cmp $line->{btime} ) > 0 );
					#for ( 'chtxt', 'btime', 'etime' ) {
					#	$f = 0 if ( $line->{$_} ne $ary[$i]->{$_} );
					#}
					$line->{slot} = $i;
					$y_drawn[$i] = $line->{etime};
					last;
				}
				my ( $r, $g, $b ) = ( 0, 0, 0 );
				$r += 255 if ( $line->{opt} =~ /a/ );
				$g += 255 if ( $line->{opt} =~ /H/ );
				$b += 255 if ( $line->{opt} =~ /I/ );
				if ( $r + $g + $b == 255 * 3 ){
					$r = 0;
					$g = 255;
					$b = 255;
				}
				if ( $r + $g + $b == 0 ){
					$r = $g = $b = 128;
				}
				my %escaped = ( '&' => 'amp', '<' => 'lt', '>' => 'gt', '"' => 'quot' );
				sub html_escape{
					my $str = shift or return;
					my $result = '';
					$result .= $escaped{$_} ? '&' . $escaped{$_} . ';' : $_
						for (split //, $str);
					$result;
				}
				$svg->anchor(
					-href  => "rectool.pl?mode=edit&amp;id=$line->{id}",
					target => '_blank',
					-title => html_escape( $line->{title} ),
				)->rectangle( 
					'x' => 50 + $start, 
					'y' => 30 + ( $bctype eq '\d+_' ? 0 : $tuner{terrestrial} * 20 ) + $line->{slot} * 20, 
					width  => $stop - $start, 
					height => 10, 
					style  => { fill => $category_color{$line->{epgcategory}} || $category_color{'その他'} } );
					#style  => { fill => "rgb($r,$g,$b)" } );
			}
		}
		my $xml = $svg->xmlify;
		utf8::encode( $xml );
		print $xml;
		#warningsToBrowser(true);
		exit;
	}
	else
	{
		$HTML =~ s/%HTML_TITLE_OPT%/ - Schedule Viewer - Graphical/;
		$HTML .= qq {<div style="float: left">\n};
		# $base64 = encode_base64( $svg->xmlify );
		# $HTML .= qq {<object data="data:image/svg+xml;base64,$base64">\n</object>\n};
		$HTML .= qq {予約状況一覧です。T1,T2は地上波、S1,S2はBS/CSを示しています。<br>\n};
		$HTML .= qq {SVGが利用可能なブラウザでご覧ください。<br>\n};
		$HTML .= qq {色とジャンルの対応\n};
		map { 
			$HTML .= qq {<span style="background: $_->{color}; top: 10px; left: 250px;">$_->{name}</span>\n};
		} values %category;
		$HTML .= qq {<br>\n};

		$ary_ref = $dbh->selectcol_arrayref(
			"SELECT DISTINCT DATE( btime ) 
			FROM timeline 
			WHERE type in $type_user_made 
			ORDER BY btime"
		);
		foreach my $date ( @{ $ary_ref } ) {
			my @date = $date =~ /(.{4})-(.{2})-(.{2})/;
			my $dn = DateTime->new( year => $date[0], month => $date[1], day => $date[2], locale => 'ja_JP' )->day_name;
			#utf8::encode( $dn );
			$HTML .= qq {$date[1]/$date[2]($dn)の予約状況<br>\n};
			# <img src="">
			$HTML .= qq {<object type="image/svg+xml" data="rectool.pl?mode=graph&amp;date=$date" width="820">\n};
			$HTML .= qq {SVG Image $date\n</object>\n<br>\n};

			$date2 = Date::Simple->new( @date )->next->format('%Y-%m-%d');
			my $ary_ref = $dbh->selectall_arrayref(
				"SELECT chtxt, title, btime, etime FROM timeline 
				WHERE '$date 00:00' <= btime AND etime <= '$date2 01:00'
				ORDER BY btime"
			);

			foreach my $line ( @{ $ary_ref } ) {
				#$HTML .= qq {$line->[0] $line->[1] $line->[2] $line->[3]<br>\n};
			}

		}

		goto end;
	}
}

################ mode=atom ################

if ( $mode eq 'atom' ) {
	my $recording_count = $encoding_count = $jbk_count = 0;
	my $ary_ref = $dbh->selectall_arrayref(
		"SELECT chtxt, title, btime, etime, opt 
		FROM timeline 
		WHERE type = 'reserve_running' ");
	foreach my $line ( @{$ary_ref} ) {
		my ( $begin, $end, $diff ) = &str2readable( $line->[2], $line->[3] );
		$recording_status .= qq {$line->[0] $line->[1] $begin - $end $diff $line->[4]<br />\n};
		$recording_count++;
	}
	$ary_ref = $dbh->selectall_arrayref(
		"SELECT chtxt, title, btime, etime, opt 
		FROM timeline 
		WHERE type = 'convert_ts_mp4_running' ");
	foreach my $line ( @{$ary_ref} ) {
		my ( $begin, $end, $diff ) = &str2readable( $line->[2], $line->[3] );
		$encoding_status .= qq {$line->[0] $line->[1] $begin - $end $diff $line->[4]<br />\n};
		$encoding_count++;
	}
	$ary_ref = $dbh->selectall_arrayref(
		"SELECT id, chtxt, title, btime, etime 
		FROM auto_timeline_keyword " );
	foreach my $line ( @{$ary_ref} ) {
		my ( $begin, $end, $diff ) = &str2readable( $line->[3], $line->[4] );
		$jbk_status .= qq {$line->[0] $line->[1] $line->[2] $begin - $end $diff<br />\n};
		$jbk_count++;
	}

	my $feed = XML::Atom::Feed->new( Version => 1.0 );
	$feed->title('Rec10 フィード');

	my $entry = XML::Atom::Entry->new( Version => 1.0 );
	$entry->title("Rec10 録画状況 ($recording_count)");
	$entry->id('tag:recording_status');
	$entry->content($recording_status);
	$entry->add_link(str_to_link( './rectool.pl?mode=schedule' ) );
	$feed->add_entry($entry);

	$entry = XML::Atom::Entry->new( Version => 1.0 );
	$entry->title("Rec10 縁故状況 ($encoding_count)");
	$entry->id('tag:encoding_status');
	$entry->content($encoding_status);
	$entry->add_link(str_to_link( './rectool.pl?mode=schedule' ) );
	$feed->add_entry($entry);

	$entry = XML::Atom::Entry->new( Version => 1.0 );
	$entry->title("Rec10 地引状況 ($jbk_count)");
	$entry->id('tag:jbk_status');
	$entry->content($jbk_status);
	$entry->add_link(str_to_link( './rectool.pl?mode=jbk' ) );
	$feed->add_entry($entry);

	my $xml = $feed->as_xml;
	print "Content-Type: application/atom+xml\n\n";
	print $xml;
	exit;

	sub str_to_link {
		my $link = XML::Atom::Link->new( Version => 1.0 );
		$link->type('text/html');
		$link->rel('alternate');
		$link->href(shift);
		return $link;
	}
}

################ mode=edit ################

if ( $mode eq 'edit' ) {
	my $id = $params{ 'id' };

	$HTML =~ s/%HTML_TITLE_OPT%/ - Schedule Editor/;
	$HTML .= qq {<div style="float: left">\n};

	$script = <<EOM;
		<script type="text/javascript" src="http://www.enjoyxstudy.com/javascript/dateformat/dateformat.js">
		</script>
		<script type="text/javascript">
		function setType(value){
			var index = document.reserve.type.selectedIndex;
			var value = document.reserve.type[index].value;
			if ( value == 'search_everyday' ) {
				document.reserve.deltaday.value  = 7;
				document.reserve.deltatime.value = 3;
			}
			if ( value == 'convert_b25_ts' || value == 'convert_ts_mp4' ){
				var date       = new Date();
				var dateFormat = new DateFormat("yyyy-MM-dd HH:mm:ss");
				var minutes    = date.getMinutes();
				minutes = minutes - minutes % 5 + 10;
				date.setMinutes(minutes, 0, 0);
				document.reserve.begin.value = dateFormat.format(date);
				date.setSeconds( date.getSeconds() + 3600 );
				document.reserve.end.value   = dateFormat.format(date);
			}
		}
		function setSuggest(start, stop){
			document.reserve.begin.value = start;
			document.reserve.end.value   = stop;
		}
		function shiftEndTime(value){
			var dateFormat = new DateFormat("yyyy-MM-dd HH:mm:ss");
			var date = dateFormat.parse(document.reserve.end.value || document.reserve.begin.value);
			date.setSeconds( date.getSeconds() + value );
			document.reserve.end.value = dateFormat.format(date);
		}
		</script>
EOM
	$script =~ s/^\t{2}//gm;
	$HTML =~ s/%SCRIPT%/$script/;

	$HTML .= "スケジュール編集画面です。<br>\n";
	$HTML .= "実装がとても適当なので、利用には細心の注意を払ってください。<br>\n<br>\n";
	if ( $id ) {
		# 予約の編集
		&parse_program();
		$button_bgn = $button_end = '';
	}
	else {
		# 新規予約
		$type = 'reserve_flexible';
		$counter = -1;
		$datetime_now = DateTime->now( time_zone => $tz )->set_second( 0 )->add( minutes => 1)->strftime( '%Y-%m-%d %H:%M:%S' );
		$button_bgn = qq{<button type="button" onClick="document.reserve.begin.value='$datetime_now'">現在</button>\n<br>\n};
		$button_end = 
			 qq{<button type="button" onClick="document.reserve.end.value=document.reserve.begin.value">一致</button>}
			.qq{<button type="button" onClick="shiftEndTime(300);">+5m</button>}
			.qq{<button type="button" onClick="shiftEndTime(1800);">+30m</button>};
	}

	if ( $params{ 'suggest' } eq 'auto' ) {
		my @btime = $begin =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/;
		my @etime = $end   =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/;
		my $btime = DateTime->new(
			year => $btime[0], month  => $btime[1], day    => $btime[2],
			hour => $btime[3], minute => $btime[4], second => $btime[5], 
		);
		my $etime = DateTime->new(
			year => $etime[0], month  => $etime[1], day    => $etime[2],
			hour => $etime[3], minute => $etime[4], second => $etime[5], 
		);
		my %hash = &sqlgetsuggested( $btime, $etime );

		$HTML .= qq {可能性のある番組<br>\n};
		$HTML .= qq {<table summary="suggesttable" border=1 cellspacing=0>\n<tr>\n};
		$HTML .= qq {<th>優先度</th>\n};
		$HTML .= qq {<th>タイトル</th>\n};
		$HTML .= qq {<th>開始時刻</th>\n};
		$HTML .= qq {<th>終了時刻</th>\n};
		$HTML .= qq {<th>説明</th>\n};
		$HTML .= qq {<th>適用</th>\n};
		$HTML .= qq {</tr>\n};

		foreach my $key (sort keys %hash){
			my $val = $hash{$key};
			foreach my $val ( @{$val} ) {
				my $style = qq {style="white-space: nowrap"};
				$val->[0] =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/;
				$val->[1] =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/;
				$HTML .= qq {<tr>\n<td>$key</td>\n<td>$val->[2]</td>\n};
				$HTML .= qq {<td $style>$val->[0]</td>\n<td $style>$val->[1]</td>\n<td>$val->[3]</td>\n};
				$HTML .= qq {<td><button onClick="setSuggest('$val->[0]','$val->[1]');">適用</button></td>\n</tr>\n};
			}
		}
		$HTML .= qq {</table>\n<br>\n};
	}

	my $len = length $id;
	$HTML .= qq {<form method="get" action="rectool.pl" name="reserve">\n};
	$HTML .= qq {<input type="hidden" name="mode" value="change">\n};
	$HTML .= qq {<input type="hidden" name="mode_sub" value="update">\n};
	$HTML .= qq {<input type="hidden" name="id" value="$id">\n};
	$HTML .= qq {ID\n<input type="text" name="id" value="$id" size=$len disabled>\n};
	$HTML .= qq {タイプ\n<select name="type" onChange="setType();">\n};
	foreach my $key ( keys %type ) {
		next if ( $key !~ /^search|^reserve_flexible$|^reserve_fixed$|^convert_b25_ts$|^convert_ts_mp4$|^$type$/ );
		$value = $type{$key};
		if ( $key eq $type ) {
			$HTML .= qq {<option value="$key" selected>$value</option>\n};
		}
		else {
			$HTML .= qq {<option value="$key">$value</option>\n};
		}
	}
	$HTML .= qq {</select>\n};

	$HTML .= qq {チャンネル\n<select name="chtxt">\n};
	# 移動縁故など、チャンネルリスト内にchtxtが存在しない場合に備えて
	$chtxt_0_chname{$chtxt} = $chname || $chtxt if ( !$chtxt_0_chname{$chtxt} );
	foreach my $key ( sort keys %chtxt_0_chname ) {
		if ( $key eq $chtxt || $key eq $chtxt_0 ) {
			$HTML .= qq {<option value="$key" selected>$chtxt_0_chname{$key}</option>\n};
		}
		else {
			$HTML .= qq {<option value="$key">$chtxt_0_chname{$key}</option>\n};
		}
	}
	$HTML .= qq {</select><br>\n};
	$HTML .= qq {タイトル\n<input type="text" name="title" value="$title" size=64><br>\n};
	$HTML .= qq {開始時刻\n<input type="text" name="begin" value="$begin" maxlength=19 size=24>\n};
	$HTML .= $button_bgn;
	$HTML .= qq {終了時刻\n<input type="text" name="end" value="$end" maxlength=19 size=24>\n};
	$HTML .= $button_end . "<br>\n";
	$HTML .= qq {隔日周期\n<input type="text" name="deltaday" value="$deltaday" maxlength=2  size=2 >\n};
	$HTML .= qq {時刻誤差\n<input type="text" name="deltatime" value="$deltatime" maxlength=2  size=2 >\n};
	$HTML .= qq {オプション\n<input type="text" name="opt" value="$opt">\n};
	$HTML .= qq {回数\n<input type="text" name="counter" value="$counter" size=2 >\n};
	$HTML .= qq {<input type="submit" name="update" value="更新">\n</form>\n};
}

################ mode=change ################

if ( $mode eq 'change' ) {
	@id     = $q->param( 'id' );

	$HTML =~ s/%HTML_TITLE_OPT%/ - Change/;
	$HTML .= qq {<div style="float: left">\n};

	if ( $params{ 'delete' } )
	{
		if ( @id ) {
			foreach my $id ( @id ) {
				$dbh->do( "DELETE FROM timeline WHERE id = '$id'" );
			}
			$HTML .= "削除しました。<br>\n5秒後に予約確認画面に移動します。<br>\n";
			$HTML =~ s|%REFRESH%|<meta http-equiv="refresh" content="5; url=rectool.pl?mode=schedule">|;
			goto end;
		}
	}
	if ( $params{ 'update' } )
	{
		$type      = $params{ 'type' };
		$chtxt     = $params{ 'chtxt' };
		$title     = $params{ 'title' };
		$begin     = $params{ 'begin' };
		$end       = $params{ 'end' };
		$deltaday  = $params{ 'deltaday' };
		$deltatime = $params{ 'deltatime' };
		$opt       = $params{ 'opt' };
		$counter   = $params{ 'counter' };
		$id        = $id[0];
		if ( $id ) {
			$dbh->do( 
				"UPDATE timeline SET type = '$type', chtxt = '$chtxt', title = '$title', 
				btime = '$begin', etime = '$end', 
				deltaday = '$deltaday', deltatime = '$deltatime', opt = '$opt', counter = '$counter' 
				WHERE id = '$id'" 
			);
		}
		else {
			$dbh->do( 
				"INSERT INTO timeline ( type, chtxt, title, btime, etime, deltaday, deltatime, opt, counter ) 
				VALUES ( '$type', '$chtxt', '$title', '$begin', '$end', '$deltaday', '$deltatime', '$opt', '$counter' )" 
			);
		}
		$HTML .= "更新しました。<br>\n5秒後に予約確認画面に移動します。<br>\n";
		$HTML =~ s|%REFRESH%|<meta http-equiv="refresh" content="5; url=rectool.pl?mode=schedule">|;
		goto end;
	}
	if ( $mode_sub eq 'proc' ) {
		my $type  = $params{ 'type' };
		my $chtxt = $params{ 'chtxt' } || 'nhk-k';
		my $title = $params{ 'title' };
		my @opt   = $q->param( 'opt' );
		my $opt   = join '', @opt;

		my $datetime_now = DateTime->now( time_zone => $tz )->set_second( 0 )->add( minutes => 10);
		my $sql_type = $type_suggest{$type};
		my $begin = $datetime_now->strftime( '%Y-%m-%d %H:%M:%S' );
		$datetime_now = $datetime_now->add( minutes => 60 );
		my $end = $datetime_now->strftime( '%Y-%m-%d %H:%M:%S' );

		$dbh->do( 
			"INSERT INTO timeline ( type, chtxt, title, btime, etime, opt ) 
			VALUES ( '$sql_type', '$chtxt', '$title', '$begin', '$end', '$opt' )"
		);

		goto end;
	}
	if ( $mode_sub eq 'move' ) {
		my $mode_sub2  = $params{ 'mode_sub2' };
		my $title      = $params{ 'title' };
		my $response;

		$ENV{'LANG'} = 'ja_JP.UTF-8';
		if ( $mode_sub2 eq 'predict' ) {
			$HTML .= "移動後のシミュレーション結果です。\n<br>";
			eval '$response = `python26 ' . $cfg->param( 'path.rec10' ) . "/classify.py -s '$title'`";
		}
		elsif ( $mode_sub2 eq 'exec' ) {
			eval '$response = `python26 ' . $cfg->param( 'path.rec10' ) . "/classify.py -e '$title'`";
		}
		utf8::decode( $response );
		$HTML .= $response;

		goto end;
	}
	if ( $mode_sub eq 'setting' ) {
		my $jbk     = $params{ 'jbk' }     || '0';
		my $bayes   = $params{ 'bayes' }   || '0';
		my $del_tmp = $params{ 'del_tmp' } || '0';
		my $opt     = $params{ 'opt' }     || '';
		my $user    = $params{ 'user' }    || '';
		my $pass    = $params{ 'pass' }    || '';

		$dbh->do( 
			"UPDATE in_settings SET auto_jbk = '$jbk', auto_bayes = '$bayes', 
			auto_del_tmp = '$del_tmp', auto_opt = '$opt'"
		);

		goto end;
	}
	if ( $mode_sub eq 'fixstatus' ) {
		my $key = $params{ 'terec'  } ? 'terec'  : $params{ 'bscsrec' } ? 'bscsrec' : 
		          $params{ 'b252ts' } ? 'b252ts' : $params{ 'ts2avi'  } ? 'ts2avi'  : '';

		$dbh->do( 
			"UPDATE in_status SET $key = 0"
		);

		goto end;
	}

}

################ mode=confirm ################

if ( $mode eq 'confirm' ) {
	if ( $mode_sub eq 'reserve' ) {
		$HTML =~ s/%HTML_TITLE_OPT%/ - Reserver/;
		$HTML .= qq {<div style="float: left">\n};
		&parse_program();

		my $duration = ( str2datetime( $end ) - str2datetime( $begin ) )->delta_minutes;
		$HTML .= "番組名：$title<br>\nチャンネル：$chname<br>\n放送継続時間：$duration 分<br>\n番組内容：$desc<br>\nジャンル：$category<br>\n";
		if ( $longdesc ) {
			$longdesc =~ s/\\n/<br>\n/gs;
			$HTML .= "番組内容(長)：$longdesc<br>\n";
		}
		my $error = &check_error();
		if ( $error )
		{
			# エラー

			$ary_ref = $dbh->selectall_arrayref(
				"SELECT start, stop FROM epg_timeline WHERE channel = '$chtxt' AND title = '$title' "
			);
			if ( $error != 1 ) {
				$HTML .= "同一の番組の他の放送予定です。<br>\n";
				foreach my $line ( @{$ary_ref} ) {
					$begin = $line->[0];
					$end   = $line->[1];
					$begin =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/;
					$end   =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/;
					$overlap = &get_overlap() >= 2 ? '不可能' : 
						qq {<a href="rectool.pl?mode=confirm&amp;mode_sub=reserve&amp;chtxt=$chtxt&amp;start=$line->[0]&amp;stop=$line->[1]">可能</a>};
					$HTML .= "開始：$begin\n終了：$end\n録画は$overlap<br>\n";
				}
			}
		}
		else {
			$HTML .= "録画予約の詳細設定を行ってください。<br>\n";
			$HTML .= qq {<form method="get" action="rectool.pl">\n};
			$HTML .= qq {<input type="hidden" name="mode"  value="reserve">\n};
			$HTML .= qq {<input type="hidden" name="chtxt" value="$chtxt">\n};
			$HTML .= qq {<input type="hidden" name="start" value="$start">\n};
			$HTML .= qq {<input type="hidden" name="stop"  value="$stop">\n};
			$HTML .= qq {<input type="hidden" name="title" value="$title">\n} if ( $params{ 'title' } );
			&draw_form_opt( 'reserve' );
			$HTML .= qq {<input type="submit" value="予約">\n</form>\n};
		}
		goto end;
	}
	# End of $mode_sub eq 'reserve';

	if ( $mode_sub eq 'proc' ) {
		my    $type  = $params{ 'type' };
		local $chtxt = $params{ 'chtxt' };
		my    $title = $params{ 'title' };
		local $opt   = $params{ 'opt' };
		utf8::decode( $title );

		$HTML .= "詳細設定を行ってください。<br>\n";
		$HTML .= "タイトル：$title\n<br>\n";

		$HTML .= qq {<form method="get" action="rectool.pl">\n};
		$HTML .= qq {<input type="hidden" name="mode"     value="change">\n};
		$HTML .= qq {<input type="hidden" name="mode_sub" value="proc">\n};
		$HTML .= qq {<input type="hidden" name="type"     value="$type">\n};
		$HTML .= qq {<input type="hidden" name="title"    value="$title">\n};
		&draw_form_channel( 'nonone' );
		&draw_form_opt();
		$HTML .= qq {<input type="submit" value="予約">\n</form>\n};
		goto end;
	}
}

################ mode=reserve ################

if ( $mode eq 'reserve' ) {
	$HTML .= qq {<div style="float: left">\n};
	&parse_program();
	$title = $params{ 'title' } if ( !$title );
	@opt = $q->param( 'opt' );
	$opt = join '', @opt;
	my ( $deltaday, $deltatime );

	if ( $params{'every'} eq '1' ) {
		$type = 'search_everyday';
		( $changed_t ) = $title =~ /(.*)#/;
		$title = $changed_t if ( $changed_t );
		( $changed_t ) = $title =~ /(.*)第/;
		$title = $changed_t if ( $changed_t );
		( $changed_t ) = $title =~ /(.*)▽/;
		$title = $changed_t if ( $changed_t );
		$title =~ s/「.*」//;
		$title =~ s/＜.*＞//;
		$title =~ s/（.*）//;
		$title =~ s/\[新\]//;
		$title =~ s/無料≫//;
		$title =~ s/\s*$//;
		$deltaday  = 7;
		$deltatime = 3;
	}
	else {
		$type = 'reserve_flexible';
	}
	$chtxt = $chtxt_0 if ( $chtxt_0 );
	if ( !&check_error ) {
		$dbh->do( 
			"INSERT INTO timeline ( type, chtxt, title, btime, etime, opt, deltaday, deltatime ) 
			VALUES ( '$type', '$chtxt', '$title', '$begin', '$end', '$opt', '$deltaday', '$deltatime' )" 
		);
	}
	$HTML .= "録画予約を実行しました。<br>\n5秒後にトップへ移動します。<br>\n";
	$HTML =~ s|%REFRESH%|<meta http-equiv="refresh" content="5; url=rectool.pl">|;
	goto end;
}

################ mode=program ################

if ( $mode eq 'program' ) {
	&draw_form();

	$HTML =~ s/%HTML_TITLE_OPT%/ - Program Viewer/;
	$unix = DateTime->now( time_zone => $tz )->strftime( '%Y%m%d%H%M%S' );
	$sql = 
		"SELECT channel, epg_ch.chname, start, stop, title, category 
		FROM epg_timeline 
		INNER JOIN epg_ch ON epg_timeline.channel = epg_ch.chtxt 
		WHERE $unix <= stop %CH% %DATE% %CATEGORY% %KEY% ORDER BY start";

	if ( $chtxt ) {
		my $ch;
		if ( $chtxt =~ /^\d+(_0)?$/ ) {
			# teはxx_yyy形式であるため
			$chtxt =~ s/_0//;
			$ch = "AND channel LIKE '$chtxt\_%'";
		}
		else {
			$ch = "AND channel = '$chtxt'";
		}
		$sql =~ s/%CH%/$ch/;
	}
	if ( $date_sel ) {
		$date_1 = $date_sel . '000000';
		$date_2 = Date::Simple->new( $date_sel =~ /(.{4})(.{2})(.{2})/ )->next->format('%Y%m%d') . '000000';
		my $date = "AND '$date_1' <= stop AND start <= '$date_2'";
		$sql =~ s/%DATE%/$date/;
	}
	if ( $category_sel ) {
		# 一時的
		#	$category_tmp = $category{$category_sel} . $category_sel;
		my $category = "AND category = '$category{$category_sel}->{name}'";
		$sql =~ s/%CATEGORY%/$category/;
	}
	if ( $key ) {
		my $key = "AND TITLE LIKE '%$key%'";
		$sql =~ s/%KEY%/$key/;
	}
	$sql =~ s/%CH%//;
	$sql =~ s/%DATE%//;
	$sql =~ s/%KEY%//;
	$sql =~ s/%CATEGORY%//;

	$ary_ref = $dbh->selectall_arrayref( $sql );
	foreach my $prg ( @{ $ary_ref } ) {
		my @date = $prg->[2] =~ /(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/;

		$date = $date[2];
		if ( $date != $prev ) {
			my $date = DateTime->new(
				year => $date[0], month  => $date[1], day    => $date[2], 
				locale => 'ja_JP'
			);

			my $dn = $date->day_name;
			#utf8::encode( $dn );
			$HTML .= qq {--------$date[1]/$date[2]($dn)--------<br>\n};
		}
		$HTML .= qq {$date[1]/$date[2] $date[3]:$date[4] };
		$HTML .= qq {$prg->[1] } if ( !$chtxt );
		$HTML .= qq {<a href="rectool.pl?mode=confirm&amp;mode_sub=reserve&amp;chtxt=$prg->[0]&amp;start=$prg->[2]&amp;stop=$prg->[3]">$prg->[4]</a><br>\n};
		$prev = $date;
	}
}

################ mode=list ################

if ( $mode eq 'list' ) {
	$HTML =~ s/%HTML_TITLE_OPT%/ - List/;
	$HTML .= qq {<div>\n};

	$script = <<EOM;
		<link rel="stylesheet" type="text/css" href="http://cdn.sencha.io/ext-3.4.0/resources/css/ext-all.css" />
		<script type="text/javascript" src="http://cdn.sencha.io/ext-3.4.0/adapter/ext/ext-base.js"></script>
		<script type="text/javascript" src="http://cdn.sencha.io/ext-3.4.0/ext-all.js"></script>
		<script>
		Ext.onReady(function() {
		  Ext.select('.ffmpeg').on('contextmenu', function(eventObj, elRef) {
		    var win = new Ext.Window({
		      title: 'FFmpeg info', 
		      //autoShow: true, 
		      autoLoad: "rectool.pl?mode=list&mode_sub=ffmpeg&path=" + Ext.Element(elRef).getAttribute("path") + 
		        "&pathtype=" + Ext.Element(elRef).getAttribute("pathtype"), 
		    });
		    win.show();
		  }, null, {stopEvent:true});
/*
		  Ext.select( '.ffmpeg' , true ).each(function (elem) {
		    // elem.dom.textContent
		    var tooltip = new Ext.ToolTip({
		      target: elem,
		      width: 400,
		      autoLoad: {url: "rectool.pl?mode=list&mode_sub=ffmpeg&path=" + elem.getAttribute("path")},
		      autoHide: false,
		      closable: true,
		      draggable: true, 
		      title: 'FFmpeg info',
		    });
		  });
*/
		});
		</script>
EOM
	$script =~ s/^\t{2}//gm;
	$HTML =~ s/%SCRIPT%/$script/;

	my $recording = $cfg->param( 'path.recpath' );
	my $movedest  = $cfg->param( 'path.ts_movepath' );
	my $recorded  = $cfg->param( 'path.recorded' );

	if ( $mode_sub eq 'log' ) {
		my $title = $params{ 'title' };
		my $log = read_file( "$recording/$title.log" ) if ( -e "$recording/$title.log" );
		utf8::decode( $log );
		$HTML .= '<pre>'.$log."</pre>\n";
		goto end;
	}
	if ( $mode_sub eq 'logzip' ) {
		my $title = $params{ 'title' };
		my $zip = Archive::Zip->new();
		my $logzip;
		die 'read error' unless $zip->read("$recording/$title.log.zip") == AZ_OK;
		my @members = $zip->members();
		foreach (@members) {
			$logzip .= $_->fileName() . "\n";
			my @lines = split /\n|\r/, $zip->contents( $_->fileName() );
			my %count;
			@lines = grep {!$count{$_}++} @lines;
			$logzip .= join "\n", @lines;
			$logzip .= "\n<hr>\n";
		}

		utf8::decode( $logzip );
		$HTML .= '<pre>'.$logzip."</pre>\n";
		goto end;
	}
	if ( $mode_sub eq 'ffmpeg' ) {
		my $path = $params{ 'path' };
		my $pathtype = $params{ 'pathtype' };
		my $pathdir;
		$pathdir = $recording if ( $pathtype eq 'ing');
		$pathdir = $recorded  if ( $pathtype eq 'ed' );
		$pathdir = $movedest  if ( $pathtype eq 'dst');
		# mediainfo (not working)
		# ffprobe
		# FIXME: sanitize
		my $ffmpeg = `ffmpeg -i "$pathdir/$path" 2>&1` if ( -f "$pathdir/$path" );
		utf8::decode($ffmpeg);
		$ffmpeg = join "<br>\n", grep /Duration|Stream/, split /\n/, $ffmpeg;
		$HTML = $ffmpeg;
		goto end;
	}
	if ( !$mode_sub ) {
		$HTML .= qq {<a href="rectool.pl?mode=list&amp;mode_sub=new">録画中のみ</a>\n};
		$HTML .= qq {<a href="rectool.pl?mode=list&amp;mode_sub=old">録画後のみ</a>\n<br>\n};
	}
	if ( !$mode_sub || $mode_sub eq 'new' ) {
		$HTML .= "録画中のファイル一覧<br>\n";
		&list( $recording );
	}
	if ( !$mode_sub ) {
		$HTML .= "<br>\n";
	}
	if ( !$mode_sub || $mode_sub eq 'old' ) {
		$HTML .= "録画後のファイル一覧<br>\n";
		&simple_list( $movedest );
		&simple_list( $recorded );
	}

	sub list {
		local $path = shift;
		local %list = ();
		my @exp = ( 'log', 'log.zip', 'ts.b25', 'ts.tsmix', 'ts', 'ts.log', 
			'aac', 'srt', 'm2v', 'wav', '264', 'mp4', 'mkv' );
		for ( 0..$#exp ) {
			$exp{$exp[$_]} = $_;
		}
		my $exp_count = scalar keys %exp;

		&get_file_list_wrapper( $path, \&wanted );

		my $help;
		foreach my $name ( sort { $exp{$a} <=> $exp{$b} } keys %exp ) {
			$help .= $exp{$name} + 1 . " = $name / ";
		}
		$HTML .= $help;
		$help  = qq {<tr style="background-color: #87CEEB"><td>$help\n</td>\n};
		$help .= qq {<td>$_</td>\n} for ( 1..$exp_count );

		$HTML .= qq {<br>\n○ = 完了 / ● = 書き込み中 / ◆ = ファイルサイズ異常<br>\n};
		$HTML .= qq {<table summary="listtable" border=1 cellspacing=0>\n<tr>\n};
		$HTML .= qq {<th>タイトル</th>\n};
		$HTML .= qq {<th>$_</th>\n} for ( 1..$exp_count );
		$HTML .= qq {</tr>\n};

		my $count = 0;

		foreach my $title ( sort keys %list ) {
			my $value = $list{$title};
			my @flag = ( 0 ) x ( $exp_count );
			$HTML .= qq {<tr>\n<td width="600" style="width: 600px; white-space: normal">$title</td>\n};
			foreach my $exp ( keys %{$value} ) {
				if ( $exp eq 'log' ) {
					# ログへのリンクを追加
					my $title = $q->escape( $title );
					my $extra = qq {<td><a href="rectool.pl?mode=list&amp;mode_sub=log&amp;title=$title">○</a></td>\n};

					$value->{$exp}->{extra} = $extra;
				}
				elsif ( $exp eq 'log.zip' ) {
					# ZIPログへのリンクを追加
					my $title = $q->escape( $title );
					my $extra = qq {<td><a href="rectool.pl?mode=list&amp;mode_sub=logzip&amp;title=$title">○</a></td>\n};

					$value->{$exp}->{extra} = $extra;
				}
				elsif ( $exp eq 'mp4' ) {
					# ○などの代わりにサイズを表示
					# $value->{$exp}->{style} = $value->{$exp}->{size};
					my $size = $value->{$exp}->{size};
					my $extra = qq {<td><span class="ffmpeg" path="$title.mp4" pathtype="ing">$size</span></td>\n};
					$value->{$exp}->{extra} = $extra;
				}
				elsif ( $exp eq 'mkv' ) {
					# サムネイルへのリンクを追加
					my $title = $q->escape( $title );

					my $extra = qq {<td><a title="$value->{$exp}->{size}" href="rectool.pl?mode=thumb&amp;title=$title">■</a></td>\n};
					$value->{$exp}->{extra} = $extra;
				}
				$flag[$exp{$exp}] = $value->{$exp};
			}
			foreach ( @flag ) {
				my $size  = $_->{size};
				my $style = $_->{style};
				my $span  =  $size ? qq {<span title="$size">$style</span>} : '<br>';
				$HTML .= $_->{extra} || qq {<td>$span</td>\n};
			}
			$HTML .= qq {</tr>\n};
			$HTML .= $help unless ( ++$count % 20 );
		}
		$HTML .= qq {</table>\n};

		sub wanted {
			my $rel = shift;
			my $abs = shift;

			return if ( $rel =~ /Thumbs\.db/ );
			return if ( $rel =~ /\.idx/ );

			$rel =~ s/\.temp$//;
			my $regexp = join '|', keys %exp;
			my ( $title, $exp ) = $rel =~ /(.*?)\.($regexp)$/;
			my ( $size, $style ) = &get_size( $abs );
			$rel =~ s/\.temp$//;
			if ( !$title ) {
				$title = '_error_exp_'.$rel;
				$exp   = 'log';
			}
			if ( $title !~ /[^0-9A-F]+/ ) {
				my $tmp = pack( 'H*', $title );
				if ( !$tmp ) {
					$title = '_error_b16_'.$rel;
					$exp   = 'log';
				}
				else {
					$title = 'Base16_'.$tmp;
				}
			}
			$list{$title}->{$exp} = { 'style' => $style, 'size' => $size };
		}
	}

	sub simple_list {
		local $path = shift;
		local @list = ();

		&get_file_list_wrapper( $path, \&simple_wanted );

		@list = nsort @list;

		foreach ( @list ) {
			$HTML .= "$_<br>\n";
		}

		sub simple_wanted {
			my $rel = shift;
			my $abs = shift;

			my ( $size ) = &get_size( $abs );
			$rel = qq {<span class="ffmpeg" path="$rel" pathtype="ed">$rel</span>};
			push @list, $rel ."\t\t". $size;
		}
	}

	sub get_size {
		my $file = shift;
		my ( $size, $last ) = (stat( $file ))[7,9];
		my @unim = ("B","KiB","MiB","GiB","TiB","PiB");
		my $count = 0;

		while($size >= 1024 ){
			$count++;
			$size = $size / 1024;
		}
		$size *= 100;
		$size  = int( $size );
		$size /= 100;
		if ( time - $last < 10 ) {
			$style = '●';
		}
		elsif ( $size == 0 ) {
			$style = '◆';
		}
		else {
			$style = '○';
		}
		return ( "$size $unim[$count]", $style );
	}
}

################ mode=thumb ################

if ( $mode eq 'thumb' ) {
	my $title = $params{ 'title' };
	my $pos  = $params{ 'pos' };
	my $recording = $cfg->param( 'path.recpath' );

	print "Content-Type: image/jpeg\n\n";
	exec "ffmpeg -ss 300 -i '$recording/$title.mkv' -f image2 -pix_fmt jpg -vframes 1 -s 320x240 -";
	exit;
}

################ mode=check ################

if ( $mode eq 'check' ) {
}

################ mode=bravia ################

if ( $mode eq 'bravia' ) {
	$HTML =~ s/%HTML_TITLE_OPT%/ - Bravia/;
	$HTML .= qq {<div>\n};
	$HTML .= qq {<form method="get" action="rectool.pl">\n};
	$HTML .= qq {<div>\n};
	$HTML .= qq {<table summary="bayestable" border=1 cellspacing=0>\n<tr>\n};
	$HTML .= qq {<th>ID</th>\n};
	$HTML .= qq {<th>チャンネル</th>\n};
	$HTML .= qq {<th>タイトル</th>\n};
	$HTML .= qq {<th><a href="rectool.pl?mode=bravia">開始時刻</a></th>\n};
	$HTML .= qq {<th>終了時刻</th>\n};
	$HTML .= qq {<th>録画時間</th>\n};
	$HTML .= qq {<th><a href="rectool.pl?mode=bravia&amp;order=point">ポイント</a></th>\n};
	$HTML .= qq {<th>予約</th>\n};
	$HTML .= qq {</tr>\n};
	my $order = $params{ 'order' };
	if ( $order ne 'point' ) {
		$order = 'btime';
	}
	else {
		$order = 'point DESC';
	}
	my $ary_ref = $dbh->selectall_arrayref(
		"SELECT id, chtxt, title, btime, etime, point 
		FROM auto_timeline_bayes 
		ORDER BY $order" );

	foreach my $line ( @{ $ary_ref } ) {
		my ( $begin, $end, $diff ) = &str2readable( $line->[3], $line->[4] );

		$line->[1] = $chtxt_chname{$line->[1]} || $line->[1];
		$HTML .= qq {<tr align="center">\n};
		$HTML .= qq {<td>$line->[0]</td>\n};
		$HTML .= qq {<td>$line->[1]</td>\n};
		$HTML .= qq {<td>$line->[2]</td>\n};
		$HTML .= qq {<td>$begin</td>\n<td>$end</td>\n<td>$diff</td>\n};
		$HTML .= qq {<td>$line->[5]</td>\n};
		$HTML .= qq {<td><a href="rectool.pl?mode=confirm&amp;mode_sub=reserve&amp;bayesid=$line->[0]">予約</a></td>\n};
		$HTML .= qq {</tr>\n};
	}
	$HTML .= qq {</table>\n};
	$HTML .= qq {</div>\n};
	$HTML .= qq {</form>\n};

}

################ mode=proc ################

if ( $mode eq 'proc' ) {
	$HTML =~ s/%HTML_TITLE_OPT%/ - Proposal/;
	$HTML .= qq {<div>\n};
	$HTML .= qq {<table summary="proctable" border=1 cellspacing=0>\n<tr>\n};
	$HTML .= qq {<th>タイプ</th>\n};
	$HTML .= qq {<th>タイトル</th>\n};
	$HTML .= qq {<th>予約</th>\n};
	$HTML .= qq {</tr>\n};

	my $ary_ref = $dbh->selectall_arrayref(
		"SELECT type, chtxt, title 
		FROM auto_proc 
		ORDER BY title " );

	foreach my $line ( @{ $ary_ref } ) {
		my $url;
		$line->[3] = $q->escape( $line->[2] );
		my $opt = $dbh->selectrow_array( 
			"SELECT opt FROM in_timeline_log 
			WHERE title = '$line->[2]' "
		);

		if ( $line->[0] eq 'auto_suggest_dec' ) {
			unless ( $dbh->selectrow_array( 
				"SELECT 1 FROM timeline 
				WHERE ( type = 'convert_b25_ts' OR type = 'convert_b25_ts_running' )
				AND title = '$line->[2]' "
			) ) {
				$url = qq {rectool.pl?mode=confirm&amp;mode_sub=proc&amp;type=$line->[0]&amp;chtxt=$line->[1]&amp;title=$line->[3]&amp;opt=$opt};
			}
		}
		elsif ( $line->[0] eq 'auto_suggest_enc' ) {
			unless ( $dbh->selectrow_array( 
				"SELECT 1 FROM timeline 
				WHERE ( type = 'convert_ts_mp4' OR type = 'convert_ts_mp4_running' ) 
				AND title = '$line->[2]' "
			) ) {
				$url = qq {rectool.pl?mode=confirm&amp;mode_sub=proc&amp;type=$line->[0]&amp;chtxt=$line->[1]&amp;title=$line->[3]&amp;opt=$opt};
			}
		}
		else {
			unless ( $dbh->selectrow_array( 
				"SELECT 1 FROM timeline 
				WHERE ( type LIKE 'convert_avi%' OR type = 'convert_mkv' ) 
				AND title = '$line->[2]' "
			) ) {
				$url = qq {rectool.pl?mode=confirm&amp;mode_sub=proc&amp;type=$line->[0]&amp;chtxt=$line->[1]&amp;title=$line->[3]};
			}
		}
		if ( $url ) { 
			$href = qq {<a href="$url">予約</a>};
		}
		else {
			$href = q {予約済};
		}

		my $color = $color{$type_suggest{$line->[0]}} ? $color{$type_suggest{$line->[0]}} : '';
		$line->[0] = $type{$line->[0]} ? $type{$line->[0]} : $line->[0];
		$line->[0] = qq {<span style="color: $color">$line->[0]</span>} if ( $color );
		$HTML .= qq {<tr align="center">\n};
		$HTML .= qq {<td>$line->[0]</td>\n};
		$HTML .= qq {<td align="left">$line->[2]</td>\n};
		$HTML .= qq {<td>$href</td>\n};
		$HTML .= qq {</tr>\n};
	}

	$HTML .= qq {</table>\n};
}

################ mode=jbk ################

if ( $mode eq 'jbk' ) {
	$HTML =~ s/%HTML_TITLE_OPT%/ - JBK/;
	$HTML .= qq {<div>\n};

	if ( $mode_sub eq 'add' ) {
		my $keyword = $params{ 'keyword' };
		utf8::decode( $keyword );
		$HTML .= "キーワード「$keyword」を追加しました。<br>\n";
		$dbh->do( 
			"INSERT INTO in_auto_jbk_key ( keyword ) 
			VALUES ( '$keyword' )" 
		);
	}
	elsif ( $mode_sub eq 'del' ) {
		my $id = $params{ 'id' };
		my $keyword = $dbh->selectrow_array( 
			"SELECT keyword FROM in_auto_jbk_key 
			WHERE id = '$id' " );
		$HTML .= "キーワード「$keyword」を削除しました。<br>\n";
		$dbh->do( 
			"DELETE FROM in_auto_jbk_key WHERE id = '$id'" 
		);
	}
	elsif ( $mode_sub eq 'on' ) {
		my $id = $params{ 'id' };
		$HTML .= "キーワード「$keyword」を自動録画対象にしました。<br>\n";
		$dbh->do( 
			"UPDATE in_auto_jbk_key SET auto = 1 WHERE id = '$id'" 
		);
	}
	elsif ( $mode_sub eq 'off' ) {
		my $id = $params{ 'id' };
		$HTML .= "キーワード「$keyword」を自動録画対象から外しました。<br>\n";
		$dbh->do( 
			"UPDATE in_auto_jbk_key SET auto = 0 WHERE id = '$id'" 
		);
	}

	$HTML .= qq {<table summary="jbktable" border=1 cellspacing=0>\n<tr>\n};
	$HTML .= qq {<th>ID</th>\n};
	$HTML .= qq {<th>キーワード</th>\n};
	$HTML .= qq {<th>自動録画</th>\n};
	$HTML .= qq {<th>切り替え</th>\n};
	$HTML .= qq {<th>録画オプション</th>\n};
	$HTML .= qq {<th>削除</th>\n};
	$HTML .= qq {</tr>\n};

	my $ary_ref = $dbh->selectall_arrayref(
		"SELECT id, keyword, auto, opt 
		FROM in_auto_jbk_key
		ORDER BY id " );

	foreach my $line ( @{ $ary_ref } ) {
		my $delurl = "rectool.pl?mode=jbk&amp;mode_sub=del&amp;id=$line->[0]";
		my $auto = $line->[2] ? 'on' : 'off';
		my $oppo = $line->[2] ? 'off' : 'on';
		my $oppourl = "rectool.pl?mode=jbk&amp;mode_sub=$oppo&amp;id=$line->[0]";
		$oppo .= "にする";

		$HTML .= qq {<tr align="center">\n};
		$HTML .= qq {<td>$line->[0]</td>\n};
		$HTML .= qq {<td>$line->[1]</td>\n};
		$HTML .= qq {<td>$auto</td>\n};
		$HTML .= qq {<td><a href="$oppourl">$oppo</a></td>\n};
		$HTML .= qq {<td>$line->[3]</a></td>\n};
		$HTML .= qq {<td><a href="$delurl">削除</a></td>\n};
		$HTML .= qq {</tr>\n};
	}

	$HTML .= qq {</table>\n};

	$HTML .= qq {<form method="get" action="rectool.pl">\n};
	$HTML .= qq {<div>\n};
	$HTML .= qq {<input type="hidden" name="mode" value="jbk">\n};
	$HTML .= qq {<input type="hidden" name="mode_sub" value="add">\n};
	$HTML .= qq {<input name="keyword" type="text">\n};
	$HTML .= qq {<input type="submit" value="追加">\n</div>\n</form>\n<br>\n};

	$HTML .= qq {<table summary="jbkrestable" border=1 cellspacing=0>\n<tr>\n};
	$HTML .= qq {<th>ID</th>\n};
	$HTML .= qq {<th>チャンネル</th>\n};
	$HTML .= qq {<th>タイトル</th>\n};
	$HTML .= qq {<th>開始時刻</th>\n};
	$HTML .= qq {<th>終了時刻</th>\n};
	$HTML .= qq {<th>録画時間</th>\n};
	$HTML .= qq {<th>予約</th>\n};
	$HTML .= qq {</tr>\n};

	$ary_ref = $dbh->selectall_arrayref(
		"SELECT id, auto_timeline_keyword.chtxt, epg_ch.chname, title, btime, etime 
		FROM auto_timeline_keyword 
		INNER JOIN epg_ch ON auto_timeline_keyword.chtxt = epg_ch.chtxt 
		ORDER BY btime" 
		, {Slice=>{}} );

	foreach my $line ( @{ $ary_ref } ) {
		my ( $begin, $end, $diff ) = &str2readable( $line->{btime}, $line->{etime} );
		$line->{btime} =~ s/(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/$1$2$3$4$5$6/;
		$line->{etime} =~ s/(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/$1$2$3$4$5$6/;
		my $url = qq "rectool.pl?mode=confirm&amp;mode_sub=reserve&amp;chtxt=$line->{chtxt}&amp;start=$line->{btime}&amp;stop=$line->{etime}";

		$HTML .= qq {<tr align="center">\n};
		$HTML .= qq {<td>$line->{id}</td>\n};
		$HTML .= qq {<td>$line->{chname}</td>\n};
		$HTML .= qq {<td>$line->{title}</td>\n};
		$HTML .= qq {<td>$begin</td>\n};
		$HTML .= qq {<td>$end</td>\n};
		$HTML .= qq {<td>$diff</td>\n};
		$HTML .= qq {<td><a href="$url">予約</a></td>\n};
		$HTML .= qq {</tr>\n};
	}

	$HTML .= qq {</table>\n};

}

################ mode=recognize ################

if ( $mode eq 'recognize' ) {
	$HTML =~ s/%HTML_TITLE_OPT%/ - Recognizer/;

	my $text  = $params{ 'text' };
	utf8::decode( $text );
	$chtxt = $params{ 'chtxt' };
	my $title = $params{ 'title' };
	utf8::decode( $title );

	$HTML .= qq {<div>\n};
	$HTML .= qq {与えられた文字列のうち、番組の放送時刻と思われる文字列を認識します。<br>\n};
	$HTML .= qq {番組表が取得できない一週間以上先の予約ができます。<br>\n};
	$HTML .= qq {<form method="post" action="rectool.pl">\n};
	$HTML .= qq {<div>\n};
	&draw_form_channel( 'nonone' );
	$HTML .= qq {<input type="text" name="title" value="$title">\n};
	$HTML .= qq {<br>\n};
	$HTML .= qq {<input type="hidden" name="mode" value="recognize">\n};
	$HTML .= qq {<textarea name="text" cols=40 rows=4>\n$text</textarea>\n};
	$HTML .= qq {<input type="submit" value="実行">\n</div>\n</form>\n};

	my $ch_list = join '|', grep /.+/, values %chtxt_0_chname;
	my %ch_reverse = reverse %chtxt_0_chname;

	if ( $text ) {
		my ( $year, $month, $day );
		my ( $bhour, $bminute, $ehour, $eminute );
		my $next_day = 0;
		foreach ( split /\n/, $text ) {
			my @bdate = /(\d{4}).(\d{1,2}).(\d{1,2})/;
			s/(\d{4}).(\d{2}).(\d{2})//;
			my @btime = /(\d{1,2})[:：](\d{1,2})/;
			s/(\d{1,2})[:：](\d{2})//;
			my @etime = /(\d{1,2})[:：](\d{1,2})/;
			s/(\d{1,2})[:：](\d{2})//;
			s/\(.*\)//;
			if ( !@bdate ) {
				$bdate[0] = Time::Piece->localtime->year;
				( $bdate[1], $bdate[2] ) = /(\d{1,2})月(\d{1,2})日/;
				s/(\d{1,2})月(\d{1,2})日//;
			}
			next if (!( @bdate || @btime ));
			( $year,  $month, $day ) = @bdate if ( $bdate[0] && $bdate[1] && $bdate[2] );
			( $bhour, $bminute )     = @btime if ( defined $btime[0] && defined $btime[1] );
			( $ehour, $eminute )     = @etime if ( defined $etime[0] && defined $etime[1] );
			$next_day = 1 if ( /深夜/ );
			my ( $ch ) = /($ch_list)/;
			my $chtxt = $ch_reverse{$ch} if ( $ch && $ch_reverse{$ch} );
			s/($ch_list)//;

			if ( $year && $month && $day && defined $bhour && defined $bminute ) {
				my $tp  = Time::Piece->strptime( "$year-$month-$day $bhour:$bminute", '%Y-%m-%d %H:%M' );
				my $etp = Time::Piece->strptime( "$year-$month-$day $ehour:$eminute", '%Y-%m-%d %H:%M' ) if ( defined $ehour && defined $eminute );
				$tp += ONE_DAY if ( $next_day );
				my $start = $tp->strftime( '%Y%m%d%H%M%S' );
				my $stop  = defined $etp ? 
					$etp->strftime( '%Y%m%d%H%M%S' ) :
					( $tp + ONE_MINUTE * 30 )->strftime( '%Y%m%d%H%M%S' );
				$title = $_ if ( !$title );
				my $url = qq "rectool.pl?mode=confirm&amp;mode_sub=reserve&amp;chtxt=$chtxt&amp;start=$start&amp;stop=$stop&amp;title=$title";
				$HTML .= qq {認識結果:$year-$month-$day $bhour:$bminute -> $ehour:$eminute 残り:$_<a href="$url">リンク</a> <br>\n};
			}
		}
	}
}

################ mode=expert ################

if ( $mode eq 'expert' ) {
	my $ary_ref;

	$HTML =~ s/%HTML_TITLE_OPT%/ - Expert/;
	$HTML .= qq {<div>\n};

	if ( $mode_sub eq 'reget' ) {
		my $bctype = $params{ 'bctype' };
		my ( $chtxt, $chname ) = $dbh->selectrow_array( 
			"SELECT chtxt, chname FROM epg_ch 
			WHERE bctype = '$bctype' " );
		$HTML .= "Update for $chname ( chtxt: $chtxt ) has been reserved.<br>\n";
		$dbh->do( "UPDATE epg_ch SET status = '2' WHERE chtxt = '$chtxt' " );
		goto end;
	}

	if ( $params{ 'dump' } ) {
		# id、epgXXを除外して出力
		my $sth = $dbh->prepare(
			"SELECT type, chtxt, title, btime, etime, deltatime, deltaday, opt, counter 
			FROM timeline"
		);
		# my $yaw = XML::Handler::YAWriter->new;
		my $output;
		my $wri = XML::SAX::Writer->new( Output => \$output );
		my $gen = XML::Generator::DBI->new(
			Handler => $wri,
			AsAttributes => 1,
		);
		$gen->execute($sth);
		# $HTML .= join "\n", @{$yaw->{Strings}};
		utf8::encode($output);
		my $len = length $output;
		print "Content-Type: text/xml\n";
		print "Content-Length: $len\n";
		print "Content-Disposition: attachment; filename=\"rec10-reserve-dump.xml\"\n\n";
		print $output;
		exit;
	}

	if ( $params{ 'restore' } ) {
		my $fh = $q->upload('upfile');
		my $xml = read_file( $fh );
		my $tpp = XML::TreePP->new;
		my $tree = $tpp->parse( $xml );
		my @rows = @{ $tree->{database}->{select}->{row} };

		# 高速化のためVALUESを連結
		# INSERT INTO timeline ( ... ) VALUES ( aa, bb, cc ), ( kk, ll, mm ), ( xx, yy, zz )
		my @keys = qw/type chtxt title btime etime deltatime deltaday opt counter/;
		my $keys = join ', ', @keys;
		my @values;

		foreach my $row ( @rows ) {
			my $values = join ', ', map { "'".$row->{'-'.$_}."'" } @keys;
			utf8::decode( $values );
			push @values, "( $values )";
		}
		my $sql = "INSERT INTO timeline ( $keys ) VALUES " . join ', ', @values;
		$dbh->do( "TRUNCATE TABLE timeline" );
		$dbh->do( $sql );
		goto end;
	}

	my @ary = $dbh->selectrow_array(
		"SELECT auto_jbk, auto_bayes, auto_del_tmp, auto_opt 
		FROM in_settings " );
	my $opt = pop @ary;
	@ary = map( $_ ? 'checked' : '', @ary );

	$HTML .= qq {内部オプションの変更\n<br>};
	$HTML .= qq {<form method="get" action="rectool.pl">\n};
	$HTML .= qq {<div>\n};
	$HTML .= qq {<input type="hidden" name="mode"     value="change">\n};
	$HTML .= qq {<input type="hidden" name="mode_sub" value="setting">\n};
	$HTML .= qq {<input type="checkbox" name="jbk"     value="1" $ary[0]>自動地引\n};
	$HTML .= qq {<input type="checkbox" name="bayes"   value="1" $ary[1]>自動ベイズ\n};
	$HTML .= qq {<input type="checkbox" name="del_tmp" value="1" $ary[2]>自動一時ファイル削除\n};
	$HTML .= qq {自動オプション:<input type="text" name="opt" value="$opt">\n};
	$HTML .= qq {<input type="submit" value="保存">\n</div>\n</form>\n};


	$HTML .= qq {<hr>\n番組表のカテゴリ一覧と内蔵のカテゴリ一覧の合致を確認中...\n};
	$ary_ref = $dbh->selectcol_arrayref(
		"SELECT DISTINCT category FROM epg_timeline"
	);
	my @category = map {$_->{name}} sort values %category;
	if ( List::Compare->new( $ary_ref, \@category )->get_symdiff ) {
		$HTML .= qq {一致しません<br>\n};
		$HTML .= qq {番組表：@{$ary_ref}<br>\n内蔵：@category<br>\n};
	}
	else {
		$HTML .= qq {一致しました<br>\n};
	}


	@ary = $dbh->selectrow_array( "SELECT terec, bscsrec, b252ts, ts2avi FROM in_status" );
	$HTML .= qq {<hr>\n地上波録画数：$ary[0]\n衛星波録画数：$ary[1]\n解読数：$ary[2]\n縁故数：$ary[3]\n<br>\n};
	$HTML .= qq {<form method="get" action="rectool.pl">\n};
	$HTML .= qq {<div>\n};
	$HTML .= qq {<input type="hidden" name="mode"     value="change">\n};
	$HTML .= qq {<input type="hidden" name="mode_sub" value="fixstatus">\n};
	$HTML .= qq {<input type="submit" name="terec"   value="地上波録画数をリセット">\n};
	$HTML .= qq {<input type="submit" name="bscsrec" value="衛星波録画数をリセット">\n};
	$HTML .= qq {<input type="submit" name="b252ts"  value="解読数をリセット">\n};
	$HTML .= qq {<input type="submit" name="ts2avi"  value="縁故数をリセット">\n</div>\n</form>\n};


	$HTML .= qq {<hr>\nRec10 バージョン：$rec10_version\nrectool バージョン：$rectool_version\n<br>\n};


	if (0) {
	$HTML .= qq {<hr>\n番組表の欠落<br>\n};
	$ary_ref = $dbh->selectall_arrayref( "SELECT chname, chtxt FROM epg_ch" );
	foreach my $line ( @{$ary_ref} ) {
		my $ary_ref = $dbh->selectall_arrayref( 
			"SELECT start, stop, title FROM epg_timeline WHERE channel = '$line->[1]' ORDER BY start" 
		);
		my $error;
		my @program_old = ( '', $ary_ref->[0]->[0] );
		my $program_old = \@program_old;

		foreach my $program_new ( @{$ary_ref} ) {
			if ( $program_old->[1] ne $program_new->[0] && 
				$program_old->[2] !~ /クロ?ジング|クロージング|エンディング|休止|ミッドナイト|ending/ && 
				$program_new->[2] !~ /オープニング|ウィークリー・インフォメーション|モーニング|opening/ && 
				( str2datetime( $program_new->[0] ) - str2datetime( $program_old->[1] ) )->delta_minutes > 30 ) {
				$program_old->[1] =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/;
				$program_new->[0] =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/;
				$error .= qq{    $program_old->[2]    $program_old->[1]\n    ->  $program_new->[2]    $program_new->[0]\n};
			}
			$program_old = $program_new;
		}
		$HTML .= qq {<pre>\n$line->[0]\n$error</pre>\n} if ( $error );
	}
	}


	$HTML .= qq {<hr>\n予約の保存・復元<br>\n};
	$HTML .= qq {<form action="rectool.pl" method="post" enctype="multipart/form-data">\n};
	$HTML .= qq {<div>\n};
	$HTML .= qq {<input type="hidden" name="mode" value="expert">\n};
	$HTML .= qq {<input type="submit" name="dump" value="保存">\n};
	$HTML .= qq {<input type="file" name="upfile">\n};
	$HTML .= qq {<input type="submit" name="restore" value="復元">\n};
	$HTML .= qq {</div>\n};
	$HTML .= qq {</form>\n};


	$ary_ref = $dbh->selectall_arrayref( 
		"SELECT chname, chtxt, bctype, ch, csch, tsid, updatetime, status, visible 
		FROM epg_ch 
		ORDER BY chtxt " );
	$HTML .= qq {<hr>\n番組表の更新状況<br>\n};
	$HTML .= qq {<table summary="channeltable" border=1 cellspacing=0>\n<tr>\n};
	$HTML .= qq {<th>チャンネル名</th>\n};
	$HTML .= qq {<th>chtxt</th>\n};
	$HTML .= qq {<th>bctype</th>\n};
	$HTML .= qq {<th>ch</th>\n};
	$HTML .= qq {<th>csch</th>\n};
	$HTML .= qq {<th>tsid</th>\n};
	$HTML .= qq {<th>最終更新時刻</th>\n};
	$HTML .= qq {<th>状態</th>\n};
	$HTML .= qq {<th>表示</th>\n};
	$HTML .= qq {</tr>\n};
	foreach my $status ( @{$ary_ref} ) {
		$HTML .= qq {<tr>\n};
		$HTML .= qq {<td>$status->[0]</td>\n<td>$status->[1]</td>\n<td>$status->[2]</td>\n<td>$status->[3]</td>\n};
		$HTML .= qq {<td>$status->[4]</td>\n<td>$status->[5]</td>\n<td>$status->[6]</td>\n<td>$status->[7]</td>\n};
		$HTML .= qq {<td>$status->[8]</td>\n};
		$HTML .= qq {</tr>\n};
	}
	$HTML .= qq {</table>\n};

	$HTML .= qq {<form method="get" action="rectool.pl">\n};
	$HTML .= qq {<div>\n};
	$HTML .= qq {番組表を再取得する\n};
	$HTML .= qq {<input type="hidden" name="mode" value="expert">\n};
	$HTML .= qq {<input type="hidden" name="mode_sub" value="reget">\n};
	$HTML .= qq {<select name="bctype">\n};
	$ary_ref = $dbh->selectall_arrayref(
		"SELECT DISTINCT bctype 
		FROM epg_ch WHERE bctype NOT LIKE '_s%' "
	);
	foreach my $line ( @{$ary_ref} ) {
		$HTML .= qq {<option value="$line->[0]">$line->[0]</option>\n};
	}
	$HTML .= qq {<option value="bs">BS</option>\n};
	$HTML .= qq {<option value="cs1">CS1</option>\n};
	$HTML .= qq {<option value="cs2">CS2</option>\n};
	$HTML .= qq {</select>\n};
	$HTML .= qq {<input type="submit" value="実行">\n</div>\n</form>\n};



	$ary_ref = $dbh->selectall_arrayref(
		"SELECT id, type, chtxt, title, btime, etime, opt, deltaday, deltatime 
		FROM timeline 
		ORDER BY id ");
	$HTML .= qq {<hr>\n予約表<br>\n};
	$HTML .= qq {<table summary="rectimetable" border=1 cellspacing=0>\n<tr>\n};
	$HTML .= qq {<th>ID</th>\n};
	$HTML .= qq {<th>type</th>\n};
	$HTML .= qq {<th>chtxt</th>\n};
	$HTML .= qq {<th>title</th>\n};
	$HTML .= qq {<th>btime</th>\n};
	$HTML .= qq {<th>etime</th>\n};
	$HTML .= qq {<th>opt</th>\n};
	$HTML .= qq {<th>deltaday</th>\n};
	$HTML .= qq {<th>deltatime</th>\n};
	$HTML .= qq {</tr>\n};
	foreach my $status ( @{$ary_ref} ) {
		$HTML .= qq {<tr>\n};
		$HTML .= qq {<td>$status->[0]</td>\n<td>$status->[1]</td>\n<td>$status->[2]</td>\n<td>$status->[3]</td>\n};
		$HTML .= qq {<td>$status->[4]</td>\n<td>$status->[5]</td>\n<td>$status->[6]</td>\n<td>$status->[7]</td>\n};
		$HTML .= qq {<td>$status->[8]</td>\n};
		$HTML .= qq {</tr>\n};
	}
	$HTML .= qq {</table>\n};
}

################ mode=log ################

if ( $mode eq 'log' ) {
	$HTML =~ s/%HTML_TITLE_OPT%/ - Log/;

	$HTML .= qq {<div>\n};
	$HTML .= qq {<table summary="reclogtable" border=1 cellspacing=0>\n<tr>\n};
	$HTML .= qq {<th>ID</th>\n};
	$HTML .= qq {<th>chtxt</th>\n};
	$HTML .= qq {<th>title</th>\n};
	$HTML .= qq {<th>btime</th>\n};
	$HTML .= qq {<th>etime</th>\n};
	$HTML .= qq {<th>opt</th>\n};
	$HTML .= qq {<th>exp</th>\n};
	$HTML .= qq {<th>longexp</th>\n};
	$HTML .= qq {<th>category</th>\n};
	$HTML .= qq {</tr>\n};
	$ary_ref = $dbh->selectall_arrayref(
		"SELECT id, chtxt, title, btime, etime, opt, exp, longexp, category 
		FROM in_timeline_log "
	);
	foreach my $line ( @{$ary_ref} ) {
		$HTML .= qq {<tr>\n};
		$HTML .= qq {<td>$line->[0]</td>\n<td>$line->[1]</td>\n<td>$line->[2]</td>\n<td>$line->[3]</td>\n};
		$HTML .= qq {<td>$line->[4]</td>\n<td>$line->[5]</td>\n<td>$line->[6]</td>\n<td>$line->[7]</td>\n};
		$HTML .= qq {<td>$line->[8]</td>\n};
		$HTML .= qq {</tr>\n};
	}
	$HTML .= qq {</table>\n};
}

################ mode=help ################

if ( $mode eq 'help' ) {
	$HTML =~ s/%HTML_TITLE_OPT%/ - Help/;
	$HTML =~ s|%REFRESH%|<meta http-equiv="refresh" content="300">|;
	$HTML .= qq {<div>\n};
	$HTML .= qq {ヘルプ\n};
}

################ mode=test ################

if ( $mode eq 'test' ) {
	$HTML =~ s/%HTML_TITLE_OPT%/ - Test/;
	$HTML =~ s|%REFRESH%|<meta http-equiv="refresh" content="300">|;
	$HTML .= qq {<div>\n};

	$tmp = read_file( '/etc/rec10.conf' );
	$tmp =~ s/\n/<br>\n/gs;
	$HTML .= $tmp;

	# $HTML .= Dumper( $ary_ref );
}

################ mode nasi ################

if ( !$mode ) {
	&draw_form();
	$HTML =~ s/%HTML_TITLE_OPT%/ - Top/;
	$HTML .= qq {Welcome to Rec10!<br>\n};
	goto end;
}


end:
#<div style="float: right">
$HTML .= <<EOM;
</div>
</body>
</html>
EOM

#<div align="center">
#$HTML_ADV = $HTML_ADV_IMG . $HTML_ADV_TEXT if ( !$HTML_ADV );
my $HTML_ADV = '';
$HTML_HEADER = qq {<div style="text-align: center">\n$HTML_ADV\n</div>\n};

&draw_menu();
$HTML =~ s/%HTML_TITLE_OPT%//;
$HTML =~ s/%REFRESH%//;
$HTML =~ s/%SCRIPT%//;
$HTML =~ s/%CSS%//;
$HTML =~ s/%HTML_HEADER%/$HTML_HEADER/;

utf8::encode( $HTML );
print $HTTP_HEADER;
print $HTML;
exit;

sub draw_menu {
	$hires = Time::HiRes::time() - $hires;
	$last_modified = localtime((stat 'rectool.pl')[9]);

	$HTML_HEADER .= qq {<div>\n};
	$HTML_HEADER .= qq {<span style="float: right; font-size: 8px">Last-Modified: $last_modified<br>Time-Elapsed: $hires 秒</span>\n};
	$HTML_HEADER .= qq {<span style="float: left">\n};
	$HTML_HEADER .= qq {<a href="rectool.pl">トップ(検索)</a>\n};
	$HTML_HEADER .= qq {<a href="rectool.pl?mode=schedule">予約確認</a>\n};
	$HTML_HEADER .= qq {<a href="rectool.pl?mode=graph">予約状況(画像版)</a>\n};
	$HTML_HEADER .= qq {<a href="rectool.pl?mode=list">録画一覧</a>\n};
	$HTML_HEADER .= qq {<a href="rectool.pl?mode=bravia">おまかせ</a>\n};
	$HTML_HEADER .= qq {<a href="rectool.pl?mode=expert">玄人仕様</a>\n};
	$HTML_HEADER .= qq {<a href="rectool.pl?mode=proc">復旧支援</a>\n};
	$HTML_HEADER .= qq {<a href="rectool.pl?mode=jbk">地引</a>\n};
	$HTML_HEADER .= qq {<a href="rectool.pl?mode=log">録画履歴</a>\n};
	$HTML_HEADER .= qq {<a href="rectool.pl?mode=recognize">文字認識</a>\n};
	$HTML_HEADER .= qq {<a href="rectool.pl?mode=edit">新規予約</a>\n};
#	$HTML_HEADER .= qq {<a href="../rec10web/rec10web.py">新規予約</a>\n};
	$HTML_HEADER .= qq {</span>\n};
	$HTML_HEADER .= qq {<hr style="clear: both; background-color: grey; height: 4px">\n};
	$HTML_HEADER .= qq {</div>\n};
}

sub draw_form {
	$chname = $params{ 'chname' };
	$chtxt  = $params{ 'chtxt' };
	$key    = $params{ 'key' };
	utf8::decode( $key );
	if ( $chname ) {
		$chtxt = $dbh->selectrow_array("SELECT chtxt FROM epg_ch WHERE chname = '$chname' ");
	}

	$HTML .= qq {<div style="float: left">\n};
	$HTML .= qq {<form method="get" action="rectool.pl">\n};
	$HTML .= qq {<div>\n};
	$HTML .= qq {<input type="hidden" name="mode" value="program">\n};

	# チャンネル指定
	&draw_form_channel();

	# 日付指定
	$HTML .= qq {<select name="date">\n<option value="" selected>無指定</option>\n};
	$ary_ref = $dbh->selectcol_arrayref(
		"SELECT DISTINCT SUBSTRING(start, 1, 8) FROM epg_timeline ORDER BY start"
	);
	$date_sel = $params{ 'date' };
	foreach my $date ( @{ $ary_ref } ) {
		my @date = $date =~ /(.{4})(.{2})(.{2})/;
		$date_prt = "$date[1]/$date[2]";

		if ( $date eq $date_sel ) {
			$HTML .= qq {<option value="$date" selected>$date_prt</option>\n};
		}
		else {
			$HTML .= qq {<option value="$date">$date_prt</option>\n};
		}
	}
	$HTML .= qq {</select>\n};

	# カテゴリ指定
	$HTML .= qq {<select name="category">\n<option value="" selected>無指定</option>\n};
	$category_sel = $params{ 'category' };
	foreach my $category ( keys %category ) {
		if ( $category eq $category_sel ) {
			$HTML .= qq {<option value="$category" selected>$category{$category}->{name}</option>\n};
		}
		else {
			$HTML .= qq {<option value="$category">$category{$category}->{name}</option>\n};
		}
	}
	$HTML .= qq {</select>\n};

	# キーワード指定
	$HTML .= qq {<input name="key" type="text" value="$key" style="width:200px" accesskey="s">\n};

	# フォーム描画
	$HTML .= qq {<input type="submit" value="更新" accesskey="r">\n</div>\n</form>\n};
}

sub draw_form_channel {
	$HTML .= qq {<select name="chtxt">\n};
	$HTML .= qq {<option value="" selected>無指定</option>\n} if ( shift ne 'nonone' );

	foreach my $key ( keys %chtxt_0_chname ) {
		my $value = $chtxt_0_chname{$key};
		if ( ($chtxt && $key eq $chtxt ) || ( $chname && $value eq $chname ) ) {
			$HTML .= qq {<option value="$key" selected>$value</option>\n};
		}
		else {
			$HTML .= qq {<option value="$key">$value</option>\n};
		}
	}
	$HTML .= qq {</select>\n};
}

sub draw_form_opt {
	my $shift = shift;
	my ( %selected, %checked );

	if ( $chtxt  =~ /BS_103/ ) {
		$selected{F} = 'selected';
	}
	elsif ( $chtxt  =~ /CS_239|CS_240|CS_335/ ) {
		$selected{H} = 'selected';
	}
	elsif ( $chtxt =~ /BS_101|BS_102/ || $bctype =~ /cs/ ) {
		$selected{W} = 'selected';
	}
	elsif ( $bctype =~ /bs|te/ ) {
		$selected{H} = 'selected';
	}
	$selected{g} = 'selected';
	$selected{s} = 'selected';
	$checked{a} = $chtxt =~ /CS_331|CS_332|CS_333|CS_334|CS_335/ || $category =~ /アニメ/ ? 'checked' : '';
	$checked{l} = '';
	$checked{d} = $title =~ /\Q[二]\E|［二］|\Q(二)\E|（二）/ ? 'checked' : '';
	$checked{5} = $title =~ /5\.1|5．1/ ? 'checked' : '';
	$checked{2} = 'checked';

	if ( $opt ) {
		undef %checked;
		undef %selected;
		my @opt = split //, $opt;
		foreach my $opt ( @opt ) {
			$selected{$opt} = 'selected' if ( $opt =~ /S|L|G|H|F/ );
			$checked {$opt} = 'checked'  if ( $opt =~ /a|h|l|d|2|5/ );
		}
		$checked{d} = $title =~ /\Q[二]\E|［二］|\Q(二)\E|（二）/ ? 'checked' : '';
		$checked{5} = $title =~ /5\.1|5．1/ ? 'checked' : '';
	}
	# 画質/圧縮率ともに指定されていない場合、真ん中をselectedにする
	$selected{g} = 'selected' unless ( $selected{u} || $selected{i} || $selected{o} || $selected{p} );
	$selected{s} = 'selected' unless ( $selected{q} || $selected{w} || $selected{e} || $selected{r} );

	$HTML .= qq {<select name="opt">\n};
	#$HTML .= qq {<option value="S" $selected{S}>S 720x480</option>\n};
	$HTML .= qq {<option value="W" $selected{W}>W 854x480</option>\n};
	$HTML .= qq {<option value="H" $selected{H}>H 1280x720</option>\n};
	$HTML .= qq {<option value="F" $selected{F}>F 1920x1080</option>\n};
	$HTML .= qq {<option value="I" $selected{I}>I インタレ保持</option>\n};
	$HTML .= qq {</select>\n};

	$HTML .= qq {<select name="opt">\n};
	$HTML .= qq {<option value="u" $selected{u}>最低</option>\n};
	$HTML .= qq {<option value="i" $selected{i}>低</option>\n};
	$HTML .= qq {<option value=""  $selected{g}>画質</option>\n};
	$HTML .= qq {<option value="o" $selected{o}>高</option>\n};
	$HTML .= qq {<option value="p" $selected{p}>最高</option>\n};
	$HTML .= qq {</select>\n};

	$HTML .= qq {<select name="opt">\n};
	$HTML .= qq {<option value="q" $selected{q}>最低</option>\n};
	$HTML .= qq {<option value="w" $selected{w}>低</option>\n};
	$HTML .= qq {<option value=""  $selected{s}>圧縮率</option>\n};
	$HTML .= qq {<option value="e" $selected{e}>高</option>\n};
	$HTML .= qq {<option value="r" $selected{r}>最高</option>\n};
	$HTML .= qq {</select>\n};

	$HTML .= qq {<select name="opt">\n};
	$HTML .= qq {<option value=""  $selected{s}>コンテナ</option>\n};
	$HTML .= qq {<option value="m" $selected{e}>MKV</option>\n};
	$HTML .= qq {<option value="4" $selected{r}>MP4</option>\n};
	$HTML .= qq {</select>\n};

	$HTML .= qq {<select name="opt">\n};
	$HTML .= qq {<option value=""  $selected{s}>モバイル向け</option>\n};
	$HTML .= qq {<option value="1" $selected{e}>QVGA</option>\n};
	$HTML .= qq {<option value="2" $selected{r}>WVGA</option>\n};
	$HTML .= qq {<option value="B" $selected{B}>Blu-ray向け</option>\n};
	$HTML .= qq {</select>\n};

	$HTML .= qq {<input type="checkbox" name="opt" value="a" $checked{a}>24fps(主にアニメ)\n};
	$HTML .= qq {<input type="checkbox" name="opt" value="d" $checked{d}>二ヶ国語放送\n};
	#$HTML .= qq {<input type="checkbox" name="opt" value="2" $checked{2}>2passモード\n};
	$HTML .= qq {<input type="checkbox" name="opt" value="5" $checked{5}>5.1ch放送\n};
	$HTML .= qq {<br>\n};
	$HTML .= qq {<select name="opt">\n};
	$HTML .= qq {<option value="">移動なし</option>\n};
	$HTML .= qq {<option value="R">録画後移動</option>\n};
	$HTML .= qq {<option value="D">解読後移動</option>\n};
	$HTML .= qq {<option value="E">縁故後移動</option>\n};
	$HTML .= qq {</select>\n};
	$HTML .= qq {<input type="checkbox" name="opt"   value="N">ファイル名日時追加\n} if ( $shift eq 'reserve' );
	$HTML .= qq {<input type="checkbox" name="every" value="1">隔週録画\n}           if ( $shift eq 'reserve' );
}

sub parse_program {
	$chname  = $params{ 'chname' };
	$chtxt   = $params{ 'chtxt' };
	$start   = $params{ 'start' };
	$stop    = $params{ 'stop' };
	$bayesid = $params{ 'bayesid' };
	$id      = $params{ 'id' };

	# chtxt と chname を相互に補完
	if ( $chname ) {
		$chtxt = $dbh->selectrow_array("SELECT chtxt FROM epg_ch WHERE chname = '$chname'");
	}
	elsif ( $chtxt && $chtxt_0_chname{$chtxt} ) {
		$chname = $chtxt_0_chname{$chtxt};
		( $chtxt_sql = $chtxt ) =~ s/_0/_%/;
		$bctype = $dbh->selectrow_array("SELECT bctype FROM epg_ch WHERE chtxt LIKE '$chtxt_sql'");
	}
	elsif ( $chtxt ) {
		$chname = $dbh->selectrow_array("SELECT chname FROM epg_ch WHERE chtxt = '$chtxt'")
	}

	# EPGから番組の情報を取得
	( $title, $desc, $longdesc, $category ) = $dbh->selectrow_array(
		"SELECT title, exp, longexp, category
		FROM epg_timeline 
		WHERE channel = '$chtxt' AND start = '$start' AND stop = '$stop' ");
	if ( !$bctype ) {
		$bctype = $dbh->selectrow_array("SELECT bctype FROM epg_ch WHERE chtxt = '$chtxt'");
	}

	if ( $bayesid ) {
		( $chtxt, $title, $begin, $end ) = $dbh->selectrow_array( 
			"SELECT chtxt, title, btime, etime FROM auto_timeline_bayes WHERE id = '$bayesid' " 
		);
		( $chname, $bctype ) = $dbh->selectrow_array( 
			"SELECT chname, bctype FROM epg_ch WHERE chtxt = '$chtxt' " 
		);
		$start = str2datetime( $begin )->strftime( '%Y%m%d%H%M%S' );
		$stop  = str2datetime( $end   )->strftime( '%Y%m%d%H%M%S' );
		( $desc, $longdesc, $category ) = $dbh->selectrow_array( 
			"SELECT exp, longexp, category FROM epg_timeline WHERE channel = '$chtxt' AND start = '$start' AND stop = '$stop' " 
		);
	}
	if ( $id ) {
		( $type, $chtxt, $title, $begin, $end, $deltaday, $deltatime, $opt, $counter ) = $dbh->selectrow_array( 
			"SELECT type, chtxt, title, btime, etime, deltaday, deltatime, opt, counter 
			FROM timeline WHERE id = '$id' " 
		);
		&chtxt_format();
		( $chname, $bctype ) = $dbh->selectrow_array( 
			"SELECT chname, bctype FROM epg_ch WHERE chtxt LIKE '$chtxt_sql' " 
		);
		$start = str2datetime( $begin )->strftime( '%Y%m%d%H%M%S' );
		$stop  = str2datetime( $end   )->strftime( '%Y%m%d%H%M%S' );
		( $desc, $longdesc, $category ) = $dbh->selectrow_array( 
			"SELECT exp, longexp, category FROM epg_timeline WHERE channel = '$chtxt' AND start = '$start' AND stop = '$stop' " 
		);
	}
	# set $chtxt_0, $chtxt_sql, $bctype_sql
	&chtxt_format();
	#( $chtxt_no0 ) = $chtxt   =~ /(\d+)_/;
	@start = $start =~ /(.{4})(.{2})(.{2})(.{2})(.{2})/;
	@stop  = $stop  =~ /(.{4})(.{2})(.{2})(.{2})(.{2})/;
	$begin = sprintf( '%04d-%02d-%02d %02d:%02d:%02d', @start, '00' );
	$end   = sprintf( '%04d-%02d-%02d %02d:%02d:%02d', @stop , '00' );

	if ( $params{ 'title' } ) {
		$title = $params{ 'title' };
		utf8::decode( $title );
	}
	$HTML .= qq {<!-- chtxt=$chtxt chtxt_0=$chtxt_0 chtxt_sql=$chtxt_sql bctype=$bctype -->\n};
}

sub check_error {
	my $is_error;
	my $is_same = $dbh->selectrow_array( 
		"SELECT COUNT(*) FROM timeline WHERE chtxt = '$chtxt' AND btime = '$begin' AND etime = '$end'" 
	);
	my @overlap = &get_overlap();

	if ( $is_same ) {
		$HTML .= "同一の番組が既に存在します。<br>\n";
		$is_error = 1;
	}
	elsif ( $overlap[0] >= 2 ) {
		$HTML .= "時間が被る番組が既に2個存在します。<br>\n";
		$HTML .= $overlap[1];
		$is_error = 2;
	}
	else {
		$is_error = 0;
	}
	return $is_error;
}

sub get_overlap {
	my $ary_ref = $dbh->selectall_arrayref(
		"SELECT btime, etime, title
		FROM timeline 
		INNER JOIN epg_ch ON timeline.chtxt = epg_ch.chtxt 
		WHERE bctype LIKE '$bctype_sql' AND type IN $type_user_made 
		AND btime < '$end' 
		AND etime > '$begin' 
		"
	);

	my %overlap;
	my $overlap = $max = 0;
	my $str;
	foreach my $prg ( @{ $ary_ref } ) {
		$str .= "$prg->[0] ? $prg->[1] : $prg->[2]<br>\n";
		$overlap{$prg->[0]} += 1;
		$overlap{$prg->[1]} -= 1;
	}
	foreach my $key ( sort keys %overlap ) {
		$overlap += $overlap{$key};
		$max = List::Util::max( $max, $overlap );
	}
	if ( wantarray ) {
		return ( $max, $str );
	}
	else {
		return $max;
	}
}

sub get_file_list_wrapper {
	local $base_dir = shift;
	local $ptr = shift;

	&get_file_list( $base_dir );
}

sub get_file_list{
	my $dir = shift;

	opendir ( DIR, $dir );
	my @list = sort readdir( DIR );
	closedir( DIR );

	foreach my $file ( @list ) {
		next if ( $file =~ /^\.{1,2}$/ );
		if ( -d "$dir/$file" ){
			&get_file_list("$dir/$file");
		}
		else{
			$abs = "$dir/$file";
			utf8::decode( $abs );
			( $rel ) = $abs =~ /^$base_dir\/(.*)$/;
			$ptr->( $rel, $abs );
		}
	}
}

sub strisjoined {
	my $str = shift;

	return $str =~ /.{4}-.{2}-.{2} .{2}:.{2}:.{2}/ ? 0 : 1;
}

sub str2datetime {
	my $str    = shift;
	my @time;

	if ( strisjoined( $str ) ) {
		@time = $str =~ /(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/;
	}
	else {
		@time = $str =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/;
	}
	return DateTime->new(
		year   => $time[0], month     => $time[1], day    => $time[2],
		hour   => $time[3], minute    => $time[4], second => $time[5], 
		locale => 'ja_JP' , time_zone => $tz
	);
}

sub str2dayname {
	my  $str = shift;
	our %day_name_cache;

	if ( !$day_name_cache{$str} ) {
		$day_name_cache{$str} = str2datetime( $str )->day_name;
	}
	return $day_name_cache{$str};
}

sub str2readable { 
	my $begin = shift;
	my $end   = shift;

	my $dt_begin = ref( $begin ) eq 'DateTime' ? $begin : &str2datetime( $begin );
	my $dt_end   = ref( $end   ) eq 'DateTime' ? $end   : &str2datetime( $end );

	my $str_begin = $dt_begin->strftime( '%m/%d(%a) %H:%M' );
	my $str_end   = $dt_end  ->strftime( $dt_begin->day == $dt_end->day ? '%H:%M' : '翌 %H:%M' );
	# utf8::encode( $str_begin );

	my ( $sec, $min, $hour );
	$sec  = $dt_end->epoch - $dt_begin->epoch;
	$min  = int( $sec / 60 );
	$sec  = $sec - $min * 60;
	$hour = int( $min / 60 );
	$min  = $min - $hour * 60;
	my $str_diff = '';
	$str_diff .= $hour . '時間' if ( $hour );
	$str_diff .= $min  . '分'   if ( $min );
	$str_diff .= $sec  . '秒'   if ( $sec );

	return ( $str_begin, $str_end, $str_diff );
}

sub sqlgetsuggested {
	my ( $btime, $etime ) = @_;
	$deltatime = 3 if ( !$deltatime );

	$btime_bgn = $btime->clone->subtract( hours => $deltatime )->strftime( '%Y%m%d%H%M%S' );
	$btime_end = $btime->clone->add(      hours => $deltatime )->strftime( '%Y%m%d%H%M%S' );
	$etime_bgn = $etime->clone->subtract( hours => $deltatime )->strftime( '%Y%m%d%H%M%S' );
	$etime_end = $etime->clone->add(      hours => $deltatime )->strftime( '%Y%m%d%H%M%S' );

	$ary_ref = $dbh->selectall_arrayref(
		"SELECT start, stop, title, exp 
		FROM epg_timeline 
		WHERE channel LIKE '$chtxt_sql' 
		AND start BETWEEN '$btime_bgn' AND '$btime_end' 
		AND stop  BETWEEN '$etime_bgn' AND '$etime_end' "
	);
	#die Dumper $ary_ref;

	my %hash;
	my $hash_r = ngram_counts( $title, 2 ); # bi-gram
	foreach my $program ( @{$ary_ref} ) {
		no warnings;
		my $hash_k = ngram_counts( $program->[2], 2 );
		my $point;
		map $point += $hash_k->{$_}, keys %{$hash_r};
		push @{$hash{$point}}, $program if ( $point );
	}

	return %hash;
}

sub ngram_counts {
	my $str  = shift;
	my $klen = shift;
	my $slen = length($str);  

	my $href;
	for (my $i=0; $i < $slen-$klen+1; $i++){  
		$href->{substr($str, $i, $klen)}++;
	}
	return $href;
}

sub chtxt_format {
	( $chtxt_0   = $chtxt ) =~ s/(\d+)_\d+/$1_0/;
	( $chtxt_sql = $chtxt ) =~ s/(\d+)_\d+/$1_%/;
	if ( $bctype =~ /bs|cs/ ) {
		$bctype_sql = '_s%';
	}
	elsif ( $bctype =~ /te/ ) {
		$bctype_sql = 'te%';
	}
}

