use Time::Seconds;
use Date::Simple;
use DateTime;
-use CGI::Minimal;
+use CGI;
use MIME::Base64;
use Config::Simple;
use Time::HiRes;
use Tie::IxHash;
use Perl6::Slurp;
use Sort::Naturally;
+use Algorithm::Diff qw(LCS);
#require SVG Time::Simple XML::Atom Encode Text::Ngram List::Compare List::Util
-#use utf8;
+use utf8;
+#%DB::packages = ( 'main' => 1 );
################ バージョン定義 ################
-my $rectool_version = 98;
+my $rectool_version = 100;
################ 初期化ここから ################
-%DB::packages = ( 'main' => 1 );
my $tz = DateTime::TimeZone->new( name => 'local' );
my $hires = Time::HiRes::time();
my $cfg = new Config::Simple;
-if ( -e '/etc/rec10.conf' ) {
+if ( -e 'rec10.conf' ) {
+ $cfg->read( 'rec10.conf' );
+}
+elsif ( -e '/etc/rec10.conf' ) {
$cfg->read( '/etc/rec10.conf' );
}
+else {
+ die 'rec10.confが見つかりません。';
+}
my $sql = $cfg->param( 'db.db' );
$dbh = DBI->connect("dbi:mysql:$name:$host:$port", $user, $pass, {
AutoCommit => 1,
RaiseError => 1,
+ mysql_enable_utf8 => 1, # only availavle for MySQL
});
$dbh->do( 'SET NAMES utf8' );
}
$HTML .= qq {Rec10のバージョンアップを行ってください。<br>\n};
}
- $HTML .= qq {Rec10のバージョンは$rec10_version、rectoolのバージョンは$rectool_versionです。<br>\n};
+ $HTML .= qq {Rec10のバージョンは$rec10_version 、rectoolのバージョンは$rectool_version です。<br>\n};
$HTML .= qq {<a href="http://sourceforge.jp/projects/rec10/">公式ページ</a>\n};
goto end;
}
-$q = new CGI::Minimal;
-$mode = $q->param( 'mode' );
-$mode_sub = $q->param( 'mode_sub' );
+$q = new CGI;
+%params = $q->Vars;
+$mode = $params{ 'mode' };
+$mode_sub = $params{ 'mode_sub' };
+
+################ %chtxt_chnameの準備 ################
+
+my %chtxt_chname;
+my %chtxt_0_chname;
+tie %chtxt_0_chname, 'Tie::IxHash';
+
+my $ary_ref = $dbh->selectall_arrayref(
+ "SELECT chtxt, chname, ch, bctype FROM epg_ch
+ WHERE visible = 1"
+);
+
+%chtxt_chname = map { $_->[0], $_->[1] } @{$ary_ref};
+
+# NHK BS 1/2/hiをBS/CSから除外(101-103) - by 2011/04
+# te: 地上波、BSのNHK以外
+# bc: BSのNHK、CS
+my @te_ary = grep $_->[0]=~ /^\d|BS_(?!10[1-3])/, @{$ary_ref};
+my @bc_ary = grep $_->[0]!~ /^\d|BS_(?!10[1-3])/, @{$ary_ref};
+
+# teの操作(まとめる)
+foreach my $line ( @te_ary ) {
+ # te xx_yyyy(chtxt) -> xx(ch)
+ if ( $line->[3] =~ /te/ ) {
+ push @{ $chtxt_0_chname{ $line->[2] . '_0'} }, $line->[1];
+ }
+ else {
+ push @{ $chtxt_0_chname{'BS_' . $line->[2] } }, $line->[1];
+ }
+}
+foreach my $key ( keys %chtxt_0_chname ) {
+ my @chname = @{ $chtxt_0_chname{$key} };
+ if ( @chname >= 2 ) {
+ # 2つ以上ある場合
+ my @tmp = map { my @ary = split //, $_; \@ary } @chname;
+ # 1つ目と2つ目のみ比較
+ # FIXME: すべてを比較するべき
+ $chtxt_0_chname{$key} = join '', LCS( $tmp[0], $tmp[1] );
+ }
+ else {
+ # 1つしかない場合
+ $chtxt_0_chname{$key} = $chname[0];
+ }
+}
+
+# bs/csの操作(そのまま)
+foreach my $line ( @bc_ary ) {
+ $chtxt_0_chname{$line->[0]} = $line->[1];
+}
+undef $ary_ref;
################ 定数宣言 ################
################ 初期化ここまで ################
+################ mode=schedule ################
+
if ( $mode eq 'schedule' ) {
$HTML =~ s/%HTML_TITLE_OPT%/ - Schedule Viewer/;
-# $HTML =~ s|%REFRESH%|<meta http-equiv="refresh" content="300">|;
+ #$HTML =~ s|%REFRESH%|<meta http-equiv="refresh" content="300">|;
$css = <<EOM;
<style type="text/css">
td {
$css =~ s/^\t{2}//gm;
$HTML =~ s/%CSS%/$css/;
- my $order = $q->param( 'order' );
- my $extra = $q->param( 'extra' );
+ my $order = $params{ 'order' };
+ my $extra = $params{ 'extra' };
if ( $order ne 'id' ) {
$order = 'btime';
}
$forward_order = $order eq 'btime' ? '' : '&order=id';
my $ary_ref = $dbh->selectall_arrayref(
- "SELECT id, type, epg_ch.chtxt, epg_ch.ontv, epg_ch.chname, title, btime, etime, opt, deltaday, deltatime,
+ "SELECT id, type, timeline.chtxt, epg_ch.chname, title, btime, etime, opt, deltaday, deltatime,
epgtitle, epgbtime, epgetime, epgexp, epgduplicate, epgchange, counter
FROM timeline
- INNER JOIN epg_ch ON timeline.chtxt = epg_ch.chtxt
- ORDER BY $order");
+ LEFT OUTER JOIN epg_ch ON timeline.chtxt = epg_ch.chtxt
+ ORDER BY $order"
+ , {Slice=>{}});
$HTML .= qq {<div style="font-size: 80%; float: left">\n};
$HTML .= qq {<form method="get" action="rectool.pl">\n};
$HTML .= qq {</tr>\n};
foreach my $line ( @{ $ary_ref } ) {
- $type = $type{$line->[1]} || $line->[1];
- if ( $line->[1] =~ /^search/ ) {
+ $type = $type{$line->{type}} || $line->{type};
+ if ( $line->{type} =~ /^search/ ) {
$type = qq {<span style="color: #8B008B">$type</span>};
- $line->[9] = qq {<span style="color: #FF0000">空</span>} if ( !$line->[9] && $line->[1] eq 'search_everyday' );
- $line->[10] = qq {<span style="color: #FF0000">空</span>} if ( !$line->[10] );
+ $line->{deltaday} = qq {<span style="color: #FF0000">空</span>} if ( !$line->{deltaday} && $line->{type} eq 'search_everyday' );
+ $line->{deltatime} = qq {<span style="color: #FF0000">空</span>} if ( !$line->{deltatime} );
}
else {
- my $color = $color{$line->[1]} ? $color{$line->[1]} : $color{'other'};
+ my $color = $color{$line->{type}} ? $color{$line->{type}} : $color{'other'};
$type = qq {<span style="color: $color">$type</span>};
}
- $chname_encoded = $q->url_encode( $line->[4] );
- $line->[5] = 'タイトルなし' if ( !$line->[5] );
- my $unix_6 = str2datetime( $line->[6] );
- my $unix_7 = str2datetime( $line->[7] );
-
- 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] =~ /^search_|^reserve_/ ) {
-# my @ary = $dbh->selectrow_array(
-# "SELECT title, exp FROM epg_timeline
-# WHERE channel = '$line->[3]'
-# AND start = '$btime'
-# AND stop = '$etime' ");
- my @ary = ( $line->[11], $line->[14] );
-
- if ( $ary[0] ) {
- $ary[0] =~ s/無料≫//;
-
- if ( $ary[0] ne $line->[5] ) {
- my $count = $ary[0] =~ s/\Q$line->[5]\E//;
- if ( !$count ) {
- my $href = qq {<a href="rectool.pl?mode=edit&id=$line->[0]&suggest=auto">自動検索</a>};
- $ary[0] = qq {<span style="color: #FF4000">$ary[0]■$href■</span>};
+ # 地上波の場合、xx_yyyをxx_0に置換する
+ ( $line->{chtxt_0} = $line->{chtxt} ) =~ s/(\d+)_/$1_0/;
+ # chnameが無いとき(移動縁故など)、chtxtを代わりに使う
+ $line->{chname} =
+ $line->{chname} ||
+ $chtxt_0_chname{$line->{chtxt}} ||
+ $chtxt_0_chname{$line->{chtxt_0}};
+ if ( !$line->{chname} ) {
+ # chnameが無いとき、リンクを作成しない
+ $line->{chname} = $line->{chtxt};
+ $line->{chname_link} = qq {$line->{chname}</a>};
+ }
+ else {
+ $line->{chname_link} = qq {<a href="rectool.pl?mode=program&chtxt=$line->{chtxt}">$line->{chname}</a>};
+ }
+ $line->{title} = 'タイトルなし' if ( !$line->{title} );
+ $line->{tr_style} = '';
+ $line->{title_2} = '';
+ my $unix_b = str2datetime( $line->{btime} );
+ my $unix_e = str2datetime( $line->{etime} );
+
+ my $btime = $unix_b->strftime( '%Y%m%d%H%M%S' );
+ my $etime = $unix_e->strftime( '%Y%m%d%H%M%S' );
+ if ( $extra and $line->{type} =~ /^search_|^reserve_(?!running)/ ) {
+ #my @ary = $dbh->selectrow_array(
+ # "SELECT title, exp FROM epg_timeline
+ # WHERE channel = '$line->{chname}'
+ # AND start = '$btime'
+ # AND stop = '$etime' ");
+ #my @ary = ( $line->{epgtitle}, $line->{epgexp} );
+ my ( $epgtitle, $epgexp ) = ( $line->{epgtitle}, $line->{epgexp} );
+
+ if ( $epgtitle ) {
+ $epgtitle =~ s/無料≫//;
+
+ if ( $epgtitle ne $line->{title} ) {
+ # epgtitleとtitleが一致しない
+ # []に囲まれた部分を除去して比較
+ my @brackets = $line->{title} =~ /(\[.+\])+/;
+ my $epgtitle_nobrackets = $epgtitle;
+ my $title_nobrackets = $line->{title};
+ if ( @brackets && $epgtitle =~ /(\[.+\])+/ >= @brackets ) {
+ foreach ( @brackets ) {
+ $epgtitle_nobrackets =~ s/\Q$_\E//;
+ }
+ }
+ $title_nobrackets =~ s/(\[.+\])+//;
+ if ( !scalar $epgtitle_nobrackets =~ s/\Q$title_nobrackets\E// ) {
+ # epgtitleにtitleが含まれていない
+ my $href = qq {<a href="rectool.pl?mode=edit&id=$line->{id}&suggest=auto">自動検索</a>};
+ $epgtitle = qq {<span style="color: #FF4000">$epgtitle■$href■</span>};
+ }
+ else {
+ # epgtitleにtitleが含まれている
+ $epgtitle = $epgtitle_nobrackets;
}
}
else {
- $ary[0] = '説明';
+ # epgtitleとtitleが一致している
+ $epgtitle = '説明';
}
- $line->[5_2] = qq {<div style="float: right; cursor: help" title="$ary[1]">$ary[0]</div>};
+ $line->{title_2} = qq {<div style="float: right; cursor: help" title="$epgexp">$epgtitle</div>};
}
else {
- my $href = qq {<a href="rectool.pl?mode=edit&id=$line->[0]&suggest=auto">自動検索</a>};
- $line->[5_2] = qq {<span style="float: right; color: #FF0000">■$href■</span>};
+ # epgtitleがない
+ my $href = qq {<a href="rectool.pl?mode=edit&id=$line->{id}&suggest=auto">自動検索</a>};
+ $line->{title_2} = qq {<span style="float: right; color: #FF0000">■$href■</span>};
+ $line->{tr_style} = qq {style="background-color: #A0A0A0"};
}
}
- my ( $begin, $end, $diff ) = &str2readable( $unix_6, $unix_7 );
+ my ( $begin, $end, $diff ) = &str2readable( $unix_b, $unix_e );
- my $hr;
+ my $hr = '';
if (
- $line->[1] eq 'reserve_running'
+ $line->{type} eq 'reserve_running'
&&
- $unix_6->epoch <= time && time <= $unix_7->epoch
+ $unix_b->epoch <= time && time <= $unix_e->epoch
)
{
- $percent = int( ( 100 * ( time - $unix_6->epoch ) ) / ( $unix_7->epoch - $unix_6->epoch ) );
+ $percent = int( ( 100 * ( time - $unix_b->epoch ) ) / ( $unix_e->epoch - $unix_b->epoch ) );
$hr .= qq {<hr style="margin: 0 auto 0 0; height: 4px; width: $percent%;};
$hr .= qq { background-color: blue; border: none" title="$percent%">};
}
- $line->[5] = qq {<a href="rectool.pl?mode=edit&id=$line->[0]">$line->[5]</a>};
-# $line->[5] = qq {<div style="float: left">$line->[5]</div>} if ( $line->[5_2] );
- $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};
+ $line->{title} = qq {<a href="rectool.pl?mode=edit&id=$line->{id}">$line->{title}</a>};
+ #$line->{title} = qq {<div style="float: left">$line->{title}</div>} if ( $line->{title_2} );
+ $HTML .= qq {<tr align="center" $line->{tr_style}>\n};
+ $HTML .= qq {<td><input type="checkbox" name="id" value="$line->{id}"></td>\n};
+ $HTML .= qq {<td>$line->{id}</td>\n};
$HTML .= qq {<td>$type</td>\n};
- $HTML .= qq {<td><a href="rectool.pl?mode=program&chtxt=$line->[2]">$line->[2]</a></td>\n};
- $HTML .= qq {<td align="left" style="white-space: normal">$line->[5]$line->[5_2]</td>\n};
+ $HTML .= qq {<td>$line->{chname_link}</td>\n};
+ $HTML .= qq {<td align="left" style="white-space: normal">$line->{title}$line->{title_2}</td>\n};
$HTML .= qq {<td>$begin</td>\n<td>$end</td>\n};
$HTML .= qq {<td>$hr$diff</td>\n};
- $HTML .= qq {<td>$line->[8]</td>\n<td>$line->[9]</td>\n<td>$line->[10]</td>\n<td>$line->[17]</td>\n};
+ $HTML .= qq {<td>$line->{opt}</td>\n<td>$line->{deltaday}</td>\n<td>$line->{deltatime}</td>\n<td>$line->{counter}</td>\n};
$HTML .= qq {</tr>\n};
}
$HTML .= qq {</table>\n};
-# $HTML .= qq {<input type="submit" name="edit" value="編集(要JS)">\n};
+ #$HTML .= qq {<input type="submit" name="edit" value="編集(要JS)">\n};
$HTML .= qq {<input type="submit" name="delete" value="削除">\n</div>\n</form>\n};
goto end;
}
+################ mode=graph ################
+
if ( $mode eq 'graph' ) {
- my $date = $q->param( 'date' );
+ my $date = $params{ 'date' };
if ( $date )
{
$today = $date eq Date::Simple->today() ? 1 : 0;
$tuner{terrestrial} = 2; #$cfg->param( 'env.te_max' );
- $tuner{satellite} = 4; #$cfg->param( 'env.bscs_max' );
+ $tuner{satellite} = 2; #$cfg->param( 'env.bscs_max' );
$tuner{all} = $tuner{terrestrial} + $tuner{satellite};
$hours = 24;
$width = 30 * $hours;
foreach my $bctype ( 'te%', '_s%' ) {
my $tuner = $bctype eq 'te%' ? $tuner{terrestrial} : $tuner{satellite};
my $ary_ref = $dbh->selectall_arrayref(
- "SELECT id, type, timeline.chtxt, title, btime, etime, opt FROM timeline
+ "SELECT id, title, timeline.chtxt, btime, etime, opt FROM timeline
INNER JOIN epg_ch ON timeline.chtxt = epg_ch.chtxt
WHERE epg_ch.bctype LIKE '$bctype'
AND type IN $type_user_made
'$graph_bgn 00:00' < etime AND etime <= '$graph_end 00:00'
)
ORDER BY id"
+ , {Slice=>{}}
);
foreach my $line ( @{ $ary_ref } ) {
- @start = $line->[4] =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2})/;
- @stop = $line->[5] =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2})/;
+ @start = $line->{btime} =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2})/;
+ @stop = $line->{etime} =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2})/;
$start = ( ( $day == $start[2] ? 0 : 24 * 60 ) + $start[3] * 60 + $start[4] ) * 0.5;
$stop = ( ( $day == $stop [2] ? 0 : 24 * 60 ) + $stop [3] * 60 + $stop [4] ) * 0.5;
$start = 0 if ( $start < 0 || $day > $start[2] ); # 月の変わり目はスルー
$stop = $width if ( $stop > $width );
- $begin = $line->[4];
- $end = $line->[5];
+ $begin = $line->{btime};
+ $end = $line->{etime};
my $ary = $dbh->selectall_arrayref(
"SELECT id, type, timeline.chtxt, title, btime, etime, opt FROM timeline
( btime >= '$end' )
)
ORDER BY id"
+ , {Slice=>{}}
);
my @ary = @{$ary};
for ( 0..$tuner - 1 ) {
- $f = 1;
- $i = $_;
- for ( 0..4 ) {
- $f = 0 if ( $line->[$_] ne $ary[$i]->[$_] );
+ my $f = 1;
+ my $i = $_;
+ for ( 'chtxt', 'btime', 'etime' ) {
+ $f = 0 if ( $line->{$_} ne $ary[$i]->{$_} );
}
if ( $f ) {
$slot = $i;
}
}
my ( $r, $g, $b ) = ( 0, 0, 0 );
- $r += 255 if ( $line->[6] =~ /a/ );
- $g += 255 if ( $line->[6] =~ /H/ );
- $b += 255 if ( $line->[6] =~ /2/ );
+ $r += 255 if ( $line->{opt} =~ /a/ );
+ $g += 255 if ( $line->{opt} =~ /H/ );
+ $b += 255 if ( $line->{opt} =~ /I/ );
if ( $r + $g + $b == 255 * 3 ){
$r = 0;
$g = 255;
$result;
}
$svg->anchor(
- -href => "rectool.pl?mode=edit&id=$line->[0]",
+ -href => "rectool.pl?mode=edit&id=$line->{id}",
target => '_blank',
- -title => html_escape( $line->[3] ),
+ -title => html_escape( $line->{title} ),
)->rectangle(
'x' => 50 + $start,
'y' => 30 + ( $bctype eq 'te%' ? 0 : $tuner{terrestrial} * 20 ) + $slot * 20,
$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 {予約状況一覧です。T1,T2は地上波、S1,S2はBS/CS、赤はアニメ、緑はHD、青はインターレースを示しています。<br>\n};
$HTML .= qq {SVGが利用可能なブラウザでご覧ください。<br>\n};
$ary_ref = $dbh->selectcol_arrayref(
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 );
+ #utf8::encode( $dn );
$HTML .= qq {$date[1]/$date[2]($dn)の予約状況<br>\n};
+ # <img src="">
$HTML .= qq {<object type="image/svg+xml" data="rectool.pl?mode=graph&date=$date" width="820">\n};
$HTML .= qq {SVG Image $date\n</object>\n<br>\n};
);
foreach my $line ( @{ $ary_ref } ) {
-# $HTML .= qq {$line->[0] $line->[1] $line->[2] $line->[3]<br>\n};
+ #$HTML .= qq {$line->[0] $line->[1] $line->[2] $line->[3]<br>\n};
}
}
}
}
+################ mode=atom ################
+
if ( $mode eq 'atom' ) {
require XML::Atom::Feed;
require XML::Atom::Entry;
}
}
+################ mode=edit ################
+
if ( $mode eq 'edit' ) {
- my $id = $q->param( 'id' );
+ my $id = $params{ 'id' };
$HTML =~ s/%HTML_TITLE_OPT%/ - Schedule Editor/;
$HTML .= qq {<div style="float: left">\n};
$HTML .= "スケジュール編集画面です。<br>\n";
$HTML .= "実装がとても適当なので、利用には細心の注意を払ってください。<br>\n<br>\n";
if ( $id ) {
+ # 予約の編集
&parse_program();
$button_bgn = $button_end = '';
}
else {
+ # 新規予約
$type = 'reserve_flexible';
$counter = -1;
$datetime_now = DateTime->now( time_zone => $tz )->set_second( 0 )->add( minutes => 1)->strftime( '%Y-%m-%d %H:%M:%S' );
.qq{<button type="button" onClick="shiftEndTime(1800);">+30m</button>};
}
- if ( $q->param( 'suggest' ) eq 'auto' ) {
+ if ( $params{ 'suggest' } eq 'auto' ) {
my @btime = $begin =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/;
my @etime = $end =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/;
my $btime = DateTime->new(
}
}
$HTML .= qq {</select>\n};
+
$HTML .= qq {チャンネル\n<select name="chtxt">\n};
- $ary_ref = $dbh->selectall_arrayref(
- "SELECT chtxt, chname FROM epg_ch"
- );
- foreach my $line ( @{$ary_ref} ) {
- if ( $line->[0] eq $chtxt ) {
- $HTML .= qq {<option value="$line->[0]" selected>$line->[1]</option>\n};
+ # 移動縁故など、チャンネルリスト内にchtxtが存在しない場合に備えて
+ $chtxt_0_chname{$chtxt} = $chname || $chtxt if ( !$chtxt_0_chname{$chtxt} );
+ foreach my $key ( sort keys %chtxt_0_chname ) {
+ if ( $key eq $chtxt || $key eq $chtxt_0 ) {
+ $HTML .= qq {<option value="$key" selected>$chtxt_0_chname{$key}</option>\n};
}
else {
- $HTML .= qq {<option value="$line->[0]">$line->[1]</option>\n};
+ $HTML .= qq {<option value="$key">$chtxt_0_chname{$key}</option>\n};
}
}
$HTML .= qq {</select><br>\n};
$HTML .= qq {<input type="submit" name="update" value="更新">\n</form>\n};
}
+################ mode=change ################
+
if ( $mode eq 'change' ) {
@id = $q->param( 'id' );
$HTML =~ s/%HTML_TITLE_OPT%/ - Change/;
$HTML .= qq {<div style="float: left">\n};
- if ( $q->param( 'delete' ) )
+ if ( $params{ 'delete' } )
{
if ( @id ) {
foreach my $id ( @id ) {
goto end;
}
}
- if ( $q->param( 'update' ) )
+ if ( $params{ 'update' } )
{
- $type = $q->param( 'type' );
- $chtxt = $q->param( 'chtxt' );
- $title = $q->param( 'title' );
- $begin = $q->param( 'begin' );
- $end = $q->param( 'end' );
- $deltaday = $q->param( 'deltaday' );
- $deltatime = $q->param( 'deltatime' );
- $opt = $q->param( 'opt' );
- $counter = $q->param( 'counter' );
+ $type = $params{ 'type' };
+ $chtxt = $params{ 'chtxt' };
+ $title = $params{ 'title' };
+ $begin = $params{ 'begin' };
+ $end = $params{ 'end' };
+ $deltaday = $params{ 'deltaday' };
+ $deltatime = $params{ 'deltatime' };
+ $opt = $params{ 'opt' };
+ $counter = $params{ 'counter' };
$id = $id[0];
if ( $id ) {
$dbh->do(
goto end;
}
if ( $mode_sub eq 'proc' ) {
- my $type = $q->param( 'type' );
- my $chtxt = $q->param( 'chtxt' ) || 'nhk-k';
- my $title = $q->param( 'title' );
+ my $type = $params{ 'type' };
+ my $chtxt = $params{ 'chtxt' } || 'nhk-k';
+ my $title = $params{ 'title' };
my @opt = $q->param( 'opt' );
my $opt = join '', @opt;
goto end;
}
if ( $mode_sub eq 'move' ) {
- my $mode_sub2 = $q->param( 'mode_sub2' );
- my $title = $q->param( 'title' );
+ my $mode_sub2 = $params{ 'mode_sub2' };
+ my $title = $params{ 'title' };
+ my $response;
$ENV{'LANG'} = 'ja_JP.UTF-8';
if ( $mode_sub2 eq 'predict' ) {
$HTML .= "移動後のシミュレーション結果です。\n<br>";
- eval '$HTML .= `python26 ' . $cfg->param( 'path.rec10' ) . "/classify.py -s '$title'`";
+ eval '$response = `python26 ' . $cfg->param( 'path.rec10' ) . "/classify.py -s '$title'`";
}
elsif ( $mode_sub2 eq 'exec' ) {
- eval '$HTML .= `python26 ' . $cfg->param( 'path.rec10' ) . "/classify.py -e '$title'`";
+ eval '$response = `python26 ' . $cfg->param( 'path.rec10' ) . "/classify.py -e '$title'`";
}
+ utf8::decode( $response );
+ $HTML .= $response;
goto end;
}
if ( $mode_sub eq 'setting' ) {
- my $jbk = $q->param( 'jbk' ) || '0';
- my $bayes = $q->param( 'bayes' ) || '0';
- my $del_tmp = $q->param( 'del_tmp' ) || '0';
- my $opt = $q->param( 'opt' ) || '';
- my $user = $q->param( 'user' ) || '';
- my $pass = $q->param( 'pass' ) || '';
+ my $jbk = $params{ 'jbk' } || '0';
+ my $bayes = $params{ 'bayes' } || '0';
+ my $del_tmp = $params{ 'del_tmp' } || '0';
+ my $opt = $params{ 'opt' } || '';
+ my $user = $params{ 'user' } || '';
+ my $pass = $params{ 'pass' } || '';
$dbh->do(
"UPDATE in_settings SET auto_jbk = '$jbk', auto_bayes = '$bayes',
goto end;
}
if ( $mode_sub eq 'fixstatus' ) {
- my $key = $q->param( 'terec' ) ? 'terec' : $q->param( 'bscsrec' ) ? 'bscsrec' :
- $q->param( 'b252ts' ) ? 'b252ts' : $q->param( 'ts2avi' ) ? 'ts2avi' : '';
+ my $key = $params{ 'terec' } ? 'terec' : $params{ 'bscsrec' } ? 'bscsrec' :
+ $params{ 'b252ts' } ? 'b252ts' : $params{ 'ts2avi' } ? 'ts2avi' : '';
- if ( $key ) {
- $dbh->do(
- "UPDATE in_status SET $key = 0"
- );
- }
- else {
- $HTML .= qq {パラメータが異常です。<br>\n};
- }
+ $dbh->do(
+ "UPDATE in_status SET $key = 0"
+ );
goto end;
}
}
+################ mode=confirm ################
+
if ( $mode eq 'confirm' ) {
if ( $mode_sub eq 'reserve' ) {
$HTML =~ s/%HTML_TITLE_OPT%/ - Reserver/;
&parse_program();
my $duration = ( str2datetime( $end ) - str2datetime( $begin ) )->delta_minutes;
- $title = $q->param( 'title' ) if ( !$title );
- $HTML .= "番組名：$title<br>\nチャンネル：$chname<br>\n放送継続時間：$duration分<br>\n番組内容：$desc<br>\n";
+ $HTML .= "番組名：$title<br>\nチャンネル：$chname<br>\n放送継続時間：$duration 分<br>\n番組内容：$desc<br>\n";
if ( $longdesc ) {
$longdesc =~ s/\\n/<br>\n/gs;
$HTML .= "番組内容(長)：$longdesc<br>\n";
# エラー
$ary_ref = $dbh->selectall_arrayref(
- "SELECT start, stop FROM epg_timeline WHERE channel = '$ontv' AND title = '$title' "
+ "SELECT start, stop FROM epg_timeline WHERE channel = '$chtxt' AND title = '$title' "
);
if ( $error != 1 ) {
$HTML .= "同一の番組の他の放送予定です。<br>\n";
else {
$HTML .= "録画予約の詳細設定を行ってください。<br>\n";
$HTML .= qq {<form method="get" action="rectool.pl">\n};
- $HTML .= qq {<input type="hidden" name="mode" value="reserve">\n};
- $HTML .= qq {<input type="hidden" name="chname" value="$chname">\n};
- $HTML .= qq {<input type="hidden" name="start" value="$start">\n};
- $HTML .= qq {<input type="hidden" name="stop" value="$stop">\n};
- $HTML .= qq {<input type="hidden" name="title" value="$title">\n} if ( $q->param( 'title' ) );
+ $HTML .= qq {<input type="hidden" name="mode" value="reserve">\n};
+ $HTML .= qq {<input type="hidden" name="chtxt" value="$chtxt">\n};
+ $HTML .= qq {<input type="hidden" name="start" value="$start">\n};
+ $HTML .= qq {<input type="hidden" name="stop" value="$stop">\n};
+ $HTML .= qq {<input type="hidden" name="title" value="$title">\n} if ( $params{ 'title' } );
&draw_form_opt( 'reserve' );
$HTML .= qq {<input type="submit" value="予約">\n</form>\n};
}
# End of $mode_sub eq 'reserve';
if ( $mode_sub eq 'proc' ) {
- my $type = $q->param( 'type' );
- local $chtxt = $q->param( 'chtxt' );
- my $title = $q->param( 'title' );
- local $opt = $q->param( 'opt' );
+ my $type = $params{ 'type' };
+ local $chtxt = $params{ 'chtxt' };
+ my $title = $params{ 'title' };
+ local $opt = $params{ 'opt' };
+ utf8::decode( $title );
$HTML .= "詳細設定を行ってください。<br>\n";
$HTML .= "タイトル：$title\n<br>\n";
}
}
+################ mode=reserve ################
+
if ( $mode eq 'reserve' ) {
$HTML .= qq {<div style="float: left">\n};
&parse_program();
- $title = $q->param( 'title' ) if ( !$title );
+ $title = $params{ 'title' } if ( !$title );
@opt = $q->param( 'opt' );
$opt = join '', @opt;
my ( $deltaday, $deltatime );
- if ( $q->param('every') eq '1' ) {
+ if ( $params{'every'} eq '1' ) {
$type = 'search_everyday';
( $changed_t ) = $title =~ /(.*)#/;
$title = $changed_t if ( $changed_t );
else {
$type = 'reserve_flexible';
}
+ $chtxt = $chtxt_0 if ( $chtxt_0 );
if ( !&check_error ) {
$dbh->do(
"INSERT INTO timeline ( type, chtxt, title, btime, etime, opt, deltaday, deltatime )
goto end;
}
+################ mode=program ################
+
if ( $mode eq 'program' ) {
&draw_form();
$HTML =~ s/%HTML_TITLE_OPT%/ - Program Viewer/;
$unix = DateTime->now( time_zone => $tz )->strftime( '%Y%m%d%H%M%S' );
$sql =
- "SELECT channel, chtxt, chname, start, stop, title, category
+ "SELECT channel, epg_ch.chname, start, stop, title, category
FROM epg_timeline
- INNER JOIN epg_ch ON epg_timeline.channel = epg_ch.ontv
+ INNER JOIN epg_ch ON epg_timeline.channel = epg_ch.chtxt
WHERE $unix <= stop %CH% %DATE% %CATEGORY% %KEY% ORDER BY start";
- if ( $ontv ) {
- my $ch = "AND channel = '$ontv'";
+ if ( $chtxt ) {
+ my $ch;
+ if ( $chtxt =~ /^\d+(_0)?$/ ) {
+ # teはxx_yyy形式であるため
+ $chtxt =~ s/_0//;
+ $ch = "AND channel LIKE '$chtxt\_%'";
+ }
+ else {
+ $ch = "AND channel = '$chtxt'";
+ }
$sql =~ s/%CH%/$ch/;
}
if ( $date_sel ) {
$ary_ref = $dbh->selectall_arrayref( $sql );
foreach my $prg ( @{ $ary_ref } ) {
- my @date = $prg->[3] =~ /(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/;
-
+ my @date = $prg->[2] =~ /(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/;
+
$date = $date[2];
if ( $date != $prev ) {
my $date = DateTime->new(
);
my $dn = $date->day_name;
- utf8::encode( $dn );
+ #utf8::encode( $dn );
$HTML .= qq {--------$date[1]/$date[2]($dn)--------<br>\n};
}
$HTML .= qq {$date[1]/$date[2] $date[3]:$date[4] };
- $HTML .= qq {$prg->[2] } if ( !$ontv );
- $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};
+ $HTML .= qq {$prg->[1] } if ( !$chtxt );
+ $HTML .= qq {<a href="rectool.pl?mode=confirm&mode_sub=reserve&chtxt=$prg->[0]&start=$prg->[2]&stop=$prg->[3]">$prg->[4]</a><br>\n};
$prev = $date;
}
-
}
+################ mode=list ################
+
if ( $mode eq 'list' ) {
$HTML =~ s/%HTML_TITLE_OPT%/ - List/;
$HTML .= qq {<div>\n};
my $recorded = $cfg->param( 'path.recorded' );
if ( $mode_sub eq 'log' ) {
- my $title = $q->param( 'title' );
+ my $title = $params{ 'title' };
my $log = slurp( "$recording/$title.log" ) if ( -e "$recording/$title.log" );
+ utf8::decode( $log );
$HTML .= '<pre>'.$log."</pre>\n";
goto end;
}
sub list {
local $path = shift;
local %list = ();
- my @exp = ( 'log', 'ts.b25', 'ts.tsmix', 'ts', 'ts.log.mbtree', 'ts.log',
- 'sa.avi', 'sa.avi.log', 'aac', 'srt', 'm2v', 'wav', 'avi', '264', 'mp4', 'mkv' );
+ my @exp = ( 'log', 'log.zip', 'ts.b25', 'ts.tsmix', 'ts', 'ts.log',
+ 'aac', 'srt', 'm2v', 'wav', '264', 'mp4', 'mkv' );
for ( 0..$#exp ) {
$exp{$exp[$_]} = $_;
}
$help .= $exp{$name} + 1 . " = $name / ";
}
$HTML .= $help;
- $help = qq {<tr style="background-color: #87CEEB"><td rowspan="2">$help\n</td>\n};
+ $help = qq {<tr style="background-color: #87CEEB"><td>$help\n</td>\n};
$help .= qq {<td>$_</td>\n} for ( 1..$exp_count );
$help .= qq {<td colspan="2">自動移動</td>\n</tr>\n};
$help .= qq {<tr>\n</tr>\n};
$HTML .= qq {<tr>\n<td width="600" style="width: 600px; white-space: normal">$title</td>\n};
foreach my $exp ( keys %{$value} ) {
if ( $exp eq 'log' ) {
- my $title = $q->url_encode( $title );
+ my $title = $q->escape( $title );
my $check = qq {<td><a href="rectool.pl?mode=list&mode_sub=log&title=$title">○</a></td>\n};
$value->{$exp}->{check} = $check;
}
elsif ( $exp eq 'mkv' ) {
- my $title = $q->url_encode( $title );
+ my $title = $q->escape( $title );
my $check = qq {<td><a title="$value->{$exp}->{size}" href="rectool.pl?mode=thumb&title=$title">■</a></td>\n};
$value->{$exp}->{check} = $check;
$flag[@flag]->{check} = qq {<td colspan="2"><br></td>\n};
}
else {
- my $title = $q->url_encode( $title );
+ my $title = $q->escape( $title );
$flag[@flag]->{check} =
qq {<td><a href="rectool.pl?mode=change&mode_sub=move&mode_sub2=predict&title=$title">予測</a></td>\n}.
# @list = sort @list;
# natural sortを行う
- @list = map( Encode::decode_utf8( $_ ), @list );
+ #@list = map( Encode::decode_utf8( $_ ), @list );
@list = nsort @list;
- @list = map( Encode::encode_utf8( $_ ), @list );
+ #@list = map( Encode::encode_utf8( $_ ), @list );
foreach ( @list ) {
$HTML .= "$_<br>\n";
}
}
+################ mode=thumb ################
+
if ( $mode eq 'thumb' ) {
- my $title = $q->param( 'title' );
- my $pos = $q->param( 'pos' );
+ my $title = $params{ 'title' };
+ my $pos = $params{ 'pos' };
my $recording = $cfg->param( 'path.recpath' );
print "Content-Type: image/jpeg\n\n";
exit;
}
+################ mode=check ################
+
if ( $mode eq 'check' ) {
}
+################ mode=bravia ################
+
if ( $mode eq 'bravia' ) {
$HTML =~ s/%HTML_TITLE_OPT%/ - Bravia/;
$HTML .= qq {<div>\n};
$HTML .= qq {<th><a href="rectool.pl?mode=bravia&order=point">ポイント</a></th>\n};
$HTML .= qq {<th>予約</th>\n};
$HTML .= qq {</tr>\n};
-
- my $order = $q->param( 'order' );
+ my $order = $params{ 'order' };
if ( $order ne 'point' ) {
$order = 'btime';
}
foreach my $line ( @{ $ary_ref } ) {
my ( $begin, $end, $diff ) = &str2readable( $line->[3], $line->[4] );
+ $line->[1] = $chtxt_chname{$line->[1]} || $line->[1];
$HTML .= qq {<tr align="center">\n};
$HTML .= qq {<td>$line->[0]</td>\n};
$HTML .= qq {<td>$line->[1]</td>\n};
}
+################ mode=proc ################
+
if ( $mode eq 'proc' ) {
$HTML =~ s/%HTML_TITLE_OPT%/ - Proposal/;
$HTML .= qq {<div>\n};
foreach my $line ( @{ $ary_ref } ) {
my $url;
- $line->[3] = $q->url_encode( $line->[2] );
+ $line->[3] = $q->escape( $line->[2] );
my $opt = $dbh->selectrow_array(
"SELECT opt FROM in_timeline_log
WHERE title = '$line->[2]' "
$HTML .= qq {</table>\n};
}
+################ mode=jbk ################
+
if ( $mode eq 'jbk' ) {
$HTML =~ s/%HTML_TITLE_OPT%/ - JBK/;
$HTML .= qq {<div>\n};
if ( $mode_sub eq 'add' ) {
- my $keyword = $q->param( 'keyword' );
+ my $keyword = $params{ 'keyword' };
+ utf8::decode( $keyword );
$HTML .= "キーワード「$keyword」を追加しました。<br>\n";
$dbh->do(
"INSERT INTO in_auto_jbk_key ( keyword )
);
}
elsif ( $mode_sub eq 'del' ) {
- my $id = $q->param( 'id' );
+ my $id = $params{ 'id' };
my $keyword = $dbh->selectrow_array(
"SELECT keyword FROM in_auto_jbk_key
WHERE id = '$id' " );
"DELETE FROM in_auto_jbk_key WHERE id = '$id'"
);
}
+ elsif ( $mode_sub eq 'on' ) {
+ my $id = $params{ 'id' };
+ $HTML .= "キーワード「$keyword」を自動録画対象にしました。<br>\n";
+ $dbh->do(
+ "UPDATE in_auto_jbk_key SET auto = 1 WHERE id = '$id'"
+ );
+ }
+ elsif ( $mode_sub eq 'off' ) {
+ my $id = $params{ 'id' };
+ $HTML .= "キーワード「$keyword」を自動録画対象から外しました。<br>\n";
+ $dbh->do(
+ "UPDATE in_auto_jbk_key SET auto = 0 WHERE id = '$id'"
+ );
+ }
$HTML .= qq {<table summary="jbktable" border=1 cellspacing=0>\n<tr>\n};
$HTML .= qq {<th>ID</th>\n};
$HTML .= qq {<th>キーワード</th>\n};
+ $HTML .= qq {<th>自動録画</th>\n};
+ $HTML .= qq {<th>切り替え</th>\n};
$HTML .= qq {<th>削除</th>\n};
$HTML .= qq {</tr>\n};
my $ary_ref = $dbh->selectall_arrayref(
- "SELECT id, keyword
+ "SELECT id, keyword, auto
FROM in_auto_jbk_key
ORDER BY id " );
foreach my $line ( @{ $ary_ref } ) {
- my $url = "rectool.pl?mode=jbk&mode_sub=del&id=$line->[0]";
+ my $delurl = "rectool.pl?mode=jbk&mode_sub=del&id=$line->[0]";
+ my $auto = $line->[2] ? 'on' : 'off';
+ my $oppo = $line->[2] ? 'off' : 'on';
+ my $oppourl = "rectool.pl?mode=jbk&mode_sub=$oppo&id=$line->[0]";
+ $oppo .= "にする";
$HTML .= qq {<tr align="center">\n};
$HTML .= qq {<td>$line->[0]</td>\n};
$HTML .= qq {<td>$line->[1]</td>\n};
- $HTML .= qq {<td><a href="$url">削除</a></td>\n};
+ $HTML .= qq {<td>$auto</td>\n};
+ $HTML .= qq {<td><a href="$oppourl">$oppo</a></td>\n};
+ $HTML .= qq {<td><a href="$delurl">削除</a></td>\n};
$HTML .= qq {</tr>\n};
}
$HTML .= qq {<th>予約</th>\n};
$HTML .= qq {</tr>\n};
- my $ary_ref = $dbh->selectall_arrayref(
- "SELECT id, chtxt, title, btime, etime
- FROM auto_timeline_keyword " );
+ $ary_ref = $dbh->selectall_arrayref(
+ "SELECT id, auto_timeline_keyword.chtxt, epg_ch.chname, title, btime, etime
+ FROM auto_timeline_keyword
+ INNER JOIN epg_ch ON auto_timeline_keyword.chtxt = epg_ch.chtxt "
+ , {Slice=>{}} );
foreach my $line ( @{ $ary_ref } ) {
- my ( $begin, $end, $diff ) = &str2readable( $line->[3], $line->[4] );
- $line->[3] =~ s/(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/$1$2$3$4$5$6/;
- $line->[4] =~ s/(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/$1$2$3$4$5$6/;
- my $url = qq "rectool.pl?mode=confirm&mode_sub=reserve&chtxt=$line->[1]&start=$line->[3]&stop=$line->[4]";
+ my ( $begin, $end, $diff ) = &str2readable( $line->{btime}, $line->{etime} );
+ $line->{btime} =~ s/(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/$1$2$3$4$5$6/;
+ $line->{etime} =~ s/(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/$1$2$3$4$5$6/;
+ my $url = qq "rectool.pl?mode=confirm&mode_sub=reserve&chtxt=$line->{chtxt}&start=$line->{btime}&stop=$line->{etime}";
$HTML .= qq {<tr align="center">\n};
- $HTML .= qq {<td>$line->[0]</td>\n};
- $HTML .= qq {<td>$line->[1]</td>\n};
- $HTML .= qq {<td>$line->[2]</td>\n};
+ $HTML .= qq {<td>$line->{id}</td>\n};
+ $HTML .= qq {<td>$line->{chname}</td>\n};
+ $HTML .= qq {<td>$line->{title}</td>\n};
$HTML .= qq {<td>$begin</td>\n};
$HTML .= qq {<td>$end</td>\n};
$HTML .= qq {<td>$diff</td>\n};
}
+################ mode=recognize ################
+
if ( $mode eq 'recognize' ) {
$HTML =~ s/%HTML_TITLE_OPT%/ - Recognizer/;
- my $text = $q->param( 'text' );
- $chtxt = $q->param( 'chtxt' );
- my $title = $q->param( 'title' );
+ my $text = $params{ 'text' };
+ utf8::decode( $text );
+ $chtxt = $params{ 'chtxt' };
+ my $title = $params{ 'title' };
+ utf8::decode( $title );
$HTML .= qq {<div>\n};
$HTML .= qq {与えられた文字列のうち、番組の放送時刻と思われる文字列を認識します。<br>\n};
$HTML .= qq {<textarea name="text" cols=40 rows=4>\n$text</textarea>\n};
$HTML .= qq {<input type="submit" value="実行">\n</div>\n</form>\n};
- my @ch_list = @{ $dbh->selectcol_arrayref( "SELECT chtxt FROM epg_ch" ) };
- my $ch_list = join '|', @ch_list;
+ my $ch_list = join '|', grep /.+/, values %chtxt_0_chname;
+ my %ch_reverse = reverse %chtxt_0_chname;
if ( $text ) {
my ( $year, $month, $day );
- my ( $hour, $minute );
+ my ( $bhour, $bminute, $ehour, $eminute );
my $next_day = 0;
foreach ( split /\n/, $text ) {
- my @date = /(\d{4}).(\d{1,2}).(\d{1,2})/;
- my @time = /(\d{1,2})[:：](\d{1,2})/;
+ my @bdate = /(\d{4}).(\d{1,2}).(\d{1,2})/;
s/(\d{4}).(\d{2}).(\d{2})//;
+ my @btime = /(\d{1,2})[:：](\d{1,2})/;
+ s/(\d{1,2})[:：](\d{2})//;
+ my @etime = /(\d{1,2})[:：](\d{1,2})/;
s/(\d{1,2})[:：](\d{2})//;
s/\(.*\)//;
- if ( !@date ) {
- $date[0] = Time::Piece->localtime->year;
- ( $date[1], $date[2] ) = /(\d{1,2})月(\d{1,2})日/;
+ if ( !@bdate ) {
+ $bdate[0] = Time::Piece->localtime->year;
+ ( $bdate[1], $bdate[2] ) = /(\d{1,2})月(\d{1,2})日/;
s/(\d{1,2})月(\d{1,2})日//;
}
- next if (!( @date || @time ));
- ( $year, $month, $day ) = @date if ( $date[0] && $date[1] && $date[2] );
- ( $hour, $minute ) = @time if ( defined $time[0] && defined $time[1] );
- $next_day = 1 if ( $_ =~ /深夜/ );
+ next if (!( @bdate || @btime ));
+ ( $year, $month, $day ) = @bdate if ( $bdate[0] && $bdate[1] && $bdate[2] );
+ ( $bhour, $bminute ) = @btime if ( defined $btime[0] && defined $btime[1] );
+ ( $ehour, $eminute ) = @etime if ( defined $etime[0] && defined $etime[1] );
+ $next_day = 1 if ( /深夜/ );
my ( $ch ) = /($ch_list)/;
- my $chtxt = $ch if ( $ch );
+ my $chtxt = $ch_reverse{$ch} if ( $ch && $ch_reverse{$ch} );
+ s/($ch_list)//;
- if ( $year && $month && $day && defined $hour && defined $minute ) {
- my $tp = Time::Piece->strptime( "$year-$month-$day $hour:$minute", '%Y-%m-%d %H:%M' );
+ if ( $year && $month && $day && defined $bhour && defined $bminute ) {
+ my $tp = Time::Piece->strptime( "$year-$month-$day $bhour:$bminute", '%Y-%m-%d %H:%M' );
+ my $etp = Time::Piece->strptime( "$year-$month-$day $ehour:$eminute", '%Y-%m-%d %H:%M' ) if ( defined $ehour && defined $eminute );
$tp += ONE_DAY if ( $next_day );
my $start = $tp->strftime( '%Y%m%d%H%M%S' );
- my $stop = ( $tp + ONE_MINUTE * 30 )->strftime( '%Y%m%d%H%M%S' );
+ my $stop = defined $etp ?
+ $etp->strftime( '%Y%m%d%H%M%S' ) :
+ ( $tp + ONE_MINUTE * 30 )->strftime( '%Y%m%d%H%M%S' );
$title = $_ if ( !$title );
my $url = qq "rectool.pl?mode=confirm&mode_sub=reserve&chtxt=$chtxt&start=$start&stop=$stop&title=$title";
- $HTML .= qq {認識結果:$year-$month-$day $
hour:$minute 残り:$_<a href="$url">リンク</a> <br>\n};
+ $HTML .= qq {認識結果:$year-$month-$day $
bhour:$bminute -> $ehour:$eminute 残り:$_<a href="$url">リンク</a> <br>\n};
}
}
}
}
+################ mode=expert ################
+
if ( $mode eq 'expert' ) {
require List::Compare;
$HTML .= qq {<div>\n};
if ( $mode_sub eq 'reget' ) {
- my $bctype = $q->param( 'bctype' );
- my ( $ontv, $chname ) = $dbh->selectrow_array(
- "SELECT ontv, chname FROM epg_ch
+ my $bctype = $params{ 'bctype' };
+ my ( $chtxt, $chname ) = $dbh->selectrow_array(
+ "SELECT chtxt, chname FROM epg_ch
WHERE bctype = '$bctype' " );
- $HTML .= "Update for $chname ( ontv: $ontv ) has been reserved.<br>\n";
- $dbh->do( "UPDATE epg_ch SET status = '2' WHERE ontv = '$ontv' " );
+ $HTML .= "Update for $chname ( chtxt: $chtxt ) has been reserved.<br>\n";
+ $dbh->do( "UPDATE epg_ch SET status = '2' WHERE chtxt = '$chtxt' " );
goto end;
}
}
- my @ary = $dbh->selectrow_array( "SELECT terec, bscsrec, b252ts, ts2avi FROM in_status" );
+ @ary = $dbh->selectrow_array( "SELECT terec, bscsrec, b252ts, ts2avi FROM in_status" );
$HTML .= qq {<hr>\n地上波録画数：$ary[0]\n衛星波録画数：$ary[1]\n解読数：$ary[2]\n縁故数：$ary[3]\n<br>\n};
$HTML .= qq {<form method="get" action="rectool.pl">\n};
$HTML .= qq {<div>\n};
foreach my $program_new ( @{$ary_ref} ) {
if ( $program_old->[1] ne $program_new->[0] &&
- $program_old->[2] !~ /クロ?ジング|クロージング|エンディング|休止|ミッドナイト/ &&
- $program_new->[2] !~ /オープニング|ウィークリー・インフォメーション|モーニング/ &&
+ $program_old->[2] !~ /クロ?ジング|クロージング|エンディング|休止|ミッドナイト|ending/ &&
+ $program_new->[2] !~ /オープニング|ウィークリー・インフォメーション|モーニング|opening/ &&
( str2datetime( $program_new->[0] ) - str2datetime( $program_old->[1] ) )->delta_minutes > 30 ) {
$program_old->[1] =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/;
$program_new->[0] =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/;
- $error .= qq{ $program_old->[2] $program_old->[1]\n ? $program_new->[2] $program_new->[0]\n};
+ $error .= qq{ $program_old->[2] $program_old->[1]\n -> $program_new->[2] $program_new->[0]\n};
}
$program_old = $program_new;
}
$ary_ref = $dbh->selectall_arrayref(
- "SELECT chname, chtxt, ontv, bctype, ch, csch, updatetime, status
+ "SELECT chname, chtxt, bctype, ch, csch, updatetime, status, visible
FROM epg_ch
ORDER BY bctype " );
$HTML .= qq {<hr>\n番組表の更新状況<br>\n};
$HTML .= qq {<table summary="channeltable" border=1 cellspacing=0>\n<tr>\n};
$HTML .= qq {<th>チャンネル名</th>\n};
- $HTML .= qq {<th>チャンネルコード</th>\n};
- $HTML .= qq {<th>ontvコード</th>\n};
- $HTML .= qq {<th>タイプ</th>\n};
+ $HTML .= qq {<th>chtxt</th>\n};
+ $HTML .= qq {<th>bctype</th>\n};
$HTML .= qq {<th>ch</th>\n};
$HTML .= qq {<th>csch</th>\n};
$HTML .= qq {<th>最終更新時刻</th>\n};
$HTML .= qq {<th>状態</th>\n};
+ $HTML .= qq {<th>表示</th>\n};
$HTML .= qq {</tr>\n};
foreach my $status ( @{$ary_ref} ) {
$HTML .= qq {<tr>\n};
$ary_ref = $dbh->selectall_arrayref(
- "SELECT id, type, chtxt, title, btime, etime, deltaday, deltatime
+ "SELECT id, type, chtxt, title, btime, etime, opt, deltaday, deltatime
FROM timeline
ORDER BY id ");
$HTML .= qq {<hr>\n予約表<br>\n};
$HTML .= qq {<th>title</th>\n};
$HTML .= qq {<th>btime</th>\n};
$HTML .= qq {<th>etime</th>\n};
+ $HTML .= qq {<th>opt</th>\n};
$HTML .= qq {<th>deltaday</th>\n};
$HTML .= qq {<th>deltatime</th>\n};
$HTML .= qq {</tr>\n};
$HTML .= qq {<tr>\n};
$HTML .= qq {<td>$status->[0]</td>\n<td>$status->[1]</td>\n<td>$status->[2]</td>\n<td>$status->[3]</td>\n};
$HTML .= qq {<td>$status->[4]</td>\n<td>$status->[5]</td>\n<td>$status->[6]</td>\n<td>$status->[7]</td>\n};
+ $HTML .= qq {<td>$status->[8]</td>\n};
$HTML .= qq {</tr>\n};
}
$HTML .= qq {</table>\n};
}
+################ mode=log ################
+
if ( $mode eq 'log' ) {
$HTML =~ s/%HTML_TITLE_OPT%/ - Log/;
$HTML .= qq {</table>\n};
}
+################ mode=help ################
+
if ( $mode eq 'help' ) {
$HTML =~ s/%HTML_TITLE_OPT%/ - Help/;
$HTML =~ s|%REFRESH%|<meta http-equiv="refresh" content="300">|;
$HTML .= qq {ヘルプ\n};
}
+################ mode=test ################
+
if ( $mode eq 'test' ) {
$HTML =~ s/%HTML_TITLE_OPT%/ - Test/;
$HTML =~ s|%REFRESH%|<meta http-equiv="refresh" content="300">|;
# $HTML .= Dumper( $ary_ref );
}
+################ mode nasi ################
+
if ( !$mode ) {
&draw_form();
$HTML =~ s/%HTML_TITLE_OPT%/ - Top/;
#<div align="center">
#$HTML_ADV = $HTML_ADV_IMG . $HTML_ADV_TEXT if ( !$HTML_ADV );
+my $HTML_ADV = '';
$HTML_HEADER = qq {<div style="text-align: center">\n$HTML_ADV\n</div>\n};
&draw_menu();
$HTML =~ s/%CSS%//;
$HTML =~ s/%HTML_HEADER%/$HTML_HEADER/;
+utf8::encode( $HTML );
print $HTTP_HEADER;
print $HTML;
exit;
$last_modified = localtime((stat 'rectool.pl')[9]);
$HTML_HEADER .= qq {<div>\n};
- $HTML_HEADER .= qq {<span style="float: right; font-size: 8px">Last-Modified: $last_modified<br>Time-Elapsed: $hires秒</span>\n};
+ $HTML_HEADER .= qq {<span style="float: right; font-size: 8px">Last-Modified: $last_modified<br>Time-Elapsed: $hires 秒</span>\n};
$HTML_HEADER .= qq {<span style="float: left">\n};
- $HTML_HEADER .= qq {<a href="rectool.pl">トップ</a>\n};
+ $HTML_HEADER .= qq {<a href="rectool.pl">トップ(検索)</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};
}
sub draw_form {
- $chname = $q->param( 'chname' );
- $chtxt = $q->param( 'chtxt' );
- $key = $q->param( 'key' );
+ $chname = $params{ 'chname' };
+ $chtxt = $params{ 'chtxt' };
+ $key = $params{ 'key' };
+ utf8::decode( $key );
if ( $chname ) {
- $ontv = $dbh->selectrow_array("SELECT ontv FROM epg_ch WHERE chname = '$chname' ");
- }
- if ( $chtxt ) {
- $ontv = $dbh->selectrow_array("SELECT ontv FROM epg_ch WHERE chtxt = '$chtxt' ");
+ $chtxt = $dbh->selectrow_array("SELECT chtxt FROM epg_ch WHERE chname = '$chname' ");
}
$HTML .= qq {<div style="float: left">\n};
$ary_ref = $dbh->selectcol_arrayref(
"SELECT DISTINCT SUBSTRING(start, 1, 8) FROM epg_timeline ORDER BY start"
);
- $date_sel = $q->param( 'date' );
+ $date_sel = $params{ 'date' };
foreach my $date ( @{ $ary_ref } ) {
my @date = $date =~ /(.{4})(.{2})(.{2})/;
$date_prt = "$date[1]/$date[2]";
# カテゴリ指定
$HTML .= qq {<select name="category">\n<option value="" selected>無指定</option>\n};
- $category_sel = $q->param( 'category' );
+ $category_sel = $params{ 'category' };
foreach my $category ( keys %category ) {
if ( $category eq $category_sel ) {
$HTML .= qq {<option value="$category" selected>$category{$category}</option>\n};
sub draw_form_channel {
$HTML .= qq {<select name="chtxt">\n};
$HTML .= qq {<option value="" selected>無指定</option>\n} if ( shift ne 'nonone' );
- $ary_ref = $dbh->selectall_arrayref(
- "SELECT chtxt, chname FROM epg_ch"
- );
- foreach my $line ( @{$ary_ref} ) {
- if ( $line->[0] eq $chtxt || $line->[1] eq $chname ) {
- $HTML .= qq {<option value="$line->[0]" selected>$line->[1]</option>\n};
+
+ foreach my $key ( keys %chtxt_0_chname ) {
+ my $value = $chtxt_0_chname{$key};
+ if ( ($chtxt && $key eq $chtxt ) || ( $chname && $value eq $chname ) ) {
+ $HTML .= qq {<option value="$key" selected>$value</option>\n};
}
else {
- $HTML .= qq {<option value="$line->[0]">$line->[1]</option>\n};
+ $HTML .= qq {<option value="$key">$value</option>\n};
}
}
$HTML .= qq {</select>\n};
my $shift = shift;
my ( %selected, %checked );
- if ( $chtxt =~ /\Qbs-nhk-hi\E/ ) {
+ if ( $chtxt =~ /BS_103/ ) {
$selected{F} = 'selected';
}
- elsif ( $chtxt =~ /movieplus|nihoneiga|kidshd/ ) {
+ elsif ( $chtxt =~ /CS_239|CS_240|CS_335/ ) {
$selected{H} = 'selected';
}
- elsif ( $chtxt =~ /bs-nhk/ || $bctype =~ /cs/ ) {
+ elsif ( $chtxt =~ /BS_101|BS_102/ || $bctype =~ /cs/ ) {
$selected{W} = 'selected';
}
elsif ( $bctype =~ /bs|te/ ) {
}
$selected{g} = 'selected';
$selected{s} = 'selected';
- $checked{a} = $chtxt =~ /animax|atx|disney|kids/ || $category =~ /アニメ/ ? 'checked' : '';
+ $checked{a} = $chtxt =~ /CS_331|CS_332|CS_333|CS_334|CS_335/ || $category =~ /アニメ/ ? 'checked' : '';
$checked{l} = '';
$checked{d} = $title =~ /\Q[二]\E|［二］|\Q(二)\E|（二）/ ? 'checked' : '';
$checked{5} = $title =~ /5\.1|5．1/ ? 'checked' : '';
$checked{d} = $title =~ /\Q[二]\E|［二］|\Q(二)\E|（二）/ ? 'checked' : '';
$checked{5} = $title =~ /5\.1|5．1/ ? 'checked' : '';
}
+ # 画質/圧縮率ともに指定されていない場合、真ん中をselectedにする
+ $selected{g} = 'selected' unless ( $selected{u} || $selected{i} || $selected{o} || $selected{p} );
+ $selected{s} = 'selected' unless ( $selected{q} || $selected{w} || $selected{e} || $selected{r} );
$HTML .= qq {<select name="opt">\n};
- $HTML .= qq {<option value="S" $selected{S}>S 720x480</option>\n};
+ #$HTML .= qq {<option value="S" $selected{S}>S 720x480</option>\n};
$HTML .= qq {<option value="W" $selected{W}>W 854x480</option>\n};
$HTML .= qq {<option value="H" $selected{H}>H 1280x720</option>\n};
$HTML .= qq {<option value="F" $selected{F}>F 1920x1080</option>\n};
$HTML .= qq {<option value="4" $selected{r}>MP4</option>\n};
$HTML .= qq {</select>\n};
+ $HTML .= qq {<select name="opt">\n};
+ $HTML .= qq {<option value="" $selected{s}>モバイル向け</option>\n};
+ $HTML .= qq {<option value="1" $selected{e}>QVGA</option>\n};
+ $HTML .= qq {<option value="2" $selected{r}>WVGA</option>\n};
+ $HTML .= qq {</select>\n};
+
$HTML .= qq {<input type="checkbox" name="opt" value="a" $checked{a}>24fps(主にアニメ)\n};
$HTML .= qq {<input type="checkbox" name="opt" value="d" $checked{d}>二ヶ国語放送\n};
-# $HTML .= qq {<input type="checkbox" name="opt" value="2" $checked{2}>2passモード\n};
+ #$HTML .= qq {<input type="checkbox" name="opt" value="2" $checked{2}>2passモード\n};
$HTML .= qq {<input type="checkbox" name="opt" value="5" $checked{5}>5.1ch放送\n};
$HTML .= qq {<br>\n};
$HTML .= qq {<select name="opt">\n};
}
sub parse_program {
- $chname = $q->param( 'chname' );
- $chtxt = $q->param( 'chtxt' );
- $start = $q->param( 'start' );
- $stop = $q->param( 'stop' );
- $bayesid = $q->param( 'bayesid' );
- $id = $q->param( 'id' );
+ $chname = $params{ 'chname' };
+ $chtxt = $params{ 'chtxt' };
+ $start = $params{ 'start' };
+ $stop = $params{ 'stop' };
+ $bayesid = $params{ 'bayesid' };
+ $id = $params{ 'id' };
if ( $chname ) {
- $ontv = $dbh->selectrow_array("SELECT ontv FROM epg_ch WHERE chname = '$chname'");
- $chtxt = $dbh->selectrow_array("SELECT chtxt FROM epg_ch WHERE ontv = '$ontv'");
+ $chtxt = $dbh->selectrow_array("SELECT chtxt FROM epg_ch WHERE chname = '$chname'");
+ }
+ elsif ( $chtxt && $chtxt_0_chname{$chtxt} ) {
+ $chname = $chtxt_0_chname{$chtxt};
+ ( $chtxt_sql = $chtxt ) =~ s/_0/_%/;
+ $bctype = $dbh->selectrow_array("SELECT bctype FROM epg_ch WHERE chtxt LIKE '$chtxt_sql'");
}
elsif ( $chtxt ) {
- $ontv = $dbh->selectrow_array("SELECT ontv FROM epg_ch WHERE chtxt = '$chtxt'");
- $chname = $dbh->selectrow_array("SELECT chname FROM epg_ch WHERE ontv = '$ontv'");
+ $chname = $dbh->selectrow_array("SELECT chname FROM epg_ch WHERE chtxt = '$chtxt'")
+ }
+ ( $title, $desc, $longdesc, $category ) = $dbh->selectrow_array(
+ "SELECT title, exp, longexp, category
+ FROM epg_timeline
+ WHERE channel = '$chtxt' AND start = '$start' AND stop = '$stop' ");
+ if ( !$bctype ) {
+ $bctype = $dbh->selectrow_array("SELECT bctype FROM epg_ch WHERE chtxt = '$chtxt'");
}
- $title = $dbh->selectrow_array("SELECT title FROM epg_timeline WHERE channel = '$ontv' AND start = '$start' AND stop = '$stop' ");
- $desc = $dbh->selectrow_array("SELECT exp FROM epg_timeline WHERE channel = '$ontv' AND start = '$start' AND stop = '$stop' ");
- $longdesc = $dbh->selectrow_array("SELECT longexp FROM epg_timeline WHERE channel = '$ontv' AND start = '$start' AND stop = '$stop' ");
- $category = $dbh->selectrow_array("SELECT category FROM epg_timeline WHERE channel = '$ontv' AND start = '$start' AND stop = '$stop' ");
- $bctype = $dbh->selectrow_array("SELECT bctype FROM epg_ch WHERE ontv = '$ontv'");
if ( $bayesid ) {
( $chtxt, $title, $begin, $end ) = $dbh->selectrow_array(
"SELECT chtxt, title, btime, etime FROM auto_timeline_bayes WHERE id = '$bayesid' "
);
- ( $ontv, $chname, $bctype ) = $dbh->selectrow_array(
- "SELECT ontv, chname, bctype FROM epg_ch WHERE chtxt = '$chtxt' "
+ ( $chname, $bctype ) = $dbh->selectrow_array(
+ "SELECT chname, bctype FROM epg_ch WHERE chtxt = '$chtxt' "
);
$start = str2datetime( $begin )->strftime( '%Y%m%d%H%M%S' );
$stop = str2datetime( $end )->strftime( '%Y%m%d%H%M%S' );
( $desc, $longdesc, $category ) = $dbh->selectrow_array(
- "SELECT exp, longexp, category FROM epg_timeline WHERE channel = '$ontv' AND start = '$start' AND stop = '$stop' "
+ "SELECT exp, longexp, category FROM epg_timeline WHERE channel = '$chtxt' AND start = '$start' AND stop = '$stop' "
);
}
if ( $id ) {
"SELECT type, chtxt, title, btime, etime, deltaday, deltatime, opt, counter
FROM timeline WHERE id = '$id' "
);
- ( $ontv, $chname, $bctype ) = $dbh->selectrow_array(
- "SELECT ontv, chname, bctype FROM epg_ch WHERE chtxt = '$chtxt' "
+ ( $chname, $bctype ) = $dbh->selectrow_array(
+ "SELECT chname, bctype FROM epg_ch WHERE chtxt = '$chtxt' "
);
$start = str2datetime( $begin )->strftime( '%Y%m%d%H%M%S' );
$stop = str2datetime( $end )->strftime( '%Y%m%d%H%M%S' );
( $desc, $longdesc, $category ) = $dbh->selectrow_array(
- "SELECT exp, longexp, category FROM epg_timeline WHERE channel = '$ontv' AND start = '$start' AND stop = '$stop' "
+ "SELECT exp, longexp, category FROM epg_timeline WHERE channel = '$chtxt' AND start = '$start' AND stop = '$stop' "
);
}
- if ( $bctype =~ /.s/ ) {
+ if ( $bctype =~ /bs|cs/ ) {
$bctype_sql = '_s%';
}
elsif ( $bctype =~ /te/ ) {
+ ( $chtxt_0 = $chtxt ) =~ s/(\d+)_.*/$1_0/;
+ ( $chtxt_sql = $chtxt ) =~ s/_0/_%/;
$bctype_sql = 'te%';
}
+ #( $chtxt_no0 ) = $chtxt =~ /(\d+)_/;
@start = $start =~ /(.{4})(.{2})(.{2})(.{2})(.{2})/;
@stop = $stop =~ /(.{4})(.{2})(.{2})(.{2})(.{2})/;
$begin = sprintf( '%04d-%02d-%02d %02d:%02d:%02d', @start, '00' );
$end = sprintf( '%04d-%02d-%02d %02d:%02d:%02d', @stop , '00' );
+
+ if ( $params{ 'title' } ) {
+ $title = $params{ 'title' };
+ utf8::decode( $title );
+ }
+ $HTML .= qq {<!-- chtxt=$chtxt chtxt_0=$chtxt_0 chtxt_sql=$chtxt_sql bctype=$bctype -->\n};
}
sub check_error {
}
else{
$abs = "$dir/$file";
+ utf8::decode( $abs );
( $rel ) = $abs =~ /^$base_dir\/(.*)$/;
$ptr->( $rel, $abs );
}
my $str_begin = $dt_begin->strftime( '%m/%d(%a) %H:%M' );
my $str_end = $dt_end ->strftime( $dt_begin->day == $dt_end->day ? '%H:%M' : '翌 %H:%M' );
- utf8::encode( $str_begin );
+ # utf8::encode( $str_begin );
my ( $sec, $min, $hour );
$sec = $dt_end->epoch - $dt_begin->epoch;
$etime_bgn = $etime->clone->subtract( hours => $deltatime )->strftime( '%Y%m%d%H%M%S' );
$etime_end = $etime->clone->add( hours => $deltatime )->strftime( '%Y%m%d%H%M%S' );
- my $ontv = $dbh->selectrow_array( "SELECT ontv FROM epg_ch WHERE chtxt = '$chtxt' " );
$ary_ref = $dbh->selectall_arrayref(
"SELECT start, stop, title, exp
FROM epg_timeline
- WHERE channel = '$ontv'
+ WHERE channel LIKE '$chtxt_sql'
AND start BETWEEN '$btime_bgn' AND '$btime_end'
AND stop BETWEEN '$etime_bgn' AND '$etime_end' "
);
+ #die Dumper $ary_ref;
my %hash;
- my $hash_r = Text::Ngram::ngram_counts( Encode::decode_utf8( $title ), 2 ); # bi-gram
+ my $hash_r = Text::Ngram::ngram_counts( $title, 2 ); # bi-gram
foreach my $program ( @{$ary_ref} ) {
- my $hash_k = Text::Ngram::ngram_counts( Encode::decode_utf8( $program->[2] ), 2 );
+ my $hash_k = Text::Ngram::ngram_counts( $program->[2], 2 );
my $point;
map $point += $hash_k->{$_}, keys %{$hash_r};
push @{$hash{$point}}, $program if ( $point );
OSDN Git Service
