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 DBI;
  13 use Date::Simple;
  14 use DateTime;
  15 use CGI::Minimal;
  16 use MIME::Base64;
  17 use Config::Simple;
  18 use Time::HiRes;
  19 use Data::Dumper;
  20 #require SVG Time::Simple Encode Text::Ngram File::Find Data::Dumper Perl6::Slurp List::Util
  21 #use utf8;
  22 %DB::packages = ( 'main' => 1 );
  23 my $tz = DateTime::TimeZone->new( name => 'local' );
  24 my $hires = Time::HiRes::time();
  25
  26 my $cfg = new Config::Simple;
  27 if ( -e '/etc/rec10.conf' ) {
  28         $cfg->read( '/etc/rec10.conf' );
  29 }
  30 else {
  31         $cfg->read( 'config.ini' );
  32 }
  33
  34 my $sql = $cfg->param( 'db.db' );
  35
  36 if ( $sql eq 'MySQL' ) {
  37         my $name = $cfg->param( 'db.mysql_dbname' );
  38         my $host = $cfg->param( 'db.mysql_host' );
  39         my $port = $cfg->param( 'db.mysql_port' );
  40         my $user = $cfg->param( 'db.mysql_user' );
  41         my $pass = $cfg->param( 'db.mysql_passwd' );
  42         $dbh = DBI->connect("dbi:mysql:$name:$host:$port", $user, $pass, {
  43                 AutoCommit => 1,
  44                 RaiseError => 1,
  45         });
  46         $dbh->do( 'SET NAMES utf8' );
  47 }
  48
  49 my $HTML;
  50
  51 #print "Content-Type: text/html\n\n";
  52
  53 $HTTP_HEADER = "Content-Type: text/html\n\n";
  54 $HTML .= <<EOM;
  55 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
  56 <html lang="ja">
  57 <head>
  58 <title>Rec10%HTML_TITLE_OPT%</title>
  59 <meta http-equiv="Content-Script-Type" content="text/javascript">
  60 <meta http-equiv="Content-Style-Type" content="text/css">
  61 <meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
  62 <link rev="MADE" href="Rea10">
  63 %REFRESH%
  64 %SCRIPT%
  65 %CSS%
  66 </head>
  67 <body>
  68 %HTML_HEADER%
  69 EOM
  70
  71
  72 $q = new CGI::Minimal;
  73 $mode = $q->param( 'mode' );
  74 $mode_sub = $q->param( 'mode_sub' );
  75
  76 %type = (
  77         'search_everyday'         => '隔日検索',
  78         'search_today'            => '当日検索',
  79         'reserve_flexible'        => '浮動予約',
  80         'reserve_fixed'           => '確定予約',
  81
  82         'reserve_running'         => '録画途中',
  83
  84         'convert_b25_ts'          => '解読予約',
  85         'convert_b25_ts_running'  => '解読途中',
  86         'convert_b25_ts_miss'     => '解読失敗',
  87
  88         'convert_ts_mp4'          => '縁故予約',
  89         'convert_ts_mp4_running'  => '縁故於鯖',
  90         'convert_ts_mp4_network'  => '縁故於網',
  91         'convert_ts_mp4_finished' => '縁故完了',
  92
  93         'convert_avi_mkv'         => '変換旧露',
  94         'convert_avi_mp4'         => '変換旧四',
  95         'convert_mkv_mp4'         => '変換露四',
  96
  97         'auto_suggest_dec'        => '予測解読',
  98         'auto_suggest_enc'        => '予測縁故',
  99         'auto_suggest_a24'        => '予測旧四',
 100         'auto_suggest_m24'        => '予測露四',
 101
 102         'move_end'                => '移動完了',
 103 );
 104
 105 %type_suggest = (
 106         'auto_suggest_dec' => 'convert_b25_ts',
 107         'auto_suggest_enc' => 'convert_ts_mp4',
 108         'auto_suggest_a24' => 'convert_avi_mp4',
 109         'auto_suggest_m24' => 'convert_mkv_mp4',
 110 );
 111
 112 $type_user_made = "( 'search_everyday', 'search_today', 'reserve_flexible', 'reserve_fixed', 'reserve_running' )";
 113
 114 %category = (
 115         'etc'         => 'その他',
 116         'news'        => 'ニュース・報道',
 117         'variety'     => 'バラエティ',
 118         'anime'       => 'アニメ・特撮',
 119         'information' => '情報',
 120         'drama'       => 'ドラマ',
 121         'sports'      => 'スポーツ',
 122         'music'       => '音楽',
 123         'cinema'      => '映画',
 124 );
 125
 126 if ( $mode eq 'schedule' ) {
 127
 128         $HTML =~ s/%HTML_TITLE_OPT%/ - Schedule Viewer/;
 129 #       $HTML =~ s|%REFRESH%|<meta http-equiv="refresh" content="300">|;
 130         $css = <<EOM;
 131                 <style type="text/css">
 132                 td {
 133                         white-space: nowrap;
 134                 }
 135                 </style>
 136 EOM
 137         $css =~ s/^\t{2}//gm;
 138         $HTML =~ s/%CSS%/$css/;
 139
 140         my $order = $q->param( 'order' );
 141         my $extra = $q->param( 'extra' );
 142         if ( $order ne 'id' ) {
 143                 $order = 'btime';
 144         }
 145         $reverse_extra = $extra            ? '' : '&amp;extra=1';
 146         $forward_order = $order eq 'btime' ? '' : '&amp;order=id';
 147
 148         my $ary_ref = $dbh->selectall_arrayref(
 149                 "SELECT id, type, epg_ch.chtxt, epg_ch.ontv, epg_ch.chname, title, btime, etime, opt, deltaday, deltatime
 150                 FROM timeline
 151                 INNER JOIN epg_ch ON timeline.chtxt = epg_ch.chtxt
 152                 ORDER BY $order");
 153
 154         $HTML .= qq {<div style="font-size: 10pt; float: left">\n};
 155         $HTML .= qq {<form method="get" action="rectool.pl">\n};
 156         $HTML .= qq {<div>\n};
 157         $HTML .= qq {<input type="hidden" name="mode" value="change">\n};
 158         $HTML .= qq {<table summary="rectimetable" border=1 cellspacing=0>\n<tr>\n};
 159         $HTML .= qq {<th><a href="rectool.pl?mode=schedule$forward_order$reverse_extra">■</a></th>\n};
 160         $HTML .= qq {<th><a href="rectool.pl?mode=schedule&amp;order=id">ID</a></th>\n};
 161         $HTML .= qq {<th>タイプ</th>\n};
 162         $HTML .= qq {<th>チャンネル</th>\n};
 163         $HTML .= qq {<th>タイトル</th>\n};
 164         $HTML .= qq {<th><a href="rectool.pl?mode=schedule">開始時刻</a></th>\n};
 165         $HTML .= qq {<th>終了時刻</th>\n};
 166         $HTML .= qq {<th>録画時間</th>\n};
 167         $HTML .= qq {<th>オプション</th>\n};
 168         $HTML .= qq {<th>dd</th>\n};
 169         $HTML .= qq {<th>dt</th>\n};
 170         $HTML .= qq {</tr>\n};
 171         foreach my $line ( @{ $ary_ref } ) {
 172
 173                 $type = $type{$line->[1]} || $line->[1];
 174                 if    ( $line->[1] =~ /^search/ ) {
 175                         $type = qq {<span style="color: #800080">$type</span>};
 176                         $line->[9]  = qq {<span style="color: #FF0000">空</span>} if ( !$line->[9] && $line->[1] eq 'search_everyday' );
 177                         $line->[10] = qq {<span style="color: #FF0000">空</span>} if ( !$line->[10] );
 178                 }
 179                 elsif ( $line->[1] eq 'reserve_running' ) {
 180                         $type = qq {<span style="color: #FFA000">$type</span>};
 181                 }
 182                 elsif ( $line->[1] =~ /^reserve/ ) {
 183                         $type = qq {<span style="color: #A0A000">$type</span>};
 184                 }
 185                 elsif ( $line->[1] eq 'convert_b25_ts' || $line->[1] eq 'convert_b25_ts' ) {
 186                         $type = qq {<span style="color: #404040">$type</span>};
 187                 }
 188                 elsif ( $line->[1] eq 'convert_b25_ts_running' ) {
 189                         $type = qq {<span style="color: #C04040">$type</span>};
 190                 }
 191                 elsif ( $line->[1] eq 'convert_ts_mp4_running' ) {
 192                         $type = qq {<span style="color: #008080">$type</span>};
 193                 }
 194                 else {
 195                         $type = qq {<span style="color: #A0A0A0">$type</span>};
 196                 }
 197                 $chname_encoded = $q->url_encode( $line->[4] );
 198                 $line->[5] = 'タイトルなし' if ( !$line->[5] );
 199                 my $unix_6 = str2datetime( $line->[6] );
 200                 my $unix_7 = str2datetime( $line->[7] );
 201
 202                 my $btime = $unix_6->strftime( '%Y%m%d%H%M%S' );
 203                 my $etime = $unix_7->strftime( '%Y%m%d%H%M%S' );
 204                 if ( $extra and $line->[1] =~ /^search_|^reserve_/ ) {
 205                         my @ary = $dbh->selectrow_array(
 206                                 "SELECT title, exp FROM epg_timeline
 207                                 WHERE channel = '$line->[3]'
 208                                 AND start = '$btime'
 209                                 AND stop  = '$etime' ");
 210
 211                         if ( $ary[0] ) {
 212                                 $ary[0] =~ s/無料≫//;
 213
 214                                 if ( $ary[0] ne $line->[5] ) {
 215                                         my $count = $ary[0] =~ s/\Q$line->[5]\E//;
 216                                         if ( !$count ) {
 217                                                 $ary[0] = qq {<span style="color: #FF4000">$ary[0]</span>};
 218                                         }
 219                                 }
 220                                 else {
 221                                         $ary[0] = '説明';
 222                                 }
 223
 224                                 if ( $ary[1] ) {
 225                                         $line->[11] = qq {<div style="float: right; cursor: help" title="$ary[1]">$ary[0]</div>};
 226                                 }
 227                                 else {
 228                                         $line->[11] = qq {<span style="float: right">説明なし</span>};
 229                                 }
 230                         }
 231                         else {
 232                                 my $href    = qq {<a href="rectool.pl?mode=edit&amp;id=$line->[0]&amp;suggest=auto">自動検索</a>};
 233                                 $line->[11] = qq {<span style="float: right; color: #FF0000">！$href！</span>};
 234                         }
 235                 }
 236
 237                 my $begin = $unix_6->strftime( '%m/%d(%a) %H:%M' );
 238                 utf8::encode( $begin );
 239                 my $end;
 240                 if ( $unix_6->month == $unix_7->month && $unix_6->day == $unix_7->day )
 241                 {
 242                         $end   = $unix_7->strftime( '%H:%M' );
 243                 }
 244                 else {
 245                         $end   = $unix_7->strftime( '翌 %H:%M' );
 246                 }
 247
 248                 my ( $sec, $min, $hour );
 249                 $sec  = $unix_7->epoch - $unix_6->epoch;
 250                 $min  = int( $sec / 60 );
 251                 $sec  = $sec - $min * 60;
 252                 $hour = int( $min / 60 );
 253                 $min  = $min - $hour * 60;
 254                 my $diff = '';
 255                 $diff .= $hour . '時間' if ( $hour );
 256                 $diff .= $min  . '分'   if ( $min );
 257                 $diff .= $sec  . '秒'   if ( $sec );
 258
 259                 my $hr;
 260                 if (
 261                         $line->[1] eq 'reserve_running'
 262                                 &&
 263                         $unix_6->epoch <= time && time <= $unix_7->epoch
 264                 )
 265                 {
 266                         $percent = int( ( 100 * ( time - $unix_6->epoch ) ) / ( $unix_7->epoch - $unix_6->epoch ) );
 267                         $hr .= qq {<hr style="margin: 0 auto 0 0; height: 4px; width: $percent%;};
 268                         $hr .= qq { background-color: blue; border: none" title="$percent%">};
 269                 }
 270
 271                 $line->[5] = qq {<div style="float: left">$line->[5]</div>} if ( $line->[11] );
 272                 $line->[5] = qq {<a href="rectool.pl?mode=edit&amp;id=$line->[0]">$line->[5]</a>};
 273                 $HTML .= qq {<tr align="center">\n};
 274                 $HTML .= qq {<td><input type="checkbox" name="id" value="$line->[0]"></td>\n};
 275                 $HTML .= qq {<td>$line->[0]</td>\n};
 276                 $HTML .= qq {<td>$type</td>\n};
 277                 $HTML .= qq {<td><a href="rectool.pl?mode=program&amp;chname=$chname_encoded">$line->[2]</a></td>\n};
 278                 $HTML .= qq {<td align="left" style="white-space: normal">$line->[5]$line->[11]</td>\n};
 279                 $HTML .= qq {<td>$begin</td>\n<td>$end</td>\n};
 280                 $HTML .= qq {<td>$hr$diff</td>\n};
 281                 $HTML .= qq {<td>$line->[8]</td>\n<td>$line->[9]</td>\n<td>$line->[10]</td>\n};
 282                 $HTML .= qq {</tr>\n};
 283         }
 284         $HTML .= qq {</table>\n};
 285         $HTML .= qq {<input type="submit" name="edit" value="編集(要JS)">\n};
 286         $HTML .= qq {<input type="submit" name="delete" value="削除">\n</div>\n</form>\n};
 287         goto end;
 288 }
 289
 290 if ( $mode eq 'graph' ) {
 291
 292         $graph = $q->param( 'graph' );
 293
 294         if ( $graph )
 295         {
 296                 print "Content-Type: image/svg+xml\n\n";
 297
 298                 require SVG;
 299                 $graph = Date::Simple->new( split /-/, $graph );
 300                 $graph_bgn = $graph->format('%Y-%m-%d');
 301                 $graph_end = $graph->next->format('%Y-%m-%d');
 302                 $day = $graph->day;
 303                 $today = $graph eq Date::Simple->today() ? 1 : 0;
 304
 305                 $tuner{terrestrial} = 2; #$cfg->param( 'env.te_max' );
 306                 $tuner{satellite}   = 4; #$cfg->param( 'env.bscs_max' );
 307                 $tuner{all} = $tuner{terrestrial} + $tuner{satellite};
 308                 $hours = 24;
 309                 $width = 30 * $hours;
 310
 311                 $svg = new SVG( width => 820, height => $tuner{all} * 20 + 40 );
 312                 $svg->rectangle( 'x' => 40, 'y' => 20,
 313                         width => $width + 20, height => $tuner{all} * 20 + 10,
 314                         rx => 15, ry => 15,
 315                         style => { stroke => 'blue', fill => 'white' } );
 316                 for ( 1..$tuner{terrestrial} ) {
 317                         $svg->text( 'x' => 10, 'y' => ( $_ + 1 ) * 20 )
 318                                 ->cdata( "T$_" );
 319                 }
 320                 for ( 1..$tuner{satellite} ) {
 321                         $svg->text( 'x' => 10, 'y' => ( $_ + $tuner{terrestrial} + 1 ) * 20 )
 322                                 ->cdata( "S$_" );
 323                 }
 324                 for ( 0..$hours ) {
 325                         $svg->text( 'x' => $_ * 30 + 65, 'y' => 15,
 326                                 style => { 'text-anchor' => 'middle' } )
 327                                 ->cdata( sprintf( '%02d', $_ ) ) if ( $_ < $hours );
 328                         # $svg->line( ); # can't use when required
 329                         $svg->tag( 'line', x1 => $_ * 30 + 50, x2 => $_ * 30 + 50, y1 => 30, y2 => $tuner{all} * 20 + 20,
 330                                 style => { stroke => 'gray' } );
 331                 }
 332                 for ( 1..$tuner{all} ) {
 333                         $svg->rectangle( 'x' => 50, 'y' => $_ * 20 + 10, width => $width, height => 10 );
 334                 }
 335                 if ( $today ) {
 336                         require Time::Simple;
 337                         my $time = Time::Simple->new();
 338                         my $x = ( $time->hours * 60 + $time->minutes ) * 0.5 + 50;
 339                         $svg->tag( 'line', x1 => $x, x2 => $x, y1 => 30, y2 => $tuner{all} * 20 + 20,
 340                                 style => { stroke => 'red', 'fill-opacity' => '1.0' } );
 341                 }
 342                 foreach my $bctype ( 'te%', '_s%' ) {
 343                         my $tuner = $bctype eq 'te%' ? $tuner{terrestrial} : $tuner{satellite};
 344                         my $ary_ref = $dbh->selectall_arrayref(
 345                                 "SELECT id, type, timeline.chtxt, title, btime, etime, opt FROM timeline
 346                                 INNER JOIN epg_ch ON timeline.chtxt = epg_ch.chtxt
 347                                 WHERE epg_ch.bctype LIKE '$bctype'
 348                                 AND type IN $type_user_made
 349                                 AND
 350                                 (
 351                                         '$graph_bgn 00:00' <= btime AND btime <  '$graph_end 00:00'
 352                                                 OR
 353                                         '$graph_bgn 00:00' <  etime AND etime <= '$graph_end 00:00'
 354                                 )
 355                                 ORDER BY id"
 356                         );
 357                         foreach my $line ( @{ $ary_ref } ) {
 358                                 @start = $line->[4] =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2})/;
 359                                 @stop  = $line->[5] =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2})/;
 360                                 $start = ( ( $day == $start[2] ? 0 : 24 * 60 ) + $start[3] * 60 + $start[4] ) * 0.5;
 361                                 $stop  = ( ( $day == $stop [2] ? 0 : 24 * 60 ) + $stop [3] * 60 + $stop [4] ) * 0.5;
 362                                 $start = 0      if ( $start < 0 || $day > $start[2] ); # 月の変わり目はスルー
 363                                 $stop  = $width if ( $stop  > $width );
 364                                 $begin = $line->[4];
 365                                 $end   = $line->[5];
 366
 367                                 my $ary = $dbh->selectall_arrayref(
 368                                         "SELECT id, type, timeline.chtxt, title, btime, etime, opt FROM timeline
 369                                         INNER JOIN epg_ch ON timeline.chtxt = epg_ch.chtxt
 370                                         WHERE epg_ch.bctype LIKE '$bctype'
 371                                         AND type IN $type_user_made
 372                                         AND NOT
 373                                         (
 374                                                 ( etime <= '$begin' )
 375                                                         OR
 376                                                 ( btime >= '$end'   )
 377                                         )
 378                                         ORDER BY id"
 379                                 );
 380                                 my @ary = @{$ary};
 381                                 for ( 0..$tuner - 1 ) {
 382                                         $f = 1;
 383                                         $i = $_;
 384                                         for ( 0..4 ) {
 385                                                 $f = 0 if ( $line->[$_] ne $ary[$i]->[$_] );
 386                                         }
 387                                         if ( $f ) {
 388                                                 $slot = $i;
 389                                         }
 390                                 }
 391                                 my ( $r, $g, $b ) = ( 0, 0, 0 );
 392                                 $r += 255 if ( $line->[6] =~ /a/ );
 393                                 $g += 255 if ( $line->[6] =~ /H/ );
 394                                 $b += 255 if ( $line->[6] =~ /2/ );
 395                                 if ( $r + $g + $b == 255 * 3 ){
 396                                         $r = 0;
 397                                         $g = 255;
 398                                         $b = 255;
 399                                 }
 400                                 if ( $r + $g + $b == 0 ){
 401                                         $r = $g = $b = 128;
 402                                 }
 403                                 my %escaped = ( '&' => 'amp', '<' => 'lt', '>' => 'gt', '"' => 'quot' );
 404                                 sub html_escape{
 405                                     my $str = shift or return;
 406                                     my $result = '';
 407                                     $result .= $escaped{$_} ? '&' . $escaped{$_} . ';' : $_
 408                                         for (split //, $str);
 409                                     $result;
 410                                 }
 411                                 $svg->anchor(
 412                                         -href  => "rectool.pl?mode=edit&amp;id=$line->[0]",
 413                                         target => '_blank',
 414                                         -title => html_escape( $line->[3] ),
 415                                 )->rectangle(
 416                                         'x' => 50 + $start,
 417                                         'y' => 30 + ( $bctype eq 'te%' ? 0 : $tuner{terrestrial} * 20 ) + $slot * 20,
 418                                         width  => $stop - $start,
 419                                         height => 10,
 420                                         style  => { fill => "rgb($r,$g,$b)" } );
 421                         }
 422                 }
 423                 print $svg->xmlify;
 424                 exit;
 425         }
 426         else
 427         {
 428                 $HTML =~ s/%HTML_TITLE_OPT%/ - Schedule Viewer - Graphical/;
 429                 $HTML .= qq {<div style="float: left">\n};
 430                 # $base64 = encode_base64( $svg->xmlify );
 431                 # $HTML .= qq {<object data="data:image/svg+xml;base64,$base64">\n</object>\n};
 432                 $HTML .= qq {予約状況一覧です。T1,T2は地上波、S1,S2はBS/CS、赤はアニメ、緑はHD、青は2 passを示しています。<br>\n};
 433                 $HTML .= qq {SVGが利用可能なブラウザでご覧ください。<br>\n};
 434
 435                 $ary_ref = $dbh->selectcol_arrayref(
 436                         "SELECT DISTINCT DATE( btime )
 437                         FROM timeline
 438                         WHERE type in $type_user_made
 439                         ORDER BY btime"
 440                 );
 441                 foreach my $date ( @{ $ary_ref } ) {
 442                         my @date = $date =~ /(.{4})-(.{2})-(.{2})/;
 443                         my $dn = DateTime->new( year => $date[0], month => $date[1], day => $date[2], locale => 'ja_JP' )->day_name;
 444                         utf8::encode( $dn );
 445                         $HTML .= qq {$date[1]/$date[2]($dn)の予約状況<br>\n};
 446                         $HTML .= qq {<object type="image/svg+xml" data="rectool.pl?mode=graph&amp;graph=$date" width="820">\n};
 447                         $HTML .= qq {SVG Image $date\n</object>\n<br>\n};
 448
 449                         $date2 = Date::Simple->new( @date )->next->format('%Y-%m-%d');
 450                         my $ary_ref = $dbh->selectall_arrayref(
 451                                 "SELECT chtxt, title, btime, etime FROM timeline
 452                                 WHERE '$date 00:00' <= btime AND etime <= '$date2 01:00'
 453                                 ORDER BY btime"
 454                         );
 455
 456                         foreach my $line ( @{ $ary_ref } ) {
 457 #                               $HTML .= qq {$line->[0] $line->[1] $line->[2] $line->[3]<br>\n};
 458                         }
 459
 460                 }
 461
 462                 goto end;
 463         }
 464 }
 465
 466 if ( $mode eq 'edit' ) {
 467         my $id = $q->param( 'id' );
 468
 469         $HTML =~ s/%HTML_TITLE_OPT%/ - Schedule Editor/;
 470         $HTML .= qq {<div style="float: left">\n};
 471
 472         $script = <<EOM;
 473                 <script type="text/javascript" src="http://www.enjoyxstudy.com/javascript/dateformat/dateformat.js">
 474                 </script>
 475                 <script type="text/javascript">
 476                 function setType(value){
 477                         var index = document.reserve.type.selectedIndex;
 478                         var value = document.reserve.type[index].value;
 479                         if ( value == 'search_everyday' ) {
 480                                 document.reserve.deltaday.value  = 7;
 481                                 document.reserve.deltatime.value = 3;
 482                         }
 483                         if ( value == 'convert_b25_ts' || value == 'convert_ts_mp4' ){
 484                                 var date       = new Date();
 485                                 var dateFormat = new DateFormat("yyyy-MM-dd HH:mm:ss");
 486                                 var minutes    = date.getMinutes();
 487                                 minutes = minutes - minutes % 5 + 10;
 488                                 date.setMinutes(minutes, 0, 0);
 489                                 document.reserve.begin.value = dateFormat.format(date);
 490                                 date.setSeconds( date.getSeconds() + 3600 );
 491                                 document.reserve.end.value   = dateFormat.format(date);
 492                         }
 493                 }
 494                 function setSuggest(start, stop){
 495                         document.reserve.begin.value = start;
 496                         document.reserve.end.value   = stop;
 497                 }
 498                 function shiftEndTime(value){
 499                         var dateFormat = new DateFormat("yyyy-MM-dd HH:mm:ss");
 500                         var date = dateFormat.parse(document.reserve.end.value || document.reserve.begin.value);
 501                         date.setSeconds( date.getSeconds() + value );
 502                         document.reserve.end.value = dateFormat.format(date);
 503                 }
 504                 </script>
 505 EOM
 506         $script =~ s/^\t{2}//gm;
 507         $HTML =~ s/%SCRIPT%/$script/;
 508
 509         $HTML .= "スケジュール編集画面です。<br>\n";
 510         $HTML .= "実装がとても適当なので、利用には細心の注意を払ってください。<br>\n<br>\n";
 511         if ( $id ) {
 512                 &parse_program();
 513                 $button_bgn = $button_end = '';
 514         }
 515         else {
 516                 $type = 'reserve_flexible';
 517                 $datetime_now = DateTime->now( time_zone => $tz )->set_second( 0 )->add( minutes => 1)->strftime( '%Y-%m-%d %H:%M:%S' );
 518                 $button_bgn = qq{<button type="button" onClick="document.reserve.begin.value='$datetime_now'">現在</button>\n<br>\n};
 519                 $button_end =
 520                          qq{<button type="button" onClick="document.reserve.end.value=document.reserve.begin.value">一致</button>}
 521                         .qq{<button type="button" onClick="shiftEndTime(300);">+5m</button>}
 522                         .qq{<button type="button" onClick="shiftEndTime(1800);">+30m</button>};
 523         }
 524
 525         if ( $q->param( 'suggest' ) eq 'auto' ) {
 526                 my @btime = $begin =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/;
 527                 my @etime = $end   =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/;
 528                 my $btime = DateTime->new(
 529                         year => $btime[0], month  => $btime[1], day    => $btime[2],
 530                         hour => $btime[3], minute => $btime[4], second => $btime[5],
 531                 );
 532                 my $etime = DateTime->new(
 533                         year => $etime[0], month  => $etime[1], day    => $etime[2],
 534                         hour => $etime[3], minute => $etime[4], second => $etime[5],
 535                 );
 536                 my %hash = &sqlgetsuggested( $btime, $etime );
 537
 538                 $HTML .= qq {可能性のある番組<br>\n};
 539                 $HTML .= qq {<table summary="suggesttable" border=1 cellspacing=0>\n<tr>\n};
 540                 $HTML .= qq {<th>優先度</th>\n};
 541                 $HTML .= qq {<th>タイトル</th>\n};
 542                 $HTML .= qq {<th>開始時刻</th>\n};
 543                 $HTML .= qq {<th>終了時刻</th>\n};
 544                 $HTML .= qq {<th>説明</th>\n};
 545                 $HTML .= qq {<th>適用</th>\n};
 546                 $HTML .= qq {</tr>\n};
 547
 548                 foreach my $key (sort keys %hash){
 549                         my $val = $hash{$key};
 550                         foreach my $val ( @{$val} ) {
 551                                 my $style = qq {style="white-space: nowrap"};
 552                                 $val->[0] =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/;
 553                                 $val->[1] =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/;
 554                                 $HTML .= qq {<tr>\n<td>$key</td>\n<td>$val->[2]</td>\n};
 555                                 $HTML .= qq {<td $style>$val->[0]</td>\n<td $style>$val->[1]</td>\n<td>$val->[3]</td>\n};
 556                                 $HTML .= qq {<td><button onClick="setSuggest('$val->[0]','$val->[1]');">適用</button></td>\n</tr>\n};
 557                         }
 558                 }
 559                 $HTML .= qq {</table>\n<br>\n};
 560         }
 561
 562         my $len = length $id;
 563         $HTML .= qq {<form method="get" action="rectool.pl" name="reserve">\n};
 564         $HTML .= qq {<input type="hidden" name="mode" value="change">\n};
 565         $HTML .= qq {<input type="hidden" name="mode_sub" value="update">\n};
 566         $HTML .= qq {<input type="hidden" name="id" value="$id">\n};
 567         $HTML .= qq {ID\n<input type="text" name="id" value="$id" size=$len disabled>\n};
 568         $HTML .= qq {タイプ\n<select name="type" onChange="setType();">\n};
 569         while ( my ($key, $value) = each %type ) {
 570                 next if ( $key !~ /^search|^reserve|^convert_b25_ts$|^convert_ts_mp4$|^$type$/ );
 571                 if ( $key eq $type ) {
 572                         $HTML .= qq {<option value="$key" selected>$value</option>\n};
 573                 }
 574                 else {
 575                         $HTML .= qq {<option value="$key">$value</option>\n};
 576                 }
 577         }
 578         $HTML .= qq {</select>\n};
 579         $HTML .= qq {チャンネル\n<select name="chtxt">\n};
 580         $ary_ref = $dbh->selectall_arrayref(
 581                 "SELECT chname, chtxt FROM epg_ch"
 582         );
 583         foreach my $line ( @{$ary_ref} ) {
 584                 if ( $line->[1] eq $chtxt ) {
 585                         $HTML .= qq {<option value="$line->[1]" selected>$line->[0]</option>\n};
 586                 }
 587                 else {
 588                         $HTML .= qq {<option value="$line->[1]">$line->[0]</option>\n};
 589                 }
 590         }
 591         $HTML .= qq {</select><br>\n};
 592         $HTML .= qq {タイトル\n<input type="text" name="title" value="$title" size=64><br>\n};
 593         $HTML .= qq {開始時刻\n<input type="text" name="begin" value="$begin" maxlength=19 size=24>\n};
 594         $HTML .= $button_bgn;
 595         $HTML .= qq {終了時刻\n<input type="text" name="end" value="$end" maxlength=19 size=24>\n};
 596         $HTML .= $button_end . "<br>\n";
 597         $HTML .= qq {隔日周期\n<input type="text" name="deltaday" value="$deltaday" maxlength=2  size=2 >\n};
 598         $HTML .= qq {時刻誤差\n<input type="text" name="deltatime" value="$deltatime" maxlength=2  size=2 >\n};
 599         $HTML .= qq {オプション\n<input type="text" name="opt" value="$opt">\n};
 600         $HTML .= qq {<input type="submit" name="update" value="更新">\n</form>\n};
 601 }
 602
 603 if ( $mode eq 'change' ) {
 604         @id     = $q->param( 'id' );
 605
 606         $HTML =~ s/%HTML_TITLE_OPT%/ - Change/;
 607         $HTML .= qq {<div style="float: left">\n};
 608
 609         if ( $q->param( 'delete' ) )
 610         {
 611                 if ( @id ) {
 612                         foreach my $id ( @id ) {
 613                                 $dbh->do( "DELETE FROM timeline WHERE id = '$id'" );
 614                         }
 615                         $HTML .= "削除しました。<br>\n5秒後に予約確認画面に移動します。<br>\n";
 616                         $HTML =~ s|%REFRESH%|<meta http-equiv="refresh" content="5; url=rectool.pl?mode=schedule">|;
 617                         goto end;
 618                 }
 619         }
 620         if ( $q->param( 'update' ) )
 621         {
 622                 $type      = $q->param( 'type' );
 623                 $chtxt     = $q->param( 'chtxt' );
 624                 $title     = $q->param( 'title' );
 625                 $begin     = $q->param( 'begin' );
 626                 $end       = $q->param( 'end' );
 627                 $deltaday  = $q->param( 'deltaday' );
 628                 $deltatime = $q->param( 'deltatime' );
 629                 $opt       = $q->param( 'opt' );
 630                 $id        = $id[0];
 631                 if ( $id ) {
 632                         $dbh->do(
 633                                 "UPDATE timeline SET type = '$type', chtxt = '$chtxt', title = '$title',
 634                                 btime = '$begin', etime = '$end',
 635                                 deltaday = '$deltaday', deltatime = '$deltatime', opt = '$opt'
 636                                 WHERE id = '$id'"
 637                         );
 638                 }
 639                 else {
 640                         $dbh->do(
 641                                 "INSERT INTO timeline ( type, chtxt, title, btime, etime, deltaday, deltatime, opt )
 642                                 VALUES ( '$type', '$chtxt', '$title', '$begin', '$end', '$deltaday', '$deltatime', '$opt' )"
 643                         );
 644                 }
 645                 $HTML .= "更新しました。<br>\n5秒後に予約確認画面に移動します。<br>\n";
 646                 $HTML =~ s|%REFRESH%|<meta http-equiv="refresh" content="5; url=rectool.pl?mode=schedule">|;
 647                 goto end;
 648         }
 649         if ( $mode_sub eq 'proc' ) {
 650                 my $type  = $q->param( 'type' );
 651                 my $chtxt = $q->param( 'chtxt' ) || 'nhk-k';
 652                 my $title = $q->param( 'title' );
 653                 my @opt   = $q->param( 'opt' );
 654                 my $opt   = join '', @opt;
 655
 656                 my $datetime_now = DateTime->now( time_zone => $tz )->set_second( 0 )->add( minutes => 10);
 657                 my $sql_type = $type_suggest{$type};
 658                 my $begin = $datetime_now->strftime( '%Y-%m-%d %H:%M:%S' );
 659                 $datetime_now = $datetime_now->add( minutes => 60 );
 660                 my $end = $datetime_now->strftime( '%Y-%m-%d %H:%M:%S' );
 661
 662                 $dbh->do(
 663                         "INSERT INTO timeline ( type, chtxt, title, btime, etime, opt )
 664                         VALUES ( '$sql_type', '$chtxt', '$title', '$begin', '$end', '$opt' )"
 665                 );
 666
 667                 goto end;
 668         }
 669         if ( $mode_sub eq 'move' ) {
 670                 my $mode_sub2  = $q->param( 'mode_sub2' );
 671                 my $title      = $q->param( 'title' );
 672                 $title =~ s/＃/#/g;
 673                 $title =~ s/\+/ /g;
 674
 675                 $ENV{'LANG'} = 'ja_JP.UTF-8';
 676                 if ( $mode_sub2 eq 'predict' ) {
 677                         eval '$HTML .= `python26 ' . $cfg->param( 'path.rec10' ) . "classify.py -s '$title'`";
 678                 }
 679                 elsif ( $mode_sub2 eq 'exec' ) {
 680                         eval '$HTML .= `python26 ' . $cfg->param( 'path.rec10' ) . "classify.py -e '$title'`";
 681                 }
 682
 683                 goto end;
 684         }
 685
 686 }
 687
 688 if ( $mode eq 'confirm' ) {
 689         if ( $mode_sub eq 'reserve' ) {
 690                 $HTML =~ s/%HTML_TITLE_OPT%/ - Reserver/;
 691                 $HTML .= qq {<div style="float: left">\n};
 692                 &parse_program();
 693
 694                 my $duration = ( str2datetime( $end ) - str2datetime( $begin ) )->delta_minutes;
 695                 $HTML .= "番組名：$title<br>\nチャンネル：$chname<br>\n放送継続時間：$duration分<br>\n番組内容：$desc<br>\n";
 696                 if ( $longdesc ) {
 697                         $longdesc =~ s/\\n/<br>\n/gs;
 698                         $HTML .= "番組内容(長)：$longdesc<br>\n";
 699                 }
 700                 my $error = &check_error();
 701                 if ( $error )
 702                 {
 703                         # エラー
 704
 705                         $ary_ref = $dbh->selectall_arrayref(
 706                                 "SELECT start, stop FROM epg_timeline WHERE channel = '$ontv' AND title = '$title' "
 707                         );
 708                         if ( $error != 1 ) {
 709                                 $HTML .= "同一の番組の他の放送予定です。<br>\n";
 710                                 foreach my $line ( @{$ary_ref} ) {
 711                                         $begin = $line->[0];
 712                                         $end   = $line->[1];
 713                                         $begin =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/;
 714                                         $end   =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/;
 715                                         $overlap = &get_overlap() >= 2 ? '不可能' :
 716                                                 qq {<a href="rectool.pl?mode=confirm&amp;mode_sub=reserve&amp;chname=$chname&amp;start=$line->[0]&amp;stop=$line->[1]">可能</a>};
 717                                         $HTML .= "開始：$begin\n終了：$end\n録画は$overlap<br>\n";
 718                                 }
 719                         }
 720                 }
 721                 else {
 722                         if ( $chtxt  =~ /\Qbs-nhk-hi\E/ ) {
 723                                 $selected_f = 'selected';
 724                         }
 725                         elsif ( $chtxt  =~ /movieplus/ ) {
 726                                 $selected_h = 'selected';
 727                         }
 728                         elsif ( $chtxt =~ /bs-nhk/ || $bctype =~ /cs/ ) {
 729                                 $selected_l = 'selected';
 730                         }
 731                         elsif ( $bctype =~ /bs|te/ ) {
 732                                 $selected_g = 'selected';
 733                         }
 734                         $checked_a  = $chtxt  =~ /animax|atx|disney|kids/ || $category =~ /アニメ/ ? 'checked' : '';
 735                         $checked_d  = $title  =~ /\Q[二]\E|［二］|\Q(二)\E|（二）/ ? 'checked' : '';
 736                         $checked_5  = $title  =~ /5\.1|5．1/ ? 'checked' : '';
 737                         $checked_2  = 'checked';
 738
 739                         $HTML .= "録画予約の詳細設定を行ってください。<br>\n";
 740                         $HTML .= qq {<form method="get" action="rectool.pl">\n};
 741                         $HTML .= qq {<input type="hidden" name="mode"   value="reserve">\n};
 742                         $HTML .= qq {<input type="hidden" name="chname" value="$chname">\n};
 743                         $HTML .= qq {<input type="hidden" name="start"  value="$start">\n};
 744                         $HTML .= qq {<input type="hidden" name="stop"   value="$stop">\n};
 745                         $HTML .= qq {<select name="opt">\n};
 746                         $HTML .= qq {<option value="L" $selected_l>L ***x*** 1250kbps</option>\n};
 747                         $HTML .= qq {<option value="G" $selected_g>G 1280x720 2500kbps</option>\n};
 748                         $HTML .= qq {<option value="H" $selected_h>H 1280x720 3750kbps</option>\n};
 749                         $HTML .= qq {<option value="F" $selected_f>F 1920x1080 5000kbps</option>\n};
 750                         $HTML .= qq {<option value="S">S 720x480 1250kbps</option>\n};
 751                         $HTML .= qq {</select>\n};
 752                         $HTML .= qq {<input type="checkbox" name="opt" value="a" $checked_a>アニメ\n};
 753                         $HTML .= qq {<input type="checkbox" name="opt" value="d" $checked_d>二ヶ国語放送\n};
 754                         $HTML .= qq {<input type="checkbox" name="opt" value="2" $checked_2>2passモード\n};
 755                         $HTML .= qq {<input type="checkbox" name="opt" value="5" $checked_5>5.1ch放送\n};
 756                         $HTML .= qq {<br>\n};
 757                         $HTML .= qq {<select name="opt">\n};
 758                         $HTML .= qq {<option value="">移動なし</option>\n};
 759                         $HTML .= qq {<option value="R">録画後移動</option>\n};
 760                         $HTML .= qq {<option value="D">解読後移動</option>\n};
 761                         $HTML .= qq {<option value="E">縁故後移動</option>\n};
 762                         $HTML .= qq {</select>\n};
 763                         $HTML .= qq {<input type="checkbox" name="opt" value="N">ファイル名日時追加\n};
 764                         $HTML .= qq {<input type="submit" value="予約">\n</form>\n};
 765                 }
 766                 goto end;
 767         }
 768         # End of $mode_sub eq 'reserve';
 769
 770         if ( $mode_sub eq 'proc' ) {
 771                 my $type  = $q->param( 'type' );
 772                 my $title = $q->param( 'title' );
 773
 774                 $HTML .= "詳細設定を行ってください。<br>\n";
 775                 $HTML .= "タイトル：$title\n<br>\n";
 776
 777                 $HTML .= qq {<form method="get" action="rectool.pl">\n};
 778                 $HTML .= qq {<input type="hidden" name="mode"     value="change">\n};
 779                 $HTML .= qq {<input type="hidden" name="mode_sub" value="proc">\n};
 780                 $HTML .= qq {<input type="hidden" name="type"     value="$type">\n};
 781                 $HTML .= qq {<input type="hidden" name="title"    value="$title">\n};
 782                 $HTML .= qq {<select name="chtxt">\n};
 783                 $ary_ref = $dbh->selectall_arrayref(
 784                         "SELECT chname, chtxt FROM epg_ch"
 785                 );
 786                 foreach my $line ( @{$ary_ref} ) {
 787                         if ( $line->[1] eq $chtxt ) {
 788                                 $HTML .= qq {<option value="$line->[1]" selected>$line->[0]</option>\n};
 789                         }
 790                         else {
 791                                 $HTML .= qq {<option value="$line->[1]">$line->[0]</option>\n};
 792                         }
 793                 }
 794                 $HTML .= qq {</select>\n};
 795
 796                 $HTML .= qq {<select name="opt">\n};
 797                 $HTML .= qq {<option value="L" $selected_l>L ***x*** 1250kbps</option>\n};
 798                 $HTML .= qq {<option value="G" $selected_g>G 1280x720 2500kbps</option>\n};
 799                 $HTML .= qq {<option value="H" $selected_h>H 1280x720 3750kbps</option>\n};
 800                 $HTML .= qq {<option value="F" $selected_f>F 1920x1080 5000kbps</option>\n};
 801                 $HTML .= qq {<option value="S">S 720x480 1250kbps</option>\n};
 802                 $HTML .= qq {</select>\n};
 803                 $HTML .= qq {<input type="checkbox" name="opt" value="a" $checked_a>アニメ\n};
 804                 $HTML .= qq {<input type="checkbox" name="opt" value="d" $checked_d>二ヶ国語放送\n};
 805                 $HTML .= qq {<input type="checkbox" name="opt" value="2" $checked_2>2passモード\n};
 806                 $HTML .= qq {<input type="checkbox" name="opt" value="5" $checked_5>5.1ch放送\n};
 807                 $HTML .= qq {<input type="submit" value="予約">\n</form>\n};
 808                 goto end;
 809         }
 810 }
 811
 812 if ( $mode eq 'reserve' ) {
 813         $HTML .= qq {<div style="float: left">\n};
 814         &parse_program();
 815         @opt = $q->param( 'opt' );
 816         $opt = join '', @opt;
 817         if ( !&check_error ) {
 818                 $dbh->do(
 819                         "INSERT INTO timeline ( type, chtxt, title, btime, etime, opt )
 820                         VALUES ( 'reserve_flexible', '$chtxt', '$title', '$begin', '$end', '$opt' )"
 821                 );
 822         }
 823         $HTML .= "録画予約を実行しました。<br>\n5秒後にトップへ移動します。<br>\n";
 824         $HTML =~ s|%REFRESH%|<meta http-equiv="refresh" content="5; url=rectool.pl">|;
 825         goto end;
 826 }
 827
 828 if ( $mode eq 'program' ) {
 829         &draw_form();
 830
 831         $HTML =~ s/%HTML_TITLE_OPT%/ - Program Viewer/;
 832         $unix = DateTime->now( time_zone => $tz )->strftime( '%Y%m%d%H%M%S' );
 833         $sql =
 834                 "SELECT channel, chname, start, stop, title, category
 835                 FROM epg_timeline
 836                 INNER JOIN epg_ch ON epg_timeline.channel = epg_ch.ontv
 837                 WHERE $unix <= stop %CH% %DATE% %CATEGORY% %KEY% ORDER BY start";
 838
 839         if ( $ontv ) {
 840                 my $ch = "AND channel = '$ontv'";
 841                 $sql =~ s/%CH%/$ch/;
 842         }
 843         if ( $date_sel ) {
 844                 $date_1 = $date_sel . '000000';
 845                 $date_2 = Date::Simple->new( $date_sel =~ /(.{4})(.{2})(.{2})/ )->next->format('%Y%m%d') . '000000';
 846                 my $date = "AND '$date_1' <= stop AND start <= '$date_2'";
 847                 $sql =~ s/%DATE%/$date/;
 848         }
 849         if ( $category_sel ) {
 850                 # 一時的
 851                 #       $category_tmp = $category{$category_sel} . $category_sel;
 852                 my $category = "AND category = '$category{$category_sel}'";
 853                 $sql =~ s/%CATEGORY%/$category/;
 854         }
 855         if ( $key ) {
 856                 my $key = "AND TITLE LIKE '%$key%'";
 857                 $sql =~ s/%KEY%/$key/;
 858         }
 859         $sql =~ s/%CH%//;
 860         $sql =~ s/%DATE%//;
 861         $sql =~ s/%KEY%//;
 862         $sql =~ s/%CATEGORY%//;
 863
 864         $ary_ref = $dbh->selectall_arrayref( $sql );
 865         foreach my $prg ( @{ $ary_ref } ) {
 866                 my @date = $prg->[2] =~ /(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/;
 867
 868                 $date = $date[2];
 869                 if ( $date != $prev ) {
 870                         my $date = DateTime->new(
 871                                 year => $date[0], month  => $date[1], day    => $date[2],
 872                                 locale => 'ja_JP'
 873                         );
 874
 875                         my $dn = $date->day_name;
 876                         utf8::encode( $dn );
 877                         $HTML .= qq {--------$date[1]/$date[2]($dn)--------<br>\n};
 878                 }
 879                 $prg->[5] = $q->url_encode( $prg->[1] );
 880                 $HTML .= qq {$date[1]/$date[2] $date[3]:$date[4] };
 881                 $HTML .= qq {$prg->[1] } if ( !$ontv );
 882                 $HTML .= qq {<a href="rectool.pl?mode=confirm&amp;mode_sub=reserve&amp;chname=$prg->[5]&amp;start=$prg->[2]&amp;stop=$prg->[3]">$prg->[4]</a><br>\n};
 883                 $prev = $date;
 884         }
 885
 886 }
 887
 888 if ( $mode eq 'list' ) {
 889         require File::Find;
 890
 891         $HTML =~ s/%HTML_TITLE_OPT%/ - List/;
 892
 893         my $mode_sub  = $q->param( 'mode_sub' );
 894         my $recording = $cfg->param( 'path.recpath' );
 895         my $recorded  = $cfg->param( 'path.recorded' );
 896
 897         if ( !$mode_sub ) {
 898                 $HTML .= qq {<a href="rectool.pl?mode=list&amp;mode_sub=new">録画中のみ</a>\n};
 899                 $HTML .= qq {<a href="rectool.pl?mode=list&amp;mode_sub=old">録画後のみ</a>\n<br>\n};
 900         }
 901         if ( !$mode_sub || $mode_sub eq 'new' ) {
 902                 $HTML .= "録画中のファイル一覧<br>\n";
 903                 &list( $recording );
 904         }
 905         if ( !$mode_sub ) {
 906                 $HTML .= "<br>\n";
 907         }
 908         if ( !$mode_sub || $mode_sub eq 'old' ) {
 909                 $HTML .= "録画後のファイル一覧<br>\n";
 910                 &simple_list( $recorded );
 911         }
 912
 913         sub list {
 914                 local $path = shift;
 915                 local %list = ();
 916                 my @exp = ( 'log', 'ts.b25', 'ts.tsmix', 'ts', 'ts.log.mbtree', 'ts.log',
 917                         'sa.avi', 'sa.avi.log', 'm2v', 'wav', 'avi', 'mkv', 'mp4' );
 918                 for ( 0..$#exp ) {
 919                         $exp{$exp[$_]} = $_;
 920                 }
 921                 my $exp_count = scalar keys %exp;
 922
 923                 my %opt = ( follow => 1, wanted => \&wanted,  );
 924                 File::Find::find( \%opt, $path );
 925
 926                 foreach my $name ( sort { $exp{$a} <=> $exp{$b} } keys %exp ) {
 927                         $HTML .= $exp{$name} + 1 . " = $name / ";
 928                 }
 929                 $HTML .= $exp_count+1 . qq { = サムネイル<br>\n○ = 完了 / ● = 書き込み中 / ◆ = ファイルサイズ異常<br>\n};
 930                 $HTML .= qq {<table summary="listtable" border=1 cellspacing=0>\n<tr>\n};
 931                 $HTML .= qq {<th>タイトル</th>\n};
 932                 $HTML .= qq {<th>$_</th>\n} for ( 1..$exp_count + 1 );
 933                 $HTML .= qq {<th colspan="2">自動移動</th>\n};
 934                 $HTML .= qq {</tr>\n};
 935
 936                 foreach ( sort keys %list ) {
 937                         my $value = $list{$_};
 938                         my @flag = ( 0 ) x $exp_count;
 939                         $HTML .= qq {<tr>\n<td width="600" style="width: 600px; white-space: normal">$_</td>\n};
 940                         foreach ( keys %{$value} ) {
 941                                 my $tmp = $_;
 942                                 $flag[$exp{$tmp}] = $value->{$_};
 943                         }
 944                         foreach ( @flag ) {
 945                                 my $size = $_->{size};
 946                                 my $last = $_->{last} || ( $_->{size} eq '0 B' ? '◆' : '○' );
 947                                 my $check = $size ? qq {<span title="$size">$last</span>} : '<br>';
 948                                 $HTML .= qq {<td>$check</td>\n};
 949                         }
 950                         if ( $flag[$exp{mp4}] ) {
 951                                 s/#/＃/g;
 952                                 s/ /\+/g;
 953                                 my $img = $value->{mp4}->{img};
 954                                 $HTML  .= qq {<td><a href="rectool.pl?mode=thumb&amp;title=$img">■</a></td>\n};
 955                                 my $pre = qq {<a href="rectool.pl?mode=change&amp;mode_sub=move&amp;mode_sub2=predict&amp;title=$_">予測</a>};
 956                                 $HTML  .= qq {<td>$pre</td>\n};
 957                                 my $exe = qq {<a href="rectool.pl?mode=change&amp;mode_sub=move&amp;mode_sub2=exec&amp;title=$_">実行</a>};
 958                                 $HTML  .= qq {<td>$exe</td>\n};
 959                         }
 960                         else {
 961                                 $HTML .= qq {<td><br></td>\n<td colspan="2"><br></td>\n};
 962                         }
 963                         $HTML .= qq {</tr>\n};
 964                 }
 965                 $HTML .= qq {</table>\n};
 966
 967                 sub wanted {
 968                         return if ( !$_ );
 969                         return if ( -d $File::Find::name );
 970                         return if ( $_ eq 'Thumbs.db' );
 971                         return if ( /\.idx/ );
 972                         s/\.temp$//;
 973                         my $regexp = join '|', keys %exp;
 974                         my ( $title, $exp ) = /(.*?)\.($regexp)$/;
 975                         my ( $size, $last ) = &get_size( $File::Find::name );
 976                         my $img;
 977                         $File::Find::name =~ s/\.temp$//;
 978                         if ( !$title ) {
 979                                 $title = '_error_exp_'.$_;
 980                                 $exp   = 'log';
 981                         }
 982                         if ( $title !~ /[^0-9A-F]+/ ) {
 983                                 my $tmp = pack( 'H*', $title );
 984                                 if ( !$tmp ) {
 985                                         $title = '_error_b16_'.$_;
 986                                         $exp   = 'log';
 987                                 }
 988                                 else {
 989                                         $title = 'Base16_'.$tmp;
 990                                 }
 991                         }
 992                         if ( $_ =~ /mp4/ ) {
 993                                 my $tmp = $title;
 994                                 $tmp =~ s/#/＃/g;
 995                                 $tmp =~ s/ /\+/g;
 996                                 $img = $tmp;
 997                         }
 998                         $list{$title}->{$exp} = { 'last' => $last, 'size' => $size, 'img' => $img };
 999                 }
1000         }
1001
1002         sub simple_list {
1003                 local $path = shift;
1004                 local @list = ();
1005
1006                 File::Find::find( \&simple_wanted, $path );
1007
1008                 @list = sort @list;
1009                 foreach ( @list ) {
1010                         $HTML .= "$_<br>\n";
1011                 }
1012
1013                 sub simple_wanted {
1014                         return if ( !$_ );
1015                         return if ( -d $File::Find::name );
1016                         return if ( $_ eq 'Thumbs.db' );
1017                         my ( $size ) = &get_size( $File::Find::name );
1018                         $File::Find::name =~ s/\Q$path\E//;
1019                         push @list, $File::Find::name ."\t\t". $size;
1020                 }
1021         }
1022
1023         sub get_size {
1024                 my $file = shift;
1025                 my ( $size, $last ) = (stat( $file ))[7,9];
1026                 my @unim = ("B","KB","MB","GB","TB","PB");
1027                 my $count = 0;
1028
1029                 while($size >= 1024 ){
1030                         $count++;
1031                         $size = $size / 1024;
1032                 }
1033                 $size *= 100;
1034                 $size  = int( $size );
1035                 $size /= 100;
1036                 if ( time - $last < 10 ) {
1037                         $last = '●';
1038                 }
1039                 else {
1040                         $last = '';
1041                 }
1042                 return ( "$size $unim[$count]", $last );
1043         }
1044 }
1045
1046 if ( $mode eq 'thumb' ) {
1047         my $title = $q->param( 'title' );
1048         my $pos  = $q->param( 'pos' );
1049         my $recording = $cfg->param( 'path.recpath' );
1050         $title =~ s/\+/ /g;
1051         $title =~ s/＃/#/g;
1052
1053         print "Content-Type: image/jpeg\n\n";
1054         exec "ffmpeg -ss 300 -i '$recording/$title.mp4' -f image2 -pix_fmt jpg -vframes 1 -s 320x240 -";
1055         exit;
1056 }
1057
1058 if ( $mode eq 'check' ) {
1059 }
1060
1061 if ( $mode eq 'bravia' ) {
1062         $HTML =~ s/%HTML_TITLE_OPT%/ - Bravia/;
1063         $HTML .= qq {<div>\n};
1064         $HTML .= qq {<form method="get" action="rectool.pl">\n};
1065         $HTML .= qq {<div>\n};
1066         $HTML .= qq {<table summary="bayestable" border=1 cellspacing=0>\n<tr>\n};
1067         $HTML .= qq {<th>ID</th>\n};
1068         $HTML .= qq {<th>チャンネル</th>\n};
1069         $HTML .= qq {<th>タイトル</th>\n};
1070         $HTML .= qq {<th><a href="rectool.pl?mode=bravia">開始時刻</a></th>\n};
1071         $HTML .= qq {<th>終了時刻</th>\n};
1072         $HTML .= qq {<th>録画時間</th>\n};
1073         $HTML .= qq {<th><a href="rectool.pl?mode=bravia&amp;order=point">ポイント</a></th>\n};
1074         $HTML .= qq {<th>予約</th>\n};
1075         $HTML .= qq {</tr>\n};
1076
1077         my $order = $q->param( 'order' );
1078         if ( $order ne 'point' ) {
1079                 $order = 'btime';
1080         }
1081         else {
1082                 $order = 'point DESC';
1083         }
1084         my $ary_ref = $dbh->selectall_arrayref(
1085                 "SELECT id, chtxt, title, btime, etime, point
1086                 FROM auto_timeline_bayes
1087                 ORDER BY $order" );
1088
1089         foreach my $line ( @{ $ary_ref } ) {
1090                 my ( $begin, $end, $diff ) = &str2readable( $line->[3], $line->[4] );
1091
1092                 $HTML .= qq {<tr align="center">\n};
1093                 $HTML .= qq {<td>$line->[0]</td>\n};
1094                 $HTML .= qq {<td>$line->[1]</td>\n};
1095                 $HTML .= qq {<td>$line->[2]</td>\n};
1096                 $HTML .= qq {<td>$begin</td>\n<td>$end</td>\n<td>$diff</td>\n};
1097                 $HTML .= qq {<td>$line->[5]</td>\n};
1098                 $HTML .= qq {<td><a href="rectool.pl?mode=confirm&amp;mode_sub=reserve&amp;bayesid=$line->[0]">予約</a></td>\n};
1099                 $HTML .= qq {</tr>\n};
1100         }
1101         $HTML .= qq {</table>\n};
1102         $HTML .= qq {</div>\n};
1103         $HTML .= qq {</form>\n};
1104
1105 }
1106
1107 if ( $mode eq 'proc' ) {
1108         $HTML =~ s/%HTML_TITLE_OPT%/ - Proposal/;
1109         $HTML .= qq {<div>\n};
1110         $HTML .= qq {<table summary="proctable" border=1 cellspacing=0>\n<tr>\n};
1111         $HTML .= qq {<th>タイプ</th>\n};
1112         $HTML .= qq {<th>タイトル</th>\n};
1113         $HTML .= qq {<th>予約</th>\n};
1114         $HTML .= qq {</tr>\n};
1115
1116         my $ary_ref = $dbh->selectall_arrayref(
1117                 "SELECT type, title
1118                 FROM auto_proc " );
1119
1120         foreach my $line ( @{ $ary_ref } ) {
1121                 my $url;
1122                 $line->[2] = $q->url_encode( $line->[1] );
1123
1124                 if ( $line->[0] =~ /^auto_suggest_(dec|enc)/ ) {
1125                         $url = qq {rectool.pl?mode=confirm&amp;mode_sub=proc&amp;type=$line->[0]&amp;title=$line->[2]};
1126                 }
1127                 else {
1128                         $url = qq {rectool.pl?mode=change&amp;mode_sub=proc&amp;type=$line->[0]&amp;title=$line->[2]};
1129                 }
1130                 $HTML .= qq {<tr align="center">\n};
1131                 $HTML .= qq {<td>$type{$line->[0]}</td>\n};
1132                 $HTML .= qq {<td>$line->[1]</td>\n};
1133                 $HTML .= qq {<td><a href="$url">予約</a></td>\n};
1134                 $HTML .= qq {</tr>\n};
1135         }
1136
1137         $HTML .= qq {</table>\n};
1138 }
1139
1140 if ( $mode eq 'jbk' ) {
1141         $HTML =~ s/%HTML_TITLE_OPT%/ - JBK/;
1142         $HTML .= qq {<div>\n};
1143
1144         if ( $mode_sub eq 'add' ) {
1145                 my $keyword = $q->param( 'keyword' );
1146                 $HTML .= "キーワード「$keyword」を追加しました。<br>\n";
1147                 $dbh->do(
1148                         "INSERT INTO in_auto_jbk_key ( keyword )
1149                         VALUES ( '$keyword' )"
1150                 );
1151         }
1152         elsif ( $mode_sub eq 'del' ) {
1153                 my $id = $q->param( 'id' );
1154                 my $keyword = $dbh->selectrow_array(
1155                         "SELECT keyword FROM in_auto_jbk_key
1156                         WHERE id = '$id' " );
1157                 $HTML .= "キーワード「$keyword」を削除しました。<br>\n";
1158                 $dbh->do(
1159                         "DELETE FROM in_auto_jbk_key WHERE id = '$id'"
1160                 );
1161         }
1162
1163         $HTML .= qq {<table summary="jbktable" border=1 cellspacing=0>\n<tr>\n};
1164         $HTML .= qq {<th>ID</th>\n};
1165         $HTML .= qq {<th>キーワード</th>\n};
1166         $HTML .= qq {<th>削除</th>\n};
1167         $HTML .= qq {</tr>\n};
1168
1169         my $ary_ref = $dbh->selectall_arrayref(
1170                 "SELECT id, keyword
1171                 FROM in_auto_jbk_key
1172                 ORDER BY id " );
1173
1174         foreach my $line ( @{ $ary_ref } ) {
1175                 my $url = "rectool.pl?mode=jbk&amp;mode_sub=del&amp;id=$line->[0]";
1176
1177                 $HTML .= qq {<tr align="center">\n};
1178                 $HTML .= qq {<td>$line->[0]</td>\n};
1179                 $HTML .= qq {<td>$line->[1]</td>\n};
1180                 $HTML .= qq {<td><a href="$url">削除</a></td>\n};
1181                 $HTML .= qq {</tr>\n};
1182         }
1183
1184         $HTML .= qq {</table>\n};
1185
1186         $HTML .= qq {<form method="get" action="rectool.pl">\n};
1187         $HTML .= qq {<div>\n};
1188         $HTML .= qq {<input type="hidden" name="mode" value="jbk">\n};
1189         $HTML .= qq {<input type="hidden" name="mode_sub" value="add">\n};
1190         $HTML .= qq {<input name="keyword" type="text">\n};
1191         $HTML .= qq {<input type="submit" value="追加">\n</div>\n</form>\n<br>\n};
1192
1193         $HTML .= qq {<table summary="jbkrestable" border=1 cellspacing=0>\n<tr>\n};
1194         $HTML .= qq {<th>ID</th>\n};
1195         $HTML .= qq {<th>チャンネル</th>\n};
1196         $HTML .= qq {<th>タイトル</th>\n};
1197         $HTML .= qq {<th>開始時刻</th>\n};
1198         $HTML .= qq {<th>終了時刻</th>\n};
1199         $HTML .= qq {<th>録画時間</th>\n};
1200         $HTML .= qq {<th>予約</th>\n};
1201         $HTML .= qq {</tr>\n};
1202
1203         my $ary_ref = $dbh->selectall_arrayref(
1204                 "SELECT id, chtxt, title, btime, etime
1205                 FROM auto_timeline_keyword " );
1206
1207         foreach my $line ( @{ $ary_ref } ) {
1208                 my ( $begin, $end, $diff ) = &str2readable( $line->[3], $line->[4] );
1209                 $line->[3] =~ s/(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/$1$2$3$4$5$6/;
1210                 $line->[4] =~ s/(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/$1$2$3$4$5$6/;
1211                 my $url = qq "rectool.pl?mode=confirm&amp;mode_sub=reserve&amp;chtxt=$line->[1]&amp;start=$line->[3]&amp;stop=$line->[4]";
1212
1213                 $HTML .= qq {<tr align="center">\n};
1214                 $HTML .= qq {<td>$line->[0]</td>\n};
1215                 $HTML .= qq {<td>$line->[1]</td>\n};
1216                 $HTML .= qq {<td>$line->[2]</td>\n};
1217                 $HTML .= qq {<td>$begin</td>\n};
1218                 $HTML .= qq {<td>$end</td>\n};
1219                 $HTML .= qq {<td>$diff</td>\n};
1220                 $HTML .= qq {<td><a href="$url">予約</a></td>\n};
1221                 $HTML .= qq {</tr>\n};
1222         }
1223
1224         $HTML .= qq {</table>\n};
1225
1226 }
1227
1228 if ( $mode eq 'expert' ) {
1229         my $ary_ref;
1230         my $mode_sub = $q->param( 'mode_sub' );
1231         $HTML =~ s/%HTML_TITLE_OPT%/ - Expert/;
1232         $HTML .= qq {<div>\n};
1233
1234         if ( $mode_sub eq 'reget' ) {
1235                 my $bctype = $q->param( 'bctype' );
1236                 my ( $ontv, $chname ) = $dbh->selectrow_array(
1237                         "SELECT ontv, chname FROM epg_ch
1238                         WHERE bctype = '$bctype' " );
1239                 $HTML .= "Update for $chname ( ontv: $ontv ) has been reserved.<br>\n";
1240                 $dbh->do( "UPDATE epg_ch SET status = '2' WHERE ontv = '$ontv' " );
1241                 goto end;
1242         }
1243
1244
1245         $ary_ref = $dbh->selectcol_arrayref(
1246                 "SELECT DISTINCT category FROM epg_timeline"
1247         );
1248         # 一時的
1249         #       my @category = map { $category{$_} . $_ } sort keys %category;
1250         my @category = sort values %category;
1251         $HTML .= qq {<hr>\n番組表のカテゴリ一覧と内蔵の一覧の合致を確認中...\n};
1252         if ( List::Compare->new( $ary_ref, \@category )->get_symdiff ) {
1253                 $HTML .= qq {一致しません<br>\n};
1254                 $HTML .= qq {番組表：@{$ary_ref}<br>\n内蔵：@category<br>\n};
1255         }
1256         else {
1257                 $HTML .= qq {一致しました<br>\n};
1258         }
1259
1260         my @ary = $dbh->selectrow_array( "SELECT terec, bscsrec, b252ts, ts2avi FROM in_status" );
1261         $HTML .= qq {<hr>\n地上波録画数：$ary[0]\n衛星波録画数：$ary[1]\n解読数：$ary[2]\n縁故数：$ary[3]\n<br>\n};
1262
1263         use List::Compare;
1264         $ary_ref = $dbh->selectall_arrayref( "SELECT chname, chtxt FROM epg_ch" );
1265         my $prev;
1266         $HTML .= "<hr>\n番組表の欠落<br>\n";
1267         foreach my $line ( @{$ary_ref} ) {
1268                 my $ary_ref = $dbh->selectall_arrayref(
1269                         "SELECT start, stop, title FROM epg_timeline WHERE channel = '$line->[1]' ORDER BY start"
1270                 );
1271                 my $error;
1272                 my @program_old = ( '', $ary_ref->[0]->[0] );
1273                 my $program_old = \@program_old;
1274
1275                 foreach my $program_new ( @{$ary_ref} ) {
1276                         if ( $program_old->[1] ne $program_new->[0] &&
1277                                 $program_old->[2] !~ /クロ?ジング|クロージング|エンディング|休止|ミッドナイトプレゼント/ &&
1278                                 $program_new->[2] !~ /オープニング|ウィークリー・インフォメーション|モーニングプレゼント/ &&
1279                                 ( str2datetime( $program_new->[0] ) - str2datetime( $program_old->[1] ) )->delta_minutes > 30 ) {
1280                                 $program_old->[1] =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/;
1281                                 $program_new->[0] =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/;
1282                                 $error .= qq{    $program_old->[2]    $program_old->[1]\n    ?  $program_new->[2]    $program_new->[0]\n};
1283                         }
1284                         $program_old = $program_new;
1285                 }
1286                 $HTML .= qq {<pre>\n$line->[0]\n$error</pre>\n} if ( $error );
1287                 }
1288
1289         $ary_ref = $dbh->selectall_arrayref(
1290                 "SELECT chname, chtxt, ontv, bctype, ch, csch, updatetime, status
1291                 FROM epg_ch
1292                 ORDER BY bctype " );
1293         $HTML .= qq {<hr>\n番組表の更新状況<br>\n};
1294         $HTML .= qq {<table summary="channeltable" border=1 cellspacing=0>\n<tr>\n};
1295         $HTML .= qq {<th>チャンネル名</th>\n};
1296         $HTML .= qq {<th>チャンネルコード</th>\n};
1297         $HTML .= qq {<th>ontvコード</th>\n};
1298         $HTML .= qq {<th>タイプ</th>\n};
1299         $HTML .= qq {<th>ch</th>\n};
1300         $HTML .= qq {<th>csch</th>\n};
1301         $HTML .= qq {<th>最終更新時刻</th>\n};
1302         $HTML .= qq {<th>状態</th>\n};
1303         $HTML .= qq {</tr>\n};
1304         foreach my $status ( @{$ary_ref} ) {
1305                 $HTML .= qq {<tr>\n};
1306                 $HTML .= qq {<td>$status->[0]</td>\n<td>$status->[1]</td>\n<td>$status->[2]</td>\n<td>$status->[3]</td>\n};
1307                 $HTML .= qq {<td>$status->[4]</td>\n<td>$status->[5]</td>\n<td>$status->[6]</td>\n<td>$status->[7]</td>\n};
1308                 $HTML .= qq {</tr>\n};
1309         }
1310         $HTML .= qq {</table>\n};
1311
1312         $HTML .= qq {<form method="get" action="rectool.pl">\n};
1313         $HTML .= qq {<div>\n};
1314         $HTML .= qq {番組表を再取得する\n};
1315         $HTML .= qq {<input type="hidden" name="mode" value="expert">\n};
1316         $HTML .= qq {<input type="hidden" name="mode_sub" value="reget">\n};
1317         $HTML .= qq {<select name="bctype">\n};
1318         $ary_ref = $dbh->selectall_arrayref(
1319                 "SELECT chname, bctype
1320                 FROM epg_ch WHERE bctype NOT LIKE '_s%' "
1321         );
1322         foreach my $line ( @{$ary_ref} ) {
1323                 $HTML .= qq {<option value="$line->[1]">$line->[0]</option>\n};
1324         }
1325         $HTML .= qq {<option value="bs">BS</option>\n};
1326         $HTML .= qq {<option value="cs1">CS1</option>\n};
1327         $HTML .= qq {<option value="cs2">CS2</option>\n};
1328         $HTML .= qq {</select>\n};
1329         $HTML .= qq {<input type="submit" value="実行">\n</div>\n</form>\n};
1330
1331
1332
1333         $ary_ref = $dbh->selectall_arrayref(
1334                 "SELECT id, type, chtxt, title, btime, etime, deltaday, deltatime
1335                 FROM timeline
1336                 ORDER BY id ");
1337         $HTML .= qq {<hr>\n予約表<br>\n};
1338         $HTML .= qq {<table summary="rectimetable" border=1 cellspacing=0>\n<tr>\n};
1339         $HTML .= qq {<th>ID</th>\n};
1340         $HTML .= qq {<th>type</th>\n};
1341         $HTML .= qq {<th>chtxt</th>\n};
1342         $HTML .= qq {<th>title</th>\n};
1343         $HTML .= qq {<th>btime</th>\n};
1344         $HTML .= qq {<th>etime</th>\n};
1345         $HTML .= qq {<th>deltaday</th>\n};
1346         $HTML .= qq {<th>deltatime</th>\n};
1347         $HTML .= qq {</tr>\n};
1348         foreach my $status ( @{$ary_ref} ) {
1349                 $HTML .= qq {<tr>\n};
1350                 $HTML .= qq {<td>$status->[0]</td>\n<td>$status->[1]</td>\n<td>$status->[2]</td>\n<td>$status->[3]</td>\n};
1351                 $HTML .= qq {<td>$status->[4]</td>\n<td>$status->[5]</td>\n<td>$status->[6]</td>\n<td>$status->[7]</td>\n};
1352                 $HTML .= qq {</tr>\n};
1353         }
1354         $HTML .= qq {</table>\n};
1355 }
1356
1357 if ( $mode eq 'help' ) {
1358         $HTML =~ s/%HTML_TITLE_OPT%/ - Help/;
1359         $HTML =~ s|%REFRESH%|<meta http-equiv="refresh" content="300">|;
1360         $HTML .= qq {<div>\n};
1361         $HTML .= qq {ヘルプ\n};
1362 }
1363
1364 if ( $mode eq 'test' ) {
1365         $HTML =~ s/%HTML_TITLE_OPT%/ - Test/;
1366         $HTML =~ s|%REFRESH%|<meta http-equiv="refresh" content="300">|;
1367         $HTML .= qq {<div>\n};
1368
1369         require Data::Dumper;
1370         require Perl6::Slurp;
1371         $tmp = Perl6::Slurp::slurp( 'config.ini' );
1372         $tmp =~ s/\n/<br>\n/gs;
1373         $HTML .= $tmp;
1374
1375         # $HTML .= Dumper( $ary_ref );
1376 }
1377
1378 if ( !$mode ) {
1379         &draw_form();
1380         $HTML =~ s/%HTML_TITLE_OPT%/ - Top/;
1381         $HTML .= qq {Welcome to Rec10!<br>\n};
1382         goto end;
1383 }
1384
1385
1386 end:
1387 #<div style="float: right">
1388 $HTML .= <<EOM;
1389 </div>
1390 </body>
1391 </html>
1392 EOM
1393
1394 #<div align="center">
1395 #$HTML_ADV = $HTML_ADV_IMG . $HTML_ADV_TEXT if ( !$HTML_ADV );
1396 $HTML_HEADER = qq {<div style="text-align: center">\n$HTML_ADV\n</div>\n};
1397
1398 &draw_menu();
1399 $HTML =~ s/%HTML_TITLE_OPT%//;
1400 $HTML =~ s/%REFRESH%//;
1401 $HTML =~ s/%SCRIPT%//;
1402 $HTML =~ s/%CSS%//;
1403 $HTML =~ s/%HTML_HEADER%/$HTML_HEADER/;
1404
1405 print $HTTP_HEADER;
1406 print $HTML;
1407
1408 sub draw_menu {
1409         $hires = Time::HiRes::time() - $hires;
1410         $last_modified = localtime((stat 'rectool.pl')[9]);
1411
1412         $HTML_HEADER .= qq {<div>\n};
1413         $HTML_HEADER .= qq {<span style="float: right; font-size: 8px">Last-Modified: $last_modified<br>Time-Elasped: $hires秒</span>\n};
1414         $HTML_HEADER .= qq {<span style="float: left">\n};
1415         $HTML_HEADER .= qq {<a href="rectool.pl">トップ</a>\n};
1416         $HTML_HEADER .= qq {<a href="rectool.pl?mode=schedule">予約確認</a>\n};
1417         $HTML_HEADER .= qq {<a href="rectool.pl?mode=graph">予約状況(画像版)</a>\n};
1418         $HTML_HEADER .= qq {<a href="rectool.pl?mode=list">録画一覧</a>\n};
1419         $HTML_HEADER .= qq {<a href="rectool.pl?mode=bravia">おまかせ</a>\n};
1420         $HTML_HEADER .= qq {<a href="rectool.pl?mode=expert">玄人仕様</a>\n};
1421         $HTML_HEADER .= qq {<a href="rectool.pl?mode=proc">復旧支援</a>\n};
1422         $HTML_HEADER .= qq {<a href="rectool.pl?mode=jbk">地引</a>\n};
1423         $HTML_HEADER .= qq {<a href="../rec10web/rec10web.py">新規予約</a>\n};
1424         $HTML_HEADER .= qq {<a href="rectool.pl?mode=edit">新規予約2</a>\n};
1425         $HTML_HEADER .= qq {</span>\n};
1426         $HTML_HEADER .= qq {<hr style="clear: both; background-color: grey; height: 4px">\n};
1427         $HTML_HEADER .= qq {</div>\n};
1428 }
1429
1430 sub draw_form {
1431         $chname = $q->param( 'chname' );
1432         $key    = $q->param( 'key' );
1433         $ontv = $dbh->selectrow_array("SELECT ontv FROM epg_ch WHERE chname = '$chname' ");
1434
1435         $HTML .= qq {<div style="float: left">\n};
1436         $HTML .= qq {<form method="get" action="rectool.pl">\n};
1437         $HTML .= qq {<div>\n};
1438         $HTML .= qq {<input type="hidden" name="mode" value="program">\n};
1439
1440         # チャンネル指定
1441         $HTML .= qq {<select name="chname">\n<option value="" selected>無指定</option>\n};
1442         $ary_ref = $dbh->selectcol_arrayref(
1443                 "SELECT chname FROM epg_ch"
1444         );
1445         foreach my $line ( @{$ary_ref} ) {
1446                 if ( $line eq $chname ) {
1447                         $HTML .= qq {<option value="$line" selected>$line</option>\n};
1448                 }
1449                 else {
1450                         $HTML .= qq {<option value="$line">$line</option>\n};
1451                 }
1452         }
1453         $HTML .= qq {</select>\n};
1454
1455         # 日付指定
1456         $HTML .= qq {<select name="date">\n<option value="" selected>無指定</option>\n};
1457         $ary_ref = $dbh->selectcol_arrayref(
1458                 "SELECT DISTINCT SUBSTRING(start, 1, 8) FROM epg_timeline ORDER BY start"
1459         );
1460         $date_sel = $q->param( 'date' );
1461         foreach my $date ( @{ $ary_ref } ) {
1462                 my @date = $date =~ /(.{4})(.{2})(.{2})/;
1463                 $date_prt = "$date[1]/$date[2]";
1464
1465                 if ( $date eq $date_sel ) {
1466                         $HTML .= qq {<option value="$date" selected>$date_prt</option>\n};
1467                 }
1468                 else {
1469                         $HTML .= qq {<option value="$date">$date_prt</option>\n};
1470                 }
1471         }
1472         $HTML .= qq {</select>\n};
1473
1474         # カテゴリ指定
1475         $HTML .= qq {<select name="category">\n<option value="" selected>無指定</option>\n};
1476         $category_sel = $q->param( 'category' );
1477         foreach my $category ( keys %category ) {
1478                 if ( $category eq $category_sel ) {
1479                         $HTML .= qq {<option value="$category" selected>$category{$category}</option>\n};
1480                 }
1481                 else {
1482                         $HTML .= qq {<option value="$category">$category{$category}</option>\n};
1483                 }
1484         }
1485         $HTML .= qq {</select>\n};
1486
1487         # キーワード指定
1488         $HTML .= qq {<input name="key" type="text" value="$key" style="width:200px">\n};
1489
1490         # フォーム描画
1491         $HTML .= qq {<input type="submit" value="更新">\n</div>\n</form>\n};
1492 }
1493
1494 sub parse_program {
1495         $chname  = $q->param( 'chname' );
1496         $chtxt   = $q->param( 'chtxt' );
1497         $start   = $q->param( 'start' );
1498         $stop    = $q->param( 'stop' );
1499         $bayesid = $q->param( 'bayesid' );
1500         $id      = $q->param( 'id' );
1501
1502         if ( $chname ) {
1503                 $ontv     = $dbh->selectrow_array("SELECT ontv   FROM epg_ch WHERE chname = '$chname'");
1504                 $chtxt    = $dbh->selectrow_array("SELECT chtxt  FROM epg_ch WHERE ontv   = '$ontv'");
1505         }
1506         elsif ( $chtxt ) {
1507                 $ontv     = $dbh->selectrow_array("SELECT ontv   FROM epg_ch WHERE chtxt  = '$chtxt'");
1508                 $chname   = $dbh->selectrow_array("SELECT chname FROM epg_ch WHERE ontv   = '$ontv'");
1509         }
1510         $title    = $dbh->selectrow_array("SELECT title    FROM epg_timeline WHERE channel = '$ontv' AND start = '$start' AND stop = '$stop' ");
1511         $desc     = $dbh->selectrow_array("SELECT exp      FROM epg_timeline WHERE channel = '$ontv' AND start = '$start' AND stop = '$stop' ");
1512         $longdesc = $dbh->selectrow_array("SELECT longexp  FROM epg_timeline WHERE channel = '$ontv' AND start = '$start' AND stop = '$stop' ");
1513         $category = $dbh->selectrow_array("SELECT category FROM epg_timeline WHERE channel = '$ontv' AND start = '$start' AND stop = '$stop' ");
1514         $bctype   = $dbh->selectrow_array("SELECT bctype   FROM epg_ch       WHERE ontv    = '$ontv'");
1515
1516         if ( $bayesid ) {
1517                 ( $chtxt, $title, $begin, $end ) = $dbh->selectrow_array(
1518                         "SELECT chtxt, title, btime, etime FROM auto_timeline_bayes WHERE id = '$bayesid' "
1519                 );
1520                 ( $ontv, $chname, $bctype ) = $dbh->selectrow_array(
1521                         "SELECT ontv, chname, bctype FROM epg_ch WHERE chtxt = '$chtxt' "
1522                 );
1523                 $start = str2datetime( $begin )->strftime( '%Y%m%d%H%M%S' );
1524                 $stop  = str2datetime( $end   )->strftime( '%Y%m%d%H%M%S' );
1525                 ( $desc, $longdesc, $category ) = $dbh->selectrow_array(
1526                         "SELECT exp, longexp, category FROM epg_timeline WHERE channel = '$ontv' AND start = '$start' AND stop = '$stop' "
1527                 );
1528         }
1529         if ( $id ) {
1530                 ( $type, $chtxt, $title, $begin, $end, $deltaday, $deltatime, $opt ) = $dbh->selectrow_array(
1531                         "SELECT type, chtxt, title, btime, etime, deltaday, deltatime, opt
1532                         FROM timeline WHERE id = '$id' "
1533                 );
1534                 ( $ontv, $chname, $bctype ) = $dbh->selectrow_array(
1535                         "SELECT ontv, chname, bctype FROM epg_ch WHERE chtxt = '$chtxt' "
1536                 );
1537                 $start = str2datetime( $begin )->strftime( '%Y%m%d%H%M%S' );
1538                 $stop  = str2datetime( $end   )->strftime( '%Y%m%d%H%M%S' );
1539                 ( $desc, $longdesc, $category ) = $dbh->selectrow_array(
1540                         "SELECT exp, longexp, category FROM epg_timeline WHERE channel = '$ontv' AND start = '$start' AND stop = '$stop' "
1541                 );
1542         }
1543         if ( $bctype =~ /.s/ ) {
1544                 $bctype_sql = '_s%';
1545         }
1546         elsif ( $bctype =~ /te/ ) {
1547                 $bctype_sql = 'te%';
1548         }
1549         @start = $start =~ /(.{4})(.{2})(.{2})(.{2})(.{2})/;
1550         @stop  = $stop  =~ /(.{4})(.{2})(.{2})(.{2})(.{2})/;
1551         $begin = sprintf( '%04d-%02d-%02d %02d:%02d:%02d', @start, '00' );
1552         $end   = sprintf( '%04d-%02d-%02d %02d:%02d:%02d', @stop , '00' );
1553 }
1554
1555 sub check_error {
1556         my $is_error;
1557         my $is_same = $dbh->selectrow_array(
1558                 "SELECT COUNT(*) FROM timeline WHERE chtxt = '$chtxt' AND btime = '$begin' AND etime = '$end'"
1559         );
1560         my @overlap = &get_overlap();
1561
1562         if ( $is_same ) {
1563                 $HTML .= "同一の番組が既に存在します。<br>\n";
1564                 $is_error = 1;
1565         }
1566         elsif ( $overlap[0] >= 2 ) {
1567                 $HTML .= "時間が被る番組が既に2個存在します。<br>\n";
1568                 $HTML .= $overlap[1];
1569                 $is_error = 2;
1570         }
1571         else {
1572                 $is_error = 0;
1573         }
1574         return $is_error;
1575 }
1576
1577 sub get_overlap {
1578         require List::Util;
1579
1580         my $ary_ref = $dbh->selectall_arrayref(
1581                 "SELECT btime, etime, title
1582                 FROM timeline
1583                 INNER JOIN epg_ch ON timeline.chtxt = epg_ch.chtxt
1584                 WHERE bctype LIKE '$bctype_sql' AND type IN $type_user_made
1585                 AND btime < '$end'
1586                 AND etime > '$begin'
1587                 "
1588         );
1589
1590         my %overlap;
1591         my $overlap = $max = 0;
1592         my $str;
1593         foreach my $prg ( @{ $ary_ref } ) {
1594                 $str .= "$prg->[0] ? $prg->[1] : $prg->[2]<br>\n";
1595                 $overlap{$prg->[0]} += 1;
1596                 $overlap{$prg->[1]} -= 1;
1597         }
1598         foreach my $key ( sort keys %overlap ) {
1599                 $overlap += $overlap{$key};
1600                 $max = List::Util::max( $max, $overlap );
1601         }
1602         if ( wantarray ) {
1603                 return ( $max, $str );
1604         }
1605         else {
1606                 return $max;
1607         }
1608 }
1609
1610 sub strisjoined {
1611         my $str = shift;
1612
1613         return $str =~ /.{4}-.{2}-.{2} .{2}:.{2}:.{2}/ ? 0 : 1;
1614 }
1615
1616 sub str2datetime {
1617         my $str    = shift;
1618         my @time;
1619
1620         if ( strisjoined( $str ) ) {
1621                 @time = $str =~ /(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/;
1622         }
1623         else {
1624                 @time = $str =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/;
1625         }
1626         return DateTime->new(
1627                 year   => $time[0], month     => $time[1], day    => $time[2],
1628                 hour   => $time[3], minute    => $time[4], second => $time[5],
1629                 locale => 'ja_JP' , time_zone => $tz
1630         );
1631 }
1632
1633 sub str2dayname {
1634         my  $str = shift;
1635         our %day_name_cache;
1636
1637         if ( !$day_name_cache{$str} ) {
1638                 $day_name_cache{$str} = str2datetime( $str )->day_name;
1639         }
1640         return $day_name_cache{$str};
1641 }
1642
1643 sub str2readable {
1644         my $begin = shift;
1645         my $end   = shift;
1646
1647         my $dt_begin = &str2datetime( $begin );
1648         my $dt_end   = &str2datetime( $end );
1649
1650         my $str_begin = $dt_begin->strftime( '%m/%d(%a) %H:%M' );
1651         my $str_end   = $dt_end  ->strftime( $dt_begin->day == $dt_end->day ? '%H:%M' : '翌 %H:%M' );
1652         utf8::encode( $str_begin );
1653
1654         my ( $sec, $min, $hour );
1655         $sec  = $dt_end->epoch - $dt_begin->epoch;
1656         $min  = int( $sec / 60 );
1657         $sec  = $sec - $min * 60;
1658         $hour = int( $min / 60 );
1659         $min  = $min - $hour * 60;
1660         my $str_diff = '';
1661         $str_diff .= $hour . '時間' if ( $hour );
1662         $str_diff .= $min  . '分'   if ( $min );
1663         $str_diff .= $sec  . '秒'   if ( $sec );
1664
1665         return ( $str_begin, $str_end, $str_diff );
1666 }
1667
1668 sub sqlgetsuggested {
1669         require Encode;
1670         require Text::Ngram;
1671
1672         my ( $btime, $etime ) = @_;
1673
1674         $btime_bgn = $btime->clone->subtract( hours => $deltatime )->strftime( '%Y%m%d%H%M%S' );
1675         $btime_end = $btime->clone->add(      hours => $deltatime )->strftime( '%Y%m%d%H%M%S' );
1676         $etime_bgn = $etime->clone->subtract( hours => $deltatime )->strftime( '%Y%m%d%H%M%S' );
1677         $etime_end = $etime->clone->add(      hours => $deltatime )->strftime( '%Y%m%d%H%M%S' );
1678
1679         my $ontv = $dbh->selectrow_array( "SELECT ontv FROM epg_ch WHERE chtxt = '$chtxt' " );
1680         $ary_ref = $dbh->selectall_arrayref(
1681                 "SELECT start, stop, title, exp
1682                 FROM epg_timeline
1683                 WHERE channel = '$ontv'
1684                 AND start BETWEEN '$btime_bgn' AND '$btime_end'
1685                 AND stop  BETWEEN '$etime_bgn' AND '$etime_end' "
1686         );
1687
1688         my %hash;
1689         my $hash_r = Text::Ngram::ngram_counts( Encode::decode_utf8( $title ), 2 ); # bi-gram
1690         foreach my $program ( @{$ary_ref} ) {
1691                 my $hash_k = Text::Ngram::ngram_counts( Encode::decode_utf8( $program->[2] ), 2 );
1692                 my $point;
1693                 map $point += $hash_k->{$_}, keys %{$hash_r};
1694                 push @{$hash{$point}}, $program if ( $point );
1695         }
1696
1697         return %hash;
1698 }