OSDN Git Service

update rectool.pl, improve rpm
authorlonginus <longinus@4e526526-5e11-4fc0-8910-f8fd03428081>
Sat, 14 Jan 2012 16:59:40 +0000 (16:59 +0000)
committerlonginus <longinus@4e526526-5e11-4fc0-8910-f8fd03428081>
Sat, 14 Jan 2012 16:59:40 +0000 (16:59 +0000)
git-svn-id: svn+ssh://svn.sourceforge.jp/svnroot/rec10@900 4e526526-5e11-4fc0-8910-f8fd03428081

rectool/trunk/Makefile.PL
rectool/trunk/makerpm.sh [new file with mode: 0755]
rectool/trunk/rec10.conf [moved from rectool/trunk/rpm/SOURCES/rec10.conf with 100% similarity]
rectool/trunk/rectool.pl
rectool/trunk/rectool.spec [moved from rectool/trunk/rpm/SPECS/rectool.spec with 98% similarity]
rectool/trunk/rpm/SOURCES/rectool.pl [deleted file]

index cd8fba3..a125512 100755 (executable)
@@ -31,17 +31,17 @@ my @packages = (
        [ 'Date::Simple'         , 'yes', 'yes' ], 
        [ 'DateTime'             , 'yes', 'yes' ], 
        [ 'DBI'                  , 'yes', 'yes' ], 
-       [ 'MIME::Base64'         , 'no' , 'yes' ], 
+#      [ 'MIME::Base64'         , 'no' , 'yes' ], # in standard module
        [ 'File::Slurp'          , 'yes', 'yes' ], 
        [ 'Sort::Naturally'      , 'yes', 'yes' ], 
        [ 'Time::Piece'          , 'yes', 'yes' ], 
-#      [ 'Time::Seconds'        , 'no' , 'no'  ], in perl-Time-Piece
-       [ 'Time::HiRes'          , 'no' , 'yes' ], 
+#      [ 'Time::Seconds'        , 'no' , 'no'  ], in perl-Time-Piece
+#      [ 'Time::HiRes'          , 'no' , 'yes' ], # in standard module 
        [ 'Tie::IxHash'          , 'yes', 'yes' ], 
 #      [ 'required'             , 'by' , 'cgi' ], 
        [ 'Text::Ngram'          , 'no' , 'no'  ], 
        [ 'List::Compare'        , 'yes', 'yes' ], 
-#      [ 'List::Util'           , 'no' , 'no'  ], in standard module
+#      [ 'List::Util'           , 'no' , 'no'  ], in standard module
        [ 'XML::Atom'            , 'yes', 'yes' ], 
 );
 
diff --git a/rectool/trunk/makerpm.sh b/rectool/trunk/makerpm.sh
new file mode 100755 (executable)
index 0000000..b4990ab
--- /dev/null
@@ -0,0 +1,21 @@
+#!/bin/sh
+# Create RPM files for rec10-rectool
+
+
+RPMBUILD=`mktemp -d $HOME/rpmbuild.XXXXXX`
+#RPMMACRO=`mktemp    $HOME/.rpmmacros.XXXXXX`
+echo "Build directory $RPMBUILD"
+mkdir -p $RPMBUILD/{BUILD,RPMS,SOURCES,SPECS,SRPMS}
+cp {rectool.pl,rec10.conf} $RPMBUILD/SOURCES
+cp rectool.spec $RPMBUILD/SPECS
+echo "%_topdir $RPMBUILD" > ~/.rpmmacros
+rpmbuild -ba "$RPMBUILD/SPECS/rectool.spec"
+cp $RPMBUILD/RPMS/noarch/* .
+cp $RPMBUILD/SRPMS/* .
+
+#sleep 5
+#read -p "Press Enter key to exit."
+echo 'Remove build directory'
+rm -r $RPMBUILD
+#rm $RPMMACRO
+
index a993c4d..e1b38b9 100755 (executable)
-#!/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 CGI::Carp qw( fatalsToBrowser );
-use warnings;
-use DBI;
-use Time::Piece;
-use Time::Seconds;
-use Date::Simple;
-use DateTime;
-use CGI;
-use MIME::Base64;
-use Config::Simple;
-use Time::HiRes;
-use Data::Dumper::Concise;
-use Tie::IxHash;
-use File::Slurp;
-use Sort::Naturally;
-use Algorithm::Diff qw(LCS);
-#require SVG Time::Simple XML::Atom Encode Text::Ngram List::Compare List::Util
-use utf8;
-#%DB::packages = ( 'main' => 1 );
-
-
-################ バージョン定義 ################
-
-
-my $rectool_version = 100;
-
-
-################ 初期化ここから ################
-
-
-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"
-);
-
-%chtxt_chname = map { $_->[0], $_->[1] } @{$ary_ref};
-
-# NHK BS 1/2/hiをBS/CSから除外(101-103) - by 2011/04
-# te: 地上波、BSのNHK以外
-# bc: BSのNHK、CS
-my @te_ary = grep $_->[0]=~ /^\d|BS_(?!10[1-3])/, @{$ary_ref};
-my @bc_ary = grep $_->[0]!~ /^\d|BS_(?!10[1-3])/, @{$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' )";
-
-%category = (
-       'etc'         => 'その他', 
-       'news'        => 'ニュース・報道', 
-       'variety'     => 'バラエティ', 
-       'anime'       => 'アニメ・特撮', 
-       'information' => '情報', 
-       'drama'       => 'ドラマ', 
-       'sports'      => 'スポーツ', 
-       'music'       => '音楽', 
-       'cinema'      => '映画', 
-);
-
-
-################ 初期化ここまで ################
-
-
-################ 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";
-
-               require SVG;
-               $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} = 2; #$cfg->param( 'env.te_max' );
-               $tuner{satellite}   = 2; #$cfg->param( 'env.bscs_max' );
-               $tuner{all} = $tuner{terrestrial} + $tuner{satellite};
-               $hours = 24;
-               $width = 30 * $hours;
-
-               $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->rectangle( 'x' => 50, 'y' => $_ * 20 + 10, width => $width, height => 10 );
-               }
-               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' } );
-               }
-               foreach my $bctype ( 'te%', '_s%' ) {
-                       my $tuner = $bctype eq 'te%' ? $tuner{terrestrial} : $tuner{satellite};
-                       my $ary_ref = $dbh->selectall_arrayref(
-                               "SELECT id, title, timeline.chtxt, btime, etime, opt FROM timeline 
-                               INNER JOIN epg_ch ON timeline.chtxt = epg_ch.chtxt 
-                               WHERE epg_ch.bctype LIKE '$bctype' 
-                               AND 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 id"
-                               , {Slice=>{}}
-                       );
-                       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 = $dbh->selectall_arrayref( 
-                                       "SELECT id, type, timeline.chtxt, title, btime, etime, opt FROM timeline 
-                                       INNER JOIN epg_ch ON timeline.chtxt = epg_ch.chtxt 
-                                       WHERE epg_ch.bctype LIKE '$bctype' 
-                                       AND type IN $type_user_made 
-                                       AND NOT 
-                                       ( 
-                                               ( etime <= '$begin' ) 
-                                                       OR 
-                                               ( btime >= '$end'   ) 
-                                       ) 
-                                       ORDER BY id" 
-                                       , {Slice=>{}}
-                               );
-                               my @ary = @{$ary};
-                               for ( 0..$tuner - 1 ) {
-                                       my $f = 1;
-                                       my $i = $_;
-                                       for ( 'chtxt', 'btime', 'etime' ) {
-                                               $f = 0 if ( $line->{$_} ne $ary[$i]->{$_} );
-                                       }
-                                       if ( $f ) {
-                                               $slot = $i;
-                                       }
-                               }
-                               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 'te%' ? 0 : $tuner{terrestrial} * 20 ) + $slot * 20, 
-                                       width  => $stop - $start, 
-                                       height => 10, 
-                                       style  => { fill => "rgb($r,$g,$b)" } );
-                       }
-               }
-               print $svg->xmlify;
-               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、赤はアニメ、緑はHD、青はインターレースを示しています。<br>\n};
-               $HTML .= qq {SVGが利用可能なブラウザでご覧ください。<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' ) {
-       require XML::Atom::Feed;
-       require XML::Atom::Entry;
-
-       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";
-               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}'";
-               $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};
-
-       my $recording   = $cfg->param( 'path.recpath' );
-       my $ts_movepath = $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 ) {
-               $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( $ts_movepath );
-               &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 );
-               $help .= qq {<td colspan="2">自動移動</td>\n</tr>\n};
-               $help .= qq {<tr>\n</tr>\n};
-
-               $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 {<th colspan="2">自動移動</th>\n};
-               $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 $check = qq {<td><a href="rectool.pl?mode=list&amp;mode_sub=log&amp;title=$title">○</a></td>\n};
-
-                                       $value->{$exp}->{check} = $check;
-                               }
-                               elsif ( $exp eq 'mkv' ) {
-                                       my $title = $q->escape( $title );
-
-                                       my $check = qq {<td><a title="$value->{$exp}->{size}" href="rectool.pl?mode=thumb&amp;title=$title">■</a></td>\n};
-                                       $value->{$exp}->{check} = $check;
-                               }
-                               $flag[$exp{$exp}] = $value->{$exp};
-                       }
-                       if ( !$flag[$exp{'mkv'}] ) {
-                               $flag[@flag]->{check} = qq {<td colspan="2"><br></td>\n};
-                       }
-                       else {
-                               my $title = $q->escape( $title );
-
-                               $flag[@flag]->{check} = 
-                                       qq {<td><a href="rectool.pl?mode=change&amp;mode_sub=move&amp;mode_sub2=predict&amp;title=$title">予測</a></td>\n}.
-                                       qq {<td><a href="rectool.pl?mode=change&amp;mode_sub=move&amp;mode_sub2=exec&amp;title=$title">実行</a></td>\n};
-                       }
-                       foreach ( @flag ) {
-                               my $size = $_->{size};
-                               my $last = $_->{last} || ( $_->{size} eq '0 B' ? '◆' : '○' );
-                               my $check =  $size ? qq {<span title="$size">$last</span>} : '<br>';
-                               $HTML .= $_->{check} ? $_->{check} : qq {<td>$check</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, $last ) = &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} = { 'last' => $last, 'size' => $size };
-               }
-       }
-
-       sub simple_list {
-               local $path = shift;
-               local @list = ();
-
-               &get_file_list_wrapper( $path, \&simple_wanted );
-
-#              @list = sort @list;
-               # natural sortを行う
-                       #@list = map( Encode::decode_utf8( $_ ), @list );
-                       @list = nsort @list;
-                       #@list = map( Encode::encode_utf8( $_ ), @list );
-
-               foreach ( @list ) {
-                       $HTML .= "$_<br>\n";
-               }
-
-               sub simple_wanted {
-                       my $rel = shift;
-                       my $abs = shift;
-
-                       my ( $size ) = &get_size( $abs );
-                       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 ) {
-                       $last = '●';
-               }
-               else {
-                       $last = '';
-               }
-               return ( "$size $unim[$count]", $last );
-       }
-}
-
-################ 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 {</tr>\n};
-
-       my $ary_ref = $dbh->selectall_arrayref(
-               "SELECT id, keyword, auto 
-               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><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 " 
-               , {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' ) {
-       require List::Compare;
-
-       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;
-       }
-
-
-       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 = 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};
-
-
-       $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 );
-               }
-
-
-       $ary_ref = $dbh->selectall_arrayref( 
-               "SELECT chname, chtxt, bctype, ch, csch, updatetime, status, visible 
-               FROM epg_ch 
-               ORDER BY bctype " );
-       $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>最終更新時刻</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 {</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 chname, bctype 
-               FROM epg_ch WHERE bctype NOT LIKE '_s%' "
-       );
-       foreach my $line ( @{$ary_ref} ) {
-               $HTML .= qq {<option value="$line->[1]">$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( 'config.ini' );
-       $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}</option>\n};
-               }
-               else {
-                       $HTML .= qq {<option value="$category">$category{$category}</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 {</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' };
-
-       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'")
-       }
-       ( $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' " 
-               );
-               ( $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 ( $bctype =~ /bs|cs/ ) {
-               $bctype_sql = '_s%';
-       }
-       elsif ( $bctype =~ /te/ ) {
-               ( $chtxt_0   = $chtxt ) =~ s/(\d+)_.*/$1_0/;
-               ( $chtxt_sql = $chtxt ) =~ s/_0/_%/;
-               $bctype_sql = 'te%';
-       }
-       #( $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 {
-       require List::Util;
-
-       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 {
-       require Text::Ngram;
-
-       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 = Text::Ngram::ngram_counts( $title, 2 ); # bi-gram
-       foreach my $program ( @{$ary_ref} ) {
-               my $hash_k = Text::Ngram::ngram_counts( $program->[2], 2 );
-               my $point;
-               map $point += $hash_k->{$_}, keys %{$hash_r};
-               push @{$hash{$point}}, $program if ( $point );
-       }
-
-       return %hash;
-}
+#!/usr/bin/perl\r
+# -d:SmallProf\r
+#use Perl6::Slurp;\r
+#use XML::Simple;\r
+#use CGI;\r
+#use CGI::Lite;\r
+#use Date::Manip;\r
+#Date_Init("TZ=JST","ConvTZ=JST");\r
+#use SVG;\r
+#use KCatch;\r
+use warnings;\r
+use Algorithm::Diff qw(LCS);\r
+use Archive::Zip;\r
+use CGI;\r
+use CGI::Carp qw( fatalsToBrowser warningsToBrowser );\r
+use Config::Simple;\r
+use Data::Dumper;\r
+use Date::Simple;\r
+use DateTime;\r
+use DBI;\r
+use MIME::Base64;\r
+use Perl6::Slurp;\r
+use Sort::Naturally;\r
+use Time::Piece;\r
+use Time::Seconds;\r
+use Time::HiRes;\r
+use Tie::IxHash;\r
+#require SVG Time::Simple XML::Atom Encode Text::Ngram List::Compare List::Util\r
+use utf8;\r
+#%DB::packages = ( 'main' => 1 );\r
+\r
+\r
+################ バージョン定義 ################\r
+\r
+\r
+my $rectool_version = 101;\r
+\r
+\r
+################ 初期化ここから ################\r
+\r
+\r
+my $tz = DateTime::TimeZone->new( name => 'local' );\r
+my $hires = Time::HiRes::time();\r
+\r
+my $cfg = new Config::Simple;\r
+if ( -e 'rec10.conf' ) {\r
+       $cfg->read( 'rec10.conf' );\r
+}\r
+elsif ( -e '/etc/rec10.conf' ) {\r
+       $cfg->read( '/etc/rec10.conf' );\r
+}\r
+else { \r
+       die 'rec10.confが見つかりません。';\r
+}\r
+\r
+my $sql = $cfg->param( 'db.db' );\r
+\r
+if ( $sql eq 'MySQL' ) {\r
+       my $name = $cfg->param( 'db.mysql_dbname' );\r
+       my $host = $cfg->param( 'db.mysql_host' );\r
+       my $port = $cfg->param( 'db.mysql_port' );\r
+       my $user = $cfg->param( 'db.mysql_user' );\r
+       my $pass = $cfg->param( 'db.mysql_passwd' );\r
+       $dbh = DBI->connect("dbi:mysql:$name:$host:$port", $user, $pass, {\r
+               AutoCommit => 1,\r
+               RaiseError => 1,\r
+               mysql_enable_utf8 => 1, # only availavle for MySQL\r
+       });\r
+       $dbh->do( 'SET NAMES utf8' );\r
+}\r
+\r
+my $rec10_version = eval {\r
+       $dbh->selectrow_array( "SELECT version FROM in_status " );\r
+};\r
+\r
+my $HTML;\r
+\r
+$HTTP_HEADER = "Content-Type: text/html\n\n";\r
+$HTML .= <<EOM;\r
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">\r
+<html lang="ja">\r
+<head>\r
+<title>Rec10%HTML_TITLE_OPT%</title>\r
+<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">\r
+<meta http-equiv="Content-Script-Type" content="text/javascript">\r
+<meta http-equiv="Content-Style-Type" content="text/css">\r
+<meta name="robots" content="noindex,nofollow,noarchive">\r
+<link rev="made" href="Rea10">\r
+<link rel="alternate" type="application/atom+xml" title= "Rec10 Atom Feed" href="./rectool.pl?mode=atom">\r
+%REFRESH%\r
+%SCRIPT%\r
+%CSS%\r
+</head>\r
+<body>\r
+%HTML_HEADER%\r
+EOM\r
+\r
+my ( $user, $pass, $auth );\r
+( $user, $pass ) = eval {\r
+       $dbh->selectrow_array( "SELECT webuser, webpass FROM in_settings " );\r
+};\r
+\r
+if ( $user and $pass ) {\r
+       if ( $ENV{'HTTP_AUTHORIZATION'} ) {\r
+               my ( $base64 ) = $ENV{'HTTP_AUTHORIZATION'} =~ /Basic\s(.*)/;\r
+               if ( $base64 eq encode_base64( "$user:$pass" ) ) {\r
+                       $auth = 1;\r
+               }\r
+               else {\r
+                       $auth = 0;\r
+               }\r
+       }\r
+       else {\r
+               $auth = 0;\r
+       }\r
+}\r
+else {\r
+       $auth = 1;\r
+}\r
+\r
+if ( !$auth ) {\r
+       my ( $base64 ) = $ENV{'REMOTE_USER'} =~ /Basic (.*)/;\r
+       $HTTP_HEADER = qq {Status: 401 Authorization Required\nWWW-Authenticate: Basic realm="Protected Rec10 $ENV{'HTTP_AUTHORIZATION'}"\n} . $HTTP_HEADER;\r
+       goto end;\r
+}\r
+\r
+if ( $rec10_version != $rectool_version ) {\r
+       $HTML .= qq {<div style="font-size: 200%; font-weight: bold; color: red">\n};\r
+\r
+       if ( $rec10_version > $rectool_version ) {\r
+               $HTML .= qq {Rec10本体のバージョンが新しいため、実行できません。<br>\n};\r
+               $HTML .= qq {rectoolのバージョンアップを行ってください。<br>\n};\r
+       }\r
+\r
+       if ( $rec10_version < $rectool_version ) {\r
+               $HTML .= qq {Rec10本体のバージョンが古いため、実行できません。<br>\n};\r
+               $HTML .= qq {Rec10のバージョンアップを行ってください。<br>\n};\r
+       }\r
+\r
+       $HTML .= qq {Rec10のバージョンは$rec10_version 、rectoolのバージョンは$rectool_version です。<br>\n};\r
+       $HTML .= qq {<a href="http://sourceforge.jp/projects/rec10/">公式ページ</a>\n};\r
+       goto end;\r
+}\r
+\r
+$q = new CGI;\r
+%params = $q->Vars;\r
+$mode = $params{ 'mode' };\r
+$mode_sub = $params{ 'mode_sub' };\r
+\r
+################ %chtxt_chnameの準備 ################\r
+\r
+my %chtxt_chname;\r
+my %chtxt_0_chname;\r
+tie %chtxt_0_chname, 'Tie::IxHash';\r
+\r
+my $ary_ref = $dbh->selectall_arrayref(\r
+       "SELECT chtxt, chname, ch, bctype FROM epg_ch\r
+       WHERE visible = 1"\r
+);\r
+\r
+%chtxt_chname = map { $_->[0], $_->[1] } @{$ary_ref};\r
+\r
+# NHK BS 1/2/hiをBS/CSから除外(101-103) - by 2011/04\r
+# te: 地上波、BSのNHK以外\r
+# bc: BSのNHK、CS\r
+my @te_ary = grep $_->[0]=~ /^\d|BS_(?!(10|19)[1-3])/, @{$ary_ref};\r
+my @bc_ary = grep $_->[0]!~ /^\d|BS_(?!(10|19)[1-3])/, @{$ary_ref};\r
+\r
+# teの操作(まとめる)\r
+foreach my $line ( @te_ary ) {\r
+       # te xx_yyyy(chtxt) -> xx(ch)\r
+       if ( $line->[3] =~ /te/ ) {\r
+               push @{ $chtxt_0_chname{        $line->[2] . '_0'} }, $line->[1];\r
+       }\r
+       else {\r
+               push @{ $chtxt_0_chname{'BS_' . $line->[2]       } }, $line->[1];\r
+       }\r
+}\r
+foreach my $key ( keys %chtxt_0_chname ) {\r
+       my @chname = @{ $chtxt_0_chname{$key} };\r
+       if ( @chname >= 2 ) {\r
+               # 2つ以上ある場合\r
+               my @tmp = map { my @ary = split //, $_; \@ary } @chname;\r
+               # 1つ目と2つ目のみ比較\r
+               # FIXME: すべてを比較するべき\r
+               $chtxt_0_chname{$key} = join '', LCS( $tmp[0], $tmp[1] );\r
+       }\r
+       else {\r
+               # 1つしかない場合\r
+               $chtxt_0_chname{$key} = $chname[0];\r
+       }\r
+}\r
+\r
+# bs/csの操作(そのまま)\r
+foreach my $line ( @bc_ary ) {\r
+       $chtxt_0_chname{$line->[0]} = $line->[1];\r
+}\r
+undef $ary_ref;\r
+\r
+\r
+################ 定数宣言 ################\r
+\r
+\r
+tie %type, 'Tie::IxHash';\r
+%type = (\r
+       'search_everyday'          => '隔日検索',\r
+       'search_today'             => '当日検索',\r
+       'reserve_flexible'         => '浮動予約',\r
+       'reserve_fixed'            => '確定予約',\r
+\r
+       'reserve_running'          => '録画途中',\r
+\r
+       'convert_b25_ts'           => '解読予約',\r
+       'convert_b25_ts_running'   => '解読途中',\r
+       'convert_b25_ts_miss'      => '解読失敗',\r
+\r
+       'convert_ts_mp4'           => '縁故予約',\r
+       'convert_ts_mp4_running'   => '縁故於鯖',\r
+       'convert_ts_mp4_network'   => '縁故於網',\r
+       'convert_ts_mp4_finished'  => '縁故完了',\r
+\r
+       'convert_avi_mkv'          => '変換旧露',\r
+       'convert_avi_mp4'          => '変換旧四',\r
+       'convert_mkv_mp4'          => '変換露四',\r
+       'convert_mkv_mp4_runnings' => '換途露四',\r
+\r
+       'auto_suggest_dec'         => '予測解読',\r
+       'auto_suggest_enc'         => '予測縁故',\r
+       'auto_suggest_avi2fp'      => '予測旧四',\r
+       'auto_suggest_ap2fp'       => '予測露四',\r
+\r
+       'move_end'                 => '移動完了',\r
+);\r
+\r
+%type_suggest = (\r
+       'auto_suggest_dec'    => 'convert_b25_ts',\r
+       'auto_suggest_enc'    => 'convert_ts_mp4',\r
+       'auto_suggest_avi2fp' => 'convert_avi_mkv',\r
+       'auto_suggest_ap2fp'  => 'convert_mp4_mkv',\r
+);\r
+\r
+%color = (\r
+       'search_everyday'        => '#8B008B',\r
+       'search_today'           => '#8B008B',\r
+       'reserve_flexible'       => '#4169E1',\r
+       'reserve_fixed'          => '#4169E1',\r
+       'reserve_running'        => '#FF8C00',\r
+       'convert_b25_ts'         => '#CD5C5C',\r
+       'convert_b25_ts_running' => '#DC143C',\r
+       'convert_ts_mp4'         => '#32CD32',\r
+       'convert_ts_mp4_running' => '#2E8B57',\r
+       'convert_ts_mp4_network' => '#808000',\r
+\r
+       'other'                  => '#A0A0A0',\r
+);\r
+\r
+$type_user_made = "( 'search_everyday', 'search_today', 'reserve_flexible', 'reserve_fixed', 'reserve_running' )";\r
+\r
+tie %category, 'Tie::IxHash';\r
+%category = (\r
+       'news'        => { name => 'ニュース・報道'          , color => '#ff0000' }, \r
+       'sports'      => { name => 'スポーツ'                , color => '#ff8000' }, \r
+       'information' => { name => '情報'                    , color => '#ffff00' }, \r
+       'drama'       => { name => 'ドラマ'                  , color => '#80ff00' }, \r
+       'music'       => { name => '音楽'                    , color => '#00ff00' }, \r
+       'variety'     => { name => 'バラエティ'              , color => '#00ff80' }, \r
+       'cinema'      => { name => '映画'                    , color => '#00ffff' }, \r
+       'anime'       => { name => 'アニメ・特撮'            , color => '#0080ff' }, \r
+       'documentary' => { name => 'ドキュメンタリー・教養'  , color => '#0000ff' }, \r
+       'stage'       => { name => '演劇'                    , color => '#8000ff' }, \r
+       'hobby'       => { name => '趣味・実用'              , color => '#ff00ff' }, \r
+       'etc'         => { name => 'その他'                  , color => '#ff0080' }, \r
+);\r
+\r
+################ 初期化ここまで ################\r
+\r
+\r
+################ mode=schedule ################\r
+\r
+if ( $mode eq 'schedule' ) {\r
+\r
+       $HTML =~ s/%HTML_TITLE_OPT%/ - Schedule Viewer/;\r
+       #$HTML =~ s|%REFRESH%|<meta http-equiv="refresh" content="300">|;\r
+       $css = <<EOM;\r
+               <style type="text/css">\r
+               td {\r
+                       white-space: nowrap;\r
+               }\r
+               </style>\r
+EOM\r
+       $css =~ s/^\t{2}//gm;\r
+       $HTML =~ s/%CSS%/$css/;\r
+\r
+       my $order = $params{ 'order' };\r
+       my $extra = $params{ 'extra' };\r
+       if ( $order ne 'id' ) {\r
+               $order = 'btime';\r
+       }\r
+       $reverse_extra = $extra            ? '' : '&amp;extra=1';\r
+       $forward_order = $order eq 'btime' ? '' : '&amp;order=id';\r
+\r
+       my $ary_ref = $dbh->selectall_arrayref(\r
+               "SELECT id, type, timeline.chtxt, epg_ch.chname, title, btime, etime, opt, deltaday, deltatime, \r
+               epgtitle, epgbtime, epgetime, epgexp, epgduplicate, epgchange, counter \r
+               FROM timeline \r
+               LEFT OUTER JOIN epg_ch ON timeline.chtxt = epg_ch.chtxt \r
+               ORDER BY $order"\r
+               , {Slice=>{}});\r
+\r
+       $HTML .= qq {<div style="font-size: 80%; float: left">\n};\r
+       $HTML .= qq {<form method="get" action="rectool.pl">\n};\r
+       $HTML .= qq {<div>\n};\r
+       $HTML .= qq {<input type="hidden" name="mode" value="change">\n};\r
+       $HTML .= qq {<table summary="rectimetable" border=1 cellspacing=0>\n<tr>\n};\r
+       $HTML .= qq {<th><a href="rectool.pl?mode=schedule$forward_order$reverse_extra">■</a></th>\n};\r
+       $HTML .= qq {<th><a href="rectool.pl?mode=schedule&amp;order=id">ID</a></th>\n};\r
+       $HTML .= qq {<th>タイプ</th>\n};\r
+       $HTML .= qq {<th>チャンネル</th>\n};\r
+       $HTML .= qq {<th>タイトル</th>\n};\r
+       $HTML .= qq {<th><a href="rectool.pl?mode=schedule">開始時刻</a></th>\n};\r
+       $HTML .= qq {<th>終了時刻</th>\n};\r
+       $HTML .= qq {<th>録画時間</th>\n};\r
+       $HTML .= qq {<th>オプション</th>\n};\r
+       $HTML .= qq {<th>dd</th>\n};\r
+       $HTML .= qq {<th>dt</th>\n};\r
+       $HTML .= qq {<th>残り</th>\n};\r
+       $HTML .= qq {</tr>\n};\r
+       foreach my $line ( @{ $ary_ref } ) {\r
+\r
+               $type = $type{$line->{type}} || $line->{type};\r
+               if    ( $line->{type} =~ /^search/ ) {\r
+                       $type = qq {<span style="color: #8B008B">$type</span>};\r
+                       $line->{deltaday} = qq {<span style="color: #FF0000">空</span>} if ( !$line->{deltaday} && $line->{type} eq 'search_everyday' );\r
+                       $line->{deltatime} = qq {<span style="color: #FF0000">空</span>} if ( !$line->{deltatime} );\r
+               }\r
+               else {\r
+                       my $color = $color{$line->{type}} ? $color{$line->{type}} : $color{'other'};\r
+                       $type = qq {<span style="color: $color">$type</span>};\r
+               }\r
+               # 地上波の場合、xx_yyyをxx_0に置換する\r
+               ( $line->{chtxt_0} = $line->{chtxt} ) =~ s/(\d+)_/$1_0/;\r
+               # chnameが無いとき(移動縁故など)、chtxtを代わりに使う\r
+               $line->{chname} = \r
+                       $line->{chname} || \r
+                       $chtxt_0_chname{$line->{chtxt}} || \r
+                       $chtxt_0_chname{$line->{chtxt_0}};\r
+               if ( !$line->{chname} ) {\r
+                       # chnameが無いとき、リンクを作成しない\r
+                       $line->{chname} = $line->{chtxt};\r
+                       $line->{chname_link} = qq {$line->{chname}</a>};\r
+               }\r
+               else {\r
+                       $line->{chname_link} = qq {<a href="rectool.pl?mode=program&amp;chtxt=$line->{chtxt}">$line->{chname}</a>};\r
+               }\r
+               $line->{title} = 'タイトルなし' if ( !$line->{title} );\r
+               $line->{tr_style} = '';\r
+               $line->{title_2} = '';\r
+               my $unix_b = str2datetime( $line->{btime} );\r
+               my $unix_e = str2datetime( $line->{etime} );\r
+\r
+               my $btime = $unix_b->strftime( '%Y%m%d%H%M%S' );\r
+               my $etime = $unix_e->strftime( '%Y%m%d%H%M%S' );\r
+               if ( $extra and $line->{type} =~ /^search_|^reserve_(?!running)/ ) {\r
+                       #my @ary = $dbh->selectrow_array(\r
+                       #       "SELECT title, exp FROM epg_timeline \r
+                       #       WHERE channel = '$line->{chname}' \r
+                       #       AND start = '$btime' \r
+                       #       AND stop  = '$etime' ");\r
+                       #my @ary = ( $line->{epgtitle}, $line->{epgexp} );\r
+                       my ( $epgtitle, $epgexp ) = ( $line->{epgtitle}, $line->{epgexp} );\r
+\r
+                       if ( $epgtitle ) {\r
+                               $epgtitle =~ s/無料≫//;\r
+\r
+                               if ( $epgtitle ne $line->{title} ) {\r
+                                       # epgtitleとtitleが一致しない\r
+                                       # []に囲まれた部分を除去して比較\r
+                                       my @brackets = $line->{title} =~ /(\[.+\])+/;\r
+                                       my $epgtitle_nobrackets = $epgtitle;\r
+                                       my $title_nobrackets = $line->{title};\r
+                                       if ( @brackets && $epgtitle =~ /(\[.+\])+/ >= @brackets ) {\r
+                                               foreach ( @brackets ) {\r
+                                                       $epgtitle_nobrackets =~ s/\Q$_\E//;\r
+                                               }\r
+                                       }\r
+                                       $title_nobrackets =~ s/(\[.+\])+//;\r
+                                       if ( !scalar $epgtitle_nobrackets =~ s/\Q$title_nobrackets\E// ) {\r
+                                               # epgtitleにtitleが含まれていない\r
+                                               my $href  = qq {<a href="rectool.pl?mode=edit&amp;id=$line->{id}&amp;suggest=auto">自動検索</a>};\r
+                                               $epgtitle = qq {<span style="color: #FF4000">$epgtitle■$href■</span>};\r
+                                       }\r
+                                       else {\r
+                                               # epgtitleにtitleが含まれている\r
+                                               $epgtitle = $epgtitle_nobrackets;\r
+                                       }\r
+                               }\r
+                               else {\r
+                                       # epgtitleとtitleが一致している\r
+                                       $epgtitle = '説明';\r
+                               }\r
+\r
+                               $line->{title_2} = qq {<div style="float: right; cursor: help" title="$epgexp">$epgtitle</div>};\r
+                       }\r
+                       else {\r
+                               # epgtitleがない\r
+                               my $href    = qq {<a href="rectool.pl?mode=edit&amp;id=$line->{id}&amp;suggest=auto">自動検索</a>};\r
+                               $line->{title_2}  = qq {<span style="float: right; color: #FF0000">■$href■</span>};\r
+                               $line->{tr_style} = qq {style="background-color: #A0A0A0"};\r
+                       }\r
+               }\r
+\r
+               my ( $begin, $end, $diff ) = &str2readable( $unix_b, $unix_e );\r
+\r
+               my $hr = '';\r
+               if ( \r
+                       $line->{type} eq 'reserve_running' \r
+                               &&\r
+                       $unix_b->epoch <= time && time <= $unix_e->epoch\r
+               )\r
+               {\r
+                       $percent = int( ( 100 * ( time - $unix_b->epoch ) ) / ( $unix_e->epoch - $unix_b->epoch ) );\r
+                       $hr .= qq {<hr style="margin: 0 auto 0 0; height: 4px; width: $percent%;};\r
+                       $hr .= qq { background-color: blue; border: none" title="$percent%">};\r
+               }\r
+\r
+               $line->{title} = qq {<a href="rectool.pl?mode=edit&amp;id=$line->{id}">$line->{title}</a>};\r
+               #$line->{title} = qq {<div style="float: left">$line->{title}</div>} if ( $line->{title_2} );\r
+               $HTML .= qq {<tr align="center" $line->{tr_style}>\n};\r
+               $HTML .= qq {<td><input type="checkbox" name="id" value="$line->{id}"></td>\n};\r
+               $HTML .= qq {<td>$line->{id}</td>\n};\r
+               $HTML .= qq {<td>$type</td>\n};\r
+               $HTML .= qq {<td>$line->{chname_link}</td>\n};\r
+               $HTML .= qq {<td align="left" style="white-space: normal">$line->{title}$line->{title_2}</td>\n};\r
+               $HTML .= qq {<td>$begin</td>\n<td>$end</td>\n};\r
+               $HTML .= qq {<td>$hr$diff</td>\n};\r
+               $HTML .= qq {<td>$line->{opt}</td>\n<td>$line->{deltaday}</td>\n<td>$line->{deltatime}</td>\n<td>$line->{counter}</td>\n};\r
+               $HTML .= qq {</tr>\n};\r
+       }\r
+       $HTML .= qq {</table>\n};\r
+       #$HTML .= qq {<input type="submit" name="edit" value="編集(要JS)">\n};\r
+       $HTML .= qq {<input type="submit" name="delete" value="削除">\n</div>\n</form>\n};\r
+       goto end;\r
+}\r
+\r
+################ mode=graph ################\r
+\r
+if ( $mode eq 'graph' ) {\r
+\r
+       my $date = $params{ 'date' };\r
+\r
+       if ( $date )\r
+       {\r
+               print "Content-Type: image/svg+xml\n\n";\r
+\r
+               require SVG;\r
+               $date = Date::Simple->new( split /-/, $date );\r
+               $graph_bgn = $date->format('%Y-%m-%d');\r
+               $graph_end = $date->next->format('%Y-%m-%d');\r
+               $day = $date->day;\r
+               $today = $date eq Date::Simple->today() ? 1 : 0;\r
+\r
+               $tuner{terrestrial} = $cfg->param( 'env.te_max'   );# 2;\r
+               $tuner{satellite}   = $cfg->param( 'env.bscs_max' );# 2;\r
+               $tuner{all} = $tuner{terrestrial} + $tuner{satellite};\r
+               $hours = 24;\r
+               $width = 30 * $hours;\r
+               my %category_color = map { $_->{name}, $_->{color} } values %category;\r
+\r
+               $svg = new SVG( width => 820, height => $tuner{all} * 20 + 40 );\r
+               $svg->rectangle( 'x' => 40, 'y' => 20, \r
+                       width => $width + 20, height => $tuner{all} * 20 + 10, \r
+                       rx => 15, ry => 15, \r
+                       style => { stroke => 'blue', fill => 'white' } );\r
+               for ( 1..$tuner{terrestrial} ) {\r
+                       $svg->text( 'x' => 10, 'y' => ( $_ + 1 ) * 20 )\r
+                               ->cdata( "T$_" );\r
+               }\r
+               for ( 1..$tuner{satellite} ) {\r
+                       $svg->text( 'x' => 10, 'y' => ( $_ + $tuner{terrestrial} + 1 ) * 20 )\r
+                               ->cdata( "S$_" );\r
+               }\r
+               for ( 0..$hours ) {\r
+                       $svg->text( 'x' => $_ * 30 + 65, 'y' => 15, \r
+                               style => { 'text-anchor' => 'middle' } )\r
+                               ->cdata( sprintf( '%02d', $_ ) ) if ( $_ < $hours );\r
+                       # $svg->line( ); # can't be used when required\r
+                       $svg->tag( 'line', x1 => $_ * 30 + 50, x2 => $_ * 30 + 50, y1 => 30, y2 => $tuner{all} * 20 + 20, \r
+                               style => { stroke => 'gray' } );\r
+               }\r
+               for ( 1..$tuner{all} ) {\r
+#                      $svg->tag( 'line', x1 =>50, x2 => 50 + $width, y1 => $_ * 20 + 10, y2 => $_ * 20 + 10, \r
+#                              style => { stroke => 'gray' } );\r
+#                      $svg->rectangle( 'x' => 50, 'y' => $_ * 20 + 10, width => $width, height => 10 );\r
+                       $svg->rectangle( 'x' => 50, 'y' => $_ * 20 + 14, width => $width, height => 2 );\r
+               }\r
+               if ( $today ) {\r
+                       require Time::Simple;\r
+                       my $time = Time::Simple->new();\r
+                       my $x = ( $time->hours * 60 + $time->minutes ) * 0.5 + 50;\r
+                       $svg->tag( 'line', x1 => $x, x2 => $x, y1 => 30, y2 => $tuner{all} * 20 + 20, \r
+                               style => { stroke => 'red', 'fill-opacity' => '1.0' } );\r
+               }\r
+               my $ary_ref = $dbh->selectall_arrayref(\r
+                       #       epg_timeline.channel = timeline.chtxt && \r
+                       "SELECT id, title, chtxt, btime, etime, epgcategory, opt FROM timeline \r
+                       WHERE type IN $type_user_made \r
+                       AND \r
+                       (\r
+                               '$graph_bgn 00:00' <= btime AND btime <  '$graph_end 00:00'\r
+                                       OR\r
+                               '$graph_bgn 00:00' <  etime AND etime <= '$graph_end 00:00'\r
+                       )\r
+                       ORDER BY btime"\r
+                       , {Slice=>{}}\r
+               );\r
+\r
+               foreach my $bctype ( '\d+_', 'S_' ) {\r
+                       my $tuner = $bctype eq '\d+_' ? $tuner{terrestrial} : $tuner{satellite};\r
+                       my @ary_ref = grep { $_->{chtxt} =~ /$bctype/ } @{ $ary_ref };\r
+                       my @y_drawn = ('') x $tuner;\r
+                       foreach my $line ( @ary_ref ) {\r
+                               @start = $line->{btime} =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2})/;\r
+                               @stop  = $line->{etime} =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2})/;\r
+                               $start = ( ( $day == $start[2] ? 0 : 24 * 60 ) + $start[3] * 60 + $start[4] ) * 0.5;\r
+                               $stop  = ( ( $day == $stop [2] ? 0 : 24 * 60 ) + $stop [3] * 60 + $stop [4] ) * 0.5;\r
+                               $start = 0      if ( $start < 0 || $day > $start[2] ); # 月の変わり目はスルー\r
+                               $stop  = $width if ( $stop  > $width );\r
+                               $begin = $line->{btime};\r
+                               $end   = $line->{etime};\r
+\r
+                               my @ary = grep { ( $_->{etime} cmp $line->{btime} ) > 0 and ( $_->{btime} cmp $line->{etime} ) < 0 and $_->{id} != $line->{id} } @ary_ref;\r
+                               foreach my $i ( 0..$tuner - 1 ) {\r
+                                       next if ( ( $y_drawn[$i] cmp $line->{btime} ) > 0 );\r
+                                       #for ( 'chtxt', 'btime', 'etime' ) {\r
+                                       #       $f = 0 if ( $line->{$_} ne $ary[$i]->{$_} );\r
+                                       #}\r
+                                       $line->{slot} = $i;\r
+                                       $y_drawn[$i] = $line->{etime};\r
+                                       last;\r
+                               }\r
+                               my ( $r, $g, $b ) = ( 0, 0, 0 );\r
+                               $r += 255 if ( $line->{opt} =~ /a/ );\r
+                               $g += 255 if ( $line->{opt} =~ /H/ );\r
+                               $b += 255 if ( $line->{opt} =~ /I/ );\r
+                               if ( $r + $g + $b == 255 * 3 ){\r
+                                       $r = 0;\r
+                                       $g = 255;\r
+                                       $b = 255;\r
+                               }\r
+                               if ( $r + $g + $b == 0 ){\r
+                                       $r = $g = $b = 128;\r
+                               }\r
+                               my %escaped = ( '&' => 'amp', '<' => 'lt', '>' => 'gt', '"' => 'quot' );\r
+                               sub html_escape{\r
+                                       my $str = shift or return;\r
+                                       my $result = '';\r
+                                       $result .= $escaped{$_} ? '&' . $escaped{$_} . ';' : $_\r
+                                               for (split //, $str);\r
+                                       $result;\r
+                               }\r
+                               $svg->anchor(\r
+                                       -href  => "rectool.pl?mode=edit&amp;id=$line->{id}",\r
+                                       target => '_blank',\r
+                                       -title => html_escape( $line->{title} ),\r
+                               )->rectangle( \r
+                                       'x' => 50 + $start, \r
+                                       'y' => 30 + ( $bctype eq '\d+_' ? 0 : $tuner{terrestrial} * 20 ) + $line->{slot} * 20, \r
+                                       width  => $stop - $start, \r
+                                       height => 10, \r
+                                       style  => { fill => $category_color{$line->{epgcategory}} || $category_color{'その他'} } );\r
+                                       #style  => { fill => "rgb($r,$g,$b)" } );\r
+                       }\r
+               }\r
+               my $xml = $svg->xmlify;\r
+               utf8::encode( $xml );\r
+               print $xml;\r
+               #warningsToBrowser(true);\r
+               exit;\r
+       }\r
+       else\r
+       {\r
+               $HTML =~ s/%HTML_TITLE_OPT%/ - Schedule Viewer - Graphical/;\r
+               $HTML .= qq {<div style="float: left">\n};\r
+               # $base64 = encode_base64( $svg->xmlify );\r
+               # $HTML .= qq {<object data="data:image/svg+xml;base64,$base64">\n</object>\n};\r
+               $HTML .= qq {予約状況一覧です。T1,T2は地上波、S1,S2はBS/CSを示しています。<br>\n};\r
+               $HTML .= qq {SVGが利用可能なブラウザでご覧ください。<br>\n};\r
+               $HTML .= qq {色とジャンルの対応\n};\r
+               map { \r
+                       $HTML .= qq {<span style="background: $_->{color}; top: 10px; left: 250px;">$_->{name}</span>\n};\r
+               } values %category;\r
+               $HTML .= qq {<br>\n};\r
+\r
+               $ary_ref = $dbh->selectcol_arrayref(\r
+                       "SELECT DISTINCT DATE( btime ) \r
+                       FROM timeline \r
+                       WHERE type in $type_user_made \r
+                       ORDER BY btime"\r
+               );\r
+               foreach my $date ( @{ $ary_ref } ) {\r
+                       my @date = $date =~ /(.{4})-(.{2})-(.{2})/;\r
+                       my $dn = DateTime->new( year => $date[0], month => $date[1], day => $date[2], locale => 'ja_JP' )->day_name;\r
+                       #utf8::encode( $dn );\r
+                       $HTML .= qq {$date[1]/$date[2]($dn)の予約状況<br>\n};\r
+                       # <img src="">\r
+                       $HTML .= qq {<object type="image/svg+xml" data="rectool.pl?mode=graph&amp;date=$date" width="820">\n};\r
+                       $HTML .= qq {SVG Image $date\n</object>\n<br>\n};\r
+\r
+                       $date2 = Date::Simple->new( @date )->next->format('%Y-%m-%d');\r
+                       my $ary_ref = $dbh->selectall_arrayref(\r
+                               "SELECT chtxt, title, btime, etime FROM timeline \r
+                               WHERE '$date 00:00' <= btime AND etime <= '$date2 01:00'\r
+                               ORDER BY btime"\r
+                       );\r
+\r
+                       foreach my $line ( @{ $ary_ref } ) {\r
+                               #$HTML .= qq {$line->[0] $line->[1] $line->[2] $line->[3]<br>\n};\r
+                       }\r
+\r
+               }\r
+\r
+               goto end;\r
+       }\r
+}\r
+\r
+################ mode=atom ################\r
+\r
+if ( $mode eq 'atom' ) {\r
+       require XML::Atom::Feed;\r
+       require XML::Atom::Entry;\r
+\r
+       my $recording_count = $encoding_count = $jbk_count = 0;\r
+       my $ary_ref = $dbh->selectall_arrayref(\r
+               "SELECT chtxt, title, btime, etime, opt \r
+               FROM timeline \r
+               WHERE type = 'reserve_running' ");\r
+       foreach my $line ( @{$ary_ref} ) {\r
+               my ( $begin, $end, $diff ) = &str2readable( $line->[2], $line->[3] );\r
+               $recording_status .= qq {$line->[0] $line->[1] $begin - $end $diff $line->[4]<br />\n};\r
+               $recording_count++;\r
+       }\r
+       $ary_ref = $dbh->selectall_arrayref(\r
+               "SELECT chtxt, title, btime, etime, opt \r
+               FROM timeline \r
+               WHERE type = 'convert_ts_mp4_running' ");\r
+       foreach my $line ( @{$ary_ref} ) {\r
+               my ( $begin, $end, $diff ) = &str2readable( $line->[2], $line->[3] );\r
+               $encoding_status .= qq {$line->[0] $line->[1] $begin - $end $diff $line->[4]<br />\n};\r
+               $encoding_count++;\r
+       }\r
+       $ary_ref = $dbh->selectall_arrayref(\r
+               "SELECT id, chtxt, title, btime, etime \r
+               FROM auto_timeline_keyword " );\r
+       foreach my $line ( @{$ary_ref} ) {\r
+               my ( $begin, $end, $diff ) = &str2readable( $line->[3], $line->[4] );\r
+               $jbk_status .= qq {$line->[0] $line->[1] $line->[2] $begin - $end $diff<br />\n};\r
+               $jbk_count++;\r
+       }\r
+\r
+       my $feed = XML::Atom::Feed->new( Version => 1.0 );\r
+       $feed->title('Rec10 フィード');\r
+\r
+       my $entry = XML::Atom::Entry->new( Version => 1.0 );\r
+       $entry->title("Rec10 録画状況 ($recording_count)");\r
+       $entry->id('tag:recording_status');\r
+       $entry->content($recording_status);\r
+       $entry->add_link(str_to_link( './rectool.pl?mode=schedule' ) );\r
+       $feed->add_entry($entry);\r
+\r
+       $entry = XML::Atom::Entry->new( Version => 1.0 );\r
+       $entry->title("Rec10 縁故状況 ($encoding_count)");\r
+       $entry->id('tag:encoding_status');\r
+       $entry->content($encoding_status);\r
+       $entry->add_link(str_to_link( './rectool.pl?mode=schedule' ) );\r
+       $feed->add_entry($entry);\r
+\r
+       $entry = XML::Atom::Entry->new( Version => 1.0 );\r
+       $entry->title("Rec10 地引状況 ($jbk_count)");\r
+       $entry->id('tag:jbk_status');\r
+       $entry->content($jbk_status);\r
+       $entry->add_link(str_to_link( './rectool.pl?mode=jbk' ) );\r
+       $feed->add_entry($entry);\r
+\r
+       my $xml = $feed->as_xml;\r
+       print "Content-Type: application/atom+xml\n\n";\r
+       print $xml;\r
+       exit;\r
+\r
+       sub str_to_link {\r
+               my $link = XML::Atom::Link->new( Version => 1.0 );\r
+               $link->type('text/html');\r
+               $link->rel('alternate');\r
+               $link->href(shift);\r
+               return $link;\r
+       }\r
+}\r
+\r
+################ mode=edit ################\r
+\r
+if ( $mode eq 'edit' ) {\r
+       my $id = $params{ 'id' };\r
+\r
+       $HTML =~ s/%HTML_TITLE_OPT%/ - Schedule Editor/;\r
+       $HTML .= qq {<div style="float: left">\n};\r
+\r
+       $script = <<EOM;\r
+               <script type="text/javascript" src="http://www.enjoyxstudy.com/javascript/dateformat/dateformat.js">\r
+               </script>\r
+               <script type="text/javascript">\r
+               function setType(value){\r
+                       var index = document.reserve.type.selectedIndex;\r
+                       var value = document.reserve.type[index].value;\r
+                       if ( value == 'search_everyday' ) {\r
+                               document.reserve.deltaday.value  = 7;\r
+                               document.reserve.deltatime.value = 3;\r
+                       }\r
+                       if ( value == 'convert_b25_ts' || value == 'convert_ts_mp4' ){\r
+                               var date       = new Date();\r
+                               var dateFormat = new DateFormat("yyyy-MM-dd HH:mm:ss");\r
+                               var minutes    = date.getMinutes();\r
+                               minutes = minutes - minutes % 5 + 10;\r
+                               date.setMinutes(minutes, 0, 0);\r
+                               document.reserve.begin.value = dateFormat.format(date);\r
+                               date.setSeconds( date.getSeconds() + 3600 );\r
+                               document.reserve.end.value   = dateFormat.format(date);\r
+                       }\r
+               }\r
+               function setSuggest(start, stop){\r
+                       document.reserve.begin.value = start;\r
+                       document.reserve.end.value   = stop;\r
+               }\r
+               function shiftEndTime(value){\r
+                       var dateFormat = new DateFormat("yyyy-MM-dd HH:mm:ss");\r
+                       var date = dateFormat.parse(document.reserve.end.value || document.reserve.begin.value);\r
+                       date.setSeconds( date.getSeconds() + value );\r
+                       document.reserve.end.value = dateFormat.format(date);\r
+               }\r
+               </script>\r
+EOM\r
+       $script =~ s/^\t{2}//gm;\r
+       $HTML =~ s/%SCRIPT%/$script/;\r
+\r
+       $HTML .= "スケジュール編集画面です。<br>\n";\r
+       $HTML .= "実装がとても適当なので、利用には細心の注意を払ってください。<br>\n<br>\n";\r
+       if ( $id ) {\r
+               # 予約の編集\r
+               &parse_program();\r
+               $button_bgn = $button_end = '';\r
+       }\r
+       else {\r
+               # 新規予約\r
+               $type = 'reserve_flexible';\r
+               $counter = -1;\r
+               $datetime_now = DateTime->now( time_zone => $tz )->set_second( 0 )->add( minutes => 1)->strftime( '%Y-%m-%d %H:%M:%S' );\r
+               $button_bgn = qq{<button type="button" onClick="document.reserve.begin.value='$datetime_now'">現在</button>\n<br>\n};\r
+               $button_end = \r
+                        qq{<button type="button" onClick="document.reserve.end.value=document.reserve.begin.value">一致</button>}\r
+                       .qq{<button type="button" onClick="shiftEndTime(300);">+5m</button>}\r
+                       .qq{<button type="button" onClick="shiftEndTime(1800);">+30m</button>};\r
+       }\r
+\r
+       if ( $params{ 'suggest' } eq 'auto' ) {\r
+               my @btime = $begin =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/;\r
+               my @etime = $end   =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/;\r
+               my $btime = DateTime->new(\r
+                       year => $btime[0], month  => $btime[1], day    => $btime[2],\r
+                       hour => $btime[3], minute => $btime[4], second => $btime[5], \r
+               );\r
+               my $etime = DateTime->new(\r
+                       year => $etime[0], month  => $etime[1], day    => $etime[2],\r
+                       hour => $etime[3], minute => $etime[4], second => $etime[5], \r
+               );\r
+               my %hash = &sqlgetsuggested( $btime, $etime );\r
+\r
+               $HTML .= qq {可能性のある番組<br>\n};\r
+               $HTML .= qq {<table summary="suggesttable" border=1 cellspacing=0>\n<tr>\n};\r
+               $HTML .= qq {<th>優先度</th>\n};\r
+               $HTML .= qq {<th>タイトル</th>\n};\r
+               $HTML .= qq {<th>開始時刻</th>\n};\r
+               $HTML .= qq {<th>終了時刻</th>\n};\r
+               $HTML .= qq {<th>説明</th>\n};\r
+               $HTML .= qq {<th>適用</th>\n};\r
+               $HTML .= qq {</tr>\n};\r
+\r
+               foreach my $key (sort keys %hash){\r
+                       my $val = $hash{$key};\r
+                       foreach my $val ( @{$val} ) {\r
+                               my $style = qq {style="white-space: nowrap"};\r
+                               $val->[0] =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/;\r
+                               $val->[1] =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/;\r
+                               $HTML .= qq {<tr>\n<td>$key</td>\n<td>$val->[2]</td>\n};\r
+                               $HTML .= qq {<td $style>$val->[0]</td>\n<td $style>$val->[1]</td>\n<td>$val->[3]</td>\n};\r
+                               $HTML .= qq {<td><button onClick="setSuggest('$val->[0]','$val->[1]');">適用</button></td>\n</tr>\n};\r
+                       }\r
+               }\r
+               $HTML .= qq {</table>\n<br>\n};\r
+       }\r
+\r
+       my $len = length $id;\r
+       $HTML .= qq {<form method="get" action="rectool.pl" name="reserve">\n};\r
+       $HTML .= qq {<input type="hidden" name="mode" value="change">\n};\r
+       $HTML .= qq {<input type="hidden" name="mode_sub" value="update">\n};\r
+       $HTML .= qq {<input type="hidden" name="id" value="$id">\n};\r
+       $HTML .= qq {ID\n<input type="text" name="id" value="$id" size=$len disabled>\n};\r
+       $HTML .= qq {タイプ\n<select name="type" onChange="setType();">\n};\r
+       foreach my $key ( keys %type ) {\r
+               next if ( $key !~ /^search|^reserve_flexible$|^reserve_fixed$|^convert_b25_ts$|^convert_ts_mp4$|^$type$/ );\r
+               $value = $type{$key};\r
+               if ( $key eq $type ) {\r
+                       $HTML .= qq {<option value="$key" selected>$value</option>\n};\r
+               }\r
+               else {\r
+                       $HTML .= qq {<option value="$key">$value</option>\n};\r
+               }\r
+       }\r
+       $HTML .= qq {</select>\n};\r
+\r
+       $HTML .= qq {チャンネル\n<select name="chtxt">\n};\r
+       # 移動縁故など、チャンネルリスト内にchtxtが存在しない場合に備えて\r
+       $chtxt_0_chname{$chtxt} = $chname || $chtxt if ( !$chtxt_0_chname{$chtxt} );\r
+       foreach my $key ( sort keys %chtxt_0_chname ) {\r
+               if ( $key eq $chtxt || $key eq $chtxt_0 ) {\r
+                       $HTML .= qq {<option value="$key" selected>$chtxt_0_chname{$key}</option>\n};\r
+               }\r
+               else {\r
+                       $HTML .= qq {<option value="$key">$chtxt_0_chname{$key}</option>\n};\r
+               }\r
+       }\r
+       $HTML .= qq {</select><br>\n};\r
+       $HTML .= qq {タイトル\n<input type="text" name="title" value="$title" size=64><br>\n};\r
+       $HTML .= qq {開始時刻\n<input type="text" name="begin" value="$begin" maxlength=19 size=24>\n};\r
+       $HTML .= $button_bgn;\r
+       $HTML .= qq {終了時刻\n<input type="text" name="end" value="$end" maxlength=19 size=24>\n};\r
+       $HTML .= $button_end . "<br>\n";\r
+       $HTML .= qq {隔日周期\n<input type="text" name="deltaday" value="$deltaday" maxlength=2  size=2 >\n};\r
+       $HTML .= qq {時刻誤差\n<input type="text" name="deltatime" value="$deltatime" maxlength=2  size=2 >\n};\r
+       $HTML .= qq {オプション\n<input type="text" name="opt" value="$opt">\n};\r
+       $HTML .= qq {回数\n<input type="text" name="counter" value="$counter" size=2 >\n};\r
+       $HTML .= qq {<input type="submit" name="update" value="更新">\n</form>\n};\r
+}\r
+\r
+################ mode=change ################\r
+\r
+if ( $mode eq 'change' ) {\r
+       @id     = $q->param( 'id' );\r
+\r
+       $HTML =~ s/%HTML_TITLE_OPT%/ - Change/;\r
+       $HTML .= qq {<div style="float: left">\n};\r
+\r
+       if ( $params{ 'delete' } )\r
+       {\r
+               if ( @id ) {\r
+                       foreach my $id ( @id ) {\r
+                               $dbh->do( "DELETE FROM timeline WHERE id = '$id'" );\r
+                       }\r
+                       $HTML .= "削除しました。<br>\n5秒後に予約確認画面に移動します。<br>\n";\r
+                       $HTML =~ s|%REFRESH%|<meta http-equiv="refresh" content="5; url=rectool.pl?mode=schedule">|;\r
+                       goto end;\r
+               }\r
+       }\r
+       if ( $params{ 'update' } )\r
+       {\r
+               $type      = $params{ 'type' };\r
+               $chtxt     = $params{ 'chtxt' };\r
+               $title     = $params{ 'title' };\r
+               $begin     = $params{ 'begin' };\r
+               $end       = $params{ 'end' };\r
+               $deltaday  = $params{ 'deltaday' };\r
+               $deltatime = $params{ 'deltatime' };\r
+               $opt       = $params{ 'opt' };\r
+               $counter   = $params{ 'counter' };\r
+               $id        = $id[0];\r
+               if ( $id ) {\r
+                       $dbh->do( \r
+                               "UPDATE timeline SET type = '$type', chtxt = '$chtxt', title = '$title', \r
+                               btime = '$begin', etime = '$end', \r
+                               deltaday = '$deltaday', deltatime = '$deltatime', opt = '$opt', counter = '$counter' \r
+                               WHERE id = '$id'" \r
+                       );\r
+               }\r
+               else {\r
+                       $dbh->do( \r
+                               "INSERT INTO timeline ( type, chtxt, title, btime, etime, deltaday, deltatime, opt, counter ) \r
+                               VALUES ( '$type', '$chtxt', '$title', '$begin', '$end', '$deltaday', '$deltatime', '$opt', '$counter' )" \r
+                       );\r
+               }\r
+               $HTML .= "更新しました。<br>\n5秒後に予約確認画面に移動します。<br>\n";\r
+               $HTML =~ s|%REFRESH%|<meta http-equiv="refresh" content="5; url=rectool.pl?mode=schedule">|;\r
+               goto end;\r
+       }\r
+       if ( $mode_sub eq 'proc' ) {\r
+               my $type  = $params{ 'type' };\r
+               my $chtxt = $params{ 'chtxt' } || 'nhk-k';\r
+               my $title = $params{ 'title' };\r
+               my @opt   = $q->param( 'opt' );\r
+               my $opt   = join '', @opt;\r
+\r
+               my $datetime_now = DateTime->now( time_zone => $tz )->set_second( 0 )->add( minutes => 10);\r
+               my $sql_type = $type_suggest{$type};\r
+               my $begin = $datetime_now->strftime( '%Y-%m-%d %H:%M:%S' );\r
+               $datetime_now = $datetime_now->add( minutes => 60 );\r
+               my $end = $datetime_now->strftime( '%Y-%m-%d %H:%M:%S' );\r
+\r
+               $dbh->do( \r
+                       "INSERT INTO timeline ( type, chtxt, title, btime, etime, opt ) \r
+                       VALUES ( '$sql_type', '$chtxt', '$title', '$begin', '$end', '$opt' )"\r
+               );\r
+\r
+               goto end;\r
+       }\r
+       if ( $mode_sub eq 'move' ) {\r
+               my $mode_sub2  = $params{ 'mode_sub2' };\r
+               my $title      = $params{ 'title' };\r
+               my $response;\r
+\r
+               $ENV{'LANG'} = 'ja_JP.UTF-8';\r
+               if ( $mode_sub2 eq 'predict' ) {\r
+                       $HTML .= "移動後のシミュレーション結果です。\n<br>";\r
+                       eval '$response = `python26 ' . $cfg->param( 'path.rec10' ) . "/classify.py -s '$title'`";\r
+               }\r
+               elsif ( $mode_sub2 eq 'exec' ) {\r
+                       eval '$response = `python26 ' . $cfg->param( 'path.rec10' ) . "/classify.py -e '$title'`";\r
+               }\r
+               utf8::decode( $response );\r
+               $HTML .= $response;\r
+\r
+               goto end;\r
+       }\r
+       if ( $mode_sub eq 'setting' ) {\r
+               my $jbk     = $params{ 'jbk' }     || '0';\r
+               my $bayes   = $params{ 'bayes' }   || '0';\r
+               my $del_tmp = $params{ 'del_tmp' } || '0';\r
+               my $opt     = $params{ 'opt' }     || '';\r
+               my $user    = $params{ 'user' }    || '';\r
+               my $pass    = $params{ 'pass' }    || '';\r
+\r
+               $dbh->do( \r
+                       "UPDATE in_settings SET auto_jbk = '$jbk', auto_bayes = '$bayes', \r
+                       auto_del_tmp = '$del_tmp', auto_opt = '$opt'"\r
+               );\r
+\r
+               goto end;\r
+       }\r
+       if ( $mode_sub eq 'fixstatus' ) {\r
+               my $key = $params{ 'terec'  } ? 'terec'  : $params{ 'bscsrec' } ? 'bscsrec' : \r
+                         $params{ 'b252ts' } ? 'b252ts' : $params{ 'ts2avi'  } ? 'ts2avi'  : '';\r
+\r
+               $dbh->do( \r
+                       "UPDATE in_status SET $key = 0"\r
+               );\r
+\r
+               goto end;\r
+       }\r
+\r
+}\r
+\r
+################ mode=confirm ################\r
+\r
+if ( $mode eq 'confirm' ) {\r
+       if ( $mode_sub eq 'reserve' ) {\r
+               $HTML =~ s/%HTML_TITLE_OPT%/ - Reserver/;\r
+               $HTML .= qq {<div style="float: left">\n};\r
+               &parse_program();\r
+\r
+               my $duration = ( str2datetime( $end ) - str2datetime( $begin ) )->delta_minutes;\r
+               $HTML .= "番組名:$title<br>\nチャンネル:$chname<br>\n放送継続時間:$duration 分<br>\n番組内容:$desc<br>\nジャンル:$category<br>\n";\r
+               if ( $longdesc ) {\r
+                       $longdesc =~ s/\\n/<br>\n/gs;\r
+                       $HTML .= "番組内容(長):$longdesc<br>\n";\r
+               }\r
+               my $error = &check_error();\r
+               if ( $error )\r
+               {\r
+                       # エラー\r
+\r
+                       $ary_ref = $dbh->selectall_arrayref(\r
+                               "SELECT start, stop FROM epg_timeline WHERE channel = '$chtxt' AND title = '$title' "\r
+                       );\r
+                       if ( $error != 1 ) {\r
+                               $HTML .= "同一の番組の他の放送予定です。<br>\n";\r
+                               foreach my $line ( @{$ary_ref} ) {\r
+                                       $begin = $line->[0];\r
+                                       $end   = $line->[1];\r
+                                       $begin =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/;\r
+                                       $end   =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/;\r
+                                       $overlap = &get_overlap() >= 2 ? '不可能' : \r
+                                               qq {<a href="rectool.pl?mode=confirm&amp;mode_sub=reserve&amp;chtxt=$chtxt&amp;start=$line->[0]&amp;stop=$line->[1]">可能</a>};\r
+                                       $HTML .= "開始:$begin\n終了:$end\n録画は$overlap<br>\n";\r
+                               }\r
+                       }\r
+               }\r
+               else {\r
+                       $HTML .= "録画予約の詳細設定を行ってください。<br>\n";\r
+                       $HTML .= qq {<form method="get" action="rectool.pl">\n};\r
+                       $HTML .= qq {<input type="hidden" name="mode"  value="reserve">\n};\r
+                       $HTML .= qq {<input type="hidden" name="chtxt" value="$chtxt">\n};\r
+                       $HTML .= qq {<input type="hidden" name="start" value="$start">\n};\r
+                       $HTML .= qq {<input type="hidden" name="stop"  value="$stop">\n};\r
+                       $HTML .= qq {<input type="hidden" name="title" value="$title">\n} if ( $params{ 'title' } );\r
+                       &draw_form_opt( 'reserve' );\r
+                       $HTML .= qq {<input type="submit" value="予約">\n</form>\n};\r
+               }\r
+               goto end;\r
+       }\r
+       # End of $mode_sub eq 'reserve';\r
+\r
+       if ( $mode_sub eq 'proc' ) {\r
+               my    $type  = $params{ 'type' };\r
+               local $chtxt = $params{ 'chtxt' };\r
+               my    $title = $params{ 'title' };\r
+               local $opt   = $params{ 'opt' };\r
+               utf8::decode( $title );\r
+\r
+               $HTML .= "詳細設定を行ってください。<br>\n";\r
+               $HTML .= "タイトル:$title\n<br>\n";\r
+\r
+               $HTML .= qq {<form method="get" action="rectool.pl">\n};\r
+               $HTML .= qq {<input type="hidden" name="mode"     value="change">\n};\r
+               $HTML .= qq {<input type="hidden" name="mode_sub" value="proc">\n};\r
+               $HTML .= qq {<input type="hidden" name="type"     value="$type">\n};\r
+               $HTML .= qq {<input type="hidden" name="title"    value="$title">\n};\r
+               &draw_form_channel( 'nonone' );\r
+               &draw_form_opt();\r
+               $HTML .= qq {<input type="submit" value="予約">\n</form>\n};\r
+               goto end;\r
+       }\r
+}\r
+\r
+################ mode=reserve ################\r
+\r
+if ( $mode eq 'reserve' ) {\r
+       $HTML .= qq {<div style="float: left">\n};\r
+       &parse_program();\r
+       $title = $params{ 'title' } if ( !$title );\r
+       @opt = $q->param( 'opt' );\r
+       $opt = join '', @opt;\r
+       my ( $deltaday, $deltatime );\r
+\r
+       if ( $params{'every'} eq '1' ) {\r
+               $type = 'search_everyday';\r
+               ( $changed_t ) = $title =~ /(.*)#/;\r
+               $title = $changed_t if ( $changed_t );\r
+               ( $changed_t ) = $title =~ /(.*)第/;\r
+               $title = $changed_t if ( $changed_t );\r
+               ( $changed_t ) = $title =~ /(.*)▽/;\r
+               $title = $changed_t if ( $changed_t );\r
+               $title =~ s/「.*」//;\r
+               $title =~ s/<.*>//;\r
+               $title =~ s/(.*)//;\r
+               $title =~ s/\[新\]//;\r
+               $title =~ s/無料≫//;\r
+               $title =~ s/\s*$//;\r
+               $deltaday  = 7;\r
+               $deltatime = 3;\r
+       }\r
+       else {\r
+               $type = 'reserve_flexible';\r
+       }\r
+       $chtxt = $chtxt_0 if ( $chtxt_0 );\r
+       if ( !&check_error ) {\r
+               $dbh->do( \r
+                       "INSERT INTO timeline ( type, chtxt, title, btime, etime, opt, deltaday, deltatime ) \r
+                       VALUES ( '$type', '$chtxt', '$title', '$begin', '$end', '$opt', '$deltaday', '$deltatime' )" \r
+               );\r
+       }\r
+       $HTML .= "録画予約を実行しました。<br>\n5秒後にトップへ移動します。<br>\n";\r
+       $HTML =~ s|%REFRESH%|<meta http-equiv="refresh" content="5; url=rectool.pl">|;\r
+       goto end;\r
+}\r
+\r
+################ mode=program ################\r
+\r
+if ( $mode eq 'program' ) {\r
+       &draw_form();\r
+\r
+       $HTML =~ s/%HTML_TITLE_OPT%/ - Program Viewer/;\r
+       $unix = DateTime->now( time_zone => $tz )->strftime( '%Y%m%d%H%M%S' );\r
+       $sql = \r
+               "SELECT channel, epg_ch.chname, start, stop, title, category \r
+               FROM epg_timeline \r
+               INNER JOIN epg_ch ON epg_timeline.channel = epg_ch.chtxt \r
+               WHERE $unix <= stop %CH% %DATE% %CATEGORY% %KEY% ORDER BY start";\r
+\r
+       if ( $chtxt ) {\r
+               my $ch;\r
+               if ( $chtxt =~ /^\d+(_0)?$/ ) {\r
+                       # teはxx_yyy形式であるため\r
+                       $chtxt =~ s/_0//;\r
+                       $ch = "AND channel LIKE '$chtxt\_%'";\r
+               }\r
+               else {\r
+                       $ch = "AND channel = '$chtxt'";\r
+               }\r
+               $sql =~ s/%CH%/$ch/;\r
+       }\r
+       if ( $date_sel ) {\r
+               $date_1 = $date_sel . '000000';\r
+               $date_2 = Date::Simple->new( $date_sel =~ /(.{4})(.{2})(.{2})/ )->next->format('%Y%m%d') . '000000';\r
+               my $date = "AND '$date_1' <= stop AND start <= '$date_2'";\r
+               $sql =~ s/%DATE%/$date/;\r
+       }\r
+       if ( $category_sel ) {\r
+               # 一時的\r
+               #       $category_tmp = $category{$category_sel} . $category_sel;\r
+               my $category = "AND category = '$category{$category_sel}->{name}'";\r
+               $sql =~ s/%CATEGORY%/$category/;\r
+       }\r
+       if ( $key ) {\r
+               my $key = "AND TITLE LIKE '%$key%'";\r
+               $sql =~ s/%KEY%/$key/;\r
+       }\r
+       $sql =~ s/%CH%//;\r
+       $sql =~ s/%DATE%//;\r
+       $sql =~ s/%KEY%//;\r
+       $sql =~ s/%CATEGORY%//;\r
+\r
+       $ary_ref = $dbh->selectall_arrayref( $sql );\r
+       foreach my $prg ( @{ $ary_ref } ) {\r
+               my @date = $prg->[2] =~ /(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/;\r
+\r
+               $date = $date[2];\r
+               if ( $date != $prev ) {\r
+                       my $date = DateTime->new(\r
+                               year => $date[0], month  => $date[1], day    => $date[2], \r
+                               locale => 'ja_JP'\r
+                       );\r
+\r
+                       my $dn = $date->day_name;\r
+                       #utf8::encode( $dn );\r
+                       $HTML .= qq {--------$date[1]/$date[2]($dn)--------<br>\n};\r
+               }\r
+               $HTML .= qq {$date[1]/$date[2] $date[3]:$date[4] };\r
+               $HTML .= qq {$prg->[1] } if ( !$chtxt );\r
+               $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};\r
+               $prev = $date;\r
+       }\r
+}\r
+\r
+################ mode=list ################\r
+\r
+if ( $mode eq 'list' ) {\r
+       $HTML =~ s/%HTML_TITLE_OPT%/ - List/;\r
+       $HTML .= qq {<div>\n};\r
+\r
+       my $recording   = $cfg->param( 'path.recpath' );\r
+       my $ts_movepath = $cfg->param( 'path.ts_movepath' );\r
+       my $recorded    = $cfg->param( 'path.recorded' );\r
+\r
+       if ( $mode_sub eq 'log' ) {\r
+               my $title = $params{ 'title' };\r
+               my $log = slurp( "$recording/$title.log" ) if ( -e "$recording/$title.log" );\r
+               utf8::decode( $log );\r
+               $HTML .= '<pre>'.$log."</pre>\n";\r
+               goto end;\r
+       }\r
+       if ( $mode_sub eq 'logzip' ) {\r
+               my $title = $params{ 'title' };\r
+               my $zip = Archive::Zip->new();\r
+               my $logzip;\r
+               die 'read error' unless $zip->read("$recording/$title.log.zip") == AZ_OK;\r
+               my @members = $zip->members();\r
+               foreach (@members) {\r
+                       $logzip .= $_->fileName() . "\n";\r
+                       my @lines = split /\n|\r/, $zip->contents( $_->fileName() );\r
+                       my %count;\r
+                       @lines = grep {!$count{$_}++} @lines;\r
+                       $logzip .= join "\n", @lines;\r
+                       $logzip .= "\n\n";\r
+               }\r
+\r
+               utf8::decode( $logzip );\r
+               $HTML .= '<pre>'.$logzip."</pre>\n";\r
+               goto end;\r
+       }\r
+       if ( !$mode_sub ) {\r
+               $HTML .= qq {<a href="rectool.pl?mode=list&amp;mode_sub=new">録画中のみ</a>\n};\r
+               $HTML .= qq {<a href="rectool.pl?mode=list&amp;mode_sub=old">録画後のみ</a>\n<br>\n};\r
+       }\r
+       if ( !$mode_sub || $mode_sub eq 'new' ) {\r
+               $HTML .= "録画中のファイル一覧<br>\n";\r
+               &list( $recording );\r
+       }\r
+       if ( !$mode_sub ) {\r
+               $HTML .= "<br>\n";\r
+       }\r
+       if ( !$mode_sub || $mode_sub eq 'old' ) {\r
+               $HTML .= "録画後のファイル一覧<br>\n";\r
+               &simple_list( $ts_movepath );\r
+               &simple_list( $recorded );\r
+       }\r
+\r
+       sub list {\r
+               local $path = shift;\r
+               local %list = ();\r
+               my @exp = ( 'log', 'log.zip', 'ts.b25', 'ts.tsmix', 'ts', 'ts.log', \r
+                       'aac', 'srt', 'm2v', 'wav', '264', 'mp4', 'mkv' );\r
+               for ( 0..$#exp ) {\r
+                       $exp{$exp[$_]} = $_;\r
+               }\r
+               my $exp_count = scalar keys %exp;\r
+\r
+               &get_file_list_wrapper( $path, \&wanted );\r
+\r
+               my $help;\r
+               foreach my $name ( sort { $exp{$a} <=> $exp{$b} } keys %exp ) {\r
+                       $help .= $exp{$name} + 1 . " = $name / ";\r
+               }\r
+               $HTML .= $help;\r
+               $help  = qq {<tr style="background-color: #87CEEB"><td>$help\n</td>\n};\r
+               $help .= qq {<td>$_</td>\n} for ( 1..$exp_count );\r
+\r
+               $HTML .= qq {<br>\n○ = 完了 / ● = 書き込み中 / ◆ = ファイルサイズ異常<br>\n};\r
+               $HTML .= qq {<table summary="listtable" border=1 cellspacing=0>\n<tr>\n};\r
+               $HTML .= qq {<th>タイトル</th>\n};\r
+               $HTML .= qq {<th>$_</th>\n} for ( 1..$exp_count );\r
+               $HTML .= qq {</tr>\n};\r
+\r
+               my $count = 0;\r
+\r
+               foreach my $title ( sort keys %list ) {\r
+                       my $value = $list{$title};\r
+                       my @flag = ( 0 ) x ( $exp_count );\r
+                       $HTML .= qq {<tr>\n<td width="600" style="width: 600px; white-space: normal">$title</td>\n};\r
+                       foreach my $exp ( keys %{$value} ) {\r
+                               if ( $exp eq 'log' ) {\r
+                                       # ログへのリンクを追加\r
+                                       my $title = $q->escape( $title );\r
+                                       my $extra = qq {<td><a href="rectool.pl?mode=list&amp;mode_sub=log&amp;title=$title">○</a></td>\n};\r
+\r
+                                       $value->{$exp}->{extra} = $extra;\r
+                               }\r
+                               elsif ( $exp eq 'log.zip' ) {\r
+                                       # ZIPログへのリンクを追加\r
+                                       my $title = $q->escape( $title );\r
+                                       my $extra = qq {<td><a href="rectool.pl?mode=list&amp;mode_sub=logzip&amp;title=$title">○</a></td>\n};\r
+\r
+                                       $value->{$exp}->{extra} = $extra;\r
+                               }\r
+                               elsif ( $exp eq 'mp4' ) {\r
+                                       # ○などの代わりにサイズを表示\r
+                                       $value->{$exp}->{style} = $value->{$exp}->{size};\r
+                               }\r
+                               elsif ( $exp eq 'mkv' ) {\r
+                                       # サムネイルへのリンクを追加\r
+                                       my $title = $q->escape( $title );\r
+\r
+                                       my $extra = qq {<td><a title="$value->{$exp}->{size}" href="rectool.pl?mode=thumb&amp;title=$title">■</a></td>\n};\r
+                                       $value->{$exp}->{extra} = $extra;\r
+                               }\r
+                               $flag[$exp{$exp}] = $value->{$exp};\r
+                       }\r
+                       foreach ( @flag ) {\r
+                               my $size  = $_->{size};\r
+                               my $style = $_->{style};\r
+                               my $span  =  $size ? qq {<span title="$size">$style</span>} : '<br>';\r
+                               $HTML .= $_->{extra} || qq {<td>$span</td>\n};\r
+                       }\r
+                       $HTML .= qq {</tr>\n};\r
+                       $HTML .= $help unless ( ++$count % 20 );\r
+               }\r
+               $HTML .= qq {</table>\n};\r
+\r
+               sub wanted {\r
+                       my $rel = shift;\r
+                       my $abs = shift;\r
+\r
+                       return if ( $rel =~ /Thumbs\.db/ );\r
+                       return if ( $rel =~ /\.idx/ );\r
+\r
+                       $rel =~ s/\.temp$//;\r
+                       my $regexp = join '|', keys %exp;\r
+                       my ( $title, $exp ) = $rel =~ /(.*?)\.($regexp)$/;\r
+                       my ( $size, $style ) = &get_size( $abs );\r
+                       $rel =~ s/\.temp$//;\r
+                       if ( !$title ) {\r
+                               $title = '_error_exp_'.$rel;\r
+                               $exp   = 'log';\r
+                       }\r
+                       if ( $title !~ /[^0-9A-F]+/ ) {\r
+                               my $tmp = pack( 'H*', $title );\r
+                               if ( !$tmp ) {\r
+                                       $title = '_error_b16_'.$rel;\r
+                                       $exp   = 'log';\r
+                               }\r
+                               else {\r
+                                       $title = 'Base16_'.$tmp;\r
+                               }\r
+                       }\r
+                       $list{$title}->{$exp} = { 'style' => $style, 'size' => $size };\r
+               }\r
+       }\r
+\r
+       sub simple_list {\r
+               require Encode;\r
+\r
+               local $path = shift;\r
+               local @list = ();\r
+\r
+               &get_file_list_wrapper( $path, \&simple_wanted );\r
+\r
+#              @list = sort @list;\r
+               # natural sortを行う\r
+                       #@list = map( Encode::decode_utf8( $_ ), @list );\r
+                       @list = nsort @list;\r
+                       #@list = map( Encode::encode_utf8( $_ ), @list );\r
+\r
+               foreach ( @list ) {\r
+                       $HTML .= "$_<br>\n";\r
+               }\r
+\r
+               sub simple_wanted {\r
+                       my $rel = shift;\r
+                       my $abs = shift;\r
+\r
+                       my ( $size ) = &get_size( $abs );\r
+                       push @list, $rel ."\t\t". $size;\r
+               }\r
+       }\r
+\r
+       sub get_size {\r
+               my $file = shift;\r
+               my ( $size, $last ) = (stat( $file ))[7,9];\r
+               my @unim = ("B","KiB","MiB","GiB","TiB","PiB");\r
+               my $count = 0;\r
+\r
+               while($size >= 1024 ){\r
+                       $count++;\r
+                       $size = $size / 1024;\r
+               }\r
+               $size *= 100;\r
+               $size  = int( $size );\r
+               $size /= 100;\r
+               if ( time - $last < 10 ) {\r
+                       $style = '●';\r
+               }\r
+               elsif ( $size == 0 ) {\r
+                       $style = '◆';\r
+               }\r
+               else {\r
+                       $style = '○';\r
+               }\r
+               return ( "$size $unim[$count]", $style );\r
+       }\r
+}\r
+\r
+################ mode=thumb ################\r
+\r
+if ( $mode eq 'thumb' ) {\r
+       my $title = $params{ 'title' };\r
+       my $pos  = $params{ 'pos' };\r
+       my $recording = $cfg->param( 'path.recpath' );\r
+\r
+       print "Content-Type: image/jpeg\n\n";\r
+       exec "ffmpeg -ss 300 -i '$recording/$title.mkv' -f image2 -pix_fmt jpg -vframes 1 -s 320x240 -";\r
+       exit;\r
+}\r
+\r
+################ mode=check ################\r
+\r
+if ( $mode eq 'check' ) {\r
+}\r
+\r
+################ mode=bravia ################\r
+\r
+if ( $mode eq 'bravia' ) {\r
+       $HTML =~ s/%HTML_TITLE_OPT%/ - Bravia/;\r
+       $HTML .= qq {<div>\n};\r
+       $HTML .= qq {<form method="get" action="rectool.pl">\n};\r
+       $HTML .= qq {<div>\n};\r
+       $HTML .= qq {<table summary="bayestable" border=1 cellspacing=0>\n<tr>\n};\r
+       $HTML .= qq {<th>ID</th>\n};\r
+       $HTML .= qq {<th>チャンネル</th>\n};\r
+       $HTML .= qq {<th>タイトル</th>\n};\r
+       $HTML .= qq {<th><a href="rectool.pl?mode=bravia">開始時刻</a></th>\n};\r
+       $HTML .= qq {<th>終了時刻</th>\n};\r
+       $HTML .= qq {<th>録画時間</th>\n};\r
+       $HTML .= qq {<th><a href="rectool.pl?mode=bravia&amp;order=point">ポイント</a></th>\n};\r
+       $HTML .= qq {<th>予約</th>\n};\r
+       $HTML .= qq {</tr>\n};\r
+       my $order = $params{ 'order' };\r
+       if ( $order ne 'point' ) {\r
+               $order = 'btime';\r
+       }\r
+       else {\r
+               $order = 'point DESC';\r
+       }\r
+       my $ary_ref = $dbh->selectall_arrayref(\r
+               "SELECT id, chtxt, title, btime, etime, point \r
+               FROM auto_timeline_bayes \r
+               ORDER BY $order" );\r
+\r
+       foreach my $line ( @{ $ary_ref } ) {\r
+               my ( $begin, $end, $diff ) = &str2readable( $line->[3], $line->[4] );\r
+\r
+               $line->[1] = $chtxt_chname{$line->[1]} || $line->[1];\r
+               $HTML .= qq {<tr align="center">\n};\r
+               $HTML .= qq {<td>$line->[0]</td>\n};\r
+               $HTML .= qq {<td>$line->[1]</td>\n};\r
+               $HTML .= qq {<td>$line->[2]</td>\n};\r
+               $HTML .= qq {<td>$begin</td>\n<td>$end</td>\n<td>$diff</td>\n};\r
+               $HTML .= qq {<td>$line->[5]</td>\n};\r
+               $HTML .= qq {<td><a href="rectool.pl?mode=confirm&amp;mode_sub=reserve&amp;bayesid=$line->[0]">予約</a></td>\n};\r
+               $HTML .= qq {</tr>\n};\r
+       }\r
+       $HTML .= qq {</table>\n};\r
+       $HTML .= qq {</div>\n};\r
+       $HTML .= qq {</form>\n};\r
+\r
+}\r
+\r
+################ mode=proc ################\r
+\r
+if ( $mode eq 'proc' ) {\r
+       $HTML =~ s/%HTML_TITLE_OPT%/ - Proposal/;\r
+       $HTML .= qq {<div>\n};\r
+       $HTML .= qq {<table summary="proctable" border=1 cellspacing=0>\n<tr>\n};\r
+       $HTML .= qq {<th>タイプ</th>\n};\r
+       $HTML .= qq {<th>タイトル</th>\n};\r
+       $HTML .= qq {<th>予約</th>\n};\r
+       $HTML .= qq {</tr>\n};\r
+\r
+       my $ary_ref = $dbh->selectall_arrayref(\r
+               "SELECT type, chtxt, title \r
+               FROM auto_proc \r
+               ORDER BY title " );\r
+\r
+       foreach my $line ( @{ $ary_ref } ) {\r
+               my $url;\r
+               $line->[3] = $q->escape( $line->[2] );\r
+               my $opt = $dbh->selectrow_array( \r
+                       "SELECT opt FROM in_timeline_log \r
+                       WHERE title = '$line->[2]' "\r
+               );\r
+\r
+               if ( $line->[0] eq 'auto_suggest_dec' ) {\r
+                       unless ( $dbh->selectrow_array( \r
+                               "SELECT 1 FROM timeline \r
+                               WHERE ( type = 'convert_b25_ts' OR type = 'convert_b25_ts_running' )\r
+                               AND title = '$line->[2]' "\r
+                       ) ) {\r
+                               $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};\r
+                       }\r
+               }\r
+               elsif ( $line->[0] eq 'auto_suggest_enc' ) {\r
+                       unless ( $dbh->selectrow_array( \r
+                               "SELECT 1 FROM timeline \r
+                               WHERE ( type = 'convert_ts_mp4' OR type = 'convert_ts_mp4_running' ) \r
+                               AND title = '$line->[2]' "\r
+                       ) ) {\r
+                               $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};\r
+                       }\r
+               }\r
+               else {\r
+                       unless ( $dbh->selectrow_array( \r
+                               "SELECT 1 FROM timeline \r
+                               WHERE ( type LIKE 'convert_avi%' OR type = 'convert_mkv' ) \r
+                               AND title = '$line->[2]' "\r
+                       ) ) {\r
+                               $url = qq {rectool.pl?mode=confirm&amp;mode_sub=proc&amp;type=$line->[0]&amp;chtxt=$line->[1]&amp;title=$line->[3]};\r
+                       }\r
+               }\r
+               if ( $url ) { \r
+                       $href = qq {<a href="$url">予約</a>};\r
+               }\r
+               else {\r
+                       $href = q {予約済};\r
+               }\r
+\r
+               my $color = $color{$type_suggest{$line->[0]}} ? $color{$type_suggest{$line->[0]}} : '';\r
+               $line->[0] = $type{$line->[0]} ? $type{$line->[0]} : $line->[0];\r
+               $line->[0] = qq {<span style="color: $color">$line->[0]</span>} if ( $color );\r
+               $HTML .= qq {<tr align="center">\n};\r
+               $HTML .= qq {<td>$line->[0]</td>\n};\r
+               $HTML .= qq {<td align="left">$line->[2]</td>\n};\r
+               $HTML .= qq {<td>$href</td>\n};\r
+               $HTML .= qq {</tr>\n};\r
+       }\r
+\r
+       $HTML .= qq {</table>\n};\r
+}\r
+\r
+################ mode=jbk ################\r
+\r
+if ( $mode eq 'jbk' ) {\r
+       $HTML =~ s/%HTML_TITLE_OPT%/ - JBK/;\r
+       $HTML .= qq {<div>\n};\r
+\r
+       if ( $mode_sub eq 'add' ) {\r
+               my $keyword = $params{ 'keyword' };\r
+               utf8::decode( $keyword );\r
+               $HTML .= "キーワード「$keyword」を追加しました。<br>\n";\r
+               $dbh->do( \r
+                       "INSERT INTO in_auto_jbk_key ( keyword ) \r
+                       VALUES ( '$keyword' )" \r
+               );\r
+       }\r
+       elsif ( $mode_sub eq 'del' ) {\r
+               my $id = $params{ 'id' };\r
+               my $keyword = $dbh->selectrow_array( \r
+                       "SELECT keyword FROM in_auto_jbk_key \r
+                       WHERE id = '$id' " );\r
+               $HTML .= "キーワード「$keyword」を削除しました。<br>\n";\r
+               $dbh->do( \r
+                       "DELETE FROM in_auto_jbk_key WHERE id = '$id'" \r
+               );\r
+       }\r
+       elsif ( $mode_sub eq 'on' ) {\r
+               my $id = $params{ 'id' };\r
+               $HTML .= "キーワード「$keyword」を自動録画対象にしました。<br>\n";\r
+               $dbh->do( \r
+                       "UPDATE in_auto_jbk_key SET auto = 1 WHERE id = '$id'" \r
+               );\r
+       }\r
+       elsif ( $mode_sub eq 'off' ) {\r
+               my $id = $params{ 'id' };\r
+               $HTML .= "キーワード「$keyword」を自動録画対象から外しました。<br>\n";\r
+               $dbh->do( \r
+                       "UPDATE in_auto_jbk_key SET auto = 0 WHERE id = '$id'" \r
+               );\r
+       }\r
+\r
+       $HTML .= qq {<table summary="jbktable" border=1 cellspacing=0>\n<tr>\n};\r
+       $HTML .= qq {<th>ID</th>\n};\r
+       $HTML .= qq {<th>キーワード</th>\n};\r
+       $HTML .= qq {<th>自動録画</th>\n};\r
+       $HTML .= qq {<th>切り替え</th>\n};\r
+       $HTML .= qq {<th>録画オプション</th>\n};\r
+       $HTML .= qq {<th>削除</th>\n};\r
+       $HTML .= qq {</tr>\n};\r
+\r
+       my $ary_ref = $dbh->selectall_arrayref(\r
+               "SELECT id, keyword, auto, opt \r
+               FROM in_auto_jbk_key\r
+               ORDER BY id " );\r
+\r
+       foreach my $line ( @{ $ary_ref } ) {\r
+               my $delurl = "rectool.pl?mode=jbk&amp;mode_sub=del&amp;id=$line->[0]";\r
+               my $auto = $line->[2] ? 'on' : 'off';\r
+               my $oppo = $line->[2] ? 'off' : 'on';\r
+               my $oppourl = "rectool.pl?mode=jbk&amp;mode_sub=$oppo&amp;id=$line->[0]";\r
+               $oppo .= "にする";\r
+\r
+               $HTML .= qq {<tr align="center">\n};\r
+               $HTML .= qq {<td>$line->[0]</td>\n};\r
+               $HTML .= qq {<td>$line->[1]</td>\n};\r
+               $HTML .= qq {<td>$auto</td>\n};\r
+               $HTML .= qq {<td><a href="$oppourl">$oppo</a></td>\n};\r
+               $HTML .= qq {<td>$line->[3]</a></td>\n};\r
+               $HTML .= qq {<td><a href="$delurl">削除</a></td>\n};\r
+               $HTML .= qq {</tr>\n};\r
+       }\r
+\r
+       $HTML .= qq {</table>\n};\r
+\r
+       $HTML .= qq {<form method="get" action="rectool.pl">\n};\r
+       $HTML .= qq {<div>\n};\r
+       $HTML .= qq {<input type="hidden" name="mode" value="jbk">\n};\r
+       $HTML .= qq {<input type="hidden" name="mode_sub" value="add">\n};\r
+       $HTML .= qq {<input name="keyword" type="text">\n};\r
+       $HTML .= qq {<input type="submit" value="追加">\n</div>\n</form>\n<br>\n};\r
+\r
+       $HTML .= qq {<table summary="jbkrestable" border=1 cellspacing=0>\n<tr>\n};\r
+       $HTML .= qq {<th>ID</th>\n};\r
+       $HTML .= qq {<th>チャンネル</th>\n};\r
+       $HTML .= qq {<th>タイトル</th>\n};\r
+       $HTML .= qq {<th>開始時刻</th>\n};\r
+       $HTML .= qq {<th>終了時刻</th>\n};\r
+       $HTML .= qq {<th>録画時間</th>\n};\r
+       $HTML .= qq {<th>予約</th>\n};\r
+       $HTML .= qq {</tr>\n};\r
+\r
+       $ary_ref = $dbh->selectall_arrayref(\r
+               "SELECT id, auto_timeline_keyword.chtxt, epg_ch.chname, title, btime, etime \r
+               FROM auto_timeline_keyword \r
+               INNER JOIN epg_ch ON auto_timeline_keyword.chtxt = epg_ch.chtxt \r
+               ORDER BY btime" \r
+               , {Slice=>{}} );\r
+\r
+       foreach my $line ( @{ $ary_ref } ) {\r
+               my ( $begin, $end, $diff ) = &str2readable( $line->{btime}, $line->{etime} );\r
+               $line->{btime} =~ s/(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/$1$2$3$4$5$6/;\r
+               $line->{etime} =~ s/(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/$1$2$3$4$5$6/;\r
+               my $url = qq "rectool.pl?mode=confirm&amp;mode_sub=reserve&amp;chtxt=$line->{chtxt}&amp;start=$line->{btime}&amp;stop=$line->{etime}";\r
+\r
+               $HTML .= qq {<tr align="center">\n};\r
+               $HTML .= qq {<td>$line->{id}</td>\n};\r
+               $HTML .= qq {<td>$line->{chname}</td>\n};\r
+               $HTML .= qq {<td>$line->{title}</td>\n};\r
+               $HTML .= qq {<td>$begin</td>\n};\r
+               $HTML .= qq {<td>$end</td>\n};\r
+               $HTML .= qq {<td>$diff</td>\n};\r
+               $HTML .= qq {<td><a href="$url">予約</a></td>\n};\r
+               $HTML .= qq {</tr>\n};\r
+       }\r
+\r
+       $HTML .= qq {</table>\n};\r
+\r
+}\r
+\r
+################ mode=recognize ################\r
+\r
+if ( $mode eq 'recognize' ) {\r
+       $HTML =~ s/%HTML_TITLE_OPT%/ - Recognizer/;\r
+\r
+       my $text  = $params{ 'text' };\r
+       utf8::decode( $text );\r
+       $chtxt = $params{ 'chtxt' };\r
+       my $title = $params{ 'title' };\r
+       utf8::decode( $title );\r
+\r
+       $HTML .= qq {<div>\n};\r
+       $HTML .= qq {与えられた文字列のうち、番組の放送時刻と思われる文字列を認識します。<br>\n};\r
+       $HTML .= qq {番組表が取得できない一週間以上先の予約ができます。<br>\n};\r
+       $HTML .= qq {<form method="post" action="rectool.pl">\n};\r
+       $HTML .= qq {<div>\n};\r
+       &draw_form_channel( 'nonone' );\r
+       $HTML .= qq {<input type="text" name="title" value="$title">\n};\r
+       $HTML .= qq {<br>\n};\r
+       $HTML .= qq {<input type="hidden" name="mode" value="recognize">\n};\r
+       $HTML .= qq {<textarea name="text" cols=40 rows=4>\n$text</textarea>\n};\r
+       $HTML .= qq {<input type="submit" value="実行">\n</div>\n</form>\n};\r
+\r
+       my $ch_list = join '|', grep /.+/, values %chtxt_0_chname;\r
+       my %ch_reverse = reverse %chtxt_0_chname;\r
+\r
+       if ( $text ) {\r
+               my ( $year, $month, $day );\r
+               my ( $bhour, $bminute, $ehour, $eminute );\r
+               my $next_day = 0;\r
+               foreach ( split /\n/, $text ) {\r
+                       my @bdate = /(\d{4}).(\d{1,2}).(\d{1,2})/;\r
+                       s/(\d{4}).(\d{2}).(\d{2})//;\r
+                       my @btime = /(\d{1,2})[::](\d{1,2})/;\r
+                       s/(\d{1,2})[::](\d{2})//;\r
+                       my @etime = /(\d{1,2})[::](\d{1,2})/;\r
+                       s/(\d{1,2})[::](\d{2})//;\r
+                       s/\(.*\)//;\r
+                       if ( !@bdate ) {\r
+                               $bdate[0] = Time::Piece->localtime->year;\r
+                               ( $bdate[1], $bdate[2] ) = /(\d{1,2})月(\d{1,2})日/;\r
+                               s/(\d{1,2})月(\d{1,2})日//;\r
+                       }\r
+                       next if (!( @bdate || @btime ));\r
+                       ( $year,  $month, $day ) = @bdate if ( $bdate[0] && $bdate[1] && $bdate[2] );\r
+                       ( $bhour, $bminute )     = @btime if ( defined $btime[0] && defined $btime[1] );\r
+                       ( $ehour, $eminute )     = @etime if ( defined $etime[0] && defined $etime[1] );\r
+                       $next_day = 1 if ( /深夜/ );\r
+                       my ( $ch ) = /($ch_list)/;\r
+                       my $chtxt = $ch_reverse{$ch} if ( $ch && $ch_reverse{$ch} );\r
+                       s/($ch_list)//;\r
+\r
+                       if ( $year && $month && $day && defined $bhour && defined $bminute ) {\r
+                               my $tp  = Time::Piece->strptime( "$year-$month-$day $bhour:$bminute", '%Y-%m-%d %H:%M' );\r
+                               my $etp = Time::Piece->strptime( "$year-$month-$day $ehour:$eminute", '%Y-%m-%d %H:%M' ) if ( defined $ehour && defined $eminute );\r
+                               $tp += ONE_DAY if ( $next_day );\r
+                               my $start = $tp->strftime( '%Y%m%d%H%M%S' );\r
+                               my $stop  = defined $etp ? \r
+                                       $etp->strftime( '%Y%m%d%H%M%S' ) :\r
+                                       ( $tp + ONE_MINUTE * 30 )->strftime( '%Y%m%d%H%M%S' );\r
+                               $title = $_ if ( !$title );\r
+                               my $url = qq "rectool.pl?mode=confirm&amp;mode_sub=reserve&amp;chtxt=$chtxt&amp;start=$start&amp;stop=$stop&amp;title=$title";\r
+                               $HTML .= qq {認識結果:$year-$month-$day $bhour:$bminute -> $ehour:$eminute 残り:$_<a href="$url">リンク</a> <br>\n};\r
+                       }\r
+               }\r
+       }\r
+}\r
+\r
+################ mode=expert ################\r
+\r
+if ( $mode eq 'expert' ) {\r
+       require List::Compare;\r
+\r
+       my $ary_ref;\r
+\r
+       $HTML =~ s/%HTML_TITLE_OPT%/ - Expert/;\r
+       $HTML .= qq {<div>\n};\r
+\r
+       if ( $mode_sub eq 'reget' ) {\r
+               my $bctype = $params{ 'bctype' };\r
+               my ( $chtxt, $chname ) = $dbh->selectrow_array( \r
+                       "SELECT chtxt, chname FROM epg_ch \r
+                       WHERE bctype = '$bctype' " );\r
+               $HTML .= "Update for $chname ( chtxt: $chtxt ) has been reserved.<br>\n";\r
+               $dbh->do( "UPDATE epg_ch SET status = '2' WHERE chtxt = '$chtxt' " );\r
+               goto end;\r
+       }\r
+\r
+\r
+       my @ary = $dbh->selectrow_array(\r
+               "SELECT auto_jbk, auto_bayes, auto_del_tmp, auto_opt \r
+               FROM in_settings " );\r
+       my $opt = pop @ary;\r
+       @ary = map( $_ ? 'checked' : '', @ary );\r
+\r
+       $HTML .= qq {内部オプションの変更\n<br>};\r
+       $HTML .= qq {<form method="get" action="rectool.pl">\n};\r
+       $HTML .= qq {<div>\n};\r
+       $HTML .= qq {<input type="hidden" name="mode"     value="change">\n};\r
+       $HTML .= qq {<input type="hidden" name="mode_sub" value="setting">\n};\r
+       $HTML .= qq {<input type="checkbox" name="jbk"     value="1" $ary[0]>自動地引\n};\r
+       $HTML .= qq {<input type="checkbox" name="bayes"   value="1" $ary[1]>自動ベイズ\n};\r
+       $HTML .= qq {<input type="checkbox" name="del_tmp" value="1" $ary[2]>自動一時ファイル削除\n};\r
+       $HTML .= qq {自動オプション:<input type="text" name="opt" value="$opt">\n};\r
+       $HTML .= qq {<input type="submit" value="保存">\n</div>\n</form>\n};\r
+\r
+\r
+       $HTML .= qq {<hr>\n番組表のカテゴリ一覧と内蔵のカテゴリ一覧の合致を確認中...\n};\r
+       $ary_ref = $dbh->selectcol_arrayref(\r
+               "SELECT DISTINCT category FROM epg_timeline"\r
+       );\r
+       my @category = map {$_->{name}} sort values %category;\r
+       if ( List::Compare->new( $ary_ref, \@category )->get_symdiff ) {\r
+               $HTML .= qq {一致しません<br>\n};\r
+               $HTML .= qq {番組表:@{$ary_ref}<br>\n内蔵:@category<br>\n};\r
+       }\r
+       else {\r
+               $HTML .= qq {一致しました<br>\n};\r
+       }\r
+\r
+\r
+       @ary = $dbh->selectrow_array( "SELECT terec, bscsrec, b252ts, ts2avi FROM in_status" );\r
+       $HTML .= qq {<hr>\n地上波録画数:$ary[0]\n衛星波録画数:$ary[1]\n解読数:$ary[2]\n縁故数:$ary[3]\n<br>\n};\r
+       $HTML .= qq {<form method="get" action="rectool.pl">\n};\r
+       $HTML .= qq {<div>\n};\r
+       $HTML .= qq {<input type="hidden" name="mode"     value="change">\n};\r
+       $HTML .= qq {<input type="hidden" name="mode_sub" value="fixstatus">\n};\r
+       $HTML .= qq {<input type="submit" name="terec"   value="地上波録画数をリセット">\n};\r
+       $HTML .= qq {<input type="submit" name="bscsrec" value="衛星波録画数をリセット">\n};\r
+       $HTML .= qq {<input type="submit" name="b252ts"  value="解読数をリセット">\n};\r
+       $HTML .= qq {<input type="submit" name="ts2avi"  value="縁故数をリセット">\n</div>\n</form>\n};\r
+\r
+\r
+       $HTML .= qq {<hr>\nRec10 バージョン:$rec10_version\nrectool バージョン:$rectool_version\n<br>\n};\r
+\r
+\r
+       $HTML .= qq {<hr>\n番組表の欠落<br>\n};\r
+       $ary_ref = $dbh->selectall_arrayref( "SELECT chname, chtxt FROM epg_ch" );\r
+       foreach my $line ( @{$ary_ref} ) {\r
+               my $ary_ref = $dbh->selectall_arrayref( \r
+                       "SELECT start, stop, title FROM epg_timeline WHERE channel = '$line->[1]' ORDER BY start" \r
+               );\r
+               my $error;\r
+               my @program_old = ( '', $ary_ref->[0]->[0] );\r
+               my $program_old = \@program_old;\r
+\r
+               foreach my $program_new ( @{$ary_ref} ) {\r
+                       if ( $program_old->[1] ne $program_new->[0] && \r
+                               $program_old->[2] !~ /クロ?ジング|クロージング|エンディング|休止|ミッドナイト|ending/ && \r
+                               $program_new->[2] !~ /オープニング|ウィークリー・インフォメーション|モーニング|opening/ && \r
+                               ( str2datetime( $program_new->[0] ) - str2datetime( $program_old->[1] ) )->delta_minutes > 30 ) {\r
+                               $program_old->[1] =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/;\r
+                               $program_new->[0] =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/;\r
+                               $error .= qq{    $program_old->[2]    $program_old->[1]\n    ->  $program_new->[2]    $program_new->[0]\n};\r
+                       }\r
+                       $program_old = $program_new;\r
+               }\r
+               $HTML .= qq {<pre>\n$line->[0]\n$error</pre>\n} if ( $error );\r
+               }\r
+\r
+\r
+       $ary_ref = $dbh->selectall_arrayref( \r
+               "SELECT chname, chtxt, bctype, ch, csch, updatetime, status, visible \r
+               FROM epg_ch \r
+               ORDER BY bctype " );\r
+       $HTML .= qq {<hr>\n番組表の更新状況<br>\n};\r
+       $HTML .= qq {<table summary="channeltable" border=1 cellspacing=0>\n<tr>\n};\r
+       $HTML .= qq {<th>チャンネル名</th>\n};\r
+       $HTML .= qq {<th>chtxt</th>\n};\r
+       $HTML .= qq {<th>bctype</th>\n};\r
+       $HTML .= qq {<th>ch</th>\n};\r
+       $HTML .= qq {<th>csch</th>\n};\r
+       $HTML .= qq {<th>最終更新時刻</th>\n};\r
+       $HTML .= qq {<th>状態</th>\n};\r
+       $HTML .= qq {<th>表示</th>\n};\r
+       $HTML .= qq {</tr>\n};\r
+       foreach my $status ( @{$ary_ref} ) {\r
+               $HTML .= qq {<tr>\n};\r
+               $HTML .= qq {<td>$status->[0]</td>\n<td>$status->[1]</td>\n<td>$status->[2]</td>\n<td>$status->[3]</td>\n};\r
+               $HTML .= qq {<td>$status->[4]</td>\n<td>$status->[5]</td>\n<td>$status->[6]</td>\n<td>$status->[7]</td>\n};\r
+               $HTML .= qq {</tr>\n};\r
+       }\r
+       $HTML .= qq {</table>\n};\r
+\r
+       $HTML .= qq {<form method="get" action="rectool.pl">\n};\r
+       $HTML .= qq {<div>\n};\r
+       $HTML .= qq {番組表を再取得する\n};\r
+       $HTML .= qq {<input type="hidden" name="mode" value="expert">\n};\r
+       $HTML .= qq {<input type="hidden" name="mode_sub" value="reget">\n};\r
+       $HTML .= qq {<select name="bctype">\n};\r
+       $ary_ref = $dbh->selectall_arrayref(\r
+               "SELECT chname, bctype \r
+               FROM epg_ch WHERE bctype NOT LIKE '_s%' "\r
+       );\r
+       foreach my $line ( @{$ary_ref} ) {\r
+               $HTML .= qq {<option value="$line->[1]">$line->[0]</option>\n};\r
+       }\r
+       $HTML .= qq {<option value="bs">BS</option>\n};\r
+       $HTML .= qq {<option value="cs1">CS1</option>\n};\r
+       $HTML .= qq {<option value="cs2">CS2</option>\n};\r
+       $HTML .= qq {</select>\n};\r
+       $HTML .= qq {<input type="submit" value="実行">\n</div>\n</form>\n};\r
+\r
+\r
+\r
+       $ary_ref = $dbh->selectall_arrayref(\r
+               "SELECT id, type, chtxt, title, btime, etime, opt, deltaday, deltatime \r
+               FROM timeline \r
+               ORDER BY id ");\r
+       $HTML .= qq {<hr>\n予約表<br>\n};\r
+       $HTML .= qq {<table summary="rectimetable" border=1 cellspacing=0>\n<tr>\n};\r
+       $HTML .= qq {<th>ID</th>\n};\r
+       $HTML .= qq {<th>type</th>\n};\r
+       $HTML .= qq {<th>chtxt</th>\n};\r
+       $HTML .= qq {<th>title</th>\n};\r
+       $HTML .= qq {<th>btime</th>\n};\r
+       $HTML .= qq {<th>etime</th>\n};\r
+       $HTML .= qq {<th>opt</th>\n};\r
+       $HTML .= qq {<th>deltaday</th>\n};\r
+       $HTML .= qq {<th>deltatime</th>\n};\r
+       $HTML .= qq {</tr>\n};\r
+       foreach my $status ( @{$ary_ref} ) {\r
+               $HTML .= qq {<tr>\n};\r
+               $HTML .= qq {<td>$status->[0]</td>\n<td>$status->[1]</td>\n<td>$status->[2]</td>\n<td>$status->[3]</td>\n};\r
+               $HTML .= qq {<td>$status->[4]</td>\n<td>$status->[5]</td>\n<td>$status->[6]</td>\n<td>$status->[7]</td>\n};\r
+               $HTML .= qq {<td>$status->[8]</td>\n};\r
+               $HTML .= qq {</tr>\n};\r
+       }\r
+       $HTML .= qq {</table>\n};\r
+}\r
+\r
+################ mode=log ################\r
+\r
+if ( $mode eq 'log' ) {\r
+       $HTML =~ s/%HTML_TITLE_OPT%/ - Log/;\r
+\r
+       $HTML .= qq {<div>\n};\r
+       $HTML .= qq {<table summary="reclogtable" border=1 cellspacing=0>\n<tr>\n};\r
+       $HTML .= qq {<th>ID</th>\n};\r
+       $HTML .= qq {<th>chtxt</th>\n};\r
+       $HTML .= qq {<th>title</th>\n};\r
+       $HTML .= qq {<th>btime</th>\n};\r
+       $HTML .= qq {<th>etime</th>\n};\r
+       $HTML .= qq {<th>opt</th>\n};\r
+       $HTML .= qq {<th>exp</th>\n};\r
+       $HTML .= qq {<th>longexp</th>\n};\r
+       $HTML .= qq {<th>category</th>\n};\r
+       $HTML .= qq {</tr>\n};\r
+       $ary_ref = $dbh->selectall_arrayref(\r
+               "SELECT id, chtxt, title, btime, etime, opt, exp, longexp, category \r
+               FROM in_timeline_log "\r
+       );\r
+       foreach my $line ( @{$ary_ref} ) {\r
+               $HTML .= qq {<tr>\n};\r
+               $HTML .= qq {<td>$line->[0]</td>\n<td>$line->[1]</td>\n<td>$line->[2]</td>\n<td>$line->[3]</td>\n};\r
+               $HTML .= qq {<td>$line->[4]</td>\n<td>$line->[5]</td>\n<td>$line->[6]</td>\n<td>$line->[7]</td>\n};\r
+               $HTML .= qq {<td>$line->[8]</td>\n};\r
+               $HTML .= qq {</tr>\n};\r
+       }\r
+       $HTML .= qq {</table>\n};\r
+}\r
+\r
+################ mode=help ################\r
+\r
+if ( $mode eq 'help' ) {\r
+       $HTML =~ s/%HTML_TITLE_OPT%/ - Help/;\r
+       $HTML =~ s|%REFRESH%|<meta http-equiv="refresh" content="300">|;\r
+       $HTML .= qq {<div>\n};\r
+       $HTML .= qq {ヘルプ\n};\r
+}\r
+\r
+################ mode=test ################\r
+\r
+if ( $mode eq 'test' ) {\r
+       $HTML =~ s/%HTML_TITLE_OPT%/ - Test/;\r
+       $HTML =~ s|%REFRESH%|<meta http-equiv="refresh" content="300">|;\r
+       $HTML .= qq {<div>\n};\r
+\r
+       require Data::Dumper;\r
+       $tmp = Perl6::Slurp::slurp( 'config.ini' );\r
+       $tmp =~ s/\n/<br>\n/gs;\r
+       $HTML .= $tmp;\r
+\r
+       # $HTML .= Dumper( $ary_ref );\r
+}\r
+\r
+################ mode nasi ################\r
+\r
+if ( !$mode ) {\r
+       &draw_form();\r
+       $HTML =~ s/%HTML_TITLE_OPT%/ - Top/;\r
+       $HTML .= qq {Welcome to Rec10!<br>\n};\r
+       goto end;\r
+}\r
+\r
+\r
+end:\r
+#<div style="float: right">\r
+$HTML .= <<EOM;\r
+</div>\r
+</body>\r
+</html>\r
+EOM\r
+\r
+#<div align="center">\r
+#$HTML_ADV = $HTML_ADV_IMG . $HTML_ADV_TEXT if ( !$HTML_ADV );\r
+my $HTML_ADV = '';\r
+$HTML_HEADER = qq {<div style="text-align: center">\n$HTML_ADV\n</div>\n};\r
+\r
+&draw_menu();\r
+$HTML =~ s/%HTML_TITLE_OPT%//;\r
+$HTML =~ s/%REFRESH%//;\r
+$HTML =~ s/%SCRIPT%//;\r
+$HTML =~ s/%CSS%//;\r
+$HTML =~ s/%HTML_HEADER%/$HTML_HEADER/;\r
+\r
+utf8::encode( $HTML );\r
+print $HTTP_HEADER;\r
+print $HTML;\r
+exit;\r
+\r
+sub draw_menu {\r
+       $hires = Time::HiRes::time() - $hires;\r
+       $last_modified = localtime((stat 'rectool.pl')[9]);\r
+\r
+       $HTML_HEADER .= qq {<div>\n};\r
+       $HTML_HEADER .= qq {<span style="float: right; font-size: 8px">Last-Modified: $last_modified<br>Time-Elapsed: $hires 秒</span>\n};\r
+       $HTML_HEADER .= qq {<span style="float: left">\n};\r
+       $HTML_HEADER .= qq {<a href="rectool.pl">トップ(検索)</a>\n};\r
+       $HTML_HEADER .= qq {<a href="rectool.pl?mode=schedule">予約確認</a>\n};\r
+       $HTML_HEADER .= qq {<a href="rectool.pl?mode=graph">予約状況(画像版)</a>\n};\r
+       $HTML_HEADER .= qq {<a href="rectool.pl?mode=list">録画一覧</a>\n};\r
+       $HTML_HEADER .= qq {<a href="rectool.pl?mode=bravia">おまかせ</a>\n};\r
+       $HTML_HEADER .= qq {<a href="rectool.pl?mode=expert">玄人仕様</a>\n};\r
+       $HTML_HEADER .= qq {<a href="rectool.pl?mode=proc">復旧支援</a>\n};\r
+       $HTML_HEADER .= qq {<a href="rectool.pl?mode=jbk">地引</a>\n};\r
+       $HTML_HEADER .= qq {<a href="rectool.pl?mode=log">録画履歴</a>\n};\r
+       $HTML_HEADER .= qq {<a href="rectool.pl?mode=recognize">文字認識</a>\n};\r
+       $HTML_HEADER .= qq {<a href="rectool.pl?mode=edit">新規予約</a>\n};\r
+#      $HTML_HEADER .= qq {<a href="../rec10web/rec10web.py">新規予約</a>\n};\r
+       $HTML_HEADER .= qq {</span>\n};\r
+       $HTML_HEADER .= qq {<hr style="clear: both; background-color: grey; height: 4px">\n};\r
+       $HTML_HEADER .= qq {</div>\n};\r
+}\r
+\r
+sub draw_form {\r
+       $chname = $params{ 'chname' };\r
+       $chtxt  = $params{ 'chtxt' };\r
+       $key    = $params{ 'key' };\r
+       utf8::decode( $key );\r
+       if ( $chname ) {\r
+               $chtxt = $dbh->selectrow_array("SELECT chtxt FROM epg_ch WHERE chname = '$chname' ");\r
+       }\r
+\r
+       $HTML .= qq {<div style="float: left">\n};\r
+       $HTML .= qq {<form method="get" action="rectool.pl">\n};\r
+       $HTML .= qq {<div>\n};\r
+       $HTML .= qq {<input type="hidden" name="mode" value="program">\n};\r
+\r
+       # チャンネル指定\r
+       &draw_form_channel();\r
+\r
+       # 日付指定\r
+       $HTML .= qq {<select name="date">\n<option value="" selected>無指定</option>\n};\r
+       $ary_ref = $dbh->selectcol_arrayref(\r
+               "SELECT DISTINCT SUBSTRING(start, 1, 8) FROM epg_timeline ORDER BY start"\r
+       );\r
+       $date_sel = $params{ 'date' };\r
+       foreach my $date ( @{ $ary_ref } ) {\r
+               my @date = $date =~ /(.{4})(.{2})(.{2})/;\r
+               $date_prt = "$date[1]/$date[2]";\r
+\r
+               if ( $date eq $date_sel ) {\r
+                       $HTML .= qq {<option value="$date" selected>$date_prt</option>\n};\r
+               }\r
+               else {\r
+                       $HTML .= qq {<option value="$date">$date_prt</option>\n};\r
+               }\r
+       }\r
+       $HTML .= qq {</select>\n};\r
+\r
+       # カテゴリ指定\r
+       $HTML .= qq {<select name="category">\n<option value="" selected>無指定</option>\n};\r
+       $category_sel = $params{ 'category' };\r
+       foreach my $category ( keys %category ) {\r
+               if ( $category eq $category_sel ) {\r
+                       $HTML .= qq {<option value="$category" selected>$category{$category}->{name}</option>\n};\r
+               }\r
+               else {\r
+                       $HTML .= qq {<option value="$category">$category{$category}->{name}</option>\n};\r
+               }\r
+       }\r
+       $HTML .= qq {</select>\n};\r
+\r
+       # キーワード指定\r
+       $HTML .= qq {<input name="key" type="text" value="$key" style="width:200px" accesskey="s">\n};\r
+\r
+       # フォーム描画\r
+       $HTML .= qq {<input type="submit" value="更新" accesskey="r">\n</div>\n</form>\n};\r
+}\r
+\r
+sub draw_form_channel {\r
+       $HTML .= qq {<select name="chtxt">\n};\r
+       $HTML .= qq {<option value="" selected>無指定</option>\n} if ( shift ne 'nonone' );\r
+\r
+       foreach my $key ( keys %chtxt_0_chname ) {\r
+               my $value = $chtxt_0_chname{$key};\r
+               if ( ($chtxt && $key eq $chtxt ) || ( $chname && $value eq $chname ) ) {\r
+                       $HTML .= qq {<option value="$key" selected>$value</option>\n};\r
+               }\r
+               else {\r
+                       $HTML .= qq {<option value="$key">$value</option>\n};\r
+               }\r
+       }\r
+       $HTML .= qq {</select>\n};\r
+}\r
+\r
+sub draw_form_opt {\r
+       my $shift = shift;\r
+       my ( %selected, %checked );\r
+\r
+       if ( $chtxt  =~ /BS_103/ ) {\r
+               $selected{F} = 'selected';\r
+       }\r
+       elsif ( $chtxt  =~ /CS_239|CS_240|CS_335/ ) {\r
+               $selected{H} = 'selected';\r
+       }\r
+       elsif ( $chtxt =~ /BS_101|BS_102/ || $bctype =~ /cs/ ) {\r
+               $selected{W} = 'selected';\r
+       }\r
+       elsif ( $bctype =~ /bs|te/ ) {\r
+               $selected{H} = 'selected';\r
+       }\r
+       $selected{g} = 'selected';\r
+       $selected{s} = 'selected';\r
+       $checked{a} = $chtxt =~ /CS_331|CS_332|CS_333|CS_334|CS_335/ || $category =~ /アニメ/ ? 'checked' : '';\r
+       $checked{l} = '';\r
+       $checked{d} = $title =~ /\Q[二]\E|[二]|\Q(二)\E|(二)/ ? 'checked' : '';\r
+       $checked{5} = $title =~ /5\.1|5.1/ ? 'checked' : '';\r
+       $checked{2} = 'checked';\r
+\r
+       if ( $opt ) {\r
+               undef %checked;\r
+               undef %selected;\r
+               my @opt = split //, $opt;\r
+               foreach my $opt ( @opt ) {\r
+                       $selected{$opt} = 'selected' if ( $opt =~ /S|L|G|H|F/ );\r
+                       $checked {$opt} = 'checked'  if ( $opt =~ /a|h|l|d|2|5/ );\r
+               }\r
+               $checked{d} = $title =~ /\Q[二]\E|[二]|\Q(二)\E|(二)/ ? 'checked' : '';\r
+               $checked{5} = $title =~ /5\.1|5.1/ ? 'checked' : '';\r
+       }\r
+       # 画質/圧縮率ともに指定されていない場合、真ん中をselectedにする\r
+       $selected{g} = 'selected' unless ( $selected{u} || $selected{i} || $selected{o} || $selected{p} );\r
+       $selected{s} = 'selected' unless ( $selected{q} || $selected{w} || $selected{e} || $selected{r} );\r
+\r
+       $HTML .= qq {<select name="opt">\n};\r
+       #$HTML .= qq {<option value="S" $selected{S}>S 720x480</option>\n};\r
+       $HTML .= qq {<option value="W" $selected{W}>W 854x480</option>\n};\r
+       $HTML .= qq {<option value="H" $selected{H}>H 1280x720</option>\n};\r
+       $HTML .= qq {<option value="F" $selected{F}>F 1920x1080</option>\n};\r
+       $HTML .= qq {<option value="I" $selected{I}>I インタレ保持</option>\n};\r
+       $HTML .= qq {</select>\n};\r
+\r
+       $HTML .= qq {<select name="opt">\n};\r
+       $HTML .= qq {<option value="u" $selected{u}>最低</option>\n};\r
+       $HTML .= qq {<option value="i" $selected{i}>低</option>\n};\r
+       $HTML .= qq {<option value=""  $selected{g}>画質</option>\n};\r
+       $HTML .= qq {<option value="o" $selected{o}>高</option>\n};\r
+       $HTML .= qq {<option value="p" $selected{p}>最高</option>\n};\r
+       $HTML .= qq {</select>\n};\r
+\r
+       $HTML .= qq {<select name="opt">\n};\r
+       $HTML .= qq {<option value="q" $selected{q}>最低</option>\n};\r
+       $HTML .= qq {<option value="w" $selected{w}>低</option>\n};\r
+       $HTML .= qq {<option value=""  $selected{s}>圧縮率</option>\n};\r
+       $HTML .= qq {<option value="e" $selected{e}>高</option>\n};\r
+       $HTML .= qq {<option value="r" $selected{r}>最高</option>\n};\r
+       $HTML .= qq {</select>\n};\r
+\r
+       $HTML .= qq {<select name="opt">\n};\r
+       $HTML .= qq {<option value=""  $selected{s}>コンテナ</option>\n};\r
+       $HTML .= qq {<option value="m" $selected{e}>MKV</option>\n};\r
+       $HTML .= qq {<option value="4" $selected{r}>MP4</option>\n};\r
+       $HTML .= qq {</select>\n};\r
+\r
+       $HTML .= qq {<select name="opt">\n};\r
+       $HTML .= qq {<option value=""  $selected{s}>モバイル向け</option>\n};\r
+       $HTML .= qq {<option value="1" $selected{e}>QVGA</option>\n};\r
+       $HTML .= qq {<option value="2" $selected{r}>WVGA</option>\n};\r
+       $HTML .= qq {<option value="B" $selected{B}>Blu-ray向け</option>\n};\r
+       $HTML .= qq {</select>\n};\r
+\r
+       $HTML .= qq {<input type="checkbox" name="opt" value="a" $checked{a}>24fps(主にアニメ)\n};\r
+       $HTML .= qq {<input type="checkbox" name="opt" value="d" $checked{d}>二ヶ国語放送\n};\r
+       #$HTML .= qq {<input type="checkbox" name="opt" value="2" $checked{2}>2passモード\n};\r
+       $HTML .= qq {<input type="checkbox" name="opt" value="5" $checked{5}>5.1ch放送\n};\r
+       $HTML .= qq {<br>\n};\r
+       $HTML .= qq {<select name="opt">\n};\r
+       $HTML .= qq {<option value="">移動なし</option>\n};\r
+       $HTML .= qq {<option value="R">録画後移動</option>\n};\r
+       $HTML .= qq {<option value="D">解読後移動</option>\n};\r
+       $HTML .= qq {<option value="E">縁故後移動</option>\n};\r
+       $HTML .= qq {</select>\n};\r
+       $HTML .= qq {<input type="checkbox" name="opt"   value="N">ファイル名日時追加\n} if ( $shift eq 'reserve' );\r
+       $HTML .= qq {<input type="checkbox" name="every" value="1">隔週録画\n}           if ( $shift eq 'reserve' );\r
+}\r
+\r
+sub parse_program {\r
+       $chname  = $params{ 'chname' };\r
+       $chtxt   = $params{ 'chtxt' };\r
+       $start   = $params{ 'start' };\r
+       $stop    = $params{ 'stop' };\r
+       $bayesid = $params{ 'bayesid' };\r
+       $id      = $params{ 'id' };\r
+\r
+       if ( $chname ) {\r
+               $chtxt = $dbh->selectrow_array("SELECT chtxt FROM epg_ch WHERE chname = '$chname'");\r
+       }\r
+       elsif ( $chtxt && $chtxt_0_chname{$chtxt} ) {\r
+               $chname = $chtxt_0_chname{$chtxt};\r
+               ( $chtxt_sql = $chtxt ) =~ s/_0/_%/;\r
+               $bctype = $dbh->selectrow_array("SELECT bctype FROM epg_ch WHERE chtxt LIKE '$chtxt_sql'");\r
+       }\r
+       elsif ( $chtxt ) {\r
+               $chname = $dbh->selectrow_array("SELECT chname FROM epg_ch WHERE chtxt = '$chtxt'")\r
+       }\r
+       ( $title, $desc, $longdesc, $category ) = $dbh->selectrow_array(\r
+               "SELECT title, exp, longexp, category\r
+               FROM epg_timeline \r
+               WHERE channel = '$chtxt' AND start = '$start' AND stop = '$stop' ");\r
+       if ( !$bctype ) {\r
+               $bctype = $dbh->selectrow_array("SELECT bctype FROM epg_ch WHERE chtxt = '$chtxt'");\r
+       }\r
+\r
+       if ( $bayesid ) {\r
+               ( $chtxt, $title, $begin, $end ) = $dbh->selectrow_array( \r
+                       "SELECT chtxt, title, btime, etime FROM auto_timeline_bayes WHERE id = '$bayesid' " \r
+               );\r
+               ( $chname, $bctype ) = $dbh->selectrow_array( \r
+                       "SELECT chname, bctype FROM epg_ch WHERE chtxt = '$chtxt' " \r
+               );\r
+               $start = str2datetime( $begin )->strftime( '%Y%m%d%H%M%S' );\r
+               $stop  = str2datetime( $end   )->strftime( '%Y%m%d%H%M%S' );\r
+               ( $desc, $longdesc, $category ) = $dbh->selectrow_array( \r
+                       "SELECT exp, longexp, category FROM epg_timeline WHERE channel = '$chtxt' AND start = '$start' AND stop = '$stop' " \r
+               );\r
+       }\r
+       if ( $id ) {\r
+               ( $type, $chtxt, $title, $begin, $end, $deltaday, $deltatime, $opt, $counter ) = $dbh->selectrow_array( \r
+                       "SELECT type, chtxt, title, btime, etime, deltaday, deltatime, opt, counter \r
+                       FROM timeline WHERE id = '$id' " \r
+               );\r
+               ( $chname, $bctype ) = $dbh->selectrow_array( \r
+                       "SELECT chname, bctype FROM epg_ch WHERE chtxt = '$chtxt' " \r
+               );\r
+               $start = str2datetime( $begin )->strftime( '%Y%m%d%H%M%S' );\r
+               $stop  = str2datetime( $end   )->strftime( '%Y%m%d%H%M%S' );\r
+               ( $desc, $longdesc, $category ) = $dbh->selectrow_array( \r
+                       "SELECT exp, longexp, category FROM epg_timeline WHERE channel = '$chtxt' AND start = '$start' AND stop = '$stop' " \r
+               );\r
+       }\r
+       if ( $bctype =~ /bs|cs/ ) {\r
+               $bctype_sql = '_s%';\r
+       }\r
+       elsif ( $bctype =~ /te/ ) {\r
+               ( $chtxt_0   = $chtxt ) =~ s/(\d+)_.*/$1_0/;\r
+               ( $chtxt_sql = $chtxt ) =~ s/_0/_%/;\r
+               $bctype_sql = 'te%';\r
+       }\r
+       #( $chtxt_no0 ) = $chtxt   =~ /(\d+)_/;\r
+       @start = $start =~ /(.{4})(.{2})(.{2})(.{2})(.{2})/;\r
+       @stop  = $stop  =~ /(.{4})(.{2})(.{2})(.{2})(.{2})/;\r
+       $begin = sprintf( '%04d-%02d-%02d %02d:%02d:%02d', @start, '00' );\r
+       $end   = sprintf( '%04d-%02d-%02d %02d:%02d:%02d', @stop , '00' );\r
+\r
+       if ( $params{ 'title' } ) {\r
+               $title = $params{ 'title' };\r
+               utf8::decode( $title );\r
+       }\r
+       $HTML .= qq {<!-- chtxt=$chtxt chtxt_0=$chtxt_0 chtxt_sql=$chtxt_sql bctype=$bctype -->\n};\r
+}\r
+\r
+sub check_error {\r
+       my $is_error;\r
+       my $is_same = $dbh->selectrow_array( \r
+               "SELECT COUNT(*) FROM timeline WHERE chtxt = '$chtxt' AND btime = '$begin' AND etime = '$end'" \r
+       );\r
+       my @overlap = &get_overlap();\r
+\r
+       if ( $is_same ) {\r
+               $HTML .= "同一の番組が既に存在します。<br>\n";\r
+               $is_error = 1;\r
+       }\r
+       elsif ( $overlap[0] >= 2 ) {\r
+               $HTML .= "時間が被る番組が既に2個存在します。<br>\n";\r
+               $HTML .= $overlap[1];\r
+               $is_error = 2;\r
+       }\r
+       else {\r
+               $is_error = 0;\r
+       }\r
+       return $is_error;\r
+}\r
+\r
+sub get_overlap {\r
+       require List::Util;\r
+\r
+       my $ary_ref = $dbh->selectall_arrayref(\r
+               "SELECT btime, etime, title\r
+               FROM timeline \r
+               INNER JOIN epg_ch ON timeline.chtxt = epg_ch.chtxt \r
+               WHERE bctype LIKE '$bctype_sql' AND type IN $type_user_made \r
+               AND btime < '$end' \r
+               AND etime > '$begin' \r
+               "\r
+       );\r
+\r
+       my %overlap;\r
+       my $overlap = $max = 0;\r
+       my $str;\r
+       foreach my $prg ( @{ $ary_ref } ) {\r
+               $str .= "$prg->[0] ? $prg->[1] : $prg->[2]<br>\n";\r
+               $overlap{$prg->[0]} += 1;\r
+               $overlap{$prg->[1]} -= 1;\r
+       }\r
+       foreach my $key ( sort keys %overlap ) {\r
+               $overlap += $overlap{$key};\r
+               $max = List::Util::max( $max, $overlap );\r
+       }\r
+       if ( wantarray ) {\r
+               return ( $max, $str );\r
+       }\r
+       else {\r
+               return $max;\r
+       }\r
+}\r
+\r
+sub get_file_list_wrapper {\r
+       local $base_dir = shift;\r
+       local $ptr = shift;\r
+\r
+       &get_file_list( $base_dir );\r
+}\r
+\r
+sub get_file_list{\r
+       my $dir = shift;\r
+\r
+       opendir ( DIR, $dir );\r
+       my @list = sort readdir( DIR );\r
+       closedir( DIR );\r
+\r
+       foreach my $file ( @list ) {\r
+               next if ( $file =~ /^\.{1,2}$/ );\r
+               if ( -d "$dir/$file" ){\r
+                       &get_file_list("$dir/$file");\r
+               }\r
+               else{\r
+                       $abs = "$dir/$file";\r
+                       utf8::decode( $abs );\r
+                       ( $rel ) = $abs =~ /^$base_dir\/(.*)$/;\r
+                       $ptr->( $rel, $abs );\r
+               }\r
+       }\r
+}\r
+\r
+sub strisjoined {\r
+       my $str = shift;\r
+\r
+       return $str =~ /.{4}-.{2}-.{2} .{2}:.{2}:.{2}/ ? 0 : 1;\r
+}\r
+\r
+sub str2datetime {\r
+       my $str    = shift;\r
+       my @time;\r
+\r
+       if ( strisjoined( $str ) ) {\r
+               @time = $str =~ /(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/;\r
+       }\r
+       else {\r
+               @time = $str =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/;\r
+       }\r
+       return DateTime->new(\r
+               year   => $time[0], month     => $time[1], day    => $time[2],\r
+               hour   => $time[3], minute    => $time[4], second => $time[5], \r
+               locale => 'ja_JP' , time_zone => $tz\r
+       );\r
+}\r
+\r
+sub str2dayname {\r
+       my  $str = shift;\r
+       our %day_name_cache;\r
+\r
+       if ( !$day_name_cache{$str} ) {\r
+               $day_name_cache{$str} = str2datetime( $str )->day_name;\r
+       }\r
+       return $day_name_cache{$str};\r
+}\r
+\r
+sub str2readable { \r
+       my $begin = shift;\r
+       my $end   = shift;\r
+\r
+       my $dt_begin = ref( $begin ) eq 'DateTime' ? $begin : &str2datetime( $begin );\r
+       my $dt_end   = ref( $end   ) eq 'DateTime' ? $end   : &str2datetime( $end );\r
+\r
+       my $str_begin = $dt_begin->strftime( '%m/%d(%a) %H:%M' );\r
+       my $str_end   = $dt_end  ->strftime( $dt_begin->day == $dt_end->day ? '%H:%M' : '翌 %H:%M' );\r
+       # utf8::encode( $str_begin );\r
+\r
+       my ( $sec, $min, $hour );\r
+       $sec  = $dt_end->epoch - $dt_begin->epoch;\r
+       $min  = int( $sec / 60 );\r
+       $sec  = $sec - $min * 60;\r
+       $hour = int( $min / 60 );\r
+       $min  = $min - $hour * 60;\r
+       my $str_diff = '';\r
+       $str_diff .= $hour . '時間' if ( $hour );\r
+       $str_diff .= $min  . '分'   if ( $min );\r
+       $str_diff .= $sec  . '秒'   if ( $sec );\r
+\r
+       return ( $str_begin, $str_end, $str_diff );\r
+}\r
+\r
+sub sqlgetsuggested {\r
+       require Encode;\r
+       require Text::Ngram;\r
+\r
+       my ( $btime, $etime ) = @_;\r
+       $deltatime = 3 if ( !$deltatime );\r
+\r
+       $btime_bgn = $btime->clone->subtract( hours => $deltatime )->strftime( '%Y%m%d%H%M%S' );\r
+       $btime_end = $btime->clone->add(      hours => $deltatime )->strftime( '%Y%m%d%H%M%S' );\r
+       $etime_bgn = $etime->clone->subtract( hours => $deltatime )->strftime( '%Y%m%d%H%M%S' );\r
+       $etime_end = $etime->clone->add(      hours => $deltatime )->strftime( '%Y%m%d%H%M%S' );\r
+\r
+       $ary_ref = $dbh->selectall_arrayref(\r
+               "SELECT start, stop, title, exp \r
+               FROM epg_timeline \r
+               WHERE channel LIKE '$chtxt_sql' \r
+               AND start BETWEEN '$btime_bgn' AND '$btime_end' \r
+               AND stop  BETWEEN '$etime_bgn' AND '$etime_end' "\r
+       );\r
+       #die Dumper $ary_ref;\r
+\r
+       my %hash;\r
+       my $hash_r = Text::Ngram::ngram_counts( $title, 2 ); # bi-gram\r
+       foreach my $program ( @{$ary_ref} ) {\r
+               my $hash_k = Text::Ngram::ngram_counts( $program->[2], 2 );\r
+               my $point;\r
+               map $point += $hash_k->{$_}, keys %{$hash_r};\r
+               push @{$hash{$point}}, $program if ( $point );\r
+       }\r
+\r
+       return %hash;\r
+}\r
+\r
similarity index 98%
rename from rectool/trunk/rpm/SPECS/rectool.spec
rename to rectool/trunk/rectool.spec
index dd6cb4c..027067a 100644 (file)
@@ -1,4 +1,4 @@
-Name:          rectool
+Name:          rec10-rectool
 Version:       0.0.1
 Release:       1%{?dist}
 Summary:       rec10 web interface
diff --git a/rectool/trunk/rpm/SOURCES/rectool.pl b/rectool/trunk/rpm/SOURCES/rectool.pl
deleted file mode 100755 (executable)
index a993c4d..0000000
+++ /dev/null
@@ -1,2320 +0,0 @@
-#!/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 CGI::Carp qw( fatalsToBrowser );
-use warnings;
-use DBI;
-use Time::Piece;
-use Time::Seconds;
-use Date::Simple;
-use DateTime;
-use CGI;
-use MIME::Base64;
-use Config::Simple;
-use Time::HiRes;
-use Data::Dumper::Concise;
-use Tie::IxHash;
-use File::Slurp;
-use Sort::Naturally;
-use Algorithm::Diff qw(LCS);
-#require SVG Time::Simple XML::Atom Encode Text::Ngram List::Compare List::Util
-use utf8;
-#%DB::packages = ( 'main' => 1 );
-
-
-################ バージョン定義 ################
-
-
-my $rectool_version = 100;
-
-
-################ 初期化ここから ################
-
-
-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"
-);
-
-%chtxt_chname = map { $_->[0], $_->[1] } @{$ary_ref};
-
-# NHK BS 1/2/hiをBS/CSから除外(101-103) - by 2011/04
-# te: 地上波、BSのNHK以外
-# bc: BSのNHK、CS
-my @te_ary = grep $_->[0]=~ /^\d|BS_(?!10[1-3])/, @{$ary_ref};
-my @bc_ary = grep $_->[0]!~ /^\d|BS_(?!10[1-3])/, @{$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' )";
-
-%category = (
-       'etc'         => 'その他', 
-       'news'        => 'ニュース・報道', 
-       'variety'     => 'バラエティ', 
-       'anime'       => 'アニメ・特撮', 
-       'information' => '情報', 
-       'drama'       => 'ドラマ', 
-       'sports'      => 'スポーツ', 
-       'music'       => '音楽', 
-       'cinema'      => '映画', 
-);
-
-
-################ 初期化ここまで ################
-
-
-################ 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";
-
-               require SVG;
-               $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} = 2; #$cfg->param( 'env.te_max' );
-               $tuner{satellite}   = 2; #$cfg->param( 'env.bscs_max' );
-               $tuner{all} = $tuner{terrestrial} + $tuner{satellite};
-               $hours = 24;
-               $width = 30 * $hours;
-
-               $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->rectangle( 'x' => 50, 'y' => $_ * 20 + 10, width => $width, height => 10 );
-               }
-               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' } );
-               }
-               foreach my $bctype ( 'te%', '_s%' ) {
-                       my $tuner = $bctype eq 'te%' ? $tuner{terrestrial} : $tuner{satellite};
-                       my $ary_ref = $dbh->selectall_arrayref(
-                               "SELECT id, title, timeline.chtxt, btime, etime, opt FROM timeline 
-                               INNER JOIN epg_ch ON timeline.chtxt = epg_ch.chtxt 
-                               WHERE epg_ch.bctype LIKE '$bctype' 
-                               AND 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 id"
-                               , {Slice=>{}}
-                       );
-                       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 = $dbh->selectall_arrayref( 
-                                       "SELECT id, type, timeline.chtxt, title, btime, etime, opt FROM timeline 
-                                       INNER JOIN epg_ch ON timeline.chtxt = epg_ch.chtxt 
-                                       WHERE epg_ch.bctype LIKE '$bctype' 
-                                       AND type IN $type_user_made 
-                                       AND NOT 
-                                       ( 
-                                               ( etime <= '$begin' ) 
-                                                       OR 
-                                               ( btime >= '$end'   ) 
-                                       ) 
-                                       ORDER BY id" 
-                                       , {Slice=>{}}
-                               );
-                               my @ary = @{$ary};
-                               for ( 0..$tuner - 1 ) {
-                                       my $f = 1;
-                                       my $i = $_;
-                                       for ( 'chtxt', 'btime', 'etime' ) {
-                                               $f = 0 if ( $line->{$_} ne $ary[$i]->{$_} );
-                                       }
-                                       if ( $f ) {
-                                               $slot = $i;
-                                       }
-                               }
-                               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 'te%' ? 0 : $tuner{terrestrial} * 20 ) + $slot * 20, 
-                                       width  => $stop - $start, 
-                                       height => 10, 
-                                       style  => { fill => "rgb($r,$g,$b)" } );
-                       }
-               }
-               print $svg->xmlify;
-               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、赤はアニメ、緑はHD、青はインターレースを示しています。<br>\n};
-               $HTML .= qq {SVGが利用可能なブラウザでご覧ください。<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' ) {
-       require XML::Atom::Feed;
-       require XML::Atom::Entry;
-
-       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";
-               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}'";
-               $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};
-
-       my $recording   = $cfg->param( 'path.recpath' );
-       my $ts_movepath = $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 ) {
-               $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( $ts_movepath );
-               &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 );
-               $help .= qq {<td colspan="2">自動移動</td>\n</tr>\n};
-               $help .= qq {<tr>\n</tr>\n};
-
-               $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 {<th colspan="2">自動移動</th>\n};
-               $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 $check = qq {<td><a href="rectool.pl?mode=list&amp;mode_sub=log&amp;title=$title">○</a></td>\n};
-
-                                       $value->{$exp}->{check} = $check;
-                               }
-                               elsif ( $exp eq 'mkv' ) {
-                                       my $title = $q->escape( $title );
-
-                                       my $check = qq {<td><a title="$value->{$exp}->{size}" href="rectool.pl?mode=thumb&amp;title=$title">■</a></td>\n};
-                                       $value->{$exp}->{check} = $check;
-                               }
-                               $flag[$exp{$exp}] = $value->{$exp};
-                       }
-                       if ( !$flag[$exp{'mkv'}] ) {
-                               $flag[@flag]->{check} = qq {<td colspan="2"><br></td>\n};
-                       }
-                       else {
-                               my $title = $q->escape( $title );
-
-                               $flag[@flag]->{check} = 
-                                       qq {<td><a href="rectool.pl?mode=change&amp;mode_sub=move&amp;mode_sub2=predict&amp;title=$title">予測</a></td>\n}.
-                                       qq {<td><a href="rectool.pl?mode=change&amp;mode_sub=move&amp;mode_sub2=exec&amp;title=$title">実行</a></td>\n};
-                       }
-                       foreach ( @flag ) {
-                               my $size = $_->{size};
-                               my $last = $_->{last} || ( $_->{size} eq '0 B' ? '◆' : '○' );
-                               my $check =  $size ? qq {<span title="$size">$last</span>} : '<br>';
-                               $HTML .= $_->{check} ? $_->{check} : qq {<td>$check</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, $last ) = &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} = { 'last' => $last, 'size' => $size };
-               }
-       }
-
-       sub simple_list {
-               local $path = shift;
-               local @list = ();
-
-               &get_file_list_wrapper( $path, \&simple_wanted );
-
-#              @list = sort @list;
-               # natural sortを行う
-                       #@list = map( Encode::decode_utf8( $_ ), @list );
-                       @list = nsort @list;
-                       #@list = map( Encode::encode_utf8( $_ ), @list );
-
-               foreach ( @list ) {
-                       $HTML .= "$_<br>\n";
-               }
-
-               sub simple_wanted {
-                       my $rel = shift;
-                       my $abs = shift;
-
-                       my ( $size ) = &get_size( $abs );
-                       push @list, $rel ."\t\t". $size;
-               }
-       }
-
-       sub get_size {