From 423dd585e16b4278e144eb46391bbe1e83a03b7b Mon Sep 17 00:00:00 2001 From: longinus Date: Fri, 4 Feb 2011 02:34:41 +0000 Subject: [PATCH] update to db ver 100 git-svn-id: svn+ssh://svn.sourceforge.jp/svnroot/rec10@825 4e526526-5e11-4fc0-8910-f8fd03428081 --- rectool/trunk/Makefile.PL | 1 + rectool/trunk/rectool.pl | 728 +++++++++++++++++++++++++++++----------------- 2 files changed, 468 insertions(+), 261 deletions(-) diff --git a/rectool/trunk/Makefile.PL b/rectool/trunk/Makefile.PL index 7b3345a..0acd122 100755 --- a/rectool/trunk/Makefile.PL +++ b/rectool/trunk/Makefile.PL @@ -23,6 +23,7 @@ else { my @packages = ( # [ 'CPAN' , 'YUM', 'APT' ], + [ 'Algorithm::Diff', 'yes', 'yes' ], [ 'CGI::Carp' , 'no' , 'no' ], [ 'CGI::Minimal' , 'no' , 'no' ], [ 'Config::Simple' , 'yes', 'yes' ], diff --git a/rectool/trunk/rectool.pl b/rectool/trunk/rectool.pl index ab2a91e..8632929 100755 --- a/rectool/trunk/rectool.pl +++ b/rectool/trunk/rectool.pl @@ -15,7 +15,7 @@ use Time::Piece; use Time::Seconds; use Date::Simple; use DateTime; -use CGI::Minimal; +use CGI; use MIME::Base64; use Config::Simple; use Time::HiRes; @@ -23,27 +23,34 @@ use Data::Dumper; 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' ); @@ -56,6 +63,7 @@ if ( $sql eq 'MySQL' ) { $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' ); } @@ -128,14 +136,65 @@ if ( $rec10_version != $rectool_version ) { $HTML .= qq {Rec10のバージョンアップを行ってください。
\n}; } - $HTML .= qq {Rec10のバージョンは$rec10_version、rectoolのバージョンは$rectool_versionです。
\n}; + $HTML .= qq {Rec10のバージョンは$rec10_version 、rectoolのバージョンは$rectool_version です。
\n}; $HTML .= qq {公式ページ\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; ################ 定数宣言 ################ @@ -212,10 +271,12 @@ $type_user_made = "( 'search_everyday', 'search_today', 'reserve_flexible', 'res ################ 初期化ここまで ################ +################ mode=schedule ################ + if ( $mode eq 'schedule' ) { $HTML =~ s/%HTML_TITLE_OPT%/ - Schedule Viewer/; -# $HTML =~ s|%REFRESH%||; + #$HTML =~ s|%REFRESH%||; $css = < td { @@ -226,8 +287,8 @@ EOM $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'; } @@ -235,11 +296,12 @@ EOM $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 {
\n}; $HTML .= qq {
\n}; @@ -261,89 +323,126 @@ EOM $HTML .= qq {\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 {$type}; - $line->[9] = qq {空} if ( !$line->[9] && $line->[1] eq 'search_everyday' ); - $line->[10] = qq {空} if ( !$line->[10] ); + $line->{deltaday} = qq {空} if ( !$line->{deltaday} && $line->{type} eq 'search_everyday' ); + $line->{deltatime} = qq {空} 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 {$type}; } - $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 {自動検索}; - $ary[0] = qq {$ary[0]■$href■}; + # 地上波の場合、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}}; + } + else { + $line->{chname_link} = qq {$line->{chname}}; + } + $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 {自動検索}; + $epgtitle = qq {$epgtitle■$href■}; + } + else { + # epgtitleにtitleが含まれている + $epgtitle = $epgtitle_nobrackets; } } else { - $ary[0] = '説明'; + # epgtitleとtitleが一致している + $epgtitle = '説明'; } - $line->[5_2] = qq {
$ary[0]
}; + $line->{title_2} = qq {
$epgtitle
}; } else { - my $href = qq {自動検索}; - $line->[5_2] = qq {■$href■}; + # epgtitleがない + my $href = qq {自動検索}; + $line->{title_2} = qq {■$href■}; + $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 {
}; } - $line->[5] = qq {$line->[5]}; -# $line->[5] = qq {
$line->[5]
} if ( $line->[5_2] ); - $HTML .= qq {\n}; - $HTML .= qq {\n}; - $HTML .= qq {$line->[0]\n}; + $line->{title} = qq {$line->{title}}; + #$line->{title} = qq {
$line->{title}
} if ( $line->{title_2} ); + $HTML .= qq {{tr_style}>\n}; + $HTML .= qq {\n}; + $HTML .= qq {$line->{id}\n}; $HTML .= qq {$type\n}; - $HTML .= qq {$line->[2]\n}; - $HTML .= qq {$line->[5]$line->[5_2]\n}; + $HTML .= qq {$line->{chname_link}\n}; + $HTML .= qq {$line->{title}$line->{title_2}\n}; $HTML .= qq {$begin\n$end\n}; $HTML .= qq {$hr$diff\n}; - $HTML .= qq {$line->[8]\n$line->[9]\n$line->[10]\n$line->[17]\n}; + $HTML .= qq {$line->{opt}\n$line->{deltaday}\n$line->{deltatime}\n$line->{counter}\n}; $HTML .= qq {\n}; } $HTML .= qq {\n}; -# $HTML .= qq {\n}; + #$HTML .= qq {\n}; $HTML .= qq {\n
\n\n}; goto end; } +################ mode=graph ################ + if ( $mode eq 'graph' ) { - my $date = $q->param( 'date' ); + my $date = $params{ 'date' }; if ( $date ) { @@ -357,7 +456,7 @@ if ( $mode eq 'graph' ) { $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; @@ -396,7 +495,7 @@ if ( $mode eq 'graph' ) { 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 @@ -407,16 +506,17 @@ if ( $mode eq 'graph' ) { '$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 @@ -430,22 +530,23 @@ if ( $mode eq 'graph' ) { ( 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; @@ -463,9 +564,9 @@ if ( $mode eq 'graph' ) { $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, @@ -483,7 +584,7 @@ if ( $mode eq 'graph' ) { $HTML .= qq {
\n}; # $base64 = encode_base64( $svg->xmlify ); # $HTML .= qq {\n\n}; - $HTML .= qq {予約状況一覧です。T1,T2は地上波、S1,S2はBS/CS、赤はアニメ、緑はHD、青は2 passを示しています。
\n}; + $HTML .= qq {予約状況一覧です。T1,T2は地上波、S1,S2はBS/CS、赤はアニメ、緑はHD、青はインターレースを示しています。
\n}; $HTML .= qq {SVGが利用可能なブラウザでご覧ください。
\n}; $ary_ref = $dbh->selectcol_arrayref( @@ -495,8 +596,9 @@ if ( $mode eq 'graph' ) { 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)の予約状況
\n}; + # $HTML .= qq {\n}; $HTML .= qq {SVG Image $date\n\n
\n}; @@ -508,7 +610,7 @@ if ( $mode eq 'graph' ) { ); foreach my $line ( @{ $ary_ref } ) { -# $HTML .= qq {$line->[0] $line->[1] $line->[2] $line->[3]
\n}; + #$HTML .= qq {$line->[0] $line->[1] $line->[2] $line->[3]
\n}; } } @@ -517,6 +619,8 @@ if ( $mode eq 'graph' ) { } } +################ mode=atom ################ + if ( $mode eq 'atom' ) { require XML::Atom::Feed; require XML::Atom::Entry; @@ -587,8 +691,10 @@ if ( $mode eq 'atom' ) { } } +################ mode=edit ################ + if ( $mode eq 'edit' ) { - my $id = $q->param( 'id' ); + my $id = $params{ 'id' }; $HTML =~ s/%HTML_TITLE_OPT%/ - Schedule Editor/; $HTML .= qq {
\n}; @@ -633,10 +739,12 @@ EOM $HTML .= "スケジュール編集画面です。
\n"; $HTML .= "実装がとても適当なので、利用には細心の注意を払ってください。
\n
\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' ); @@ -647,7 +755,7 @@ EOM .qq{}; } - 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( @@ -702,16 +810,16 @@ EOM } } $HTML .= qq {\n}; + $HTML .= qq {チャンネル\n
\n}; @@ -727,13 +835,15 @@ EOM $HTML .= qq {\n\n}; } +################ mode=change ################ + if ( $mode eq 'change' ) { @id = $q->param( 'id' ); $HTML =~ s/%HTML_TITLE_OPT%/ - Change/; $HTML .= qq {
\n}; - if ( $q->param( 'delete' ) ) + if ( $params{ 'delete' } ) { if ( @id ) { foreach my $id ( @id ) { @@ -744,17 +854,17 @@ if ( $mode eq 'change' ) { 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( @@ -775,9 +885,9 @@ if ( $mode eq 'change' ) { 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; @@ -795,27 +905,30 @@ if ( $mode eq 'change' ) { 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
"; - 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', @@ -825,23 +938,20 @@ if ( $mode eq 'change' ) { 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 {パラメータが異常です。
\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/; @@ -849,8 +959,7 @@ if ( $mode eq 'confirm' ) { &parse_program(); my $duration = ( str2datetime( $end ) - str2datetime( $begin ) )->delta_minutes; - $title = $q->param( 'title' ) if ( !$title ); - $HTML .= "番組名：$title
\nチャンネル：$chname
\n放送継続時間：$duration分
\n番組内容：$desc
\n"; + $HTML .= "番組名：$title
\nチャンネル：$chname
\n放送継続時間：$duration 分
\n番組内容：$desc
\n"; if ( $longdesc ) { $longdesc =~ s/\\n/
\n/gs; $HTML .= "番組内容(長)：$longdesc
\n"; @@ -861,7 +970,7 @@ if ( $mode eq 'confirm' ) { # エラー $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 .= "同一の番組の他の放送予定です。
\n"; @@ -879,11 +988,11 @@ if ( $mode eq 'confirm' ) { else { $HTML .= "録画予約の詳細設定を行ってください。
\n"; $HTML .= qq {
\n}; - $HTML .= qq {\n}; - $HTML .= qq {\n}; - $HTML .= qq {\n}; - $HTML .= qq {\n}; - $HTML .= qq {\n} if ( $q->param( 'title' ) ); + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n} if ( $params{ 'title' } ); &draw_form_opt( 'reserve' ); $HTML .= qq {\n
\n}; } @@ -892,10 +1001,11 @@ if ( $mode eq 'confirm' ) { # 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 .= "詳細設定を行ってください。
\n"; $HTML .= "タイトル：$title\n
\n"; @@ -912,15 +1022,17 @@ if ( $mode eq 'confirm' ) { } } +################ mode=reserve ################ + if ( $mode eq 'reserve' ) { $HTML .= qq {
\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 ); @@ -940,6 +1052,7 @@ if ( $mode eq 'reserve' ) { 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 ) @@ -951,19 +1064,29 @@ if ( $mode eq 'reserve' ) { 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 ) { @@ -989,8 +1112,8 @@ if ( $mode eq 'program' ) { $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( @@ -999,17 +1122,18 @@ if ( $mode eq 'program' ) { ); my $dn = $date->day_name; - utf8::encode( $dn ); + #utf8::encode( $dn ); $HTML .= qq {--------$date[1]/$date[2]($dn)--------
\n}; } $HTML .= qq {$date[1]/$date[2] $date[3]:$date[4] }; - $HTML .= qq {$prg->[2] } if ( !$ontv ); - $HTML .= qq {$prg->[5]
\n}; + $HTML .= qq {$prg->[1] } if ( !$chtxt ); + $HTML .= qq {$prg->[4]
\n}; $prev = $date; } - } +################ mode=list ################ + if ( $mode eq 'list' ) { $HTML =~ s/%HTML_TITLE_OPT%/ - List/; $HTML .= qq {
\n}; @@ -1019,8 +1143,9 @@ if ( $mode eq 'list' ) { 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 .= '
'.$log."
\n"; goto end; } @@ -1044,8 +1169,8 @@ if ( $mode eq 'list' ) { 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[$_]} = $_; } @@ -1058,7 +1183,7 @@ if ( $mode eq 'list' ) { $help .= $exp{$name} + 1 . " = $name / "; } $HTML .= $help; - $help = qq {$help\n\n}; + $help = qq {$help\n\n}; $help .= qq {$_\n} for ( 1..$exp_count ); $help .= qq {自動移動\n\n}; $help .= qq {\n\n}; @@ -1078,13 +1203,13 @@ if ( $mode eq 'list' ) { $HTML .= qq {\n$title\n}; foreach my $exp ( keys %{$value} ) { if ( $exp eq 'log' ) { - my $title = $q->url_encode( $title ); + my $title = $q->escape( $title ); my $check = qq {○\n}; $value->{$exp}->{check} = $check; } elsif ( $exp eq 'mkv' ) { - my $title = $q->url_encode( $title ); + my $title = $q->escape( $title ); my $check = qq {■\n}; $value->{$exp}->{check} = $check; @@ -1095,7 +1220,7 @@ if ( $mode eq 'list' ) { $flag[@flag]->{check} = qq {
\n}; } else { - my $title = $q->url_encode( $title ); + my $title = $q->escape( $title ); $flag[@flag]->{check} = qq {予測\n}. @@ -1152,9 +1277,9 @@ if ( $mode eq 'list' ) { # @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 .= "$_
\n"; @@ -1192,9 +1317,11 @@ if ( $mode eq 'list' ) { } } +################ 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"; @@ -1202,9 +1329,13 @@ if ( $mode eq 'thumb' ) { exit; } +################ mode=check ################ + if ( $mode eq 'check' ) { } +################ mode=bravia ################ + if ( $mode eq 'bravia' ) { $HTML =~ s/%HTML_TITLE_OPT%/ - Bravia/; $HTML .= qq {
\n}; @@ -1220,8 +1351,7 @@ if ( $mode eq 'bravia' ) { $HTML .= qq {ポイント\n}; $HTML .= qq {予約\n}; $HTML .= qq {\n}; - - my $order = $q->param( 'order' ); + my $order = $params{ 'order' }; if ( $order ne 'point' ) { $order = 'btime'; } @@ -1236,6 +1366,7 @@ if ( $mode eq 'bravia' ) { foreach my $line ( @{ $ary_ref } ) { my ( $begin, $end, $diff ) = &str2readable( $line->[3], $line->[4] ); + $line->[1] = $chtxt_chname{$line->[1]} || $line->[1]; $HTML .= qq {\n}; $HTML .= qq {$line->[0]\n}; $HTML .= qq {$line->[1]\n}; @@ -1251,6 +1382,8 @@ if ( $mode eq 'bravia' ) { } +################ mode=proc ################ + if ( $mode eq 'proc' ) { $HTML =~ s/%HTML_TITLE_OPT%/ - Proposal/; $HTML .= qq {
\n}; @@ -1267,7 +1400,7 @@ if ( $mode eq 'proc' ) { 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]' " @@ -1320,12 +1453,15 @@ if ( $mode eq 'proc' ) { $HTML .= qq {\n}; } +################ mode=jbk ################ + if ( $mode eq 'jbk' ) { $HTML =~ s/%HTML_TITLE_OPT%/ - JBK/; $HTML .= qq {
\n}; if ( $mode_sub eq 'add' ) { - my $keyword = $q->param( 'keyword' ); + my $keyword = $params{ 'keyword' }; + utf8::decode( $keyword ); $HTML .= "キーワード「$keyword」を追加しました。
\n"; $dbh->do( "INSERT INTO in_auto_jbk_key ( keyword ) @@ -1333,7 +1469,7 @@ if ( $mode eq 'jbk' ) { ); } 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' " ); @@ -1342,25 +1478,47 @@ if ( $mode eq 'jbk' ) { "DELETE FROM in_auto_jbk_key WHERE id = '$id'" ); } + elsif ( $mode_sub eq 'on' ) { + my $id = $params{ 'id' }; + $HTML .= "キーワード「$keyword」を自動録画対象にしました。
\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」を自動録画対象から外しました。
\n"; + $dbh->do( + "UPDATE in_auto_jbk_key SET auto = 0 WHERE id = '$id'" + ); + } $HTML .= qq {\n\n}; $HTML .= qq {\n}; $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; $HTML .= qq {\n}; $HTML .= qq {\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 {\n}; $HTML .= qq {\n}; $HTML .= qq {\n}; - $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; $HTML .= qq {\n}; } @@ -1383,20 +1541,22 @@ if ( $mode eq 'jbk' ) { $HTML .= qq {\n}; $HTML .= qq {\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 {\n}; - $HTML .= qq {\n}; - $HTML .= qq {\n}; - $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; $HTML .= qq {\n}; $HTML .= qq {\n}; $HTML .= qq {\n}; @@ -1408,12 +1568,16 @@ if ( $mode eq 'jbk' ) { } +################ 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 {
\n}; $HTML .= qq {与えられた文字列のうち、番組の放送時刻と思われる文字列を認識します。
\n}; @@ -1427,44 +1591,53 @@ if ( $mode eq 'recognize' ) { $HTML .= qq {\n}; $HTML .= qq {\n
\n\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 残り:$_リンク
\n}; + $HTML .= qq {認識結果:$year-$month-$day $bhour:$bminute -> $ehour:$eminute 残り:$_リンク
\n}; } } } } +################ mode=expert ################ + if ( $mode eq 'expert' ) { require List::Compare; @@ -1474,12 +1647,12 @@ if ( $mode eq 'expert' ) { $HTML .= qq {
\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.
\n"; - $dbh->do( "UPDATE epg_ch SET status = '2' WHERE ontv = '$ontv' " ); + $HTML .= "Update for $chname ( chtxt: $chtxt ) has been reserved.
\n"; + $dbh->do( "UPDATE epg_ch SET status = '2' WHERE chtxt = '$chtxt' " ); goto end; } @@ -1516,7 +1689,7 @@ if ( $mode eq 'expert' ) { } - 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 {
\n地上波録画数：$ary[0]\n衛星波録画数：$ary[1]\n解読数：$ary[2]\n縁故数：$ary[3]\n
\n}; $HTML .= qq {
\n}; $HTML .= qq {
\n}; @@ -1543,12 +1716,12 @@ if ( $mode eq 'expert' ) { 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; } @@ -1557,19 +1730,19 @@ if ( $mode eq 'expert' ) { $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 {
\n番組表の更新状況
\n}; $HTML .= qq {
IDキーワード自動録画切り替え削除
$line->[0]$line->[1]削除$auto$oppo削除
予約
$line->[0]$line->[1]$line->[2]$line->{id}$line->{chname}$line->{title}$begin$end$diff
\n\n}; $HTML .= qq {\n}; - $HTML .= qq {\n}; - $HTML .= qq {\n}; - $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; $HTML .= qq {\n}; $HTML .= qq {\n}; $HTML .= qq {\n}; $HTML .= qq {\n}; + $HTML .= qq {\n}; $HTML .= qq {\n}; foreach my $status ( @{$ary_ref} ) { $HTML .= qq {\n}; @@ -1601,7 +1774,7 @@ if ( $mode eq 'expert' ) { $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 {
\n予約表
\n}; @@ -1612,6 +1785,7 @@ if ( $mode eq 'expert' ) { $HTML .= qq {\n}; $HTML .= qq {\n}; $HTML .= qq {\n}; + $HTML .= qq {\n}; $HTML .= qq {\n}; $HTML .= qq {\n}; $HTML .= qq {\n}; @@ -1619,11 +1793,14 @@ if ( $mode eq 'expert' ) { $HTML .= qq {\n}; $HTML .= qq {\n\n\n\n}; $HTML .= qq {\n\n\n\n}; + $HTML .= qq {\n}; $HTML .= qq {\n}; } $HTML .= qq {
チャンネル名チャンネルコードontvコードタイプchtxtbctypechcsch最終更新時刻状態表示
titlebtimeetimeoptdeltadaydeltatime
$status->[0]$status->[1]$status->[2]$status->[3]$status->[4]$status->[5]$status->[6]$status->[7]$status->[8]
\n}; } +################ mode=log ################ + if ( $mode eq 'log' ) { $HTML =~ s/%HTML_TITLE_OPT%/ - Log/; @@ -1653,6 +1830,8 @@ if ( $mode eq 'log' ) { $HTML .= qq {\n}; } +################ mode=help ################ + if ( $mode eq 'help' ) { $HTML =~ s/%HTML_TITLE_OPT%/ - Help/; $HTML =~ s|%REFRESH%||; @@ -1660,6 +1839,8 @@ if ( $mode eq 'help' ) { $HTML .= qq {ヘルプ\n}; } +################ mode=test ################ + if ( $mode eq 'test' ) { $HTML =~ s/%HTML_TITLE_OPT%/ - Test/; $HTML =~ s|%REFRESH%||; @@ -1673,6 +1854,8 @@ if ( $mode eq 'test' ) { # $HTML .= Dumper( $ary_ref ); } +################ mode nasi ################ + if ( !$mode ) { &draw_form(); $HTML =~ s/%HTML_TITLE_OPT%/ - Top/; @@ -1691,6 +1874,7 @@ EOM #
#$HTML_ADV = $HTML_ADV_IMG . $HTML_ADV_TEXT if ( !$HTML_ADV ); +my $HTML_ADV = ''; $HTML_HEADER = qq {
\n$HTML_ADV\n
\n}; &draw_menu(); @@ -1700,6 +1884,7 @@ $HTML =~ s/%SCRIPT%//; $HTML =~ s/%CSS%//; $HTML =~ s/%HTML_HEADER%/$HTML_HEADER/; +utf8::encode( $HTML ); print $HTTP_HEADER; print $HTML; exit; @@ -1709,9 +1894,9 @@ sub draw_menu { $last_modified = localtime((stat 'rectool.pl')[9]); $HTML_HEADER .= qq {
\n}; - $HTML_HEADER .= qq {Last-Modified: $last_modified
Time-Elapsed: $hires秒\n}; + $HTML_HEADER .= qq {Last-Modified: $last_modified
Time-Elapsed: $hires 秒\n}; $HTML_HEADER .= qq {\n}; - $HTML_HEADER .= qq {トップ\n}; + $HTML_HEADER .= qq {トップ(検索)\n}; $HTML_HEADER .= qq {予約確認\n}; $HTML_HEADER .= qq {予約状況(画像版)\n}; $HTML_HEADER .= qq {録画一覧\n}; @@ -1729,14 +1914,12 @@ sub draw_menu { } 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 {
\n}; @@ -1752,7 +1935,7 @@ sub draw_form { $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]"; @@ -1768,7 +1951,7 @@ sub draw_form { # カテゴリ指定 $HTML .= qq {\n}; $HTML .= qq {\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 {\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 {\n}; } else { - $HTML .= qq {\n}; + $HTML .= qq {\n}; } } $HTML .= qq {\n}; @@ -1807,13 +1989,13 @@ sub draw_form_opt { 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/ ) { @@ -1821,7 +2003,7 @@ sub draw_form_opt { } $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' : ''; @@ -1838,9 +2020,12 @@ sub draw_form_opt { $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 {\n}; + $HTML .= qq {\n}; + $HTML .= qq {24fps(主にアニメ)\n}; $HTML .= qq {二ヶ国語放送\n}; -# $HTML .= qq {2passモード\n}; + #$HTML .= qq {2passモード\n}; $HTML .= qq {5.1ch放送\n}; $HTML .= qq {
\n}; $HTML .= qq {