--- /dev/null
+#!/usr/bin/perl
+# -d:SmallProf
+#use Perl6::Slurp;
+#use XML::Simple;
+#use CGI;
+#use CGI::Lite;
+#use Date::Manip;
+#Date_Init("TZ=JST","ConvTZ=JST");
+#use SVG;
+#use KCatch;
+use CGI::Carp qw( fatalsToBrowser );
+use DBI;
+use Date::Simple;
+use DateTime;
+use CGI::Minimal;
+use MIME::Base64;
+use Config::Simple;
+use Time::HiRes;
+use Data::Dumper;
+#require SVG Time::Simple Encode Text::Ngram File::Find Data::Dumper Perl6::Slurp List::Util
+#use utf8;
+%DB::packages = ( 'main' => 1 );
+my $tz = DateTime::TimeZone->new( name => 'local' );
+my $hires = Time::HiRes::time();
+
+my $cfg = new Config::Simple;
+$cfg->read( 'config.ini' );
+my $sql = $cfg->param( 'db.db' );
+
+if ( $sql eq 'SQLite' ) {
+ $dbh = DBI->connect("dbi:SQLite:dbname=ch.db", undef, undef, {
+ AutoCommit => 1,
+ RaiseError => 1,
+ });
+ $SQL{'SUBSTR'} = 'SUBSTR(start, 0, 9)';
+}
+
+if ( $sql eq 'MySQL' ) {
+ my $name = $cfg->param( 'db.mysql_dbname' );
+ my $host = $cfg->param( 'db.mysql_host' );
+ my $port = $cfg->param( 'db.mysql_port' );
+ my $user = $cfg->param( 'db.mysql_user' );
+ my $pass = $cfg->param( 'db.mysql_passwd' );
+ $dbh = DBI->connect("dbi:mysql:$name:$host:$port", $user, $pass, {
+ AutoCommit => 1,
+ RaiseError => 1,
+ });
+ $dbh->do( 'SET NAMES utf8' );
+ $SQL{'SUBSTR'} = 'SUBSTRING(start, 1, 8)';
+}
+
+my $HTML;
+
+#print "Content-Type: text/html\n\n";
+
+$HTTP_HEADER = "Content-Type: text/html\n\n";
+$HTML .= <<EOM;
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<html lang="ja">
+<head>
+<title>Rec10%HTML_TITLE_OPT%</title>
+<meta http-equiv="Content-Script-Type" content="text/javascript">
+<meta http-equiv="Content-Style-Type" content="text/css">
+<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<link rev="MADE" href="Rea10">
+%REFRESH%
+%SCRIPT%
+%CSS%
+</head>
+<body>
+%HTML_HEADER%
+EOM
+
+
+$q = new CGI::Minimal;
+$mode = $q->param( 'mode' );
+
+$display = $q->param( 'ch' );
+$start = $q->param( 'start' );
+$stop = $q->param( 'stop' );
+$key = $q->param( 'key' );
+@id = $q->param( 'id' );
+
+%type = (
+ 'res' => '一回限定',
+ 'rec' => '最終段階',
+ 'key' => '当日検索',
+ 'keyevery' => '隔日検索',
+ 'tsrecording' => '録画途中',
+ 'tsfin' => '録画終了',
+ 'tsmiss' => '録画失敗',
+ 'b252ts' => '解読予約',
+ 'tsdecoding' => '解読途中',
+ 'ts2avi' => '縁故予約',
+ 'local' => '縁故於鯖',
+ 'grid' => '縁故於網',
+ 'fin_local' => '縁故完了',
+ 'end' => '録画終了',
+);
+
+%category = (
+ 'etc' => 'その他',
+ 'news' => 'ニュース・報道',
+ 'variety' => 'バラエティ',
+ 'anime' => 'アニメ・特撮',
+ 'information' => '情報',
+ 'drama' => 'ドラマ',
+ 'sports' => 'スポーツ',
+ 'music' => '音楽',
+ 'cinema' => '映画',
+);
+
+if ( $mode eq 'schedule' ) {
+
+ $HTML =~ s/%HTML_TITLE_OPT%/ - Schedule Viewer/;
+# $HTML =~ s|%REFRESH%|<meta http-equiv="refresh" content="300">|;
+ $css = <<EOM;
+ <style type="text/css">
+ td {
+ white-space: nowrap;
+ }
+ </style>
+EOM
+ $css =~ s/^\t{2}//gm;
+ $HTML =~ s/%CSS%/$css/;
+
+ my $order = $q->param( 'order' );
+ my $extra = $q->param( 'extra' );
+ if ( $order ne 'id' ) {
+ $order = 'btime';
+ }
+ $reverse_extra = $extra ? '' : '&extra=1';
+ $forward_order = $order eq 'btime' ? '' : '&order=id';
+
+ my $ary_ref = $dbh->selectall_arrayref(
+ "SELECT id, type, rectime.chtxt, chdata.ontv, ch.display, title, btime, etime, opt, deltaday, deltatime
+ FROM rectime
+ INNER JOIN chdata ON rectime.chtxt = chdata.chtxt
+ INNER JOIN ch ON chdata.ontv = ch.channel
+ ORDER BY $order");
+
+ $HTML .= qq {<div style="font-size: 10pt; float: left">\n}; my $ary_ref = $dbh->selectall_arrayref(
+ "SELECT id, type, rectime.chtxt, chdata.ontv, ch.display, title, btime, etime, opt, deltaday, deltatime
+ FROM rectime
+ INNER JOIN chdata ON rectime.chtxt = chdata.chtxt
+ INNER JOIN ch ON chdata.ontv = ch.channel
+ ORDER BY $order");
+
+ $HTML .= qq {<form method="get" action="rectool.pl">\n};
+ $HTML .= qq {<div>\n};
+ $HTML .= qq {<input type="hidden" name="mode" value="change">\n};
+ $HTML .= qq {<table summary="rectimetable" border=1 cellspacing=0>\n<tr>\n};
+ $HTML .= qq {<th><a href="rectool.pl?mode=schedule$forward_order$reverse_extra">■</a></th>\n};
+ $HTML .= qq {<th><a href="rectool.pl?mode=schedule&order=id">ID</a></th>\n};
+ $HTML .= qq {<th>タイプ</th>\n};
+ $HTML .= qq {<th>チャンネル</th>\n};
+ $HTML .= qq {<th>タイトル</th>\n};
+ $HTML .= qq {<th><a href="rectool.pl?mode=schedule">開始時刻</a></th>\n};
+ $HTML .= qq {<th>終了時刻</th>\n};
+ $HTML .= qq {<th>録画時間</th>\n};
+ $HTML .= qq {<th>オプション</th>\n};
+ $HTML .= qq {<th>dd</th>\n};
+ $HTML .= qq {<th>dt</th>\n};
+ $HTML .= qq {</tr>\n};
+ foreach my $line ( @{ $ary_ref } ) {
+
+ $type = $type{$line->[1]} || $line->[1];
+ if ( $line->[1] eq 'key' || $line->[1] eq 'keyevery' ) {
+ $type = qq {<span style="color: #800080">$type</span>};
+ $line->[9] = qq {<span style="color: #FF0000">空</span>} if ( !$line->[9] && $line->[1] eq 'keyevery' );
+ $line->[10] = qq {<span style="color: #FF0000">空</span>} if ( !$line->[10] );
+ }
+ elsif ( $line->[1] eq 'res' || $line->[1] eq 'rec' ) {
+ $type = qq {<span style="color: #A0A000">$type</span>};
+ }
+ elsif ( $line->[1] eq 'tsrecording' ) {
+ $type = qq {<span style="color: #FFA000">$type</span>};
+ }
+ elsif ( $line->[1] eq 'b252ts' || $line->[1] eq 'ts2avi' ) {
+ $type = qq {<span style="color: #404040">$type</span>};
+ }
+ elsif ( $line->[1] eq 'tsdecoding' ) {
+ $type = qq {<span style="color: #C04040">$type</span>};
+ }
+ elsif ( $line->[1] eq 'local' ) {
+ $type = qq {<span style="color: #008080">$type</span>};
+ }
+ else {
+ $type = qq {<span style="color: #A0A0A0">$type</span>};
+ }
+ $display = $q->url_encode( $line->[4] );
+ $line->[5] = 'タイトルなし' if ( !$line->[5] );
+ my @unix_6 = $line->[6] =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/;
+ my $unix_6 = DateTime->new(
+ year => $unix_6[0], month => $unix_6[1], day => $unix_6[2],
+ hour => $unix_6[3], minute => $unix_6[4], second => $unix_6[5],
+ time_zone => $tz
+ );
+ my @unix_7 = $line->[7] =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/;
+ my $unix_7 = DateTime->new(
+ year => $unix_7[0], month => $unix_7[1], day => $unix_7[2],
+ hour => $unix_7[3], minute => $unix_7[4], second => $unix_7[5],
+ time_zone => $tz
+ );
+
+ my $btime = $unix_6->strftime( '%Y%m%d%H%M%S' );
+ my $etime = $unix_7->strftime( '%Y%m%d%H%M%S' );
+ if ( $extra and $line->[1] =~ /key|res/ ) {
+ my @ary = $dbh->selectrow_array(
+ "SELECT title, exp FROM tv
+ WHERE channel = '$line->[3]'
+ AND start = '$btime'
+ AND stop = '$etime' ");
+ $ary[0] = '説明' if ( $line->[1] eq 'res' );
+ if ( $ary[0] ) {
+ $ary[0] =~ s/無料≫//;
+ if ( $line->[1] ne 'res' && $ary[0] ne $line->[5] ) {
+ my $count = $ary[0] =~ s/\Q$line->[5]\E//;
+ if ( !$count ) {
+ $ary[0] = qq {<span style="color: #FF4000">$ary[0]</span>};
+ }
+ }
+ if ( $ary[1] ) {
+ $line->[11] = qq {<div style="float: right; cursor: help" title="$ary[1]">$ary[0]</div>};
+ }
+ else {
+ # $line->[11] = qq {<span style="float: right; color: #FF0000">該当なし</span>};
+ $line->[11] = qq {<span style="float: right">説明なし</span>};
+ }
+ }
+ else {
+ my $href = qq {<a href="rectool.pl?mode=edit&id=$line->[0]&suggest=auto">自動検索</a>};
+ $line->[11] = qq {<span style="float: right; color: #FF0000">！$href！</span>};
+ }
+ }
+
+ my $begin = $unix_6->strftime( '%m/%d %H:%M' );
+ my $end;
+ if ( $unix_6->month == $unix_7->month && $unix_6->day == $unix_7->day )
+ {
+ $end = $unix_7->strftime( '%H:%M' );
+ }
+ else {
+ $end = $unix_7->strftime( '翌 %H:%M' );
+ }
+
+ my ( $sec, $min, $hour );
+ $sec = $unix_7->epoch - $unix_6->epoch;
+ $min = int( $sec / 60 );
+ $sec = $sec - $min * 60;
+ $hour = int( $min / 60 );
+ $min = $min - $hour * 60;
+ my $diff = '';
+ $diff .= $hour . '時間' if ( $hour );
+ $diff .= $min . '分' if ( $min );
+ $diff .= $sec . '秒' if ( $sec );
+
+ my $hr;
+ if (
+ $line->[1] eq 'tsrecording'
+ &&
+ $unix_6->epoch <= time && time <= $unix_7->epoch
+ )
+ {
+ $percent = int( ( 100 * ( time - $unix_6->epoch ) ) / ( $unix_7->epoch - $unix_6->epoch ) );
+ $hr .= qq {<hr style="margin: 0 auto 0 0; height: 4px; width: $percent%;};
+ $hr .= qq { background-color: blue; border: none" title="$percent%">};
+ }
+
+ $line->[5] = qq {<div style="float: left">$line->[5]</div>} if ( $line->[11] );
+ $line->[5] = qq {<a href="rectool.pl?mode=edit&id=$line->[0]">$line->[5]</a>};
+ $HTML .= qq {<tr align="center">\n};
+ $HTML .= qq {<td><input type="checkbox" name="id" value="$line->[0]"></td>\n};
+ $HTML .= qq {<td>$line->[0]</td>\n};
+ $HTML .= qq {<td>$type</td>\n};
+ $HTML .= qq {<td><a href="rectool.pl?mode=program&ch=$display">$line->[2]</a></td>\n};
+ $HTML .= qq {<td align="left" style="white-space: normal">$line->[5]$line->[11]</td>\n};
+ $HTML .= qq {<td>$begin</td>\n<td>$end</td>\n};
+ $HTML .= qq {<td>$hr$diff</td>\n};
+ $HTML .= qq {<td>$line->[8]</td>\n<td>$line->[9]</td>\n<td>$line->[10]</td>\n};
+ # $HTML .= qq {<td>$line->[11]</td>\n} if ( $extra );
+ $HTML .= qq {</tr>\n};
+ }
+ $HTML .= qq {</table>\n};
+ $HTML .= qq {<input type="submit" name="edit" value="編集(要JS)">\n};
+ $HTML .= qq {<input type="submit" name="delete" value="削除">\n</div>\n</form>\n};
+ goto end;
+}
+
+if ( $mode eq 'graph' ) {
+
+ $graph = $q->param( 'graph' );
+
+ if ( $graph )
+ {
+ print "Content-Type: image/svg+xml\n\n";
+
+ require SVG;
+ $graph = Date::Simple->new( split /-/, $graph );
+ $graph_bgn = $graph->format('%Y-%m-%d');
+ $graph_end = $graph->next->format('%Y-%m-%d');
+ $day = $graph->day;
+ $today = $graph eq Date::Simple->today() ? 1 : 0;
+
+ $tuner{terrestrial} = 2; #$cfg->param( 'env.te_max' );
+ $tuner{satellite} = 4; #$cfg->param( 'env.bscs_max' );
+ $tuner{all} = $tuner{terrestrial} + $tuner{satellite};
+ $hours = 24;
+ $width = 30 * $hours;
+
+ $svg = new SVG( width => 820, height => $tuner{all} * 20 + 40 );
+ $svg->rectangle( 'x' => 40, 'y' => 20,
+ width => $width + 20, height => $tuner{all} * 20 + 10,
+ rx => 15, ry => 15,
+ style => { stroke => 'blue', fill => 'white' } );
+ for ( 1..$tuner{terrestrial} ) {
+ $svg->text( 'x' => 10, 'y' => ( $_ + 1 ) * 20 )
+ ->cdata( "T$_" );
+ }
+ for ( 1..$tuner{satellite} ) {
+ $svg->text( 'x' => 10, 'y' => ( $_ + $tuner{terrestrial} + 1 ) * 20 )
+ ->cdata( "S$_" );
+ }
+ for ( 0..$hours ) {
+ $svg->text( 'x' => $_ * 30 + 65, 'y' => 15,
+ style => { 'text-anchor' => 'middle' } )
+ ->cdata( sprintf( '%02d', $_ ) ) if ( $_ < $hours );
+# $svg->line( ); # can't use when required
+ $svg->tag( 'line', x1 => $_ * 30 + 50, x2 => $_ * 30 + 50, y1 => 30, y2 => $tuner{all} * 20 + 20,
+ style => { stroke => 'gray' } );
+ }
+ for ( 1..$tuner{all} ) {
+ $svg->rectangle( 'x' => 50, 'y' => $_ * 20 + 10, width => $width, height => 10 );
+ }
+ if ( $today ) {
+ require Time::Simple;
+ my $time = Time::Simple->new();
+ my $x = ( $time->hours * 60 + $time->minutes ) * 0.5 + 50;
+ $svg->tag( 'line', x1 => $x, x2 => $x, y1 => 30, y2 => $tuner{all} * 20 + 20,
+ style => { stroke => 'red', 'fill-opacity' => '1.0' } );
+ }
+ foreach my $bctype ( 'te%', '_s%' ) {
+ my $tuner = $bctype eq 'te%' ? $tuner{terrestrial} : $tuner{satellite};
+ my $ary_ref = $dbh->selectall_arrayref(
+ "SELECT id, type, rectime.chtxt, title, btime, etime, opt FROM rectime
+ INNER JOIN chdata ON rectime.chtxt = chdata.chtxt
+ WHERE chdata.bctype LIKE '$bctype'
+ AND type IN ( 'rec', 'res', 'key', 'keyevery', 'tsrecording' )
+ AND
+ (
+ '$graph_bgn 00:00' <= btime AND btime < '$graph_end 00:00'
+ OR
+ '$graph_bgn 00:00' < etime AND etime <= '$graph_end 00:00'
+ )
+ ORDER BY id"
+ );
+ foreach my $line ( @{ $ary_ref } ) {
+ @start = $line->[4] =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2})/;
+ @stop = $line->[5] =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2})/;
+ $start = ( ( $day == $start[2] ? 0 : 24 * 60 ) + $start[3] * 60 + $start[4] ) * 0.5;
+ $stop = ( ( $day == $stop [2] ? 0 : 24 * 60 ) + $stop [3] * 60 + $stop [4] ) * 0.5;
+ $start = 0 if ( $start < 0 || $day > $start[2] ); # 月の変わり目はスルー
+ $stop = $width if ( $stop > $width );
+ $begin = $line->[4];
+ $end = $line->[5];
+
+ my $ary = $dbh->selectall_arrayref(
+ "SELECT id, type, rectime.chtxt, title, btime, etime, opt FROM rectime
+ INNER JOIN chdata ON rectime.chtxt = chdata.chtxt
+ WHERE chdata.bctype LIKE '$bctype'
+ AND type IN ( 'rec', 'res', 'key', 'keyevery', 'tsrecording' )
+ AND NOT
+ (
+ ( etime <= '$begin' )
+ OR
+ ( btime >= '$end' )
+ )
+ ORDER BY id"
+ );
+ my @ary = @{$ary};
+ for ( 0..$tuner - 1 ) {
+ $f = 1;
+ $i = $_;
+ for ( 0..4 ) {
+ $f = 0 if ( $line->[$_] ne $ary[$i]->[$_] );
+ }
+ if ( $f ) {
+ $slot = $i;
+ }
+ }
+ my ( $r, $g, $b ) = ( 0, 0, 0 );
+ $r += 255 if ( $line->[6] =~ /a/ );
+ $g += 255 if ( $line->[6] =~ /H/ );
+ $b += 255 if ( $line->[6] =~ /2/ );
+ if ( $r + $g + $b == 255 * 3 ){
+ $r = 0;
+ $g = 255;
+ $b = 255;
+ }
+ if ( $r + $g + $b == 0 ){
+ $r = $g = $b = 128;
+ }
+ my %escaped = ( '&' => 'amp', '<' => 'lt', '>' => 'gt', '"' => 'quot' );
+ sub html_escape{
+ my $str = shift or return;
+ my $result = '';
+ $result .= $escaped{$_} ? '&' . $escaped{$_} . ';' : $_
+ for (split //, $str);
+ $result;
+ }
+ $svg->anchor(
+ -href => "rectool.pl?mode=edit&id=$line->[0]",
+ target => '_blank',
+ -title => html_escape( $line->[3] ),
+ )->rectangle(
+ 'x' => 50 + $start,
+ 'y' => 30 + ( $bctype eq 'te%' ? 0 : $tuner{terrestrial} * 20 ) + $slot * 20,
+ width => $stop - $start,
+ height => 10,
+ style => { fill => "rgb($r,$g,$b)" } );
+ }
+ }
+ print $svg->xmlify;
+ exit;
+ }
+ else
+ {
+ $HTML =~ s/%HTML_TITLE_OPT%/ - Schedule Viewer - Graphical/;
+ $HTML .= qq {<div style="float: left">\n};
+# $base64 = encode_base64( $svg->xmlify );
+# $HTML .= qq {<object data="data:image/svg+xml;base64,$base64">\n</object>\n};
+ $HTML .= qq {予約状況一覧です。T1,T2は地上波、S1,S2はBS/CS、赤はアニメ、緑はHD、青は2 passを示しています。<br>\n};
+ $HTML .= qq {SVGが利用可能なブラウザでご覧ください。<br>\n};
+
+ $ary_ref = $dbh->selectcol_arrayref(
+# "SELECT DISTINCT SUBSTR( btime, 0, 11 )
+ "SELECT DISTINCT DATE( btime )
+ FROM rectime
+ WHERE type in ( 'rec', 'res', 'key', 'keyevery', 'tsrecording' )
+ ORDER BY btime"
+ );
+ foreach my $date ( @{ $ary_ref } ) {
+ my @date = $date =~ /(.{4})-(.{2})-(.{2})/;
+ my $dn = DateTime->new( year => $date[0], month => $date[1], day => $date[2], locale => 'ja_JP' )->day_name;
+ utf8::encode( $dn );
+ $HTML .= qq {$date[1]/$date[2]($dn)の予約状況<br>\n};
+ $HTML .= qq {<object type="image/svg+xml" data="rectool.pl?mode=graph&graph=$date" width="820">\n};
+ # width=821 height=121>\n};
+ $HTML .= qq {SVG Image $date\n</object>\n<br>\n};
+
+ $date2 = Date::Simple->new( @date )->next->format('%Y-%m-%d');
+ my $ary_ref = $dbh->selectall_arrayref(
+ "SELECT chtxt, title, btime, etime FROM rectime
+ WHERE '$date 00:00' <= btime AND etime <= '$date2 01:00'
+ ORDER BY btime"
+ );
+
+ foreach my $line ( @{ $ary_ref } ) {
+# $HTML .= qq {$line->[0] $line->[1] $line->[2] $line->[3]<br>\n};
+ }
+
+ }
+
+ goto end;
+ }
+}
+
+if ( $mode eq 'edit' ) {
+ $HTML =~ s/%HTML_TITLE_OPT%/ - Schedule Editor/;
+ $HTML .= qq {<div style="float: left">\n};
+
+ $script = <<EOM;
+ <script type="text/javascript" src="http://www.enjoyxstudy.com/javascript/dateformat/dateformat.js">
+ </script>
+ <script type="text/javascript">
+ function setType(value){
+ var index = document.reserve.type.selectedIndex;
+ var value = document.reserve.type[index].value;
+ if ( value == 'keyevery' ) {
+ document.reserve.deltaday.value = 7;
+ document.reserve.deltatime.value = 3;
+ }
+ if ( value == 'ts2avi' || value == 'b252ts' ){
+ var date = new Date();
+ var dateFormat = new DateFormat("yyyy-MM-dd HH:mm:ss");
+ var minutes = date.getMinutes();
+ minutes = minutes - minutes % 5 + 10;
+ date.setMinutes(minutes, 0, 0);
+ document.reserve.begin.value = dateFormat.format(date);
+ date.setSeconds( date.getSeconds() + 3600 );
+ document.reserve.end.value = dateFormat.format(date);
+ }
+ }
+ function setSuggest(start, stop){
+ document.reserve.begin.value = start;
+ document.reserve.end.value = stop;
+ }
+ </script>
+EOM
+ $script =~ s/^\t{2}//gm;
+ $HTML =~ s/%SCRIPT%/$script/;
+
+ $HTML .= "スケジュール編集画面です。<br>\n";
+ $HTML .= "実装がとても適当なので、利用には細心の注意を払ってください。<br>\n<br>\n";
+ if ( $id[0] ) {
+ @reserve = $dbh->selectrow_array(
+ "SELECT id, type, chtxt, title, btime, etime, deltaday, deltatime, opt
+ FROM rectime
+ WHERE id = $id[0]"
+ );
+ $button_bgn = $button_end = '';
+ }
+ else {
+ $reserve[1] = 'res';
+ $datetime_now = DateTime->now( time_zone => $tz )->set_second( 0 )->strftime( '%Y-%m-%d %H:%M:%S' );
+ $button_bgn = qq{<button type="button" onClick="document.reserve.begin.value='$datetime_now'">現在</button>\n<br>\n};
+ $button_end = qq{<button type="button" onClick="document.reserve.end.value=document.reserve.begin.value">一致</button>};
+ }
+
+ if ( $q->param( 'suggest' ) eq 'auto' ) {
+ require Encode;
+ require Text::Ngram;
+
+ my @btime = $reserve[4] =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/;
+ my @etime = $reserve[5] =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/;
+ my $btime = DateTime->new(
+ year => $btime[0], month => $btime[1], day => $btime[2],
+ hour => $btime[3], minute => $btime[4], second => $btime[5],
+ );
+ my $etime = DateTime->new(
+ year => $etime[0], month => $etime[1], day => $etime[2],
+ hour => $etime[3], minute => $etime[4], second => $etime[5],
+ );
+ $btime_bgn = $btime->clone;
+ $btime_end = $btime->clone;
+ $etime_bgn = $etime->clone;
+ $etime_end = $etime->clone;
+ $btime_bgn->subtract( hours => $reserve[7] );
+ $btime_end->add( hours => $reserve[7] );
+ $etime_bgn->subtract( hours => $reserve[7] );
+ $etime_end->add( hours => $reserve[7] );
+ $btime_bgn = $btime_bgn->strftime( '%Y%m%d%H%M%S' );
+ $btime_end = $btime_end->strftime( '%Y%m%d%H%M%S' );
+ $etime_bgn = $etime_bgn->strftime( '%Y%m%d%H%M%S' );
+ $etime_end = $etime_end->strftime( '%Y%m%d%H%M%S' );
+
+ my $ontv = $dbh->selectrow_array( "SELECT ontv FROM chdata WHERE chtxt = '$reserve[2]' " );
+ $ary_ref = $dbh->selectall_arrayref(
+ "SELECT start, stop, title, exp
+ FROM tv
+ WHERE channel = '$ontv'
+ AND start BETWEEN '$btime_bgn' AND '$btime_end'
+ AND stop BETWEEN '$etime_bgn' AND '$etime_end' "
+ );
+
+ my %hash;
+ my $hash_r = Text::Ngram::ngram_counts( Encode::decode_utf8( $reserve[3] ), 2 ); # bi-gram
+ foreach my $program ( @{$ary_ref} ) {
+ my $hash_k = Text::Ngram::ngram_counts( Encode::decode_utf8( $program->[2] ), 2 );
+ my $point;
+ map $point += $hash_k->{$_}, keys %{$hash_r};
+ push @{$hash{$point}}, $program if ( $point );
+ }
+
+ $HTML .= qq {可能性のある番組<br>\n};
+ $HTML .= qq {<table summary="suggesttable" border=1 cellspacing=0>\n<tr>\n};
+ $HTML .= qq {<th>優先度</th>\n};
+ $HTML .= qq {<th>タイトル</th>\n};
+ $HTML .= qq {<th>開始時刻</th>\n};
+ $HTML .= qq {<th>終了時刻</th>\n};
+ $HTML .= qq {<th>説明</th>\n};
+ $HTML .= qq {<th>適用</th>\n};
+ $HTML .= qq {</tr>\n};
+
+ foreach my $key (sort keys %hash){
+ my $val = $hash{$key};
+ foreach my $val ( @{$val} ) {
+ my $style = qq {style="white-space: nowrap"};
+ $val->[0] =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/;
+ $val->[1] =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/;
+ $HTML .= qq {<tr>\n<td>$key</td>\n<td>$val->[2]</td>\n};
+ $HTML .= qq {<td $style>$val->[0]</td>\n<td $style>$val->[1]</td>\n<td>$val->[3]</td>\n};
+ $HTML .= qq {<td><button onClick="setSuggest('$val->[0]','$val->[1]');">適用</button></td>\n</tr>\n};
+ }
+ }
+ $HTML .= qq {</table>\n<br>\n};
+ }
+
+ my $len = length $reserve[0];
+ $HTML .= qq {<form method="get" action="rectool.pl" name="reserve">\n};
+ $HTML .= qq {<input type="hidden" name="mode" value="change">\n};
+ $HTML .= qq {<input type="hidden" name="id" value="$reserve[0]">\n};
+ $HTML .= qq {ID\n<input type="text" name="id" value="$reserve[0]" size=$len disabled>\n};
+ $HTML .= qq {タイプ\n<select name="type" onChange="setType();">\n};
+ while ( my ($key, $value) = each %type ) {
+ next if ( $key !~ /^rec|res|key|ts2avi|b252ts|$reserve[1]/ );
+ if ( $key eq $reserve[1] ) {
+ $HTML .= qq {<option value="$key" selected>$value</option>\n};
+ }
+ else {
+ $HTML .= qq {<option value="$key">$value</option>\n};
+ }
+ }
+ $HTML .= qq {</select>\n};
+ $HTML .= qq {チャンネル\n<select name="ch">\n};
+ $ary_ref = $dbh->selectall_arrayref(
+ "SELECT display, chtxt FROM ch INNER JOIN chdata ON ch.channel = chdata.ontv"
+ );
+ foreach my $ch ( @{$ary_ref} ) {
+ if ( $ch->[1] eq $reserve[2] ) {
+ $HTML .= qq {<option value="$ch->[1]" selected>$ch->[0]</option>\n};
+ }
+ else {
+ $HTML .= qq {<option value="$ch->[1]">$ch->[0]</option>\n};
+ }
+ }
+ $HTML .= qq {</select><br>\n};
+ $HTML .= qq {タイトル\n<input type="text" name="title" value="$reserve[3]" size=64><br>\n};
+ $HTML .= qq {開始時刻\n<input type="text" name="begin" value="$reserve[4]" maxlength=19 size=24>\n}.$button_bgn;
+ $HTML .= qq {終了時刻\n<input type="text" name="end" value="$reserve[5]" maxlength=19 size=24>\n}.$button_end."<br>\n";
+ $HTML .= qq {隔日周期\n<input type="text" name="deltaday" value="$reserve[6]" maxlength=2 size=2>\n};
+ $HTML .= qq {時刻誤差\n<input type="text" name="deltatime" value="$reserve[7]" maxlength=2 size=2>\n};
+ $HTML .= qq {オプション\n<input type="text" name="opt" value="$reserve[8]">\n};
+ $HTML .= qq {<input type="submit" name="update" value="更新">\n</form>\n};
+}
+
+if ( $mode eq 'change' ) {
+ $HTML =~ s/%HTML_TITLE_OPT%/ - Change/;
+ $HTML .= qq {<div style="float: left">\n};
+
+ if ( $q->param( 'delete' ) )
+ {
+ if ( @id ) {
+ foreach my $id ( @id ) {
+ $dbh->do( "DELETE FROM rectime WHERE id = '$id'" );
+ }
+ $HTML .= "削除しました。<br>\n5秒後に予約確認画面に移動します。<br>\n";
+ $HTML =~ s|%REFRESH%|<meta http-equiv="refresh" content="5; url=rectool.pl?mode=schedule">|;
+ goto end;
+ }
+ }
+ if ( $q->param( 'edit' ) )
+ {
+ if ( $q->param( 'edit' ) eq '編集(要JS)' ) {
+ $HTML .= "スケジュール編集画面に移動します。<br>\n";
+ $HTML =~ s|%REFRESH%|<meta http-equiv="refresh" content="0; url=../rec10web/rec10web.py?exec=edit:$id[0]">|;
+ goto end;
+ }
+ else {
+ goto end;
+ }
+ }
+ if ( $q->param( 'update' ) )
+ {
+ $type = $q->param( 'type' );
+ $chtxt = $q->param( 'ch' );
+ $title = $q->param( 'title' );
+ $begin = $q->param( 'begin' );
+ $end = $q->param( 'end' );
+ $deltaday = $q->param( 'deltaday' );
+ $deltatime = $q->param( 'deltatime' );
+ $opt = $q->param( 'opt' );
+ $id = $id[0];
+ if ( $id[0] ) {
+ $dbh->do(
+ "UPDATE rectime SET type = '$type', chtxt = '$chtxt', title = '$title',
+ btime = '$begin', etime = '$end',
+ deltaday = '$deltaday', deltatime = '$deltatime', opt = '$opt'
+ WHERE id = '$id'"
+ );
+ }
+ else {
+ $dbh->do(
+ "INSERT INTO rectime ( type, chtxt, title, btime, etime, deltaday, deltatime, opt )
+ VALUES ( '$type', '$chtxt', '$title', '$begin', '$end', '$deltaday', '$deltatime', '$opt' )"
+ );
+ }
+ $HTML .= "更新しました。<br>\n5秒後に予約確認画面に移動します。<br>\n";
+ $HTML =~ s|%REFRESH%|<meta http-equiv="refresh" content="5; url=rectool.pl?mode=schedule">|;
+ goto end;
+ }
+}
+
+if ( $mode eq 'confirm' ) {
+ # && $display && $start && $stop
+
+ $HTML =~ s/%HTML_TITLE_OPT%/ - Reserver/;
+ $HTML .= qq {<div style="float: left">\n};
+ &parse_program();
+
+ my $duration = ( str2datetime( $end ) - str2datetime( $begin ) )->delta_minutes;
+ $HTML .= "番組名：$title<br>\nチャンネル：$display<br>\n放送継続時間：$duration分<br>\n";
+ if ( &check_error() )
+ {
+ # エラー
+
+ $ary_ref = $dbh->selectall_arrayref(
+ "SELECT start, stop FROM tv WHERE channel = '$channel' AND title = '$title' "
+ );
+ $HTML .= "同一の番組の他の放送予定です。<br>\n";
+ foreach my $line ( @{$ary_ref} ) {
+ $begin = $line->[0];
+ $end = $line->[1];
+ $begin =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/;
+ $end =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/;
+ $overlap = &get_overlap() >= 2 ? '不可能' :
+ qq {<a href="rectool.pl?mode=confirm&ch=$display} .
+ qq {&start=$line->[0]&stop=$line->[1]">可能</a>};
+ $HTML .= "開始：$begin\n終了：$end\n録画は$overlap<br>\n";
+ }
+ }
+ else {
+ $desc = $dbh->selectrow_array(
+ "SELECT exp FROM tv WHERE channel = '$channel' AND start = '$start' AND stop = '$stop' "
+ );
+ $selected_hd = $chtxt =~ /movieplus/ ? 'selected' : '';
+ $selected_full = $chtxt =~ /\Qbs-nhk-hi\E/ ? 'selected' : '';
+ $checked_anime = $chtxt =~ /animax|atx|disney|kids/ ? 'checked' : '';
+ $checked_dual = $title =~ /\Q[二]\E|［二］|\Q(二)\E|（二）/ ? 'checked' : '';
+ $checked_5_1 = $title =~ /5\.1|5．1/ ? 'checked' : '';
+
+ $HTML .= "番組内容：$desc<br>\n<br>\n録画予約の詳細設定を行ってください。<br>\n";
+ $HTML .= qq {<form method="get" action="rectool.pl">\n};
+ $HTML .= qq {<input type="hidden" name="mode" value="reserve">\n};
+ $HTML .= qq {<input type="hidden" name="ch" value="$display">\n};
+ $HTML .= qq {<input type="hidden" name="start" value="$start">\n};
+ $HTML .= qq {<input type="hidden" name="stop" value="$stop">\n};
+ $HTML .= qq {<select name="opt">\n};
+ # $HTML .= qq {<option value="T">TE HD画質(1440x1080)</option>\n};
+ # $HTML .= qq {<option value="F" $check>FULLHD画質(1920x1080)</option>\n};
+ # $HTML .= qq {<option value="Q">WQVGA画質(400x240)</option>\n};
+ $HTML .= qq {<option value="L">L ***x*** 1250kbps</option>\n};
+ $HTML .= qq {<option value="G">G 1280x720 2500kbps</option>\n};
+ $HTML .= qq {<option value="H" $selected_hd>H 1280x720 3750kbps</option>\n};
+ $HTML .= qq {<option value="F" $selected_full>F 1920x1080 5000kbps</option>\n};
+ $HTML .= qq {<option value="S">S 720x480 1250kbps</option>\n};
+ $HTML .= qq {</select>\n};
+ $HTML .= qq {<input type="checkbox" name="opt" value="a" $checked_anime>アニメ\n};
+ $HTML .= qq {<input type="checkbox" name="opt" value="d" $checked_dual>二ヶ国語放送\n};
+ $HTML .= qq {<input type="checkbox" name="opt" value="2" checked>2passモード\n};
+ $HTML .= qq {<input type="checkbox" name="opt" value="5" $checked_5_1>5.1ch放送\n};
+ $HTML .= qq {<input type="checkbox" name="opt" value="x">Xvidモード\n};
+ $HTML .= qq {<input type="submit" value="予約">\n</form>\n};
+ }
+ goto end;
+}
+
+if ( $mode eq 'reserve' ) {
+ $HTML .= qq {<div style="float: left">\n};
+ &parse_program();
+ @opt = $q->param( 'opt' );
+ $opt = join '', @opt;
+ if ( !&check_error ) {
+ $dbh->do(
+ "INSERT INTO rectime ( type, chtxt, title, btime, etime, opt )
+ VALUES ( 'res', '$chtxt', '$title', '$begin', '$end', '$opt' )"
+ );
+ }
+ $HTML .= "録画予約を実行しました。<br>\n5秒後にトップへ移動します。<br>\n";
+ $HTML =~ s|%REFRESH%|<meta http-equiv="refresh" content="5; url=rectool.pl">|;
+ goto end;
+}
+
+if ( $mode eq 'program' ) {
+ &draw_form();
+
+ $HTML =~ s/%HTML_TITLE_OPT%/ - Program Viewer/;
+ $unix = DateTime->now( time_zone => $tz )->strftime( '%Y%m%d%H%M%S' );
+ $sql =
+ "SELECT tv.channel,
+ (SELECT display FROM ch WHERE ch.channel = tv.channel),
+ start, stop, title, category
+ FROM tv
+ INNER JOIN chdata ON tv.channel = chdata.ontv
+ WHERE $unix <= stop %CH% %DATE% %CATEGORY% %KEY% ORDER BY start";
+# INNER JOIN ch ON tv.channel = ch.channel
+
+ if ( $channel ) {
+ my $ch = "AND tv.channel = '$channel'";
+ $sql =~ s/%CH%/$ch/;
+ }
+ if ( $date_sel ) {
+ $date_1 = $date_sel . '000000';
+ $date_2 = Date::Simple->new( $date_sel =~ /(.{4})(.{2})(.{2})/ )->next->format('%Y%m%d') . '000000';
+ my $date = "AND '$date_1' <= stop AND start <= '$date_2'";
+ $sql =~ s/%DATE%/$date/;
+ }
+ if ( $category_sel ) {
+ # 一時的
+ $category_tmp = $category{$category_sel} . $category_sel;
+ my $category = "AND category = '$category_tmp'";
+ $sql =~ s/%CATEGORY%/$category/;
+ }
+ if ( $key ) {
+ my $key = "AND TITLE LIKE '%$key%'";
+ $sql =~ s/%KEY%/$key/;
+ }
+ $sql =~ s/%CH%//;
+ $sql =~ s/%DATE%//;
+ $sql =~ s/%KEY%//;
+ $sql =~ s/%CATEGORY%//;
+
+ $ary_ref = $dbh->selectall_arrayref( $sql );
+ foreach my $prg ( @{ $ary_ref } ) {
+ my @date = $prg->[2] =~ /(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/;
+
+ $date = $date[2];
+ if ( $date != $prev ) {
+ my $date = DateTime->new(
+ year => $date[0], month => $date[1], day => $date[2],
+# hour => $date[3], minute => $date[4], second => $date[5],
+ locale => 'ja_JP'
+ );
+
+ my $dn = $date->day_name;
+ utf8::encode( $dn );
+ $HTML .= qq {--------$date[1]/$date[2]($dn)--------<br>\n};
+ }
+ $prg->[1] = $q->url_encode( $prg->[1] );
+ $HTML .= qq {$date[1]/$date[2] $date[3]:$date[4] };
+ $HTML .= qq {<a href="rectool.pl?mode=confirm&ch=$prg->[1]};
+ $HTML .= qq {&start=$prg->[2]&stop=$prg->[3]">$prg->[4]</a><br>\n};
+ $prev = $date;
+ }
+
+}
+
+if ( $mode eq 'list' ) {
+ require File::Find;
+
+ $HTML =~ s/%HTML_TITLE_OPT%/ - List/;
+
+ my $type = $q->param( 'type' );
+ my $recording = $cfg->param( 'path.recpath' );
+ my $recorded = $cfg->param( 'path.recorded' );
+
+ if ( !$type ) {
+ $HTML .= qq {<a href="rectool.pl?mode=list&type=new">録画中のみ</a>\n};
+ $HTML .= qq {<a href="rectool.pl?mode=list&type=old">録画後のみ</a>\n<br>\n};
+ }
+ if ( !$type || $type eq 'new' ) {
+ $HTML .= "録画中のファイル一覧<br>\n";
+ &list( $recording );
+ }
+ if ( !$type ) {
+ $HTML .= "<br>\n";
+ }
+ if ( !$type || $type eq 'old' ) {
+ $HTML .= "録画後のファイル一覧<br>\n";
+ &simple_list( $recorded );
+ }
+
+ sub list {
+ local $path = shift;
+ local %list = ();
+ my @exp = ( 'log', 'ts.b25', 'ts.tsmix', 'ts', 'ts.log',
+ 'sa.avi', 'sa.avi.log', 'm2v', 'wav', 'avi', 'mkv' );
+ for ( 0..$#exp ) {
+ $exp{$exp[$_]} = $_;
+ }
+ my $exp_count = scalar keys %exp;
+
+ File::Find::find( \&wanted, $path );
+
+ foreach my $name ( sort { $exp{$a} <=> $exp{$b} } keys %exp ) {
+ $HTML .= $exp{$name} + 1 . " = $name / ";
+ }
+ $HTML .= $exp_count+1 . qq { = サムネイル<br>\n○ = 完了 / ● = 書き込み中<br>\n};
+ $HTML .= qq {<table summary="listtable" border=1 cellspacing=0>\n<tr>\n};
+ $HTML .= qq {<th>タイトル</th>\n};
+ $HTML .= qq {<th>$_</th>\n} for ( 1..$exp_count + 1 );
+ $HTML .= qq {<th colspan="2">自動移動</th>\n};
+ $HTML .= qq {</tr>\n};
+
+ foreach ( sort keys %list ) {
+ my $value = $list{$_};
+ my @flag = ( 0 ) x $exp_count;
+ $HTML .= qq {<tr>\n<td width="600" style="width: 600px; white-space: normal">$_</td>\n};
+ foreach ( keys %{$value} ) {
+ my $tmp = $_;
+ $flag[$exp{$tmp}] = $value->{$_};
+ }
+ foreach ( @flag ) {
+ my $size = $_->{size};
+ my $last = $_->{last} || '○';
+ my $check = $size ? qq {<span title="$size">$last</span>} : '<br>';
+ $HTML .= qq {<td>$check</td>\n};
+ }
+ if ( $flag[$exp{mkv}] ) {
+ s/#/＃/g;
+ s/ /\+/g;
+ my $img = $value->{mkv}->{img};
+ $HTML .= qq {<td><a href="rectool.pl?mode=thumb&title=$img">■</a></td>\n};
+ my $pre = qq {<a href="rectool.pl?mode=move&type=predict&title=$_">予測</a>};
+ $HTML .= qq {<td>$pre</td>\n};
+# my $exe = qq {<a href="rectool.pl?mode=move&type=exec&title=$_">実行</a>};
+ my $exe = qq {実行};
+ $HTML .= qq {<td>$exe</td>\n};
+ }
+ else {
+ $HTML .= qq {<td><br></td>\n<td colspan="2"><br></td>\n};
+ }
+ $HTML .= qq {</tr>\n};
+ }
+ $HTML .= qq {</table>\n};
+
+ sub wanted {
+ return if ( !$_ );
+ return if ( -d $File::Find::name );
+ return if ( $_ eq 'Thumbs.db' );
+ return if ( /\.idx/ );
+ s/\.temp$//;
+ my $regexp = join '|', keys %exp;
+ my ( $title, $exp ) = /(.*?)\.($regexp)$/;
+ my ( $size, $last ) = &get_size( $File::Find::name );
+ my $img;
+ $File::Find::name =~ s/\.temp$//;
+ if ( $title !~ /[^0-9A-F]/ ) {
+ $title = pack( 'H*', $title );
+ $title = 'Base16_'.$title;
+ }
+ if ( $_ =~ /mkv/ ) {
+ my $tmp = $title;
+ $tmp =~ s/#/＃/g;
+ $tmp =~ s/ /\+/g;
+ $img = $tmp;
+# $img = qq {<img width=160 height=120 src="rectool.pl?mode=thumb&title=$tmp"><br>\n};
+ }
+ die $_ if ( !$title );
+ $list{$title}->{$exp} = { 'last' => $last, 'size' => $size, 'img' => $img };
+ }
+ }
+
+ sub simple_list {
+ local $path = shift;
+ local @list = ();
+
+ File::Find::find( \&simple_wanted, $path );
+
+ @list = sort @list;
+ foreach ( @list ) {
+ $HTML .= "$_<br>\n";
+ }
+
+ sub simple_wanted {
+ return if ( !$_ );
+ return if ( -d $File::Find::name );
+ return if ( $_ eq 'Thumbs.db' );
+ my ( $size ) = &get_size( $File::Find::name );
+ $File::Find::name =~ s/\Q$path\E//;
+ push @list, $File::Find::name ."\t\t". $size;
+ }
+ }
+
+ sub get_size {
+ my $file = shift;
+ my ( $size, $last ) = (stat( $file ))[7,9];
+ my @unim = ("B","KB","MB","GB","TB","PB");
+ my $count = 0;
+
+ while($size >= 1024 ){
+ $count++;
+ $size = $size / 1024;
+ }
+ $size *= 100;
+ $size = int( $size );
+ $size /= 100;
+ if ( time - $last < 10 ) {
+ $last = '●';
+ }
+ else {
+ $last = '';
+ }
+ return ( "$size $unim[$count]", $last );
+ }
+}
+
+if ( $mode eq 'move' ) {
+ my $type = $q->param( 'type' );
+ my $title = $q->param( 'title' );
+ $title =~ s/＃/#/g;
+ $title =~ s/\+/ /g;
+
+ if ( $type eq 'predict' ) {
+ eval '$HTML .= `python26 ' . $cfg->param( 'path.rec10' ) . "classify.py -s '$title'`";
+ }
+ elsif ( $type eq 'exec' ) {
+ eval '$HTML .= `python26 ' . $cfg->param( 'path.rec10' ) . "classify.py -e '$title'`";
+ }
+}
+
+if ( $mode eq 'thumb' ) {
+ my $title = $q->param( 'title' );
+ my $pos = $q->param( 'pos' );
+ my $recording = $cfg->param( 'path.recpath' );
+ $title =~ s/\+/ /g;
+ $title =~ s/＃/#/g;
+
+ print "Content-Type: image/jpeg\n\n";
+ exec "ffmpeg -ss 300 -i '$recording/$title.mkv' -f image2 -pix_fmt jpg -vframes 1 -s 320x240 -";
+ exit;
+}
+
+if ( $mode eq 'check' ) {
+}
+
+if ( $mode eq 'expert' ) {
+ my $ary_ref;
+ my $type = $q->param( 'type' );
+ $HTML =~ s/%HTML_TITLE_OPT%/ - Expert/;
+ $HTML .= qq {<div>\n};
+
+ if ( $type eq 'reget' ) {
+ my $display = $q->param( 'ch' );
+ my $SQL_WHERE;
+ if ( $display =~ /^bs$|^cs.$/ ) {
+ $SQL_WHERE = "chdata.bctype = '$display'";
+ }
+ else {
+ $SQL_WHERE = "display = '$display'";
+ }
+ my $ontv = $dbh->selectrow_array(
+ "SELECT ontv FROM ch
+ INNER JOIN chdata ON ch.channel = chdata.ontv
+ WHERE $SQL_WHERE " );
+ $dbh->do( "UPDATE chdata SET status = '2' WHERE ontv = '$ontv' " );
+ goto end;
+ }
+
+
+ $ary_ref = $dbh->selectcol_arrayref(
+ "SELECT DISTINCT category FROM tv"
+ );
+ # 一時的
+ my @category = map { $category{$_} . $_ } sort keys %category;
+ # my @category = sort keys %category;
+ $HTML .= qq {<hr>\n番組表のカテゴリ一覧と内蔵の一覧の合致を確認中...\n};
+ # $HTML .= qq {番組表：@{$ary_ref}<br>\n内蔵：@category<br>\n};
+ if ( List::Compare->new( $ary_ref, \@category )->get_symdiff ) {
+ $HTML .= qq {一致しません<br>\n};
+ }
+ else {
+ $HTML .= qq {一致しました<br>\n};
+ }
+
+ my @ary = $dbh->selectrow_array( "SELECT terec, bscsrec, b252ts, ts2avi FROM status" );
+ $HTML .= qq {<hr>\n地上波録画数：$ary[0]\n衛星波録画数：$ary[1]\n解読数：$ary[2]\n縁故数：$ary[3]\n<br>\n};
+
+ use List::Compare;
+ $ary_ref = $dbh->selectall_arrayref( "SELECT display, channel FROM ch INNER JOIN chdata ON ch.channel = chdata.ontv" );
+ my $prev;
+ $HTML .= "<hr>\n番組表の欠落<br>\n";
+ foreach my $line ( @{$ary_ref} ) {
+ my $ary_ref = $dbh->selectall_arrayref( "SELECT start, stop, title FROM tv WHERE channel = '$line->[1]' ORDER BY start" );
+ my $error;
+ my @program_old = ( '', $ary_ref->[0]->[0] );
+ my $program_old = \@program_old;
+
+ foreach my $program_new ( @{$ary_ref} ) {
+ if ( $program_old->[1] ne $program_new->[0] &&
+ $program_old->[2] !~ /クロ−ジング|クロージング|エンディング|休止|ミッドナイトプレゼント/ &&
+ $program_new->[2] !~ /オープニング|ウィークリー・インフォメーション|モーニングプレゼント/ &&
+ ( str2datetime( $program_new->[0], 1 ) - str2datetime( $program_old->[1], 1 ) )->delta_minutes > 30 ) {
+ $program_old->[1] =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/;
+ $program_new->[0] =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/;
+ $error .= qq{ $program_old->[2] $program_old->[1]\n 〜 $program_new->[2] $program_new->[0]\n};
+ }
+ $program_old = $program_new;
+ }
+ $HTML .= qq {<pre>\n$line->[0]\n$error</pre>\n} if ( $error );
+ }
+
+ $ary_ref = $dbh->selectall_arrayref(
+ "SELECT display, chtxt, ontv, chdata.bctype, ch, csch, updatetime, status FROM chdata
+ INNER JOIN ch ON ch.channel = chdata.ontv
+ ORDER BY bctype " );
+ $HTML .= qq {<hr>\n番組表の更新状況<br>\n};
+ $HTML .= qq {<table summary="channeltable" border=1 cellspacing=0>\n<tr>\n};
+ $HTML .= qq {<th>チャンネル名</th>\n};
+ $HTML .= qq {<th>チャンネルコード</th>\n};
+ $HTML .= qq {<th>ontvコード</th>\n};
+ $HTML .= qq {<th>タイプ</th>\n};
+ $HTML .= qq {<th>ch</th>\n};
+ $HTML .= qq {<th>csch</th>\n};
+ $HTML .= qq {<th>最終更新時刻</th>\n};
+ $HTML .= qq {<th>状態</th>\n};
+ $HTML .= qq {</tr>\n};
+ foreach my $status ( @{$ary_ref} ) {
+ $HTML .= qq {<tr>\n};
+ $HTML .= qq {<td>$status->[0]</td>\n<td>$status->[1]</td>\n<td>$status->[2]</td>\n<td>$status->[3]</td>\n};
+ $HTML .= qq {<td>$status->[4]</td>\n<td>$status->[5]</td>\n<td>$status->[6]</td>\n<td>$status->[7]</td>\n};
+ $HTML .= qq {</tr>\n};
+ }
+ $HTML .= qq {</table>\n};
+
+ $HTML .= qq {<form method="get" action="rectool.pl">\n};
+ $HTML .= qq {<div>\n};
+ $HTML .= qq {番組表を再取得する\n};
+ $HTML .= qq {<input type="hidden" name="mode" value="expert">\n};
+ $HTML .= qq {<input type="hidden" name="type" value="reget">\n};
+ $HTML .= qq {<select name="ch">\n};
+ $ary_ref = $dbh->selectcol_arrayref(
+ "SELECT display FROM ch INNER JOIN chdata ON ch.channel = chdata.ontv WHERE chdata.bctype NOT LIKE '_s%' "
+ );
+ foreach my $ch ( @{$ary_ref} ) {
+ $HTML .= qq {<option value="$ch">$ch</option>\n};
+ }
+ $HTML .= qq {<option value="bs">BS</option>\n};
+ $HTML .= qq {<option value="cs1">CS1</option>\n};
+ $HTML .= qq {<option value="cs2">CS2</option>\n};
+ $HTML .= qq {</select>\n};
+ $HTML .= qq {<input type="submit" value="実行">\n</div>\n</form>\n};
+
+
+
+ $ary_ref = $dbh->selectall_arrayref(
+ "SELECT id, type, rectime.chtxt, title, btime, etime, deltaday, deltatime
+ FROM rectime
+ ORDER BY id ");
+ $HTML .= qq {<hr>\n予約表<br>\n};
+ $HTML .= qq {<table summary="rectimetable" border=1 cellspacing=0>\n<tr>\n};
+ $HTML .= qq {<th>ID</th>\n};
+ $HTML .= qq {<th>type</th>\n};
+ $HTML .= qq {<th>chtxt</th>\n};
+ $HTML .= qq {<th>title</th>\n};
+ $HTML .= qq {<th>btime</th>\n};
+ $HTML .= qq {<th>etime</th>\n};
+ $HTML .= qq {<th>deltaday</th>\n};
+ $HTML .= qq {<th>deltatime</th>\n};
+ $HTML .= qq {</tr>\n};
+ foreach my $status ( @{$ary_ref} ) {
+ $HTML .= qq {<tr>\n};
+ $HTML .= qq {<td>$status->[0]</td>\n<td>$status->[1]</td>\n<td>$status->[2]</td>\n<td>$status->[3]</td>\n};
+ $HTML .= qq {<td>$status->[4]</td>\n<td>$status->[5]</td>\n<td>$status->[6]</td>\n<td>$status->[7]</td>\n};
+ $HTML .= qq {</tr>\n};
+ }
+ $HTML .= qq {</table>\n};
+}
+
+if ( $mode eq 'help' ) {
+ $HTML =~ s/%HTML_TITLE_OPT%/ - Help/;
+ $HTML =~ s|%REFRESH%|<meta http-equiv="refresh" content="300">|;
+ $HTML .= qq {<div>\n};
+ $HTML .= qq {ヘルプ\n};
+}
+
+if ( $mode eq 'test' ) {
+ $HTML =~ s/%HTML_TITLE_OPT%/ - Test/;
+ $HTML =~ s|%REFRESH%|<meta http-equiv="refresh" content="300">|;
+ $HTML .= qq {<div>\n};
+
+ require Data::Dumper;
+ require Perl6::Slurp;
+ $tmp = Perl6::Slurp::slurp( 'config.ini' );
+ $tmp =~ s/\n/<br>\n/gs;
+ $HTML .= $tmp;
+
+ # $HTML .= Dumper( $ary_ref );
+}
+
+if ( !$mode ) {
+ &draw_form();
+ $HTML =~ s/%HTML_TITLE_OPT%/ - Top/;
+ $HTML .= qq {Welcome to Rec10!<br>\n};
+ goto end;
+}
+
+
+end:
+#<div style="float: right">
+$HTML .= <<EOM;
+</div>
+</body>
+</html>
+EOM
+
+#<div align="center">
+$HTML_ADV_TEXT = <<EOM;
+<script type="text/javascript"><!--
+google_ad_client = "pub-6837289609486635";
+/* 728x90, 作成済み 09/07/20 */
+google_ad_slot = "6679390404";
+google_ad_width = 728;
+google_ad_height = 90;
+//-->
+</script>
+<script type="text/javascript"
+src="http://pagead2.googlesyndication.com/pagead/show_ads.js">
+</script>
+EOM
+
+$HTML_ADV_IMG = <<EOM;
+<script type="text/javascript"><!--
+google_ad_client = "pub-6837289609486635";
+/* 728x90, 作成済み 09/07/20 */
+google_ad_slot = "5941705087";
+google_ad_width = 728;
+google_ad_height = 90;
+//-->
+</script>
+<script type="text/javascript"
+src="http://pagead2.googlesyndication.com/pagead/show_ads.js">
+</script>
+EOM
+
+#$HTML_ADV = $HTML_ADV_IMG . $HTML_ADV_TEXT if ( !$HTML_ADV );
+$HTML_HEADER = qq {<div style="text-align: center">\n$HTML_ADV\n</div>\n};
+
+&draw_menu();
+$HTML =~ s/%HTML_TITLE_OPT%//;
+$HTML =~ s/%REFRESH%//;
+$HTML =~ s/%SCRIPT%//;
+$HTML =~ s/%CSS%//;
+$HTML =~ s/%HTML_HEADER%/$HTML_HEADER/;
+
+print $HTTP_HEADER;
+print $HTML;
+
+sub draw_menu {
+ $hires = Time::HiRes::time() - $hires;
+ $last_modified = localtime((stat 'rectool.pl')[9]);
+
+ $HTML_HEADER .= qq {<div>\n};
+ $HTML_HEADER .= qq {<span style="float: right; font-size: 8px">Last-Modified: $last_modified<br>Time-Elasped: $hires秒</span>\n};
+ $HTML_HEADER .= qq {<span style="float: left">\n};
+ $HTML_HEADER .= qq {<a href="rectool.pl">トップ</a>\n};
+ $HTML_HEADER .= qq {<a href="rectool.pl?mode=schedule">予約確認</a>\n};
+ $HTML_HEADER .= qq {<a href="rectool.pl?mode=graph">予約状況(画像版)</a>\n};
+ $HTML_HEADER .= qq {<a href="rectool.pl?mode=list">録画一覧</a>\n};
+# $HTML_HEADER .= qq {<a href="rectool.pl?mode=edit">新規予約</a>\n};
+ $HTML_HEADER .= qq {<a href="../rec10web/rec10web.py">新規予約</a>\n};
+ $HTML_HEADER .= qq {</span>\n};
+ $HTML_HEADER .= qq {<hr style="clear: both; background-color: grey; height: 4px">\n};
+ $HTML_HEADER .= qq {</div>\n};
+}
+
+sub draw_form {
+ $channel = $dbh->selectrow_array("SELECT channel FROM ch WHERE display = '$display' ");
+
+ # チャンネル指定
+ $HTML .= qq {<div style="float: left">\n};
+ $HTML .= qq {<form method="get" action="rectool.pl">\n};
+ $HTML .= qq {<div>\n};
+ $HTML .= qq {<input type="hidden" name="mode" value="program">\n};
+ $HTML .= qq {<select name="ch">\n<option value="" selected>無指定</option>\n};
+ $ary_ref = $dbh->selectcol_arrayref(
+ "SELECT display FROM ch INNER JOIN chdata ON ch.channel = chdata.ontv"
+ );
+ foreach my $ch ( @{$ary_ref} ) {
+ if ( $ch eq $display ) {
+ $HTML .= qq {<option value="$ch" selected>$ch</option>\n};
+ }
+ else {
+ $HTML .= qq {<option value="$ch">$ch</option>\n};
+ }
+ }
+ $HTML .= qq {</select>\n};
+
+ # 日付指定
+ $HTML .= qq {<select name="date">\n<option value="" selected>無指定</option>\n};
+ $ary_ref = $dbh->selectcol_arrayref(
+ "SELECT DISTINCT $SQL{'SUBSTR'} FROM tv"
+ );
+ $date_sel = $q->param( 'date' );
+ foreach my $date ( @{ $ary_ref } ) {
+ my @date = $date =~ /(.{4})(.{2})(.{2})/;
+ $date_prt = "$date[1]/$date[2]";
+
+ if ( $date eq $date_sel ) {
+ $HTML .= qq {<option value="$date" selected>$date_prt</option>\n};
+ }
+ else {
+ $HTML .= qq {<option value="$date">$date_prt</option>\n};
+ }
+ }
+ $HTML .= qq {</select>\n};
+
+ # カテゴリ指定
+ $HTML .= qq {<select name="category">\n<option value="" selected>無指定</option>\n};
+ $category_sel = $q->param( 'category' );
+ foreach my $category ( keys %category ) {
+ if ( $category eq $category_sel ) {
+ $HTML .= qq {<option value="$category" selected>$category{$category}</option>\n};
+ }
+ else {
+ $HTML .= qq {<option value="$category">$category{$category}</option>\n};
+ }
+ }
+ $HTML .= qq {</select>\n};
+
+ # キーワード指定
+ $HTML .= qq {<input name="key" type="text" value="$key" style="width:200px">\n};
+
+ # フォーム描画
+ $HTML .= qq {<input type="submit" value="更新">\n</div>\n</form>\n};
+}
+
+sub parse_program {
+ @start = $start =~ /(.{4})(.{2})(.{2})(.{2})(.{2})/;
+ @stop = $stop =~ /(.{4})(.{2})(.{2})(.{2})(.{2})/;
+ $channel = $dbh->selectrow_array("SELECT channel FROM ch WHERE display = '$display'");
+ $title = $dbh->selectrow_array("SELECT title FROM tv WHERE channel = '$channel' AND start = '$start' AND stop = '$stop' ");
+ $chtxt = $dbh->selectrow_array("SELECT chtxt FROM chdata WHERE ontv = '$channel'");
+ $bctype = $dbh->selectrow_array("SELECT bctype FROM chdata WHERE ontv = '$channel'");
+ if ( $bctype =~ /.s/ ) {
+ $bctype = '_s%';
+ }
+ elsif ( $bctype =~ /te/ ) {
+ $bctype = 'te%';
+ }
+ $begin = sprintf( '%04d-%02d-%02d %02d:%02d:%02d', @start, '00' );
+ $end = sprintf( '%04d-%02d-%02d %02d:%02d:%02d', @stop , '00' );
+}
+
+sub check_error {
+ my $is_error = 1;
+ my @overlap = &get_overlap();
+
+ if ( $dbh->selectrow_array(
+ "SELECT COUNT(*) FROM rectime
+ WHERE chtxt = '$chtxt' AND btime = '$begin' AND etime = '$end'"
+ ) ) {
+ $HTML .= "同一の番組が既に存在します。<br>\n";
+ }
+ elsif ( $overlap[0] >= 2 ) {
+ $HTML .= "時間が被る番組が既に2個存在します。<br>\n";
+ $HTML .= $overlap[1];
+ }
+ else {
+ $is_error = 0;
+ }
+ return $is_error;
+}
+
+sub get_overlap {
+ require List::Util;
+
+ my $ary_ref = $dbh->selectall_arrayref(
+ "SELECT btime, etime, title
+ FROM rectime
+ INNER JOIN chdata ON rectime.chtxt = chdata.chtxt
+ WHERE bctype LIKE '$bctype' AND type IN ( 'rec', 'res', 'key', 'keyevery', 'tsrecording' )
+ AND btime < '$end'
+ AND etime > '$begin'
+ "
+ );
+
+ my %overlap;
+ my $overlap = $max = 0;
+ my $str;
+ foreach my $prg ( @{ $ary_ref } ) {
+ $str .= "$prg->[0] 〜 $prg->[1] : $prg->[2]<br>\n";
+ $overlap{$prg->[0]} += 1;
+ $overlap{$prg->[1]} -= 1;
+ }
+ foreach my $key ( sort keys %overlap ) {
+ $overlap += $overlap{$key};
+ $max = List::Util::max( $max, $overlap );
+ }
+ if ( wantarray ) {
+ return ( $max, $str );
+ }
+ else {
+ return $max;
+ }
+}
+
+sub str2datetime {
+ my $str = shift;
+ my $joined = shift;
+ my @time;
+
+ if ( $joined ) {
+ @time = $str =~ /(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/;
+ }
+ else {
+ @time = $str =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/;
+ }
+ return DateTime->new(
+ year => $time[0], month => $time[1], day => $time[2],
+ hour => $time[3], minute => $time[4], second => $time[5],
+ );
+}
+
OSDN Git Service
