8 #Date_Init("TZ=JST","ConvTZ=JST");
11 use CGI::Carp qw( fatalsToBrowser );
26 #require SVG Time::Simple XML::Atom Encode Text::Ngram List::Compare List::Util
30 ################ バージョン定義 ################
33 my $rectool_version = 93;
36 ################ 初期化ここから ################
39 %DB::packages = ( 'main' => 1 );
40 my $tz = DateTime::TimeZone->new( name => 'local' );
41 my $hires = Time::HiRes::time();
43 my $cfg = new Config::Simple;
44 if ( -e '/etc/rec10.conf' ) {
45 $cfg->read( '/etc/rec10.conf' );
48 my $sql = $cfg->param( 'db.db' );
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, {
60 $dbh->do( 'SET NAMES utf8' );
63 my $rec10_version = eval {
64 $dbh->selectrow_array( "SELECT version FROM in_status " );
69 $HTTP_HEADER = "Content-Type: text/html\n\n";
71 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
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">
89 my ( $user, $pass, $auth );
90 ( $user, $pass ) = eval {
91 $dbh->selectrow_array( "SELECT webuser, webpass FROM in_settings " );
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" ) ) {
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;
118 if ( $rec10_version != $rectool_version ) {
119 $HTML .= qq {<div style="font-size: 200%; font-weight: bold; color: red">\n};
121 if ( $rec10_version > $rectool_version ) {
122 $HTML .= qq {Rec10本体のバージョンが新しいため、実行できません。<br>\n};
123 $HTML .= qq {rectoolのバージョンアップを行ってください。<br>\n};
126 if ( $rec10_version < $rectool_version ) {
127 $HTML .= qq {Rec10本体のバージョンが古いため、実行できません。<br>\n};
128 $HTML .= qq {Rec10のバージョンアップを行ってください。<br>\n};
131 $HTML .= qq {Rec10のバージョンは$rec10_version、rectoolのバージョンは$rectool_versionです。<br>\n};
132 $HTML .= qq {<a href="http://sourceforge.jp/projects/rec10/">公式ページ</a>\n};
136 $q = new CGI::Minimal;
137 $mode = $q->param( 'mode' );
138 $mode_sub = $q->param( 'mode_sub' );
141 ################ 定数宣言 ################
144 tie %type, 'Tie::IxHash';
146 'search_everyday' => '隔日検索',
147 'search_today' => '当日検索',
148 'reserve_flexible' => '浮動予約',
149 'reserve_fixed' => '確定予約',
151 'reserve_running' => '録画途中',
153 'convert_b25_ts' => '解読予約',
154 'convert_b25_ts_running' => '解読途中',
155 'convert_b25_ts_miss' => '解読失敗',
157 'convert_ts_mp4' => '縁故予約',
158 'convert_ts_mp4_running' => '縁故於鯖',
159 'convert_ts_mp4_network' => '縁故於網',
160 'convert_ts_mp4_finished' => '縁故完了',
162 'convert_avi_mkv' => '変換旧露',
163 'convert_avi_mp4' => '変換旧四',
164 'convert_mkv_mp4' => '変換露四',
165 'convert_mkv_mp4_runnings' => '換途露四',
167 'auto_suggest_dec' => '予測解読',
168 'auto_suggest_enc' => '予測縁故',
169 'auto_suggest_avi2fp' => '予測旧四',
170 'auto_suggest_ap2fp' => '予測露四',
172 'move_end' => '移動完了',
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',
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',
194 'other' => '#A0A0A0',
197 $type_user_made = "( 'search_everyday', 'search_today', 'reserve_flexible', 'reserve_fixed', 'reserve_running' )";
202 'variety' => 'バラエティ',
204 'information' => '情報',
212 ################ 初期化ここまで ################
215 if ( $mode eq 'schedule' ) {
217 $HTML =~ s/%HTML_TITLE_OPT%/ - Schedule Viewer/;
218 # $HTML =~ s|%REFRESH%|<meta http-equiv="refresh" content="300">|;
220 <style type="text/css">
226 $css =~ s/^\t{2}//gm;
227 $HTML =~ s/%CSS%/$css/;
229 my $order = $q->param( 'order' );
230 my $extra = $q->param( 'extra' );
231 if ( $order ne 'id' ) {
234 $reverse_extra = $extra ? '' : '&extra=1';
235 $forward_order = $order eq 'btime' ? '' : '&order=id';
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
240 INNER JOIN epg_ch ON timeline.chtxt = epg_ch.chtxt
243 $HTML .= qq {<div style="font-size: 80%; float: left">\n};
244 $HTML .= qq {<form method="get" action="rectool.pl">\n};
245 $HTML .= qq {<div>\n};
246 $HTML .= qq {<input type="hidden" name="mode" value="change">\n};
247 $HTML .= qq {<table summary="rectimetable" border=1 cellspacing=0>\n<tr>\n};
248 $HTML .= qq {<th><a href="rectool.pl?mode=schedule$forward_order$reverse_extra">■</a></th>\n};
249 $HTML .= qq {<th><a href="rectool.pl?mode=schedule&order=id">ID</a></th>\n};
250 $HTML .= qq {<th>タイプ</th>\n};
251 $HTML .= qq {<th>チャンネル</th>\n};
252 $HTML .= qq {<th>タイトル</th>\n};
253 $HTML .= qq {<th><a href="rectool.pl?mode=schedule">開始時刻</a></th>\n};
254 $HTML .= qq {<th>終了時刻</th>\n};
255 $HTML .= qq {<th>録画時間</th>\n};
256 $HTML .= qq {<th>オプション</th>\n};
257 $HTML .= qq {<th>dd</th>\n};
258 $HTML .= qq {<th>dt</th>\n};
259 $HTML .= qq {</tr>\n};
260 foreach my $line ( @{ $ary_ref } ) {
262 $type = $type{$line->[1]} || $line->[1];
263 if ( $line->[1] =~ /^search/ ) {
264 $type = qq {<span style="color: #8B008B">$type</span>};
265 $line->[9] = qq {<span style="color: #FF0000">空</span>} if ( !$line->[9] && $line->[1] eq 'search_everyday' );
266 $line->[10] = qq {<span style="color: #FF0000">空</span>} if ( !$line->[10] );
269 my $color = $color{$line->[1]} ? $color{$line->[1]} : $color{'other'};
270 $type = qq {<span style="color: $color">$type</span>};
272 $chname_encoded = $q->url_encode( $line->[4] );
273 $line->[5] = 'タイトルなし' if ( !$line->[5] );
274 my $unix_6 = str2datetime( $line->[6] );
275 my $unix_7 = str2datetime( $line->[7] );
277 my $btime = $unix_6->strftime( '%Y%m%d%H%M%S' );
278 my $etime = $unix_7->strftime( '%Y%m%d%H%M%S' );
279 if ( $extra and $line->[1] =~ /^search_|^reserve_/ ) {
280 my @ary = $dbh->selectrow_array(
281 "SELECT title, exp FROM epg_timeline
282 WHERE channel = '$line->[3]'
284 AND stop = '$etime' ");
289 if ( $ary[0] ne $line->[5] ) {
290 my $count = $ary[0] =~ s/\Q$line->[5]\E//;
292 my $href = qq {<a href="rectool.pl?mode=edit&id=$line->[0]&suggest=auto">自動検索</a>};
293 $ary[0] = qq {<span style="color: #FF4000">$ary[0]■$href■</span>};
300 $line->[11] = qq {<div style="float: right; cursor: help" title="$ary[1]">$ary[0]</div>};
303 my $href = qq {<a href="rectool.pl?mode=edit&id=$line->[0]&suggest=auto">自動検索</a>};
304 $line->[11] = qq {<span style="float: right; color: #FF0000">■$href■</span>};
308 my ( $begin, $end, $diff ) = &str2readable( $unix_6, $unix_7 );
312 $line->[1] eq 'reserve_running'
314 $unix_6->epoch <= time && time <= $unix_7->epoch
317 $percent = int( ( 100 * ( time - $unix_6->epoch ) ) / ( $unix_7->epoch - $unix_6->epoch ) );
318 $hr .= qq {<hr style="margin: 0 auto 0 0; height: 4px; width: $percent%;};
319 $hr .= qq { background-color: blue; border: none" title="$percent%">};
322 $line->[5] = qq {<a href="rectool.pl?mode=edit&id=$line->[0]">$line->[5]</a>};
323 # $line->[5] = qq {<div style="float: left">$line->[5]</div>} if ( $line->[11] );
324 $HTML .= qq {<tr align="center">\n};
325 $HTML .= qq {<td><input type="checkbox" name="id" value="$line->[0]"></td>\n};
326 $HTML .= qq {<td>$line->[0]</td>\n};
327 $HTML .= qq {<td>$type</td>\n};
328 $HTML .= qq {<td><a href="rectool.pl?mode=program&chtxt=$line->[2]">$line->[2]</a></td>\n};
329 $HTML .= qq {<td align="left" style="white-space: normal">$line->[5]$line->[11]</td>\n};
330 $HTML .= qq {<td>$begin</td>\n<td>$end</td>\n};
331 $HTML .= qq {<td>$hr$diff</td>\n};
332 $HTML .= qq {<td>$line->[8]</td>\n<td>$line->[9]</td>\n<td>$line->[10]</td>\n};
333 $HTML .= qq {</tr>\n};
335 $HTML .= qq {</table>\n};
336 # $HTML .= qq {<input type="submit" name="edit" value="編集(要JS)">\n};
337 $HTML .= qq {<input type="submit" name="delete" value="削除">\n</div>\n</form>\n};
341 if ( $mode eq 'graph' ) {
343 my $date = $q->param( 'date' );
347 print "Content-Type: image/svg+xml\n\n";
350 $date = Date::Simple->new( split /-/, $date );
351 $graph_bgn = $date->format('%Y-%m-%d');
352 $graph_end = $date->next->format('%Y-%m-%d');
354 $today = $date eq Date::Simple->today() ? 1 : 0;
356 $tuner{terrestrial} = 2; #$cfg->param( 'env.te_max' );
357 $tuner{satellite} = 4; #$cfg->param( 'env.bscs_max' );
358 $tuner{all} = $tuner{terrestrial} + $tuner{satellite};
360 $width = 30 * $hours;
362 $svg = new SVG( width => 820, height => $tuner{all} * 20 + 40 );
363 $svg->rectangle( 'x' => 40, 'y' => 20,
364 width => $width + 20, height => $tuner{all} * 20 + 10,
366 style => { stroke => 'blue', fill => 'white' } );
367 for ( 1..$tuner{terrestrial} ) {
368 $svg->text( 'x' => 10, 'y' => ( $_ + 1 ) * 20 )
371 for ( 1..$tuner{satellite} ) {
372 $svg->text( 'x' => 10, 'y' => ( $_ + $tuner{terrestrial} + 1 ) * 20 )
376 $svg->text( 'x' => $_ * 30 + 65, 'y' => 15,
377 style => { 'text-anchor' => 'middle' } )
378 ->cdata( sprintf( '%02d', $_ ) ) if ( $_ < $hours );
379 # $svg->line( ); # can't be used when required
380 $svg->tag( 'line', x1 => $_ * 30 + 50, x2 => $_ * 30 + 50, y1 => 30, y2 => $tuner{all} * 20 + 20,
381 style => { stroke => 'gray' } );
383 for ( 1..$tuner{all} ) {
384 $svg->rectangle( 'x' => 50, 'y' => $_ * 20 + 10, width => $width, height => 10 );
387 require Time::Simple;
388 my $time = Time::Simple->new();
389 my $x = ( $time->hours * 60 + $time->minutes ) * 0.5 + 50;
390 $svg->tag( 'line', x1 => $x, x2 => $x, y1 => 30, y2 => $tuner{all} * 20 + 20,
391 style => { stroke => 'red', 'fill-opacity' => '1.0' } );
393 foreach my $bctype ( 'te%', '_s%' ) {
394 my $tuner = $bctype eq 'te%' ? $tuner{terrestrial} : $tuner{satellite};
395 my $ary_ref = $dbh->selectall_arrayref(
396 "SELECT id, type, timeline.chtxt, title, btime, etime, opt FROM timeline
397 INNER JOIN epg_ch ON timeline.chtxt = epg_ch.chtxt
398 WHERE epg_ch.bctype LIKE '$bctype'
399 AND type IN $type_user_made
402 '$graph_bgn 00:00' <= btime AND btime < '$graph_end 00:00'
404 '$graph_bgn 00:00' < etime AND etime <= '$graph_end 00:00'
408 foreach my $line ( @{ $ary_ref } ) {
409 @start = $line->[4] =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2})/;
410 @stop = $line->[5] =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2})/;
411 $start = ( ( $day == $start[2] ? 0 : 24 * 60 ) + $start[3] * 60 + $start[4] ) * 0.5;
412 $stop = ( ( $day == $stop [2] ? 0 : 24 * 60 ) + $stop [3] * 60 + $stop [4] ) * 0.5;
413 $start = 0 if ( $start < 0 || $day > $start[2] ); # 月の変わり目はスルー
414 $stop = $width if ( $stop > $width );
418 my $ary = $dbh->selectall_arrayref(
419 "SELECT id, type, timeline.chtxt, title, btime, etime, opt FROM timeline
420 INNER JOIN epg_ch ON timeline.chtxt = epg_ch.chtxt
421 WHERE epg_ch.bctype LIKE '$bctype'
422 AND type IN $type_user_made
425 ( etime <= '$begin' )
432 for ( 0..$tuner - 1 ) {
436 $f = 0 if ( $line->[$_] ne $ary[$i]->[$_] );
442 my ( $r, $g, $b ) = ( 0, 0, 0 );
443 $r += 255 if ( $line->[6] =~ /a/ );
444 $g += 255 if ( $line->[6] =~ /H/ );
445 $b += 255 if ( $line->[6] =~ /2/ );
446 if ( $r + $g + $b == 255 * 3 ){
451 if ( $r + $g + $b == 0 ){
454 my %escaped = ( '&' => 'amp', '<' => 'lt', '>' => 'gt', '"' => 'quot' );
456 my $str = shift or return;
458 $result .= $escaped{$_} ? '&' . $escaped{$_} . ';' : $_
459 for (split //, $str);
463 -href => "rectool.pl?mode=edit&id=$line->[0]",
465 -title => html_escape( $line->[3] ),
468 'y' => 30 + ( $bctype eq 'te%' ? 0 : $tuner{terrestrial} * 20 ) + $slot * 20,
469 width => $stop - $start,
471 style => { fill => "rgb($r,$g,$b)" } );
479 $HTML =~ s/%HTML_TITLE_OPT%/ - Schedule Viewer - Graphical/;
480 $HTML .= qq {<div style="float: left">\n};
481 # $base64 = encode_base64( $svg->xmlify );
482 # $HTML .= qq {<object data="data:image/svg+xml;base64,$base64">\n</object>\n};
483 $HTML .= qq {予約状況一覧です。T1,T2は地上波、S1,S2はBS/CS、赤はアニメ、緑はHD、青は2 passを示しています。<br>\n};
484 $HTML .= qq {SVGが利用可能なブラウザでご覧ください。<br>\n};
486 $ary_ref = $dbh->selectcol_arrayref(
487 "SELECT DISTINCT DATE( btime )
489 WHERE type in $type_user_made
492 foreach my $date ( @{ $ary_ref } ) {
493 my @date = $date =~ /(.{4})-(.{2})-(.{2})/;
494 my $dn = DateTime->new( year => $date[0], month => $date[1], day => $date[2], locale => 'ja_JP' )->day_name;
496 $HTML .= qq {$date[1]/$date[2]($dn)の予約状況<br>\n};
497 $HTML .= qq {<object type="image/svg+xml" data="rectool.pl?mode=graph&date=$date" width="820">\n};
498 $HTML .= qq {SVG Image $date\n</object>\n<br>\n};
500 $date2 = Date::Simple->new( @date )->next->format('%Y-%m-%d');
501 my $ary_ref = $dbh->selectall_arrayref(
502 "SELECT chtxt, title, btime, etime FROM timeline
503 WHERE '$date 00:00' <= btime AND etime <= '$date2 01:00'
507 foreach my $line ( @{ $ary_ref } ) {
508 # $HTML .= qq {$line->[0] $line->[1] $line->[2] $line->[3]<br>\n};
517 if ( $mode eq 'atom' ) {
518 require XML::Atom::Feed;
519 require XML::Atom::Entry;
521 my $recording_count = $encoding_count = $jbk_count = 0;
522 my $ary_ref = $dbh->selectall_arrayref(
523 "SELECT chtxt, title, btime, etime, opt
525 WHERE type = 'reserve_running' ");
526 foreach my $line ( @{$ary_ref} ) {
527 my ( $begin, $end, $diff ) = &str2readable( $line->[2], $line->[3] );
528 $recording_status .= qq {$line->[0] $line->[1] $begin - $end $diff $line->[4]<br />\n};
531 $ary_ref = $dbh->selectall_arrayref(
532 "SELECT chtxt, title, btime, etime, opt
534 WHERE type = 'convert_ts_mp4_running' ");
535 foreach my $line ( @{$ary_ref} ) {
536 my ( $begin, $end, $diff ) = &str2readable( $line->[2], $line->[3] );
537 $encoding_status .= qq {$line->[0] $line->[1] $begin - $end $diff $line->[4]<br />\n};
540 $ary_ref = $dbh->selectall_arrayref(
541 "SELECT id, chtxt, title, btime, etime
542 FROM auto_timeline_keyword " );
543 foreach my $line ( @{$ary_ref} ) {
544 my ( $begin, $end, $diff ) = &str2readable( $line->[3], $line->[4] );
545 $jbk_status .= qq {$line->[0] $line->[1] $line->[2] $begin - $end $diff<br />\n};
549 my $feed = XML::Atom::Feed->new( Version => 1.0 );
550 $feed->title('Rec10 フィード');
552 my $entry = XML::Atom::Entry->new( Version => 1.0 );
553 $entry->title("Rec10 録画状況 ($recording_count)");
554 $entry->id('tag:recording_status');
555 $entry->content($recording_status);
556 $entry->add_link(str_to_link( './rectool.pl?mode=schedule' ) );
557 $feed->add_entry($entry);
559 $entry = XML::Atom::Entry->new( Version => 1.0 );
560 $entry->title("Rec10 縁故状況 ($encoding_count)");
561 $entry->id('tag:encoding_status');
562 $entry->content($encoding_status);
563 $entry->add_link(str_to_link( './rectool.pl?mode=schedule' ) );
564 $feed->add_entry($entry);
566 $entry = XML::Atom::Entry->new( Version => 1.0 );
567 $entry->title("Rec10 地引状況 ($jbk_count)");
568 $entry->id('tag:jbk_status');
569 $entry->content($jbk_status);
570 $entry->add_link(str_to_link( './rectool.pl?mode=jbk' ) );
571 $feed->add_entry($entry);
573 my $xml = $feed->as_xml;
574 print "Content-Type: application/atom+xml\n\n";
579 my $link = XML::Atom::Link->new( Version => 1.0 );
580 $link->type('text/html');
581 $link->rel('alternate');
587 if ( $mode eq 'edit' ) {
588 my $id = $q->param( 'id' );
590 $HTML =~ s/%HTML_TITLE_OPT%/ - Schedule Editor/;
591 $HTML .= qq {<div style="float: left">\n};
594 <script type="text/javascript" src="http://www.enjoyxstudy.com/javascript/dateformat/dateformat.js">
596 <script type="text/javascript">
597 function setType(value){
598 var index = document.reserve.type.selectedIndex;
599 var value = document.reserve.type[index].value;
600 if ( value == 'search_everyday' ) {
601 document.reserve.deltaday.value = 7;
602 document.reserve.deltatime.value = 3;
604 if ( value == 'convert_b25_ts' || value == 'convert_ts_mp4' ){
605 var date = new Date();
606 var dateFormat = new DateFormat("yyyy-MM-dd HH:mm:ss");
607 var minutes = date.getMinutes();
608 minutes = minutes - minutes % 5 + 10;
609 date.setMinutes(minutes, 0, 0);
610 document.reserve.begin.value = dateFormat.format(date);
611 date.setSeconds( date.getSeconds() + 3600 );
612 document.reserve.end.value = dateFormat.format(date);
615 function setSuggest(start, stop){
616 document.reserve.begin.value = start;
617 document.reserve.end.value = stop;
619 function shiftEndTime(value){
620 var dateFormat = new DateFormat("yyyy-MM-dd HH:mm:ss");
621 var date = dateFormat.parse(document.reserve.end.value || document.reserve.begin.value);
622 date.setSeconds( date.getSeconds() + value );
623 document.reserve.end.value = dateFormat.format(date);
627 $script =~ s/^\t{2}//gm;
628 $HTML =~ s/%SCRIPT%/$script/;
630 $HTML .= "スケジュール編集画面です。<br>\n";
631 $HTML .= "実装がとても適当なので、利用には細心の注意を払ってください。<br>\n<br>\n";
634 $button_bgn = $button_end = '';
637 $type = 'reserve_flexible';
638 $datetime_now = DateTime->now( time_zone => $tz )->set_second( 0 )->add( minutes => 1)->strftime( '%Y-%m-%d %H:%M:%S' );
639 $button_bgn = qq{<button type="button" onClick="document.reserve.begin.value='$datetime_now'">現在</button>\n<br>\n};
641 qq{<button type="button" onClick="document.reserve.end.value=document.reserve.begin.value">一致</button>}
642 .qq{<button type="button" onClick="shiftEndTime(300);">+5m</button>}
643 .qq{<button type="button" onClick="shiftEndTime(1800);">+30m</button>};
646 if ( $q->param( 'suggest' ) eq 'auto' ) {
647 my @btime = $begin =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/;
648 my @etime = $end =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/;
649 my $btime = DateTime->new(
650 year => $btime[0], month => $btime[1], day => $btime[2],
651 hour => $btime[3], minute => $btime[4], second => $btime[5],
653 my $etime = DateTime->new(
654 year => $etime[0], month => $etime[1], day => $etime[2],
655 hour => $etime[3], minute => $etime[4], second => $etime[5],
657 my %hash = &sqlgetsuggested( $btime, $etime );
659 $HTML .= qq {可能性のある番組<br>\n};
660 $HTML .= qq {<table summary="suggesttable" border=1 cellspacing=0>\n<tr>\n};
661 $HTML .= qq {<th>優先度</th>\n};
662 $HTML .= qq {<th>タイトル</th>\n};
663 $HTML .= qq {<th>開始時刻</th>\n};
664 $HTML .= qq {<th>終了時刻</th>\n};
665 $HTML .= qq {<th>説明</th>\n};
666 $HTML .= qq {<th>適用</th>\n};
667 $HTML .= qq {</tr>\n};
669 foreach my $key (sort keys %hash){
670 my $val = $hash{$key};
671 foreach my $val ( @{$val} ) {
672 my $style = qq {style="white-space: nowrap"};
673 $val->[0] =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/;
674 $val->[1] =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/;
675 $HTML .= qq {<tr>\n<td>$key</td>\n<td>$val->[2]</td>\n};
676 $HTML .= qq {<td $style>$val->[0]</td>\n<td $style>$val->[1]</td>\n<td>$val->[3]</td>\n};
677 $HTML .= qq {<td><button onClick="setSuggest('$val->[0]','$val->[1]');">適用</button></td>\n</tr>\n};
680 $HTML .= qq {</table>\n<br>\n};
683 my $len = length $id;
684 $HTML .= qq {<form method="get" action="rectool.pl" name="reserve">\n};
685 $HTML .= qq {<input type="hidden" name="mode" value="change">\n};
686 $HTML .= qq {<input type="hidden" name="mode_sub" value="update">\n};
687 $HTML .= qq {<input type="hidden" name="id" value="$id">\n};
688 $HTML .= qq {ID\n<input type="text" name="id" value="$id" size=$len disabled>\n};
689 $HTML .= qq {タイプ\n<select name="type" onChange="setType();">\n};
690 foreach my $key ( keys %type ) {
691 next if ( $key !~ /^search|^reserve_flexible$|^reserve_fixed$|^convert_b25_ts$|^convert_ts_mp4$|^$type$/ );
692 $value = $type{$key};
693 if ( $key eq $type ) {
694 $HTML .= qq {<option value="$key" selected>$value</option>\n};
697 $HTML .= qq {<option value="$key">$value</option>\n};
700 $HTML .= qq {</select>\n};
701 $HTML .= qq {チャンネル\n<select name="chtxt">\n};
702 $ary_ref = $dbh->selectall_arrayref(
703 "SELECT chtxt, chname FROM epg_ch"
705 foreach my $line ( @{$ary_ref} ) {
706 if ( $line->[0] eq $chtxt ) {
707 $HTML .= qq {<option value="$line->[0]" selected>$line->[1]</option>\n};
710 $HTML .= qq {<option value="$line->[0]">$line->[1]</option>\n};
713 $HTML .= qq {</select><br>\n};
714 $HTML .= qq {タイトル\n<input type="text" name="title" value="$title" size=64><br>\n};
715 $HTML .= qq {開始時刻\n<input type="text" name="begin" value="$begin" maxlength=19 size=24>\n};
716 $HTML .= $button_bgn;
717 $HTML .= qq {終了時刻\n<input type="text" name="end" value="$end" maxlength=19 size=24>\n};
718 $HTML .= $button_end . "<br>\n";
719 $HTML .= qq {隔日周期\n<input type="text" name="deltaday" value="$deltaday" maxlength=2 size=2 >\n};
720 $HTML .= qq {時刻誤差\n<input type="text" name="deltatime" value="$deltatime" maxlength=2 size=2 >\n};
721 $HTML .= qq {オプション\n<input type="text" name="opt" value="$opt">\n};
722 $HTML .= qq {<input type="submit" name="update" value="更新">\n</form>\n};
725 if ( $mode eq 'change' ) {
726 @id = $q->param( 'id' );
728 $HTML =~ s/%HTML_TITLE_OPT%/ - Change/;
729 $HTML .= qq {<div style="float: left">\n};
731 if ( $q->param( 'delete' ) )
734 foreach my $id ( @id ) {
735 $dbh->do( "DELETE FROM timeline WHERE id = '$id'" );
737 $HTML .= "削除しました。<br>\n5秒後に予約確認画面に移動します。<br>\n";
738 $HTML =~ s|%REFRESH%|<meta http-equiv="refresh" content="5; url=rectool.pl?mode=schedule">|;
742 if ( $q->param( 'update' ) )
744 $type = $q->param( 'type' );
745 $chtxt = $q->param( 'chtxt' );
746 $title = $q->param( 'title' );
747 $begin = $q->param( 'begin' );
748 $end = $q->param( 'end' );
749 $deltaday = $q->param( 'deltaday' );
750 $deltatime = $q->param( 'deltatime' );
751 $opt = $q->param( 'opt' );
755 "UPDATE timeline SET type = '$type', chtxt = '$chtxt', title = '$title',
756 btime = '$begin', etime = '$end',
757 deltaday = '$deltaday', deltatime = '$deltatime', opt = '$opt'
763 "INSERT INTO timeline ( type, chtxt, title, btime, etime, deltaday, deltatime, opt )
764 VALUES ( '$type', '$chtxt', '$title', '$begin', '$end', '$deltaday', '$deltatime', '$opt' )"
767 $HTML .= "更新しました。<br>\n5秒後に予約確認画面に移動します。<br>\n";
768 $HTML =~ s|%REFRESH%|<meta http-equiv="refresh" content="5; url=rectool.pl?mode=schedule">|;
771 if ( $mode_sub eq 'proc' ) {
772 my $type = $q->param( 'type' );
773 my $chtxt = $q->param( 'chtxt' ) || 'nhk-k';
774 my $title = $q->param( 'title' );
775 my @opt = $q->param( 'opt' );
776 my $opt = join '', @opt;
778 my $datetime_now = DateTime->now( time_zone => $tz )->set_second( 0 )->add( minutes => 10);
779 my $sql_type = $type_suggest{$type};
780 my $begin = $datetime_now->strftime( '%Y-%m-%d %H:%M:%S' );
781 $datetime_now = $datetime_now->add( minutes => 60 );
782 my $end = $datetime_now->strftime( '%Y-%m-%d %H:%M:%S' );
785 "INSERT INTO timeline ( type, chtxt, title, btime, etime, opt )
786 VALUES ( '$sql_type', '$chtxt', '$title', '$begin', '$end', '$opt' )"
791 if ( $mode_sub eq 'move' ) {
792 my $mode_sub2 = $q->param( 'mode_sub2' );
793 my $title = $q->param( 'title' );
795 $ENV{'LANG'} = 'ja_JP.UTF-8';
796 if ( $mode_sub2 eq 'predict' ) {
797 $HTML .= "移動後のシミュレーション結果です。\n<br>";
798 eval '$HTML .= `python26 ' . $cfg->param( 'path.rec10' ) . "/classify.py -s '$title'`";
800 elsif ( $mode_sub2 eq 'exec' ) {
801 eval '$HTML .= `python26 ' . $cfg->param( 'path.rec10' ) . "/classify.py -e '$title'`";
806 if ( $mode_sub eq 'setting' ) {
807 my $jbk = $q->param( 'jbk' ) || '0';
808 my $bayes = $q->param( 'bayes' ) || '0';
809 my $del_tmp = $q->param( 'del_tmp' ) || '0';
810 my $opt = $q->param( 'opt' ) || '';
811 my $user = $q->param( 'user' ) || '';
812 my $pass = $q->param( 'pass' ) || '';
815 "INSERT INTO in_settings ( auto_jbk, auto_bayes, auto_del_tmp, auto_opt )
816 VALUES ( '$jbk', '$bayes', '$del_tmp', '$opt' )"
824 if ( $mode eq 'confirm' ) {
825 if ( $mode_sub eq 'reserve' ) {
826 $HTML =~ s/%HTML_TITLE_OPT%/ - Reserver/;
827 $HTML .= qq {<div style="float: left">\n};
830 my $duration = ( str2datetime( $end ) - str2datetime( $begin ) )->delta_minutes;
831 $title = $q->param( 'title' ) if ( !$title );
832 $HTML .= "番組名:$title<br>\nチャンネル:$chname<br>\n放送継続時間:$duration分<br>\n番組内容:$desc<br>\n";
834 $longdesc =~ s/\\n/<br>\n/gs;
835 $HTML .= "番組内容(長):$longdesc<br>\n";
837 my $error = &check_error();
842 $ary_ref = $dbh->selectall_arrayref(
843 "SELECT start, stop FROM epg_timeline WHERE channel = '$ontv' AND title = '$title' "
846 $HTML .= "同一の番組の他の放送予定です。<br>\n";
847 foreach my $line ( @{$ary_ref} ) {
850 $begin =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/;
851 $end =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/;
852 $overlap = &get_overlap() >= 2 ? '不可能' :
853 qq {<a href="rectool.pl?mode=confirm&mode_sub=reserve&chtxt=$chtxt&start=$line->[0]&stop=$line->[1]">可能</a>};
854 $HTML .= "開始:$begin\n終了:$end\n録画は$overlap<br>\n";
859 $HTML .= "録画予約の詳細設定を行ってください。<br>\n";
860 $HTML .= qq {<form method="get" action="rectool.pl">\n};
861 $HTML .= qq {<input type="hidden" name="mode" value="reserve">\n};
862 $HTML .= qq {<input type="hidden" name="chname" value="$chname">\n};
863 $HTML .= qq {<input type="hidden" name="start" value="$start">\n};
864 $HTML .= qq {<input type="hidden" name="stop" value="$stop">\n};
865 $HTML .= qq {<input type="hidden" name="title" value="$title">\n} if ( $q->param( 'title' ) );
866 &draw_form_opt( 'reserve' );
867 $HTML .= qq {<input type="submit" value="予約">\n</form>\n};
871 # End of $mode_sub eq 'reserve';
873 if ( $mode_sub eq 'proc' ) {
874 my $type = $q->param( 'type' );
875 local $chtxt = $q->param( 'chtxt' );
876 my $title = $q->param( 'title' );
877 local $opt = $q->param( 'opt' );
879 $HTML .= "詳細設定を行ってください。<br>\n";
880 $HTML .= "タイトル:$title\n<br>\n";
882 $HTML .= qq {<form method="get" action="rectool.pl">\n};
883 $HTML .= qq {<input type="hidden" name="mode" value="change">\n};
884 $HTML .= qq {<input type="hidden" name="mode_sub" value="proc">\n};
885 $HTML .= qq {<input type="hidden" name="type" value="$type">\n};
886 $HTML .= qq {<input type="hidden" name="title" value="$title">\n};
887 &draw_form_channel( 'nonone' );
889 $HTML .= qq {<input type="submit" value="予約">\n</form>\n};
894 if ( $mode eq 'reserve' ) {
895 $HTML .= qq {<div style="float: left">\n};
897 $title = $q->param( 'title' ) if ( !$title );
898 @opt = $q->param( 'opt' );
899 $opt = join '', @opt;
900 my ( $deltaday, $deltatime );
902 if ( $q->param('every') eq '1' ) {
903 $type = 'search_everyday';
904 ( $changed_t ) = $title =~ /(.*)#/;
905 $title = $changed_t if ( $changed_t );
906 ( $changed_t ) = $title =~ /(.*)第/;
907 $title = $changed_t if ( $changed_t );
908 ( $changed_t ) = $title =~ /(.*)▽/;
909 $title = $changed_t if ( $changed_t );
919 $type = 'reserve_flexible';
921 if ( !&check_error ) {
923 "INSERT INTO timeline ( type, chtxt, title, btime, etime, opt, deltaday, deltatime )
924 VALUES ( '$type', '$chtxt', '$title', '$begin', '$end', '$opt', '$deltaday', '$deltatime' )"
927 $HTML .= "録画予約を実行しました。<br>\n5秒後にトップへ移動します。<br>\n";
928 $HTML =~ s|%REFRESH%|<meta http-equiv="refresh" content="5; url=rectool.pl">|;
932 if ( $mode eq 'program' ) {
935 $HTML =~ s/%HTML_TITLE_OPT%/ - Program Viewer/;
936 $unix = DateTime->now( time_zone => $tz )->strftime( '%Y%m%d%H%M%S' );
938 "SELECT channel, chtxt, chname, start, stop, title, category
940 INNER JOIN epg_ch ON epg_timeline.channel = epg_ch.ontv
941 WHERE $unix <= stop %CH% %DATE% %CATEGORY% %KEY% ORDER BY start";
944 my $ch = "AND channel = '$ontv'";
948 $date_1 = $date_sel . '000000';
949 $date_2 = Date::Simple->new( $date_sel =~ /(.{4})(.{2})(.{2})/ )->next->format('%Y%m%d') . '000000';
950 my $date = "AND '$date_1' <= stop AND start <= '$date_2'";
951 $sql =~ s/%DATE%/$date/;
953 if ( $category_sel ) {
955 # $category_tmp = $category{$category_sel} . $category_sel;
956 my $category = "AND category = '$category{$category_sel}'";
957 $sql =~ s/%CATEGORY%/$category/;
960 my $key = "AND TITLE LIKE '%$key%'";
961 $sql =~ s/%KEY%/$key/;
966 $sql =~ s/%CATEGORY%//;
968 $ary_ref = $dbh->selectall_arrayref( $sql );
969 foreach my $prg ( @{ $ary_ref } ) {
970 my @date = $prg->[3] =~ /(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/;
973 if ( $date != $prev ) {
974 my $date = DateTime->new(
975 year => $date[0], month => $date[1], day => $date[2],
979 my $dn = $date->day_name;
981 $HTML .= qq {--------$date[1]/$date[2]($dn)--------<br>\n};
983 $HTML .= qq {$date[1]/$date[2] $date[3]:$date[4] };
984 $HTML .= qq {$prg->[2] } if ( !$ontv );
985 $HTML .= qq {<a href="rectool.pl?mode=confirm&mode_sub=reserve&chtxt=$prg->[1]&start=$prg->[3]&stop=$prg->[4]">$prg->[5]</a><br>\n};
991 if ( $mode eq 'list' ) {
992 $HTML =~ s/%HTML_TITLE_OPT%/ - List/;
993 $HTML .= qq {<div>\n};
995 my $recording = $cfg->param( 'path.recpath' );
996 my $recorded = $cfg->param( 'path.recorded' );
998 if ( $mode_sub eq 'log' ) {
999 my $title = $q->param( 'title' );
1000 my $log = slurp( "$recording/$title.log" ) if ( -e "$recording/$title.log" );
1001 $HTML .= '<pre>'.$log."</pre>\n";
1005 $HTML .= qq {<a href="rectool.pl?mode=list&mode_sub=new">録画中のみ</a>\n};
1006 $HTML .= qq {<a href="rectool.pl?mode=list&mode_sub=old">録画後のみ</a>\n<br>\n};
1008 if ( !$mode_sub || $mode_sub eq 'new' ) {
1009 $HTML .= "録画中のファイル一覧<br>\n";
1010 &list( $recording );
1015 if ( !$mode_sub || $mode_sub eq 'old' ) {
1016 $HTML .= "録画後のファイル一覧<br>\n";
1017 &simple_list( $recorded );
1021 local $path = shift;
1023 my @exp = ( 'log', 'ts.b25', 'ts.tsmix', 'ts', 'ts.log.mbtree', 'ts.log',
1024 'sa.avi', 'sa.avi.log', 'aac', 'srt', 'm2v', 'wav', 'avi', '264', 'mp4', 'mkv' );
1026 $exp{$exp[$_]} = $_;
1028 my $exp_count = scalar keys %exp;
1030 &get_file_list_wrapper( $path, \&wanted );
1033 foreach my $name ( sort { $exp{$a} <=> $exp{$b} } keys %exp ) {
1034 $help .= $exp{$name} + 1 . " = $name / ";
1037 $help = qq {<tr style="background-color: #87CEEB"><td rowspan="2">$help\n</td>\n};
1038 $help .= qq {<td>$_</td>\n} for ( 1..$exp_count );
1039 $help .= qq {<td colspan="2">自動移動</td>\n</tr>\n};
1040 $help .= qq {<tr>\n</tr>\n};
1042 $HTML .= qq {<br>\n○ = 完了 / ● = 書き込み中 / ◆ = ファイルサイズ異常<br>\n};
1043 $HTML .= qq {<table summary="listtable" border=1 cellspacing=0>\n<tr>\n};
1044 $HTML .= qq {<th>タイトル</th>\n};
1045 $HTML .= qq {<th>$_</th>\n} for ( 1..$exp_count );
1046 $HTML .= qq {<th colspan="2">自動移動</th>\n};
1047 $HTML .= qq {</tr>\n};
1051 foreach my $title ( sort keys %list ) {
1052 my $value = $list{$title};
1053 my @flag = ( 0 ) x ( $exp_count );
1054 $HTML .= qq {<tr>\n<td width="600" style="width: 600px; white-space: normal">$title</td>\n};
1055 foreach my $exp ( keys %{$value} ) {
1056 if ( $exp eq 'log' ) {
1057 my $title = $q->url_encode( $title );
1058 my $check = qq {<td><a href="rectool.pl?mode=list&mode_sub=log&title=$title">○</a></td>\n};
1060 $value->{$exp}->{check} = $check;
1062 elsif ( $exp eq 'mkv' ) {
1063 my $title = $q->url_encode( $title );
1065 my $check = qq {<td><a title="$value->{$exp}->{size}" href="rectool.pl?mode=thumb&title=$title">■</a></td>\n};
1066 $value->{$exp}->{check} = $check;
1068 $flag[$exp{$exp}] = $value->{$exp};
1070 if ( !$flag[$exp{'mkv'}] ) {
1071 $flag[@flag]->{check} = qq {<td colspan="2"><br></td>\n};
1074 my $title = $q->url_encode( $title );
1076 $flag[@flag]->{check} =
1077 qq {<td><a href="rectool.pl?mode=change&mode_sub=move&mode_sub2=predict&title=$title">予測</a></td>\n}.
1078 qq {<td><a href="rectool.pl?mode=change&mode_sub=move&mode_sub2=exec&title=$title">実行</a></td>\n};
1081 my $size = $_->{size};
1082 my $last = $_->{last} || ( $_->{size} eq '0 B' ? '◆' : '○' );
1083 my $check = $size ? qq {<span title="$size">$last</span>} : '<br>';
1084 $HTML .= $_->{check} ? $_->{check} : qq {<td>$check</td>\n};
1086 $HTML .= qq {</tr>\n};
1087 $HTML .= $help unless ( ++$count % 20 );
1089 $HTML .= qq {</table>\n};
1095 return if ( $rel =~ /Thumbs\.db/ );
1096 return if ( $rel =~ /\.idx/ );
1098 $rel =~ s/\.temp$//;
1099 my $regexp = join '|', keys %exp;
1100 my ( $title, $exp ) = $rel =~ /(.*?)\.($regexp)$/;
1101 my ( $size, $last ) = &get_size( $abs );
1102 $rel =~ s/\.temp$//;
1104 $title = '_error_exp_'.$rel;
1107 if ( $title !~ /[^0-9A-F]+/ ) {
1108 my $tmp = pack( 'H*', $title );
1110 $title = '_error_b16_'.$rel;
1114 $title = 'Base16_'.$tmp;
1117 $list{$title}->{$exp} = { 'last' => $last, 'size' => $size };
1124 local $path = shift;
1127 &get_file_list_wrapper( $path, \&simple_wanted );
1129 # @list = sort @list;
1131 @list = map( Encode::decode_utf8( $_ ), @list );
1132 @list = nsort @list;
1133 @list = map( Encode::encode_utf8( $_ ), @list );
1136 $HTML .= "$_<br>\n";
1143 my ( $size ) = &get_size( $abs );
1144 push @list, $rel ."\t\t". $size;
1150 my ( $size, $last ) = (stat( $file ))[7,9];
1151 my @unim = ("B","KiB","MiB","GiB","TiB","PiB");
1154 while($size >= 1024 ){
1156 $size = $size / 1024;
1159 $size = int( $size );
1161 if ( time - $last < 10 ) {
1167 return ( "$size $unim[$count]", $last );
1171 if ( $mode eq 'thumb' ) {
1172 my $title = $q->param( 'title' );
1173 my $pos = $q->param( 'pos' );
1174 my $recording = $cfg->param( 'path.recpath' );
1176 print "Content-Type: image/jpeg\n\n";
1177 exec "ffmpeg -ss 300 -i '$recording/$title.mkv' -f image2 -pix_fmt jpg -vframes 1 -s 320x240 -";
1181 if ( $mode eq 'check' ) {
1184 if ( $mode eq 'bravia' ) {
1185 $HTML =~ s/%HTML_TITLE_OPT%/ - Bravia/;
1186 $HTML .= qq {<div>\n};
1187 $HTML .= qq {<form method="get" action="rectool.pl">\n};
1188 $HTML .= qq {<div>\n};
1189 $HTML .= qq {<table summary="bayestable" border=1 cellspacing=0>\n<tr>\n};
1190 $HTML .= qq {<th>ID</th>\n};
1191 $HTML .= qq {<th>チャンネル</th>\n};
1192 $HTML .= qq {<th>タイトル</th>\n};
1193 $HTML .= qq {<th><a href="rectool.pl?mode=bravia">開始時刻</a></th>\n};
1194 $HTML .= qq {<th>終了時刻</th>\n};
1195 $HTML .= qq {<th>録画時間</th>\n};
1196 $HTML .= qq {<th><a href="rectool.pl?mode=bravia&order=point">ポイント</a></th>\n};
1197 $HTML .= qq {<th>予約</th>\n};
1198 $HTML .= qq {</tr>\n};
1200 my $order = $q->param( 'order' );
1201 if ( $order ne 'point' ) {
1205 $order = 'point DESC';
1207 my $ary_ref = $dbh->selectall_arrayref(
1208 "SELECT id, chtxt, title, btime, etime, point
1209 FROM auto_timeline_bayes
1212 foreach my $line ( @{ $ary_ref } ) {
1213 my ( $begin, $end, $diff ) = &str2readable( $line->[3], $line->[4] );
1215 $HTML .= qq {<tr align="center">\n};
1216 $HTML .= qq {<td>$line->[0]</td>\n};
1217 $HTML .= qq {<td>$line->[1]</td>\n};
1218 $HTML .= qq {<td>$line->[2]</td>\n};
1219 $HTML .= qq {<td>$begin</td>\n<td>$end</td>\n<td>$diff</td>\n};
1220 $HTML .= qq {<td>$line->[5]</td>\n};
1221 $HTML .= qq {<td><a href="rectool.pl?mode=confirm&mode_sub=reserve&bayesid=$line->[0]">予約</a></td>\n};
1222 $HTML .= qq {</tr>\n};
1224 $HTML .= qq {</table>\n};
1225 $HTML .= qq {</div>\n};
1226 $HTML .= qq {</form>\n};
1230 if ( $mode eq 'proc' ) {
1231 $HTML =~ s/%HTML_TITLE_OPT%/ - Proposal/;
1232 $HTML .= qq {<div>\n};
1233 $HTML .= qq {<table summary="proctable" border=1 cellspacing=0>\n<tr>\n};
1234 $HTML .= qq {<th>タイプ</th>\n};
1235 $HTML .= qq {<th>タイトル</th>\n};
1236 $HTML .= qq {<th>予約</th>\n};
1237 $HTML .= qq {</tr>\n};
1239 my $ary_ref = $dbh->selectall_arrayref(
1240 "SELECT type, chtxt, title
1244 foreach my $line ( @{ $ary_ref } ) {
1246 $line->[3] = $q->url_encode( $line->[2] );
1247 my $opt = $dbh->selectrow_array(
1248 "SELECT opt FROM in_timeline_log
1249 WHERE title = '$line->[2]' "
1252 if ( $line->[0] eq 'auto_suggest_dec' ) {
1253 unless ( $dbh->selectrow_array(
1254 "SELECT 1 FROM timeline
1255 WHERE ( type = 'convert_b25_ts' OR type = 'convert_b25_ts_running' )
1256 AND title = '$line->[2]' "
1258 $url = qq {rectool.pl?mode=confirm&mode_sub=proc&type=$line->[0]&chtxt=$line->[1]&title=$line->[3]&opt=$opt};
1261 elsif ( $line->[0] eq 'auto_suggest_enc' ) {
1262 unless ( $dbh->selectrow_array(
1263 "SELECT 1 FROM timeline
1264 WHERE ( type = 'convert_ts_mp4' OR type = 'convert_ts_mp4_running' )
1265 AND title = '$line->[2]' "
1267 $url = qq {rectool.pl?mode=confirm&mode_sub=proc&type=$line->[0]&chtxt=$line->[1]&title=$line->[3]&opt=$opt};
1271 unless ( $dbh->selectrow_array(
1272 "SELECT 1 FROM timeline
1273 WHERE ( type LIKE 'convert_avi%' OR type = 'convert_mkv' )
1274 AND title = '$line->[2]' "
1276 $url = qq {rectool.pl?mode=confirm&mode_sub=proc&type=$line->[0]&chtxt=$line->[1]&title=$line->[3]};
1280 $href = qq {<a href="$url">予約</a>};
1286 my $color = $color{$type_suggest{$line->[0]}} ? $color{$type_suggest{$line->[0]}} : '';
1287 $line->[0] = $type{$line->[0]} ? $type{$line->[0]} : $line->[0];
1288 $line->[0] = qq {<span style="color: $color">$line->[0]</span>} if ( $color );
1289 $HTML .= qq {<tr align="center">\n};
1290 $HTML .= qq {<td>$line->[0]</td>\n};
1291 $HTML .= qq {<td align="left">$line->[2]</td>\n};
1292 $HTML .= qq {<td>$href</td>\n};
1293 $HTML .= qq {</tr>\n};
1296 $HTML .= qq {</table>\n};
1299 if ( $mode eq 'jbk' ) {
1300 $HTML =~ s/%HTML_TITLE_OPT%/ - JBK/;
1301 $HTML .= qq {<div>\n};
1303 if ( $mode_sub eq 'add' ) {
1304 my $keyword = $q->param( 'keyword' );
1305 $HTML .= "キーワード「$keyword」を追加しました。<br>\n";
1307 "INSERT INTO in_auto_jbk_key ( keyword )
1308 VALUES ( '$keyword' )"
1311 elsif ( $mode_sub eq 'del' ) {
1312 my $id = $q->param( 'id' );
1313 my $keyword = $dbh->selectrow_array(
1314 "SELECT keyword FROM in_auto_jbk_key
1315 WHERE id = '$id' " );
1316 $HTML .= "キーワード「$keyword」を削除しました。<br>\n";
1318 "DELETE FROM in_auto_jbk_key WHERE id = '$id'"
1322 $HTML .= qq {<table summary="jbktable" border=1 cellspacing=0>\n<tr>\n};
1323 $HTML .= qq {<th>ID</th>\n};
1324 $HTML .= qq {<th>キーワード</th>\n};
1325 $HTML .= qq {<th>削除</th>\n};
1326 $HTML .= qq {</tr>\n};
1328 my $ary_ref = $dbh->selectall_arrayref(
1330 FROM in_auto_jbk_key
1333 foreach my $line ( @{ $ary_ref } ) {
1334 my $url = "rectool.pl?mode=jbk&mode_sub=del&id=$line->[0]";
1336 $HTML .= qq {<tr align="center">\n};
1337 $HTML .= qq {<td>$line->[0]</td>\n};
1338 $HTML .= qq {<td>$line->[1]</td>\n};
1339 $HTML .= qq {<td><a href="$url">削除</a></td>\n};
1340 $HTML .= qq {</tr>\n};
1343 $HTML .= qq {</table>\n};
1345 $HTML .= qq {<form method="get" action="rectool.pl">\n};
1346 $HTML .= qq {<div>\n};
1347 $HTML .= qq {<input type="hidden" name="mode" value="jbk">\n};
1348 $HTML .= qq {<input type="hidden" name="mode_sub" value="add">\n};
1349 $HTML .= qq {<input name="keyword" type="text">\n};
1350 $HTML .= qq {<input type="submit" value="追加">\n</div>\n</form>\n<br>\n};
1352 $HTML .= qq {<table summary="jbkrestable" border=1 cellspacing=0>\n<tr>\n};
1353 $HTML .= qq {<th>ID</th>\n};
1354 $HTML .= qq {<th>チャンネル</th>\n};
1355 $HTML .= qq {<th>タイトル</th>\n};
1356 $HTML .= qq {<th>開始時刻</th>\n};
1357 $HTML .= qq {<th>終了時刻</th>\n};
1358 $HTML .= qq {<th>録画時間</th>\n};
1359 $HTML .= qq {<th>予約</th>\n};
1360 $HTML .= qq {</tr>\n};
1362 my $ary_ref = $dbh->selectall_arrayref(
1363 "SELECT id, chtxt, title, btime, etime
1364 FROM auto_timeline_keyword " );
1366 foreach my $line ( @{ $ary_ref } ) {
1367 my ( $begin, $end, $diff ) = &str2readable( $line->[3], $line->[4] );
1368 $line->[3] =~ s/(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/$1$2$3$4$5$6/;
1369 $line->[4] =~ s/(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/$1$2$3$4$5$6/;
1370 my $url = qq "rectool.pl?mode=confirm&mode_sub=reserve&chtxt=$line->[1]&start=$line->[3]&stop=$line->[4]";
1372 $HTML .= qq {<tr align="center">\n};
1373 $HTML .= qq {<td>$line->[0]</td>\n};
1374 $HTML .= qq {<td>$line->[1]</td>\n};
1375 $HTML .= qq {<td>$line->[2]</td>\n};
1376 $HTML .= qq {<td>$begin</td>\n};
1377 $HTML .= qq {<td>$end</td>\n};
1378 $HTML .= qq {<td>$diff</td>\n};
1379 $HTML .= qq {<td><a href="$url">予約</a></td>\n};
1380 $HTML .= qq {</tr>\n};
1383 $HTML .= qq {</table>\n};
1387 if ( $mode eq 'recognize' ) {
1388 $HTML =~ s/%HTML_TITLE_OPT%/ - Recognizer/;
1390 my $text = $q->param( 'text' );
1391 $chtxt = $q->param( 'chtxt' );
1392 my $title = $q->param( 'title' );
1394 $HTML .= qq {<div>\n};
1395 $HTML .= qq {与えられた文字列のうち、番組の放送時刻と思われる文字列を認識します。<br>\n};
1396 $HTML .= qq {番組表が取得できない一週間以上先の予約ができます。<br>\n};
1397 $HTML .= qq {<form method="post" action="rectool.pl">\n};
1398 $HTML .= qq {<div>\n};
1399 &draw_form_channel( 'nonone' );
1400 $HTML .= qq {<input type="text" name="title" value="$title">\n};
1401 $HTML .= qq {<br>\n};
1402 $HTML .= qq {<input type="hidden" name="mode" value="recognize">\n};
1403 $HTML .= qq {<textarea name="text" cols=40 rows=4>\n$text</textarea>\n};
1404 $HTML .= qq {<input type="submit" value="実行">\n</div>\n</form>\n};
1407 my ( $year, $month, $day );
1408 my ( $hour, $minute );
1410 foreach ( split /\n/, $text ) {
1411 my @date = /(\d{4}).(\d{1,2}).(\d{1,2})/;
1412 my @time = /(\d{1,2})[::](\d{1,2})/;
1413 s/(\d{4}).(\d{2}).(\d{2})//;
1414 s/(\d{1,2})[::](\d{2})//;
1417 $date[0] = Time::Piece->localtime->year;
1418 ( $date[1], $date[2] ) = /(\d{1,2})月(\d{1,2})日/;
1419 s/(\d{1,2})月(\d{1,2})日//;
1421 next if (!( @date || @time ));
1422 ( $year, $month, $day ) = @date if ( $date[0] && $date[1] && $date[2] );
1423 ( $hour, $minute ) = @time if ( defined $time[0] && defined $time[1] );
1424 $next_day = 1 if ( $_ =~ /深夜/ );
1425 if ( $year && $month && $day && defined $hour && defined $minute ) {
1426 my $tp = Time::Piece->strptime( "$year-$month-$day $hour:$minute", '%Y-%m-%d %H:%M' );
1427 $tp += ONE_DAY if ( $next_day );
1428 my $start = $tp->strftime( '%Y%m%d%H%M%S' );
1429 my $stop = ( $tp + ONE_MINUTE * 30 )->strftime( '%Y%m%d%H%M%S' );
1430 $title = $_ if ( !$title );
1431 my $url = qq "rectool.pl?mode=confirm&mode_sub=reserve&chtxt=$chtxt&start=$start&stop=$stop&title=$title";
1432 $HTML .= qq {認識結果:$year-$month-$day $hour:$minute 残り:$_<a href="$url">リンク</a> <br>\n};
1438 if ( $mode eq 'expert' ) {
1439 require List::Compare;
1443 $HTML =~ s/%HTML_TITLE_OPT%/ - Expert/;
1444 $HTML .= qq {<div>\n};
1446 if ( $mode_sub eq 'reget' ) {
1447 my $bctype = $q->param( 'bctype' );
1448 my ( $ontv, $chname ) = $dbh->selectrow_array(
1449 "SELECT ontv, chname FROM epg_ch
1450 WHERE bctype = '$bctype' " );
1451 $HTML .= "Update for $chname ( ontv: $ontv ) has been reserved.<br>\n";
1452 $dbh->do( "UPDATE epg_ch SET status = '2' WHERE ontv = '$ontv' " );
1457 my @ary = $dbh->selectrow_array(
1458 "SELECT auto_jbk, auto_bayes, auto_del_tmp, auto_opt
1459 FROM in_settings " );
1461 @ary = map( $_ ? 'checked' : '', @ary );
1463 $HTML .= qq {内部オプションの変更\n<br>};
1464 $HTML .= qq {<form method="get" action="rectool.pl">\n};
1465 $HTML .= qq {<div>\n};
1466 $HTML .= qq {<input type="hidden" name="mode" value="change">\n};
1467 $HTML .= qq {<input type="hidden" name="mode_sub" value="setting">\n};
1468 $HTML .= qq {<input type="checkbox" name="jbk" value="1" $ary[0]>自動地引\n};
1469 $HTML .= qq {<input type="checkbox" name="bayes" value="1" $ary[1]>自動ベイズ\n};
1470 $HTML .= qq {<input type="checkbox" name="del_tmp" value="1" $ary[2]>自動一時ファイル削除\n};
1471 $HTML .= qq {自動オプション:<input type="text" name="opt" value="$opt">\n};
1472 $HTML .= qq {<input type="submit" value="保存">\n</div>\n</form>\n};
1475 $HTML .= qq {<hr>\n番組表のカテゴリ一覧と内蔵のカテゴリ一覧の合致を確認中...\n};
1476 $ary_ref = $dbh->selectcol_arrayref(
1477 "SELECT DISTINCT category FROM epg_timeline"
1479 my @category = sort values %category;
1480 if ( List::Compare->new( $ary_ref, \@category )->get_symdiff ) {
1481 $HTML .= qq {一致しません<br>\n};
1482 $HTML .= qq {番組表:@{$ary_ref}<br>\n内蔵:@category<br>\n};
1485 $HTML .= qq {一致しました<br>\n};
1489 my @ary = $dbh->selectrow_array( "SELECT terec, bscsrec, b252ts, ts2avi FROM in_status" );
1490 $HTML .= qq {<hr>\n地上波録画数:$ary[0]\n衛星波録画数:$ary[1]\n解読数:$ary[2]\n縁故数:$ary[3]\n<br>\n};
1493 $HTML .= qq {<hr>\n番組表の欠落<br>\n};
1494 $ary_ref = $dbh->selectall_arrayref( "SELECT chname, chtxt FROM epg_ch" );
1495 foreach my $line ( @{$ary_ref} ) {
1496 my $ary_ref = $dbh->selectall_arrayref(
1497 "SELECT start, stop, title FROM epg_timeline WHERE channel = '$line->[1]' ORDER BY start"
1500 my @program_old = ( '', $ary_ref->[0]->[0] );
1501 my $program_old = \@program_old;
1503 foreach my $program_new ( @{$ary_ref} ) {
1504 if ( $program_old->[1] ne $program_new->[0] &&
1505 $program_old->[2] !~ /クロ?ジング|クロージング|エンディング|休止|ミッドナイト/ &&
1506 $program_new->[2] !~ /オープニング|ウィークリー・インフォメーション|モーニング/ &&
1507 ( str2datetime( $program_new->[0] ) - str2datetime( $program_old->[1] ) )->delta_minutes > 30 ) {
1508 $program_old->[1] =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/;
1509 $program_new->[0] =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/;
1510 $error .= qq{ $program_old->[2] $program_old->[1]\n ? $program_new->[2] $program_new->[0]\n};
1512 $program_old = $program_new;
1514 $HTML .= qq {<pre>\n$line->[0]\n$error</pre>\n} if ( $error );
1517 $ary_ref = $dbh->selectall_arrayref(
1518 "SELECT chname, chtxt, ontv, bctype, ch, csch, updatetime, status
1520 ORDER BY bctype " );
1521 $HTML .= qq {<hr>\n番組表の更新状況<br>\n};
1522 $HTML .= qq {<table summary="channeltable" border=1 cellspacing=0>\n<tr>\n};
1523 $HTML .= qq {<th>チャンネル名</th>\n};
1524 $HTML .= qq {<th>チャンネルコード</th>\n};
1525 $HTML .= qq {<th>ontvコード</th>\n};
1526 $HTML .= qq {<th>タイプ</th>\n};
1527 $HTML .= qq {<th>ch</th>\n};
1528 $HTML .= qq {<th>csch</th>\n};
1529 $HTML .= qq {<th>最終更新時刻</th>\n};
1530 $HTML .= qq {<th>状態</th>\n};
1531 $HTML .= qq {</tr>\n};
1532 foreach my $status ( @{$ary_ref} ) {
1533 $HTML .= qq {<tr>\n};
1534 $HTML .= qq {<td>$status->[0]</td>\n<td>$status->[1]</td>\n<td>$status->[2]</td>\n<td>$status->[3]</td>\n};
1535 $HTML .= qq {<td>$status->[4]</td>\n<td>$status->[5]</td>\n<td>$status->[6]</td>\n<td>$status->[7]</td>\n};
1536 $HTML .= qq {</tr>\n};
1538 $HTML .= qq {</table>\n};
1540 $HTML .= qq {<form method="get" action="rectool.pl">\n};
1541 $HTML .= qq {<div>\n};
1542 $HTML .= qq {番組表を再取得する\n};
1543 $HTML .= qq {<input type="hidden" name="mode" value="expert">\n};
1544 $HTML .= qq {<input type="hidden" name="mode_sub" value="reget">\n};
1545 $HTML .= qq {<select name="bctype">\n};
1546 $ary_ref = $dbh->selectall_arrayref(
1547 "SELECT chname, bctype
1548 FROM epg_ch WHERE bctype NOT LIKE '_s%' "
1550 foreach my $line ( @{$ary_ref} ) {
1551 $HTML .= qq {<option value="$line->[1]">$line->[0]</option>\n};
1553 $HTML .= qq {<option value="bs">BS</option>\n};
1554 $HTML .= qq {<option value="cs1">CS1</option>\n};
1555 $HTML .= qq {<option value="cs2">CS2</option>\n};
1556 $HTML .= qq {</select>\n};
1557 $HTML .= qq {<input type="submit" value="実行">\n</div>\n</form>\n};
1561 $ary_ref = $dbh->selectall_arrayref(
1562 "SELECT id, type, chtxt, title, btime, etime, deltaday, deltatime
1565 $HTML .= qq {<hr>\n予約表<br>\n};
1566 $HTML .= qq {<table summary="rectimetable" border=1 cellspacing=0>\n<tr>\n};
1567 $HTML .= qq {<th>ID</th>\n};
1568 $HTML .= qq {<th>type</th>\n};
1569 $HTML .= qq {<th>chtxt</th>\n};
1570 $HTML .= qq {<th>title</th>\n};
1571 $HTML .= qq {<th>btime</th>\n};
1572 $HTML .= qq {<th>etime</th>\n};
1573 $HTML .= qq {<th>deltaday</th>\n};
1574 $HTML .= qq {<th>deltatime</th>\n};
1575 $HTML .= qq {</tr>\n};
1576 foreach my $status ( @{$ary_ref} ) {
1577 $HTML .= qq {<tr>\n};
1578 $HTML .= qq {<td>$status->[0]</td>\n<td>$status->[1]</td>\n<td>$status->[2]</td>\n<td>$status->[3]</td>\n};
1579 $HTML .= qq {<td>$status->[4]</td>\n<td>$status->[5]</td>\n<td>$status->[6]</td>\n<td>$status->[7]</td>\n};
1580 $HTML .= qq {</tr>\n};
1582 $HTML .= qq {</table>\n};
1585 if ( $mode eq 'log' ) {
1586 $HTML =~ s/%HTML_TITLE_OPT%/ - Log/;
1588 $HTML .= qq {<div>\n};
1589 $HTML .= qq {<table summary="reclogtable" border=1 cellspacing=0>\n<tr>\n};
1590 $HTML .= qq {<th>ID</th>\n};
1591 $HTML .= qq {<th>chtxt</th>\n};
1592 $HTML .= qq {<th>title</th>\n};
1593 $HTML .= qq {<th>btime</th>\n};
1594 $HTML .= qq {<th>etime</th>\n};
1595 $HTML .= qq {<th>opt</th>\n};
1596 $HTML .= qq {<th>exp</th>\n};
1597 $HTML .= qq {<th>longexp</th>\n};
1598 $HTML .= qq {<th>category</th>\n};
1599 $HTML .= qq {</tr>\n};
1600 $ary_ref = $dbh->selectall_arrayref(
1601 "SELECT id, chtxt, title, btime, etime, opt, exp, longexp, category
1602 FROM in_timeline_log "
1604 foreach my $line ( @{$ary_ref} ) {
1605 $HTML .= qq {<tr>\n};
1606 $HTML .= qq {<td>$line->[0]</td>\n<td>$line->[1]</td>\n<td>$line->[2]</td>\n<td>$line->[3]</td>\n};
1607 $HTML .= qq {<td>$line->[4]</td>\n<td>$line->[5]</td>\n<td>$line->[6]</td>\n<td>$line->[7]</td>\n};
1608 $HTML .= qq {<td>$line->[8]</td>\n};
1609 $HTML .= qq {</tr>\n};
1611 $HTML .= qq {</table>\n};
1614 if ( $mode eq 'help' ) {
1615 $HTML =~ s/%HTML_TITLE_OPT%/ - Help/;
1616 $HTML =~ s|%REFRESH%|<meta http-equiv="refresh" content="300">|;
1617 $HTML .= qq {<div>\n};
1618 $HTML .= qq {ヘルプ\n};
1621 if ( $mode eq 'test' ) {
1622 $HTML =~ s/%HTML_TITLE_OPT%/ - Test/;
1623 $HTML =~ s|%REFRESH%|<meta http-equiv="refresh" content="300">|;
1624 $HTML .= qq {<div>\n};
1626 require Data::Dumper;
1627 $tmp = Perl6::Slurp::slurp( 'config.ini' );
1628 $tmp =~ s/\n/<br>\n/gs;
1631 # $HTML .= Dumper( $ary_ref );
1636 $HTML =~ s/%HTML_TITLE_OPT%/ - Top/;
1637 $HTML .= qq {Welcome to Rec10!<br>\n};
1643 #<div style="float: right">
1650 #<div align="center">
1651 #$HTML_ADV = $HTML_ADV_IMG . $HTML_ADV_TEXT if ( !$HTML_ADV );
1652 $HTML_HEADER = qq {<div style="text-align: center">\n$HTML_ADV\n</div>\n};
1655 $HTML =~ s/%HTML_TITLE_OPT%//;
1656 $HTML =~ s/%REFRESH%//;
1657 $HTML =~ s/%SCRIPT%//;
1659 $HTML =~ s/%HTML_HEADER%/$HTML_HEADER/;
1666 $hires = Time::HiRes::time() - $hires;
1667 $last_modified = localtime((stat 'rectool.pl')[9]);
1669 $HTML_HEADER .= qq {<div>\n};
1670 $HTML_HEADER .= qq {<span style="float: right; font-size: 8px">Last-Modified: $last_modified<br>Time-Elapsed: $hires秒</span>\n};
1671 $HTML_HEADER .= qq {<span style="float: left">\n};
1672 $HTML_HEADER .= qq {<a href="rectool.pl">トップ</a>\n};
1673 $HTML_HEADER .= qq {<a href="rectool.pl?mode=schedule">予約確認</a>\n};
1674 $HTML_HEADER .= qq {<a href="rectool.pl?mode=graph">予約状況(画像版)</a>\n};
1675 $HTML_HEADER .= qq {<a href="rectool.pl?mode=list">録画一覧</a>\n};
1676 $HTML_HEADER .= qq {<a href="rectool.pl?mode=bravia">おまかせ</a>\n};
1677 $HTML_HEADER .= qq {<a href="rectool.pl?mode=expert">玄人仕様</a>\n};
1678 $HTML_HEADER .= qq {<a href="rectool.pl?mode=proc">復旧支援</a>\n};
1679 $HTML_HEADER .= qq {<a href="rectool.pl?mode=jbk">地引</a>\n};
1680 $HTML_HEADER .= qq {<a href="rectool.pl?mode=log">録画履歴</a>\n};
1681 $HTML_HEADER .= qq {<a href="rectool.pl?mode=recognize">文字認識</a>\n};
1682 $HTML_HEADER .= qq {<a href="rectool.pl?mode=edit">新規予約</a>\n};
1683 # $HTML_HEADER .= qq {<a href="../rec10web/rec10web.py">新規予約</a>\n};
1684 $HTML_HEADER .= qq {</span>\n};
1685 $HTML_HEADER .= qq {<hr style="clear: both; background-color: grey; height: 4px">\n};
1686 $HTML_HEADER .= qq {</div>\n};
1690 $chname = $q->param( 'chname' );
1691 $chtxt = $q->param( 'chtxt' );
1692 $key = $q->param( 'key' );
1694 $ontv = $dbh->selectrow_array("SELECT ontv FROM epg_ch WHERE chname = '$chname' ");
1697 $ontv = $dbh->selectrow_array("SELECT ontv FROM epg_ch WHERE chtxt = '$chtxt' ");
1700 $HTML .= qq {<div style="float: left">\n};
1701 $HTML .= qq {<form method="get" action="rectool.pl">\n};
1702 $HTML .= qq {<div>\n};
1703 $HTML .= qq {<input type="hidden" name="mode" value="program">\n};
1706 &draw_form_channel();
1709 $HTML .= qq {<select name="date">\n<option value="" selected>無指定</option>\n};
1710 $ary_ref = $dbh->selectcol_arrayref(
1711 "SELECT DISTINCT SUBSTRING(start, 1, 8) FROM epg_timeline ORDER BY start"
1713 $date_sel = $q->param( 'date' );
1714 foreach my $date ( @{ $ary_ref } ) {
1715 my @date = $date =~ /(.{4})(.{2})(.{2})/;
1716 $date_prt = "$date[1]/$date[2]";
1718 if ( $date eq $date_sel ) {
1719 $HTML .= qq {<option value="$date" selected>$date_prt</option>\n};
1722 $HTML .= qq {<option value="$date">$date_prt</option>\n};
1725 $HTML .= qq {</select>\n};
1728 $HTML .= qq {<select name="category">\n<option value="" selected>無指定</option>\n};
1729 $category_sel = $q->param( 'category' );
1730 foreach my $category ( keys %category ) {
1731 if ( $category eq $category_sel ) {
1732 $HTML .= qq {<option value="$category" selected>$category{$category}</option>\n};
1735 $HTML .= qq {<option value="$category">$category{$category}</option>\n};
1738 $HTML .= qq {</select>\n};
1741 $HTML .= qq {<input name="key" type="text" value="$key" style="width:200px" accesskey="s">\n};
1744 $HTML .= qq {<input type="submit" value="更新" accesskey="r">\n</div>\n</form>\n};
1747 sub draw_form_channel {
1748 $HTML .= qq {<select name="chtxt">\n};
1749 $HTML .= qq {<option value="" selected>無指定</option>\n} if ( shift ne 'nonone' );
1750 $ary_ref = $dbh->selectall_arrayref(
1751 "SELECT chtxt, chname FROM epg_ch"
1753 foreach my $line ( @{$ary_ref} ) {
1754 if ( $line->[0] eq $chtxt || $line->[1] eq $chname ) {
1755 $HTML .= qq {<option value="$line->[0]" selected>$line->[1]</option>\n};
1758 $HTML .= qq {<option value="$line->[0]">$line->[1]</option>\n};
1761 $HTML .= qq {</select>\n};
1766 my ( %selected, %checked );
1768 if ( $chtxt =~ /\Qbs-nhk-hi\E/ ) {
1769 $selected{F} = 'selected';
1771 elsif ( $chtxt =~ /movieplus|nihoneiga/ ) {
1772 $selected{H} = 'selected';
1774 elsif ( $chtxt =~ /bs-nhk/ || $bctype =~ /cs/ ) {
1775 $selected{W} = 'selected';
1777 elsif ( $bctype =~ /bs|te/ ) {
1778 $selected{H} = 'selected';
1780 $selected{g} = 'selected';
1781 $selected{s} = 'selected';
1782 $checked{a} = $chtxt =~ /animax|atx|disney|kids/ || $category =~ /アニメ/ ? 'checked' : '';
1784 $checked{d} = $title =~ /\Q[二]\E|[二]|\Q(二)\E|(二)/ ? 'checked' : '';
1785 $checked{5} = $title =~ /5\.1|5.1/ ? 'checked' : '';
1786 $checked{2} = 'checked';
1791 my @opt = split //, $opt;
1792 foreach my $opt ( @opt ) {
1793 $selected{$opt} = 'selected' if ( $opt =~ /S|L|G|H|F/ );
1794 $checked {$opt} = 'checked' if ( $opt =~ /a|h|l|d|2|5/ );
1798 $HTML .= qq {<select name="opt">\n};
1799 $HTML .= qq {<option value="S" $selected{S}>S 720x480</option>\n};
1800 $HTML .= qq {<option value="W" $selected{W}>W 854x480</option>\n};
1801 $HTML .= qq {<option value="H" $selected{H}>H 1280x720</option>\n};
1802 $HTML .= qq {<option value="F" $selected{F}>F 1920x1080</option>\n};
1803 $HTML .= qq {</select>\n};
1805 $HTML .= qq {<select name="opt">\n};
1806 $HTML .= qq {<option value="u" $selected{u}>最低</option>\n};
1807 $HTML .= qq {<option value="i" $selected{i}>低</option>\n};
1808 $HTML .= qq {<option value="" $selected{g}>画質</option>\n};
1809 $HTML .= qq {<option value="o" $selected{o}>高</option>\n};
1810 $HTML .= qq {<option value="p" $selected{p}>最高</option>\n};
1811 $HTML .= qq {</select>\n};
1813 $HTML .= qq {<select name="opt">\n};
1814 $HTML .= qq {<option value="q" $selected{q}>最低</option>\n};
1815 $HTML .= qq {<option value="w" $selected{w}>低</option>\n};
1816 $HTML .= qq {<option value="" $selected{s}>圧縮率</option>\n};
1817 $HTML .= qq {<option value="e" $selected{e}>高</option>\n};
1818 $HTML .= qq {<option value="r" $selected{r}>最高</option>\n};
1819 $HTML .= qq {</select>\n};
1821 $HTML .= qq {<select name="opt">\n};
1822 $HTML .= qq {<option value="" $selected{s}>コンテナ</option>\n};
1823 $HTML .= qq {<option value="m" $selected{e}>MKV</option>\n};
1824 $HTML .= qq {<option value="4" $selected{r}>MP4</option>\n};
1825 $HTML .= qq {</select>\n};
1827 $HTML .= qq {<input type="checkbox" name="opt" value="a" $checked{a}>24fps(主にアニメ)\n};
1828 $HTML .= qq {<input type="checkbox" name="opt" value="d" $checked{d}>二ヶ国語放送\n};
1829 # $HTML .= qq {<input type="checkbox" name="opt" value="2" $checked{2}>2passモード\n};
1830 $HTML .= qq {<input type="checkbox" name="opt" value="5" $checked{5}>5.1ch放送\n};
1831 $HTML .= qq {<br>\n};
1832 $HTML .= qq {<select name="opt">\n};
1833 $HTML .= qq {<option value="">移動なし</option>\n};
1834 $HTML .= qq {<option value="R">録画後移動</option>\n};
1835 $HTML .= qq {<option value="D">解読後移動</option>\n};
1836 $HTML .= qq {<option value="E">縁故後移動</option>\n};
1837 $HTML .= qq {</select>\n};
1838 $HTML .= qq {<input type="checkbox" name="opt" value="N">ファイル名日時追加\n} if ( $shift eq 'reserve' );
1839 $HTML .= qq {<input type="checkbox" name="every" value="1">隔週録画\n} if ( $shift eq 'reserve' );
1843 $chname = $q->param( 'chname' );
1844 $chtxt = $q->param( 'chtxt' );
1845 $start = $q->param( 'start' );
1846 $stop = $q->param( 'stop' );
1847 $bayesid = $q->param( 'bayesid' );
1848 $id = $q->param( 'id' );
1851 $ontv = $dbh->selectrow_array("SELECT ontv FROM epg_ch WHERE chname = '$chname'");
1852 $chtxt = $dbh->selectrow_array("SELECT chtxt FROM epg_ch WHERE ontv = '$ontv'");
1855 $ontv = $dbh->selectrow_array("SELECT ontv FROM epg_ch WHERE chtxt = '$chtxt'");
1856 $chname = $dbh->selectrow_array("SELECT chname FROM epg_ch WHERE ontv = '$ontv'");
1858 $title = $dbh->selectrow_array("SELECT title FROM epg_timeline WHERE channel = '$ontv' AND start = '$start' AND stop = '$stop' ");
1859 $desc = $dbh->selectrow_array("SELECT exp FROM epg_timeline WHERE channel = '$ontv' AND start = '$start' AND stop = '$stop' ");
1860 $longdesc = $dbh->selectrow_array("SELECT longexp FROM epg_timeline WHERE channel = '$ontv' AND start = '$start' AND stop = '$stop' ");
1861 $category = $dbh->selectrow_array("SELECT category FROM epg_timeline WHERE channel = '$ontv' AND start = '$start' AND stop = '$stop' ");
1862 $bctype = $dbh->selectrow_array("SELECT bctype FROM epg_ch WHERE ontv = '$ontv'");
1865 ( $chtxt, $title, $begin, $end ) = $dbh->selectrow_array(
1866 "SELECT chtxt, title, btime, etime FROM auto_timeline_bayes WHERE id = '$bayesid' "
1868 ( $ontv, $chname, $bctype ) = $dbh->selectrow_array(
1869 "SELECT ontv, chname, bctype FROM epg_ch WHERE chtxt = '$chtxt' "
1871 $start = str2datetime( $begin )->strftime( '%Y%m%d%H%M%S' );
1872 $stop = str2datetime( $end )->strftime( '%Y%m%d%H%M%S' );
1873 ( $desc, $longdesc, $category ) = $dbh->selectrow_array(
1874 "SELECT exp, longexp, category FROM epg_timeline WHERE channel = '$ontv' AND start = '$start' AND stop = '$stop' "
1878 ( $type, $chtxt, $title, $begin, $end, $deltaday, $deltatime, $opt ) = $dbh->selectrow_array(
1879 "SELECT type, chtxt, title, btime, etime, deltaday, deltatime, opt
1880 FROM timeline WHERE id = '$id' "
1882 ( $ontv, $chname, $bctype ) = $dbh->selectrow_array(
1883 "SELECT ontv, chname, bctype FROM epg_ch WHERE chtxt = '$chtxt' "
1885 $start = str2datetime( $begin )->strftime( '%Y%m%d%H%M%S' );
1886 $stop = str2datetime( $end )->strftime( '%Y%m%d%H%M%S' );
1887 ( $desc, $longdesc, $category ) = $dbh->selectrow_array(
1888 "SELECT exp, longexp, category FROM epg_timeline WHERE channel = '$ontv' AND start = '$start' AND stop = '$stop' "
1891 if ( $bctype =~ /.s/ ) {
1892 $bctype_sql = '_s%';
1894 elsif ( $bctype =~ /te/ ) {
1895 $bctype_sql = 'te%';
1897 @start = $start =~ /(.{4})(.{2})(.{2})(.{2})(.{2})/;
1898 @stop = $stop =~ /(.{4})(.{2})(.{2})(.{2})(.{2})/;
1899 $begin = sprintf( '%04d-%02d-%02d %02d:%02d:%02d', @start, '00' );
1900 $end = sprintf( '%04d-%02d-%02d %02d:%02d:%02d', @stop , '00' );
1905 my $is_same = $dbh->selectrow_array(
1906 "SELECT COUNT(*) FROM timeline WHERE chtxt = '$chtxt' AND btime = '$begin' AND etime = '$end'"
1908 my @overlap = &get_overlap();
1911 $HTML .= "同一の番組が既に存在します。<br>\n";
1914 elsif ( $overlap[0] >= 2 ) {
1915 $HTML .= "時間が被る番組が既に2個存在します。<br>\n";
1916 $HTML .= $overlap[1];
1928 my $ary_ref = $dbh->selectall_arrayref(
1929 "SELECT btime, etime, title
1931 INNER JOIN epg_ch ON timeline.chtxt = epg_ch.chtxt
1932 WHERE bctype LIKE '$bctype_sql' AND type IN $type_user_made
1934 AND etime > '$begin'
1939 my $overlap = $max = 0;
1941 foreach my $prg ( @{ $ary_ref } ) {
1942 $str .= "$prg->[0] ? $prg->[1] : $prg->[2]<br>\n";
1943 $overlap{$prg->[0]} += 1;
1944 $overlap{$prg->[1]} -= 1;
1946 foreach my $key ( sort keys %overlap ) {
1947 $overlap += $overlap{$key};
1948 $max = List::Util::max( $max, $overlap );
1951 return ( $max, $str );
1958 sub get_file_list_wrapper {
1959 local $base_dir = shift;
1962 &get_file_list( $base_dir );
1968 opendir ( DIR, $dir );
1969 my @list = sort readdir( DIR );
1972 foreach my $file ( @list ) {
1973 next if ( $file =~ /^\.{1,2}$/ );
1974 if ( -d "$dir/$file" ){
1975 &get_file_list("$dir/$file");
1978 $abs = "$dir/$file";
1979 ( $rel ) = $abs =~ /^$base_dir\/(.*)$/;
1980 $ptr->( $rel, $abs );
1988 return $str =~ /.{4}-.{2}-.{2} .{2}:.{2}:.{2}/ ? 0 : 1;
1995 if ( strisjoined( $str ) ) {
1996 @time = $str =~ /(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/;
1999 @time = $str =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/;
2001 return DateTime->new(
2002 year => $time[0], month => $time[1], day => $time[2],
2003 hour => $time[3], minute => $time[4], second => $time[5],
2004 locale => 'ja_JP' , time_zone => $tz
2010 our %day_name_cache;
2012 if ( !$day_name_cache{$str} ) {
2013 $day_name_cache{$str} = str2datetime( $str )->day_name;
2015 return $day_name_cache{$str};
2022 my $dt_begin = ref( $begin ) eq 'DateTime' ? $begin : &str2datetime( $begin );
2023 my $dt_end = ref( $end ) eq 'DateTime' ? $end : &str2datetime( $end );
2025 my $str_begin = $dt_begin->strftime( '%m/%d(%a) %H:%M' );
2026 my $str_end = $dt_end ->strftime( $dt_begin->day == $dt_end->day ? '%H:%M' : '翌 %H:%M' );
2027 utf8::encode( $str_begin );
2029 my ( $sec, $min, $hour );
2030 $sec = $dt_end->epoch - $dt_begin->epoch;
2031 $min = int( $sec / 60 );
2032 $sec = $sec - $min * 60;
2033 $hour = int( $min / 60 );
2034 $min = $min - $hour * 60;
2036 $str_diff .= $hour . '時間' if ( $hour );
2037 $str_diff .= $min . '分' if ( $min );
2038 $str_diff .= $sec . '秒' if ( $sec );
2040 return ( $str_begin, $str_end, $str_diff );
2043 sub sqlgetsuggested {
2045 require Text::Ngram;
2047 my ( $btime, $etime ) = @_;
2048 $deltatime = 3 if ( !$deltatime );
2050 $btime_bgn = $btime->clone->subtract( hours => $deltatime )->strftime( '%Y%m%d%H%M%S' );
2051 $btime_end = $btime->clone->add( hours => $deltatime )->strftime( '%Y%m%d%H%M%S' );
2052 $etime_bgn = $etime->clone->subtract( hours => $deltatime )->strftime( '%Y%m%d%H%M%S' );
2053 $etime_end = $etime->clone->add( hours => $deltatime )->strftime( '%Y%m%d%H%M%S' );
2055 my $ontv = $dbh->selectrow_array( "SELECT ontv FROM epg_ch WHERE chtxt = '$chtxt' " );
2056 $ary_ref = $dbh->selectall_arrayref(
2057 "SELECT start, stop, title, exp
2059 WHERE channel = '$ontv'
2060 AND start BETWEEN '$btime_bgn' AND '$btime_end'
2061 AND stop BETWEEN '$etime_bgn' AND '$etime_end' "
2065 my $hash_r = Text::Ngram::ngram_counts( Encode::decode_utf8( $title ), 2 ); # bi-gram
2066 foreach my $program ( @{$ary_ref} ) {
2067 my $hash_k = Text::Ngram::ngram_counts( Encode::decode_utf8( $program->[2] ), 2 );
2069 map $point += $hash_k->{$_}, keys %{$hash_r};
2070 push @{$hash{$point}}, $program if ( $point );