rectool/trunk/rectool.pl

   1 #!/usr/bin/perl
   2 # -d:SmallProf
   3 #use Perl6::Slurp;
   4 #use XML::Simple;
   5 #use CGI;
   6 #use CGI::Lite;
   7 #use Date::Manip;
   8 #Date_Init("TZ=JST","ConvTZ=JST");
   9 #use SVG;
  10 #use KCatch;
  11 use CGI::Carp qw( fatalsToBrowser );
  12 use warnings;
  13 use DBI;
  14 use Time::Piece;
  15 use Time::Seconds;
  16 use Date::Simple;
  17 use DateTime;
  18 use CGI::Minimal;
  19 use MIME::Base64;
  20 use Config::Simple;
  21 use Time::HiRes;
  22 use Data::Dumper;
  23 use Tie::IxHash;
  24 use Perl6::Slurp;
  25 use Sort::Naturally;
  26 #require SVG Time::Simple XML::Atom Encode Text::Ngram List::Compare List::Util
  27 #use utf8;
  28
  29
  30 ################ バージョン定義 ################
  31
  32
  33 my $rectool_version = 98;
  34
  35
  36 ################ 初期化ここから ################
  37
  38
  39 %DB::packages = ( 'main' => 1 );
  40 my $tz = DateTime::TimeZone->new( name => 'local' );
  41 my $hires = Time::HiRes::time();
  42
  43 my $cfg = new Config::Simple;
  44 if ( -e '/etc/rec10.conf' ) {
  45         $cfg->read( '/etc/rec10.conf' );
  46 }
  47
  48 my $sql = $cfg->param( 'db.db' );
  49
  50 if ( $sql eq 'MySQL' ) {
  51         my $name = $cfg->param( 'db.mysql_dbname' );
  52         my $host = $cfg->param( 'db.mysql_host' );
  53         my $port = $cfg->param( 'db.mysql_port' );
  54         my $user = $cfg->param( 'db.mysql_user' );
  55         my $pass = $cfg->param( 'db.mysql_passwd' );
  56         $dbh = DBI->connect("dbi:mysql:$name:$host:$port", $user, $pass, {
  57                 AutoCommit => 1,
  58                 RaiseError => 1,
  59         });
  60         $dbh->do( 'SET NAMES utf8' );
  61 }
  62
  63 my $rec10_version = eval {
  64         $dbh->selectrow_array( "SELECT version FROM in_status " );
  65 };
  66
  67 my $HTML;
  68
  69 $HTTP_HEADER = "Content-Type: text/html\n\n";
  70 $HTML .= <<EOM;
  71 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
  72 <html lang="ja">
  73 <head>
  74 <title>Rec10%HTML_TITLE_OPT%</title>
  75 <meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
  76 <meta http-equiv="Content-Script-Type" content="text/javascript">
  77 <meta http-equiv="Content-Style-Type" content="text/css">
  78 <meta name="robots" content="noindex,nofollow,noarchive">
  79 <link rev="made" href="Rea10">
  80 <link rel="alternate" type="application/atom+xml" title= "Rec10 Atom Feed" href="./rectool.pl?mode=atom">
  81 %REFRESH%
  82 %SCRIPT%
  83 %CSS%
  84 </head>
  85 <body>
  86 %HTML_HEADER%
  87 EOM
  88
  89 my ( $user, $pass, $auth );
  90 ( $user, $pass ) = eval {
  91         $dbh->selectrow_array( "SELECT webuser, webpass FROM in_settings " );
  92 };
  93
  94 if ( $user and $pass ) {
  95         if ( $ENV{'HTTP_AUTHORIZATION'} ) {
  96                 my ( $base64 ) = $ENV{'HTTP_AUTHORIZATION'} =~ /Basic\s(.*)/;
  97                 if ( $base64 eq encode_base64( "$user:$pass" ) ) {
  98                         $auth = 1;
  99                 }
 100                 else {
 101                         $auth = 0;
 102                 }
 103         }
 104         else {
 105                 $auth = 0;
 106         }
 107 }
 108 else {
 109         $auth = 1;
 110 }
 111
 112 if ( !$auth ) {
 113         my ( $base64 ) = $ENV{'REMOTE_USER'} =~ /Basic (.*)/;
 114         $HTTP_HEADER = qq {Status: 401 Authorization Required\nWWW-Authenticate: Basic realm="Protected Rec10 $ENV{'HTTP_AUTHORIZATION'}"\n} . $HTTP_HEADER;
 115         goto end;
 116 }
 117
 118 if ( $rec10_version != $rectool_version ) {
 119         $HTML .= qq {<div style="font-size: 200%; font-weight: bold; color: red">\n};
 120
 121         if ( $rec10_version > $rectool_version ) {
 122                 $HTML .= qq {Rec10本体のバージョンが新しいため、実行できません。<br>\n};
 123                 $HTML .= qq {rectoolのバージョンアップを行ってください。<br>\n};
 124         }
 125
 126         if ( $rec10_version < $rectool_version ) {
 127                 $HTML .= qq {Rec10本体のバージョンが古いため、実行できません。<br>\n};
 128                 $HTML .= qq {Rec10のバージョンアップを行ってください。<br>\n};
 129         }
 130
 131         $HTML .= qq {Rec10のバージョンは$rec10_version、rectoolのバージョンは$rectool_versionです。<br>\n};
 132         $HTML .= qq {<a href="http://sourceforge.jp/projects/rec10/">公式ページ</a>\n};
 133         goto end;
 134 }
 135
 136 $q = new CGI::Minimal;
 137 $mode = $q->param( 'mode' );
 138 $mode_sub = $q->param( 'mode_sub' );
 139
 140
 141 ################ 定数宣言 ################
 142
 143
 144 tie %type, 'Tie::IxHash';
 145 %type = (
 146         'search_everyday'          => '隔日検索',
 147         'search_today'             => '当日検索',
 148         'reserve_flexible'         => '浮動予約',
 149         'reserve_fixed'            => '確定予約',
 150
 151         'reserve_running'          => '録画途中',
 152
 153         'convert_b25_ts'           => '解読予約',
 154         'convert_b25_ts_running'   => '解読途中',
 155         'convert_b25_ts_miss'      => '解読失敗',
 156
 157         'convert_ts_mp4'           => '縁故予約',
 158         'convert_ts_mp4_running'   => '縁故於鯖',
 159         'convert_ts_mp4_network'   => '縁故於網',
 160         'convert_ts_mp4_finished'  => '縁故完了',
 161
 162         'convert_avi_mkv'          => '変換旧露',
 163         'convert_avi_mp4'          => '変換旧四',
 164         'convert_mkv_mp4'          => '変換露四',
 165         'convert_mkv_mp4_runnings' => '換途露四',
 166
 167         'auto_suggest_dec'         => '予測解読',
 168         'auto_suggest_enc'         => '予測縁故',
 169         'auto_suggest_avi2fp'      => '予測旧四',
 170         'auto_suggest_ap2fp'       => '予測露四',
 171
 172         'move_end'                 => '移動完了',
 173 );
 174
 175 %type_suggest = (
 176         'auto_suggest_dec'    => 'convert_b25_ts',
 177         'auto_suggest_enc'    => 'convert_ts_mp4',
 178         'auto_suggest_avi2fp' => 'convert_avi_mkv',
 179         'auto_suggest_ap2fp'  => 'convert_mp4_mkv',
 180 );
 181
 182 %color = (
 183         'search_everyday'        => '#8B008B',
 184         'search_today'           => '#8B008B',
 185         'reserve_flexible'       => '#4169E1',
 186         'reserve_fixed'          => '#4169E1',
 187         'reserve_running'        => '#FF8C00',
 188         'convert_b25_ts'         => '#CD5C5C',
 189         'convert_b25_ts_running' => '#DC143C',
 190         'convert_ts_mp4'         => '#32CD32',
 191         'convert_ts_mp4_running' => '#2E8B57',
 192         'convert_ts_mp4_network' => '#808000',
 193
 194         'other'                  => '#A0A0A0',
 195 );
 196
 197 $type_user_made = "( 'search_everyday', 'search_today', 'reserve_flexible', 'reserve_fixed', 'reserve_running' )";
 198
 199 %category = (
 200         'etc'         => 'その他',
 201         'news'        => 'ニュース・報道',
 202         'variety'     => 'バラエティ',
 203         'anime'       => 'アニメ・特撮',
 204         'information' => '情報',
 205         'drama'       => 'ドラマ',
 206         'sports'      => 'スポーツ',
 207         'music'       => '音楽',
 208         'cinema'      => '映画',
 209 );
 210
 211
 212 ################ 初期化ここまで ################
 213
 214
 215 if ( $mode eq 'schedule' ) {
 216
 217         $HTML =~ s/%HTML_TITLE_OPT%/ - Schedule Viewer/;
 218 #       $HTML =~ s|%REFRESH%|<meta http-equiv="refresh" content="300">|;
 219         $css = <<EOM;
 220                 <style type="text/css">
 221                 td {
 222                         white-space: nowrap;
 223                 }
 224                 </style>
 225 EOM
 226         $css =~ s/^\t{2}//gm;
 227         $HTML =~ s/%CSS%/$css/;
 228
 229         my $order = $q->param( 'order' );
 230         my $extra = $q->param( 'extra' );
 231         if ( $order ne 'id' ) {
 232                 $order = 'btime';
 233         }
 234         $reverse_extra = $extra            ? '' : '&amp;extra=1';
 235         $forward_order = $order eq 'btime' ? '' : '&amp;order=id';
 236
 237         my $ary_ref = $dbh->selectall_arrayref(
 238                 "SELECT id, type, epg_ch.chtxt, epg_ch.ontv, epg_ch.chname, title, btime, etime, opt, deltaday, deltatime,
 239                 epgtitle, epgbtime, epgetime, epgexp, epgduplicate, epgchange, counter
 240                 FROM timeline
 241                 INNER JOIN epg_ch ON timeline.chtxt = epg_ch.chtxt
 242                 ORDER BY $order");
 243
 244         $HTML .= qq {<div style="font-size: 80%; float: left">\n};
 245         $HTML .= qq {<form method="get" action="rectool.pl">\n};
 246         $HTML .= qq {<div>\n};
 247         $HTML .= qq {<input type="hidden" name="mode" value="change">\n};
 248         $HTML .= qq {<table summary="rectimetable" border=1 cellspacing=0>\n<tr>\n};
 249         $HTML .= qq {<th><a href="rectool.pl?mode=schedule$forward_order$reverse_extra">■</a></th>\n};
 250         $HTML .= qq {<th><a href="rectool.pl?mode=schedule&amp;order=id">ID</a></th>\n};
 251         $HTML .= qq {<th>タイプ</th>\n};
 252         $HTML .= qq {<th>チャンネル</th>\n};
 253         $HTML .= qq {<th>タイトル</th>\n};
 254         $HTML .= qq {<th><a href="rectool.pl?mode=schedule">開始時刻</a></th>\n};
 255         $HTML .= qq {<th>終了時刻</th>\n};
 256         $HTML .= qq {<th>録画時間</th>\n};
 257         $HTML .= qq {<th>オプション</th>\n};
 258         $HTML .= qq {<th>dd</th>\n};
 259         $HTML .= qq {<th>dt</th>\n};
 260         $HTML .= qq {<th>残り</th>\n};
 261         $HTML .= qq {</tr>\n};
 262         foreach my $line ( @{ $ary_ref } ) {
 263
 264                 $type = $type{$line->[1]} || $line->[1];
 265                 if    ( $line->[1] =~ /^search/ ) {
 266                         $type = qq {<span style="color: #8B008B">$type</span>};
 267                         $line->[9]  = qq {<span style="color: #FF0000">空</span>} if ( !$line->[9] && $line->[1] eq 'search_everyday' );
 268                         $line->[10] = qq {<span style="color: #FF0000">空</span>} if ( !$line->[10] );
 269                 }
 270                 else {
 271                         my $color = $color{$line->[1]} ? $color{$line->[1]} : $color{'other'};
 272                         $type = qq {<span style="color: $color">$type</span>};
 273                 }
 274                 $chname_encoded = $q->url_encode( $line->[4] );
 275                 $line->[5] = 'タイトルなし' if ( !$line->[5] );
 276                 my $unix_6 = str2datetime( $line->[6] );
 277                 my $unix_7 = str2datetime( $line->[7] );
 278
 279                 my $btime = $unix_6->strftime( '%Y%m%d%H%M%S' );
 280                 my $etime = $unix_7->strftime( '%Y%m%d%H%M%S' );
 281                 if ( $extra and $line->[1] =~ /^search_|^reserve_/ ) {
 282 #                       my @ary = $dbh->selectrow_array(
 283 #                               "SELECT title, exp FROM epg_timeline
 284 #                               WHERE channel = '$line->[3]'
 285 #                               AND start = '$btime'
 286 #                               AND stop  = '$etime' ");
 287                         my @ary = ( $line->[11], $line->[14] );
 288
 289                         if ( $ary[0] ) {
 290                                 $ary[0] =~ s/無料≫//;
 291
 292                                 if ( $ary[0] ne $line->[5] ) {
 293                                         my $count = $ary[0] =~ s/\Q$line->[5]\E//;
 294                                         if ( !$count ) {
 295                                                 my $href = qq {<a href="rectool.pl?mode=edit&amp;id=$line->[0]&amp;suggest=auto">自動検索</a>};
 296                                                 $ary[0]  = qq {<span style="color: #FF4000">$ary[0]■$href■</span>};
 297                                         }
 298                                 }
 299                                 else {
 300                                         $ary[0] = '説明';
 301                                 }
 302
 303                                 $line->[5_2] = qq {<div style="float: right; cursor: help" title="$ary[1]">$ary[0]</div>};
 304                         }
 305                         else {
 306                                 my $href    = qq {<a href="rectool.pl?mode=edit&amp;id=$line->[0]&amp;suggest=auto">自動検索</a>};
 307                                 $line->[5_2] = qq {<span style="float: right; color: #FF0000">■$href■</span>};
 308                         }
 309                 }
 310
 311                 my ( $begin, $end, $diff ) = &str2readable( $unix_6, $unix_7 );
 312
 313                 my $hr;
 314                 if (
 315                         $line->[1] eq 'reserve_running'
 316                                 &&
 317                         $unix_6->epoch <= time && time <= $unix_7->epoch
 318                 )
 319                 {
 320                         $percent = int( ( 100 * ( time - $unix_6->epoch ) ) / ( $unix_7->epoch - $unix_6->epoch ) );
 321                         $hr .= qq {<hr style="margin: 0 auto 0 0; height: 4px; width: $percent%;};
 322                         $hr .= qq { background-color: blue; border: none" title="$percent%">};
 323                 }
 324
 325                 $line->[5] = qq {<a href="rectool.pl?mode=edit&amp;id=$line->[0]">$line->[5]</a>};
 326 #               $line->[5] = qq {<div style="float: left">$line->[5]</div>} if ( $line->[5_2] );
 327                 $HTML .= qq {<tr align="center">\n};
 328                 $HTML .= qq {<td><input type="checkbox" name="id" value="$line->[0]"></td>\n};
 329                 $HTML .= qq {<td>$line->[0]</td>\n};
 330                 $HTML .= qq {<td>$type</td>\n};
 331                 $HTML .= qq {<td><a href="rectool.pl?mode=program&amp;chtxt=$line->[2]">$line->[2]</a></td>\n};
 332                 $HTML .= qq {<td align="left" style="white-space: normal">$line->[5]$line->[5_2]</td>\n};
 333                 $HTML .= qq {<td>$begin</td>\n<td>$end</td>\n};
 334                 $HTML .= qq {<td>$hr$diff</td>\n};
 335                 $HTML .= qq {<td>$line->[8]</td>\n<td>$line->[9]</td>\n<td>$line->[10]</td>\n<td>$line->[17]</td>\n};
 336                 $HTML .= qq {</tr>\n};
 337         }
 338         $HTML .= qq {</table>\n};
 339 #       $HTML .= qq {<input type="submit" name="edit" value="編集(要JS)">\n};
 340         $HTML .= qq {<input type="submit" name="delete" value="削除">\n</div>\n</form>\n};
 341         goto end;
 342 }
 343
 344 if ( $mode eq 'graph' ) {
 345
 346         my $date = $q->param( 'date' );
 347
 348         if ( $date )
 349         {
 350                 print "Content-Type: image/svg+xml\n\n";
 351
 352                 require SVG;
 353                 $date = Date::Simple->new( split /-/, $date );
 354                 $graph_bgn = $date->format('%Y-%m-%d');
 355                 $graph_end = $date->next->format('%Y-%m-%d');
 356                 $day = $date->day;
 357                 $today = $date eq Date::Simple->today() ? 1 : 0;
 358
 359                 $tuner{terrestrial} = 2; #$cfg->param( 'env.te_max' );
 360                 $tuner{satellite}   = 4; #$cfg->param( 'env.bscs_max' );
 361                 $tuner{all} = $tuner{terrestrial} + $tuner{satellite};
 362                 $hours = 24;
 363                 $width = 30 * $hours;
 364
 365                 $svg = new SVG( width => 820, height => $tuner{all} * 20 + 40 );
 366                 $svg->rectangle( 'x' => 40, 'y' => 20,
 367                         width => $width + 20, height => $tuner{all} * 20 + 10,
 368                         rx => 15, ry => 15,
 369                         style => { stroke => 'blue', fill => 'white' } );
 370                 for ( 1..$tuner{terrestrial} ) {
 371                         $svg->text( 'x' => 10, 'y' => ( $_ + 1 ) * 20 )
 372                                 ->cdata( "T$_" );
 373                 }
 374                 for ( 1..$tuner{satellite} ) {
 375                         $svg->text( 'x' => 10, 'y' => ( $_ + $tuner{terrestrial} + 1 ) * 20 )
 376                                 ->cdata( "S$_" );
 377                 }
 378                 for ( 0..$hours ) {
 379                         $svg->text( 'x' => $_ * 30 + 65, 'y' => 15,
 380                                 style => { 'text-anchor' => 'middle' } )
 381                                 ->cdata( sprintf( '%02d', $_ ) ) if ( $_ < $hours );
 382                         # $svg->line( ); # can't be used when required
 383                         $svg->tag( 'line', x1 => $_ * 30 + 50, x2 => $_ * 30 + 50, y1 => 30, y2 => $tuner{all} * 20 + 20,
 384                                 style => { stroke => 'gray' } );
 385                 }
 386                 for ( 1..$tuner{all} ) {
 387                         $svg->rectangle( 'x' => 50, 'y' => $_ * 20 + 10, width => $width, height => 10 );
 388                 }
 389                 if ( $today ) {
 390                         require Time::Simple;
 391                         my $time = Time::Simple->new();
 392                         my $x = ( $time->hours * 60 + $time->minutes ) * 0.5 + 50;
 393                         $svg->tag( 'line', x1 => $x, x2 => $x, y1 => 30, y2 => $tuner{all} * 20 + 20,
 394                                 style => { stroke => 'red', 'fill-opacity' => '1.0' } );
 395                 }
 396                 foreach my $bctype ( 'te%', '_s%' ) {
 397                         my $tuner = $bctype eq 'te%' ? $tuner{terrestrial} : $tuner{satellite};
 398                         my $ary_ref = $dbh->selectall_arrayref(
 399                                 "SELECT id, type, timeline.chtxt, title, btime, etime, opt FROM timeline
 400                                 INNER JOIN epg_ch ON timeline.chtxt = epg_ch.chtxt
 401                                 WHERE epg_ch.bctype LIKE '$bctype'
 402                                 AND type IN $type_user_made
 403                                 AND
 404                                 (
 405                                         '$graph_bgn 00:00' <= btime AND btime <  '$graph_end 00:00'
 406                                                 OR
 407                                         '$graph_bgn 00:00' <  etime AND etime <= '$graph_end 00:00'
 408                                 )
 409                                 ORDER BY id"
 410                         );
 411                         foreach my $line ( @{ $ary_ref } ) {
 412                                 @start = $line->[4] =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2})/;
 413                                 @stop  = $line->[5] =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2})/;
 414                                 $start = ( ( $day == $start[2] ? 0 : 24 * 60 ) + $start[3] * 60 + $start[4] ) * 0.5;
 415                                 $stop  = ( ( $day == $stop [2] ? 0 : 24 * 60 ) + $stop [3] * 60 + $stop [4] ) * 0.5;
 416                                 $start = 0      if ( $start < 0 || $day > $start[2] ); # 月の変わり目はスルー
 417                                 $stop  = $width if ( $stop  > $width );
 418                                 $begin = $line->[4];
 419                                 $end   = $line->[5];
 420
 421                                 my $ary = $dbh->selectall_arrayref(
 422                                         "SELECT id, type, timeline.chtxt, title, btime, etime, opt FROM timeline
 423                                         INNER JOIN epg_ch ON timeline.chtxt = epg_ch.chtxt
 424                                         WHERE epg_ch.bctype LIKE '$bctype'
 425                                         AND type IN $type_user_made
 426                                         AND NOT
 427                                         (
 428                                                 ( etime <= '$begin' )
 429                                                         OR
 430                                                 ( btime >= '$end'   )
 431                                         )
 432                                         ORDER BY id"
 433                                 );
 434                                 my @ary = @{$ary};
 435                                 for ( 0..$tuner - 1 ) {
 436                                         $f = 1;
 437                                         $i = $_;
 438                                         for ( 0..4 ) {
 439                                                 $f = 0 if ( $line->[$_] ne $ary[$i]->[$_] );
 440                                         }
 441                                         if ( $f ) {
 442                                                 $slot = $i;
 443                                         }
 444                                 }
 445                                 my ( $r, $g, $b ) = ( 0, 0, 0 );
 446                                 $r += 255 if ( $line->[6] =~ /a/ );
 447                                 $g += 255 if ( $line->[6] =~ /H/ );
 448                                 $b += 255 if ( $line->[6] =~ /2/ );
 449                                 if ( $r + $g + $b == 255 * 3 ){
 450                                         $r = 0;
 451                                         $g = 255;
 452                                         $b = 255;
 453                                 }
 454                                 if ( $r + $g + $b == 0 ){
 455                                         $r = $g = $b = 128;
 456                                 }
 457                                 my %escaped = ( '&' => 'amp', '<' => 'lt', '>' => 'gt', '"' => 'quot' );
 458                                 sub html_escape{
 459                                     my $str = shift or return;
 460                                     my $result = '';
 461                                     $result .= $escaped{$_} ? '&' . $escaped{$_} . ';' : $_
 462                                         for (split //, $str);
 463                                     $result;
 464                                 }
 465                                 $svg->anchor(
 466                                         -href  => "rectool.pl?mode=edit&amp;id=$line->[0]",
 467                                         target => '_blank',
 468                                         -title => html_escape( $line->[3] ),
 469                                 )->rectangle(
 470                                         'x' => 50 + $start,
 471                                         'y' => 30 + ( $bctype eq 'te%' ? 0 : $tuner{terrestrial} * 20 ) + $slot * 20,
 472                                         width  => $stop - $start,
 473                                         height => 10,
 474                                         style  => { fill => "rgb($r,$g,$b)" } );
 475                         }
 476                 }
 477                 print $svg->xmlify;
 478                 exit;
 479         }
 480         else
 481         {
 482                 $HTML =~ s/%HTML_TITLE_OPT%/ - Schedule Viewer - Graphical/;
 483                 $HTML .= qq {<div style="float: left">\n};
 484                 # $base64 = encode_base64( $svg->xmlify );
 485                 # $HTML .= qq {<object data="data:image/svg+xml;base64,$base64">\n</object>\n};
 486                 $HTML .= qq {予約状況一覧です。T1,T2は地上波、S1,S2はBS/CS、赤はアニメ、緑はHD、青は2 passを示しています。<br>\n};
 487                 $HTML .= qq {SVGが利用可能なブラウザでご覧ください。<br>\n};
 488
 489                 $ary_ref = $dbh->selectcol_arrayref(
 490                         "SELECT DISTINCT DATE( btime )
 491                         FROM timeline
 492                         WHERE type in $type_user_made
 493                         ORDER BY btime"
 494                 );
 495                 foreach my $date ( @{ $ary_ref } ) {
 496                         my @date = $date =~ /(.{4})-(.{2})-(.{2})/;
 497                         my $dn = DateTime->new( year => $date[0], month => $date[1], day => $date[2], locale => 'ja_JP' )->day_name;
 498                         utf8::encode( $dn );
 499                         $HTML .= qq {$date[1]/$date[2]($dn)の予約状況<br>\n};
 500                         $HTML .= qq {<object type="image/svg+xml" data="rectool.pl?mode=graph&amp;date=$date" width="820">\n};
 501                         $HTML .= qq {SVG Image $date\n</object>\n<br>\n};
 502
 503                         $date2 = Date::Simple->new( @date )->next->format('%Y-%m-%d');
 504                         my $ary_ref = $dbh->selectall_arrayref(
 505                                 "SELECT chtxt, title, btime, etime FROM timeline
 506                                 WHERE '$date 00:00' <= btime AND etime <= '$date2 01:00'
 507                                 ORDER BY btime"
 508                         );
 509
 510                         foreach my $line ( @{ $ary_ref } ) {
 511 #                               $HTML .= qq {$line->[0] $line->[1] $line->[2] $line->[3]<br>\n};
 512                         }
 513
 514                 }
 515
 516                 goto end;
 517         }
 518 }
 519
 520 if ( $mode eq 'atom' ) {
 521         require XML::Atom::Feed;
 522         require XML::Atom::Entry;
 523
 524         my $recording_count = $encoding_count = $jbk_count = 0;
 525         my $ary_ref = $dbh->selectall_arrayref(
 526                 "SELECT chtxt, title, btime, etime, opt
 527                 FROM timeline
 528                 WHERE type = 'reserve_running' ");
 529         foreach my $line ( @{$ary_ref} ) {
 530                 my ( $begin, $end, $diff ) = &str2readable( $line->[2], $line->[3] );
 531                 $recording_status .= qq {$line->[0] $line->[1] $begin - $end $diff $line->[4]<br />\n};
 532                 $recording_count++;
 533         }
 534         $ary_ref = $dbh->selectall_arrayref(
 535                 "SELECT chtxt, title, btime, etime, opt
 536                 FROM timeline
 537                 WHERE type = 'convert_ts_mp4_running' ");
 538         foreach my $line ( @{$ary_ref} ) {
 539                 my ( $begin, $end, $diff ) = &str2readable( $line->[2], $line->[3] );
 540                 $encoding_status .= qq {$line->[0] $line->[1] $begin - $end $diff $line->[4]<br />\n};
 541                 $encoding_count++;
 542         }
 543         $ary_ref = $dbh->selectall_arrayref(
 544                 "SELECT id, chtxt, title, btime, etime
 545                 FROM auto_timeline_keyword " );
 546         foreach my $line ( @{$ary_ref} ) {
 547                 my ( $begin, $end, $diff ) = &str2readable( $line->[3], $line->[4] );
 548                 $jbk_status .= qq {$line->[0] $line->[1] $line->[2] $begin - $end $diff<br />\n};
 549                 $jbk_count++;
 550         }
 551
 552         my $feed = XML::Atom::Feed->new( Version => 1.0 );
 553         $feed->title('Rec10 フィード');
 554
 555         my $entry = XML::Atom::Entry->new( Version => 1.0 );
 556         $entry->title("Rec10 録画状況 ($recording_count)");
 557         $entry->id('tag:recording_status');
 558         $entry->content($recording_status);
 559         $entry->add_link(str_to_link( './rectool.pl?mode=schedule' ) );
 560         $feed->add_entry($entry);
 561
 562         $entry = XML::Atom::Entry->new( Version => 1.0 );
 563         $entry->title("Rec10 縁故状況 ($encoding_count)");
 564         $entry->id('tag:encoding_status');
 565         $entry->content($encoding_status);
 566         $entry->add_link(str_to_link( './rectool.pl?mode=schedule' ) );
 567         $feed->add_entry($entry);
 568
 569         $entry = XML::Atom::Entry->new( Version => 1.0 );
 570         $entry->title("Rec10 地引状況 ($jbk_count)");
 571         $entry->id('tag:jbk_status');
 572         $entry->content($jbk_status);
 573         $entry->add_link(str_to_link( './rectool.pl?mode=jbk' ) );
 574         $feed->add_entry($entry);
 575
 576         my $xml = $feed->as_xml;
 577         print "Content-Type: application/atom+xml\n\n";
 578         print $xml;
 579         exit;
 580
 581         sub str_to_link {
 582                 my $link = XML::Atom::Link->new( Version => 1.0 );
 583                 $link->type('text/html');
 584                 $link->rel('alternate');
 585                 $link->href(shift);
 586                 return $link;
 587         }
 588 }
 589
 590 if ( $mode eq 'edit' ) {
 591         my $id = $q->param( 'id' );
 592
 593         $HTML =~ s/%HTML_TITLE_OPT%/ - Schedule Editor/;
 594         $HTML .= qq {<div style="float: left">\n};
 595
 596         $script = <<EOM;
 597                 <script type="text/javascript" src="http://www.enjoyxstudy.com/javascript/dateformat/dateformat.js">
 598                 </script>
 599                 <script type="text/javascript">
 600                 function setType(value){
 601                         var index = document.reserve.type.selectedIndex;
 602                         var value = document.reserve.type[index].value;
 603                         if ( value == 'search_everyday' ) {
 604                                 document.reserve.deltaday.value  = 7;
 605                                 document.reserve.deltatime.value = 3;
 606                         }
 607                         if ( value == 'convert_b25_ts' || value == 'convert_ts_mp4' ){
 608                                 var date       = new Date();
 609                                 var dateFormat = new DateFormat("yyyy-MM-dd HH:mm:ss");
 610                                 var minutes    = date.getMinutes();
 611                                 minutes = minutes - minutes % 5 + 10;
 612                                 date.setMinutes(minutes, 0, 0);
 613                                 document.reserve.begin.value = dateFormat.format(date);
 614                                 date.setSeconds( date.getSeconds() + 3600 );
 615                                 document.reserve.end.value   = dateFormat.format(date);
 616                         }
 617                 }
 618                 function setSuggest(start, stop){
 619                         document.reserve.begin.value = start;
 620                         document.reserve.end.value   = stop;
 621                 }
 622                 function shiftEndTime(value){
 623                         var dateFormat = new DateFormat("yyyy-MM-dd HH:mm:ss");
 624                         var date = dateFormat.parse(document.reserve.end.value || document.reserve.begin.value);
 625                         date.setSeconds( date.getSeconds() + value );
 626                         document.reserve.end.value = dateFormat.format(date);
 627                 }
 628                 </script>
 629 EOM
 630         $script =~ s/^\t{2}//gm;
 631         $HTML =~ s/%SCRIPT%/$script/;
 632
 633         $HTML .= "スケジュール編集画面です。<br>\n";
 634         $HTML .= "実装がとても適当なので、利用には細心の注意を払ってください。<br>\n<br>\n";
 635         if ( $id ) {
 636                 &parse_program();
 637                 $button_bgn = $button_end = '';
 638         }
 639         else {
 640                 $type = 'reserve_flexible';
 641                 $counter = -1;
 642                 $datetime_now = DateTime->now( time_zone => $tz )->set_second( 0 )->add( minutes => 1)->strftime( '%Y-%m-%d %H:%M:%S' );
 643                 $button_bgn = qq{<button type="button" onClick="document.reserve.begin.value='$datetime_now'">現在</button>\n<br>\n};
 644                 $button_end =
 645                          qq{<button type="button" onClick="document.reserve.end.value=document.reserve.begin.value">一致</button>}
 646                         .qq{<button type="button" onClick="shiftEndTime(300);">+5m</button>}
 647                         .qq{<button type="button" onClick="shiftEndTime(1800);">+30m</button>};
 648         }
 649
 650         if ( $q->param( 'suggest' ) eq 'auto' ) {
 651                 my @btime = $begin =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/;
 652                 my @etime = $end   =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/;
 653                 my $btime = DateTime->new(
 654                         year => $btime[0], month  => $btime[1], day    => $btime[2],
 655                         hour => $btime[3], minute => $btime[4], second => $btime[5],
 656                 );
 657                 my $etime = DateTime->new(
 658                         year => $etime[0], month  => $etime[1], day    => $etime[2],
 659                         hour => $etime[3], minute => $etime[4], second => $etime[5],
 660                 );
 661                 my %hash = &sqlgetsuggested( $btime, $etime );
 662
 663                 $HTML .= qq {可能性のある番組<br>\n};
 664                 $HTML .= qq {<table summary="suggesttable" border=1 cellspacing=0>\n<tr>\n};
 665                 $HTML .= qq {<th>優先度</th>\n};
 666                 $HTML .= qq {<th>タイトル</th>\n};
 667                 $HTML .= qq {<th>開始時刻</th>\n};
 668                 $HTML .= qq {<th>終了時刻</th>\n};
 669                 $HTML .= qq {<th>説明</th>\n};
 670                 $HTML .= qq {<th>適用</th>\n};
 671                 $HTML .= qq {</tr>\n};
 672
 673                 foreach my $key (sort keys %hash){
 674                         my $val = $hash{$key};
 675                         foreach my $val ( @{$val} ) {
 676                                 my $style = qq {style="white-space: nowrap"};
 677                                 $val->[0] =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/;
 678                                 $val->[1] =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/;
 679                                 $HTML .= qq {<tr>\n<td>$key</td>\n<td>$val->[2]</td>\n};
 680                                 $HTML .= qq {<td $style>$val->[0]</td>\n<td $style>$val->[1]</td>\n<td>$val->[3]</td>\n};
 681                                 $HTML .= qq {<td><button onClick="setSuggest('$val->[0]','$val->[1]');">適用</button></td>\n</tr>\n};
 682                         }
 683                 }
 684                 $HTML .= qq {</table>\n<br>\n};
 685         }
 686
 687         my $len = length $id;
 688         $HTML .= qq {<form method="get" action="rectool.pl" name="reserve">\n};
 689         $HTML .= qq {<input type="hidden" name="mode" value="change">\n};
 690         $HTML .= qq {<input type="hidden" name="mode_sub" value="update">\n};
 691         $HTML .= qq {<input type="hidden" name="id" value="$id">\n};
 692         $HTML .= qq {ID\n<input type="text" name="id" value="$id" size=$len disabled>\n};
 693         $HTML .= qq {タイプ\n<select name="type" onChange="setType();">\n};
 694         foreach my $key ( keys %type ) {
 695                 next if ( $key !~ /^search|^reserve_flexible$|^reserve_fixed$|^convert_b25_ts$|^convert_ts_mp4$|^$type$/ );
 696                 $value = $type{$key};
 697                 if ( $key eq $type ) {
 698                         $HTML .= qq {<option value="$key" selected>$value</option>\n};
 699                 }
 700                 else {
 701                         $HTML .= qq {<option value="$key">$value</option>\n};
 702                 }
 703         }
 704         $HTML .= qq {</select>\n};
 705         $HTML .= qq {チャンネル\n<select name="chtxt">\n};
 706         $ary_ref = $dbh->selectall_arrayref(
 707                 "SELECT chtxt, chname FROM epg_ch"
 708         );
 709         foreach my $line ( @{$ary_ref} ) {
 710                 if ( $line->[0] eq $chtxt ) {
 711                         $HTML .= qq {<option value="$line->[0]" selected>$line->[1]</option>\n};
 712                 }
 713                 else {
 714                         $HTML .= qq {<option value="$line->[0]">$line->[1]</option>\n};
 715                 }
 716         }
 717         $HTML .= qq {</select><br>\n};
 718         $HTML .= qq {タイトル\n<input type="text" name="title" value="$title" size=64><br>\n};
 719         $HTML .= qq {開始時刻\n<input type="text" name="begin" value="$begin" maxlength=19 size=24>\n};
 720         $HTML .= $button_bgn;
 721         $HTML .= qq {終了時刻\n<input type="text" name="end" value="$end" maxlength=19 size=24>\n};
 722         $HTML .= $button_end . "<br>\n";
 723         $HTML .= qq {隔日周期\n<input type="text" name="deltaday" value="$deltaday" maxlength=2  size=2 >\n};
 724         $HTML .= qq {時刻誤差\n<input type="text" name="deltatime" value="$deltatime" maxlength=2  size=2 >\n};
 725         $HTML .= qq {オプション\n<input type="text" name="opt" value="$opt">\n};
 726         $HTML .= qq {回数\n<input type="text" name="counter" value="$counter" size=2 >\n};
 727         $HTML .= qq {<input type="submit" name="update" value="更新">\n</form>\n};
 728 }
 729
 730 if ( $mode eq 'change' ) {
 731         @id     = $q->param( 'id' );
 732
 733         $HTML =~ s/%HTML_TITLE_OPT%/ - Change/;
 734         $HTML .= qq {<div style="float: left">\n};
 735
 736         if ( $q->param( 'delete' ) )
 737         {
 738                 if ( @id ) {
 739                         foreach my $id ( @id ) {
 740                                 $dbh->do( "DELETE FROM timeline WHERE id = '$id'" );
 741                         }
 742                         $HTML .= "削除しました。<br>\n5秒後に予約確認画面に移動します。<br>\n";
 743                         $HTML =~ s|%REFRESH%|<meta http-equiv="refresh" content="5; url=rectool.pl?mode=schedule">|;
 744                         goto end;
 745                 }
 746         }
 747         if ( $q->param( 'update' ) )
 748         {
 749                 $type      = $q->param( 'type' );
 750                 $chtxt     = $q->param( 'chtxt' );
 751                 $title     = $q->param( 'title' );
 752                 $begin     = $q->param( 'begin' );
 753                 $end       = $q->param( 'end' );
 754                 $deltaday  = $q->param( 'deltaday' );
 755                 $deltatime = $q->param( 'deltatime' );
 756                 $opt       = $q->param( 'opt' );
 757                 $counter   = $q->param( 'counter' );
 758                 $id        = $id[0];
 759                 if ( $id ) {
 760                         $dbh->do(
 761                                 "UPDATE timeline SET type = '$type', chtxt = '$chtxt', title = '$title',
 762                                 btime = '$begin', etime = '$end',
 763                                 deltaday = '$deltaday', deltatime = '$deltatime', opt = '$opt', counter = '$counter'
 764                                 WHERE id = '$id'"
 765                         );
 766                 }
 767                 else {
 768                         $dbh->do(
 769                                 "INSERT INTO timeline ( type, chtxt, title, btime, etime, deltaday, deltatime, opt, counter )
 770                                 VALUES ( '$type', '$chtxt', '$title', '$begin', '$end', '$deltaday', '$deltatime', '$opt', '$counter' )"
 771                         );
 772                 }
 773                 $HTML .= "更新しました。<br>\n5秒後に予約確認画面に移動します。<br>\n";
 774                 $HTML =~ s|%REFRESH%|<meta http-equiv="refresh" content="5; url=rectool.pl?mode=schedule">|;
 775                 goto end;
 776         }
 777         if ( $mode_sub eq 'proc' ) {
 778                 my $type  = $q->param( 'type' );
 779                 my $chtxt = $q->param( 'chtxt' ) || 'nhk-k';
 780                 my $title = $q->param( 'title' );
 781                 my @opt   = $q->param( 'opt' );
 782                 my $opt   = join '', @opt;
 783
 784                 my $datetime_now = DateTime->now( time_zone => $tz )->set_second( 0 )->add( minutes => 10);
 785                 my $sql_type = $type_suggest{$type};
 786                 my $begin = $datetime_now->strftime( '%Y-%m-%d %H:%M:%S' );
 787                 $datetime_now = $datetime_now->add( minutes => 60 );
 788                 my $end = $datetime_now->strftime( '%Y-%m-%d %H:%M:%S' );
 789
 790                 $dbh->do(
 791                         "INSERT INTO timeline ( type, chtxt, title, btime, etime, opt )
 792                         VALUES ( '$sql_type', '$chtxt', '$title', '$begin', '$end', '$opt' )"
 793                 );
 794
 795                 goto end;
 796         }
 797         if ( $mode_sub eq 'move' ) {
 798                 my $mode_sub2  = $q->param( 'mode_sub2' );
 799                 my $title      = $q->param( 'title' );
 800
 801                 $ENV{'LANG'} = 'ja_JP.UTF-8';
 802                 if ( $mode_sub2 eq 'predict' ) {
 803                         $HTML .= "移動後のシミュレーション結果です。\n<br>";
 804                         eval '$HTML .= `python26 ' . $cfg->param( 'path.rec10' ) . "/classify.py -s '$title'`";
 805                 }
 806                 elsif ( $mode_sub2 eq 'exec' ) {
 807                         eval '$HTML .= `python26 ' . $cfg->param( 'path.rec10' ) . "/classify.py -e '$title'`";
 808                 }
 809
 810                 goto end;
 811         }
 812         if ( $mode_sub eq 'setting' ) {
 813                 my $jbk     = $q->param( 'jbk' )     || '0';
 814                 my $bayes   = $q->param( 'bayes' )   || '0';
 815                 my $del_tmp = $q->param( 'del_tmp' ) || '0';
 816                 my $opt     = $q->param( 'opt' )     || '';
 817                 my $user    = $q->param( 'user' )    || '';
 818                 my $pass    = $q->param( 'pass' )    || '';
 819
 820                 $dbh->do(
 821                         "UPDATE in_settings SET auto_jbk = '$jbk', auto_bayes = '$bayes',
 822                         auto_del_tmp = '$del_tmp', auto_opt = '$opt'"
 823                 );
 824
 825                 goto end;
 826         }
 827         if ( $mode_sub eq 'fixstatus' ) {
 828                 my $key = $q->param( 'terec'  ) ? 'terec'  : $q->param( 'bscsrec' ) ? 'bscsrec' :
 829                           $q->param( 'b252ts' ) ? 'b252ts' : $q->param( 'ts2avi'  ) ? 'ts2avi'  : '';
 830
 831                 if ( $key ) {
 832                         $dbh->do(
 833                                 "UPDATE in_status SET $key = 0"
 834                         );
 835                 }
 836                 else {
 837                         $HTML .= qq {パラメータが異常です。<br>\n};
 838                 }
 839
 840                 goto end;
 841         }
 842
 843 }
 844
 845 if ( $mode eq 'confirm' ) {
 846         if ( $mode_sub eq 'reserve' ) {
 847                 $HTML =~ s/%HTML_TITLE_OPT%/ - Reserver/;
 848                 $HTML .= qq {<div style="float: left">\n};
 849                 &parse_program();
 850
 851                 my $duration = ( str2datetime( $end ) - str2datetime( $begin ) )->delta_minutes;
 852                 $title = $q->param( 'title' ) if ( !$title );
 853                 $HTML .= "番組名：$title<br>\nチャンネル：$chname<br>\n放送継続時間：$duration分<br>\n番組内容：$desc<br>\n";
 854                 if ( $longdesc ) {
 855                         $longdesc =~ s/\\n/<br>\n/gs;
 856                         $HTML .= "番組内容(長)：$longdesc<br>\n";
 857                 }
 858                 my $error = &check_error();
 859                 if ( $error )
 860                 {
 861                         # エラー
 862
 863                         $ary_ref = $dbh->selectall_arrayref(
 864                                 "SELECT start, stop FROM epg_timeline WHERE channel = '$ontv' AND title = '$title' "
 865                         );
 866                         if ( $error != 1 ) {
 867                                 $HTML .= "同一の番組の他の放送予定です。<br>\n";
 868                                 foreach my $line ( @{$ary_ref} ) {
 869                                         $begin = $line->[0];
 870                                         $end   = $line->[1];
 871                                         $begin =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/;
 872                                         $end   =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/;
 873                                         $overlap = &get_overlap() >= 2 ? '不可能' :
 874                                                 qq {<a href="rectool.pl?mode=confirm&amp;mode_sub=reserve&amp;chtxt=$chtxt&amp;start=$line->[0]&amp;stop=$line->[1]">可能</a>};
 875                                         $HTML .= "開始：$begin\n終了：$end\n録画は$overlap<br>\n";
 876                                 }
 877                         }
 878                 }
 879                 else {
 880                         $HTML .= "録画予約の詳細設定を行ってください。<br>\n";
 881                         $HTML .= qq {<form method="get" action="rectool.pl">\n};
 882                         $HTML .= qq {<input type="hidden" name="mode"   value="reserve">\n};
 883                         $HTML .= qq {<input type="hidden" name="chname" value="$chname">\n};
 884                         $HTML .= qq {<input type="hidden" name="start"  value="$start">\n};
 885                         $HTML .= qq {<input type="hidden" name="stop"   value="$stop">\n};
 886                         $HTML .= qq {<input type="hidden" name="title"  value="$title">\n} if ( $q->param( 'title' ) );
 887                         &draw_form_opt( 'reserve' );
 888                         $HTML .= qq {<input type="submit" value="予約">\n</form>\n};
 889                 }
 890                 goto end;
 891         }
 892         # End of $mode_sub eq 'reserve';
 893
 894         if ( $mode_sub eq 'proc' ) {
 895                 my    $type  = $q->param( 'type' );
 896                 local $chtxt = $q->param( 'chtxt' );
 897                 my    $title = $q->param( 'title' );
 898                 local $opt   = $q->param( 'opt' );
 899
 900                 $HTML .= "詳細設定を行ってください。<br>\n";
 901                 $HTML .= "タイトル：$title\n<br>\n";
 902
 903                 $HTML .= qq {<form method="get" action="rectool.pl">\n};
 904                 $HTML .= qq {<input type="hidden" name="mode"     value="change">\n};
 905                 $HTML .= qq {<input type="hidden" name="mode_sub" value="proc">\n};
 906                 $HTML .= qq {<input type="hidden" name="type"     value="$type">\n};
 907                 $HTML .= qq {<input type="hidden" name="title"    value="$title">\n};
 908                 &draw_form_channel( 'nonone' );
 909                 &draw_form_opt();
 910                 $HTML .= qq {<input type="submit" value="予約">\n</form>\n};
 911                 goto end;
 912         }
 913 }
 914
 915 if ( $mode eq 'reserve' ) {
 916         $HTML .= qq {<div style="float: left">\n};
 917         &parse_program();
 918         $title = $q->param( 'title' ) if ( !$title );
 919         @opt = $q->param( 'opt' );
 920         $opt = join '', @opt;
 921         my ( $deltaday, $deltatime );
 922
 923         if ( $q->param('every') eq '1' ) {
 924                 $type = 'search_everyday';
 925                 ( $changed_t ) = $title =~ /(.*)#/;
 926                 $title = $changed_t if ( $changed_t );
 927                 ( $changed_t ) = $title =~ /(.*)第/;
 928                 $title = $changed_t if ( $changed_t );
 929                 ( $changed_t ) = $title =~ /(.*)▽/;
 930                 $title = $changed_t if ( $changed_t );
 931                 $title =~ s/「.*」//;
 932                 $title =~ s/＜.*＞//;
 933                 $title =~ s/（.*）//;
 934                 $title =~ s/\[新\]//;
 935                 $title =~ s/無料≫//;
 936                 $title =~ s/\s*$//;
 937                 $deltaday  = 7;
 938                 $deltatime = 3;
 939         }
 940         else {
 941                 $type = 'reserve_flexible';
 942         }
 943         if ( !&check_error ) {
 944                 $dbh->do(
 945                         "INSERT INTO timeline ( type, chtxt, title, btime, etime, opt, deltaday, deltatime )
 946                         VALUES ( '$type', '$chtxt', '$title', '$begin', '$end', '$opt', '$deltaday', '$deltatime' )"
 947                 );
 948         }
 949         $HTML .= "録画予約を実行しました。<br>\n5秒後にトップへ移動します。<br>\n";
 950         $HTML =~ s|%REFRESH%|<meta http-equiv="refresh" content="5; url=rectool.pl">|;
 951         goto end;
 952 }
 953
 954 if ( $mode eq 'program' ) {
 955         &draw_form();
 956
 957         $HTML =~ s/%HTML_TITLE_OPT%/ - Program Viewer/;
 958         $unix = DateTime->now( time_zone => $tz )->strftime( '%Y%m%d%H%M%S' );
 959         $sql =
 960                 "SELECT channel, chtxt, chname, start, stop, title, category
 961                 FROM epg_timeline
 962                 INNER JOIN epg_ch ON epg_timeline.channel = epg_ch.ontv
 963                 WHERE $unix <= stop %CH% %DATE% %CATEGORY% %KEY% ORDER BY start";
 964
 965         if ( $ontv ) {
 966                 my $ch = "AND channel = '$ontv'";
 967                 $sql =~ s/%CH%/$ch/;
 968         }
 969         if ( $date_sel ) {
 970                 $date_1 = $date_sel . '000000';
 971                 $date_2 = Date::Simple->new( $date_sel =~ /(.{4})(.{2})(.{2})/ )->next->format('%Y%m%d') . '000000';
 972                 my $date = "AND '$date_1' <= stop AND start <= '$date_2'";
 973                 $sql =~ s/%DATE%/$date/;
 974         }
 975         if ( $category_sel ) {
 976                 # 一時的
 977                 #       $category_tmp = $category{$category_sel} . $category_sel;
 978                 my $category = "AND category = '$category{$category_sel}'";
 979                 $sql =~ s/%CATEGORY%/$category/;
 980         }
 981         if ( $key ) {
 982                 my $key = "AND TITLE LIKE '%$key%'";
 983                 $sql =~ s/%KEY%/$key/;
 984         }
 985         $sql =~ s/%CH%//;
 986         $sql =~ s/%DATE%//;
 987         $sql =~ s/%KEY%//;
 988         $sql =~ s/%CATEGORY%//;
 989
 990         $ary_ref = $dbh->selectall_arrayref( $sql );
 991         foreach my $prg ( @{ $ary_ref } ) {
 992                 my @date = $prg->[3] =~ /(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/;
 993
 994                 $date = $date[2];
 995                 if ( $date != $prev ) {
 996                         my $date = DateTime->new(
 997                                 year => $date[0], month  => $date[1], day    => $date[2],
 998                                 locale => 'ja_JP'
 999                         );
1000
1001                         my $dn = $date->day_name;
1002                         utf8::encode( $dn );
1003                         $HTML .= qq {--------$date[1]/$date[2]($dn)--------<br>\n};
1004                 }
1005                 $HTML .= qq {$date[1]/$date[2] $date[3]:$date[4] };
1006                 $HTML .= qq {$prg->[2] } if ( !$ontv );
1007                 $HTML .= qq {<a href="rectool.pl?mode=confirm&amp;mode_sub=reserve&amp;chtxt=$prg->[1]&amp;start=$prg->[3]&amp;stop=$prg->[4]">$prg->[5]</a><br>\n};
1008                 $prev = $date;
1009         }
1010
1011 }
1012
1013 if ( $mode eq 'list' ) {
1014         $HTML =~ s/%HTML_TITLE_OPT%/ - List/;
1015         $HTML .= qq {<div>\n};
1016
1017         my $recording   = $cfg->param( 'path.recpath' );
1018         my $ts_movepath = $cfg->param( 'path.ts_movepath' );
1019         my $recorded    = $cfg->param( 'path.recorded' );
1020
1021         if ( $mode_sub eq 'log' ) {
1022                 my $title = $q->param( 'title' );
1023                 my $log = slurp( "$recording/$title.log" ) if ( -e "$recording/$title.log" );
1024                 $HTML .= '<pre>'.$log."</pre>\n";
1025                 goto end;
1026         }
1027         if ( !$mode_sub ) {
1028                 $HTML .= qq {<a href="rectool.pl?mode=list&amp;mode_sub=new">録画中のみ</a>\n};
1029                 $HTML .= qq {<a href="rectool.pl?mode=list&amp;mode_sub=old">録画後のみ</a>\n<br>\n};
1030         }
1031         if ( !$mode_sub || $mode_sub eq 'new' ) {
1032                 $HTML .= "録画中のファイル一覧<br>\n";
1033                 &list( $recording );
1034         }
1035         if ( !$mode_sub ) {
1036                 $HTML .= "<br>\n";
1037         }
1038         if ( !$mode_sub || $mode_sub eq 'old' ) {
1039                 $HTML .= "録画後のファイル一覧<br>\n";
1040                 &simple_list( $ts_movepath );
1041                 &simple_list( $recorded );
1042         }
1043
1044         sub list {
1045                 local $path = shift;
1046                 local %list = ();
1047                 my @exp = ( 'log', 'ts.b25', 'ts.tsmix', 'ts', 'ts.log.mbtree', 'ts.log',
1048                         'sa.avi', 'sa.avi.log', 'aac', 'srt', 'm2v', 'wav', 'avi', '264', 'mp4', 'mkv' );
1049                 for ( 0..$#exp ) {
1050                         $exp{$exp[$_]} = $_;
1051                 }
1052                 my $exp_count = scalar keys %exp;
1053
1054                 &get_file_list_wrapper( $path, \&wanted );
1055
1056                 my $help;
1057                 foreach my $name ( sort { $exp{$a} <=> $exp{$b} } keys %exp ) {
1058                         $help .= $exp{$name} + 1 . " = $name / ";
1059                 }
1060                 $HTML .= $help;
1061                 $help  = qq {<tr style="background-color: #87CEEB"><td rowspan="2">$help\n</td>\n};
1062                 $help .= qq {<td>$_</td>\n} for ( 1..$exp_count );
1063                 $help .= qq {<td colspan="2">自動移動</td>\n</tr>\n};
1064                 $help .= qq {<tr>\n</tr>\n};
1065
1066                 $HTML .= qq {<br>\n○ = 完了 / ● = 書き込み中 / ◆ = ファイルサイズ異常<br>\n};
1067                 $HTML .= qq {<table summary="listtable" border=1 cellspacing=0>\n<tr>\n};
1068                 $HTML .= qq {<th>タイトル</th>\n};
1069                 $HTML .= qq {<th>$_</th>\n} for ( 1..$exp_count );
1070                 $HTML .= qq {<th colspan="2">自動移動</th>\n};
1071                 $HTML .= qq {</tr>\n};
1072
1073                 my $count = 0;
1074
1075                 foreach my $title ( sort keys %list ) {
1076                         my $value = $list{$title};
1077                         my @flag = ( 0 ) x ( $exp_count );
1078                         $HTML .= qq {<tr>\n<td width="600" style="width: 600px; white-space: normal">$title</td>\n};
1079                         foreach my $exp ( keys %{$value} ) {
1080                                 if ( $exp eq 'log' ) {
1081                                         my $title = $q->url_encode( $title );
1082                                         my $check = qq {<td><a href="rectool.pl?mode=list&amp;mode_sub=log&amp;title=$title">○</a></td>\n};
1083
1084                                         $value->{$exp}->{check} = $check;
1085                                 }
1086                                 elsif ( $exp eq 'mkv' ) {
1087                                         my $title = $q->url_encode( $title );
1088
1089                                         my $check = qq {<td><a title="$value->{$exp}->{size}" href="rectool.pl?mode=thumb&amp;title=$title">■</a></td>\n};
1090                                         $value->{$exp}->{check} = $check;
1091                                 }
1092                                 $flag[$exp{$exp}] = $value->{$exp};
1093                         }
1094                         if ( !$flag[$exp{'mkv'}] ) {
1095                                 $flag[@flag]->{check} = qq {<td colspan="2"><br></td>\n};
1096                         }
1097                         else {
1098                                 my $title = $q->url_encode( $title );
1099
1100                                 $flag[@flag]->{check} =
1101                                         qq {<td><a href="rectool.pl?mode=change&amp;mode_sub=move&amp;mode_sub2=predict&amp;title=$title">予測</a></td>\n}.
1102                                         qq {<td><a href="rectool.pl?mode=change&amp;mode_sub=move&amp;mode_sub2=exec&amp;title=$title">実行</a></td>\n};
1103                         }
1104                         foreach ( @flag ) {
1105                                 my $size = $_->{size};
1106                                 my $last = $_->{last} || ( $_->{size} eq '0 B' ? '◆' : '○' );
1107                                 my $check =  $size ? qq {<span title="$size">$last</span>} : '<br>';
1108                                 $HTML .= $_->{check} ? $_->{check} : qq {<td>$check</td>\n};
1109                         }
1110                         $HTML .= qq {</tr>\n};
1111                         $HTML .= $help unless ( ++$count % 20 );
1112                 }
1113                 $HTML .= qq {</table>\n};
1114
1115                 sub wanted {
1116                         my $rel = shift;
1117                         my $abs = shift;
1118
1119                         return if ( $rel =~ /Thumbs\.db/ );
1120                         return if ( $rel =~ /\.idx/ );
1121
1122                         $rel =~ s/\.temp$//;
1123                         my $regexp = join '|', keys %exp;
1124                         my ( $title, $exp ) = $rel =~ /(.*?)\.($regexp)$/;
1125                         my ( $size, $last ) = &get_size( $abs );
1126                         $rel =~ s/\.temp$//;
1127                         if ( !$title ) {
1128                                 $title = '_error_exp_'.$rel;
1129                                 $exp   = 'log';
1130                         }
1131                         if ( $title !~ /[^0-9A-F]+/ ) {
1132                                 my $tmp = pack( 'H*', $title );
1133                                 if ( !$tmp ) {
1134                                         $title = '_error_b16_'.$rel;
1135                                         $exp   = 'log';
1136                                 }
1137                                 else {
1138                                         $title = 'Base16_'.$tmp;
1139                                 }
1140                         }
1141                         $list{$title}->{$exp} = { 'last' => $last, 'size' => $size };
1142                 }
1143         }
1144
1145         sub simple_list {
1146                 require Encode;
1147
1148                 local $path = shift;
1149                 local @list = ();
1150
1151                 &get_file_list_wrapper( $path, \&simple_wanted );
1152
1153 #               @list = sort @list;
1154                 # natural sortを行う
1155                         @list = map( Encode::decode_utf8( $_ ), @list );
1156                         @list = nsort @list;
1157                         @list = map( Encode::encode_utf8( $_ ), @list );
1158
1159                 foreach ( @list ) {
1160                         $HTML .= "$_<br>\n";
1161                 }
1162
1163                 sub simple_wanted {
1164                         my $rel = shift;
1165                         my $abs = shift;
1166
1167                         my ( $size ) = &get_size( $abs );
1168                         push @list, $rel ."\t\t". $size;
1169                 }
1170         }
1171
1172         sub get_size {
1173                 my $file = shift;
1174                 my ( $size, $last ) = (stat( $file ))[7,9];
1175                 my @unim = ("B","KiB","MiB","GiB","TiB","PiB");
1176                 my $count = 0;
1177
1178                 while($size >= 1024 ){
1179                         $count++;
1180                         $size = $size / 1024;
1181                 }
1182                 $size *= 100;
1183                 $size  = int( $size );
1184                 $size /= 100;
1185                 if ( time - $last < 10 ) {
1186                         $last = '●';
1187                 }
1188                 else {
1189                         $last = '';
1190                 }
1191                 return ( "$size $unim[$count]", $last );
1192         }
1193 }
1194
1195 if ( $mode eq 'thumb' ) {
1196         my $title = $q->param( 'title' );
1197         my $pos  = $q->param( 'pos' );
1198         my $recording = $cfg->param( 'path.recpath' );
1199
1200         print "Content-Type: image/jpeg\n\n";
1201         exec "ffmpeg -ss 300 -i '$recording/$title.mkv' -f image2 -pix_fmt jpg -vframes 1 -s 320x240 -";
1202         exit;
1203 }
1204
1205 if ( $mode eq 'check' ) {
1206 }
1207
1208 if ( $mode eq 'bravia' ) {
1209         $HTML =~ s/%HTML_TITLE_OPT%/ - Bravia/;
1210         $HTML .= qq {<div>\n};
1211         $HTML .= qq {<form method="get" action="rectool.pl">\n};
1212         $HTML .= qq {<div>\n};
1213         $HTML .= qq {<table summary="bayestable" border=1 cellspacing=0>\n<tr>\n};
1214         $HTML .= qq {<th>ID</th>\n};
1215         $HTML .= qq {<th>チャンネル</th>\n};
1216         $HTML .= qq {<th>タイトル</th>\n};
1217         $HTML .= qq {<th><a href="rectool.pl?mode=bravia">開始時刻</a></th>\n};
1218         $HTML .= qq {<th>終了時刻</th>\n};
1219         $HTML .= qq {<th>録画時間</th>\n};
1220         $HTML .= qq {<th><a href="rectool.pl?mode=bravia&amp;order=point">ポイント</a></th>\n};
1221         $HTML .= qq {<th>予約</th>\n};
1222         $HTML .= qq {</tr>\n};
1223
1224         my $order = $q->param( 'order' );
1225         if ( $order ne 'point' ) {
1226                 $order = 'btime';
1227         }
1228         else {
1229                 $order = 'point DESC';
1230         }
1231         my $ary_ref = $dbh->selectall_arrayref(
1232                 "SELECT id, chtxt, title, btime, etime, point
1233                 FROM auto_timeline_bayes
1234                 ORDER BY $order" );
1235
1236         foreach my $line ( @{ $ary_ref } ) {
1237                 my ( $begin, $end, $diff ) = &str2readable( $line->[3], $line->[4] );
1238
1239                 $HTML .= qq {<tr align="center">\n};
1240                 $HTML .= qq {<td>$line->[0]</td>\n};
1241                 $HTML .= qq {<td>$line->[1]</td>\n};
1242                 $HTML .= qq {<td>$line->[2]</td>\n};
1243                 $HTML .= qq {<td>$begin</td>\n<td>$end</td>\n<td>$diff</td>\n};
1244                 $HTML .= qq {<td>$line->[5]</td>\n};
1245                 $HTML .= qq {<td><a href="rectool.pl?mode=confirm&amp;mode_sub=reserve&amp;bayesid=$line->[0]">予約</a></td>\n};
1246                 $HTML .= qq {</tr>\n};
1247         }
1248         $HTML .= qq {</table>\n};
1249         $HTML .= qq {</div>\n};
1250         $HTML .= qq {</form>\n};
1251
1252 }
1253
1254 if ( $mode eq 'proc' ) {
1255         $HTML =~ s/%HTML_TITLE_OPT%/ - Proposal/;
1256         $HTML .= qq {<div>\n};
1257         $HTML .= qq {<table summary="proctable" border=1 cellspacing=0>\n<tr>\n};
1258         $HTML .= qq {<th>タイプ</th>\n};
1259         $HTML .= qq {<th>タイトル</th>\n};
1260         $HTML .= qq {<th>予約</th>\n};
1261         $HTML .= qq {</tr>\n};
1262
1263         my $ary_ref = $dbh->selectall_arrayref(
1264                 "SELECT type, chtxt, title
1265                 FROM auto_proc
1266                 ORDER BY title " );
1267
1268         foreach my $line ( @{ $ary_ref } ) {
1269                 my $url;
1270                 $line->[3] = $q->url_encode( $line->[2] );
1271                 my $opt = $dbh->selectrow_array(
1272                         "SELECT opt FROM in_timeline_log
1273                         WHERE title = '$line->[2]' "
1274                 );
1275
1276                 if ( $line->[0] eq 'auto_suggest_dec' ) {
1277                         unless ( $dbh->selectrow_array(
1278                                 "SELECT 1 FROM timeline
1279                                 WHERE ( type = 'convert_b25_ts' OR type = 'convert_b25_ts_running' )
1280                                 AND title = '$line->[2]' "
1281                         ) ) {
1282                                 $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};
1283                         }
1284                 }
1285                 elsif ( $line->[0] eq 'auto_suggest_enc' ) {
1286                         unless ( $dbh->selectrow_array(
1287                                 "SELECT 1 FROM timeline
1288                                 WHERE ( type = 'convert_ts_mp4' OR type = 'convert_ts_mp4_running' )
1289                                 AND title = '$line->[2]' "
1290                         ) ) {
1291                                 $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};
1292                         }
1293                 }
1294                 else {
1295                         unless ( $dbh->selectrow_array(
1296                                 "SELECT 1 FROM timeline
1297                                 WHERE ( type LIKE 'convert_avi%' OR type = 'convert_mkv' )
1298                                 AND title = '$line->[2]' "
1299                         ) ) {
1300                                 $url = qq {rectool.pl?mode=confirm&amp;mode_sub=proc&amp;type=$line->[0]&amp;chtxt=$line->[1]&amp;title=$line->[3]};
1301                         }
1302                 }
1303                 if ( $url ) {
1304                         $href = qq {<a href="$url">予約</a>};
1305                 }
1306                 else {
1307                         $href = q {予約済};
1308                 }
1309
1310                 my $color = $color{$type_suggest{$line->[0]}} ? $color{$type_suggest{$line->[0]}} : '';
1311                 $line->[0] = $type{$line->[0]} ? $type{$line->[0]} : $line->[0];
1312                 $line->[0] = qq {<span style="color: $color">$line->[0]</span>} if ( $color );
1313                 $HTML .= qq {<tr align="center">\n};
1314                 $HTML .= qq {<td>$line->[0]</td>\n};
1315                 $HTML .= qq {<td align="left">$line->[2]</td>\n};
1316                 $HTML .= qq {<td>$href</td>\n};
1317                 $HTML .= qq {</tr>\n};
1318         }
1319
1320         $HTML .= qq {</table>\n};
1321 }
1322
1323 if ( $mode eq 'jbk' ) {
1324         $HTML =~ s/%HTML_TITLE_OPT%/ - JBK/;
1325         $HTML .= qq {<div>\n};
1326
1327         if ( $mode_sub eq 'add' ) {
1328                 my $keyword = $q->param( 'keyword' );
1329                 $HTML .= "キーワード「$keyword」を追加しました。<br>\n";
1330                 $dbh->do(
1331                         "INSERT INTO in_auto_jbk_key ( keyword )
1332                         VALUES ( '$keyword' )"
1333                 );
1334         }
1335         elsif ( $mode_sub eq 'del' ) {
1336                 my $id = $q->param( 'id' );
1337                 my $keyword = $dbh->selectrow_array(
1338                         "SELECT keyword FROM in_auto_jbk_key
1339                         WHERE id = '$id' " );
1340                 $HTML .= "キーワード「$keyword」を削除しました。<br>\n";
1341                 $dbh->do(
1342                         "DELETE FROM in_auto_jbk_key WHERE id = '$id'"
1343                 );
1344         }
1345
1346         $HTML .= qq {<table summary="jbktable" border=1 cellspacing=0>\n<tr>\n};
1347         $HTML .= qq {<th>ID</th>\n};
1348         $HTML .= qq {<th>キーワード</th>\n};
1349         $HTML .= qq {<th>削除</th>\n};
1350         $HTML .= qq {</tr>\n};
1351
1352         my $ary_ref = $dbh->selectall_arrayref(
1353                 "SELECT id, keyword
1354                 FROM in_auto_jbk_key
1355                 ORDER BY id " );
1356
1357         foreach my $line ( @{ $ary_ref } ) {
1358                 my $url = "rectool.pl?mode=jbk&amp;mode_sub=del&amp;id=$line->[0]";
1359
1360                 $HTML .= qq {<tr align="center">\n};
1361                 $HTML .= qq {<td>$line->[0]</td>\n};
1362                 $HTML .= qq {<td>$line->[1]</td>\n};
1363                 $HTML .= qq {<td><a href="$url">削除</a></td>\n};
1364                 $HTML .= qq {</tr>\n};
1365         }
1366
1367         $HTML .= qq {</table>\n};
1368
1369         $HTML .= qq {<form method="get" action="rectool.pl">\n};
1370         $HTML .= qq {<div>\n};
1371         $HTML .= qq {<input type="hidden" name="mode" value="jbk">\n};
1372         $HTML .= qq {<input type="hidden" name="mode_sub" value="add">\n};
1373         $HTML .= qq {<input name="keyword" type="text">\n};
1374         $HTML .= qq {<input type="submit" value="追加">\n</div>\n</form>\n<br>\n};
1375
1376         $HTML .= qq {<table summary="jbkrestable" border=1 cellspacing=0>\n<tr>\n};
1377         $HTML .= qq {<th>ID</th>\n};
1378         $HTML .= qq {<th>チャンネル</th>\n};
1379         $HTML .= qq {<th>タイトル</th>\n};
1380         $HTML .= qq {<th>開始時刻</th>\n};
1381         $HTML .= qq {<th>終了時刻</th>\n};
1382         $HTML .= qq {<th>録画時間</th>\n};
1383         $HTML .= qq {<th>予約</th>\n};
1384         $HTML .= qq {</tr>\n};
1385
1386         my $ary_ref = $dbh->selectall_arrayref(
1387                 "SELECT id, chtxt, title, btime, etime
1388                 FROM auto_timeline_keyword " );
1389
1390         foreach my $line ( @{ $ary_ref } ) {
1391                 my ( $begin, $end, $diff ) = &str2readable( $line->[3], $line->[4] );
1392                 $line->[3] =~ s/(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/$1$2$3$4$5$6/;
1393                 $line->[4] =~ s/(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/$1$2$3$4$5$6/;
1394                 my $url = qq "rectool.pl?mode=confirm&amp;mode_sub=reserve&amp;chtxt=$line->[1]&amp;start=$line->[3]&amp;stop=$line->[4]";
1395
1396                 $HTML .= qq {<tr align="center">\n};
1397                 $HTML .= qq {<td>$line->[0]</td>\n};
1398                 $HTML .= qq {<td>$line->[1]</td>\n};
1399                 $HTML .= qq {<td>$line->[2]</td>\n};
1400                 $HTML .= qq {<td>$begin</td>\n};
1401                 $HTML .= qq {<td>$end</td>\n};
1402                 $HTML .= qq {<td>$diff</td>\n};
1403                 $HTML .= qq {<td><a href="$url">予約</a></td>\n};
1404                 $HTML .= qq {</tr>\n};
1405         }
1406
1407         $HTML .= qq {</table>\n};
1408
1409 }
1410
1411 if ( $mode eq 'recognize' ) {
1412         $HTML =~ s/%HTML_TITLE_OPT%/ - Recognizer/;
1413
1414         my $text  = $q->param( 'text' );
1415         $chtxt = $q->param( 'chtxt' );
1416         my $title = $q->param( 'title' );
1417
1418         $HTML .= qq {<div>\n};
1419         $HTML .= qq {与えられた文字列のうち、番組の放送時刻と思われる文字列を認識します。<br>\n};
1420         $HTML .= qq {番組表が取得できない一週間以上先の予約ができます。<br>\n};
1421         $HTML .= qq {<form method="post" action="rectool.pl">\n};
1422         $HTML .= qq {<div>\n};
1423         &draw_form_channel( 'nonone' );
1424         $HTML .= qq {<input type="text" name="title" value="$title">\n};
1425         $HTML .= qq {<br>\n};
1426         $HTML .= qq {<input type="hidden" name="mode" value="recognize">\n};
1427         $HTML .= qq {<textarea name="text" cols=40 rows=4>\n$text</textarea>\n};
1428         $HTML .= qq {<input type="submit" value="実行">\n</div>\n</form>\n};
1429
1430         my @ch_list = @{ $dbh->selectcol_arrayref( "SELECT chtxt FROM epg_ch" ) };
1431         my $ch_list = join '|', @ch_list;
1432
1433         if ( $text ) {
1434                 my ( $year, $month, $day );
1435                 my ( $hour, $minute );
1436                 my $next_day = 0;
1437                 foreach ( split /\n/, $text ) {
1438                         my @date = /(\d{4}).(\d{1,2}).(\d{1,2})/;
1439                         my @time = /(\d{1,2})[:：](\d{1,2})/;
1440                         s/(\d{4}).(\d{2}).(\d{2})//;
1441                         s/(\d{1,2})[:：](\d{2})//;
1442                         s/\(.*\)//;
1443                         if ( !@date ) {
1444                                 $date[0] = Time::Piece->localtime->year;
1445                                 ( $date[1], $date[2] ) = /(\d{1,2})月(\d{1,2})日/;
1446                                 s/(\d{1,2})月(\d{1,2})日//;
1447                         }
1448                         next if (!( @date || @time ));
1449                         ( $year, $month, $day ) = @date if ( $date[0] && $date[1] && $date[2] );
1450                         ( $hour, $minute )      = @time if ( defined $time[0] && defined $time[1] );
1451                         $next_day = 1 if ( $_ =~ /深夜/ );
1452                         my ( $ch ) = /($ch_list)/;
1453                         my $chtxt = $ch if ( $ch );
1454
1455                         if ( $year && $month && $day && defined $hour && defined $minute ) {
1456                                 my $tp = Time::Piece->strptime( "$year-$month-$day $hour:$minute", '%Y-%m-%d %H:%M' );
1457                                 $tp += ONE_DAY if ( $next_day );
1458                                 my $start = $tp->strftime( '%Y%m%d%H%M%S' );
1459                                 my $stop  = ( $tp + ONE_MINUTE * 30 )->strftime( '%Y%m%d%H%M%S' );
1460                                 $title = $_ if ( !$title );
1461                                 my $url = qq "rectool.pl?mode=confirm&amp;mode_sub=reserve&amp;chtxt=$chtxt&amp;start=$start&amp;stop=$stop&amp;title=$title";
1462                                 $HTML .= qq {認識結果:$year-$month-$day $hour:$minute 残り:$_<a href="$url">リンク</a> <br>\n};
1463                         }
1464                 }
1465         }
1466 }
1467
1468 if ( $mode eq 'expert' ) {
1469         require List::Compare;
1470
1471         my $ary_ref;
1472
1473         $HTML =~ s/%HTML_TITLE_OPT%/ - Expert/;
1474         $HTML .= qq {<div>\n};
1475
1476         if ( $mode_sub eq 'reget' ) {
1477                 my $bctype = $q->param( 'bctype' );
1478                 my ( $ontv, $chname ) = $dbh->selectrow_array(
1479                         "SELECT ontv, chname FROM epg_ch
1480                         WHERE bctype = '$bctype' " );
1481                 $HTML .= "Update for $chname ( ontv: $ontv ) has been reserved.<br>\n";
1482                 $dbh->do( "UPDATE epg_ch SET status = '2' WHERE ontv = '$ontv' " );
1483                 goto end;
1484         }
1485
1486
1487         my @ary = $dbh->selectrow_array(
1488                 "SELECT auto_jbk, auto_bayes, auto_del_tmp, auto_opt
1489                 FROM in_settings " );
1490         my $opt = pop @ary;
1491         @ary = map( $_ ? 'checked' : '', @ary );
1492
1493         $HTML .= qq {内部オプションの変更\n<br>};
1494         $HTML .= qq {<form method="get" action="rectool.pl">\n};
1495         $HTML .= qq {<div>\n};
1496         $HTML .= qq {<input type="hidden" name="mode"     value="change">\n};
1497         $HTML .= qq {<input type="hidden" name="mode_sub" value="setting">\n};
1498         $HTML .= qq {<input type="checkbox" name="jbk"     value="1" $ary[0]>自動地引\n};
1499         $HTML .= qq {<input type="checkbox" name="bayes"   value="1" $ary[1]>自動ベイズ\n};
1500         $HTML .= qq {<input type="checkbox" name="del_tmp" value="1" $ary[2]>自動一時ファイル削除\n};
1501         $HTML .= qq {自動オプション:<input type="text" name="opt" value="$opt">\n};
1502         $HTML .= qq {<input type="submit" value="保存">\n</div>\n</form>\n};
1503
1504
1505         $HTML .= qq {<hr>\n番組表のカテゴリ一覧と内蔵のカテゴリ一覧の合致を確認中...\n};
1506         $ary_ref = $dbh->selectcol_arrayref(
1507                 "SELECT DISTINCT category FROM epg_timeline"
1508         );
1509         my @category = sort values %category;
1510         if ( List::Compare->new( $ary_ref, \@category )->get_symdiff ) {
1511                 $HTML .= qq {一致しません<br>\n};
1512                 $HTML .= qq {番組表：@{$ary_ref}<br>\n内蔵：@category<br>\n};
1513         }
1514         else {
1515                 $HTML .= qq {一致しました<br>\n};
1516         }
1517
1518
1519         my @ary = $dbh->selectrow_array( "SELECT terec, bscsrec, b252ts, ts2avi FROM in_status" );
1520         $HTML .= qq {<hr>\n地上波録画数：$ary[0]\n衛星波録画数：$ary[1]\n解読数：$ary[2]\n縁故数：$ary[3]\n<br>\n};
1521         $HTML .= qq {<form method="get" action="rectool.pl">\n};
1522         $HTML .= qq {<div>\n};
1523         $HTML .= qq {<input type="hidden" name="mode"     value="change">\n};
1524         $HTML .= qq {<input type="hidden" name="mode_sub" value="fixstatus">\n};
1525         $HTML .= qq {<input type="submit" name="terec"   value="地上波録画数をリセット">\n};
1526         $HTML .= qq {<input type="submit" name="bscsrec" value="衛星波録画数をリセット">\n};
1527         $HTML .= qq {<input type="submit" name="b252ts"  value="解読数をリセット">\n};
1528         $HTML .= qq {<input type="submit" name="ts2avi"  value="縁故数をリセット">\n</div>\n</form>\n};
1529
1530
1531         $HTML .= qq {<hr>\nRec10 バージョン：$rec10_version\nrectool バージョン：$rectool_version\n<br>\n};
1532
1533
1534         $HTML .= qq {<hr>\n番組表の欠落<br>\n};
1535         $ary_ref = $dbh->selectall_arrayref( "SELECT chname, chtxt FROM epg_ch" );
1536         foreach my $line ( @{$ary_ref} ) {
1537                 my $ary_ref = $dbh->selectall_arrayref(
1538                         "SELECT start, stop, title FROM epg_timeline WHERE channel = '$line->[1]' ORDER BY start"
1539                 );
1540                 my $error;
1541                 my @program_old = ( '', $ary_ref->[0]->[0] );
1542                 my $program_old = \@program_old;
1543
1544                 foreach my $program_new ( @{$ary_ref} ) {
1545                         if ( $program_old->[1] ne $program_new->[0] &&
1546                                 $program_old->[2] !~ /クロ?ジング|クロージング|エンディング|休止|ミッドナイト/ &&
1547                                 $program_new->[2] !~ /オープニング|ウィークリー・インフォメーション|モーニング/ &&
1548                                 ( str2datetime( $program_new->[0] ) - str2datetime( $program_old->[1] ) )->delta_minutes > 30 ) {
1549                                 $program_old->[1] =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/;
1550                                 $program_new->[0] =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/;
1551                                 $error .= qq{    $program_old->[2]    $program_old->[1]\n    ?  $program_new->[2]    $program_new->[0]\n};
1552                         }
1553                         $program_old = $program_new;
1554                 }
1555                 $HTML .= qq {<pre>\n$line->[0]\n$error</pre>\n} if ( $error );
1556                 }
1557
1558
1559         $ary_ref = $dbh->selectall_arrayref(
1560                 "SELECT chname, chtxt, ontv, bctype, ch, csch, updatetime, status
1561                 FROM epg_ch
1562                 ORDER BY bctype " );
1563         $HTML .= qq {<hr>\n番組表の更新状況<br>\n};
1564         $HTML .= qq {<table summary="channeltable" border=1 cellspacing=0>\n<tr>\n};
1565         $HTML .= qq {<th>チャンネル名</th>\n};
1566         $HTML .= qq {<th>チャンネルコード</th>\n};
1567         $HTML .= qq {<th>ontvコード</th>\n};
1568         $HTML .= qq {<th>タイプ</th>\n};
1569         $HTML .= qq {<th>ch</th>\n};
1570         $HTML .= qq {<th>csch</th>\n};
1571         $HTML .= qq {<th>最終更新時刻</th>\n};
1572         $HTML .= qq {<th>状態</th>\n};
1573         $HTML .= qq {</tr>\n};
1574         foreach my $status ( @{$ary_ref} ) {
1575                 $HTML .= qq {<tr>\n};
1576                 $HTML .= qq {<td>$status->[0]</td>\n<td>$status->[1]</td>\n<td>$status->[2]</td>\n<td>$status->[3]</td>\n};
1577                 $HTML .= qq {<td>$status->[4]</td>\n<td>$status->[5]</td>\n<td>$status->[6]</td>\n<td>$status->[7]</td>\n};
1578                 $HTML .= qq {</tr>\n};
1579         }
1580         $HTML .= qq {</table>\n};
1581
1582         $HTML .= qq {<form method="get" action="rectool.pl">\n};
1583         $HTML .= qq {<div>\n};
1584         $HTML .= qq {番組表を再取得する\n};
1585         $HTML .= qq {<input type="hidden" name="mode" value="expert">\n};
1586         $HTML .= qq {<input type="hidden" name="mode_sub" value="reget">\n};
1587         $HTML .= qq {<select name="bctype">\n};
1588         $ary_ref = $dbh->selectall_arrayref(
1589                 "SELECT chname, bctype
1590                 FROM epg_ch WHERE bctype NOT LIKE '_s%' "
1591         );
1592         foreach my $line ( @{$ary_ref} ) {
1593                 $HTML .= qq {<option value="$line->[1]">$line->[0]</option>\n};
1594         }
1595         $HTML .= qq {<option value="bs">BS</option>\n};
1596         $HTML .= qq {<option value="cs1">CS1</option>\n};
1597         $HTML .= qq {<option value="cs2">CS2</option>\n};
1598         $HTML .= qq {</select>\n};
1599         $HTML .= qq {<input type="submit" value="実行">\n</div>\n</form>\n};
1600
1601
1602
1603         $ary_ref = $dbh->selectall_arrayref(
1604                 "SELECT id, type, chtxt, title, btime, etime, deltaday, deltatime
1605                 FROM timeline
1606                 ORDER BY id ");
1607         $HTML .= qq {<hr>\n予約表<br>\n};
1608         $HTML .= qq {<table summary="rectimetable" border=1 cellspacing=0>\n<tr>\n};
1609         $HTML .= qq {<th>ID</th>\n};
1610         $HTML .= qq {<th>type</th>\n};
1611         $HTML .= qq {<th>chtxt</th>\n};
1612         $HTML .= qq {<th>title</th>\n};
1613         $HTML .= qq {<th>btime</th>\n};
1614         $HTML .= qq {<th>etime</th>\n};
1615         $HTML .= qq {<th>deltaday</th>\n};
1616         $HTML .= qq {<th>deltatime</th>\n};
1617         $HTML .= qq {</tr>\n};
1618         foreach my $status ( @{$ary_ref} ) {
1619                 $HTML .= qq {<tr>\n};
1620                 $HTML .= qq {<td>$status->[0]</td>\n<td>$status->[1]</td>\n<td>$status->[2]</td>\n<td>$status->[3]</td>\n};
1621                 $HTML .= qq {<td>$status->[4]</td>\n<td>$status->[5]</td>\n<td>$status->[6]</td>\n<td>$status->[7]</td>\n};
1622                 $HTML .= qq {</tr>\n};
1623         }
1624         $HTML .= qq {</table>\n};
1625 }
1626
1627 if ( $mode eq 'log' ) {
1628         $HTML =~ s/%HTML_TITLE_OPT%/ - Log/;
1629
1630         $HTML .= qq {<div>\n};
1631         $HTML .= qq {<table summary="reclogtable" border=1 cellspacing=0>\n<tr>\n};
1632         $HTML .= qq {<th>ID</th>\n};
1633         $HTML .= qq {<th>chtxt</th>\n};
1634         $HTML .= qq {<th>title</th>\n};
1635         $HTML .= qq {<th>btime</th>\n};
1636         $HTML .= qq {<th>etime</th>\n};
1637         $HTML .= qq {<th>opt</th>\n};
1638         $HTML .= qq {<th>exp</th>\n};
1639         $HTML .= qq {<th>longexp</th>\n};
1640         $HTML .= qq {<th>category</th>\n};
1641         $HTML .= qq {</tr>\n};
1642         $ary_ref = $dbh->selectall_arrayref(
1643                 "SELECT id, chtxt, title, btime, etime, opt, exp, longexp, category
1644                 FROM in_timeline_log "
1645         );
1646         foreach my $line ( @{$ary_ref} ) {
1647                 $HTML .= qq {<tr>\n};
1648                 $HTML .= qq {<td>$line->[0]</td>\n<td>$line->[1]</td>\n<td>$line->[2]</td>\n<td>$line->[3]</td>\n};
1649                 $HTML .= qq {<td>$line->[4]</td>\n<td>$line->[5]</td>\n<td>$line->[6]</td>\n<td>$line->[7]</td>\n};
1650                 $HTML .= qq {<td>$line->[8]</td>\n};
1651                 $HTML .= qq {</tr>\n};
1652         }
1653         $HTML .= qq {</table>\n};
1654 }
1655
1656 if ( $mode eq 'help' ) {
1657         $HTML =~ s/%HTML_TITLE_OPT%/ - Help/;
1658         $HTML =~ s|%REFRESH%|<meta http-equiv="refresh" content="300">|;
1659         $HTML .= qq {<div>\n};
1660         $HTML .= qq {ヘルプ\n};
1661 }
1662
1663 if ( $mode eq 'test' ) {
1664         $HTML =~ s/%HTML_TITLE_OPT%/ - Test/;
1665         $HTML =~ s|%REFRESH%|<meta http-equiv="refresh" content="300">|;
1666         $HTML .= qq {<div>\n};
1667
1668         require Data::Dumper;
1669         $tmp = Perl6::Slurp::slurp( 'config.ini' );
1670         $tmp =~ s/\n/<br>\n/gs;
1671         $HTML .= $tmp;
1672
1673         # $HTML .= Dumper( $ary_ref );
1674 }
1675
1676 if ( !$mode ) {
1677         &draw_form();
1678         $HTML =~ s/%HTML_TITLE_OPT%/ - Top/;
1679         $HTML .= qq {Welcome to Rec10!<br>\n};
1680         goto end;
1681 }
1682
1683
1684 end:
1685 #<div style="float: right">
1686 $HTML .= <<EOM;
1687 </div>
1688 </body>
1689 </html>
1690 EOM
1691
1692 #<div align="center">
1693 #$HTML_ADV = $HTML_ADV_IMG . $HTML_ADV_TEXT if ( !$HTML_ADV );
1694 $HTML_HEADER = qq {<div style="text-align: center">\n$HTML_ADV\n</div>\n};
1695
1696 &draw_menu();
1697 $HTML =~ s/%HTML_TITLE_OPT%//;
1698 $HTML =~ s/%REFRESH%//;
1699 $HTML =~ s/%SCRIPT%//;
1700 $HTML =~ s/%CSS%//;
1701 $HTML =~ s/%HTML_HEADER%/$HTML_HEADER/;
1702
1703 print $HTTP_HEADER;
1704 print $HTML;
1705 exit;
1706
1707 sub draw_menu {
1708         $hires = Time::HiRes::time() - $hires;
1709         $last_modified = localtime((stat 'rectool.pl')[9]);
1710
1711         $HTML_HEADER .= qq {<div>\n};
1712         $HTML_HEADER .= qq {<span style="float: right; font-size: 8px">Last-Modified: $last_modified<br>Time-Elapsed: $hires秒</span>\n};
1713         $HTML_HEADER .= qq {<span style="float: left">\n};
1714         $HTML_HEADER .= qq {<a href="rectool.pl">トップ</a>\n};
1715         $HTML_HEADER .= qq {<a href="rectool.pl?mode=schedule">予約確認</a>\n};
1716         $HTML_HEADER .= qq {<a href="rectool.pl?mode=graph">予約状況(画像版)</a>\n};
1717         $HTML_HEADER .= qq {<a href="rectool.pl?mode=list">録画一覧</a>\n};
1718         $HTML_HEADER .= qq {<a href="rectool.pl?mode=bravia">おまかせ</a>\n};
1719         $HTML_HEADER .= qq {<a href="rectool.pl?mode=expert">玄人仕様</a>\n};
1720         $HTML_HEADER .= qq {<a href="rectool.pl?mode=proc">復旧支援</a>\n};
1721         $HTML_HEADER .= qq {<a href="rectool.pl?mode=jbk">地引</a>\n};
1722         $HTML_HEADER .= qq {<a href="rectool.pl?mode=log">録画履歴</a>\n};
1723         $HTML_HEADER .= qq {<a href="rectool.pl?mode=recognize">文字認識</a>\n};
1724         $HTML_HEADER .= qq {<a href="rectool.pl?mode=edit">新規予約</a>\n};
1725 #       $HTML_HEADER .= qq {<a href="../rec10web/rec10web.py">新規予約</a>\n};
1726         $HTML_HEADER .= qq {</span>\n};
1727         $HTML_HEADER .= qq {<hr style="clear: both; background-color: grey; height: 4px">\n};
1728         $HTML_HEADER .= qq {</div>\n};
1729 }
1730
1731 sub draw_form {
1732         $chname = $q->param( 'chname' );
1733         $chtxt  = $q->param( 'chtxt' );
1734         $key    = $q->param( 'key' );
1735         if ( $chname ) {
1736                 $ontv = $dbh->selectrow_array("SELECT ontv FROM epg_ch WHERE chname = '$chname' ");
1737         }
1738         if ( $chtxt ) {
1739                 $ontv = $dbh->selectrow_array("SELECT ontv FROM epg_ch WHERE chtxt  = '$chtxt' ");
1740         }
1741
1742         $HTML .= qq {<div style="float: left">\n};
1743         $HTML .= qq {<form method="get" action="rectool.pl">\n};
1744         $HTML .= qq {<div>\n};
1745         $HTML .= qq {<input type="hidden" name="mode" value="program">\n};
1746
1747         # チャンネル指定
1748         &draw_form_channel();
1749
1750         # 日付指定
1751         $HTML .= qq {<select name="date">\n<option value="" selected>無指定</option>\n};
1752         $ary_ref = $dbh->selectcol_arrayref(
1753                 "SELECT DISTINCT SUBSTRING(start, 1, 8) FROM epg_timeline ORDER BY start"
1754         );
1755         $date_sel = $q->param( 'date' );
1756         foreach my $date ( @{ $ary_ref } ) {
1757                 my @date = $date =~ /(.{4})(.{2})(.{2})/;
1758                 $date_prt = "$date[1]/$date[2]";
1759
1760                 if ( $date eq $date_sel ) {
1761                         $HTML .= qq {<option value="$date" selected>$date_prt</option>\n};
1762                 }
1763                 else {
1764                         $HTML .= qq {<option value="$date">$date_prt</option>\n};
1765                 }
1766         }
1767         $HTML .= qq {</select>\n};
1768
1769         # カテゴリ指定
1770         $HTML .= qq {<select name="category">\n<option value="" selected>無指定</option>\n};
1771         $category_sel = $q->param( 'category' );
1772         foreach my $category ( keys %category ) {
1773                 if ( $category eq $category_sel ) {
1774                         $HTML .= qq {<option value="$category" selected>$category{$category}</option>\n};
1775                 }
1776                 else {
1777                         $HTML .= qq {<option value="$category">$category{$category}</option>\n};
1778                 }
1779         }
1780         $HTML .= qq {</select>\n};
1781
1782         # キーワード指定
1783         $HTML .= qq {<input name="key" type="text" value="$key" style="width:200px" accesskey="s">\n};
1784
1785         # フォーム描画
1786         $HTML .= qq {<input type="submit" value="更新" accesskey="r">\n</div>\n</form>\n};
1787 }
1788
1789 sub draw_form_channel {
1790         $HTML .= qq {<select name="chtxt">\n};
1791         $HTML .= qq {<option value="" selected>無指定</option>\n} if ( shift ne 'nonone' );
1792         $ary_ref = $dbh->selectall_arrayref(
1793                 "SELECT chtxt, chname FROM epg_ch"
1794         );
1795         foreach my $line ( @{$ary_ref} ) {
1796                 if ( $line->[0] eq $chtxt || $line->[1] eq $chname ) {
1797                         $HTML .= qq {<option value="$line->[0]" selected>$line->[1]</option>\n};
1798                 }
1799                 else {
1800                         $HTML .= qq {<option value="$line->[0]">$line->[1]</option>\n};
1801                 }
1802         }
1803         $HTML .= qq {</select>\n};
1804 }
1805
1806 sub draw_form_opt {
1807         my $shift = shift;
1808         my ( %selected, %checked );
1809
1810         if ( $chtxt  =~ /\Qbs-nhk-hi\E/ ) {
1811                 $selected{F} = 'selected';
1812         }
1813         elsif ( $chtxt  =~ /movieplus|nihoneiga|kidshd/ ) {
1814                 $selected{H} = 'selected';
1815         }
1816         elsif ( $chtxt =~ /bs-nhk/ || $bctype =~ /cs/ ) {
1817                 $selected{W} = 'selected';
1818         }
1819         elsif ( $bctype =~ /bs|te/ ) {
1820                 $selected{H} = 'selected';
1821         }
1822         $selected{g} = 'selected';
1823         $selected{s} = 'selected';
1824         $checked{a} = $chtxt =~ /animax|atx|disney|kids/ || $category =~ /アニメ/ ? 'checked' : '';
1825         $checked{l} = '';
1826         $checked{d} = $title =~ /\Q[二]\E|［二］|\Q(二)\E|（二）/ ? 'checked' : '';
1827         $checked{5} = $title =~ /5\.1|5．1/ ? 'checked' : '';
1828         $checked{2} = 'checked';
1829
1830         if ( $opt ) {
1831                 undef %checked;
1832                 undef %selected;
1833                 my @opt = split //, $opt;
1834                 foreach my $opt ( @opt ) {
1835                         $selected{$opt} = 'selected' if ( $opt =~ /S|L|G|H|F/ );
1836                         $checked {$opt} = 'checked'  if ( $opt =~ /a|h|l|d|2|5/ );
1837                 }
1838                 $checked{d} = $title =~ /\Q[二]\E|［二］|\Q(二)\E|（二）/ ? 'checked' : '';
1839                 $checked{5} = $title =~ /5\.1|5．1/ ? 'checked' : '';
1840         }
1841
1842         $HTML .= qq {<select name="opt">\n};
1843         $HTML .= qq {<option value="S" $selected{S}>S 720x480</option>\n};
1844         $HTML .= qq {<option value="W" $selected{W}>W 854x480</option>\n};
1845         $HTML .= qq {<option value="H" $selected{H}>H 1280x720</option>\n};
1846         $HTML .= qq {<option value="F" $selected{F}>F 1920x1080</option>\n};
1847         $HTML .= qq {<option value="I" $selected{I}>I インタレ保持</option>\n};
1848         $HTML .= qq {</select>\n};
1849
1850         $HTML .= qq {<select name="opt">\n};
1851         $HTML .= qq {<option value="u" $selected{u}>最低</option>\n};
1852         $HTML .= qq {<option value="i" $selected{i}>低</option>\n};
1853         $HTML .= qq {<option value=""  $selected{g}>画質</option>\n};
1854         $HTML .= qq {<option value="o" $selected{o}>高</option>\n};
1855         $HTML .= qq {<option value="p" $selected{p}>最高</option>\n};
1856         $HTML .= qq {</select>\n};
1857
1858         $HTML .= qq {<select name="opt">\n};
1859         $HTML .= qq {<option value="q" $selected{q}>最低</option>\n};
1860         $HTML .= qq {<option value="w" $selected{w}>低</option>\n};
1861         $HTML .= qq {<option value=""  $selected{s}>圧縮率</option>\n};
1862         $HTML .= qq {<option value="e" $selected{e}>高</option>\n};
1863         $HTML .= qq {<option value="r" $selected{r}>最高</option>\n};
1864         $HTML .= qq {</select>\n};
1865
1866         $HTML .= qq {<select name="opt">\n};
1867         $HTML .= qq {<option value=""  $selected{s}>コンテナ</option>\n};
1868         $HTML .= qq {<option value="m" $selected{e}>MKV</option>\n};
1869         $HTML .= qq {<option value="4" $selected{r}>MP4</option>\n};
1870         $HTML .= qq {</select>\n};
1871
1872         $HTML .= qq {<input type="checkbox" name="opt" value="a" $checked{a}>24fps(主にアニメ)\n};
1873         $HTML .= qq {<input type="checkbox" name="opt" value="d" $checked{d}>二ヶ国語放送\n};
1874 #       $HTML .= qq {<input type="checkbox" name="opt" value="2" $checked{2}>2passモード\n};
1875         $HTML .= qq {<input type="checkbox" name="opt" value="5" $checked{5}>5.1ch放送\n};
1876         $HTML .= qq {<br>\n};
1877         $HTML .= qq {<select name="opt">\n};
1878         $HTML .= qq {<option value="">移動なし</option>\n};
1879         $HTML .= qq {<option value="R">録画後移動</option>\n};
1880         $HTML .= qq {<option value="D">解読後移動</option>\n};
1881         $HTML .= qq {<option value="E">縁故後移動</option>\n};
1882         $HTML .= qq {</select>\n};
1883         $HTML .= qq {<input type="checkbox" name="opt"   value="N">ファイル名日時追加\n} if ( $shift eq 'reserve' );
1884         $HTML .= qq {<input type="checkbox" name="every" value="1">隔週録画\n}           if ( $shift eq 'reserve' );
1885 }
1886
1887 sub parse_program {
1888         $chname  = $q->param( 'chname' );
1889         $chtxt   = $q->param( 'chtxt' );
1890         $start   = $q->param( 'start' );
1891         $stop    = $q->param( 'stop' );
1892         $bayesid = $q->param( 'bayesid' );
1893         $id      = $q->param( 'id' );
1894
1895         if ( $chname ) {
1896                 $ontv     = $dbh->selectrow_array("SELECT ontv   FROM epg_ch WHERE chname = '$chname'");
1897                 $chtxt    = $dbh->selectrow_array("SELECT chtxt  FROM epg_ch WHERE ontv   = '$ontv'");
1898         }
1899         elsif ( $chtxt ) {
1900                 $ontv     = $dbh->selectrow_array("SELECT ontv   FROM epg_ch WHERE chtxt  = '$chtxt'");
1901                 $chname   = $dbh->selectrow_array("SELECT chname FROM epg_ch WHERE ontv   = '$ontv'");
1902         }
1903         $title    = $dbh->selectrow_array("SELECT title    FROM epg_timeline WHERE channel = '$ontv' AND start = '$start' AND stop = '$stop' ");
1904         $desc     = $dbh->selectrow_array("SELECT exp      FROM epg_timeline WHERE channel = '$ontv' AND start = '$start' AND stop = '$stop' ");
1905         $longdesc = $dbh->selectrow_array("SELECT longexp  FROM epg_timeline WHERE channel = '$ontv' AND start = '$start' AND stop = '$stop' ");
1906         $category = $dbh->selectrow_array("SELECT category FROM epg_timeline WHERE channel = '$ontv' AND start = '$start' AND stop = '$stop' ");
1907         $bctype   = $dbh->selectrow_array("SELECT bctype   FROM epg_ch       WHERE ontv    = '$ontv'");
1908
1909         if ( $bayesid ) {
1910                 ( $chtxt, $title, $begin, $end ) = $dbh->selectrow_array(
1911                         "SELECT chtxt, title, btime, etime FROM auto_timeline_bayes WHERE id = '$bayesid' "
1912                 );
1913                 ( $ontv, $chname, $bctype ) = $dbh->selectrow_array(
1914                         "SELECT ontv, chname, bctype FROM epg_ch WHERE chtxt = '$chtxt' "
1915                 );
1916                 $start = str2datetime( $begin )->strftime( '%Y%m%d%H%M%S' );
1917                 $stop  = str2datetime( $end   )->strftime( '%Y%m%d%H%M%S' );
1918                 ( $desc, $longdesc, $category ) = $dbh->selectrow_array(
1919                         "SELECT exp, longexp, category FROM epg_timeline WHERE channel = '$ontv' AND start = '$start' AND stop = '$stop' "
1920                 );
1921         }
1922         if ( $id ) {
1923                 ( $type, $chtxt, $title, $begin, $end, $deltaday, $deltatime, $opt, $counter ) = $dbh->selectrow_array(
1924                         "SELECT type, chtxt, title, btime, etime, deltaday, deltatime, opt, counter
1925                         FROM timeline WHERE id = '$id' "
1926                 );
1927                 ( $ontv, $chname, $bctype ) = $dbh->selectrow_array(
1928                         "SELECT ontv, chname, bctype FROM epg_ch WHERE chtxt = '$chtxt' "
1929                 );
1930                 $start = str2datetime( $begin )->strftime( '%Y%m%d%H%M%S' );
1931                 $stop  = str2datetime( $end   )->strftime( '%Y%m%d%H%M%S' );
1932                 ( $desc, $longdesc, $category ) = $dbh->selectrow_array(
1933                         "SELECT exp, longexp, category FROM epg_timeline WHERE channel = '$ontv' AND start = '$start' AND stop = '$stop' "
1934                 );
1935         }
1936         if ( $bctype =~ /.s/ ) {
1937                 $bctype_sql = '_s%';
1938         }
1939         elsif ( $bctype =~ /te/ ) {
1940                 $bctype_sql = 'te%';
1941         }
1942         @start = $start =~ /(.{4})(.{2})(.{2})(.{2})(.{2})/;
1943         @stop  = $stop  =~ /(.{4})(.{2})(.{2})(.{2})(.{2})/;
1944         $begin = sprintf( '%04d-%02d-%02d %02d:%02d:%02d', @start, '00' );
1945         $end   = sprintf( '%04d-%02d-%02d %02d:%02d:%02d', @stop , '00' );
1946 }
1947
1948 sub check_error {
1949         my $is_error;
1950         my $is_same = $dbh->selectrow_array(
1951                 "SELECT COUNT(*) FROM timeline WHERE chtxt = '$chtxt' AND btime = '$begin' AND etime = '$end'"
1952         );
1953         my @overlap = &get_overlap();
1954
1955         if ( $is_same ) {
1956                 $HTML .= "同一の番組が既に存在します。<br>\n";
1957                 $is_error = 1;
1958         }
1959         elsif ( $overlap[0] >= 2 ) {
1960                 $HTML .= "時間が被る番組が既に2個存在します。<br>\n";
1961                 $HTML .= $overlap[1];
1962                 $is_error = 2;
1963         }
1964         else {
1965                 $is_error = 0;
1966         }
1967         return $is_error;
1968 }
1969
1970 sub get_overlap {
1971         require List::Util;
1972
1973         my $ary_ref = $dbh->selectall_arrayref(
1974                 "SELECT btime, etime, title
1975                 FROM timeline
1976                 INNER JOIN epg_ch ON timeline.chtxt = epg_ch.chtxt
1977                 WHERE bctype LIKE '$bctype_sql' AND type IN $type_user_made
1978                 AND btime < '$end'
1979                 AND etime > '$begin'
1980                 "
1981         );
1982
1983         my %overlap;
1984         my $overlap = $max = 0;
1985         my $str;
1986         foreach my $prg ( @{ $ary_ref } ) {
1987                 $str .= "$prg->[0] ? $prg->[1] : $prg->[2]<br>\n";
1988                 $overlap{$prg->[0]} += 1;
1989                 $overlap{$prg->[1]} -= 1;
1990         }
1991         foreach my $key ( sort keys %overlap ) {
1992                 $overlap += $overlap{$key};
1993                 $max = List::Util::max( $max, $overlap );
1994         }
1995         if ( wantarray ) {
1996                 return ( $max, $str );
1997         }
1998         else {
1999                 return $max;
2000         }
2001 }
2002
2003 sub get_file_list_wrapper {
2004         local $base_dir = shift;
2005         local $ptr = shift;
2006
2007         &get_file_list( $base_dir );
2008 }
2009
2010 sub get_file_list{
2011         my $dir = shift;
2012
2013         opendir ( DIR, $dir );
2014         my @list = sort readdir( DIR );
2015         closedir( DIR );
2016
2017         foreach my $file ( @list ) {
2018                 next if ( $file =~ /^\.{1,2}$/ );
2019                 if ( -d "$dir/$file" ){
2020                         &get_file_list("$dir/$file");
2021                 }
2022                 else{
2023                         $abs = "$dir/$file";
2024                         ( $rel ) = $abs =~ /^$base_dir\/(.*)$/;
2025                         $ptr->( $rel, $abs );
2026                 }
2027         }
2028 }
2029
2030 sub strisjoined {
2031         my $str = shift;
2032
2033         return $str =~ /.{4}-.{2}-.{2} .{2}:.{2}:.{2}/ ? 0 : 1;
2034 }
2035
2036 sub str2datetime {
2037         my $str    = shift;
2038         my @time;
2039
2040         if ( strisjoined( $str ) ) {
2041                 @time = $str =~ /(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/;
2042         }
2043         else {
2044                 @time = $str =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/;
2045         }
2046         return DateTime->new(
2047                 year   => $time[0], month     => $time[1], day    => $time[2],
2048                 hour   => $time[3], minute    => $time[4], second => $time[5],
2049                 locale => 'ja_JP' , time_zone => $tz
2050         );
2051 }
2052
2053 sub str2dayname {
2054         my  $str = shift;
2055         our %day_name_cache;
2056
2057         if ( !$day_name_cache{$str} ) {
2058                 $day_name_cache{$str} = str2datetime( $str )->day_name;
2059         }
2060         return $day_name_cache{$str};
2061 }
2062
2063 sub str2readable {
2064         my $begin = shift;
2065         my $end   = shift;
2066
2067         my $dt_begin = ref( $begin ) eq 'DateTime' ? $begin : &str2datetime( $begin );
2068         my $dt_end   = ref( $end   ) eq 'DateTime' ? $end   : &str2datetime( $end );
2069
2070         my $str_begin = $dt_begin->strftime( '%m/%d(%a) %H:%M' );
2071         my $str_end   = $dt_end  ->strftime( $dt_begin->day == $dt_end->day ? '%H:%M' : '翌 %H:%M' );
2072         utf8::encode( $str_begin );
2073
2074         my ( $sec, $min, $hour );
2075         $sec  = $dt_end->epoch - $dt_begin->epoch;
2076         $min  = int( $sec / 60 );
2077         $sec  = $sec - $min * 60;
2078         $hour = int( $min / 60 );
2079         $min  = $min - $hour * 60;
2080         my $str_diff = '';
2081         $str_diff .= $hour . '時間' if ( $hour );
2082         $str_diff .= $min  . '分'   if ( $min );
2083         $str_diff .= $sec  . '秒'   if ( $sec );
2084
2085         return ( $str_begin, $str_end, $str_diff );
2086 }
2087
2088 sub sqlgetsuggested {
2089         require Encode;
2090         require Text::Ngram;
2091
2092         my ( $btime, $etime ) = @_;
2093         $deltatime = 3 if ( !$deltatime );
2094
2095         $btime_bgn = $btime->clone->subtract( hours => $deltatime )->strftime( '%Y%m%d%H%M%S' );
2096         $btime_end = $btime->clone->add(      hours => $deltatime )->strftime( '%Y%m%d%H%M%S' );
2097         $etime_bgn = $etime->clone->subtract( hours => $deltatime )->strftime( '%Y%m%d%H%M%S' );
2098         $etime_end = $etime->clone->add(      hours => $deltatime )->strftime( '%Y%m%d%H%M%S' );
2099
2100         my $ontv = $dbh->selectrow_array( "SELECT ontv FROM epg_ch WHERE chtxt = '$chtxt' " );
2101         $ary_ref = $dbh->selectall_arrayref(
2102                 "SELECT start, stop, title, exp
2103                 FROM epg_timeline
2104                 WHERE channel = '$ontv'
2105                 AND start BETWEEN '$btime_bgn' AND '$btime_end'
2106                 AND stop  BETWEEN '$etime_bgn' AND '$etime_end' "
2107         );
2108
2109         my %hash;
2110         my $hash_r = Text::Ngram::ngram_counts( Encode::decode_utf8( $title ), 2 ); # bi-gram
2111         foreach my $program ( @{$ary_ref} ) {
2112                 my $hash_k = Text::Ngram::ngram_counts( Encode::decode_utf8( $program->[2] ), 2 );
2113                 my $point;
2114                 map $point += $hash_k->{$_}, keys %{$hash_r};
2115                 push @{$hash{$point}}, $program if ( $point );
2116         }
2117
2118         return %hash;
2119 }